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

Timestamp:

May 13, 2024, 6:00:06 PM (5 weeks 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.StdCtrls.pas (modified) (12 diffs)

trunk/Packages/DpiControls/Dpi.StdCtrls.pas

@@ -4 +4 @@
 
 uses
-  Classes, SysUtils, Controls, StdCtrls, Forms, Dpi.Controls;
+  Classes, SysUtils, Controls, StdCtrls, Forms, Dpi.Controls, Dpi.Graphics;
 
 type
@@ -104 +104 @@
   end;
 
+  TDrawItemEvent = procedure(Control: TWinControl; Index: Integer;
+    ARect: TRect; State: TOwnerDrawState) of object;
+  TListBoxStyle = StdCtrls.TListBoxStyle;
+
   { TListBox }
 
   TListBox = class(TWinControl)
   private
+    FCanvas: TCanvas;
+    FOnDrawItem: TDrawItemEvent;
     function GetBorderStyle: TBorderStyle;
     function GetCount: Integer;
@@ -118 +124 @@
     function GetParentFont: Boolean;
     function GetScrollWidth: Integer;
+    function GetStyle: TListBoxStyle;
     function GetTopIndex: Integer;
     procedure SetBorderStyle(AValue: TBorderStyle);
@@ -125 +132 @@
     procedure SetItemIndex(AValue: Integer);
     procedure SetItems(AValue: TStrings);
+    procedure SetOnDrawItem(AValue: TDrawItemEvent);
     procedure SetOnSelectionChange(AValue: TSelectionChangeEvent);
     procedure SetParentFont(AValue: Boolean);
     procedure SetScrollWidth(AValue: Integer);
+    procedure SetStyle(AValue: TListBoxStyle);
     procedure SetTopIndex(AValue: Integer);
+    procedure DoDrawItemNative(Control: Controls.TWinControl; Index: Integer;
+      ARect: TRect; State: TOwnerDrawState);
   protected
     function GetNativeWinControl: Controls.TWinControl; override;
@@ -134 +145 @@
   public
     NativeListBox: StdCtrls.TListBox;
+    constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     property ItemIndex: Integer read GetItemIndex write SetItemIndex;
     property Items: TStrings read GetItems write SetItems;
     property Count: Integer read GetCount;
+    property Canvas: TCanvas read FCanvas;
   published
     property ParentColor;
@@ -151 +164 @@
     property OnSelectionChange: TSelectionChangeEvent read GetOnSelectionChange
                                                       write SetOnSelectionChange;
+    property Style: TListBoxStyle read GetStyle write SetStyle default lbStandard;
+    property OnDrawItem: TDrawItemEvent read FOnDrawItem write SetOnDrawItem;
   end;
 
@@ -497 +512 @@
 function TListBox.GetItemHeight: Integer;
 begin
-  Result := GetNativeListBox.ItemHeight;
+  Result := ScaleFromNative(GetNativeListBox.ItemHeight);
 end;
 
@@ -525 +540 @@
 end;
 
+function TListBox.GetStyle: TListBoxStyle;
+begin
+  Result := GetNativeListBox.Style;
+end;
+
 function TListBox.GetTopIndex: Integer;
 begin
@@ -547 +567 @@
 procedure TListBox.SetItemHeight(AValue: Integer);
 begin
-  GetNativeListBox.ItemHeight := AValue;
+  GetNativeListBox.ItemHeight := ScaleToNative(AValue);
 end;
 
@@ -560 +580 @@
 end;
 
+procedure TListBox.SetOnDrawItem(AValue: TDrawItemEvent);
+begin
+  FOnDrawItem := AValue;
+  if Assigned(AValue) then
+    GetNativeListBox.OnDrawItem := DoDrawItemNative
+    else GetNativeListBox.OnDrawItem := nil;
+end;
+
 procedure TListBox.SetOnSelectionChange(AValue: TSelectionChangeEvent);
 begin
@@ -575 +603 @@
 end;
 
+procedure TListBox.SetStyle(AValue: TListBoxStyle);
+begin
+  GetNativeListBox.Style := AValue;
+end;
+
 procedure TListBox.SetTopIndex(AValue: Integer);
 begin
   GetNativeListBox.TopIndex := AValue;
+end;
+
+procedure TListBox.DoDrawItemNative(Control: Controls.TWinControl;
+  Index: Integer; ARect: TRect; State: TOwnerDrawState);
+begin
+  if Assigned(FOnDrawItem) then
+    FOnDrawItem(Self, Index, ScaleRectFromNative(ARect), State);
 end;
 
@@ -591 +631 @@
 end;
 
+constructor TListBox.Create(AOwner: TComponent);
+begin
+  inherited;
+  FCanvas := TCanvas.Create;
+  FCanvas.NativeCanvas := GetNativeListBox.Canvas;
+end;
+
 destructor TListBox.Destroy;
 begin
+  FreeAndNil(FCanvas);
   FreeAndNil(NativeListBox);
   inherited;