Registriert seit: 1. Dez 2002
Ort: Oldenburg(Oldenburg)
2.008 Beiträge
FreePascal / Lazarus
|
Re: Eine Eigene Linen Zeichnen ?
3. Nov 2007, 18:32
ich habe jetzt die Procedure erweitert von:SirThornberry Vielen Dank noch mal für dein Code.
Delphi-Quellcode:
procedure DrawLine(ACanvas: TCanvas; x1, y1, x2, y2: Integer; AColor: TColor; style:array of Boolean; FarbStyle:array of TColor);
procedure StyleFarbeLine(var zc,zw,z,lenStyle, lenColor,W:Integer);
begin
if (lenStyle > -1) and (lenColor > 0) then begin
if zc +1 <= lenColor then
inc(zc)
else
zc:=0;
end; // lenColor
if lenStyle > -1 then begin
if z +1 <= Length(style) then
inc(z)
else
z:=0;
end; // lenStyle
if (lenStyle = -1) and (lenColor > 0) then begin
if zw+1 >= w then begin
zw:=0;
if zc+1 <=lenColor then inc(zc);
end
else
inc(zw);
end;
end;
var
lCount,lDistanceX,lDistanceY,lStepSize: Integer;
z,zc,lenColor,lenStyle,w,zw:Integer;
lc:TColor;
begin
lDistanceX := x2 - x1;
lDistanceY := y2 - y1;
z:=0; zc:=0; zw:=0;
lenColor:=Length(FarbStyle);
lenStyle:=Length(style)-1;
if lenColor = -1 then lc:=AColor;
if Abs(x2 - x1) < Abs(y2 - y1) then begin
lCount := 0;
if (lDistanceY > 0) then
lStepSize := +1
else
lStepSize := -1;
w:=abs(lDistanceY div lenColor);
while (lCount <> lDistanceY) do begin
if lenColor > 0 then lc:=FarbStyle[zc];
if (lenStyle = -1) or (lenStyle >= 0) and (style[z]) then
ACanvas.Pixels[x1 + Trunc(lCount * lDistanceX / lDistanceY), y1 + lCount] := lc;
StyleFarbeLine(zc,zw,z,lenStyle,lenColor,w);
lCount := lCount + lStepSize;
end;
end
else begin
lCount := 0;
if (lDistanceX > 0) then
lStepSize := +1
else
lStepSize := -1;
w:=abs(lDistanceX div lenColor);
while (lCount <> lDistanceX) do begin
if lenColor > 0 then lc:=FarbStyle[zc];
if (lenStyle = -1) or (lenStyle >= 0) and (style[z]) then
ACanvas.Pixels[x1 + lCount, y1 + Trunc(lCount * lDistanceY / lDistanceX)] := lc;
StyleFarbeLine(zc,zw,z,lenStyle,lenColor,w);
lCount := lCount + lStepSize;
end;
end;
ACanvas.Pixels[x2, y2] := AColor;
end;
// Beispiel Aufruf:
DrawLine(PaintBox1.Canvas,mx,my,x,y,clRed,[],[clred,clBlue,clYellow]);
Nun Kann sie mit Farb Stylen und Linen Stylen umgehen*freu*
Edit00: Proceure geändert.
Edit01: Neue Version von der Proceure: Jetzt dürfte alles klappen. Ich hatte im Obigen teil ein abs vergessen bei der w Zuweisung.
Michael Springwald MFG
Michael Springwald,
Bitte nur Deutsche Links angeben Danke (benutzte überwiegend Lazarus)
|