View Issue Details

IDProjectCategoryView StatusLast Update
0037310PatchesPackagespublic2020-07-19 12:29
ReporterSalvadorbs Assigned ToBalázs Székely  
PrioritynormalSeverityminorReproducibilityhave not tried
Status resolvedResolutionfixed 
Summary0037310: Patch fix for TLazVTV (restores toUseExplorerTheme and fix LCLCocoa "Range check error" in InitializeGlobalStructure)
DescriptionI make a patch for TVirtualTree and I make a patch for TLazVirtualTree. This patch restores toUseExplorerTheme (for only Windows platform) and fix LCLCocoa "Range check error" in InitializeGlobalStructures (use TClipboardFormat instead Word).

More info https://github.com/blikblum/VirtualTreeView-Lazarus/pull/18 and https://github.com/blikblum/VirtualTreeView-Lazarus/issues/12

Thank you.
TagsNo tags attached.
Fixed in Revision
LazTarget-
WidgetsetWin32/Win64, Cocoa
Attached Files

Activities

Salvadorbs

2020-07-07 17:44

reporter  

0001-Restored-toUseExplorerTheme-and-fix-LCLCocoa-Range-c.patch (16,742 bytes)   
From 91023f5c49e3e4d76819cd817bf59b7c29f72f50 Mon Sep 17 00:00:00 2001
From: Matteo Salvi <salvadorbs@gmail.com>
Date: Tue, 7 Jul 2020 16:21:27 +0200
Subject: [PATCH] Restored toUseExplorerTheme and fix LCLCocoa Range check
 error in InitializeGlobalStructures

---
 .../include/intf/laz.dummyolemethods.inc      |   2 +-
 .../include/intf/win32/laz.olemethods.inc     |   2 +-
 .../virtualtreeview/laz.virtualtrees.pas      | 135 ++++++++++--------
 .../units/laz.dummyactivex.inc                |   4 +-
 4 files changed, 80 insertions(+), 63 deletions(-)

diff --git a/components/virtualtreeview/include/intf/laz.dummyolemethods.inc b/components/virtualtreeview/include/intf/laz.dummyolemethods.inc
index 3a64ada4ec..417e6e5da7 100644
--- a/components/virtualtreeview/include/intf/laz.dummyolemethods.inc
+++ b/components/virtualtreeview/include/intf/laz.dummyolemethods.inc
@@ -291,7 +291,7 @@ end;
 
 //----------------------------------------------------------------------------------------------------------------------
 
-function TCustomVirtualStringTree.ContentToClipboard(Format: Word; Source: TVSTTextSourceType): HGLOBAL;
+function TCustomVirtualStringTree.ContentToClipboard(Format: TClipboardFormat; Source: TVSTTextSourceType): HGLOBAL;
 
 // This method constructs a shareable memory object filled with string data in the required format. Supported are:
 // CF_TEXT - plain ANSI text (Unicode text is converted using the user's current locale)
diff --git a/components/virtualtreeview/include/intf/win32/laz.olemethods.inc b/components/virtualtreeview/include/intf/win32/laz.olemethods.inc
index 60f488a777..6c25b9371d 100644
--- a/components/virtualtreeview/include/intf/win32/laz.olemethods.inc
+++ b/components/virtualtreeview/include/intf/win32/laz.olemethods.inc
@@ -284,7 +284,7 @@ end;
 
 //----------------------------------------------------------------------------------------------------------------------
 
-function TCustomVirtualStringTree.ContentToClipboard(Format: Word; Source: TVSTTextSourceType): HGLOBAL;
+function TCustomVirtualStringTree.ContentToClipboard(Format: TClipboardFormat; Source: TVSTTextSourceType): HGLOBAL;
 
 // This method constructs a shareable memory object filled with string data in the required format. Supported are:
 // CF_TEXT - plain ANSI text (Unicode text is converted using the user's current locale)
