teeantialias.pas

BCB第三方组件

{**********************************************}
{   TAntiAliasTool and Editor                  }
{   Copyright (c) 2006-2007 by David Berneda   }
{**********************************************}
unit TeeAntiAlias;
{$I TeeDefs.inc}

interface

uses
  {$IFNDEF LINUX}
  Windows, Messages,
  {$ENDIF}
  SysUtils, Classes,
  {$IFDEF CLX}
  QGraphics, QControls, QForms, QDialogs, QStdCtrls, QExtCtrls, QButtons,
  {$ELSE}
  Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, Buttons,
  {$ENDIF}
  TeeFilters, TeEngine, Chart, TeCanvas;

type
  TAntiAliasTool=class;

  TAntiAlias=(aaYes, aaNo);

  TPenDots=Array[0..7] of Boolean;

  TAntiAliasCanvas=class(TTeeCanvas3D)
  private
    FAlias   : TAntiAlias;
    FCurrent : TPoint;

    IAlias   : Boolean;
    r,g,b    : Byte;
    dist     : Single;
    oneDist  : Single;
    IFilter  : TTeeFilter;
    IDC      : TTeeCanvasHandle;
    ITool    : TAntiAliasTool;

    IPenColor    : TColor;
    IPenSmallDot : Boolean;
    IPenStyle    : TPenStyle;
    IPenWidth    : Integer;

    procedure BlendColor1(const AX,AY:Integer);
    procedure BlendColor2(const AX,AY:Integer);
    procedure CalcArcAngles(X1,Y1,X2,Y2,X3,Y3,X4,Y4:Integer;
                            out StartAngle:Double; out EndAngle:Double);
    procedure GetPenDots(out Dots:TPenDots; out Solid:Boolean);
    procedure SetAntiAlias(const Value:TAntiAlias);
  protected
    Procedure PolygonFour; override;
  public
    Destructor Destroy; override;

    procedure Arc(const Left, Top, Right, Bottom, StartX, StartY, EndX, EndY: Integer); override;
    procedure Arc(const Left, Top, Right, Bottom:Integer; StartAngle,EndAngle:Double); override;
    procedure AssignVisiblePenColor(APen:TPen; AColor:TColor); override;
    procedure Donut( XCenter,YCenter,XRadius,YRadius:Integer;
                     Const StartAngle,EndAngle,HolePercent:Double); override;
    procedure Ellipse(X1, Y1, X2, Y2: Integer); override;
    Procedure GradientFill( Const Rect : TRect; StartColor : TColor;
                            EndColor   : TColor; Direction  : TGradientDirection;
                            Balance    : Integer=50); override;
    Function InitWindow( DestCanvas:TCanvas; A3DOptions:TView3DOptions;
                         ABackColor:TColor;
                         Is3D:Boolean;
                         Const UserRect:TRect):TRect; override;
    procedure LineTo(X,Y:Integer); override;
    procedure MoveTo(X,Y:Integer); override;
    procedure Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); override;
    Procedure Polygon(const Points:Array of TPoint); override;
    Procedure Polyline(const Points:{$IFDEF D5}Array of TPoint{$ELSE}TPointArray{$ENDIF}); override;
    procedure RoundRect(X1,Y1,X2,Y2,X3,Y3:Integer); override;

    property AntiAlias:TAntiAlias read FAlias write SetAntiAlias default aaYes;
    property Current:TPoint read FCurrent write FCurrent;
  end;

  TAntiAliasTool=class(TTeeCustomTool)
  private
    FCanvas  : TAntiAliasCanvas;
    FFilters : TFilterItems;

    procedure CheckParentCanvas;
    function FiltersStored:Boolean;
    function GetAntiAlias:Boolean;
    procedure ReadFilters(Reader: TReader);
    procedure SetFilters(Const Value:TFilterItems);
    procedure SetAntiAlias(Const Value:Boolean);
    procedure WriteFilters(Writer: TWriter);
  protected
    procedure ChartEvent(AEvent: TChartToolEvent); override;
    procedure DefineProperties(Filer:TFiler); override;
    class function GetEditorClass: String; override;
    procedure SetActive(Value:Boolean); override;
    procedure SetParentChart(const Value: TCustomAxisPanel); override;
  public
    Constructor Create(AOwner:TComponent); override;
    Destructor Destroy; override;

    function Bitmap:TBitmap;
    class Function Description:String; override;
    class Function LongDescription:String; override;

    property Canvas:TAntiAliasCanvas read FCanvas;
  published
    property Active;
    property AntiAlias:Boolean read GetAntiAlias write SetAntiAlias default True;
    property Filters:TFilterItems read FFilters write SetFilters stored False;
  end;

  TAntiAliasEditor = class(TForm)
    Button1: TButton;
    CBAnti: TCheckBox;
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure CBAntiClick(Sender: TObject);
  private
    { Private declarations }
    Tool : TAntiAliasTool;
  public
    { Public declarations }
  end;

