* Allow custom menu items in VTHeaderPopupMenu

* Dont show column images in VTHeaderPopupMenu since it will hide the checkmark

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3421 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/virtualtreeview-new/branches/4.8/VTHeaderPopup.pas

@@ -58,18 +58,15 @@ unit VTHeaderPopup;
 //
 // Modified 17 Feb 2002 by Jim Kueneman <jimdk@mindspring.com>.
 //   - Added the event to filter the items as they are added to the menu.
+// 2014
+//   - Adapted and improved for LCL by Luiz Américo Pereira Câmara
 //----------------------------------------------------------------------------------------------------------------------
 {$mode delphi}
 
 interface
 
 uses
-  {$ifdef TNT}
+  Menus, VirtualTrees;
-    TntMenus,
-  {$else}
-    Menus,
-  {$endif TNT}
-  VirtualTrees;
 
 type
   TVTHeaderPopupOption = (
@@ -88,22 +85,11 @@ type
     var Cmd: TAddPopupItemType) of object;
   TColumnChangeEvent = procedure(const Sender: TBaseVirtualTree; const Column: TColumnIndex; Visible: Boolean) of object;
 
-  {$ifdef TNT}
-    TVTMenuItem = TTntMenuItem;
-  {$else}
-    TVTMenuItem = TMenuItem;
-  {$endif}
-
-  {$ifdef TNT}
-    TVTHeaderPopupMenu = class(TTntPopupMenu)
-  {$else}
   TVTHeaderPopupMenu = class(TPopupMenu)
-  {$endif}
   private
-    FOptions: TVTHeaderPopupOptions;
-
     FOnAddHeaderPopupItem: TAddHeaderPopupItemEvent;
     FOnColumnChange: TColumnChangeEvent;
+    FOptions: TVTHeaderPopupOptions;
   protected
     procedure DoAddHeaderPopupItem(const Column: TColumnIndex; out Cmd: TAddPopupItemType); virtual;
     procedure DoColumnChange(Column: TColumnIndex; Visible: Boolean); virtual;
@@ -122,14 +108,12 @@ type
 implementation
 
 uses
-  {$ifdef TNT}
+  Classes;
-    TnTClasses
-  {$else}
-    Classes
-  {$endif TNT};
 
 type
   TVirtualTreeCast = class(TBaseVirtualTree); // Necessary to make the header accessible.
+  TVTMenuItem = class(TMenuItem)
+  end;
 
 //----------------- TVTHeaderPopupMenu ---------------------------------------------------------------------------------
 
@@ -155,7 +139,8 @@ end;
 procedure TVTHeaderPopupMenu.OnMenuItemClick(Sender: TObject);
 
 begin
-  if Assigned(PopupComponent) and (PopupComponent is TBaseVirtualTree) then
+  if PopupComponent is TBaseVirtualTree then
+  begin
     with TVTMenuItem(Sender),
       TVirtualTreeCast(PopupComponent).Header.Columns.Items[Tag] do
     begin
@@ -167,13 +152,13 @@ begin
        DoColumnChange(TVTMenuItem(Sender).Tag, not Checked);
     end;
   end;
+end;
 
 //----------------------------------------------------------------------------------------------------------------------
 
 procedure TVTHeaderPopupMenu.Popup(x, y: Integer);
 
 var
-  I: Integer;
   ColPos: TColumnPosition;
   ColIdx: TColumnIndex;
 
@@ -183,27 +168,35 @@ var
   VisibleCounter: Cardinal;
   VisibleItem: TVTMenuItem;
 
+  CurrentMenuItem: TMenuItem;
+
 begin
-  if Assigned(PopupComponent) and (PopupComponent is TBaseVirtualTree) then
+  if PopupComponent is TBaseVirtualTree then
   begin
-    // Delete existing menu items.
+    // Delete existing VT menu items. Keep normal ones
-    I := Items.Count;
+    while Items.Count > 0 do
-    while I > 0 do
     begin
-      Dec(I);
+      CurrentMenuItem := Items[Items.Count - 1];
-      Items[I].Free;
+      if CurrentMenuItem is TVTMenuItem then
+        CurrentMenuItem.Free
+      else
+        break;
     end;
 
     // Add column menu items.
     with TVirtualTreeCast(PopupComponent).Header do
     begin
-      if hoShowImages in Options then
+      if Columns.Count = 0 then
-        Self.Images := Images
+        Exit;
-      else
-        // Remove a possible reference to image list of another tree previously assigned.
-        Self.Images := nil;
       VisibleItem := nil;
       VisibleCounter := 0;
+      //add separator if necessary
+      if Items.Count > 0 then
+      begin
+        NewMenuItem := TVTMenuItem.Create(Self);
+        NewMenuItem.Caption := cLineCaption;
+        Items.Add(NewMenuItem);
+      end;
       for ColPos := 0 to Columns.Count - 1 do
       begin
         if poOriginalOrder in FOptions then
@@ -222,7 +215,6 @@ begin
             NewMenuItem.Tag := ColIdx;
             NewMenuItem.Caption := Text;
             NewMenuItem.Hint := Hint;
-            NewMenuItem.ImageIndex := ImageIndex;
             NewMenuItem.Checked := coVisible in Options;
             NewMenuItem.OnClick := OnMenuItemClick;
             if Cmd = apDisabled then