diff --git a/components/virtualtreeview/laz.virtualtrees.pas b/components/virtualtreeview/laz.virtualtrees.pas
index a3392692c4..e6dcb1dc2b 100644
--- a/components/virtualtreeview/laz.virtualtrees.pas
+++ b/components/virtualtreeview/laz.virtualtrees.pas
@@ -64,6 +64,7 @@ uses
   Windows,
   ActiveX,
   CommCtrl,
+  UxTheme,
   {$else}
   laz.FakeActiveX,
   {$endif}
@@ -244,6 +245,17 @@ const
   DEFAULT_NODE_HEIGHT = 18;
   DEFAULT_SPACING = 3;
 
+  LIS_NORMAL = 1;
+  {$EXTERNALSYM LIS_NORMAL}
+  LIS_HOT = 2;
+  {$EXTERNALSYM LIS_HOT}
+  LIS_SELECTED = 3;
+  {$EXTERNALSYM LIS_SELECTED}
+  LIS_DISABLED = 4;
+  {$EXTERNALSYM LIS_DISABLED}
+  LIS_SELECTEDNOTFOCUS = 5;
+  {$EXTERNALSYM LIS_SELECTEDNOTFOCUS}
+
 var // Clipboard format IDs used in OLE drag'n drop and clipboard transfers.
   CF_VIRTUALTREE,
   CF_VTREFERENCE,
@@ -251,7 +263,7 @@ var // Clipboard format IDs used in OLE drag'n drop and clipboard transfers.
   CF_VRTFNOOBJS,   // Unfortunately CF_RTF* is already defined as being
                    // registration strings so I have to use different identifiers.
   CF_HTML,
-  CF_CSV: Word;
+  CF_CSV: TClipboardFormat;
 
   MMXAvailable: Boolean; // necessary to know because the blend code uses MMX instructions
   IsWinVistaOrAbove: Boolean;
@@ -711,7 +723,7 @@ type
 
   // OLE drag'n drop support
   TFormatEtcArray = array of TFormatEtc;
-  TFormatArray = array of Word;
+  TFormatArray = array of TClipboardFormat;
 
   // IDataObject.SetData support
   TInternalStgMedium = packed record
@@ -3546,7 +3558,7 @@ type
     destructor Destroy(); override;
     function AddChild(Parent: PVirtualNode; UserData: Pointer = nil): PVirtualNode; override;
     function ComputeNodeHeight(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; S: String = ''): Integer; virtual;
-    function ContentToClipboard(Format: Word; Source: TVSTTextSourceType): HGLOBAL;
+    function ContentToClipboard(Format: TClipboardFormat; Source: TVSTTextSourceType): HGLOBAL;
     procedure ContentToCustom(Source: TVSTTextSourceType);
     function ContentToHTML(Source: TVSTTextSourceType; const Caption: String = ''): String;
     function ContentToRTF(Source: TVSTTextSourceType): AnsiString;
@@ -4087,8 +4099,8 @@ type
 // OLE Clipboard and drag'n drop helper
 procedure EnumerateVTClipboardFormats(TreeClass: TVirtualTreeClass; const List: TStrings); overload;
 procedure EnumerateVTClipboardFormats(TreeClass: TVirtualTreeClass; var Formats: TFormatEtcArray); overload;
-function GetVTClipboardFormatDescription(AFormat: Word): string;
-procedure RegisterVTClipboardFormat(AFormat: Word; TreeClass: TVirtualTreeClass; Priority: Cardinal); overload;
+function GetVTClipboardFormatDescription(AFormat: TClipboardFormat): string;
+procedure RegisterVTClipboardFormat(AFormat: TClipboardFormat; TreeClass: TVirtualTreeClass; Priority: Cardinal); overload;
 function RegisterVTClipboardFormat(Description: string; TreeClass: TVirtualTreeClass; Priority: Cardinal;
   tymed: Integer = TYMED_HGLOBAL; ptd: PDVTargetDevice = nil; dwAspect: Integer = DVASPECT_CONTENT;
   lindex: Integer = -1): Word; overload;