implementation

{$IFNDEF CLX}
{$IFNDEF LCL}
{$R *.DFM}
{$ENDIF}
{$ELSE}
{$R *.xfm}
{$ENDIF}

uses
  Math, TeeFiltersEditor, TeeProcs, TeeProCo;

const
  Small      : TPenDots=(True,False,True,False,True,False,True,False);
  Dot        : TPenDots=(True,True,False,False,True,True,False,False);
  Dash       : TPenDots=(True,True,True,False,True,True,True,False);
  DashDot    : TPenDots=(True,True,True,False,True,False,True,False);
  DashDotDot : TPenDots=(True,True,True,False,True,False,True,False);

procedure TAntiAliasEditor.Button1Click(Sender: TObject);
begin
  if ShowFiltersEditor(Self,Tool.Bitmap,Tool.Filters) then
     Tool.Repaint;
end;

procedure TAntiAliasEditor.FormShow(Sender: TObject);
begin
  Tool:=TAntiAliasTool(Tag);

  if Assigned(Tool) then
     CBAnti.Checked:=Tool.AntiAlias;
end;

procedure TAntiAliasEditor.CBAntiClick(Sender: TObject);
begin
  if Assigned(Tool) then
     Tool.AntiAlias:=CBAnti.Checked;
end;

{ TAntiAliasTool }

Constructor TAntiAliasTool.Create(AOwner: TComponent);
begin
  inherited;
  FFilters:=TFilterItems.Create(Self,TTeeFilter);
  AntiAlias:=True;
end;

Destructor TAntiAliasTool.Destroy;
begin
  if Assigned(FCanvas) then
  begin
    if Assigned(ParentChart) and (ParentChart.Canvas=FCanvas) then
    begin
      FCanvas.ITool:=nil;
      FCanvas:=nil;
    end
    else
       FreeAndNil(FCanvas);
  end;

  FFilters.Free;
  inherited;
end;

procedure TAntiAliasTool.ChartEvent(AEvent: TChartToolEvent);
begin
  inherited;

  if (AEvent=cteAfterDraw) and (Filters.Count>0) and (Bitmap<>nil) then
     Filters.ApplyTo(Bitmap);
end;

function TAntiAliasTool.Bitmap:TBitmap;
begin
  if Assigned(ParentChart) and (ParentChart.Canvas is TTeeCanvas3D) then
     result:=TTeeCanvas3D(ParentChart.Canvas).Bitmap
  else
     result:=nil;
end;

procedure TAntiAliasTool.DefineProperties(Filer: TFiler);
begin
  inherited;
  Filer.DefineProperty('FilterItems',ReadFilters,WriteFilters,FiltersStored); // Do not localize
end;

function TAntiAliasTool.FiltersStored:Boolean;
begin
  result:=Assigned(FFilters) and (FFilters.Count>0);
end;

function TAntiAliasTool.GetAntiAlias:Boolean;
begin
  result:=Assigned(FCanvas) and (FCanvas.AntiAlias=aaYes);
end;

procedure TAntiAliasTool.ReadFilters(Reader: TReader);
begin
  TTeePicture.ReadFilters(Reader,Filters);
end;

procedure TAntiAliasTool.SetAntiAlias(Const Value:Boolean);
begin
  if not Assigned(FCanvas) then
  begin
    FCanvas:=TAntiAliasCanvas.Create;
    FCanvas.ITool:=Self;
  end;

  if Value then
     FCanvas.AntiAlias:=aaYes
  else
     FCanvas.AntiAlias:=aaNo;

  CheckParentCanvas;
end;

procedure TAntiAliasTool.SetFilters(const Value: TFilterItems);
begin
  FFilters.Assign(Value);
end;

procedure TAntiAliasTool.WriteFilters(Writer: TWriter);
begin
  TTeePicture.WriteFilters(Writer,Filters);
end;

class function TAntiAliasTool.Description: String;
begin
  result:=TeeMsg_AntiAlias;
end;

class function TAntiAliasTool.LongDescription: String;
begin
  result:=TeeMsg_AntiAliasDesc;
end;

class function TAntiAliasTool.GetEditorClass: String;
begin
  result:='TAntiAliasEditor'; // Do not localize
end;

procedure TAntiAliasTool.SetActive(Value:Boolean);
begin
  inherited;
  SetAntiAlias(Active);
end;

procedure TAntiAliasTool.SetParentChart(const Value: TCustomAxisPanel);
begin
  inherited;
  CheckParentCanvas;
end;

procedure TAntiAliasTool.CheckParentCanvas;
begin
  if Active and AntiAlias and Assigned(ParentChart) and
     (ParentChart.Canvas<>FCanvas) then
        ParentChart.Canvas:=FCanvas;
