teegdiplus.pas

BCB第三方组件

{******************************************}
{   Base types and Procedures              }
{ Copyright (c) 1995-2007 by David Berneda }
{        All Rights Reserved               }
{******************************************}
unit TeeGDIPlus;
{$I TeeDefs.inc}

// Runtime GDI+ Plus from Microsoft at:
//
//    http://www.microsoft.com/downloads/release.asp?releaseid=32738

interface

uses
  {$IFNDEF LINUX}
  Windows,
  Classes,
  {$ENDIF}
  {$IFDEF D6}
  Types,
  {$ENDIF}
  Graphics,
  {$IFDEF CLR}
  System.Drawing,
  {$ELSE}
  GDIPAPI,
  GDIPOBJ,
  {$ENDIF}
  TeCanvas;

type
  TGDIPlusCanvas=class(TTeeCanvas3D)
  private
    FGraphics : {$IFDEF CLR}System.Drawing.Graphics{$ELSE}TGPGraphics{$ENDIF};
    FGPFont   : {$IFDEF CLR}System.Drawing.Font{$ELSE}TGPFont{$ENDIF};
    FGPPen    : {$IFDEF CLR}System.Drawing.Pen{$ELSE}TGPPen{$ENDIF};
    FGPBrush  : {$IFDEF CLR}System.Drawing.SolidBrush{$ELSE}TGPBrush{$ENDIF};

    FX,FY,FZ : Integer;
    FAnti: Boolean;
    FAntiText: Boolean;

    IPenCap      : TPenEndStyle;
    IPenColor    : TColor;
    IPenSmallDot : Boolean;
    IPenWidth    : Integer;

    procedure CalcArcAngles(X1,Y1,X2,Y2,X3,Y3,X4,Y4:Integer;
                            out StartAngle:Single; out EndAngle:Single);
    function GBrush:{$IFDEF CLR}System.Drawing.SolidBrush{$ELSE}TGPBrush{$ENDIF};
    function GPen:{$IFDEF CLR}System.Drawing.Pen{$ELSE}TGPPen{$ENDIF};
    function GDIPColor(Color:TColor):TColor;
    procedure SetAnti(const Value: Boolean);
    procedure SetAntiText(const Value: Boolean);
  protected
    procedure SetPixel(X, Y: Integer; Value: TColor); override;
    procedure SetPixel3D(X, Y, Z: Integer; Value: TColor); override;
  public
    { public }
    Transparency : Byte;

    Constructor Create;
    Destructor Destroy; override;

    Function InitWindow( DestCanvas:TCanvas;
                         A3DOptions:TView3DOptions;
                         ABackColor:TColor;
                         Is3D:Boolean;
                         Const UserRect:TRect):TRect; override;

    Function ReDrawBitmap:Boolean; override;

    Function BeginBlending(const R:TRect; Transparency:TTeeTransparency):TTeeBlend; override;
    procedure EndBlending(Blend:TTeeBlend); override;

    procedure Arc(const Left, Top, Right, Bottom, StartX, StartY, EndX, EndY: Integer); override;
    procedure AssignVisiblePenColor(APen:TPen; AColor:TColor); override;
    Procedure ClipEllipse(Const Rect:TRect; Inverted:Boolean=False); override;
    Procedure ClipPolygon(const Points:Array of TPoint; NumPoints:Integer;
                          DiffRegion:Boolean=False); override;
    procedure ClipRectangle(Const Rect:TRect); override;
    procedure ClipRectangle(Const Rect:TRect; RoundSize:Integer); override;
    procedure DoHorizLine(X0,X1,Y:Integer); override;
    procedure Donut( XCenter,YCenter,XRadius,YRadius:Integer;
                     Const StartAngle,EndAngle,HolePercent:Double); override;
    procedure DoVertLine(X,Y0,Y1:Integer); override;
    procedure Ellipse(X1, Y1, X2, Y2: Integer); override;
    procedure FillRect(const Rect: TRect); override;
    Procedure Line(X0,Y0,X1,Y1:Integer); override;
    procedure LineTo(X,Y:Integer); override;
    procedure LineTo3D(X,Y,Z:Integer); override;
    procedure MoveTo(X,Y:Integer); override;
    procedure MoveTo3D(X,Y,Z:Integer); override;
    procedure Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); override;
    procedure Polygon(const Points:Array of TPoint); override;
    {$IFDEF D5}
    Procedure Polyline(const Points:Array of TPoint); override;
    {$ENDIF}
    procedure Rectangle(X0,Y0,X1,Y1:Integer); override;
    procedure RoundRect(X1,Y1,X2,Y2,X3,Y3:Integer); override;
    procedure TextOut(X,Y:Integer; const Text:String); override;
    Procedure HorizLine3D(Left,Right,Y,Z:Integer); override;
    Procedure LineWithZ(X0,Y0,X1,Y1,Z:Integer); override;
    procedure UnClipRectangle; override;
    Procedure VertLine3D(X,Top,Bottom,Z:Integer); override;
    Procedure ZLine3D(X,Y,Z0,Z1:Integer); override;

    // published
    property AntiAlias:Boolean read FAnti write SetAnti default False;
    property AntiAliasText:Boolean read FAntiText write SetAntiText default False;
  end;

  {$IFDEF CLR}
  ChartPenHelper=class helper for TChartPen
  private
    FTransp: TTeeTransparency;
    procedure SetTransp(const Value: TTeeTransparency); for TChartPen
  published
    property Transparency:TTeeTransparency read FTransp write SetTransp default 0;
  end;
  {$ENDIF}

