Fix build against widgetset different from win32

salvadorbs · Jan 5, 2024 · 1828c6a · 1828c6a
1 parent b4f4d75
commit 1828c6a
Show file tree

Hide file tree

Showing 24 changed files with 71 additions and 523 deletions.
diff --git a/Demos/OLE/Main.pas b/Demos/OLE/Main.pas
@@ -9,7 +9,7 @@
 interface
 
 uses 
-  Windows, LCLIntf, {$ifdef lclwin32}ActiveX{$else}FakeActiveX{$endif}, SysUtils, Forms, Dialogs, Graphics, VirtualTrees.BaseTree,
+  Windows, LCLIntf, {$ifdef lclwin32}ActiveX,{$endif} virtualdragmanager, SysUtils, Forms, Dialogs, Graphics, VirtualTrees.BaseTree,
   VirtualTrees, ActnList, ComCtrls, ExtCtrls, StdCtrls, Controls, Classes, Buttons,
   LResources, VirtualTrees.Types, VirtualTrees.Header, VirtualTrees.ClipBoard;
 

diff --git a/Demos/dragdrop/fmain.pas b/Demos/dragdrop/fmain.pas
@@ -7,7 +7,7 @@ interface
 uses
   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
   VirtualTrees, VirtualTrees.BaseTree, VirtualTrees.Header, VirtualTrees.Types,
-  {$ifdef windows}ActiveX{$else}FakeActiveX{$endif};
+  {$ifdef windows}ActiveX,{$endif} virtualdragmanager;
 
 type
 

diff --git a/Source/VTConfig.inc b/Source/VTConfig.inc
@@ -34,17 +34,14 @@
 
 {$define EnableAlphaBlend}
 
-{$ifdef Windows}
-  {$define EnableWinDataObject}
-{$endif}
-
 //Don't enable this because oleacc is not available for FreePascal
 {.$define EnableAccessible}
 
 {.$define DelphiStyleServices}
 
-{$if defined(LCLWin32) or defined(LCLWinCE)}
+{$if defined(LCLWin32) or defined(LCLWin64) or defined(LCLWinCE)}
   {$define LCLWin}
+  {$define EnableWinDataObject}
 {$endif}
 
 //Logging on console

diff --git a/Source/VirtualTrees.AncestorLcl.pas b/Source/VirtualTrees.AncestorLcl.pas
@@ -7,20 +7,19 @@ interface
 {$I VTConfig.inc}
 
 uses
-  Classes, Controls, Graphics, DelphiCompat, Forms, Types, StrUtils,
+  Classes, Controls, Graphics, DelphiCompat, Forms, Types, StrUtils, LMessages,
   OleUtils, Themes,
   {$ifdef Windows}
   Windows,
   ActiveX,
   CommCtrl,
   UxTheme,
-  {$else}
-  FakeActiveX,
   {$endif}
   {$ifdef EnableAccessible}
   oleacc, // for MSAA IAccessible support
   {$endif}
   VirtualTrees.BaseTree,
+  virtualdragmanager,
   VirtualTrees.Types, LCLType, LCLIntf;
 
 type
@@ -46,7 +45,7 @@   TVirtualTreeHintWindow = class(THintWindow)
     FHintData: TVTHintData;
     FTextHeight: TDimension;
     procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
-    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
+    procedure WMEraseBkgnd(var Message: TLMEraseBkgnd); message LM_ERASEBKGND;
   strict protected
     procedure CreateParams(var Params: TCreateParams); override;
     procedure Paint; override;
@@ -167,7 +166,7 @@ procedure TVirtualTreeHintWindow.CMTextChanged(var Message: TMessage);
 
 //----------------------------------------------------------------------------------------------------------------------
 
-procedure TVirtualTreeHintWindow.WMEraseBkgnd(var Message: TWMEraseBkgnd);
+procedure TVirtualTreeHintWindow.WMEraseBkgnd(var Message: TLMEraseBkgnd);
 
 // The control is fully painted by own code so don't erase its background as this causes flickering.
 
@@ -486,7 +485,7 @@ function TVirtualTreeHintWindow.IsHintMsg(Msg: TMsg): Boolean;
 begin
   Result := inherited IsHintMsg(Msg) and HandleAllocated and IsWindowVisible(Handle);
   // Avoid that mouse moves over the non-client area or cursor key presses cancel the current hint.
