Electric Dipole

Module[{field,fieldptsfunc,dirfun},
Manipulate[LocatorPane[
Dynamic[{q1p,q2p,ptp}],
Dynamic[
With[
{
fieldlines=StreamPlot[field[x,y,q1p,q2p,qq1,qq2],{x,-frange,frange},{y,-frange,frange},StreamPoints->{fieldptsfunc[q1p,q2p,qq1,qq2(*,d,s*)],Automatic,{(*Forward*)dirfun[qq1,qq2](*Backward*),l}},
StreamScale->{(1/frange)(5/20)(*Full*),20,0.008(*, #5&*)},StreamStyle->RGBColor[0.2,0.2,0.2],
StreamColorFunction->Function[Opacity[0.08+(2/π)ArcTan[#5]]],StreamColorFunctionScaling->False,RegionFunction->Function[{x,y},(((x-q2p[[1]]))^2)+(((y -q2p[[2]]))^2)≥(d/4)&&(((x-q1p[[1]]))^2)+(((y -q1p[[2]]))^2)≥(d/4)&&(Sqrt[(x^2)+(y^2)])≤5(Sqrt[2])]
],
fieldintplot=DensityPlot[((((2/π)ArcTan[Norm[field[x,y,q1p,q2p,qq1,qq2]]]))^ExCol),{x,-6,6},{y,-6,6}, ColorFunction->GrayLevel,ColorFunctionScaling->False,BaseStyle->Directive[Opacity[opac]],MaxRecursion->2,PlotRange->{0,1.1}]
},
Dynamic[
With[
{
fieldpoint=StreamPlot[field[x,y,q1p,q2p,qq1,qq2],{x,-frangeline,frangeline},{y,-frangeline,frangeline},StreamPoints->{{{ptp,{Thickness[0.005],RGBColor[1,0,0],Arrowheads[0.02]}}},Automatic,{ForwardBackward,l}},
StreamScale->(1/(2frangeline)),
StreamColorFunction->Function[Opacity[0.08+(2/π)ArcTan[#5]]],StreamColorFunctionScaling->False,RegionFunction->Function[{x,y},(((x-q2p[[1]]))^2)+(((y -q2p[[2]]))^2)≥(d/4)&&(((x-q1p[[1]]))^2)+(((y -q1p[[2]]))^2)≥(d/4)]],
vecgraf=Graphics[
With[
{
E1=field[ptp[[1]],ptp[[2]],q1p,q2p,qq1,0],
E2=field[ptp[[1]],ptp[[2]],q1p,q2p,0,qq2],
Ept=field[ptp[[1]],ptp[[2]],q1p,q2p,qq1,qq2]
},
{Opacity[0.85],Text[Style[P,22,RGBColor[0,0,0],Bold,Italic],ptp,{0,1.5}],Text[Style[(Subscript[q, 1]),22,RGBColor[0,0,0],Bold],q1p,{0,2}],Text[Style[(Subscript[q, 2]),22,RGBColor[0,0,0],Bold],q2p,{0,2}],
Arrowheads[.015],{Dashed,GrayLevel[0.25],Line[{{VS*E2[[1]]+ptp[[1]],VS*E2[[2]]+ptp[[2]]},{VS*Ept[[1]]+ptp[[1]],VS*Ept[[2]]+ptp[[2]]}}]},{Dashed,GrayLevel[0.25],Line[{{VS*Ept[[1]]+ptp[[1]],VS*Ept[[2]]+ptp[[2]]},{VS*E1[[1]]+ptp[[1]],VS*E1[[2]]+ptp[[2]]}}]},
{RGBColor[0.2,0.5,0.2],Opacity[1.2-((1Abs[qq2])/(Abs[qq1]+Abs[qq2]+0.001))],Disk[q1p,0.2]},{RGBColor[0.2,0.2,0.5],Opacity[1.2-((1Abs[qq1])/(Abs[qq1]+Abs[qq2]+0.001))],Disk[q2p,0.2]},
{RGBColor[0.8,0.0,0.0],Disk[ptp,.12]},
{Thickness[0.0025],RGBColor[0,0.5,0],Arrow[{ptp,{VS*E1[[1]]+ptp[[1]],VS*E1[[2]]+ptp[[2]]}}]},
{Thickness[0.0025],RGBColor[0,0,0.5],Arrow[{ptp,{VS*E2[[1]]+ptp[[1]],VS*E2[[2]]+ptp[[2]]}}]},
{Thickness[0.004],RGBColor[0.5,0.1,0.1],Arrowheads[0.024],Arrow[{ptp,{VS*Ept[[1]]+ptp[[1]],VS*Ept[[2]]+ptp[[2]]}}]}}
]
]
},
Show[fieldintplot,fieldlines,fieldpoint,vecgraf,
ImageSize->750,PlotRange->{{-5,5},{-5,5}},Axes->True,AxesStyle->Arrowheads[{0.0,0.012}],AxesLabel->{Style["x",Italic],Style["y",Italic]},Frame->True,GridLines->Automatic,GridLinesStyle->Directive[Black,Thin],BaseStyle->Directive[Opacity[opac]]]
]
]
]
],(*LocatorPane - locators range->*){{-4,-4},{4,4}},
(*LocatorPane - locators Appearance->*)Appearance->{Graphics[Locator[Appearance->Medium]],Graphics[Locator[Appearance->Medium]],Graphics[Locator[Appearance->Medium]]}(*end of LocatorPane->*)],
{{q1p,{-2,0}},None},{{q2p,{2,0}},None},{{ptp,{-0.5,2.8}},None},{{dir,Forward},None},
{{l,400,Style["length",12]},0,1200,1,Appearance->"Labeled",None},
{{frange,200,Style["field range (frange)",12]},5,800,5,Appearance->"Labeled",None},{{frangeline,15,Style["field range line(frangeline)",12]},1,200,1,Appearance->"Labeled",None},
{{d,0.10EuclideanDistance[q1p,q2p],Style["field lines distance (d)",12]},0,(1/2)EuclideanDistance[q1p,q2p],0.1,Appearance->"Labeled",None},
(*here goes the slider controls*)TabView[{"Field parameters"->Column[{Control[{{qq1,2,Style["(Subscript[q, 1])",12]},-4,4,0.1,Appearance->"Labeled"}],Control[{{qq2,-2,Style["(Subscript[q, 2])",12]},-4,4,0.1,Appearance->"Labeled"}],Control[{{VS,6,"Vector scale"},0,25,1,Appearance->"Labeled"}],
Control[{{s,20,Style["Field line density",12]},0,36,1,Appearance->"Labeled"}]
}],
"Color parameters"->Column[{Control[{{ExCol,0.3,"Color Scale"},0,3,0.1,Appearance->"Labeled"}],Control[{{opac,0.6,"Field background opacity"},0,1,0.1,Appearance->"Labeled"}]}]
}
],
Initialization:>(
field[x_,y_,q1p_List,q2p_List,qq1_,qq2_]:={((qq1 (x-q1p[[1]]))/((EuclideanDistance[q1p,{x,y}])^3))+((qq2 (x-q2p[[1]]))/((EuclideanDistance[q2p,{x,y}])^3)),((qq1 (y-q1p[[2]]))/((EuclideanDistance[q1p,{x,y}])^3))+((qq2 (y-q2p[[2]]))/((EuclideanDistance[q2p,{x,y}])^3))};
dirfun[qq1_,qq2_]:=If[Chop[qq1+qq2]==0(*qq1+qq2==0*),If[qq1≥0,Forward,Backward],If[qq1+qq2>0,Forward,Backward]];
fieldptsfunc[q1p_List,q2p_List,qq1_,qq2_(*,d_,s_*)]:=
Module[{αq,xqmax,yqmax,extrapt,s1,s2,tabqopp,tabqconc},
αq=N[ArcTan[((q2p[[2]]-q1p[[2]])/(q2p[[1]]-q1p[[1]]))]];
xqmax=If[Abs[qq2]>Abs[qq1],q2p[[1]],q1p[[1]]];
yqmax=If[Abs[qq2]>Abs[qq1],q2p[[2]],q1p[[2]]];
extrapt=If[Abs[qq2]>Abs[qq1],{q1p[[1]]-25d Cos[αq],q1p[[2]]-25d Sin[αq]},{q2p[[1]]+25d Cos[αq],q2p[[2]]+25d Sin[αq]}];
s1=If[qq1==0,1,Round[((Abs[qq1])/(Abs[qq1]+Abs[qq2]))s]];
s2=If[qq2==0,1,Round[((Abs[qq2])/(Abs[qq1]+Abs[qq2]))s]];
(* if opposite charges *)
tabqopp=Join[Table[{xqmax+d Cos[k ((2π)/s)+αq],yqmax+d Sin[k ((2π)/s)+αq]},{k,0,s-1,1}],{extrapt}];
(* if equally signed charges *)tabqconc=Join[Table[{q1p[[1]]+d Cos[k ((2π)/s1)+αq],q1p[[2]]+d Sin[k ((2π)/s1)+αq]},{k,0,s1-1,1}],Table[{q2p[[1]]-d Cos[k ((2π)/s2)+αq],q2p[[2]]-d Sin[k ((2π)/s2)+αq]},{k,0,s2-1,1 }]];
(*output of fieldptsfunc->1*)If[qq1*qq2≤0,tabqopp,tabqconc]
];
)
]
]