implementation

uses
  Math,
  SysUtils;

{ TGDIPlusCanvas }
Constructor TGDIPlusCanvas.Create;
begin
  inherited;
  Transparency:=255;
  FGPPen:={$IFDEF CLR}System.Drawing.Pen.Create(Colors.Black){$ELSE}TGPPen.Create(clBlack){$ENDIF};
end;

Destructor TGDIPlusCanvas.Destroy;
begin
  FGPPen.Free;
  FGPBrush.Free;
  FGPFont.Free;
  FGraphics.Free;
  inherited;
end;

Function TGDIPlusCanvas.BeginBlending(const R:TRect; Transparency:TTeeTransparency):TTeeBlend;
begin
  Self.Transparency:=Round((100-Transparency)*2.55);
  result:=nil;
end;

procedure TGDIPlusCanvas.EndBlending(Blend:TTeeBlend);
begin
  Transparency:=255;
end;

Function TGDIPlusCanvas.InitWindow( DestCanvas:TCanvas;
                     A3DOptions:TView3DOptions;
                     ABackColor:TColor;
                     Is3D:Boolean;
                     Const UserRect:TRect):TRect;
var Status : TStatus;
begin
 result:=inherited InitWindow(DestCanvas,A3DOptions,ABackColor,Is3D,UserRect);
 FX:=0;
 FY:=0;
 FZ:=0;

 FreeAndNil(FGraphics);

 if not Assigned(FGraphics) then
 begin
   Bitmap.PixelFormat:=pf24Bit;

   FGraphics:={$IFDEF CLR}System.Drawing.Graphics.Create{$ELSE}TGPGraphics.Create(Handle){$ENDIF};

   if FAnti then
      FGraphics.SetSmoothingMode(QualityModeHigh);

   if FAntiText then
      FGraphics.SetTextRenderingHint(TextRenderingHintAntiAlias);

   Status:=FGraphics.GetLastStatus;
   if Status<>Ok then
      Raise Exception.Create(IntToStr(Ord(Status)));
 end;
end;

Function TGDIPlusCanvas.ReDrawBitmap:Boolean;
begin
  result:=inherited ReDrawBitmap;
end;

function TGDIPlusCanvas.GDIPColor(Color:TColor):TColor;
begin
  Color:=ColorToRGB(Color);
  result := ( Byte(Color shr 16) or
             (DWORD(Byte(Color shr 8)) shl GreenShift) or
             (DWORD(Byte(Color)) shl RedShift) or
             (DWORD(Transparency) shl AlphaShift));
end;

function TGDIPlusCanvas.GBrush:TGPBrush;

  function GetHatchStyle:HatchStyle;
  begin
    case Brush.Style of
      bsHorizontal: result:=HatchStyleHorizontal;
      bsVertical: result:=HatchStyleVertical;
      bsFDiagonal: result:=HatchStyleForwardDiagonal;
      bsBDiagonal: result:=HatchStyleBackwardDiagonal;
      bsCross: result:=HatchStyleCross;
    else
      {bsDiagCross:} result:=HatchStyleDiagonalCross;
    end;
  end;

