// Linien zeichnen unter Hinzunahme von Antialiasing.


// Getestet mit D4 unter XP

 

-->
100 %   1000 %
procedure AntiAliasLine(dc: HDC; x1, y1, x2, y2: integer; clr: TColor); 
var 
  i, lz: integer; 
  ly, lx, cx, cy, dx, dy, skp: single; 
  function mix(frmc, toc: TColor; w: Single): TColor; 
  begin 
    Result := RGB(Round(GetRValue(frmc) * w + GetRValue(toc) * (1 - w)), 
      Round(GetGValue(frmc) * w + GetGValue(toc) * (1 - w)), 
      Round(GetBValue(frmc) * w + GetBValue(toc) * (1 - w))); 
  end; 
  procedure vert(x: integer; y: single); 
  var w: single; 
  begin 
    w := frac(y); 
    setpixel(dc, x, trunc(y), mix(clr, getpixel(dc, x, trunc(y)), 
      1 - w)); 
    setpixel(dc, x, trunc(y) + 1, mix(clr, getpixel(dc, x, 
      trunc(y) + 1), w)); 
  end; 
  procedure horz(x: single; y: integer); 
  var w: single; 
  begin 
    w := frac(x); 
    setpixel(dc, trunc(x), y, mix(clr, getpixel(dc, trunc(x), 
      y), 1 - w)); 
    setpixel(dc, trunc(x) + 1, y, mix(clr, getpixel(dc, trunc(x) 
      + 1, y), w)); 
  end; 
begin 
  if (x1 <> x2) or (y1 <> y2) then 
  begin 
    lx := abs(x2 - x1); 
    ly := abs(y2 - y1); 
    if lx > ly then 
    begin 
      lz := trunc(lx); 
      dy := (y2 - y1) / lz; 
      i := ord(x1 <= x2); 
      skp := i; 
      dx := i * 2 - 1; 
    end else 
    begin 
      lz := trunc(ly); 
      dx := (x2 - x1) / lz; 
      i := ord(y1 <= y2); 
      skp := i; 
      dy := i * 2 - 1; 
    end; 
    cx := x1 + dx * skp; 
    cy := y1 + dy * skp; 
    for i := 1 to lz do 
    begin 
      if lx > ly then vert(trunc(cx), cy) else 
        horz(cx, trunc(cy)); 
      cx := cx + dx; 
      cy := cy + dy; 
    end; 
  end; 
end; 
 
// Beispiel 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  with canvas do begin 
    pen.color := clred; 
    moveto(10, 5); 
    lineto(200, 95); 
  end; 
  AntiAliasLine(canvas.handle, 10, 10, 200, 100, clred); 
end;



 

Zugriffe seit 6.9.2001 auf Delphi-Ecke