end;

{ TAntiAliasCanvas }

Destructor TAntiAliasCanvas.Destroy;
begin
  if Assigned(ITool) and (ITool.FCanvas=Self) then
     ITool.FCanvas:=nil;

  IFilter.Free;
  inherited;
end;

procedure TAntiAliasCanvas.GetPenDots(out Dots:TPenDots; out Solid:Boolean);
begin
    if IPenSmallDot then
       Dots:=Small
    else
    case Pen.Style of
      psSolid: Solid:=True;
        psDot: Dots:=Dot;
       psDash: Dots:=Dash;
    psDashDot: Dots:=DashDot;
 psDashDotDot: Dots:=DashDotDot;
    end;
end;

procedure TAntiAliasCanvas.CalcArcAngles(X1,Y1,X2,Y2,X3,Y3,X4,Y4:Integer;
                                out StartAngle:Double; out EndAngle:Double);
const
  HalfDivPi=180.0/Pi;
var
  XC,YC : Integer;
begin
  XC := (X2+X1) div 2;
  YC := (Y2+Y1) div 2;

  StartAngle:=ArcTan2(YC-Y3,X3-XC);
  if StartAngle<0 then
     StartAngle:=StartAngle+2.0*Pi;

  StartAngle:=StartAngle*HalfDivPi;

  EndAngle:=ArcTan2(YC-Y4,X4-XC);
  if EndAngle<0 then
     EndAngle:=EndAngle+2.0*Pi;

  EndAngle:=EndAngle*HalfDivPi;
end;

procedure TAntiAliasCanvas.Arc(const Left,Top,Right,Bottom:Integer; StartAngle,EndAngle:Double);
var midX,midY,
    oldX,oldY,
    xs,ys,
    dx,dy : Integer;
    deltaX,
    deltaY,
    startX,
    endX,
    startY,
    endY,
    tmpXt,
    tmpYt,
    radiusX,
    radiusY : Integer;
    sx,sy,
    xt,yt,
    angle,
    eAngle : Double;
    bgColor : TRGB;
    tmpDots : TPenDots;
    ISolid  : Boolean;
    tmpDir  : Boolean;
begin
  if not IAlias then
     inherited Arc(Left,Top,Right,Bottom,StartAngle,EndAngle)
  else
  begin
    {$IFDEF CLX}
    tmpDir:=True;
    {$ELSE}
    tmpDir:=GetArcDirection(Handle)=AD_CLOCKWISE;
    {$ENDIF}

    if not tmpDir then
    begin
//      SwapDouble(StartAngle,EndAngle);
    end;

    midX := (Left + Right) div 2;
    midY := (Top + Bottom) div 2;
    dx := (Right-Left);
    dy := (Bottom-Top);
    radiusX := Abs(dx) div 2;
    radiusY := Abs(dy) div 2;

    IPenColor:=ColorToRGB(Pen.Color);

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

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

    Angle:=0;

    while (Angle+90) < StartAngle do
          Angle:=Angle+90;

    while angle < endAngle do
    begin
      if startAngle >= angle then
      begin
        if endAngle <= angle+90 then
           eAngle := endAngle
        else
           eAngle := angle+90;

        sx:=radiusX*Cos(startAngle*TeePiStep);

        if sx > 0 then
           sx :=sx+ 0.5
        else
           sx :=sx- 0.5;

        startX:=Trunc(sx);
        endX:=Trunc(radiusX*Cos(eAngle*TeePiStep));

        if (endX - startX <> 0) then
           deltaX := Trunc((endX-startX) / Abs(endX-startX))
        else
           deltaX := 0;

        sy := radiusY*Sin(startAngle*TeePiStep);
        if sy > 0 then
           sy :=sy+ 0.5
        else
           sy :=sy- 0.5;

        startY:=Trunc(sy);
        endY:=Trunc(radiusY*Sin(eAngle*TeePiStep));

        if (endY - startY <> 0) then
           deltaY := Trunc((endY-startY) / Abs(endY-startY))
        else
           deltaY := 0;

        if deltaX <> 0 then
        begin
          oldY:=startY;
          xs:=startX;

          while xs <> endX do
          begin
            yt:= radiusY * Sqrt(1-(xs*xs)/(radiusX*radiusX));
            tmpYt:=Floor(yt);

            if Abs(oldY - tmpYt) < 2 then
            begin
              dist:=yt - tmpYt;
              oneDist:=1-dist;

              if deltaX < 0 then
                 BlendColor1(midX+xs,midY+tmpYt)
              else
                 BlendColor1(midX+xs,midY-tmpYt);

              if deltaX < 0 then
                 BlendColor2(midX+xs,midY+tmpYt+1)
              else
                 BlendColor2(midX+xs,midY-tmpYt-1);
            end;

            oldY:=tmpYt;
            Inc(xs,deltaX);
          end;
        end;

        if deltaY <> 0 then
        begin
          oldX := startX;
          ys := startY;

          while ys <> endY do
          begin
            xt:= radiusX * Sqrt(1-(ys*ys)/(radiusY*radiusY));
            tmpXt:=Floor(xt);

            if Abs(oldX - tmpXt) < 2 then
            begin
              dist:=xt - tmpXt;
              oneDist:=1-dist;

              if deltaX < 0 then
                 if deltaY > 0 then
                    BlendColor1(midX+tmpXt,midY+ys)
                 else
                    BlendColor1(midX-tmpXt,midY+ys)
              else
                 if deltaY < 0 then
                    BlendColor1(midX-tmpXt,midY+ys)
                 else
                    BlendColor1(midX+tmpXt,midY+ys);

              if deltaX < 0 then
                 if deltaY > 0 then
                    BlendColor2(midX+tmpXt+1,midY+ys)
                 else
                    BlendColor2(midX-tmpXt-1,midY+ys)
              else
                 if deltaY < 0 then
                    BlendColor2(midX-tmpXt-1,midY+ys)
                 else
                    BlendColor2(midX+tmpXt+1,midY+ys);
            end;

            oldX:=tmpXt;
            Inc(ys,deltaY);
          end;
        end;
      end;

      angle:=angle+90;
      StartAngle:=Angle;
    end;
  end;