@@ -4395,8 +4407,8 @@ type
       const AllowedFormats: TClipboardFormats = nil); overload;
     procedure EnumerateFormats(TreeClass: TVirtualTreeClass; const Formats: TStrings); overload;
     function FindFormat(FormatString: string): PClipboardFormatListEntry; overload;
-    function FindFormat(FormatString: string; var Fmt: Word): TVirtualTreeClass; overload;
-    function FindFormat(Fmt: Word; out Description: string): TVirtualTreeClass; overload;
+    function FindFormat(FormatString: string; var Fmt: TClipboardFormat): TVirtualTreeClass; overload;
+    function FindFormat(Fmt: TClipboardFormat; out Description: string): TVirtualTreeClass; overload;
   end;
 
 var
@@ -4577,7 +4589,7 @@ end;
 
 //----------------------------------------------------------------------------------------------------------------------
 
-function TClipboardFormatList.FindFormat(FormatString: string; var Fmt: Word): TVirtualTreeClass;
+function TClipboardFormatList.FindFormat(FormatString: string; var Fmt: TClipboardFormat): TVirtualTreeClass;
 
 var
   I: Integer;
@@ -4599,7 +4611,7 @@ end;
 
 //----------------------------------------------------------------------------------------------------------------------
 
-function TClipboardFormatList.FindFormat(Fmt: Word; out Description: string): TVirtualTreeClass;
+function TClipboardFormatList.FindFormat(Fmt: TClipboardFormat; out Description: string): TVirtualTreeClass;
 
 var
   I: Integer;
@@ -4672,7 +4684,7 @@ end;
 
 //----------------------------------------------------------------------------------------------------------------------
 
-function GetVTClipboardFormatDescription(AFormat: Word): string;
+function GetVTClipboardFormatDescription(AFormat: TClipboardFormat): string;
 
 begin
   if InternalClipboardFormats = nil then
@@ -4683,7 +4695,7 @@ end;
 
 //----------------------------------------------------------------------------------------------------------------------
 
-procedure RegisterVTClipboardFormat(AFormat: Word; TreeClass: TVirtualTreeClass; Priority: Cardinal);
+procedure RegisterVTClipboardFormat(AFormat: TClipboardFormat; TreeClass: TVirtualTreeClass; Priority: Cardinal);
 
 // Registers the given clipboard format for the given TreeClass.
 
@@ -7424,8 +7436,9 @@ var
   TextSpacing: Integer;
   UseText: Boolean;
   R: TRect;
-  //todo
-  //Theme: HTHEME;
+  {$ifdef Windows}
+  Theme: HTHEME;
+  {$endif}
 
 begin
   UseText := Length(FText) > 0;
@@ -7462,9 +7475,12 @@ begin
       if tsUseExplorerTheme in FHeader.Treeview.FStates then
       begin
         R := Rect(0, 0, 100, 100);
-        //Theme := OpenThemeData(FHeader.Treeview.Handle, 'HEADER');
-        //GetThemePartSize(Theme, DC, HP_HEADERSORTARROW, HSAS_SORTEDUP, @R, TS_TRUE, SortGlyphSize);
-        //CloseThemeData(Theme);
+		
+	{$ifdef Windows}
+        Theme := OpenThemeData(FHeader.Treeview.Handle, 'HEADER');
+        GetThemePartSize(Theme, DC, HP_HEADERSORTARROW, HSAS_SORTEDUP, @R, TS_TRUE, SortGlyphSize);
+        CloseThemeData(Theme);
+	{$endif}
       end
       else
       begin
@@ -12247,7 +12263,7 @@ function TClipboardFormats.Add(const S: string): Integer;
 // ancestors.
 
 var
-  Format: Word;
+  Format: TClipboardFormat;
   RegisteredClass: TVirtualTreeClass;
 
 begin
