Merge pull request #18 from salvadorbs/lazarus-v5

Restored toUseExplorerTheme and fix LCLCocoa "Range check error" in InitializeGlobalStructures

Author: blikblum

Source/VirtualTrees.pas

@@ -64,6 +64,7 @@ interface
   Windows,
   ActiveX,
   CommCtrl,
+  UxTheme,
   {$else}
   FakeActiveX,
   {$endif}
@@ -244,14 +245,25 @@ interface
   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,
   CF_VRTF,
   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 @@   THitInfo = record
 
   // OLE drag'n drop support
   TFormatEtcArray = array of TFormatEtc;
-  TFormatArray = array of Word;
+  TFormatArray = array of TClipboardFormat;
 
   // IDataObject.SetData support
   TInternalStgMedium = packed record
@@ -3545,7 +3557,7 @@   TCustomVirtualStringTree = class(TBaseVirtualTree)
     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;
@@ -4082,8 +4094,8 @@   TVirtualDrawTree = class(TCustomVirtualDrawTree)
 // 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;
@@ -4390,8 +4402,8 @@   TClipboardFormatList = class
       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
@@ -4572,7 +4584,7 @@ function TClipboardFormatList.FindFormat(FormatString: string): PClipboardFormat
 
 //----------------------------------------------------------------------------------------------------------------------
 
-function TClipboardFormatList.FindFormat(FormatString: string; var Fmt: Word): TVirtualTreeClass;
+function TClipboardFormatList.FindFormat(FormatString: string; var Fmt: TClipboardFormat): TVirtualTreeClass;
 
 var
   I: Integer;
@@ -4594,7 +4606,7 @@ function TClipboardFormatList.FindFormat(FormatString: string; var Fmt: Word): T
 
 //----------------------------------------------------------------------------------------------------------------------
 
-function TClipboardFormatList.FindFormat(Fmt: Word; out Description: string): TVirtualTreeClass;
+function TClipboardFormatList.FindFormat(Fmt: TClipboardFormat; out Description: string): TVirtualTreeClass;
 
 var
   I: Integer;
@@ -4667,7 +4679,7 @@ procedure EnumerateVTClipboardFormats(TreeClass: TVirtualTreeClass; var Formats:
 
 //----------------------------------------------------------------------------------------------------------------------
 
-function GetVTClipboardFormatDescription(AFormat: Word): string;
+function GetVTClipboardFormatDescription(AFormat: TClipboardFormat): string;
 
 begin
   if InternalClipboardFormats = nil then
@@ -4678,7 +4690,7 @@ function GetVTClipboardFormatDescription(AFormat: Word): string;
 
 //----------------------------------------------------------------------------------------------------------------------
 
-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.
 
@@ -7422,8 +7434,9 @@ procedure TVirtualTreeColumn.ComputeHeaderLayout(DC: HDC; const Client: TRect; U
   TextSpacing: Integer;
   UseText: Boolean;
   R: TRect;
-  //todo
-  //Theme: HTHEME;
+  {$ifdef Windows}
+  Theme: HTHEME;
+  {$endif}
 
 begin
   UseText := Length(FText) > 0;
@@ -7460,9 +7473,12 @@ procedure TVirtualTreeColumn.ComputeHeaderLayout(DC: HDC; const Client: TRect; U
       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
@@ -12235,7 +12251,7 @@ function TClipboardFormats.Add(const S: string): Integer;
 // ancestors.
 
 var
-  Format: Word;
+  Format: TClipboardFormat;
   RegisteredClass: TVirtualTreeClass;
 
 begin
@@ -12254,7 +12270,7 @@ procedure TClipboardFormats.Insert(Index: Integer; const S: string);
 // ancestors.
 
 var
-  Format: Word;
+  Format: TClipboardFormat;
   RegisteredClass: TVirtualTreeClass;
 
 begin
@@ -14255,7 +14271,9 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean);
   Bits: Pointer;
   Size: TSize;
   {$ifdef ThemeSupport}
-    //Theme: HTHEME;
+  {$ifdef Windows}
+  Theme: HTHEME;
+  {$endif}
   {$EndIf ThemeSupport}
     R: TRect;
 
@@ -14309,8 +14327,7 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean);
   Size.cy := Size.cx;
 
   {$ifdef ThemeSupport}
-  //todo
-  {
+  {$ifdef Windows}
     if tsUseThemes in FStates then
     begin
       Theme := OpenThemeData(Handle, 'TREEVIEW');
@@ -14322,7 +14339,7 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean);
     end
     else
       Theme := 0;
-   }
+  {$endif}
   {$endif ThemeSupport}
 
   if NeedButtons then
