1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159
| type tTraceMode = (tmAffiche,tmEfface,tmCopy);
procedure TracerDroite( BMP : TBitMap; xo,yo,xe,ye, epTrait : integer;
CoulPen : TColor; TraceMode : tTraceMode);
// Tracer/Effacer une droite en mode NotXor lorsque TraceMode = tmAffiche/tmEfface
var Theta,miEp,si,co,mis,mic,sinco,cosco,
ep,x,y,xo1,yo1,xe1,ye1,xo2,yo2,xe2,ye2,dx,dy,a,b,xorMin,xerMax,yorMin,yerMax,rr,d,u,dt : Extended;
iy,ix,yoMin,yeMax,xoMin,xeMax,r,i,j : integer;
Scan1: Integer; // Valeur de la 1ère adresse de ScanLine.
MemLineSize: Integer; // Taille d'une ligne de pixels en mémoire (en octets).
BytesPerPix: Integer; // Taille d'un pixel (en octets)
CurrentScan: Integer; // valeur de pointeur courant
clEcran : tColor; // Couleur arrière-plan
RPen,GPen,BPen : byte; // Composantes de CoulPen
CoulDec : tColor; // Couleur légèrement décalée de CoulPen
RDec,GDec,BDec : byte; // Composantes de CoulPen
clPNX,clDNX : TColor; // NotXor de CoulPen et de clEcran, et NotXor de Coul-décalée et de clEcran
procedure InitCouleurs;
const D = 2;
begin RPen:=GetRValue(CoulPen); GPen:=GetGValue(CoulPen); BPen:=GetBValue(CoulPen);
if RPen>127 then RDec:=RPen-D else RDec:=RPen+D;
if GPen>127 then GDec:=GPen-D else GDec:=GPen+D;
if BPen>127 then BDec:=BPen-D else BDec:=BPen+D;
CoulDec:=RGB(RDec,GDec,BDec);
end;
function clNotXor(clPen,clEcran : TColor) : TColor;
// Renvoie couleur NotXor = not (pen.color xor clEcran)
var R,G,B, RP,GP,BP, RE,GE,BE : byte;
begin RP:=getRvalue(clPen); GP:=getGvalue(clPen); BP:=getBvalue(clPen);
RE:=getRvalue(clEcran); GE:=getGvalue(clEcran); BE:=getBvalue(clEcran);
R:=not (RP xor RE); G:=not (GP xor GE); B:=not (BP xor BE);
Result:=RGB(R,G,B);
end;
procedure GSPixel; // Gère les modifs de couleurs
begin if (ix>0) and (ix<BMP.Width-1) and (iy>0) and (iy<BMP.height-1) then begin
CurrentScan:=Scan1 + iy * MemLineSize + ix * BytesPerPix;
with PRGBQuad(CurrentScan)^ do begin
case TraceMode of
tmAffiche,
tmEfface : begin clEcran:=RGB(rgbRed,rgbGreen,rgbBlue);
clPNX:=clNotXor(CoulPen,clEcran);
clDNX:=clNotXor(CoulDec,clEcran);
if TraceMode=tmAffiche then
begin if clEcran=CoulPen then
begin rgbRed := RDec; // Coul Pen décalée
rgbGreen:= GDec;
rgbBlue := BDec;
end else //clEcran <> CoulPen alors NotXor avec Coul Pen
begin rgbRed := GetRValue(clPNX);
rgbGreen:= GetGValue(clPNX);
rgbBlue := GetBValue(clPNX);
end;
end else // mode efface :
if TraceMode=tmEfface then
begin if clEcran=CoulDec then
begin rgbRed :=not (GetRValue(clDNX) xor RPen);
rgbGreen:=not (GetGValue(clDNX) xor GPen);
rgbBlue :=not (GetBValue(clDNX) xor BPen);
end else // clEcran <> CoulDec alors NotXor avec Coul Pen
begin rgbRed := GetRValue(clPNX);
rgbGreen:= GetGValue(clPNX);
rgbBlue := GetBValue(clPNX);
end;
end;
end;
else begin rgbRed := RPen; // pmCopy (utilisé uniquement lors d'un appel pour un tracé de finition serré)
rgbGreen := GPen;
rgbBlue := BPen;
end;
end;
end;
end;
end;
begin BMP.PixelFormat:=pf24bit;
Scan1 := Integer(BMP.ScanLine[0]); //Pointe sur la 1ère ligne du Bitmap.
MemLineSize := Integer(BMP.ScanLine[1]) - Scan1;
BytesPerPix := Abs(MemLineSize div BMP.Width);
InitCouleurs;
miep:=epTrait/2; rr:=miEp; ep:=0;
if xe=xo then // Verticale
begin xo1:=xo - miep; xo2:=xo + miep; yo1:=min(yo,ye); ye1:=max(yo,ye);
for ix:=round(xo1) to round(xo2) do begin
// Embouts arrondis :
d:=abs(rr-ep); u:=sqrt(sqr(rr)-sqr(d));
yoMin:=round(yo1-u); yeMax:=round(ye1+u);
for iy:=yoMin to yeMax do GSPixel;
ep:=ep+1;
end;
EXIT;
end;
if ye=yo then // Horizontale
begin yo1:=yo - miep; yo2:=yo + miep; xo1:=min(xo,xe); xe1:=max(xo,xe);
for iy:=round(yo1) to round(yo2) do begin
// Embouts arrondis :
d:=abs(rr-ep); u:=sqrt(sqr(rr)-sqr(d));
xoMin:=round(xo1-u); xeMax:=round(xe1+u);
for ix:=xoMin to xeMax do GSPixel;
ep:=ep+1;
end;
EXIT;
end;
// Droites inclinées
Theta:=arcTan2(ye-yo,xe-xo);
a:=tan(Theta);
b:=yo - a*xo;
si:=sin(Theta); co:=cos(Theta); mis:=miep*si; mic:=miep*co;
xo1:=xo + mis; yo1:=yo - mic; xo2:=xo - mis; yo2:=yo + mic;
xe1:=xe + mis; ye1:=ye - mic; xe2:=xe - mis; ye2:=ye + mic;
sinco:=sin(Pi/2-theta);
cosco:=cos(Pi/2-theta);
dy:=abs(ye-yo); dx:=abs(xe-xo);
if dy>=dx then // "y = a.x + b" --> x:= (y - b)/a
begin yorMin:=min(yo1,ye1); yerMax:=max(yo1,ye1);
b:=ye1 - a*xe1; ep:=0;
repeat // Embouts arrondis :
d:=abs(rr-ep); u:=sqrt(sqr(rr)-sqr(d)); u:=abs(u*si);
// Suite du tracé
for iy:=round(yorMin-u) to round(yerMax+u) do
begin x:= (iy - b)/a; ix:=round(x); GSPixel; end;
if TraceMode<>tmCopy then begin
ep:=ep+1;
b:=b+1/sinco;
yorMin:=yorMin+sinco;
yerMax:=yerMax+sinco;
end else begin // si appel avec tmCopy alors passe de finition resserrée avec un pas de 0.5
ep:=ep+0.5;
b:=b+0.5/sinco;
yorMin:=yorMin+0.5*sinco;
yerMax:=yerMax+0.5*sinco;
end;
until (ep>=epTrait);
EXIT;
end else // dy < dx
begin b:=yo1 - a*xo1; ep:=0;
xo2:=min(xo1,xe1); xe2:=max(xo1,xe1); xorMin:=xo2; xerMax:=xe2;
repeat // Embouts arrondis :
d:=abs(rr-ep); u:=sqrt(sqr(rr)-sqr(d)); u:=abs(u*co);
// Suite de la droite
for ix:=round(xorMin-u) to round(xerMax+u) do
begin y:= a*ix + b; iy:=round(y); GSPixel; end;
if TraceMode<>tmCopy then begin
ep:=ep+1;
b:=b+1/sinco;
xorMin:=xorMin-cosco;
xerMax:=xerMax-cosco;
end else begin // si appel avec tmCopy alors passe de finition resserrée avec un pas de 0.5
ep:=ep+0.5;
b:=b+0.5/sinco;
xorMin:=xorMin-0.5*cosco;
xerMax:=xerMax-0.5*cosco;
end;
until (ep>=epTrait);
end;
end; // TracerDroite |
Partager