tMin=0;
tMax=0.5;
tStep=0.1;
dSlopeMin=1;
dSlopeMax=2;
dSlopeStep=0.1;
sSlopeMin=1;
sSlopeMax=2;
sSlopeStep=0.1;

axisFlip=#/.{x_Line|x_GraphicsComplex:>MapAt[#~Reverse~2&,x,1],x:(PlotRange->_):>x~Reverse~2}&;
animatePlot[t_,dSlope_,sSlope_,showSurplus_?BooleanQ]:=Block[{pOld,pNew,qOld,qNew,triangleWelfareLoss,triangleConsumerSurplus,triangleProducerSurplus,welfareLoss,consumerSurplus,producerSurplus,maxTax,colorWelfare,colorProducer,colorConsumer,d,s,taxRevenueT,pOldT,qOldT,pNewT,qNewT,welfareLossT,p0,consumerSurplusT,producerSurplusT,consumerTaxT,producerTaxT,plotsSecond},

(* Demand and supply curve *)
d[p_]:=1-dSlope*p;
s[p_]:=sSlope*p;

(* Intersection point between demand curve and p-axis *)
p0=Solve[d[p]==0,p][[1,1,2]];

(* Equilibrium state. All variables with T at the and are functions defined for all taxes (second graph) *)
pOldT[τ_]=Solve[d[p]==s[p],p][[1,1,2]];
qOldT[τ_]=d[pOldT[τ]];
pNewT[τ_]=Solve[d[p]==s[p-τ],p][[1,1,2]];
qNewT[τ_]=d[pNewT[τ]];

(* Equilibrium state for the given t (first graph) *)
pOld=pOldT[t];
pNew=pNewT[t];
qOld=qOldT[t];
qNew=Max[qNewT[t],0];

(* Functions for the lower graph (need to be defined for all taxes τ) *)
taxRevenueT[τ_]:=τ*qNewT[τ];
consumerSurplusT[τ_]:=((qNewT[τ]*(p0-pNewT[τ]))/2);
producerSurplusT[τ_]:=((qNewT[τ]*(pNewT[τ]-τ))/2);
consumerTaxT[τ_]:=qNewT[τ]*(pNewT[τ]-pOld);
producerTaxT[τ_]:=qNewT[τ]*(pOld-(pNewT[τ]-τ));
welfareLossT[τ_]:=((τ*(qOldT[τ]-qNewT[τ]))/2);

(* Triangles with area values *)
triangleWelfareLoss=Triangle[{{qNew,pNew-t},{qNew,pNew},{qOld,pOld}}];
triangleConsumerSurplus=Triangle[{{0,pNew},{0,p0},{qNew,pNew}}];
triangleProducerSurplus=Triangle[{{0,0},{0,pNew-t},{qNew,pNew-t}}];
welfareLoss=({{\[Piecewise], ({{Area[triangleWelfareLoss], RegionQ[triangleWelfareLoss]}, {0, True}})}});
consumerSurplus=({{\[Piecewise], ({{Area[triangleConsumerSurplus], RegionQ[triangleConsumerSurplus]}, {0, True}})}});
producerSurplus=({{\[Piecewise], ({{Area[triangleProducerSurplus], RegionQ[triangleProducerSurplus]}, {0, True}})}});

(* Tax rate with the highest tax amount (T) *)
maxTax=Solve[taxRevenueT'[τ]==0,τ][[1,1,2]];

colorWelfare=;
colorProducer=;
colorConsumer=;

plotsSecond=4-({{\[Piecewise], ({{0, showSurplus}, {2, True}})}});

Column[{
Plot[{({{\[Piecewise], ({{d[p], d[p]≥0}, {Undefined, True}})}}),s[p],({{\[Piecewise], ({{s[p-t], s[p-t]≥0}, {Undefined, True}})}})},{p,0,2},
PlotRange->{{-0.3,1.1},{-0.2,1}},
AxesLabel->{"Q","p"},
PlotLegends->{"D(p) = "<>ToString[d[p]],"S(p) = "<>ToString[s[p]],"S(p-t) = "<>ToString[s[p-t]]},
PlotLabel->"Markt",
ImageSize->480,
BaseStyle->{FontSize->12},
PlotStyle->{colorConsumer,colorProducer,Directive[Dashed,colorProducer]},
Epilog->{
{Text["(Subscript[p, alt]^( * ))",{-0.15,pOld}]},
{Text["(Subscript[p, neu]^( * ))",{-0.15,pNew}]},
{Text["(Subscript[p, neu]^( * ))-t",{-0.15,pNew-t}]},
{Style[Line[{{pOld,-0.1},{pOld,0}}],Dashed]},
{Style[Line[{{pNew,-0.1},{pNew,0}}],Dashed]},
{Style[Line[{{pNew-t,-0.1},{pNew-t,0}}],Dashed]},
{Text["(Subscript[Q, alt]^( * ))",{qOld,-0.2}]},
{Text["(Subscript[Q, neu]^( * ))",{qNew,-0.2}]},
{Style[Line[{{-0.05,qOld},{pOld,qOld}}],Dashed]},
{Style[Line[{{-0.05,qNew},{pNew-t,qNew}}],Dashed]},
{Style[Rectangle[{0,pOld},{qNew,pNew}],colorConsumer,Opacity[0.2]]},
{Style[Rectangle[{0,pNew-t},{qNew,pOld}],colorProducer,Opacity[0.2]]},
{Style[triangleWelfareLoss,colorWelfare,Opacity[0.4]]},
{Style[triangleConsumerSurplus,colorConsumer,Opacity[0.1]]},
{Style[triangleProducerSurplus,colorProducer,Opacity[0.1]]},
{Style[Text["-ΔW="<>ToString[Round[welfareLoss,0.001]],Scaled[{0.1,0},{qOld,pOld}]],colorWelfare]},
If[showSurplus,
{
{Style[Text["K="<>ToString[Round[consumerSurplus,0.001]],{(1/3)*qNew,pNew*1.2}],colorConsumer]},
{Style[Text["P="<>ToString[Round[producerSurplus,0.001]],{(1/3)*qNew,(pNew-t)*0.8}],colorProducer]}
}
]
}
]//axisFlip,

Show[
Plot[{taxRevenueT[τ],consumerTaxT[τ]},{τ,0,t+0.0001},
ImageSize->480,
BaseStyle->{FontSize->12},
PlotRange->{{0,0.6},{-0.03,0.18}},
AxesLabel->{"Steuersatz t","€"},
PlotLegends->SwatchLegend[{Directive[colorConsumer,Opacity[0.3]],Directive[colorProducer,Opacity[0.3]]},{"Steuerlast Konsumenten (Subscript[K, T])","Steuerlast Produzenten (Subscript[P, T])"}],
PlotLabel->"Steuerpolitik",
PlotStyle->None,
Filling->{
1->{{2},Directive[colorProducer,Opacity[0.3]]},
2->{Axis,Directive[colorConsumer,Opacity[0.3]]}
},
Epilog->{
{Text["(Subscript[t, aktuell])",Scaled[{0,-0.1},{t,0}]]},
{Style[Line[{{t,0},Scaled[{0,-0.08},{t,0}]}],Dashed]},
{Style[Text["(Subscript[K, T])="<>ToString[Round[consumerTaxT[t],0.001]],{t,((consumerTaxT[t])/2)}],colorConsumer]},
{Style[Text["(Subscript[P, T])="<>ToString[Round[producerTaxT[t],0.001]],{t,consumerTaxT[t]+((producerTaxT[t])/2)}],colorProducer]}
}
],
Plot[{taxRevenueT[τ],welfareLossT[τ],consumerSurplusT[τ],producerSurplusT[τ]}[[1;;plotsSecond]]//Evaluate,{τ,0,t+0.0001},
PlotLegends->{"Steuereinnahmen T","Wohlfahrtsverlust -ΔW","Konsumentenrente K","Produzentenrente P"}[[1;;plotsSecond]],
PlotStyle->{,colorWelfare,colorConsumer,colorProducer}[[1;;plotsSecond]]
]
]

}]

];

Manipulate[
animatePlot[t,dSlope,sSlope,showSurplus]
,{{t,0.5},tMin,tMax},{dSlope,dSlopeMin,dSlopeMax},{sSlope,sSlopeMin,sSlopeMax},{{showSurplus,False},{True,False}}]

´(*Do[
Export[
FileNameJoin[{
NotebookDirectory[],
"frames/t="<>IntegerString[Round[((t-tMin)/tStep),1],10,2]<>"dSlope="<>IntegerString[Round[((dSlope-dSlopeMin)/dSlopeStep),1],10,2]<>"sSlope="<>IntegerString[Round[((sSlope-sSlopeMin)/sSlopeStep),1],10,2]<>"showSurplus="<>IntegerString[Boole[showSurplus]]<>".png"
}],
{animatePlot[t,dSlope,sSlope,showSurplus]},
"VideoFrames",
Antialiasing->True
];

,{t,0,0.5,0.1},{dSlope,1,2,0.1},{sSlope,1,2,0.1},{showSurplus,{True,False}}
];*)

(*Export[
FileNameJoin[{
NotebookDirectory[],
"MarktSteuerpolitik_Animation.png"
}],
{animatePlot[0.2,1,1,False]},
"VideoFrames",
Antialiasing->True
];*)