1698 lines
58 KiB
Plaintext
1698 lines
58 KiB
Plaintext
(* ImageEn Build 7.0.0.06.2637 @ 7-4-17 14:58:42.679 *)
|
|
(*
|
|
Copyright (c) 1998-2017 by Carlotta Calandra. All rights reserved.
|
|
Copyright (c) 2011-2017 by Xequte Software.
|
|
|
|
This software comes without express or implied warranty.
|
|
In no case shall the author be liable for any damage or unwanted behavior of any
|
|
computer hardware and/or software.
|
|
|
|
Author grants you the right to include the component
|
|
in your application, whether COMMERCIAL, SHAREWARE, or FREEWARE.
|
|
|
|
ImageEn, IEvolution and ImageEn ActiveX may not be included in any
|
|
commercial, shareware or freeware libraries or components.
|
|
|
|
www.ImageEn.com
|
|
*)
|
|
|
|
// Note: From XE2, Delphi supports GDI+ via classes in GdipApi/GdipObj
|
|
|
|
(*
|
|
File version 1010
|
|
*)
|
|
|
|
unit iegdiplus;
|
|
|
|
{$R-}
|
|
{$Q-}
|
|
|
|
{$I ie.inc}
|
|
|
|
interface
|
|
|
|
uses Windows, Classes, sysutils, Graphics,
|
|
{$ifdef IEHASTYPES} Types, {$endif}
|
|
{$ifdef IEHASUITYPES} System.UITypes, {$endif}
|
|
hyiedefs;
|
|
|
|
type
|
|
ARGB = DWORD;
|
|
|
|
TIECanvasSmoothingMode = (iesmInvalid, // = SmoothingModeInvalid = -1
|
|
iesmDefault, // = SmoothingModeDefault = 0
|
|
iesmBestPerformance, // = SmoothingModeHighSpeed = 1
|
|
iesmBestRenderingQuality, // = SmoothingModeHighQuality = 2
|
|
iesmNone, // = SmoothingModeNone = 3;
|
|
iesmAntialias); // = SmoothingModeAntiAlias = 4;
|
|
|
|
TIETextRenderingHintMode = (ietrTextRenderingHintSystemDefault, // = 0;
|
|
ietrTextRenderingHintSingleBitPerPixelGridFit, // = 1;
|
|
ietrTextRenderingHintSingleBitPerPixel, // = 2;
|
|
ietrTextRenderingHintAntiAliasGridFit, // = 3;
|
|
ietrTextRenderingHintAntiAlias, // = 4;
|
|
ietrTextRenderingHintClearTypeGridFit ); // = 5;
|
|
|
|
|
|
TIECanvasPenLineJoin = (ieljMiter, ieljBevel, ieljRound, ieljMiterClipped);
|
|
|
|
TIECanvasCompositingQuality = (ieCompositingQualityDefault, ieCompositingQualityHighSpeed, ieCompositingQualityHighQuality, ieCompositingQualityGammaCorrected, ieCompositingQualityAssumeLinear);
|
|
|
|
TIECanvasCompositingMode = (ieCompositingModeSourceOver, ieCompositingModeSourceCopy);
|
|
|
|
|
|
// values of TIEMetafileHeader.Type_
|
|
const IEMetafileTypeInvalid = 0;
|
|
const IEMetafileTypeWmf = 1;
|
|
const IEMetafileTypeWmfPlaceable = 2;
|
|
const IEMetafileTypeEmf = 3;
|
|
const IEMetafileTypeEmfPlusOnly = 4;
|
|
const IEMetafileTypeEmfPlusDual = 5;
|
|
|
|
|
|
type TIEMetafileHeader = packed record
|
|
Type_: DWORD;
|
|
Size: DWORD;
|
|
Version: DWORD;
|
|
EmfPlusFlags: DWORD;
|
|
DpiX: single;
|
|
DpiY: single;
|
|
X: integer;
|
|
Y: integer;
|
|
Width: integer;
|
|
Height: integer;
|
|
Header: TEnhMetaHeader;
|
|
end;
|
|
|
|
|
|
TIEMetafile = class
|
|
private
|
|
fHandle: pointer;
|
|
fHeader: TIEMetafileHeader;
|
|
procedure FillHeader();
|
|
function GetWidth(): integer;
|
|
function GetHeight(): integer;
|
|
|
|
public
|
|
constructor Create(const Filename: WideString); overload;
|
|
constructor Create(Stream: TStream); overload;
|
|
destructor Destroy; override;
|
|
property Handle: pointer read fHandle;
|
|
property Width: integer read GetWidth;
|
|
property Height: integer read GetHeight;
|
|
function IsWmf(): boolean;
|
|
function IsEmf(): boolean;
|
|
function IsEmfPlus(): boolean;
|
|
function IsEmfPlusDual(): boolean;
|
|
end;
|
|
|
|
|
|
// GDI+ Pen wrapper and VCL TPen wrapper
|
|
TIEPen = class
|
|
private
|
|
fGHandle: pointer; // gdi+ handle
|
|
fPen: TPen; // VCL object
|
|
fColor: TColor;
|
|
fTransparency: integer;
|
|
fWidth: single;
|
|
fStyle: TPenStyle;
|
|
fMode: TPenMode;
|
|
fLineJoin: TIECanvasPenLineJoin;
|
|
procedure ReCreatePen;
|
|
procedure SetWidth(value: single);
|
|
procedure SetTColor(value: TColor);
|
|
procedure SetTransparency(value: integer);
|
|
procedure SetStyle(value: TPenStyle);
|
|
function GetARGBColor(): ARGB;
|
|
procedure SetMode(value: TPenMode);
|
|
procedure SetVHandle(value: HPen);
|
|
function GetVHandle: HPen;
|
|
procedure SetLineJoin(value: TIECanvasPenLineJoin);
|
|
|
|
public
|
|
constructor Create(Pen: TPen);
|
|
destructor Destroy; override;
|
|
property Width: single read fWidth write SetWidth;
|
|
property Color: TColor read fColor write SetTColor;
|
|
property Transparency: integer read fTransparency write SetTransparency;
|
|
property Style: TPenStyle read fStyle write SetStyle;
|
|
property Mode: TPenMode read fMode write SetMode; // not available under GDI+
|
|
property Handle: HPen read GetVHandle write SetVHandle; // VCL TPen handle
|
|
property LineJoin: TIECanvasPenLineJoin read fLineJoin write SetLineJoin;
|
|
end;
|
|
|
|
// GDI+ Brush wrapper and VCL TBrush wrapper
|
|
TIEBrush = class
|
|
private
|
|
fGHandle: pointer; // gdi+ handle
|
|
fBrush: TBrush; // VCL object
|
|
fColor: TColor;
|
|
fTransparency: integer;
|
|
fBackColor: TColor;
|
|
fBackTransparency: integer;
|
|
fStyle: TBrushStyle;
|
|
procedure ReCreateBrush;
|
|
function GetBitmap: TBitmap;
|
|
procedure SetBitmap(value: TBitmap);
|
|
procedure SetTColor(value: TColor);
|
|
procedure SetBackTColor(value: TColor);
|
|
procedure SetTransparency(value: integer);
|
|
procedure SetBackTransparency(value: integer);
|
|
procedure SetStyle(value: TBrushStyle);
|
|
function GetARGBColor(): ARGB;
|
|
|
|
public
|
|
constructor Create(Brush: TBrush);
|
|
destructor Destroy; override;
|
|
property Bitmap: TBitmap read GetBitmap write SetBitmap; // not implemented in GDI+
|
|
property Color: TColor read fColor write SetTColor;
|
|
property BackColor: TColor read fBackColor write SetBackTColor;
|
|
property Transparency: integer read fTransparency write SetTransparency;
|
|
property BackTransparency: integer read fBackTransparency write SetBackTransparency;
|
|
property Style: TBrushStyle read fStyle write SetStyle;
|
|
end;
|
|
|
|
{!!
|
|
<FS>TIECanvas
|
|
|
|
<FM>Description<FN>
|
|
TIECanvas is a GDI+ Graphics wrapper and VCL TCanvas wrapper.
|
|
!!}
|
|
TIECanvas = class
|
|
private
|
|
fSmoothingMode: TIECanvasSmoothingMode;
|
|
fTextRendering: TIETextRenderingHintMode;
|
|
fCanvasHandle: Integer;
|
|
fSavedDC: Integer;
|
|
procedure SetSmoothingMode(value: TIECanvasSmoothingMode);
|
|
procedure SetTextRendering(value: TIETextRenderingHintMode);
|
|
procedure SetPenPos(value: TPoint);
|
|
function GetHandle: HDC;
|
|
function GetFont: TFont;
|
|
procedure DrawTextEx(Text: WideString; X, Y, Width, Height: Integer; Typographic: Boolean; MeasureOnly: Boolean; out TextSize: TSize);
|
|
procedure DrawTextEx2(Text: WideString; X, Y, Width, Height: Integer; Typographic: Boolean; Angle: Integer);
|
|
|
|
protected
|
|
fGraphics: pointer;
|
|
fCanvas: TCanvas;
|
|
fPen: TIEPen;
|
|
fPenPos: TPoint;
|
|
fBrush: TIEBrush;
|
|
fUseGDIPlus: boolean;
|
|
fImage: pointer;
|
|
fOnDestroy: TNotifyEvent;
|
|
fROIBitmap: TObject; // must be a TIEBitmap
|
|
|
|
public
|
|
|
|
constructor Create(Canvas: TCanvas; AntiAlias: boolean = true; UseGDIPlus: boolean = true; Bitmap: TBitmap = nil); overload;
|
|
destructor Destroy; override;
|
|
property SmoothingMode: TIECanvasSmoothingMode read fSmoothingMode write SetSmoothingMode;
|
|
property TextRendering: TIETextRenderingHintMode read fTextRendering write SetTextRendering;
|
|
property PenPos: TPoint read fPenPos write SetPenPos;
|
|
property Pen: TIEPen read fPen;
|
|
property Brush: TIEBrush read fBrush;
|
|
procedure MoveTo(X, Y: integer);
|
|
procedure LineTo(X, Y: integer);
|
|
procedure FillRect(const Rect: TRect);
|
|
procedure Rectangle(X1, Y1, X2, Y2: Integer); overload;
|
|
procedure Rectangle(const Rect: TRect); overload;
|
|
procedure Ellipse(X1, Y1, X2, Y2: Integer); overload;
|
|
procedure Ellipse(const Rect: TRect); overload;
|
|
procedure DrawLine(X1, Y1, X2, Y2: double);
|
|
procedure DrawLinesPath(points: TIE2DPointArray);
|
|
procedure Polygon(Points: array of TPoint);
|
|
procedure Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
|
|
procedure Polyline(Points: array of TPoint);
|
|
property Handle: HDC read GetHandle;
|
|
function TextWidth(const Text: WideString): Integer;
|
|
function TextHeight(const Text: WideString): Integer;
|
|
procedure TextOut(X, Y: Integer; const Text: string);
|
|
procedure TextOut2(X, Y: Integer; const Text: string);
|
|
property Font: TFont read GetFont;
|
|
procedure TextRect(Rect: TRect; X, Y: Integer; const Text: WideString);
|
|
procedure TextRectEx(Rect: TRect; X, Y: integer; const Text: WideString);
|
|
function TextExtent(const Text: WideString): TSize;
|
|
procedure RoundRect(X1, Y1, X2, Y2, X3, Y3: Integer);
|
|
property GDICanvas: TCanvas read fCanvas;
|
|
procedure Rotate(Angle: double);
|
|
procedure Translate(dx: double; dy: double);
|
|
procedure ResetTransform();
|
|
procedure Pie(X: single; Y: single; Width: single; Height: single; StartAngle: single; SweepAngle: single); overload;
|
|
procedure Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); overload;
|
|
procedure DrawText(Text: WideString; BoundingRect: TRect; Typographic: Boolean = False); overload;
|
|
procedure DrawText(Text: WideString; BoundingRect: TRect; Angle: Integer; Typographic: Boolean = False); overload;
|
|
procedure DrawText(Text: WideString; X, Y : Integer; Angle: Integer); overload;
|
|
function MeasureText(Text: WideString; BoundingRect: TRect; Angle: Integer = 0; Typographic: Boolean = False): TSize; overload;
|
|
function MeasureText(Text: WideString; Typographic: Boolean = False): TSize; overload;
|
|
property OnDestroy: TNotifyEvent read fOnDestroy write fOnDestroy;
|
|
property ROIBitmap: TObject read fROIBitmap write fROIBitmap;
|
|
procedure SetCompositingMode(Mode: TIECanvasCompositingMode; Quality: TIECanvasCompositingQuality);
|
|
procedure Draw(Metafile: TIEMetaFile; x: double; y: double; width: single; height: single);
|
|
procedure GradientFillRect(aRect: TRect; FromColor, ToColor: TColor; VerticalGradient: Boolean);
|
|
procedure Flush();
|
|
end;
|
|
|
|
|
|
TIEEmptyCanvas = class(TIECanvas)
|
|
private
|
|
fTempBitmap: TBitmap;
|
|
public
|
|
constructor Create(); overload;
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
|
|
function IEGDIPEnabled(): boolean;
|
|
function IEGDIPAvailable(): boolean;
|
|
procedure IEGDIPLoadLibrary();
|
|
procedure IEGDIPUnLoadLibrary();
|
|
|
|
|
|
procedure IEInitialize_iegdiplus();
|
|
procedure IEFinalize_iegdiplus();
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
SyncObjs, ActiveX, imageenproc, hyieutils, iesettings, math;
|
|
|
|
|
|
|
|
type
|
|
|
|
TGdiplusStartupInput = packed record
|
|
GdiplusVersion : Cardinal;
|
|
DebugEventCallback : pointer;
|
|
SuppressBackgroundThread: BOOL;
|
|
SuppressExternalCodecs : BOOL;
|
|
end;
|
|
PGdiplusStartupInput = ^TGdiplusStartupInput;
|
|
|
|
PGdiplusRectF = ^TGdiplusRectF;
|
|
TGdiplusRectF = record
|
|
X: single;
|
|
Y: single;
|
|
Width: single;
|
|
Height: single;
|
|
end;
|
|
|
|
|
|
var
|
|
{$ifdef IEUSEGDIPLUS}
|
|
StartupInput: TGDIPlusStartupInput;
|
|
gdiplusToken: ULONG;
|
|
{$endif}
|
|
IE_GDIPLUSHandle : THandle;
|
|
gdiplusRefCount: integer;
|
|
gdiplusCriticalSection: TCriticalSection;
|
|
|
|
const
|
|
IE_PixelFormatIndexed = $00010000; // Indexes into a palette
|
|
IE_PixelFormatGDI = $00020000; // Is a GDI-supported format
|
|
IE_PixelFormatAlpha = $00040000; // Has an alpha component
|
|
IE_PixelFormatPAlpha = $00080000; // Pre-multiplied alpha
|
|
IE_PixelFormatExtended = $00100000; // Extended color 16 bits/channel
|
|
IE_PixelFormatCanonical = $00200000;
|
|
IE_PixelFormatUndefined = 0;
|
|
IE_PixelFormatDontCare = 0;
|
|
IE_PixelFormat1bppIndexed = (1 or ( 1 shl 8) or IE_PixelFormatIndexed or IE_PixelFormatGDI);
|
|
IE_PixelFormat4bppIndexed = (2 or ( 4 shl 8) or IE_PixelFormatIndexed or IE_PixelFormatGDI);
|
|
IE_PixelFormat8bppIndexed = (3 or ( 8 shl 8) or IE_PixelFormatIndexed or IE_PixelFormatGDI);
|
|
IE_PixelFormat8bppGrayScale = (4 or (8 shl 8) or IE_PixelFormatExtended); // !!!! supported?
|
|
IE_PixelFormat16bppGrayScale = (4 or (16 shl 8) or IE_PixelFormatExtended);
|
|
IE_PixelFormat16bppRGB555 = (5 or (16 shl 8) or IE_PixelFormatGDI);
|
|
IE_PixelFormat16bppRGB565 = (6 or (16 shl 8) or IE_PixelFormatGDI);
|
|
IE_PixelFormat16bppARGB1555 = (7 or (16 shl 8) or IE_PixelFormatAlpha or IE_PixelFormatGDI);
|
|
IE_PixelFormat24bppRGB = (8 or (24 shl 8) or IE_PixelFormatGDI);
|
|
IE_PixelFormat32bppRGB = (9 or (32 shl 8) or IE_PixelFormatGDI);
|
|
IE_PixelFormat32bppARGB = (10 or (32 shl 8) or IE_PixelFormatAlpha or IE_PixelFormatGDI or IE_PixelFormatCanonical);
|
|
IE_PixelFormat32bppPARGB = (11 or (32 shl 8) or IE_PixelFormatAlpha or IE_PixelFormatPAlpha or IE_PixelFormatGDI);
|
|
IE_PixelFormat48bppRGB = (12 or (48 shl 8) or IE_PixelFormatExtended);
|
|
IE_PixelFormat64bppARGB = (13 or (64 shl 8) or IE_PixelFormatAlpha or IE_PixelFormatCanonical or IE_PixelFormatExtended);
|
|
IE_PixelFormat64bppPARGB = (14 or (64 shl 8) or IE_PixelFormatAlpha or IE_PixelFormatPAlpha or IE_PixelFormatExtended);
|
|
IE_PixelFormatMax = 15;
|
|
|
|
const
|
|
// StringFormatFlags
|
|
StringFormatFlagsDirectionRightToLeft = $00000001;
|
|
StringFormatFlagsDirectionVertical = $00000002;
|
|
StringFormatFlagsNoFitBlackBox = $00000004;
|
|
StringFormatFlagsDisplayFormatControl = $00000020;
|
|
StringFormatFlagsNoFontFallback = $00000400;
|
|
StringFormatFlagsMeasureTrailingSpaces = $00000800;
|
|
StringFormatFlagsNoWrap = $00001000;
|
|
StringFormatFlagsLineLimit = $00002000;
|
|
StringFormatFlagsNoClip = $00004000;
|
|
|
|
|
|
var
|
|
|
|
///// GDI+ functions
|
|
///// GDI+ Flat API: https://msdn.microsoft.com/en-us/library/windows/desktop/ms533969(v=vs.85).aspx
|
|
IE_GdiplusStartup : function(out token: ULONG; input: PGdiplusStartupInput; output: pointer): ULONG; stdcall;
|
|
IE_GdiplusShutdown : procedure(token: ULONG); stdcall;
|
|
IE_GdipCreateFromHDC : function(hdc: HDC; out graphics: pointer): ULONG; stdcall;
|
|
IE_GdipCreateFromHDC2 : function(hdc: HDC; hDevice: THandle; out graphics: pointer): ULONG; stdcall;
|
|
IE_GdipDeleteGraphics : function(graphics: pointer): ULONG; stdcall;
|
|
IE_GdipCreatePen1 : function(color: ARGB; width: Single; unit_: ULONG; out pen: pointer): ULONG; stdcall;
|
|
IE_GdipDeletePen : function(pen: pointer): ULONG; stdcall;
|
|
IE_GdipSetPenWidth : function(pen: pointer; width: Single): ULONG; stdcall;
|
|
IE_GdipSetPenColor : function(pen: pointer; argb_: ARGB): ULONG; stdcall;
|
|
IE_GdipSetPenDashStyle : function(pen: pointer; dashstyle: ULONG): ULONG; stdcall;
|
|
IE_GdipDrawLine : function(graphics: pointer; pen: pointer; x1: Single; y1: Single; x2: Single; y2: Single): ULONG; stdcall;
|
|
IE_GdipSetSmoothingMode : function(graphics: pointer; smoothingMode: ULONG): ULONG; stdcall; // -1=invalid, 0=default, 1=BestPerformance, 2=BestRenderingQuality, 3=None, 4=Antialias
|
|
//IE_GdipSetPenDashArray : function(pen: pointer; dash: PSingle; count: Integer): ULONG; stdcall;
|
|
IE_GdipDeleteBrush : function(brush: pointer): ULONG; stdcall;
|
|
IE_GdipCreateSolidFill : function(color: ARGB; out brush: pointer): ULONG; stdcall;
|
|
IE_GdipFillRectangle : function(graphics: pointer; brush: pointer; x: Single; y: Single; width: Single; height: Single): ULONG; stdcall;
|
|
IE_GdipDrawRectangle : function(graphics: pointer; pen: pointer; x: Single; y: Single; width: Single; height: Single): ULONG; stdcall;
|
|
IE_GdipCreateHatchBrush : function(hatchstyle: Integer; forecol: ARGB; backcol: ARGB; out brush: pointer): ULONG; stdcall;
|
|
IE_GdipDrawEllipse : function(graphics: pointer; pen: pointer; x: Single; y: Single; width: Single; height: Single): ULONG; stdcall;
|
|
IE_GdipFillEllipse : function(graphics: pointer; brush: pointer; x: Single; y: Single; width: Single; height: Single): ULONG; stdcall;
|
|
IE_GdipDrawPolygonI : function(graphics: pointer; pen: pointer; points: pointer; count: Integer): ULONG; stdcall;
|
|
IE_GdipFillPolygonI : function(graphics: pointer; brush: pointer; points: pointer; count: Integer; fillMode: ULONG): ULONG; stdcall;
|
|
IE_GdipDrawPie : function(graphics: pointer; pen: pointer; x: single; y: single; width: single; height: single; startAngle: single; sweepAngle: single): ULONG; stdcall;
|
|
IE_GdipFillPie : function(graphics: pointer; brush: pointer; x: single; y: single; width: single; height: single; startAngle: single; sweepAngle: single): ULONG; stdcall;
|
|
IE_GdipDrawLinesI : function(graphics: pointer; pen: pointer; points: pointer; count: Integer): ULONG; stdcall;
|
|
IE_GdipDrawArc : function(graphics: pointer; pen: pointer; x: Single; y: Single; width: Single; height: Single; startAngle: Single; sweepAngle: Single): ULONG; stdcall;
|
|
IE_GdipCreatePath : function(brushMode: ULONG; out path: pointer): ULONG; stdcall;
|
|
IE_GdipAddPathArc : function(path: pointer; x, y, width, height, startAngle, sweepAngle: Single): ULONG; stdcall;
|
|
IE_GdipDrawPath : function(graphics: pointer; pen: pointer; path: pointer): ULONG; stdcall;
|
|
IE_GdipFillPath : function(graphics: pointer; brush: pointer; path: pointer): ULONG; stdcall;
|
|
IE_GdipDeletePath : function(path: pointer): ULONG; stdcall;
|
|
IE_GdipAddPathLine : function(path: pointer; x1, y1, x2, y2: Single): ULONG; stdcall;
|
|
IE_GdipSetPenLineJoin : function(pen: pointer; lineJoin: ULONG): ULONG; stdcall;
|
|
IE_GdipSetWorldTransform : function(graphics: pointer; matrix: pointer): ULONG; stdcall;
|
|
IE_GdipGetWorldTransform : function(graphics: pointer; matrix: pointer): ULONG; stdcall;
|
|
IE_GdipResetWorldTransform : function(graphics: pointer): ULONG; stdcall;
|
|
IE_GdipCreateMatrix : function(out matrix: pointer): ULONG; stdcall;
|
|
IE_GdipCreateMatrix2 : function(m11: single; m12: single; m21: single; m22: single; dx: single; dy: single; out matrix: pointer): ULONG; stdcall;
|
|
IE_GdipDeleteMatrix : function(matrix: pointer): ULONG; stdcall;
|
|
IE_GdipGetDC : function(graphics: pointer; var hdc: HDC): ULONG; stdcall;
|
|
IE_GdipReleaseDC : function(graphics: pointer; hdc: HDC): ULONG; stdcall;
|
|
IE_GdipFlush : function(graphics: pointer; intention: ULONG): ULONG; stdcall;
|
|
IE_GdipRotateWorldTransform : function(graphics: pointer; angle: Single; order: ULONG): ULONG; stdcall;
|
|
IE_GdipTranslateWorldTransform : function(graphics: pointer; dx: Single; dy: Single; order: ULONG): ULONG; stdcall;
|
|
IE_GdipScaleWorldTransform : function(graphics: pointer; sx: Single; sy: Single; order: ULONG): ULONG; stdcall;
|
|
IE_GdipStartPathFigure : function(path: pointer): ULONG; stdcall;
|
|
IE_GdipClosePathFigure : function(path: pointer): ULONG; stdcall;
|
|
IE_GdipResetPath : function(path: pointer): ULONG; stdcall;
|
|
IE_GdipSetCompositingMode : function(graphics: pointer; compositingMode: ULONG): ULONG; stdcall;
|
|
IE_GdipSetCompositingQuality : function(graphics: pointer; compositingQuality: ULONG): ULONG; stdcall;
|
|
IE_GdipCreateBitmapFromScan0: function(width: Integer; height: Integer; stride: Integer; format: ULONG; scan0: pointer; out bitmap: pointer): ULONG; stdcall;
|
|
IE_GdipGetImageGraphicsContext : function(image: pointer; out graphics: pointer): ULONG; stdcall;
|
|
IE_GdipDisposeImage : function(image: pointer): ULONG; stdcall;
|
|
IE_GdipSetInterpolationMode : function(graphics: pointer; interpolationMode: ULONG): ULONG; stdcall;
|
|
IE_GdipCreateHalftonePalette : function(): THandle; stdcall;
|
|
IE_GdipCreateBitmapFromHBITMAP : function(hbm: HBITMAP; hpal: HPALETTE; out bitmap: pointer): ULONG; stdcall;
|
|
IE_GdipDrawString: function(graphics: pointer; str: PWChar; len: integer; font: pointer; const layoutRect: PGdiplusRectF; stringFormat: pointer; brush: pointer): ULONG; stdcall;
|
|
IE_GdipCreateFontFromDC: function(hdc: HDC; out font: pointer): ULONG; stdcall;
|
|
|
|
IE_GdipCreateFont: function(fontFamily: pointer; emSize: single; style: ULONG; unit_: ULONG; out font: pointer): ULONG; stdcall;
|
|
IE_GdipCreateFontFamilyFromName: function (name: PWCHAR; fontCollection: pointer; out FontFamily: pointer): ULONG; stdcall;
|
|
IE_GdipDeleteFontFamily: function(fontFamily: pointer): ULONG; stdcall;
|
|
IE_GdipGetGenericFontFamilySansSerif: function(out nativeFamily: pointer): ULONG; stdcall;
|
|
|
|
IE_GdipDeleteFont: function(font: pointer): ULONG; stdcall;
|
|
IE_GdipCreateStringFormat: function(formatAttributes: integer; language: word; out format: pointer): ULONG; stdcall;
|
|
IE_GdipStringFormatGetGenericTypographic: function(out format: pointer): ULONG; stdcall;
|
|
IE_GdipDeleteStringFormat: function(format: pointer): ULONG; stdcall;
|
|
IE_GdipSetTextRenderingHint: function(graphics: pointer; mode: DWORD): ULONG; stdcall;
|
|
IE_GdipCreateMetafileFromFile: function(filename: PWChar; out metafile: pointer): ULONG; stdcall;
|
|
IE_GdipDrawImage: function(graphics: pointer; image: pointer; x: single; y: single): ULONG; stdcall;
|
|
IE_GdipDrawImageRect: function(graphics: pointer; image: pointer; x: single; y: single; width: single; height: single): ULONG; stdcall;
|
|
IE_GdipGetMetafileHeaderFromMetafile: function(metafile: pointer; out header: TIEMetafileHeader): ULONG; stdcall;
|
|
IE_GdipCreateMetafileFromStream: function(stream: IStream; out metafile: pointer): ULONG; stdcall;
|
|
IE_GdipMeasureString : function(graphics: pointer;
|
|
str: PWChar; len: integer; font: pointer; const layoutRect: PGdiplusRectF;
|
|
stringFormat: pointer;
|
|
boundingBox: PGdiplusRectF;
|
|
codepointsFitted: PInteger;
|
|
linesFilled: PInteger ): ULONG; stdcall;
|
|
IE_GdipSetClipRect : function (graphics: pointer; x: Single; y: Single; width: Single; height: Single; combineMode: ULONG): ULONG; stdcall;
|
|
IE_GdipResetClip : function (graphics: pointer): ULONG; stdcall;
|
|
|
|
// Library handling
|
|
|
|
function IEGDIPAvailable(): boolean;
|
|
begin
|
|
result := IE_GDIPLUSHandle <> 0;
|
|
end;
|
|
|
|
function IEGDIPEnabled(): boolean;
|
|
begin
|
|
result := IEGlobalSettings().UseGDIPlus and (IE_GDIPLUSHandle <> 0);
|
|
end;
|
|
|
|
procedure IEGDIPLoadLibrary();
|
|
begin
|
|
{$ifdef IEUSEGDIPLUS}
|
|
gdiplusCriticalSection.Enter();
|
|
try
|
|
inc(gdiplusRefCount);
|
|
if not IEGDIPAvailable() and IEGlobalSettings().UseGDIPlus then
|
|
begin
|
|
IE_GDIPLUSHandle := LoadLibrary('gdiplus.dll');
|
|
if IE_GDIPLUSHandle <> 0 then
|
|
begin
|
|
@IE_GdiplusStartup := GetProcAddress(IE_GDIPLUSHandle, 'GdiplusStartup');
|
|
@IE_GdiplusShutdown := GetProcAddress(IE_GDIPLUSHandle, 'GdiplusShutdown');
|
|
@IE_GdipCreateFromHDC := GetProcAddress(IE_GDIPLUSHandle, 'GdipCreateFromHDC');
|
|
@IE_GdipCreateFromHDC2 := GetProcAddress(IE_GDIPLUSHandle, 'GdipCreateFromHDC2');
|
|
@IE_GdipDeleteGraphics := GetProcAddress(IE_GDIPLUSHandle, 'GdipDeleteGraphics');
|
|
@IE_GdipCreatePen1 := GetProcAddress(IE_GDIPLUSHandle, 'GdipCreatePen1');
|
|
@IE_GdipDeletePen := GetProcAddress(IE_GDIPLUSHandle, 'GdipDeletePen');
|
|
@IE_GdipDrawLine := GetProcAddress(IE_GDIPLUSHandle, 'GdipDrawLine');
|
|
@IE_GdipSetSmoothingMode := GetProcAddress(IE_GDIPLUSHandle, 'GdipSetSmoothingMode');
|
|
@IE_GdipSetPenWidth := GetProcAddress(IE_GDIPLUSHandle, 'GdipSetPenWidth');
|
|
@IE_GdipSetPenColor := GetProcAddress(IE_GDIPLUSHandle, 'GdipSetPenColor');
|
|
@IE_GdipSetPenDashStyle := GetProcAddress(IE_GDIPLUSHandle, 'GdipSetPenDashStyle');
|
|
//@IE_GdipSetPenDashArray := GetProcAddress(IE_GDIPLUSHandle, 'GdipSetPenDashArray');
|
|
@IE_GdipDeleteBrush := GetProcAddress(IE_GDIPLUSHandle, 'GdipDeleteBrush');
|
|
@IE_GdipCreateSolidFill := GetProcAddress(IE_GDIPLUSHandle, 'GdipCreateSolidFill');
|
|
@IE_GdipFillRectangle := GetProcAddress(IE_GDIPLUSHandle, 'GdipFillRectangle');
|
|
@IE_GdipDrawRectangle := GetProcAddress(IE_GDIPLUSHandle, 'GdipDrawRectangle');
|
|
@IE_GdipCreateHatchBrush := GetProcAddress(IE_GDIPLUSHandle, 'GdipCreateHatchBrush');
|
|
@IE_GdipDrawEllipse := GetProcAddress(IE_GDIPLUSHandle, 'GdipDrawEllipse');
|
|
@IE_GdipFillEllipse := GetProcAddress(IE_GDIPLUSHandle, 'GdipFillEllipse');
|
|
@IE_GdipDrawPolygonI := GetProcAddress(IE_GDIPLUSHandle, 'GdipDrawPolygonI');
|
|
@IE_GdipFillPolygonI := GetProcAddress(IE_GDIPLUSHandle, 'GdipFillPolygonI');
|
|
@IE_GdipDrawPie := GetProcAddress(IE_GDIPLUSHandle, 'GdipDrawPie');
|
|
@IE_GdipFillPie := GetProcAddress(IE_GDIPLUSHandle, 'GdipFillPie');
|
|
@IE_GdipDrawLinesI := GetProcAddress(IE_GDIPLUSHandle, 'GdipDrawLinesI');
|
|
@IE_GdipDrawArc := GetProcAddress(IE_GDIPLUSHandle, 'GdipDrawArc');
|
|
@IE_GdipCreatePath := GetProcAddress(IE_GDIPLUSHandle, 'GdipCreatePath');
|
|
@IE_GdipAddPathArc := GetProcAddress(IE_GDIPLUSHandle, 'GdipAddPathArc');
|
|
@IE_GdipDrawPath := GetProcAddress(IE_GDIPLUSHandle, 'GdipDrawPath');
|
|
@IE_GdipFillPath := GetProcAddress(IE_GDIPLUSHandle, 'GdipFillPath');
|
|
@IE_GdipDeletePath := GetProcAddress(IE_GDIPLUSHandle, 'GdipDeletePath');
|
|
@IE_GdipAddPathLine := GetProcAddress(IE_GDIPLUSHandle, 'GdipAddPathLine');
|
|
@IE_GdipSetPenLineJoin := GetProcAddress(IE_GDIPLUSHandle, 'GdipSetPenLineJoin');
|
|
@IE_GdipSetWorldTransform := GetProcAddress(IE_GDIPLUSHandle, 'GdipSetWorldTransform');
|
|
@IE_GdipGetWorldTransform := GetProcAddress(IE_GDIPLUSHandle, 'GdipGetWorldTransform');
|
|
@IE_GdipResetWorldTransform := GetProcAddress(IE_GDIPLUSHandle, 'GdipResetWorldTransform');
|
|
@IE_GdipCreateMatrix := GetProcAddress(IE_GDIPLUSHandle, 'GdipCreateMatrix');
|
|
@IE_GdipCreateMatrix2 := GetProcAddress(IE_GDIPLUSHandle, 'GdipCreateMatrix2');
|
|
@IE_GdipDeleteMatrix := GetProcAddress(IE_GDIPLUSHandle, 'GdipDeleteMatrix');
|
|
@IE_GdipGetDC := GetProcAddress(IE_GDIPLUSHandle, 'GdipGetDC');
|
|
@IE_GdipReleaseDC := GetProcAddress(IE_GDIPLUSHandle, 'GdipReleaseDC');
|
|
@IE_GdipFlush := GetProcAddress(IE_GDIPLUSHandle, 'GdipFlush');
|
|
@IE_GdipRotateWorldTransform := GetProcAddress(IE_GDIPLUSHandle, 'GdipRotateWorldTransform');
|
|
@IE_GdipTranslateWorldTransform := GetProcAddress(IE_GDIPLUSHandle, 'GdipTranslateWorldTransform');
|
|
@IE_GdipScaleWorldTransform := GetProcAddress(IE_GDIPLUSHandle, 'GdipScaleWorldTransform');
|
|
@IE_GdipStartPathFigure := GetProcAddress(IE_GDIPLUSHandle, 'GdipStartPathFigure');
|
|
@IE_GdipClosePathFigure := GetProcAddress(IE_GDIPLUSHandle, 'GdipClosePathFigure');
|
|
@IE_GdipResetPath := GetProcAddress(IE_GDIPLUSHandle, 'GdipResetPath');
|
|
@IE_GdipSetCompositingMode := GetProcAddress(IE_GDIPLUSHandle, 'GdipSetCompositingMode');
|
|
@IE_GdipSetCompositingQuality := GetProcAddress(IE_GDIPLUSHandle, 'GdipSetCompositingQuality');
|
|
@IE_GdipCreateBitmapFromScan0 := GetProcAddress(IE_GDIPLUSHandle, 'GdipCreateBitmapFromScan0');
|
|
@IE_GdipGetImageGraphicsContext := GetProcAddress(IE_GDIPLUSHandle, 'GdipGetImageGraphicsContext');
|
|
@IE_GdipDisposeImage := GetProcAddress(IE_GDIPLUSHandle, 'GdipDisposeImage');
|
|
@IE_GdipSetInterpolationMode := GetProcAddress(IE_GDIPLUSHandle, 'GdipSetInterpolationMode');
|
|
@IE_GdipCreateHalftonePalette := GetProcAddress(IE_GDIPLUSHandle, 'GdipCreateHalftonePalette');
|
|
@IE_GdipCreateBitmapFromHBITMAP := GetProcAddress(IE_GDIPLUSHandle, 'GdipCreateBitmapFromHBITMAP');
|
|
@IE_GdipDrawString := GetProcAddress(IE_GDIPLUSHandle, 'GdipDrawString');
|
|
@IE_GdipCreateFontFromDC := GetProcAddress(IE_GDIPLUSHandle, 'GdipCreateFontFromDC');
|
|
@IE_GdipDeleteFont := GetProcAddress(IE_GDIPLUSHandle, 'GdipDeleteFont');
|
|
@IE_GdipCreateStringFormat := GetProcAddress(IE_GDIPLUSHandle, 'GdipCreateStringFormat');
|
|
@IE_GdipStringFormatGetGenericTypographic := GetProcAddress(IE_GDIPLUSHandle, 'GdipStringFormatGetGenericTypographic');
|
|
@IE_GdipDeleteStringFormat := GetProcAddress(IE_GDIPLUSHandle, 'GdipDeleteStringFormat');
|
|
@IE_GdipSetTextRenderingHint := GetProcAddress(IE_GDIPLUSHandle, 'GdipSetTextRenderingHint');
|
|
@IE_GdipCreateMetafileFromFile := GetProcAddress(IE_GDIPLUSHandle, 'GdipCreateMetafileFromFile');
|
|
@IE_GdipDrawImage := GetProcAddress(IE_GDIPLUSHandle, 'GdipDrawImage');
|
|
@IE_GdipDrawImageRect := GetProcAddress(IE_GDIPLUSHandle, 'GdipDrawImageRect');
|
|
@IE_GdipGetMetafileHeaderFromMetafile := GetProcAddress(IE_GDIPLUSHandle, 'GdipGetMetafileHeaderFromMetafile');
|
|
@IE_GdipCreateMetafileFromStream := GetProcAddress(IE_GDIPLUSHandle, 'GdipCreateMetafileFromStream');
|
|
@IE_GdipMeasureString := GetProcAddress(IE_GDIPLUSHandle, 'GdipMeasureString');
|
|
@IE_GdipCreateFont := GetProcAddress(IE_GDIPLUSHandle, 'GdipCreateFont');
|
|
@IE_GdipCreateFontFamilyFromName := GetProcAddress(IE_GDIPLUSHandle, 'GdipCreateFontFamilyFromName');
|
|
@IE_GdipDeleteFontFamily := GetProcAddress(IE_GDIPLUSHandle, 'GdipDeleteFontFamily');
|
|
@IE_GdipGetGenericFontFamilySansSerif := GetProcAddress(IE_GDIPLUSHandle, 'GdipGetGenericFontFamilySansSerif');
|
|
@IE_GdipSetClipRect := GetProcAddress(IE_GDIPLUSHandle, 'GdipSetClipRect');
|
|
@IE_GdipResetClip := GetProcAddress(IE_GDIPLUSHandle, 'GdipResetClip');
|
|
|
|
StartupInput.DebugEventCallback := nil;
|
|
StartupInput.SuppressBackgroundThread := False;
|
|
StartupInput.SuppressExternalCodecs := False;
|
|
StartupInput.GdiplusVersion := 1;
|
|
if IE_GdiplusStartup(gdiplusToken, @StartupInput, nil) <> 0 then
|
|
IEGDIPUnLoadLibrary();
|
|
end;
|
|
end;
|
|
finally
|
|
gdiplusCriticalSection.Leave();
|
|
end;
|
|
{$endif}
|
|
end;
|
|
|
|
procedure IEGDIPUnLoadLibrary();
|
|
begin
|
|
{$ifdef IEUSEGDIPLUS}
|
|
gdiplusCriticalSection.Enter();
|
|
try
|
|
if gdiplusRefCount > 0 then
|
|
begin
|
|
dec(gdiplusRefCount);
|
|
if IEGDIPAvailable() and (gdiplusRefCount = 0) then
|
|
begin
|
|
IE_GdiplusShutdown(gdiplusToken);
|
|
FreeLibrary(IE_GDIPLUSHandle);
|
|
IE_GDIPLUSHandle := 0;
|
|
end;
|
|
end;
|
|
finally
|
|
gdiplusCriticalSection.Leave();
|
|
end;
|
|
{$endif}
|
|
end;
|
|
|
|
|
|
|
|
|
|
function CreateARGB(r, g, b, a: Byte): ARGB;
|
|
const
|
|
AlphaShift = 24;
|
|
RedShift = 16;
|
|
GreenShift = 8;
|
|
BlueShift = 0;
|
|
begin
|
|
result := ((DWORD(b) shl BlueShift) or
|
|
(DWORD(g) shl GreenShift) or
|
|
(DWORD(r) shl RedShift) or
|
|
(DWORD(a) shl AlphaShift));
|
|
end;
|
|
|
|
function CreateARGB2(Color : TColor; a: Byte): ARGB;
|
|
var
|
|
rgb: TRGB;
|
|
begin
|
|
rgb := TColor2TRGB( Color );
|
|
result := CreateARGB( rgb.r, rgb.g, rgb.b, a );
|
|
end;
|
|
|
|
////////////////////////////////////////////////////////////////////////////////////////////
|
|
////////////////////////////////////////////////////////////////////////////////////////////
|
|
// TIECanvas
|
|
|
|
constructor TIECanvas.Create(Canvas: TCanvas; AntiAlias: boolean; UseGDIPlus: boolean; Bitmap: TBitmap);
|
|
begin
|
|
inherited Create;
|
|
fOnDestroy := nil;
|
|
fROIBitmap := nil;
|
|
fGraphics := nil;
|
|
fImage := nil;
|
|
fCanvas := Canvas;
|
|
fPen := TIEPen.Create(fCanvas.Pen);
|
|
fBrush := TIEBrush.Create(fCanvas.Brush);
|
|
fUseGDIPlus := IEGDIPEnabled and UseGDIPlus;
|
|
if fUseGDIPlus then
|
|
begin
|
|
fCanvasHandle := fCanvas.Handle;
|
|
fSavedDC := Windows.SaveDC( fCanvasHandle );
|
|
if Bitmap = nil then
|
|
IE_GdipCreateFromHDC(fCanvas.Handle, fGraphics)
|
|
else
|
|
IE_GdipCreateFromHDC2(fCanvas.Handle, Bitmap.Handle, fGraphics);
|
|
if fGraphics = nil then
|
|
begin
|
|
FreeAndNil(fPen);
|
|
FreeAndNil(fBrush);
|
|
raise EIEException.Create('Cannot create TIECanvas. Ensure GDI+ is installed on system.');
|
|
end;
|
|
end;
|
|
|
|
if Antialias then
|
|
begin
|
|
SmoothingMode := iesmAntialias;
|
|
TextRendering := ietrTextRenderingHintAntiAlias;
|
|
end
|
|
else
|
|
begin
|
|
SmoothingMode := iesmBestPerformance;
|
|
TextRendering := ietrTextRenderingHintSystemDefault;
|
|
end
|
|
end;
|
|
|
|
destructor TIECanvas.Destroy;
|
|
begin
|
|
if assigned(fOnDestroy) then
|
|
fOnDestroy(self);
|
|
fBrush.Free;
|
|
fPen.Free;
|
|
if fUseGDIPlus then
|
|
begin
|
|
if fImage <> nil then
|
|
IE_GdipDisposeImage(fImage);
|
|
IE_GdipDeleteGraphics(fGraphics);
|
|
Windows.RestoreDC( fCanvasHandle, fSavedDC );
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
function TIECanvas.GetHandle: HDC;
|
|
begin
|
|
result := fCanvas.Handle;
|
|
end;
|
|
|
|
procedure TIECanvas.SetSmoothingMode(value: TIECanvasSmoothingMode);
|
|
begin
|
|
fSmoothingMode := Value;
|
|
if fUseGDIPlus then
|
|
IE_GdipSetSmoothingMode(fGraphics, integer(value)-1);
|
|
end;
|
|
|
|
procedure TIECanvas.SetTextRendering(value: TIETextRenderingHintMode);
|
|
begin
|
|
fTextRendering := Value;
|
|
if fUseGDIPlus then
|
|
IE_GdipSetTextRenderingHint(fGraphics, integer( value ));
|
|
end;
|
|
|
|
procedure TIECanvas.SetPenPos(value: TPoint);
|
|
begin
|
|
fPenPos := value;
|
|
if not fUseGDIPlus then
|
|
fCanvas.PenPos := value;
|
|
end;
|
|
|
|
procedure TIECanvas.MoveTo(X, Y: integer);
|
|
begin
|
|
fPenPos := Point(X, Y);
|
|
if not fUseGDIPlus then
|
|
fCanvas.MoveTo(X, Y);
|
|
end;
|
|
|
|
procedure TIECanvas.LineTo(X, Y: integer);
|
|
begin
|
|
if fUseGDIPlus then
|
|
begin
|
|
IE_GdipDrawLine(fGraphics, fPen.fGHandle, fPenPos.X, fPenPos.Y, X, Y);
|
|
SetPenPos( Point(X, Y) );
|
|
end
|
|
else
|
|
fCanvas.LineTo(X, Y);
|
|
end;
|
|
|
|
procedure TIECanvas.DrawLine(X1, Y1, X2, Y2: double);
|
|
var
|
|
p2: array [0..1] of TPoint;
|
|
begin
|
|
if fUseGDIPlus then
|
|
begin
|
|
IE_GdipDrawLine(fGraphics, fPen.fGHandle, X1, Y1, X2, Y2);
|
|
end
|
|
else
|
|
begin
|
|
// draws also the last point
|
|
p2[0].x := trunc(x1);
|
|
p2[0].y := trunc(y1);
|
|
p2[1].x := trunc(x2);
|
|
p2[1].y := trunc(y2);
|
|
fCanvas.Polygon(p2);
|
|
end;
|
|
end;
|
|
|
|
procedure TIECanvas.DrawLinesPath(points: TIE2DPointArray);
|
|
var
|
|
path: pointer;
|
|
i: integer;
|
|
begin
|
|
IE_GdipCreatePath(0, Path);
|
|
try
|
|
for i := 0 to high(points) - 1 do
|
|
begin
|
|
IE_GdipAddPathLine(Path, points[i].X, points[i].Y, points[i+1].X, points[i+1].Y);
|
|
end;
|
|
IE_GdipDrawPath(fGraphics, fPen.fGHandle, Path);
|
|
finally
|
|
IE_GdipDeletePath(Path);
|
|
end;
|
|
end;
|
|
|
|
procedure TIECanvas.FillRect( const Rect: TRect );
|
|
var
|
|
x1, y1, x2, y2: integer;
|
|
begin
|
|
if fUseGDIPlus then
|
|
begin
|
|
x1 := Rect.Left;
|
|
y1 := Rect.Top;
|
|
x2 := Rect.Right;
|
|
y2 := Rect.Bottom;
|
|
OrdCor( x1, y1, x2, y2 );
|
|
IE_GdipFillRectangle( fGraphics, fBrush.fGHandle, x1, y1, x2 - x1 - 1, y2 - y1 - 1 );
|
|
end
|
|
else
|
|
fCanvas.FillRect( Rect );
|
|
end;
|
|
|
|
procedure TIECanvas.Rectangle(X1, Y1, X2, Y2: Integer);
|
|
begin
|
|
Rectangle(Rect(X1, Y1, X2, Y2));
|
|
end;
|
|
|
|
procedure TIECanvas.Rectangle(const Rect: TRect);
|
|
var
|
|
x1, y1, x2, y2: integer;
|
|
begin
|
|
if fUseGDIPlus then
|
|
begin
|
|
x1 := Rect.Left;
|
|
y1 := Rect.Top;
|
|
x2 := Rect.Right;
|
|
y2 := Rect.Bottom;
|
|
OrdCor(x1, y1, x2, y2);
|
|
IE_GdipFillRectangle(fGraphics, fBrush.fGHandle, x1, y1, x2 - x1 - 1, y2 - y1 - 1);
|
|
IE_GdipDrawRectangle(fGraphics, fPen.fGHandle, x1, y1, x2 - x1 - 1, y2 - y1 - 1);
|
|
end
|
|
else
|
|
fCanvas.Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
|
|
end;
|
|
|
|
procedure TIECanvas.Ellipse(X1, Y1, X2, Y2: Integer);
|
|
begin
|
|
Ellipse(Rect(X1, Y1, X2, Y2));
|
|
end;
|
|
|
|
procedure TIECanvas.Ellipse( const Rect: TRect );
|
|
var
|
|
x1, y1, x2, y2: integer;
|
|
hp: integer;
|
|
begin
|
|
if fUseGDIPlus then
|
|
begin
|
|
x1 := Rect.Left;
|
|
y1 := Rect.Top;
|
|
x2 := Rect.Right;
|
|
y2 := Rect.Bottom;
|
|
|
|
// this code avoids width and height of ellipse to become less than half of pen width
|
|
if fPen.Width <> 1 then
|
|
begin
|
|
hp := round( fPen.Width / 2 );
|
|
|
|
if ( x2 < x1 ) then
|
|
x1 := x1 + hp;
|
|
if ( ( x1 <= x2 ) and ( x2 - x1 - 1 <= hp ) ) then
|
|
x2 := x1 + hp;
|
|
if ( ( x2 < x1 ) and ( x1 - x2 - 1 <= hp ) ) then
|
|
x2 := x1 - hp;
|
|
|
|
if ( y2 < y1 ) then
|
|
y1 := y1 + hp;
|
|
if ( ( y1 <= y2 ) and ( y2 - y1 - 1 <= hp ) ) then
|
|
y2 := y1 + hp;
|
|
if ( ( y2 < y1 ) and ( y1 - y2 - 1 <= hp ) ) then
|
|
y2 := y1 - hp;
|
|
|
|
if ( x2 - hp ) = x1 then
|
|
x1 := x1 - hp;
|
|
|
|
if ( y2 - hp ) = y1 then
|
|
y1 := y1 - hp;
|
|
|
|
if x2 = x1 then
|
|
begin
|
|
x1 := x1 - ( hp + 1 );
|
|
y2 := y2 - ( hp + 1 );
|
|
end;
|
|
|
|
if y2 = y1 then
|
|
begin
|
|
y1 := y1 - ( hp + 1 );
|
|
y2 := y2 - ( hp + 1 );
|
|
end;
|
|
|
|
if x2 < x1 then
|
|
begin
|
|
x1 := x1 - ( hp );
|
|
x2 := x2 - ( hp - 1 );
|
|
end;
|
|
end;
|
|
|
|
IE_GdipFillEllipse( fGraphics, fBrush.fGHandle, x1, y1, x2 - x1 - 1, y2 - y1 - 1 );
|
|
IE_GdipDrawEllipse( fGraphics, fPen.fGHandle, x1, y1, x2 - x1 - 1, y2 - y1 - 1 );
|
|
end
|
|
else
|
|
fCanvas.Ellipse(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
|
|
end;
|
|
|
|
procedure TIECanvas.Polygon(Points: array of TPoint);
|
|
begin
|
|
if fUseGDIPlus then
|
|
begin
|
|
IE_GdipDrawPolygonI(fGraphics, fPen.fGHandle, @Points[0], length(Points));
|
|
IE_GdipFillPolygonI(fGraphics, fBrush.fGHandle, @Points[0], length(Points), 0);
|
|
end
|
|
else
|
|
fCanvas.Polygon(Points);
|
|
end;
|
|
|
|
procedure TIECanvas.Pie(X: single; Y: single; Width: single; Height: single; StartAngle: single; SweepAngle: single);
|
|
begin
|
|
if fUseGDIPlus then
|
|
begin
|
|
IE_GdipDrawPie(fGraphics, fPen.fGHandle, X, Y, Width, Height, StartAngle, SweepAngle);
|
|
IE_GdipFillPie(fGraphics, fBrush.fGHandle, X, Y, Width, Height, StartAngle, SweepAngle);
|
|
end;
|
|
end;
|
|
|
|
procedure TIECanvas.Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
|
|
var
|
|
a1, a2: single;
|
|
cx, cy: integer;
|
|
begin
|
|
if fUseGDIPlus then
|
|
begin
|
|
cx := (X1 + X2) div 2;
|
|
cy := (Y1 + Y2) div 2;
|
|
a1 := IEAngle2(cx, cy, X4, Y4) * (180 / PI);
|
|
a2 := IEAngle3(X3, Y3, cx, cy, X4, Y4) * (180 / PI);
|
|
IE_GdipDrawPie(fGraphics, fPen.fGHandle, X1, Y1, X2 - X1 + 1, Y2 - Y1 + 1, -a1, a2);
|
|
IE_GdipFillPie(fGraphics, fBrush.fGHandle, X1, Y1, X2 - X1 + 1, Y2 - Y1 + 1, -a1, a2);
|
|
end
|
|
else
|
|
fCanvas.Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4);
|
|
end;
|
|
|
|
|
|
procedure TIECanvas.Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
|
|
var
|
|
a1, a2: single;
|
|
cx, cy: integer;
|
|
begin
|
|
if fUseGDIPlus then
|
|
begin
|
|
cx := (X1+X2) div 2;
|
|
cy := (Y1+Y2) div 2;
|
|
a1 := IEAngle2(cx, cy, X4, Y4) * (180/PI);
|
|
a2 := IEAngle3(X3, Y3, cx, cy, X4, Y4) * (180/PI);
|
|
IE_GdipDrawArc(fGraphics, fPen.fGHandle, X1, Y1, X2-X1+1, Y2-Y1+1, -a1, a2);
|
|
end
|
|
else
|
|
fCanvas.Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4);
|
|
end;
|
|
|
|
procedure TIECanvas.Polyline(Points: array of TPoint);
|
|
begin
|
|
if fUseGDIPlus then
|
|
IE_GdipDrawLinesI(fGraphics, fPen.fGHandle, @Points[0], length(Points))
|
|
else
|
|
fCanvas.Polyline(Points);
|
|
end;
|
|
|
|
// todo...
|
|
function TIECanvas.TextWidth(const Text: WideString): Integer;
|
|
begin
|
|
Result := TextExtent(Text).cX;
|
|
end;
|
|
|
|
// todo...
|
|
function TIECanvas.TextHeight(const Text: WideString): Integer;
|
|
begin
|
|
Result := TextExtent(Text).cY;
|
|
end;
|
|
|
|
// todo...
|
|
procedure TIECanvas.TextOut(X, Y: Integer; const Text: string);
|
|
begin
|
|
fCanvas.TextOut(X, Y, Text);
|
|
end;
|
|
|
|
// C++Builder 2009 converts "TextOut" to TextOutA, so we need this
|
|
procedure TIECanvas.TextOut2(X, Y: Integer; const Text: string);
|
|
begin
|
|
TextOut(X, Y, Text);
|
|
end;
|
|
|
|
|
|
// todo...
|
|
function TIECanvas.GetFont: TFont;
|
|
begin
|
|
result := fCanvas.Font;
|
|
end;
|
|
|
|
// todo...
|
|
procedure TIECanvas.TextRect(Rect: TRect; X, Y: Integer; const Text: WideString);
|
|
var
|
|
Options: Longint;
|
|
begin
|
|
//fCanvas.TextRect(Rect, X, Y, Text);
|
|
Options := ETO_CLIPPED or fCanvas.TextFlags;
|
|
if Brush.Style <> bsClear then
|
|
Options := Options or ETO_OPAQUE;
|
|
if ((fCanvas.TextFlags and ETO_RTLREADING) <> 0) and (fCanvas.CanvasOrientation = coRightToLeft) then
|
|
Inc(X, TextWidth(Text) + 1);
|
|
Windows.ExtTextOutW(fCanvas.Handle, X, Y, Options, @Rect, PWideChar(Text), Length(Text), nil);
|
|
end;
|
|
|
|
// like TextRect, but without ETO_OPAQUE in TextFlags
|
|
procedure TIECanvas.TextRectEx(Rect: TRect; X, Y: integer; const Text: WideString);
|
|
var
|
|
Options: Longint;
|
|
begin
|
|
Options := ETO_CLIPPED or fCanvas.TextFlags;
|
|
if ((fCanvas.TextFlags and ETO_RTLREADING) <> 0) and (fCanvas.CanvasOrientation = coRightToLeft) then
|
|
inc(X, TextWidth(Text) + 1);
|
|
Windows.ExtTextOutW(fCanvas.Handle, X, Y, Options, @Rect, PWideChar(Text), Length(Text), nil);
|
|
end;
|
|
|
|
// todo...
|
|
function TIECanvas.TextExtent(const Text: WideString): TSize;
|
|
begin
|
|
Result.cX := 0;
|
|
Result.cY := 0;
|
|
GetTextExtentPoint32W(fCanvas.Handle, PWideChar(Text), Length(Text), Result);
|
|
end;
|
|
|
|
|
|
procedure TIECanvas.SetCompositingMode(Mode: TIECanvasCompositingMode; Quality: TIECanvasCompositingQuality);
|
|
begin
|
|
IE_GdipSetCompositingMode(fGraphics, DWORD(Mode));
|
|
IE_GdipSetCompositingQuality(fGraphics, DWORD(Quality));
|
|
end;
|
|
|
|
|
|
// Typographic gives a tighter text output with less padding
|
|
procedure TIECanvas.DrawTextEx(Text: WideString; X, Y, Width, Height: Integer; Typographic: Boolean; MeasureOnly: Boolean; out TextSize: TSize);
|
|
const
|
|
STATUS_OK = 0;
|
|
var
|
|
font: pointer;
|
|
stringFormat: pointer;
|
|
rectf: TGdiplusRectF;
|
|
boundingBox: TGdiplusRectF;
|
|
textBrushColor: pointer;
|
|
begin
|
|
TextSize.cX := 0;
|
|
TextSize.cy := 0;
|
|
|
|
IE_GdipCreateSolidFill( CreateARGB2( fCanvas.Font.Color, 255 ), textBrushColor );
|
|
|
|
IE_GdipCreateFontFromDC(fCanvas.Handle, font);
|
|
if Typographic then
|
|
IE_GdipStringFormatGetGenericTypographic(stringFormat)
|
|
else
|
|
IE_GdipCreateStringFormat(0, LANG_NEUTRAL, stringFormat);
|
|
|
|
rectf.X := X;
|
|
rectf.Y := Y;
|
|
rectf.Width := Width;
|
|
rectf.Height := Height;
|
|
|
|
if MeasureOnly then
|
|
begin
|
|
if IE_GdipMeasureString(fGraphics, PWideChar(Text), Length(Text), font, @rectf, nil,
|
|
@boundingBox, nil, nil) = STATUS_OK then
|
|
begin
|
|
TextSize.cX := Ceil( boundingBox.Width );
|
|
TextSize.cy := Ceil( boundingBox.Height );
|
|
end;
|
|
end
|
|
else
|
|
IE_GdipDrawString( fGraphics, PWideChar(Text), Length(Text), font, @rectf, stringFormat, textBrushColor );
|
|
|
|
IE_GdipDeleteStringFormat(stringFormat);
|
|
IE_GdipDeleteFont(font);
|
|
IE_GdipDeleteBrush(textBrushColor);
|
|
end;
|
|
|
|
// Typographic gives a tighter text output with less padding
|
|
// Note: Rotated text will be kept within BoundingRect
|
|
procedure TIECanvas.DrawTextEx2(Text: WideString; X, Y, Width, Height: Integer; Typographic: Boolean; Angle: Integer);
|
|
const
|
|
CombineModeReplace = 0;
|
|
var
|
|
dummySize, textSize, rotTextSize: TSize;
|
|
rotTextWidth, rotTextHeight: Integer;
|
|
rotWidth, rotHeight: Integer;
|
|
begin
|
|
if Angle = 0 then
|
|
DrawTextEx( Text, X, Y, Width, Height, Typographic, False, dummySize ) // Draw text
|
|
else
|
|
begin
|
|
IE_GdipSetClipRect( fGraphics, x, y, width, height, CombineModeReplace);
|
|
|
|
IECalcRotatedBitmapSizes( Width, Height, IE2DPoint( 0, 0 ), Angle, rotWidth, rotHeight );
|
|
|
|
DrawTextEx( Text, X, Y, rotWidth, rotHeight, Typographic, True, textSize ); // Measure Only
|
|
IECalcRotatedBitmapSizes( textSize.cx, textSize.cy, IE2DPoint( 0, 0 ), Angle, rotTextWidth, rotTextHeight );
|
|
|
|
Translate( X + rotTextWidth div 2, Y + rotTextHeight div 2 );
|
|
Rotate( Angle );
|
|
|
|
DrawTextEx( Text, 0, 0, rotWidth, rotHeight, Typographic, True, rotTextSize ); // Measure Only
|
|
|
|
// Offset by new rotated center
|
|
if ( Width < 1 ) or ( Height < 1 ) then
|
|
DrawTextEx( Text, - rotTextSize.cX div 2, - rotTextSize.cY div 2, 0, 0, Typographic, False, dummySize ) // Draw text
|
|
else
|
|
DrawTextEx( Text, - rotTextSize.cX div 2, - rotTextSize.cY div 2, rotTextSize.cX, rotTextSize.cY, Typographic, False, dummySize ); // Draw text
|
|
|
|
ResetTransform();
|
|
|
|
IE_GdipResetClip( fGraphics );
|
|
end;
|
|
end;
|
|
|
|
// Typographic gives a tighter text output with less padding
|
|
function TIECanvas.MeasureText(Text: WideString; BoundingRect: TRect; Angle: Integer = 0; Typographic: Boolean = False): TSize;
|
|
var
|
|
boundWidth, boundHeight: Integer;
|
|
begin
|
|
boundWidth := BoundingRect.Right - BoundingRect.Left + 1;
|
|
boundHeight := BoundingRect.Bottom - BoundingRect.Top + 1;
|
|
|
|
if Angle <> 0 then
|
|
IECalcRotatedBitmapSizes( boundWidth, boundHeight, IE2DPoint( 0, 0 ), Angle, boundWidth, boundHeight );
|
|
|
|
DrawTextEx( Text,
|
|
BoundingRect.Left,
|
|
BoundingRect.Top,
|
|
boundWidth,
|
|
boundHeight,
|
|
Typographic,
|
|
True, Result );
|
|
end;
|
|
|
|
function TIECanvas.MeasureText(Text: WideString; Typographic: Boolean = False): TSize;
|
|
begin
|
|
DrawTextEx( Text, 0, 0, 0, 0, Typographic, True, Result );
|
|
end;
|
|
|
|
// Typographic gives a tighter text output with less padding
|
|
procedure TIECanvas.DrawText(Text: WideString; BoundingRect: TRect; Typographic: Boolean = False);
|
|
var
|
|
dummySize: TSize;
|
|
begin
|
|
DrawTextEx( Text,
|
|
BoundingRect.Left,
|
|
BoundingRect.Top,
|
|
BoundingRect.Right - BoundingRect.Left + 1,
|
|
BoundingRect.Bottom - BoundingRect.Top + 1,
|
|
Typographic,
|
|
False, dummySize );
|
|
end;
|
|
|
|
// Typographic gives a tighter text output with less padding
|
|
// Note: Rotated text will be kept within BoundingRect
|
|
procedure TIECanvas.DrawText(Text: WideString; BoundingRect: TRect; Angle: Integer; Typographic: Boolean = False);
|
|
begin
|
|
DrawTextEx2( Text,
|
|
BoundingRect.Left,
|
|
BoundingRect.Top,
|
|
BoundingRect.Right - BoundingRect.Left + 1,
|
|
BoundingRect.Bottom - BoundingRect.Top + 1,
|
|
Typographic,
|
|
Angle );
|
|
end;
|
|
|
|
// X, Y represents the top-left of the text, so rotated text may be <X or <Y
|
|
procedure TIECanvas.DrawText(Text: WideString; X, Y : Integer; Angle: Integer);
|
|
var
|
|
dummySize: TSize;
|
|
const
|
|
Typographic = True;
|
|
begin
|
|
if Angle = 0 then
|
|
DrawTextEx( Text, X, Y, 0, 0, Typographic, False, dummySize )
|
|
else
|
|
begin
|
|
Translate( X, Y );
|
|
Rotate( Angle );
|
|
DrawTextEx( Text, 0, 0, 0, 0, Typographic, False, dummySize );
|
|
ResetTransform();
|
|
end;
|
|
end;
|
|
|
|
|
|
{
|
|
procedure TIECanvas.RoundRect(X1, Y1, X2, Y2, X3, Y3: Integer);
|
|
var
|
|
path: pointer;
|
|
width, height: integer;
|
|
begin
|
|
if fUseGDIPlus then
|
|
begin
|
|
OrdCor(X1, Y1, X2, Y2);
|
|
width := X2 - X1;
|
|
height := Y2 - Y1;
|
|
if width < X3 then
|
|
X3 := width;
|
|
if height < Y3 then
|
|
Y3 := height;
|
|
IE_GdipCreatePath(0, path);
|
|
|
|
IE_GdipAddPathArc(path, X1, Y1, X3, Y3, 180, 90);
|
|
IE_GdipAddPathArc(path, X1 + width - X3, Y1, X3, Y3, 270, 90);
|
|
IE_GdipAddPathArc(path, X1 + width - X3, Y1 + height - Y3, X3, Y3, 0, 90);
|
|
IE_GdipAddPathArc(path, X1, Y1 + height - Y3, X3, Y3, 90, 90);
|
|
IE_GdipAddPathLine(path, X1, Y1 + height - Y3, X1, Y1 + Y3 / 2);
|
|
|
|
IE_GdipClosePathFigure(path);
|
|
|
|
IE_GdipFillPath(fGraphics, fBrush.fGHandle, path);
|
|
IE_GdipDrawPath(fGraphics, fPen.fGHandle, path);
|
|
IE_GdipDeletePath(path);
|
|
end
|
|
else
|
|
fCanvas.RoundRect(X1, Y1, X2, Y2, X3, Y3);
|
|
end;
|
|
//}
|
|
|
|
//{
|
|
procedure TIECanvas.RoundRect(X1, Y1, X2, Y2, X3, Y3: Integer);
|
|
var
|
|
path: pointer;
|
|
width, height: integer;
|
|
cwidth: integer;
|
|
cheight: integer;
|
|
begin
|
|
if fUseGDIPlus then
|
|
begin
|
|
|
|
OrdCor(X1, Y1, X2, Y2);
|
|
|
|
width := X2 - X1;
|
|
height := Y2 - Y1;
|
|
|
|
if(X3 > width) then
|
|
X3 := width;
|
|
if(Y3 > height) then
|
|
Y3 := height;
|
|
|
|
cwidth := X3;
|
|
cheight := Y3;
|
|
|
|
IE_GdipCreatePath(0, path);
|
|
|
|
IE_GdipAddPathArc(path, x1, y1, cwidth, cheight, 180, 90);
|
|
|
|
if X3 = 20 then
|
|
begin
|
|
inc(cwidth);
|
|
dec(width);
|
|
end;
|
|
if Y3 = 20 then
|
|
begin
|
|
inc(cheight);
|
|
dec(height);
|
|
end;
|
|
|
|
IE_GdipAddPathArc(path, x1 + width - X3 - 1, y1, cwidth, cheight, 270, 90);
|
|
IE_GdipAddPathArc(path, x1 + width - X3 - 1, y1 + height - Y3 - 1, cwidth, cheight, 0, 90);
|
|
IE_GdipAddPathArc(path, x1, y1 + height - Y3 - 1, cwidth, cheight, 90, 90);
|
|
|
|
IE_GdipClosePathFigure(path);
|
|
IE_GdipFillPath(fGraphics, fBrush.fGHandle, path);
|
|
IE_GdipDrawPath(fGraphics, fPen.fGHandle, path);
|
|
IE_GdipDeletePath(path);
|
|
end
|
|
else
|
|
fCanvas.RoundRect(X1, Y1, X2, Y2, X3, Y3);
|
|
end;
|
|
//}
|
|
|
|
// angle in degrees
|
|
procedure TIECanvas.Rotate(Angle: double);
|
|
begin
|
|
if fUseGDIPlus then
|
|
begin
|
|
IE_GdipRotateWorldTransform(fGraphics, Angle, 0);
|
|
end;
|
|
end;
|
|
|
|
procedure TIECanvas.Translate(dx: double; dy: double);
|
|
begin
|
|
if fUseGDIPlus then
|
|
begin
|
|
IE_GdipTranslateWorldTransform(fGraphics, dx, dy, 0);
|
|
end;
|
|
OffsetViewportOrgEx(fCanvas.Handle, trunc(dx), trunc(dy), nil);
|
|
end;
|
|
|
|
procedure TIECanvas.ResetTransform();
|
|
begin
|
|
if fUseGDIPlus then
|
|
begin
|
|
IE_GdipResetWorldTransform(fGraphics);
|
|
end;
|
|
end;
|
|
|
|
procedure TIECanvas.Draw(Metafile: TIEMetaFile; x: double; y: double; width: single; height: single);
|
|
begin
|
|
IE_GdipDrawImageRect(fGraphics, Metafile.Handle, x, y, width, height);
|
|
end;
|
|
|
|
|
|
|
|
procedure TIECanvas.GradientFillRect(aRect: TRect; FromColor, ToColor: TColor; VerticalGradient: Boolean);
|
|
var
|
|
i: integer;
|
|
fromR, fromG, fromB: Byte;
|
|
diffR, diffG, diffB: integer;
|
|
drawWidth, drawHeight : Integer;
|
|
wasPenStyle : TPenStyle;
|
|
wasPenMode : TPenMode;
|
|
wasPenWidth : Single;
|
|
wasPenColor : TColor;
|
|
begin
|
|
fromR := GetRValue(ColorToRGB(fromColor));
|
|
fromG := GetGValue(ColorToRGB(fromColor));
|
|
fromB := GetBValue(ColorToRGB(fromColor));
|
|
diffR := GetRValue(ColorToRGB(toColor)) - fromR;
|
|
diffG := GetGValue(ColorToRGB(toColor)) - fromG;
|
|
diffB := GetBValue(ColorToRGB(toColor)) - fromB;
|
|
|
|
drawWidth := aRect.Right - aRect.Left;
|
|
drawHeight := aRect.Bottom - aRect.Top;
|
|
|
|
wasPenStyle := Pen.Style;
|
|
wasPenMode := Pen.Mode;
|
|
wasPenWidth := Pen.Width;
|
|
wasPenColor := Pen.Color;
|
|
|
|
try
|
|
Pen.Style := psSolid;
|
|
Pen.Mode := pmCopy;
|
|
Pen.Width := 1;
|
|
|
|
if VerticalGradient then
|
|
begin
|
|
if drawHeight < 2 then
|
|
exit;
|
|
|
|
for i := 0 to drawHeight - 1 do
|
|
begin
|
|
Pen.Color := RGB( fromR + MulDiv( i, diffR, drawHeight - 1 ),
|
|
fromG + MulDiv( i, diffG, drawHeight - 1 ),
|
|
fromB + MulDiv( i, diffB, drawHeight - 1 ));
|
|
MoveTo( aRect.Left - 1, aRect.Top + i );
|
|
LineTo( aRect.Right, aRect.Top + i );
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if drawWidth < 2 then
|
|
exit;
|
|
|
|
for i := 0 to drawWidth - 1 do
|
|
begin
|
|
Pen.Color := RGB( fromR + MulDiv( i, diffR, drawWidth - 1 ),
|
|
fromG + MulDiv( i, diffG, drawWidth - 1 ),
|
|
fromB + MulDiv( i, diffB, drawWidth - 1 ));
|
|
MoveTo( aRect.Left + i, aRect.Top - 1 );
|
|
LineTo( aRect.Left + i, aRect.Bottom );
|
|
end;
|
|
end;
|
|
|
|
finally
|
|
Pen.Style := wasPenStyle;
|
|
Pen.Mode := wasPenMode;
|
|
Pen.Width := wasPenWidth;
|
|
Pen.Color := wasPenColor;
|
|
end;
|
|
end;
|
|
|
|
procedure TIECanvas.Flush();
|
|
begin
|
|
if fUseGDIPlus then
|
|
IE_GdipFlush(fGraphics, 1); // intention = synch
|
|
end;
|
|
|
|
|
|
// end of TIECanvas
|
|
////////////////////////////////////////////////////////////////////////////////////////////
|
|
////////////////////////////////////////////////////////////////////////////////////////////
|
|
|
|
|
|
|
|
|
|
////////////////////////////////////////////////////////////////////////////////////////////
|
|
////////////////////////////////////////////////////////////////////////////////////////////
|
|
// TIEPen
|
|
|
|
constructor TIEPen.Create(Pen: TPen);
|
|
begin
|
|
inherited Create;
|
|
fPen := Pen;
|
|
fGHandle := nil;
|
|
fTransparency := 255;
|
|
if assigned(Pen) then
|
|
begin
|
|
fColor := Pen.Color;
|
|
fWidth := Pen.Width;
|
|
fStyle := Pen.Style;
|
|
fMode := Pen.Mode;
|
|
end
|
|
else
|
|
begin
|
|
fColor := clWhite;
|
|
fWidth := 1;
|
|
fStyle := psSolid;
|
|
fMode := pmCopy;
|
|
end;
|
|
fLineJoin := ieljMiter;
|
|
if IEGDIPEnabled then
|
|
ReCreatePen;
|
|
end;
|
|
|
|
destructor TIEPen.Destroy;
|
|
begin
|
|
if IEGDIPEnabled then
|
|
IE_GdipDeletePen(fGHandle);
|
|
inherited;
|
|
end;
|
|
|
|
function TIEPen.GetARGBColor(): ARGB;
|
|
begin
|
|
if fStyle = psClear then
|
|
result := CreateARGB2(fColor, 0)
|
|
else
|
|
result := CreateARGB2(fColor, fTransparency);
|
|
end;
|
|
|
|
procedure TIEPen.ReCreatePen;
|
|
const
|
|
UnitPixel = 2;
|
|
begin
|
|
if fGHandle<>nil then
|
|
IE_GdipDeletePen(fGHandle);
|
|
fGHandle := nil;
|
|
IE_GdipCreatePen1(GetARGBColor(), fWidth, UnitPixel, fGHandle);
|
|
if fGHandle=nil then
|
|
raise EIEException.Create('Cannot create TIEPen. Ensure GDI+ is installed on system.');
|
|
SetStyle( fStyle );
|
|
SetLineJoin( fLineJoin );
|
|
end;
|
|
|
|
procedure TIEPen.SetTColor(value: TColor);
|
|
begin
|
|
fColor := value;
|
|
if IEGDIPEnabled then
|
|
IE_GdipSetPenColor(fGHandle, GetARGBColor());
|
|
if assigned(fPen) then
|
|
fPen.Color := value;
|
|
end;
|
|
|
|
procedure TIEPen.SetTransparency(value: integer);
|
|
begin
|
|
fTransparency := value;
|
|
if IEGDIPEnabled then
|
|
IE_GdipSetPenColor(fGHandle, GetARGBColor());
|
|
end;
|
|
|
|
procedure TIEPen.SetWidth(value: single);
|
|
begin
|
|
fWidth := value;
|
|
if IEGDIPEnabled then
|
|
IE_GdipSetPenWidth(fGHandle, fWidth);
|
|
if assigned(fPen) then
|
|
fPen.Width := trunc(value);
|
|
end;
|
|
|
|
procedure TIEPen.SetStyle(value: TPenStyle);
|
|
begin
|
|
fStyle := value;
|
|
if IEGDIPEnabled then
|
|
case fStyle of
|
|
psClear:
|
|
begin
|
|
IE_GdipSetPenColor(fGHandle, GetARGBColor());
|
|
IE_GdipSetPenDashStyle(fGHandle, 0);
|
|
end;
|
|
psInsideFrame:
|
|
IE_GdipSetPenDashStyle(fGHandle, 0);
|
|
else
|
|
IE_GdipSetPenDashStyle(fGHandle, integer(fStyle));
|
|
end;
|
|
if assigned(fPen) then
|
|
fPen.Style := value;
|
|
end;
|
|
|
|
// unsupported in GDI+
|
|
procedure TIEPen.SetMode(value: TPenMode);
|
|
begin
|
|
if assigned(fPen) then
|
|
fPen.Mode := value;
|
|
end;
|
|
|
|
procedure TIEPen.SetLineJoin(value: TIECanvasPenLineJoin);
|
|
begin
|
|
fLineJoin := value;
|
|
if IEGDIPEnabled then
|
|
IE_GdipSetPenLineJoin(fGHandle, ULONG(value));
|
|
end;
|
|
|
|
procedure TIEPen.SetVHandle(value: HPen);
|
|
begin
|
|
if assigned(fPen) then
|
|
fPen.Handle := value;
|
|
end;
|
|
|
|
function TIEPen.GetVHandle: HPen;
|
|
begin
|
|
if assigned(fPen) then
|
|
result := fPen.Handle
|
|
else
|
|
result := 0;
|
|
end;
|
|
|
|
|
|
// end of TIEPen
|
|
////////////////////////////////////////////////////////////////////////////////////////////
|
|
////////////////////////////////////////////////////////////////////////////////////////////
|
|
|
|
|
|
|
|
|
|
////////////////////////////////////////////////////////////////////////////////////////////
|
|
////////////////////////////////////////////////////////////////////////////////////////////
|
|
// TIEBrush
|
|
|
|
constructor TIEBrush.Create(Brush: TBrush);
|
|
begin
|
|
inherited Create;
|
|
fBrush := Brush;
|
|
fGHandle := nil;
|
|
if assigned(Brush) then
|
|
begin
|
|
fColor := Brush.Color;
|
|
fStyle := Brush.Style;
|
|
end
|
|
else
|
|
begin
|
|
fColor := clWhite;
|
|
fStyle := bsSolid;
|
|
end;
|
|
fBackColor := clBlack;
|
|
fBackTransparency := 0;
|
|
fTransparency := 255;
|
|
if IEGDIPEnabled then
|
|
ReCreateBrush;
|
|
end;
|
|
|
|
destructor TIEBrush.Destroy;
|
|
begin
|
|
if IEGDIPEnabled then
|
|
IE_GdipDeleteBrush(fGHandle);
|
|
inherited;
|
|
end;
|
|
|
|
function TIEBrush.GetARGBColor(): ARGB;
|
|
begin
|
|
if fStyle = bsClear then
|
|
result := CreateARGB2(fColor, 0)
|
|
else
|
|
result := CreateARGB2(fColor, fTransparency);
|
|
end;
|
|
|
|
procedure TIEBrush.ReCreateBrush;
|
|
begin
|
|
if fGHandle <> nil then
|
|
IE_GdipDeleteBrush(fGHandle);
|
|
fGHandle := nil;
|
|
case fStyle of
|
|
bsSolid, bsClear:
|
|
begin
|
|
IE_GdipCreateSolidFill(GetARGBColor(), fGHandle);
|
|
if fGHandle = nil then
|
|
raise EIEException.Create('Cannot create TIEBrush (1). Ensure GDI+ is installed on system.');
|
|
end;
|
|
bsHorizontal, bsVertical, bsFDiagonal, bsBDiagonal, bsCross, bsDiagCross:
|
|
begin
|
|
IE_GdipCreateHatchBrush(integer(fStyle)-2, GetARGBColor(), CreateARGB2(fBackColor, fBackTransparency), fGHandle);
|
|
if fGHandle = nil then
|
|
raise EIEException.Create('Cannot create TIEBrush (2). Ensure GDI+ is installed on system.');
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// not implemented in GDI+
|
|
function TIEBrush.GetBitmap: TBitmap;
|
|
begin
|
|
if assigned(fBrush) then
|
|
result := fBrush.Bitmap
|
|
else
|
|
result := nil;
|
|
end;
|
|
|
|
// not implemented in GDI+
|
|
procedure TIEBrush.SetBitmap(value: TBitmap);
|
|
begin
|
|
if assigned(fBrush) then
|
|
fBrush.Bitmap := value;
|
|
end;
|
|
|
|
procedure TIEBrush.SetTColor(value: TColor);
|
|
begin
|
|
fColor := value;
|
|
if IEGDIPEnabled then
|
|
ReCreateBrush;
|
|
if assigned(fBrush) then
|
|
fBrush.Color := value;
|
|
end;
|
|
|
|
procedure TIEBrush.SetBackTColor(value: TColor);
|
|
begin
|
|
fBackColor := value;
|
|
if IEGDIPEnabled then
|
|
ReCreateBrush;
|
|
end;
|
|
|
|
procedure TIEBrush.SetTransparency(value: integer);
|
|
begin
|
|
fTransparency := value;
|
|
if IEGDIPEnabled then
|
|
ReCreateBrush;
|
|
end;
|
|
|
|
procedure TIEBrush.SetBackTransparency(value: integer);
|
|
begin
|
|
fBackTransparency := value;
|
|
if IEGDIPEnabled then
|
|
ReCreateBrush;
|
|
end;
|
|
|
|
procedure TIEBrush.SetStyle(value: TBrushStyle);
|
|
begin
|
|
fStyle := value;
|
|
if IEGDIPEnabled then
|
|
ReCreateBrush;
|
|
if assigned(fBrush) then
|
|
fBrush.Style := value;
|
|
end;
|
|
|
|
|
|
// end of TIEBrush
|
|
////////////////////////////////////////////////////////////////////////////////////////////
|
|
////////////////////////////////////////////////////////////////////////////////////////////
|
|
|
|
|
|
|
|
////////////////////////////////////////////////////////////////////////////////////////////
|
|
////////////////////////////////////////////////////////////////////////////////////////////
|
|
// TIEEmptyCanvas
|
|
|
|
constructor TIEEmptyCanvas.Create();
|
|
begin
|
|
fTempBitmap := TBitmap.Create();
|
|
fTempBitmap.PixelFormat := pf24bit;
|
|
inherited Create(fTempBitmap.Canvas);
|
|
end;
|
|
|
|
destructor TIEEmptyCanvas.Destroy();
|
|
begin
|
|
fTempBitmap.Free();
|
|
inherited;
|
|
end;
|
|
|
|
|
|
|
|
////////////////////////////////////////////////////////////////////////////////////////////
|
|
////////////////////////////////////////////////////////////////////////////////////////////
|
|
// TIEMetafile
|
|
|
|
constructor TIEMetafile.Create(const Filename: WideString);
|
|
begin
|
|
fHandle := nil;
|
|
IE_GdipCreateMetafileFromFile(PWideChar(Filename), fHandle);
|
|
FillHeader();
|
|
end;
|
|
|
|
constructor TIEMetafile.Create(Stream: TStream);
|
|
begin
|
|
IE_GdipCreateMetafileFromStream(TStreamAdapter.Create(Stream) as IStream, fHandle);
|
|
FillHeader();
|
|
end;
|
|
|
|
procedure TIEMetafile.FillHeader();
|
|
begin
|
|
FillChar(fHeader, sizeof(fHeader), 0);
|
|
if fHandle <> nil then
|
|
IE_GdipGetMetafileHeaderFromMetafile(fHandle, fHeader);
|
|
end;
|
|
|
|
destructor TIEMetafile.Destroy();
|
|
begin
|
|
if fHandle <> nil then
|
|
IE_GdipDisposeImage(fHandle);
|
|
end;
|
|
|
|
function TIEMetafile.GetWidth(): integer;
|
|
begin
|
|
result := fHeader.Width;
|
|
end;
|
|
|
|
function TIEMetafile.GetHeight(): integer;
|
|
begin
|
|
result := fHeader.Height;
|
|
end;
|
|
|
|
function TIEMetafile.IsWmf(): boolean;
|
|
begin
|
|
result := (fHeader.Type_ = IEMetafileTypeWmf) or (fHeader.Type_ = IEMetafileTypeWmfPlaceable);
|
|
end;
|
|
|
|
function TIEMetafile.IsEmf(): boolean;
|
|
begin
|
|
result := (fHeader.Type_ = IEMetafileTypeEmf);
|
|
end;
|
|
|
|
function TIEMetafile.IsEmfPlus(): boolean;
|
|
begin
|
|
result := (fHeader.Type_ >= IEMetafileTypeEmfPlusOnly);
|
|
end;
|
|
|
|
function TIEMetafile.IsEmfPlusDual(): boolean;
|
|
begin
|
|
result := (fHeader.Type_ = IEMetafileTypeEmfPlusDual);
|
|
end;
|
|
|
|
|
|
////////////////////////////////////////////////////////////////////////////////////////////
|
|
////////////////////////////////////////////////////////////////////////////////////////////
|
|
|
|
|
|
|
|
|
|
// note: don't call here IEGDIPLoadLibrary()!! It Cannot be called in "initialization" sections.
|
|
procedure IEInitialize_iegdiplus();
|
|
begin
|
|
IE_GDIPlusHandle := 0;
|
|
gdiplusRefCount := 0;
|
|
gdiplusCriticalSection := TCriticalSection.Create();
|
|
end;
|
|
|
|
// note: don't call here IEGDIPUnLoadLibrary()!!
|
|
procedure IEFinalize_iegdiplus();
|
|
begin
|
|
gdiplusCriticalSection.Free();
|
|
end;
|
|
|
|
|
|
end.
|
|
|