@@ -12266,7 +12282,7 @@ procedure TClipboardFormats.Insert(Index: Integer; const S: string);
 // ancestors.
 
 var
-  Format: Word;
+  Format: TClipboardFormat;
   RegisteredClass: TVirtualTreeClass;
 
 begin
@@ -14267,8 +14283,11 @@ var
   Bits: Pointer;
   Size: TSize;
   {$ifdef ThemeSupport}
-    //Theme: HTHEME;
+  {$ifdef Windows}
+  Theme: HTHEME;
+  {$endif}
   {$EndIf ThemeSupport}
+    R: TRect;
  
   //--------------- local function --------------------------------------------
 
@@ -14320,8 +14339,7 @@ begin
   Size.cy := Size.cx;
 
   {$ifdef ThemeSupport}
-  //todo
-  {
+  {$ifdef Windows}
     if tsUseThemes in FStates then
     begin
       Theme := OpenThemeData(Handle, 'TREEVIEW');
@@ -14333,7 +14351,7 @@ begin
     end
     else
       Theme := 0;
-   }
+  {$endif}
   {$endif ThemeSupport}
 
   if NeedButtons then
@@ -14431,9 +14449,8 @@ begin
     end;
 
     {$ifdef ThemeSupport}
-    //todo
+    {$ifdef Windows}
       // Overwrite glyph images if theme is active.
-      {
       if (tsUseThemes in FStates) and (Theme <> 0) then
       begin
         R := Rect(0, 0, Size.cx, Size.cy);
@@ -14450,7 +14467,7 @@ begin
           FHotMinusBM.Canvas.Draw(0, 0, FMinusBM);
         end;
       end;
-      }
+    {$endif}
     {$endif ThemeSupport}
   end;
 
@@ -15637,8 +15654,10 @@ procedure TBaseVirtualTree.SetWindowTheme(const Theme: String);
 
 begin
   FChangingTheme := True;
-  //lcl: todo
-  //UxTheme.SetWindowTheme(Handle, PAnsiChar(Theme), nil);
+  
+  {$ifdef Windows}
+  UxTheme.SetWindowTheme(Handle, PWideChar(Theme), nil);
+  {$endif}
 end;
 
 
@@ -24438,10 +24457,12 @@ var
   Bitmap: TBitmap;
   XPos: Integer;
   IsHot: Boolean;
-  //Theme: HTHEME;
-  //Glyph: Integer;
-  //State: Integer;
-  //Pos: TRect;
+  {$ifdef Windows}
+  Theme: HTHEME;
+  Glyph: Integer;
+  State: Integer;
+  Pos: TRect;
+  {$endif}
 
 begin
   IsHot := (toHotTrack in FOptions.FPaintOptions) and (FCurrentHotNode = Node) and FHotNodeButtonHit;
@@ -24454,13 +24475,15 @@ begin
 
   if tsUseExplorerTheme in FStates then
   begin
-    {Glyph := IfThen(IsHot, TVP_HOTGLYPH, TVP_GLYPH);
+    {$ifdef Windows}
+    Glyph := IfThen(IsHot, TVP_HOTGLYPH, TVP_GLYPH);
     State := IfThen(vsExpanded in Node.States, GLPS_OPENED, GLPS_CLOSED);
     Pos := Rect(XPos, R.Top + ButtonY, XPos + FPlusBM.Width, R.Top + ButtonY + FPlusBM.Height);
+    
     Theme := OpenThemeData(Handle, 'TREEVIEW');
     DrawThemeBackground(Theme, Canvas.Handle, Glyph, State, Pos, nil);
     CloseThemeData(Theme);
-    }
+    {$endif}
   end
   else
   begin
@@ -24626,8 +24649,10 @@ var
   FocusRect,
   InnerRect: TRect;
   {$ifdef ThemeSupport}
