teeantialias.pas

BCB第三方组件

    X:=XRadius;
    Y:=0;
    XChange:=YRadius*YRadius*(1-2*XRadius);
    YChange:=XRadius*XRadius;
    EllipseError:=0;
    StoppingX:=tmpY*XRadius;
    StoppingY:=0;

    while StoppingX >= StoppingY do
    begin
      DrawPoints(X,Y);
      Inc(Y);
      Inc(StoppingY, tmpX);
      Inc(EllipseError, YChange);
      Inc(YChange,tmpX);

      if ((2*EllipseError + XChange) > 0 ) then
      begin
        Dec(X);
        Dec(StoppingX, tmpY);
        Inc(EllipseError, XChange);
        Inc(XChange,tmpY);
        a:=True
      end
      else a:=False;
    end;

    X:=0;
    Y:=YRadius;
    XChange:=YRadius*YRadius;
    YChange:=XRadius*XRadius*(1-2*YRadius);
    EllipseError:=0;
    StoppingX:=0;
    StoppingY:=tmpX*YRadius;

    while StoppingX <= StoppingY do
    begin
      DrawPoints(X,Y);
      Inc(X);
      Inc(StoppingX, tmpY);
      Inc(EllipseError, XChange);
      Inc(XChange,tmpY);

      if ((2*EllipseError + YChange) > 0 ) then
      begin
        Dec(Y);
        Dec(StoppingY, tmpX);
        Inc(EllipseError, YChange);
        Inc(YChange,tmpX);
        a:=True;
      end
      else a:=False;
    end
  end;

var OldColor : TColor;
    OldStyle : TPenStyle;
    tmp      : Boolean;
    ISolid   : Boolean;
    tmpDots  : TPenDots;
    DecX     : Integer;
    DecY     : Integer;
begin
  if not IAlias then
     inherited
  else
  begin
    IPenColor:=ColorToRGB(Pen.Color);

    OldColor:=IPenColor;
    OldStyle:=IPenStyle;

    tmp:=Pen.Style=psSolid;

    if tmp then
       Pen.Style:=psClear
    else
    begin
      OldColor:=Brush.Color;
      tmp:=Brush.Style<>bsClear;
    end;

    inherited;

    if tmp then
    begin
      Pen.Style:=psSolid;
      IPenColor:=OldColor;

      r:=GetRValue(IPenColor);
      g:=GetGValue(IPenColor);
      b:=GetBValue(IPenColor);

      ISolid:=False;
      GetPenDots(tmpDots,ISolid);

      DecX:=(x2-x1) mod 2;
      if DecX=0 then DecX:=2;

      DecY:=(y2-y1) mod 2;
      if DecY=0 then DecY:=2;

      DrawEllipse( (x1+x2) div 2,(y1+y2) div 2,(x2-x1) div 2,(y2-y1) div 2,
                   DecX,  DecY);
    end;

    IPenColor:=OldColor;
    Pen.Style:=OldStyle;
  end;
end;

Procedure TAntiAliasCanvas.GradientFill( Const Rect : TRect; StartColor : TColor;
                            EndColor   : TColor; Direction  : TGradientDirection;
                            Balance    : Integer=50);
var Old : Boolean;
begin
  Old:=IAlias;
  IAlias:=False;

  inherited;

  IAlias:=Old;
end;

function TAntiAliasCanvas.InitWindow(DestCanvas: TCanvas; A3DOptions: TView3DOptions;
  ABackColor: TColor; Is3D: Boolean; const UserRect: TRect): TRect;
begin
  result:=inherited InitWindow(DestCanvas,A3DOptions,ABackColor,Is3D,UserRect);

  IAlias:=(not Metafiling) and (AntiAlias=aaYes) and UseBuffer;

  if IAlias and Assigned(Bitmap) then
  begin
    if not Assigned(IFilter) then
       IFilter:=TTeeFilter.Create(nil);

    IFilter.Apply(Bitmap,TeeZeroRect);
  end
  else
    FreeAndNil(IFilter);

  IDC:=Handle;