components/virtualtreeview-new/trunk/VTHeaderPopup.pas

@@ -58,18 +58,15 @@ unit VTHeaderPopup;
 //
 // Modified 17 Feb 2002 by Jim Kueneman <jimdk@mindspring.com>.
 //   - Added the event to filter the items as they are added to the menu.
+// 2014
+//   - Adapted and improved for LCL by Luiz Américo Pereira Câmara
 //----------------------------------------------------------------------------------------------------------------------
 {$mode delphi}
 
 interface
 
 uses
-  {$ifdef TNT}
+  Menus, VirtualTrees;
-    TntMenus,
-  {$else}
-    Menus,
-  {$endif TNT}
-  VirtualTrees;
 
 type
   TVTHeaderPopupOption = (
@@ -88,22 +85,11 @@ type
     var Cmd: TAddPopupItemType) of object;
   TColumnChangeEvent = procedure(const Sender: TBaseVirtualTree; const Column: TColumnIndex; Visible: Boolean) of object;
 
-  {$ifdef TNT}
-    TVTMenuItem = TTntMenuItem;
-  {$else}
-    TVTMenuItem = TMenuItem;
-  {$endif}
-
-  {$ifdef TNT}
-    TVTHeaderPopupMenu = class(TTntPopupMenu)
-  {$else}
   TVTHeaderPopupMenu = class(TPopupMenu)
-  {$endif}
   private
-    FOptions: TVTHeaderPopupOptions;
-
     FOnAddHeaderPopupItem: TAddHeaderPopupItemEvent;
     FOnColumnChange: TColumnChangeEvent;
+    FOptions: TVTHeaderPopupOptions;
   protected
     procedure DoAddHeaderPopupItem(const Column: TColumnIndex; out Cmd: TAddPopupItemType); virtual;
     procedure DoColumnChange(Column: TColumnIndex; Visible: Boolean); virtual;
@@ -122,14 +108,12 @@ type
 implementation
 
 uses
-  {$ifdef TNT}
+  Classes;
-    TnTClasses
-  {$else}
-    Classes
-  {$endif TNT};
 
 type
   TVirtualTreeCast = class(TBaseVirtualTree); // Necessary to make the header accessible.
+  TVTMenuItem = class(TMenuItem)
+  end;
 
 //----------------- TVTHeaderPopupMenu ---------------------------------------------------------------------------------
 
@@ -155,7 +139,8 @@ end;
 procedure TVTHeaderPopupMenu.OnMenuItemClick(Sender: TObject);
 
 begin
-  if Assigned(PopupComponent) and (PopupComponent is TBaseVirtualTree) then
+  if PopupComponent is TBaseVirtualTree then
+  begin
     with TVTMenuItem(Sender),
       TVirtualTreeCast(PopupComponent).Header.Columns.Items[Tag] do
     begin
@@ -167,13 +152,13 @@ begin
        DoColumnChange(TVTMenuItem(Sender).Tag, not Checked);
     end;
   end;
+end;
 
 //----------------------------------------------------------------------------------------------------------------------
 
 procedure TVTHeaderPopupMenu.Popup(x, y: Integer);
 
 var
-  I: Integer;
   ColPos: TColumnPosition;
   ColIdx: TColumnIndex;
 
@@ -183,27 +168,35 @@ var
   VisibleCounter: Cardinal;
   VisibleItem: TVTMenuItem;
 
+  CurrentMenuItem: TMenuItem;
+
 begin
-  if Assigned(PopupComponent) and (PopupComponent is TBaseVirtualTree) then
+  if PopupComponent is TBaseVirtualTree then
   begin
-    // Delete existing menu items.
+    // Delete existing VT menu items. Keep normal ones
-    I := Items.Count;
+    while Items.Count > 0 do
-    while I > 0 do
     begin
-      Dec(I);
+      CurrentMenuItem := Items[Items.Count - 1];
-      Items[I].Free;
+      if CurrentMenuItem is TVTMenuItem then
+        CurrentMenuItem.Free
+      else
+        break;
     end;
 
     // Add column menu items.
     with TVirtualTreeCast(PopupComponent).Header do
     begin
-      if hoShowImages in Options then
+      if Columns.Count = 0 then
-        Self.Images := Images
+        Exit;
-      else
-        // Remove a possible reference to image list of another tree previously assigned.
-        Self.Images := nil;
       VisibleItem := nil;
       VisibleCounter := 0;
+      //add separator if necessary
+      if Items.Count > 0 then
+      begin
+        NewMenuItem := TVTMenuItem.Create(Self);
+        NewMenuItem.Caption := cLineCaption;
+        Items.Add(NewMenuItem);
+      end;
       for ColPos := 0 to Columns.Count - 1 do
       begin
         if poOriginalOrder in FOptions then
@@ -222,7 +215,6 @@ begin
             NewMenuItem.Tag := ColIdx;
             NewMenuItem.Caption := Text;
             NewMenuItem.Hint := Hint;
-            NewMenuItem.ImageIndex := ImageIndex;
             NewMenuItem.Checked := coVisible in Options;
             NewMenuItem.OnClick := OnMenuItemClick;
             if Cmd = apDisabled then