-  if Result and ((Msg.Message = WM_NCMOUSEMOVE) or ((Msg.Message >= WM_KEYFIRST) and (Msg.Message <= WM_KEYLAST) and (Msg.wparam in [VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT]))) then
+  if Result and ((Msg.Message = LM_NCMOUSEMOVE) or ((Msg.Message >= LM_KEYFIRST) and (Msg.Message <= LM_KEYLAST) and (Msg.wparam in [VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT]))) then
     Result := False;
 end;
 

diff --git a/Source/VirtualTrees.BaseAncestorLcl.pas b/Source/VirtualTrees.BaseAncestorLcl.pas
@@ -7,24 +7,20 @@ interface
 {$I VTConfig.inc}
 
 uses
-  Classes, Controls, Graphics,
+  Classes, Controls, Graphics, LCLIntf, LCLType, Types,
   {$ifdef Windows}
   Windows,
   ActiveX,
   CommCtrl,
   UxTheme,
   JwaWinAble,
-  {$else}
-  FakeActiveX,
   {$endif}
   DelphiCompat,
   {$ifdef EnableAccessible}
   oleacc, // for MSAA IAccessible support
   {$endif}
   VirtualTrees.Types,
-  LCLIntf,
-  LCLType,
-  Types;
+  virtualdragmanager;
 
 type
 
@@ -46,7 +42,9 @@   TVTBaseAncestorLcl = class abstract(TCustomControl)
   protected // methods
     function DoRenderOLEData(const FormatEtcIn: TFormatEtc; out Medium: TStgMedium; ForClipboard: Boolean): HRESULT; virtual; abstract;
     function RenderOLEData(const FormatEtcIn: TFormatEtc; out Medium: TStgMedium; ForClipboard: Boolean): HResult; virtual;
+    {$ifdef EnableAccessible}
     procedure NotifyAccessibleEvent(pEvent: DWord = EVENT_OBJECT_STATECHANGE);
+    {$endif}
     function PrepareDottedBrush(CurrentDottedBrush: TBrush; Bits: Pointer; const BitsLinesCount: Word): TBrush; virtual;
     {$IFDEF DelphiStyleServices}
     function CreateSystemImageSet(): TImageList;
@@ -96,11 +94,11 @@   TVTBaseAncestorLcl = class abstract(TCustomControl)
     /// <summary>
     /// Handle less alias for LCLIntf.SetScrollInfo
     /// </summary>
-    function SetScrollInfo(Bar: Integer; const ScrollInfo: TScrollInfo; Redraw: Boolean): TDimension;
+    function SetScrollInfo(Bar: Integer; const ScrollInfo: LCLType.TScrollInfo; Redraw: Boolean): TDimension;
     /// <summary>
     /// Handle less alias for LCLIntf.GetScrollInfo
     /// </summary>
-    function GetScrollInfo(Bar: Integer; var ScrollInfo: TScrollInfo): Boolean;
+    function GetScrollInfo(Bar: Integer; var ScrollInfo: LCLType.TScrollInfo): Boolean;
     /// <summary>
     /// Handle less alias for LCLIntf.GetScrollPos
     /// </summary>
@@ -448,13 +446,13 @@ function TVTBaseAncestorLcl.InvalidateRect(lpRect: PRect; bErase: BOOL): BOOL;
 
 //----------------------------------------------------------------------------------------------------------------------
 
+{$ifdef EnableAccessible}
 procedure TVTBaseAncestorLcl.NotifyAccessibleEvent(pEvent: DWord = EVENT_OBJECT_STATECHANGE);
-begin  
-  {$ifdef EnableAccessible}
+begin
   if Assigned(AccessibleItem) then
     NotifyWinEvent(pEvent, Handle, OBJID_CLIENT, CHILDID_SELF);
-  {$endif}
 end;
+{$endif}
 
 //----------------------------------------------------------------------------------------------------------------------
 
@@ -501,7 +499,7 @@ function TVTBaseAncestorLcl.SendWM_SETREDRAW(Updating: Boolean): LRESULT;
 
 //----------------------------------------------------------------------------------------------------------------------
 
-function TVTBaseAncestorLcl.SetScrollInfo(Bar: Integer; const ScrollInfo: TScrollInfo; Redraw: Boolean): TDimension;
+function TVTBaseAncestorLcl.SetScrollInfo(Bar: Integer; const ScrollInfo: LCLType.TScrollInfo; Redraw: Boolean): TDimension;
 begin
   Result:= LCLIntf.SetScrollInfo(Handle, Bar, ScrollInfo, Redraw);
 end;
@@ -517,7 +515,7 @@ procedure TVTBaseAncestorLcl.SetWindowTheme(const Theme: string);
 
 //----------------------------------------------------------------------------------------------------------------------
 
