Einzelnen Beitrag anzeigen

mimi

Registriert seit: 1. Dez 2002
Ort: Oldenburg(Oldenburg)
2.008 Beiträge
 
FreePascal / Lazarus
 
#17

Re: Eine Eigene Linen Zeichnen ?

  Alt 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)
  Mit Zitat antworten Zitat