-    //RowRect: TRect;
-    //Theme: HTHEME;
+  {$ifdef Windows}
+  Theme: HTHEME;
+  RowRect: TRect;
+  {$endif}
   {$endif ThemeSupport}
 
   //--------------- local functions -------------------------------------------
@@ -24653,8 +24678,7 @@ var
   end;
 
   //---------------------------------------------------------------------------
-  //lcl: todo
-  {
+  {$ifdef Windows}
   procedure DrawBackground(State: Integer);
   begin
     // if the full row selection is disabled or toGridExtensions is in the MiscOptions, draw the selection
@@ -24676,14 +24700,13 @@ var
       DrawThemeBackground(Theme, PaintInfo.Canvas.Handle, LVP_LISTDETAIL, State, RowRect, nil);
     CloseThemeData(Theme);
   end;
-  }
+  {$endif}
 
   //--------------- end local functions ---------------------------------------
 
 begin
   {$ifdef ThemeSupport}
-    //todo
-    {
+  {$ifdef Windows}
   if tsUseExplorerTheme in FStates then
   begin
     Theme := OpenThemeData(Application.Handle, 'Explorer::TreeView');
@@ -24693,7 +24716,7 @@ begin
      if toShowVertGridLines in FOptions.PaintOptions then
        Dec(RowRect.Right);
    end;
-    }
+  {$endif}
   {$endif ThemeSupport}
 
   with PaintInfo, Canvas do
@@ -24752,12 +24775,11 @@ begin
               (toFullRowSelect in FOptions.FSelectionOptions) then
               InnerRect := CellRect;
             if not IsRectEmpty(InnerRect) then
-              //todo
-              {
+              {$ifdef Windows}
               if tsUseExplorerTheme in FStates then
                 DrawBackground(TREIS_SELECTED)
               else
-              }
+              {$endif}
               if MMXAvailable and (toUseBlendedSelection in FOptions.PaintOptions) then
                 AlphaBlendSelection(Brush.Color)
               else
@@ -24788,8 +24810,7 @@ begin
               InnerRect := CellRect;
             if not IsRectEmpty(InnerRect) then
               {$ifdef ThemeSupport}
-                //todo
-                {
+              {$ifdef Windows}
                 if Theme <> 0 then
                 begin
                   // If the node is also hot, its background will be drawn later.
@@ -24798,7 +24819,7 @@ begin
                     DrawBackground(IfThen(Self.Focused, TREIS_SELECTED, TREIS_SELECTEDNOTFOCUS));
                 end
                 else
-                }
+              {$endif}
               {$endif ThemeSupport}
               if MMXAvailable and (toUseBlendedSelection in FOptions.PaintOptions) then
                 AlphaBlendSelection(Brush.Color)
@@ -24810,13 +24831,12 @@ begin
     end;
 
     {$ifdef ThemeSupport}
-    //todo
-    {
+    {$ifdef Windows}
       if (Theme <> 0) and (toHotTrack in FOptions.FPaintOptions) and (Node = FCurrentHotNode) and
          ((Column = FCurrentHotColumn) or (toFullRowSelect in FOptions.FSelectionOptions)) then
         DrawBackground(IfThen((vsSelected in Node.States) and not (toAlwaysHideSelection in FOptions.FPaintOptions),
                               TREIS_HOTSELECTED, TREIS_HOT));
-    }
+    {$endif}
     {$endif ThemeSupport}
 
     if (Column = FFocusedColumn) or (toFullRowSelect in FOptions.FSelectionOptions) then
@@ -24835,13 +24855,12 @@ begin
         SetBkColor(Handle, 0);
 
         {$ifdef ThemeSupport}
-        //todo
-        {
+        {$ifdef Windows}
           if not (toExtendedFocus in FOptions.FSelectionOptions) and (toFullRowSelect in FOptions.FSelectionOptions) and
             (Theme <> 0) then
             FocusRect := RowRect
           else
-        }
+        {$endif}
         {$endif ThemeSupport}
         if toGridExtensions in FOptions.FMiscOptions then
           FocusRect := CellRect