end;

{$IFOPT R+}
{$DEFINE WASRANGE}
{$ENDIF}

procedure TAntiAliasCanvas.BlendColor1(const AX,AY:Integer);
var AColor : TRGB;
    rr,gg,bb : Byte;
begin
  {$IFNDEF CLX}
  if PtVisible(IDC,AX,AY) then
     if Assigned(IFilter) then
     {$R-}
     with IFilter.Lines[AY,AX] do
     {$IFDEF WASRANGE}
     {$R+}
     {$ENDIF}
     begin
       Red:=Round(dist*(Red-r))     + r;
       Green:=Round(dist*(Green-g)) + g;
       Blue:=Round(dist*(Blue-b))   + b;
     end
     else
  {$ENDIF}
     begin
       AColor:=RGBValue(GetPixel(AX,AY));

       rr:=Round(dist*(AColor.Red-r))   + r;
       gg:=Round(dist*(AColor.Green-g)) + g;
       bb:=Round(dist*(AColor.Blue-b))  + b;

       SetPixel(AX,AY,(rr or (gg shl 8) or (bb shl 16)));
     end;
end;

procedure TAntiAliasCanvas.BlendColor2(const AX,AY:Integer);
var AColor   : TRGB;
    rr,gg,bb : Byte;
begin
  {$IFNDEF CLX}
  if PtVisible(IDC,AX,AY) then
     if Assigned(IFilter) then
     {$R-}
     with IFilter.Lines[AY,AX] do
     {$IFDEF WASRANGE}
     {$R+}
     {$ENDIF}
     begin
       Red:=Round(oneDist*(Red-r))     + r;
       Green:=Round(oneDist*(Green-g)) + g;
       Blue:=Round(oneDist*(Blue-b))   + b;
     end
     else
  {$ENDIF}
     begin
       AColor:=RGBValue(GetPixel(AX,AY));

       rr:=Round(oneDist*(AColor.Red-r))   + r;
       gg:=Round(oneDist*(AColor.Green-g)) + g;
       bb:=Round(oneDist*(AColor.Blue-b))  + b;

       SetPixel(AX,AY, (rr or (gg shl 8) or (bb shl 16)));
     end;
end;

procedure TAntiAliasCanvas.SetAntiAlias(const Value:TAntiAlias);
begin
  if FAlias<>Value then
  begin
    FAlias:=Value;

    if Assigned(View3DOptions) then
       View3DOptions.Repaint;
  end;
end;

procedure TAntiAliasCanvas.LineTo(X, Y: Integer);
var tmpX,tmpY,
    tmpXt,tmpYt,
    Old,
    tmp,
    t,
    dx,dy,xs,ys : Integer;
    xt,yt,k: Single;
    tmpDots : TPenDots;
    OldP    : TPoint;
    ISolid  : Boolean;
