Changeset 522 for GraphicTest/Packages/Graphics32/GR32_Backends_LCL_Win.pas

Timestamp:

Apr 17, 2019, 10:42:18 AM (5 years ago)

Author:

chronos

Message:

• Modified: Updated Graphics32 library.

Location:

GraphicTest/Packages/Graphics32

Files:

• . (modified) (1 prop)
• GR32_Backends_LCL_Win.pas (modified) (16 diffs)

GraphicTest/Packages/Graphics32/GR32_Backends_LCL_Win.pas

@@ -42 +42 @@
   {$IFDEF LCLWin32} Windows, {$ENDIF} LCLIntf, LCLType, Types, Controls,
   SysUtils, Classes, Graphics, GR32, GR32_Backends, GR32_Backends_Generic,
-  GR32_Containers, GR32_Image;
+  GR32_Containers, GR32_Image, GR32_Paths;
 
 type
@@ -51 +51 @@
   TLCLBackend = class(TCustomBackend, IPaintSupport,
     IBitmapContextSupport, IDeviceContextSupport,
-    ITextSupport, IFontSupport, ICanvasSupport)
+    ITextSupport, IFontSupport, ITextToPathSupport, ICanvasSupport)
   private
     procedure FontChangedHandler(Sender: TObject);
@@ -104 +104 @@
 
     { ITextSupport }
-    procedure Textout(X, Y: Integer; const Text: String); overload;
-    procedure Textout(X, Y: Integer; const ClipRect: TRect; const Text: String); overload;
-    procedure Textout(var DstRect: TRect; const Flags: Cardinal; const Text: String); overload;
-    function  TextExtent(const Text: String): TSize;
+    procedure Textout(X, Y: Integer; const Text: string); overload;
+    procedure Textout(X, Y: Integer; const ClipRect: TRect; const Text: string); overload;
+    procedure Textout(var DstRect: TRect; const Flags: Cardinal; const Text: string); overload;
+    function  TextExtent(const Text: string): TSize;
 
     procedure TextoutW(X, Y: Integer; const Text: Widestring); overload;
@@ -123 +123 @@
     property Font: TFont read GetFont write SetFont;
     property OnFontChange: TNotifyEvent read FOnFontChange write FOnFontChange;
+
+    { ITextToPathSupport }
+    procedure TextToPath(Path: TCustomPath; const X, Y: TFloat; const Text: WideString); overload;
+    procedure TextToPath(Path: TCustomPath; const DstRect: TFloatRect; const Text: WideString; Flags: Cardinal); overload;
+    function MeasureText(const DstRect: TFloatRect; const Text: WideString; Flags: Cardinal): TFloatRect;
 
     { ICanvasSupport }
@@ -182 +187 @@
 implementation
 
+uses
+  GR32_Text_LCL_Win;
+
 var
   StockFont: HFONT;
@@ -293 +301 @@
 end;
 
-function TLCLBackend.TextExtent(const Text: String): TSize;
+function TLCLBackend.TextExtent(const Text: string): TSize;
 var
   DC: HDC;
@@ -342 +350 @@
 end;
 
-procedure TLCLBackend.Textout(X, Y: Integer; const Text: String);
+procedure TLCLBackend.Textout(X, Y: Integer; const Text: string);
 var
   Extent: TSize;
@@ -360 +368 @@
 end;
 
-procedure TLCLBackend.TextoutW(X, Y: Integer; const Text: WideString);
+procedure TLCLBackend.TextoutW(X, Y: Integer; const Text: Widestring);
 var
   Extent: TSize;
@@ -378 +386 @@
 end;
 
-procedure TLCLBackend.TextoutW(X, Y: Integer; const ClipRect: TRect;
-  const Text: Widestring);
+procedure TLCLBackend.TextoutW(X, Y: Integer; const ClipRect: TRect; const Text: Widestring);
 var
   Extent: TSize;
@@ -386 +393 @@
 
   if not FOwner.MeasuringMode then
-    ExtTextoutW(Handle, X, Y, ETO_CLIPPED, @ClipRect, PWideChar(Text),
-      Length(Text), nil);
+    ExtTextoutW(Handle, X, Y, ETO_CLIPPED, @ClipRect, PWideChar(Text), Length(Text), nil);
 
   Extent := TextExtentW(Text);
@@ -393 +399 @@
 end;
 
-procedure TLCLBackend.Textout(X, Y: Integer; const ClipRect: TRect;
-  const Text: String);
+procedure TLCLBackend.Textout(X, Y: Integer; const ClipRect: TRect; const Text: string);
 var
   Extent: TSize;
@@ -407 +412 @@
 end;
 
-procedure TLCLBackend.TextoutW(var DstRect: TRect; const Flags: Cardinal;
-  const Text: Widestring);
+procedure TLCLBackend.TextoutW(var DstRect: TRect; const Flags: Cardinal; const Text: Widestring);
 begin
   UpdateFont;
@@ -435 +439 @@
 end;
 
-procedure TLCLBackend.Textout(var DstRect: TRect; const Flags: Cardinal;
-  const Text: String);
+procedure TLCLBackend.TextToPath(Path: TCustomPath; const X, Y: TFloat;
+  const Text: WideString);
+var
+  R: TFloatRect;
+begin
+  R := FloatRect(X, Y, X, Y);
+  GR32_Text_LCL_Win.TextToPath(Font.Handle, Path, R, Text, 0);
+end;
+
+procedure TLCLBackend.TextToPath(Path: TCustomPath; const DstRect: TFloatRect;
+  const Text: WideString; Flags: Cardinal);
+begin
+  GR32_Text_LCL_Win.TextToPath(Font.Handle, Path, DstRect, Text, Flags);
+end;
+
+function TLCLBackend.MeasureText(const DstRect: TFloatRect;
+  const Text: WideString; Flags: Cardinal): TFloatRect;
+begin
+  Result := GR32_Text_LCL_Win.MeasureText(Font.Handle, DstRect, Text, Flags);
+end;
+
+procedure TLCLBackend.Textout(var DstRect: TRect; const Flags: Cardinal; const Text: string);
 begin
   UpdateFont;
@@ -703 +727 @@
 procedure TLCLMemoryBackend.DrawTo(hDst: HDC; DstX, DstY: Integer);
 var
-  Bitmap        : HBITMAP;
-  DeviceContext : HDC;
-  Buffer        : Pointer;
-  OldObject     : HGDIOBJ;
+  Bitmap: HBITMAP;
+  DeviceContext: HDC;
+  Buffer: Pointer;
+  OldObject: HGDIOBJ;
 begin
   {$IFDEF LCLWin32}
@@ -746 +770 @@
 procedure TLCLMemoryBackend.DrawTo(hDst: HDC; const DstRect, SrcRect: TRect);
 var
-  Bitmap        : HBITMAP;
-  DeviceContext : HDC;
-  Buffer        : Pointer;
-  OldObject     : HGDIOBJ;
+  Bitmap: HBITMAP;
+  DeviceContext: HDC;
+  Buffer: Pointer;
+  OldObject: HGDIOBJ;
 begin
   {$IFDEF LCLWin32}
@@ -761 +785 @@
     if DeviceContext <> 0 then
     try
+      Buffer := nil;
       Bitmap := CreateDIBSection(DeviceContext, FBitmapInfo, DIB_RGB_COLORS,
         Buffer, 0, 0);