View Issue Details

IDProjectCategoryView StatusLast Update
0011209PatchesLCLpublic2008-07-10 01:01
ReporterBenito van der Zander Assigned ToPaul Ishenin  
PrioritynormalSeverityfeatureReproducibilityN/A
Status closedResolutionfixed 
Product Version0.9.25 (SVN) 
Target Version0.9.26Fixed in Version0.9.26 
Summary0011209: [patch] dragging of header control buttons
DescriptionThis patch allows the user to drag the buttons on a THeaderControl.
A minor problem could be that the insert position is marked only by a blue line and not also by a transparent button like in the windows control. But I doesn't know how to paint one. (or how it should be in the other widgetsets)
TagsNo tags attached.
Fixed in Revision14995
LazTarget0.9.26
WidgetsetWin32/Win64
Attached Files

Activities

2008-04-25 20:55

 

headercontrol.patch (12,829 bytes)   
Index: comctrls.pp
===================================================================
--- comctrls.pp	(revision 14972)
+++ comctrls.pp	(working copy)
@@ -2547,6 +2547,7 @@
     FState: THeaderSectionState;
     FText: string;
     FWidth: Integer;
+    FOriginalIndex: Integer;
     function GetLeft: Integer;
     function GetRight: Integer;
     procedure SetAlignment(const AValue: TAlignment);
@@ -2570,6 +2571,8 @@
     property MinWidth: Integer read FMinWidth write SetMinWidth default 0;
     property Text: string read FText write SetText;
     property Width: Integer read FWidth write SetWidth;
+    //index which doesn't change when the user reorders the sections
+    property OriginalIndex: Integer read FOriginalIndex;
   end;
   
   THeaderSectionClass = class of THeaderSection;
@@ -2590,11 +2593,14 @@
     function Add: THeaderSection;
     function AddItem(Item: THeaderSection; Index: Integer): THeaderSection;
     function Insert(Index: Integer): THeaderSection;
+    procedure Delete(Index: Integer);
     property Items[Index: Integer]: THeaderSection read GetItem write SetItem; default;
   end;
 
   TSectionTrackState = (tsTrackBegin, tsTrackMove, tsTrackEnd);