-function TVTBaseAncestorLcl.GetScrollInfo(Bar: Integer; var ScrollInfo: TScrollInfo): Boolean;
+function TVTBaseAncestorLcl.GetScrollInfo(Bar: Integer; var ScrollInfo: LCLType.TScrollInfo): Boolean;
 begin
   Result:= LCLIntf.GetScrollInfo(Handle, Bar, ScrollInfo);
 end;

diff --git a/Source/VirtualTrees.BaseTree.pas b/Source/VirtualTrees.BaseTree.pas
@@ -18,8 +18,6 @@ interface
   UxTheme,
   Win32Int,
   JwaWinAble,
-  {$else}
-  FakeActiveX,
   {$endif}
   OleUtils,
   LCLIntf,
@@ -46,6 +44,7 @@ interface
   , VirtualTrees.Classes
   , VirtualTrees.Utils
   , VirtualTrees.BaseAncestorLcl
+  , virtualdragmanager
   ;
 
 var
@@ -4493,7 +4492,7 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean);
                   FillBitmap(FSelectedHotMinusBM);
                   // Weil die selbstgezeichneten Bitmaps sehen im Vcl Style scheiße aus
                   // Because the self-drawn bitmaps view Vcl Style shit
-                  if Theme = 0 then
+                  if (not VclStyleEnabled) {or (Theme = 0)} then
                   begin
                     if not(tsUseExplorerTheme in FStates) then
                     begin
@@ -4540,7 +4539,7 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean);
                   FillBitmap(FPlusBM);
                   FillBitmap(FHotPlusBM);
                   FillBitmap(FSelectedHotPlusBM);
-                  if (not VclStyleEnabled) or (Theme = 0) then
+                  if (not VclStyleEnabled) {or (Theme = 0)} then
                   begin
                     if not(tsUseExplorerTheme in FStates) then
                     begin
@@ -8555,7 +8554,7 @@ procedure TBaseVirtualTree.WMSetCursor(var Message: TLMSetCursor);
           end
           else
             NewCursor := Cursor;
-          Windows.SetCursor(Screen.Cursors[NewCursor]);
+          LCLIntf.SetCursor(Screen.Cursors[NewCursor]);
           Message.Result := 1;
         end
         else
@@ -10427,8 +10426,10 @@ procedure TBaseVirtualTree.DoChecked(Node: PVirtualNode);
 begin
   if Assigned(FOnChecked) then
     FOnChecked(Self, Node);
+  {$ifdef EnableAccessible}
   if (Self.UpdateCount = 0) then // See issue #1174
     NotifyAccessibleEvent();
+  {$endif}
 end;
 
 //----------------------------------------------------------------------------------------------------------------------
@@ -10838,8 +10839,10 @@ procedure TBaseVirtualTree.DoExpanded(Node: PVirtualNode);
 begin
   if Assigned(FOnExpanded) then
     FOnExpanded(Self, Node);
+  {$ifdef EnableAccessible}
   if (Self.UpdateCount = 0) then // See issue #1174
     NotifyAccessibleEvent();
+  {$endif}
 end;
 
 //----------------------------------------------------------------------------------------------------------------------