begin
  FGPBrush.Free;
  if Brush.Style=bsSolid then
     FGPBrush:=TGPSolidBrush.Create(GDIPColor(Brush.Color))
  else
     FGPBrush:=TGPHatchBrush.Create(GetHatchStyle,GDIPColor(Brush.Color),GDIPColor(BackColor));

  result:=FGPBrush;
end;

function TGDIPlusCanvas.GPen:TGPPen;
begin
  with FGPPen do
  begin
    SetWidth(IPenWidth);

    if IPenSmallDot then
    begin
      SetColor(GDIPColor(IPenColor {$IFDEF CLR},Pen.Transparency{$ENDIF}));
      SetDashStyle(DashStyleDot);
    end
    else
    begin
      SetColor(GDIPColor(Pen.Color {$IFDEF CLR},Pen.Transparency{$ENDIF}));

      case Pen.Style of
        psSolid: SetDashStyle(DashStyleSolid);
        psDash: SetDashStyle(DashStyleDash);
        psDot: SetDashStyle(DashStyleDot);
        psDashDot: SetDashStyle(DashStyleDashDot);
        psDashDotDot: SetDashStyle(DashStyleDashDotDot);
      end;
    end;

    case IPenCap of
      esRound  : SetLineCap(LineCapRound, LineCapRound, LineCapRound);
      esSquare : SetLineCap(LineCapSquare, LineCapSquare, LineCapSquare);
    else
      SetLineCap(LineCapFlat, LineCapFlat, LineCapFlat);
    end;

    SetLineJoin(LineJoinBevel);
  end;

  // GdipSetPenDashArray

  result:=FGPPen;
end;

Procedure TGDIPlusCanvas.ClipEllipse(Const Rect:TRect; Inverted:Boolean=False);
var p : TGPGraphicsPath;
begin
  p:=TGPGraphicsPath.Create;
  try
    p.AddEllipse(MakeRect(Rect));
    FGraphics.SetClip(p);
  finally
    p.Free;
  end;

  inherited;
end;

Procedure TGDIPlusCanvas.ClipPolygon(const Points:Array of TPoint; NumPoints:Integer;
                                     DiffRegion:Boolean=False);
var Region : HRgn;
    r : TGPRegion;
begin
  Region:=CreatePolygonRgn(Points,NumPoints,ALTERNATE);

  r:=TGPRegion.Create(Region);
  try
    if DiffRegion then
       FGraphics.SetClip(r,CombineModeExclude)
    else
       FGraphics.SetClip(r);

  finally
    DeleteObject(Region);
    r.Free;
  end;

  inherited;
end;

procedure TGDIPlusCanvas.ClipRectangle(Const Rect:TRect);
begin
  FGraphics.SetClip(MakeRect(Rect));
end;

Procedure TGDIPlusCanvas.ClipRectangle(Const Rect:TRect; RoundSize:Integer);
begin
  ClipRectangle(Rect); // Pending!
  inherited ClipRectangle(Rect,RoundSize);
end;

Procedure TGDIPlusCanvas.DoHorizLine(X0,X1,Y:Integer);
begin
  FGraphics.DrawLine(GPen,X0,Y,X1,Y);
end;

Procedure TGDIPlusCanvas.DoVertLine(X,Y0,Y1:Integer);
begin
  FGraphics.DrawLine(GPen,X,Y0,X,Y1);
end;

procedure TGDIPlusCanvas.AssignVisiblePenColor(APen:TPen; AColor:TColor);
begin
  inherited;
  IPenColor:=AColor;

  if APen is TChartPen then
  begin
    IPenSmallDot:=TChartPen(APen).SmallDots;
    IPenCap:=TChartPen(APen).EndStyle;
  end
  else
  begin
    IPenSmallDot:=False;
    IPenCap:=esRound;
  end;

  IPenWidth:=APen.Width;
end;

procedure TGDIPlusCanvas.CalcArcAngles(X1,Y1,X2,Y2,X3,Y3,X4,Y4:Integer;
                                       out StartAngle:Single; out EndAngle:Single);
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;