begin
  tmpX:=X;
  tmpY:=Y;

  dx:=x-Current.x;
  dy:=y-Current.y;

  if (not IAlias) or
     (Pen.Style=psClear) or
     ((Pen.Style<>psClear) and ((dx=0) or (dy=0))) then
  begin
    inherited;

    FCurrent.X:=tmpX;
    FCurrent.Y:=tmpY;
    exit;
  end;

  if (not IPenSmallDot) and (IPenWidth=1) then
     IPenColor:=ColorToRGB(Pen.Color);

  if IPenWidth>1 then
  begin
    Old:=IPenWidth;
    IPenWidth:=1;
    Pen.Width:=1;
    IPenColor:=ColorToRGB(Pen.Color);

    OldP:=Current;

    for t:=0 to Old-1 do
    begin
      IAlias:=(t=0) or (t=Old-1);

      tmp:=(Old div 2)-t;

      if Abs(dy)>Abs(dx) then
      begin
        MoveTo(OldP.X-tmp,OldP.Y);
        LineTo(X-tmp,Y);
      end
      else
      begin
        MoveTo(OldP.X,OldP.Y-tmp);
        LineTo(X,Y-tmp);
      end;
    end;

    IPenWidth:=Old;
    Pen.Width:=IPenWidth;
    IAlias:=True;
  end
  else
  begin
    SetPixel(Current.x, Current.y, IPenColor);

    if (dx<>0) or (dy<>0) then
    begin
      ISolid:=False;
      GetPenDots(tmpDots,ISolid);

      r:=GetRValue(IPenColor);
      g:=GetGValue(IPenColor);
      b:=GetBValue(IPenColor);

      if Abs(dx)>Abs(dy) then
      begin
        if dx < 0 then
        begin
          SwapInteger(FCurrent.x,x);
          SwapInteger(FCurrent.y,y);
        end;

        k:=dy/dx;
        yt:=Current.y;
        xs:=Current.x+1;

        if ISolid then
        begin
          while xs<x do
          begin
            yt:=yt+k;
            tmpYt:=Floor(yt);

            dist:=yt-tmpYt;
            oneDist:=1-dist;

            BlendColor1(xs, tmpYt);
            BlendColor2(xs, tmpYt+1);

            Inc(xs);
          end;
        end
        else
        begin
          while xs<x do
          begin
            yt:=yt+k;

            if tmpDots[xs mod 8] then
            begin
              tmpYt:=Floor(yt);

              dist:=yt-tmpYt;
              oneDist:=1-dist;

              BlendColor1(xs, tmpYt);
              BlendColor2(xs, tmpYt+1);
            end;

            Inc(xs);
          end;
        end;
      end
      else
      begin
        if dy < 0 then
        begin
          SwapInteger(FCurrent.x,x);
          SwapInteger(FCurrent.y,y);
        end;

        k:=dx/dy;
        xt:=Current.x;
        ys:=Current.y+1;

        if ISolid then
        begin
          while ys<y do
          begin
            xt:=xt+k;
            tmpXt:=Floor(xt);

            dist:=xt-tmpXt;
            oneDist:=1-dist;

            BlendColor1(tmpXt,ys);
            BlendColor2(tmpXt+1, ys);

            Inc(ys);
          end;
        end
        else
        begin
          while ys<y do
          begin
            xt:=xt+k;

            if tmpDots[ys mod 8] then
            begin
              tmpXt:=Floor(xt);

              dist:=xt-tmpXt;
              oneDist:=1-dist;

              BlendColor1(tmpXt,ys);
              BlendColor2(tmpXt+1, ys);
            end;

            Inc(ys);
          end;
        end;
      end;

      SetPixel(x,y,IPenColor);
    end;

    MoveTo(tmpX,tmpY);
  end;
end;

procedure TAntiAliasCanvas.MoveTo(X,Y:Integer);
begin
  FCurrent.X:=X;
  FCurrent.Y:=Y;
  inherited;
end;

procedure TAntiAliasCanvas.Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
var midX,
    midY : Integer;
    OldColor : TColor;
    OldStyle : TPenStyle;
    tmp : Boolean;
begin
  if not IAlias then
     inherited
  else
  begin
    midX:=(x1+x2) div 2;
    midY:=(y1+y2) div 2;

    IPenColor:=ColorToRGB(Pen.Color);
    
    OldColor:=IPenColor;
    OldStyle:=IPenStyle;

    tmp:=Pen.Style=psSolid;

    if tmp then
       Pen.Style:=psClear
    else
    begin
      IPenColor:=Brush.Color;
      tmp:=Brush.Style<>bsClear;
    end;

    inherited;

    if tmp then
    begin
      Pen.Style:=psSolid;

      Arc(x1,y1,x2,y2,x3,y3,x4,y4);
      Line(midX,midY,X3,Y3);
      Line(midX,midY,X4,Y4);
    end;

    IPenColor:=OldColor;
    Pen.Style:=OldStyle;
  end;