end;

procedure TAntiAliasCanvas.Arc(const Left, Top, Right, Bottom, StartX, StartY, EndX, EndY: Integer);
var StartAngle : Double;
    EndAngle   : Double;
begin
  if not IAlias then
     inherited
  else
  begin
    CalcArcAngles(Left,Top,Right,Bottom,StartX,StartY,EndX,EndY,StartAngle,EndAngle);
    Arc(Left,Top,Right,Bottom,StartAngle,EndAngle);
  end;
end;

procedure TAntiAliasCanvas.AssignVisiblePenColor(APen:TPen; AColor:TColor);
begin
  inherited;
  IPenColor:=AColor;
  IPenSmallDot:=(APen is TChartPen) and TChartPen(APen).SmallDots;
  IPenStyle:=APen.Style;
  IPenWidth:=APen.Width;
end;

procedure TAntiAliasCanvas.Donut(XCenter, YCenter, XRadius, YRadius: Integer;
  const StartAngle, EndAngle, HolePercent: Double);

var tmpXRadius,
    tmpYRadius  : Integer;
    Old : TBrushStyle;
begin
  inherited;

  if IAlias then
  begin
    Old:=Brush.Style;
    Brush.Style:=bsClear;

    Arc(XCenter-XRadius,YCenter-YRadius,XCenter+XRadius,YCenter+YRadius,
        StartAngle*180/Pi,EndAngle*180/Pi);

    tmpXRadius:=Round(HolePercent*XRadius*0.01);
    tmpYRadius:=Round(HolePercent*YRadius*0.01);

    Arc(XCenter-tmpXRadius,YCenter-tmpYRadius,XCenter+tmpXRadius,YCenter+tmpYRadius,
        EndAngle*180/Pi,StartAngle*180/Pi);

    Brush.Style:=Old;
  end;
end;

procedure TAntiAliasCanvas.Ellipse(X1, Y1, X2, Y2: Integer);
var
  a : Boolean;

  // Bresenham ellipse algorithm
  procedure DrawEllipse(CX, CY, XRadius, YRadius, DecX, DecY : Integer);

    procedure PutPixel(x,y,OffX,OffY:Integer);
    begin
      SetPixel(x,y,IPenColor);

      dist:=0.4;
      oneDist:=1-dist;

      if not a then
      begin
        BlendColor1(x,y+OffY);
        BlendColor2(x+OffX,y);
      end
      else
      begin
        BlendColor1(x+OffX,y);
        BlendColor2(x,y+OffY);
      end;
    end;

    procedure DrawPoints(X,Y:Integer);
    begin
      PutPixel(CX+X-DecX, CY+Y-DecY, 1, 1);  // Right-bottom
      PutPixel(CX-X, CY+Y-DecY, -1, 1);  // Left-bottom
      PutPixel(CX-X, CY-Y, -1, -1);  // Left-top
      PutPixel(CX+X-DecX, CY-Y, 1, -1); // Right-top
    end;

  var X, Y : Integer;
      XChange,
      YChange : Integer;
      EllipseError : Integer;
      tmpX, tmpY: Integer;
      StoppingX,
      StoppingY : Integer;
  begin
    tmpX:= 2*XRadius*XRadius;
    tmpY:= 2*YRadius*YRadius;