(* 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; {!! TIECanvas Description 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 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.