end;

procedure TAntiAliasCanvas.Polygon(const Points: array of TPoint);
var tmp : Boolean;
    l,t : Integer;
    OldColor : TColor;
    OldStyle : TPenStyle;
begin
  if not IAlias then
     inherited
  else
  begin
    if IPenWidth=1 then
       IPenColor:=ColorToRGB(Pen.Color);

    OldColor:=IPenColor;
    OldStyle:=IPenStyle;

    tmp:=Pen.Style<>psClear;

    if tmp then
       Pen.Style:=psClear
    else
    begin
      IPenColor:=Brush.Color;
      tmp:=Brush.Style<>bsClear;
    end;

    inherited;

    if tmp then
    begin
      Pen.Style:=OldStyle;
      Pen.Color:=IPenColor;

      l:=Length(Points);

      if l>0 then
      begin
        MoveTo(Points[0]);

        if l>1 then
        begin
          for t:=1 to l-1 do
              LineTo(Points[t]);

          LineTo(Points[0]);
        end;
      end;

      Pen.Color:=OldColor;
    end;

    IPenColor:=OldColor;
    Pen.Style:=OldStyle;
  end;
end;

procedure TAntiAliasCanvas.PolygonFour;
begin
  Polygon(IPoints);
end;

Procedure TAntiAliasCanvas.Polyline(const Points:{$IFDEF D5}Array of TPoint{$ELSE}TPointArray{$ENDIF});
var l,t : Integer;
begin
  if not IAlias then
     inherited
  else
  begin
    l:=Length(Points);

    if l>0 then
    begin
      MoveTo(Points[0]);

      if l>1 then
      for t:=1 to l-1 do
          LineTo(Points[t]);
    end;
  end;
end;

procedure TAntiAliasCanvas.RoundRect(X1,Y1,X2,Y2,X3,Y3:Integer);
var dx,dy,
    offX,offY : Integer;
    OldColor : TColor;
    OldStyle : TPenStyle;
    tmp : Boolean;
begin
  if not IAlias then
     inherited
  else
  begin
    IPenColor:=ColorToRGB(Pen.Color);

    OldColor:=IPenColor;
    OldStyle:=IPenStyle;

    tmp:=IPenStyle<>psClear;

    if tmp then
       Pen.Style:=psClear
    else
    begin
      IPenColor:=Brush.Color;
      tmp:=Brush.Style<>bsClear;
    end;

    inherited;

    if tmp then
    begin
      Pen.Style:=OldStyle;
      //Pen.Width:=IPenWidth;

      Dec(x2);
      Dec(y2);

      dx := (x2 - x1);
      dy := (y2 - y1);
      offX := X3 div 2;
      X3 := offX * 2;
      offY := Y3 div 2;
      Y3 := offY * 2;

      if (X3> Abs(dx)) or (Y3 > Abs(dy)) then
          Ellipse(x1, y1, x2, y2)
      else
      begin
        Line(x1+offX, y1, x2-offX, y1);
        Arc(x2-X3, y1, x2, y1+Y3, 270, 360);
        Line(x2, y1+offY, x2, y2-offY);
        Arc(x2-X3, y2-Y3, x2, y2, 0, 90);
        Line(x2-offX, y2, x1+offX, y2);
        Arc(x1, y2-Y3, x1+X3, y2, 90, 180);
        Line(x1, y2-offY, x1, y1+offY);
        Arc(x1, y1, x1+X3, y1+Y3, 180, 270);
      end;
    end;

    IPenColor:=OldColor;
    Pen.Style:=OldStyle;
  end;
end;

initialization
  TeeAntiAliasCanvas:=TAntiAliasCanvas;

  RegisterTeeTools([TAntiAliasTool]);
  RegisterClass(TAntiAliasEditor);
finalization
  TeeAntiAliasCanvas:=nil;

  UnRegisterTeeTools([TAntiAliasTool]);
end.