// Es wird eine Linie, die aus bunten Farbpunkten besteht, vom Punkt
// x1,y1 bis einschl. x2,y2 gezogen. Dabei kann man eine immer wiederkehrende
// Farbfolge angeben, oder man kann die Farben zufällig generieren lassen.
// Siehe auch:
bunte Kreise zeichnen

// Getestet mit D4 unter XP

procedure 
  multicoloredline(dc: HDC; x1, y1, x2, y2: integer; clr: array of TColor); 
var 
  gx, gy, i, n, z: integer; 
  stp, wrt: double; 
  f: TColor; 
  procedure farbe; 
  begin 
    if z > 0 then f := clr[n] 
    else f := random(1000000); 
  end; 
  procedure weiter(a, b: integer); 
  begin 
    setpixel(dc, x1 + a, y1 + b, f); 
    inc(n); 
    if n >= z then n := 0; 
    wrt := wrt + stp; 
    farbe; 
  end; 
begin 
  z := length(clr); 
  wrt := 0; 
  n := 0; 
  farbe; 
  gx := x2 - x1; 
  gy := y2 - y1; 
  if abs(gx) > abs(gy) then begin 
    if gx = 0 then stp := 0 else stp := gy / gx; 
    if x1 < x2 then begin 
      for i := 0 to gx do weiter(i, round(wrt)); 
    end else begin 
      for i := gx to 0 do weiter(gx - i, -round(wrt)); 
    end; 
  end else begin 
    if gy = 0 then stp := 0 else stp := gx / gy; 
    if y1 < y2 then begin 
      for i := 0 to gy do weiter(round(wrt), i); 
    end else begin 
      for i := gy to 0 do weiter(-round(wrt), gy - i); 
    end; 
  end; 
end; 
// bunte Linie mit wiederkehrendem Muster 
procedure TForm1.ToolButton3Click(Sender: TObject); 
begin 
  multicoloredline(canvas.handle, 50, -50, 15, 110, 
    [clred, clyellow, clblack, clfuchsia, clblue, cllime]); 
end; 
 
// bunte Linie mit zufälliger Färbung 
procedure TForm1.ToolButton4Click(Sender: TObject); 
begin 
  multicoloredline(canvas.handle, 60, 150, 10, -120, []); 
end; 



Zugriffe seit 6.9.2001 auf Delphi-Ecke