-  TCustomSectionTrackEvent = procedure(HeaderControl: TCustomHeaderControl; Section: THeaderSection; Width: Integer; State: TSectionTrackState) of object;
+    TCustomSectionTrackEvent = procedure(HeaderControl: TCustomHeaderControl; Section: THeaderSection; Width: Integer; State: TSectionTrackState) of object;
+  TSectionDragEvent = procedure (Sender: TObject; FromSection, ToSection: THeaderSection;
+    var AllowDrag: Boolean) of object;
   TCustomSectionNotifyEvent = procedure(HeaderControl: TCustomHeaderControl;
     Section: THeaderSection) of object;
   TCustomHCCreateSectionClassEvent = procedure(Sender: TCustomHeaderControl;
@@ -2605,18 +2611,23 @@
   
   TCustomHeaderControl = class(TCustomControl)
   private
+    FDragReorder: boolean;
     FSections: THeaderSections;
     FImages: TCustomImageList;
     FPaintRect: TRect;
     FDown: Boolean;
     FDownPoint: TPoint;
-    FTracking: Boolean;
-    FSelectedSelection: longint;
+    FTracking, FDragging: Boolean;
+    FEndDragSectionIndex: longint;
+    FSelectedSection: longint;
     FMouseInControl: Boolean;
     
     FOnSectionClick: TCustomSectionNotifyEvent;
     FOnSectionResize: TCustomSectionNotifyEvent;
     FOnSectionTrack: TCustomSectionTrackEvent;
+    FOnSectionSeparatorDblClick: TCustomSectionNotifyEvent;
+    FOnSectionDrag: TSectionDragEvent;
+    FOnSectionEndDrag: TNotifyEvent;
     FOnCreateSectionClass: TCustomHCCreateSectionClassEvent;
     procedure SetImages(const AValue: TCustomImageList);
     procedure SetSections(const AValue: THeaderSections);
@@ -2629,6 +2640,9 @@
     procedure SectionClick(Section: THeaderSection); dynamic;
     procedure SectionResize(Section: THeaderSection); dynamic;
     procedure SectionTrack(Section: THeaderSection; State: TSectionTrackState); dynamic;
+    procedure SectionSeparatorDblClick(Section: THeaderSection); dynamic;
+    procedure SectionEndDrag(); dynamic;
+    function SectionDrag(FromSection, ToSection: THeaderSection):boolean; dynamic;
     procedure MouseEnter; override;
     procedure MouseLeave; override;
     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
@@ -2643,19 +2657,26 @@
     destructor Destroy; override;
     
     procedure Click; override;
+    procedure DblClick; override;
     function GetSectionAt(P: TPoint): Integer;
     procedure Paint; override;
     procedure PaintSection(Index: Integer); virtual;
   published
+    property DragReorder: boolean read FDragReorder write FDragReorder;
     property Images: TCustomImageList read FImages write SetImages;
     property Sections: THeaderSections read FSections write SetSections;
 
+    property OnSectionDrag: TSectionDragEvent read FOnSectionDrag
+      write FOnSectionDrag;
+    property OnSectionEndDrag: TNotifyEvent read FOnSectionEndDrag write FOnSectionEndDrag;
     property OnSectionClick: TCustomSectionNotifyEvent read FOnSectionClick
       write FOnSectionClick;
     property OnSectionResize: TCustomSectionNotifyEvent read FOnSectionResize
       write FOnSectionResize;
     property OnSectionTrack: TCustomSectionTrackEvent read FOnSectionTrack
       write FOnSectionTrack;
+    property OnSectionSeparatorDblClick: TCustomSectionNotifyEvent read FOnSectionSeparatorDblClick
+      write FOnSectionSeparatorDblClick;
     property OnCreateSectionClass: TCustomHCCreateSectionClassEvent read FOnCreateSectionClass
       write FOnCreateSectionClass;
   end;
Index: include/headercontrol.inc
===================================================================
--- include/headercontrol.inc	(revision 14972)
+++ include/headercontrol.inc	(working copy)
@@ -21,6 +21,7 @@
 { TCustomHeaderControl }
 
 const HeaderBorderSize = 2;
+      DragStartDistance = 5;
 
 procedure TCustomHeaderControl.SetImages(const AValue: TCustomImageList);
 begin
@@ -82,7 +83,7 @@
 var
   Index: Integer;
 begin
-  if not FTracking then
+  if FDown and not FDragging then
   begin
     inherited Click;
     Index := GetSectionAt(ScreenToClient(Mouse.CursorPos));
@@ -91,6 +92,15 @@
   end;
 end;
 
+procedure TCustomHeaderControl.DblClick;
+begin
+  inherited DblClick;
+  if FTracking then
+  begin
+    SectionSeparatorDblClick(Sections[FSelectedSection]);
+  end;
+end;
+
 function TCustomHeaderControl.GetSectionAt(P: TPoint): Integer;
 var
   i: integer;
@@ -131,6 +141,27 @@
     FOnSectionTrack(Self, Section, Section.FWidth, State);
 end;
 
+procedure TCustomHeaderControl.SectionSeparatorDblClick(Section: THeaderSection
+  );
+begin
+  if Assigned(FOnSectionSeparatorDblClick) then
+    FOnSectionSeparatorDblClick(Self, Section);
+end;
+
+procedure TCustomHeaderControl.SectionEndDrag();
+begin
+  if Assigned(FOnSectionEndDrag) then
+    FOnSectionEndDrag(self);
+end;
+
+function TCustomHeaderControl.SectionDrag(FromSection,
+  ToSection: THeaderSection): boolean;
+begin
+  Result:=DragReorder;
+  if Result and Assigned(FOnSectionDrag) then
+    FOnSectionDrag(self,FromSection,ToSection,Result);
+end;
+
 procedure TCustomHeaderControl.MouseEnter;
 begin
   inherited MouseEnter;
@@ -161,45 +192,69 @@
     FDown := True;
     FDownPoint := Point(X, Y);
     if Button = mbLeft then
-      if GetSectionAt(Point(X - HeaderBorderSize, Y))<>GetSectionAt(Point(X + HeaderBorderSize, Y)) then
+      if (X > HeaderBorderSize ) and
+         (GetSectionAt(Point(X - HeaderBorderSize, Y))<>GetSectionAt(Point(X + HeaderBorderSize, Y))) then
       begin
         FTracking:=true;
-        FSelectedSelection:=GetSectionAt(Point(X - HeaderBorderSize, Y));
-        if FSelectedSelection = -1 then
+        FSelectedSection:=GetSectionAt(Point(X - HeaderBorderSize, Y));
+        if FSelectedSection = -1 then
           FTracking:=false
         else
           Cursor:=crSizeE;
         if FTracking then
         begin
           FDown := False;
-          SectionTrack(Sections[FSelectedSelection], tsTrackBegin);
+          SectionTrack(Sections[FSelectedSection], tsTrackBegin);
         end;
-      end;
+      end else
+        FSelectedSection:=GetSectionAt(Point(X, Y));
     UpdateState;
   end;
 end;
 
 procedure TCustomHeaderControl.MouseMove(Shift: TShiftState; X, Y: Integer);
+var CurrentSectionIndex: Integer;
 begin
   inherited MouseMove(Shift, X, Y);
   if not (csDesigning in ComponentState) then
   begin
     if FTracking and (ssLeft in shift) then
     begin
-      if x>=FSections[FSelectedSelection].Left then
+      if x>=FSections[FSelectedSection].Left then
       begin
-        FSections[FSelectedSelection].Width := X - FSections[FSelectedSelection].Left;
-        SectionTrack(Sections[FSelectedSelection], tsTrackMove);
+        FSections[FSelectedSection].Width := X - FSections[FSelectedSection].Left;
+        SectionTrack(Sections[FSelectedSection], tsTrackMove);
       end;
     end
-    else
-    if FDown then
+    else if FDragging and (ssLeft in shift) then
     begin
-      if GetSectionAt(Point(X, Y)) <> GetSectionAt(FDownPoint) then
-        FDown := False;
+      CurrentSectionIndex:=GetSectionAt(Point(x,y));
+      if CurrentSectionIndex>-1 then
+      begin
+        if (Sections[CurrentSectionIndex].GetLeft + Sections[CurrentSectionIndex].Width div 2 < X) then
+          FEndDragSectionIndex:=CurrentSectionIndex+1
+         else
+          FEndDragSectionIndex:=CurrentSectionIndex;
+        if FEndDragSectionIndex < Sections.Count - 1 then
+          FDragging:=SectionDrag(Sections[FSelectedSection],Sections[FEndDragSectionIndex])
+         else
+          FDragging:=SectionDrag(Sections[FSelectedSection],Sections[Sections.Count - 1]);
+        RePaint;
+      end;
+    end
+    else if FDown then
+    begin
+      if DragReorder and (abs(X-FDownPoint.X) >= DragStartDistance) then
+      begin
+       FDragging:=true;
+       FEndDragSectionIndex:=FSelectedSection;
+      end else
+       if GetSectionAt(Point(X, Y)) <> GetSectionAt(FDownPoint) then
+         FDown := False;
     end;
     if shift = [] then
-      if GetSectionAt(Point(X - HeaderBorderSize, Y))<>GetSectionAt(Point(X + HeaderBorderSize, Y)) then
+      if (X > HeaderBorderSize) and
+         (GetSectionAt(Point(X - HeaderBorderSize, Y))<>GetSectionAt(Point(X + HeaderBorderSize, Y))) then
         Cursor:=crSizeE
        else
         Cursor:=crDefault;
@@ -213,11 +268,19 @@
   inherited MouseUp(Button, Shift, X, Y);
   if FTracking then
   begin
-    SectionTrack(Sections[FSelectedSelection],tsTrackEnd);
-    SectionResize(Sections[FSelectedSelection]);
+    SectionTrack(Sections[FSelectedSection],tsTrackEnd);
+    SectionResize(Sections[FSelectedSection]);
   end;
+  if FDragging then begin
+    if FSelectedSection<FEndDragSectionIndex then
+      Sections[FSelectedSection].Index:=FEndDragSectionIndex - 1
+     else if FSelectedSection>FEndDragSectionIndex then
+      Sections[FSelectedSection].Index:=FEndDragSectionIndex;
+    SectionEndDrag();
+  end;
   FDown := False;
   FTracking:=false;
+  FDragging:=false;
   UpdateState;
 end;
 
@@ -230,13 +293,16 @@
   MaxState := hsNormal;
   if Enabled then
     if FDown then
-      MaxState := hsPressed
-    else
-    if FMouseInControl then
+    begin
+      MaxState := hsPressed;
+      Index := FSelectedSection;
+    end else if FMouseInControl then
+    begin
       MaxState := hsHot;
+      P := ScreenToClient(Mouse.CursorPos);
+      Index := GetSectionAt(P);
+    end;
 
-  P := ScreenToClient(Mouse.CursorPos);
-  Index := GetSectionAt(P);
   for i := 0 to Sections.Count - 1 do
     if (i <> Index) then
       Sections[i].State := hsNormal
@@ -265,6 +331,17 @@
     FPaintRect.Left := Sections[Sections.Count - 1].Right;
   Details := ThemeServices.GetElementDetails(thHeaderItemRightNormal);
   ThemeServices.DrawElement(Canvas.Handle, Details, FPaintRect);
+
+  if FDragging then
+  begin
+    canvas.Pen.Width:=2;
+    canvas.Pen.Color:=clHotLight;
+    if FEndDragSectionIndex < Sections.Count then
+      canvas.MoveTo(Sections[FEndDragSectionIndex].Left,0)
+     else
+      canvas.MoveTo(Sections[Sections.Count - 1].Right,0);
+    canvas.LineTo(canvas.PenPos.x,ClientHeight);
+  end;
 end;
 
 procedure TCustomHeaderControl.PaintSection(Index: Integer);
@@ -342,18 +419,26 @@
 
 function THeaderSections.Add: THeaderSection;
 begin
-  Result := AddItem(nil, -1);
+  Result := AddItem(nil, Count);
 end;
 
 function THeaderSections.AddItem(Item: THeaderSection; Index: Integer): THeaderSection;
+var i:longint;
 begin
   if Item = nil then
     Result := FHeaderControl.CreateSection;
 
   Result.Collection := Self;
-  if Index < Count then
+  if Index > Count then
     Index := Count - 1;
   Result.Index := Index;
+  //updates OriginalIndex so that it has the value Index would have if there
+  //never was a move
+  for i:=0 to Count - 1 do
+    if Items[i].FOriginalIndex>=Index then
+      Items[i].FOriginalIndex:=Items[i].FOriginalIndex + 1;
+  Result.FOriginalIndex := Index;
+  
 end;
 
 function THeaderSections.Insert(Index: Integer): THeaderSection;
@@ -361,6 +446,17 @@
   Result := AddItem(nil, Index);
 end;
 
+procedure THeaderSections.Delete(Index: Integer);
+var i:longint;
+begin
+  inherited Delete(Index);
+  //updates OriginalIndex so that it has the value Index would have if there
+  //never was a move
+  for i:=0 to Count - 1 do
+    if items[i].FOriginalIndex > Index then
+      items[i].FOriginalIndex := items[i].FOriginalIndex - 1;
+end;
+
 { THeaderSection }
 
 function THeaderSection.GetLeft: Integer;
@@ -471,6 +567,7 @@
   FState := hsNormal;
   FMinWidth := 0;
   FMaxWidth := 10000;
+  FOriginalIndex:=ACollection.Count-1;
 end;
 
 procedure THeaderSection.Assign(Source: TPersistent);
headercontrol.patch (12,829 bytes)   

Paul Ishenin

2008-04-28 08:57

manager   ~0019115

Thanks, applied.

Issue History

Date Modified Username Field Change
2008-04-25 20:55 Benito van der Zander New Issue
2008-04-25 20:55 Benito van der Zander File Added: headercontrol.patch
2008-04-25 20:55 Benito van der Zander Widgetset => Win32
2008-04-25 21:37 Vincent Snijders Project Lazarus => Patches
2008-04-25 21:37 Vincent Snijders LazTarget => 0.9.26
2008-04-25 21:37 Vincent Snijders Assigned To => Paul Ishenin
2008-04-25 21:37 Vincent Snijders Status new => assigned
2008-04-25 21:37 Vincent Snijders Target Version => 0.9.26
2008-04-28 08:57 Paul Ishenin Fixed in Revision => 14995
2008-04-28 08:57 Paul Ishenin Status assigned => resolved
2008-04-28 08:57 Paul Ishenin Fixed in Version => 0.9.26
2008-04-28 08:57 Paul Ishenin Resolution open => fixed
2008-04-28 08:57 Paul Ishenin Note Added: 0019115
2008-07-10 01:01 Marc Weustink Status resolved => closed