@@ -10859,12 +10862,14 @@ procedure TBaseVirtualTree.DoFocusChange(Node: PVirtualNode; Column: TColumnInde
 begin
   if Assigned(FOnFocusChanged) then
     FOnFocusChanged(Self, Node, Column);
+  {$ifdef EnableAccessible}
   NotifyAccessibleEvent(EVENT_OBJECT_LOCATIONCHANGE);
   NotifyAccessibleEvent(EVENT_OBJECT_NAMECHANGE);
   NotifyAccessibleEvent(EVENT_OBJECT_VALUECHANGE);
   NotifyAccessibleEvent(EVENT_OBJECT_STATECHANGE);
   NotifyAccessibleEvent(EVENT_OBJECT_SELECTION);
   NotifyAccessibleEvent(EVENT_OBJECT_FOCUS);
+  {$endif}
 end;
 
 //----------------------------------------------------------------------------------------------------------------------
@@ -13145,7 +13150,7 @@ procedure TBaseVirtualTree.HandleIncrementalSearch(CharCode: Word);
   //---------------------------------------------------------------------------
   //todo: reimplement
   {$ifndef INCOMPLETE_WINAPI}
-  function CodePageFromLocale(Language: LCID): Integer;
+  function CodePageFromLocale(Language: DWord): Integer;
 
   // Determines the code page for a given locale.
   // Unfortunately there is no easier way than this, currently.
@@ -14590,7 +14595,9 @@ procedure TBaseVirtualTree.MainColumnChanged;
 
 begin
   DoCancelEdit;
+  {$ifdef EnableAccessible}
   NotifyAccessibleEvent();
+  {$endif}
 end;
 
 //----------------------------------------------------------------------------------------------------------------------
@@ -17868,7 +17875,9 @@ procedure TBaseVirtualTree.EndUpdate;
           Invalidate;
         UpdateDesigner;
       end;
+      {$ifdef EnableAccessible}
       NotifyAccessibleEvent(); // See issue #1174
+      {$endif}
 
       DoUpdating(usEnd);
       EnsureNodeSelected(False);

diff --git a/Source/VirtualTrees.ClipBoard.pas b/Source/VirtualTrees.ClipBoard.pas
@@ -35,9 +35,8 @@ interface
   {$ifdef Windows}
   , ActiveX
   , JwaWinUser
-  {$else}
-  , FakeActiveX
   {$endif}
+  , virtualdragmanager
   ;
 
 type
@@ -47,7 +46,7 @@   TClipboardFormatEntry = record
   end;
 
 var
-  ClipboardDescriptions: array [1..CF_MAX - 1] of TClipboardFormatEntry = (
+  ClipboardDescriptions: array [1..VirtualTrees.Types.CF_MAX - 1] of TClipboardFormatEntry = (
     (ID: CF_TEXT; Description: 'Plain text'), // Do not localize
     (ID: CF_BITMAP; Description: 'Windows bitmap'), // Do not localize
     (ID: CF_METAFILEPICT; Description: 'Windows metafile'), // Do not localize
@@ -63,8 +62,10 @@   TClipboardFormatEntry = record
     (ID: CF_UNICODETEXT; Description: 'Unicode text'), // Do not localize
     (ID: CF_ENHMETAFILE; Description: 'Enhanced metafile image'), // Do not localize
     (ID: CF_HDROP; Description: 'File name(s)'), // Do not localize
-    (ID: CF_LOCALE; Description: 'Locale descriptor'), // Do not localize
-    (ID: CF_DIBV5; Description: 'DIB image V5') // Do not localize
+    (ID: CF_LOCALE; Description: 'Locale descriptor') // Do not localize
+    {
+    ,(ID: CF_DIBV5; Description: 'DIB image V5') // Do not localize
+    }
   );
 
 
@@ -176,8 +177,7 @@ procedure RegisterVTClipboardFormat(AFormat: TClipboardFormat; TreeClass: TVirtu
   end
   else
   begin
-    GetClipboardFormatName(AFormat, Buffer, Length(Buffer));
-    TClipboardFormatList.Add(Buffer, TreeClass, Priority, FormatEtc);
+    TClipboardFormatList.Add(ClipboardFormatToMimeType(AFormat), TreeClass, Priority, FormatEtc);
   end;
 end;
 
@@ -195,7 +195,7 @@ function RegisterVTClipboardFormat(const Description: string; TreeClass: TVirtua
   FormatEtc: TFormatEtc;
 
 begin
-  Result := RegisterClipboardFormat(PChar(Description));
+  Result := ClipboardRegisterFormat(Description);
   FormatEtc.cfFormat := Result;
   FormatEtc.ptd := ptd;
   FormatEtc.dwAspect := dwAspect;

diff --git a/Source/VirtualTrees.DataObject.pas b/Source/VirtualTrees.DataObject.pas
@@ -12,11 +12,10 @@ interface
   Windows,
   ActiveX,
   JwaWinBase,
-  {$else}
-  FakeActiveX,
   {$endif}
   DelphiCompat
-  , VirtualTrees.Types;
+  , VirtualTrees.Types
+  , virtualdragmanager;
 
 type
   // IDataObject.SetData support
@@ -107,7 +106,7 @@ destructor TVTDataObject.Destroy;
   begin
     StgMedium := FindInternalStgMedium(FormatEtcArray[I].cfFormat);
     if Assigned(StgMedium) then
-      ReleaseStgMedium(StgMedium^);
+      ReleaseStgMedium(StgMedium);
   end;
 
   FormatEtcArray := nil;
@@ -499,7 +498,7 @@ function TVTDataObject.SetData(const FormatEtc : TFormatEtc; var Medium : TStgMe
     LocalStgMedium := FindInternalStgMedium(FormatEtcArray[Index].cfFormat);
     if Assigned(LocalStgMedium) then
     begin
-      ReleaseStgMedium(LocalStgMedium^);
+      ReleaseStgMedium(LocalStgMedium);
       FillChar(LocalStgMedium^, SizeOf(LocalStgMedium^), #0);
     end;
   end