Changeset 568 for trunk/Packages/DpiControls/Dpi.Graphics.pas

Timestamp:

May 13, 2024, 6:00:06 PM (2 years ago)

Author:

chronos

Message:

• Fixed: Custom draw ListBox items to keep consistent style on Linux.
• Fixed: Last game name index error if no saved games.

File:

• trunk/Packages/DpiControls/Dpi.Graphics.pas (modified) (9 diffs)

trunk/Packages/DpiControls/Dpi.Graphics.pas

@@ -8 +8 @@
 const
   clBlack = TColor($000000);
+  clWhite = TColor($ffffff);
 
 type
@@ -92 +93 @@
 
   TBrushStyle = Graphics.TBrushStyle;
+  TPenStyle = Graphics.TPenStyle;
 
   { TBrush }
@@ -131 +133 @@
     function GetHandle: HDC;
     function GetPixel(X, Y: Integer): TColor;
+    function GetTextStyle: TTextStyle;
     procedure SetBrush(AValue: TBrush);
     procedure SetFont(AValue: TFont);
@@ -137 +140 @@
     procedure SetPixel(X, Y: Integer; AValue: TColor);
     procedure SetNativeCanvas(AValue: Graphics.TCanvas);
+    procedure SetTextStyle(AValue: TTextStyle);
   protected
     procedure DoLine(X1, Y1, X2, Y2: Integer); virtual;
@@ -182 +186 @@
     function TextExtent(const Text: string): TSize; virtual;
     procedure TextOut(X, Y: Integer; const Text: string); virtual;
-    procedure TextRect(ARect: TRect; X, Y: Integer; Text: string);
+    procedure TextRect(ARect: TRect; X, Y: Integer; Text: string); overload;
+    procedure TextRect(ARect: TRect; X, Y: integer; const Text: string;
+      const Style: TTextStyle); overload;
     procedure MoveTo(X, Y: Integer);
     procedure LineTo(X, Y: Integer);
@@ -196 +202 @@
     property Width: Integer read GetWidth;
     property Height: Integer read GetHeight;
+    property TextStyle: TTextStyle read GetTextStyle write SetTextStyle;
   published
     property Brush: TBrush read FBrush write SetBrush;
@@ -966 +973 @@
 end;
 
+function TCanvas.GetTextStyle: TTextStyle;
+begin
+  Result := GetNativeCanvas.TextStyle;
+end;
+
 function TCanvas.GetWidth: Integer;
 begin
@@ -1039 +1051 @@
 end;
 
+procedure TCanvas.SetTextStyle(AValue: TTextStyle);
+begin
+  GetNativeCanvas.TextStyle := AValue;
+end;
+
 procedure TCanvas.DoLine(X1, Y1, X2, Y2: Integer);
 begin
@@ -1213 +1230 @@
 procedure TCanvas.TextRect(ARect: TRect; X, Y: Integer; Text: string);
 begin
-  GetNativeCanvas.TextRect(ScaleRectToNative(ARect), ScaleToNative(X), ScaleToNative(Y), Text);
+  GetNativeCanvas.TextRect(ScaleRectToNative(ARect), ScaleToNative(X),
+    ScaleToNative(Y), Text);
+end;
+
+procedure TCanvas.TextRect(ARect: TRect; X, Y: integer; const Text: string;
+  const Style: TTextStyle);
+begin
+  GetNativeCanvas.TextRect(ScaleRectToNative(ARect), ScaleToNative(X),
+    ScaleToNative(Y), Text, TextStyle);
 end;