@@ -24849,23 +24868,21 @@ begin
           FocusRect := InnerRect;
 
         {$ifdef ThemeSupport}
-        //todo
-        {
+        {$ifdef Windows}
         if tsUseExplorerTheme in FStates then
           InflateRect(FocusRect, -1, -1);
-         }
+        {$endif}
         {$endif ThemeSupport}
 
         if (tsUseExplorerTheme in FStates) and IsWinVistaOrAbove then
         begin
           //Draw focused unselected style like Windows 7 Explorer
-          //lcl: todo
-          {
+          {$ifdef Windows}
           if not (vsSelected in Node.States) then
             DrawThemedFocusRect(LIS_NORMAL)
           else
             DrawBackground(TREIS_HOTSELECTED);
-          }
+          {$endif}
         end
         else
           LCLIntf.DrawFocusRect(Handle, FocusRect);
diff --git a/components/virtualtreeview/units/laz.dummyactivex.inc b/components/virtualtreeview/units/laz.dummyactivex.inc
index 69d815288c..927f52f454 100644
--- a/components/virtualtreeview/units/laz.dummyactivex.inc
+++ b/components/virtualtreeview/units/laz.dummyactivex.inc
@@ -8,7 +8,7 @@
 interface
 
 uses
-  {$ifdef Windows} Windows, {$endif} Classes, SysUtils, Types;
+  {$ifdef Windows} Windows, {$endif} Classes, SysUtils, LCLType, Types;
 
 const
   TYMED_HGLOBAL = 1;
@@ -102,7 +102,7 @@ type
 
 
   tagFORMATETC                 = Record
-                                  CfFormat :  Word {TCLIPFORMAT};
+                                  CfFormat : TClipboardFormat;
                                   Ptd      : PDVTARGETDEVICE;
                                   dwAspect : DWORD;
                                   lindex   : Long;
-- 
2.23.0.windows.1

Balázs Székely

2020-07-08 09:05

developer   ~0123811

Thanks for the patch. Applied in #63528.

Pascal Riekenberg

2020-07-17 09:56

developer   ~0124114

This change prevents displaying the selection in the TreeView.

Balázs Székely

2020-07-17 12:23

developer   ~0124121

Last edited: 2020-07-17 12:23

View 2 revisions

@Pascal Riekenberg
"This change prevents displaying the selection in the TreeView."

I noticed the bug too and I contacted the author on the forum. Let's wait for a few more days before reverting the changes.

Pascal Riekenberg

2020-07-17 14:55

developer   ~0124123

I've fixed this already in r63586. Please test.

Balázs Székely

2020-07-19 12:29

developer   ~0124168

@Pascal Riekenberg
It works now. Thank you!

Issue History

Date Modified Username Field Change
2020-07-07 17:44 Salvadorbs New Issue
2020-07-07 17:44 Salvadorbs File Added: 0001-Restored-toUseExplorerTheme-and-fix-LCLCocoa-Range-c.patch
2020-07-08 08:48 Balázs Székely Assigned To => Balázs Székely
2020-07-08 08:48 Balázs Székely Status new => assigned
2020-07-08 09:05 Balázs Székely Status assigned => resolved
2020-07-08 09:05 Balázs Székely Resolution open => fixed
2020-07-08 09:05 Balázs Székely LazTarget => -
2020-07-08 09:05 Balázs Székely Widgetset Win32/Win64, Cocoa => Win32/Win64, Cocoa
2020-07-08 09:05 Balázs Székely Note Added: 0123811
2020-07-17 09:56 Pascal Riekenberg Note Added: 0124114
2020-07-17 12:23 Balázs Székely Note Added: 0124121
2020-07-17 12:23 Balázs Székely Note Edited: 0124121 View Revisions
2020-07-17 14:55 Pascal Riekenberg Note Added: 0124123
2020-07-19 12:29 Balázs Székely Note Added: 0124168