反走样DEMO

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    CheckBox1: TCheckBox;
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  aPoint: TPoint;

procedure AALine(x1, y1, x2, y2: single; color: tcolor; canvas: tcanvas);

implementation

{$R *.dfm}

procedure AALine(x1, y1, x2, y2: single; color: tcolor; canvas: tcanvas);
  function CrossFadeColor(FromColor, ToColor: TColor; Rate: Single): TColor;
  var r, g, b: byte;
  begin
    r := Round(GetRValue(FromColor) * Rate + GetRValue(ToColor) * (1 - Rate));
    g := Round(GetGValue(FromColor) * Rate + GetGValue(ToColor) * (1 - Rate));
    b := Round(GetBValue(FromColor) * Rate + GetBValue(ToColor) * (1 - Rate));
    Result := RGB(r, g, b);
  end;
  procedure hpixel(x: single; y: integer);
  var FadeRate: single;
  begin
    FadeRate := x - trunc(x);
    with canvas do
    begin
      pixels[trunc(x), y] := CrossFadeColor(Color, Pixels[Trunc(x), y], 1 - FadeRate);
      pixels[trunc(x) + 1, y] := CrossFadeColor(Color, Pixels[Trunc(x) + 1, y], FadeRate);
    end;
  end;

  procedure vpixel(x: integer; y: single);
  var FadeRate: single;
  begin
    FadeRate := y - trunc(y);
    with canvas do
    begin
      pixels[x, trunc(y)] := CrossFadeColor(Color, Pixels[x, Trunc(y)], 1 - FadeRate);
      pixels[x, trunc(y) + 1] := CrossFadeColor(Color, Pixels[x, Trunc(y) + 1], FadeRate);
    end;
  end;

var i: integer;
  ly, lx, currentx, currenty, deltax, deltay, l, skipl: single;
begin
  if (x1 <> x2) or (y1 <> y2) then
  begin
    currentx := x1;
    currenty := y1;
    lx := abs(x2 - x1);
    ly := abs(y2 - y1);

    if lx > ly then
    begin
      l := trunc(lx);
      deltay := (y2 - y1) / l;
      if x1 > x2 then
      begin
        deltax := -1;
        skipl := (currentx - trunc(currentx));
      end else
      begin
        deltax := 1;
        skipl := 1 - (currentx - trunc(currentx));
      end;
    end else
    begin
      l := trunc(ly);
      deltax := (x2 - x1) / l;
      if y1 > y2 then
      begin
        deltay := -1;
        skipl := (currenty - trunc(currenty));
      end else
      begin
        deltay := 1;
        skipl := 1 - (currenty - trunc(currenty));
      end;
    end;

    currentx := currentx + deltax * skipl;
    currenty := currenty + deltay * skipl; {}

    for i := 1 to trunc(l) do
    begin
      if lx > ly then vpixel(trunc(currentx), currenty) else hpixel(currentx, trunc(currenty));
      currentx := currentx + deltax;
      currenty := currenty + deltay;
    end;
  end;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if ssleft in Shift then
  begin
    if CheckBox1.Checked then
    begin
      AALine(aPoint.X, aPoint.Y, x, y, Canvas.Pen.Color, Canvas);
      aPoint := Point(x, y)
    end
    else
    begin
      Canvas.MoveTo(aPoint.X, aPoint.y);
      Canvas.LineTo(x, y);
      aPoint := Point(x, y);
    end;
  end;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  aPoint := Point(x, y);
end;

end.