@@ -14421,9 +14438,8 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean);
     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);
@@ -14440,7 +14456,7 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean);
           FHotMinusBM.Canvas.Draw(0, 0, FMinusBM);
         end;
       end;
-      }
+    {$endif}
     {$endif ThemeSupport}
   end;
 
@@ -15624,8 +15640,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;
 
 
@@ -24426,7 +24444,9 @@ procedure TBaseVirtualTree.PaintNodeButton(Canvas: TCanvas; Node: PVirtualNode;
   Bitmap: TBitmap;
   XPos: Integer;
   IsHot: Boolean;
-  //Theme: HTHEME;
+  {$ifdef Windows}
+  Theme: HTHEME;
+  {$endif}
   Glyph: Integer;
   State: Integer;
   Pos: TRect;
@@ -24445,11 +24465,12 @@ procedure TBaseVirtualTree.PaintNodeButton(Canvas: TCanvas; Node: PVirtualNode;
     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);
-    {
+    
+    {$ifdef Windows}
     Theme := OpenThemeData(Handle, 'TREEVIEW');
     DrawThemeBackground(Theme, Canvas.Handle, Glyph, State, Pos, nil);
     CloseThemeData(Theme);
-    }
+    {$endif}
   end
   else
   begin
@@ -24615,8 +24636,10 @@ procedure TBaseVirtualTree.PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX,
   FocusRect,
   InnerRect: TRect;
   {$ifdef ThemeSupport}
-    //RowRect: TRect;
-    //Theme: HTHEME;
+  {$ifdef Windows}
+  Theme: HTHEME;
+  RowRect: TRect;
+  {$endif}
   {$endif ThemeSupport}
 
   //--------------- local functions -------------------------------------------
@@ -24642,8 +24665,7 @@ procedure TBaseVirtualTree.PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX,
   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
@@ -24665,14 +24687,13 @@ procedure TBaseVirtualTree.PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX,
       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');
@@ -24682,7 +24703,7 @@ procedure TBaseVirtualTree.PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX,
      if toShowVertGridLines in FOptions.PaintOptions then
        Dec(RowRect.Right);
    end;
-    }
+  {$endif}
   {$endif ThemeSupport}
 
   with PaintInfo, Canvas do
@@ -24741,12 +24762,11 @@ procedure TBaseVirtualTree.PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX,
               (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
@@ -24777,8 +24797,7 @@ procedure TBaseVirtualTree.PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX,
               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.
@@ -24787,7 +24806,7 @@ procedure TBaseVirtualTree.PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX,
                     DrawBackground(IfThen(Self.Focused, TREIS_SELECTED, TREIS_SELECTEDNOTFOCUS));
                 end
                 else
-                }
+              {$endif}
               {$endif ThemeSupport}
               if MMXAvailable and (toUseBlendedSelection in FOptions.PaintOptions) then
                 AlphaBlendSelection(Brush.Color)
@@ -24799,13 +24818,12 @@ procedure TBaseVirtualTree.PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX,
     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
@@ -24824,37 +24842,34 @@ procedure TBaseVirtualTree.PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX,
         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
         else
           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);

Source/include/intf/dummyolemethods.inc

@@ -289,7 +289,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)