Implemented BorderStyle

Fixed editord position while scrolling
Fixed DoubleClick event

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

components/virtualtreeview-unstable/VirtualTrees.pas

@@ -1714,7 +1714,7 @@ type
 TBaseVirtualTree = class(TCustomControl)
   private
     FBidiMode: TBidiMode;
-    FBorderStyle: TBorderStyle;
+    //FBorderStyle: TBorderStyle;
     FHeader: TVTHeader;
     FRoot: PVirtualNode;
     FDefaultNodeHeight,
@@ -2028,7 +2028,7 @@ TBaseVirtualTree = class(TCustomControl)
     procedure SetAnimationDuration(const Value: Cardinal);
     procedure SetBackground(const Value: TPicture);
     procedure SetBackgroundOffset(const Index, Value: Integer);
-    procedure SetBorderStyle(Value: TBorderStyle);
+    //procedure SetBorderStyle(Value: TBorderStyle);
     procedure SetBottomSpace(const Value: Cardinal);
     procedure SetButtonFillMode(const Value: TVTButtonFillMode);
     procedure SetButtonStyle(const Value: TVTButtonStyle);
@@ -2173,6 +2173,7 @@ TBaseVirtualTree = class(TCustomControl)
     procedure DoAfterItemPaint(Canvas: TCanvas; Node: PVirtualNode; ItemRect: TRect); virtual;
     procedure DoAfterPaint(Canvas: TCanvas); virtual;
     procedure DoAutoScroll(X, Y: Integer); virtual;
+    procedure DoAutoSize; override;
     function DoBeforeDrag(Node: PVirtualNode; Column: TColumnIndex): Boolean; virtual;
     procedure DoBeforeCellPaint(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; CellRect: TRect); virtual;
     procedure DoBeforeItemErase(Canvas: TCanvas; Node: PVirtualNode; ItemRect: TRect; var Color: TColor;
@@ -2359,7 +2360,7 @@ TBaseVirtualTree = class(TCustomControl)
     property BackgroundOffsetX: Integer index 0 read FBackgroundOffsetX write SetBackgroundOffset default 0;
     property BackgroundOffsetY: Integer index 1 read FBackgroundOffsetY write SetBackgroundOffset default 0;
     property BidiMode: TBidiMode read FBidiMode write FBidiMode default bdLeftToRight;
-    property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
+    //property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
     property BottomSpace: Cardinal read FBottomSpace write SetBottomSpace default 0;
     property ButtonFillMode: TVTButtonFillMode read FButtonFillMode write SetButtonFillMode default fmTreeColor;
     property ButtonStyle: TVTButtonStyle read FButtonStyle write SetButtonStyle default bsRectangle;
@@ -11645,7 +11646,7 @@ begin
   FPlusBM := TBitmap.Create;
   FMinusBM := TBitmap.Create;
 
-  FBorderStyle := bsSingle;
+  //FBorderStyle := bsSingle;
   FButtonStyle := bsRectangle;
   FButtonFillMode := fmTreeColor;
 
@@ -13923,7 +13924,7 @@ begin
 end;
 
 //----------------------------------------------------------------------------------------------------------------------
-
+{
 procedure TBaseVirtualTree.SetBorderStyle(Value: TBorderStyle);
 
 begin
@@ -13934,7 +13935,7 @@ begin
     RecreateWnd(Self);
   end;
 end;
-
+}
 //----------------------------------------------------------------------------------------------------------------------
 
 procedure TBaseVirtualTree.SetBottomSpace(const Value: Cardinal);
@@ -15015,8 +15016,9 @@ end;
 procedure TBaseVirtualTree.CMCtl3DChanged(var Message: TLMessage);
 
 begin
+  //todo: check what this message is supposed todo. Probably will be removed
   inherited;
-  if FBorderStyle = bsSingle then
+  if BorderStyle = bsSingle then
     RecreateWnd(Self);
 end;
 
@@ -16592,8 +16594,8 @@ var
 begin
   Logger.EnterMethod(lcMessages,'WMLButtonDblClk');
   DoStateChange([tsLeftDblClick]);
-  //LCL does not has a inherited WMLButtonDblClick
+
-  //inherited WMLButtonDblClick(Message);
+  inherited WMLButtonDblClk(Message);
 
   // get information about the hit
   GetHitTestInfoAt(Message.XPos, Message.YPos, True, HitInfo);
@@ -17214,7 +17216,7 @@ procedure TBaseVirtualTree.WMVScroll(var Message: TLMVScroll);
 
 begin
   Logger.EnterMethod(lcScroll,'WMVScroll');
-  Logger.SendCallStack(lcScroll,'CallStack');
+  //Logger.SendCallStack(lcScroll,'CallStack');
   case Message.ScrollCode of
     SB_BOTTOM:
       SetOffsetY(-Integer(FRoot.TotalHeight));
@@ -17854,7 +17856,9 @@ begin
       WindowClass.style := WindowClass.style or CS_HREDRAW or CS_VREDRAW
     else
       WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
-    if FBorderStyle = bsSingle then
+    //lcl: Ctl3D is not used in LCL. Has the same meaning of BorderStyle = bsSingle
+    {
+    if BorderStyle = bsSingle then
     begin
       if Ctl3D then
       begin
@@ -17866,6 +17870,7 @@ begin
     end
     else
       Style := Style and not WS_BORDER;
+    }
     //todo_lcl_low
     //AddBiDiModeExStyle(ExStyle);
   end;
@@ -18411,6 +18416,13 @@ begin
   end;
 end;
 
+
+procedure TBaseVirtualTree.DoAutoSize;
+begin
+  //The default DoAutoSize makes the editors be placed wrongly when scrolling
+end;
+
+
 //----------------------------------------------------------------------------------------------------------------------
 
 function TBaseVirtualTree.DoBeforeDrag(Node: PVirtualNode; Column: TColumnIndex): Boolean;
@@ -19496,7 +19508,7 @@ var
 begin
   Logger.EnterMethod(lcScroll,'DoSetOffsetXY');
   Logger.Send(lcScroll,'Value',Value);
-  Logger.SendCallStack(lcScroll,'CallStack');
+  //Logger.SendCallStack(lcScroll,'CallStack');
   // Range check, order is important here.
   if Value.X < (ClientWidth - Integer(FRangeX)) then
     Value.X := ClientWidth - Integer(FRangeX);
@@ -19557,12 +19569,12 @@ begin
             R := ClientRect;
             R.Left := Header.Columns.GetVisibleFixedWidth;
 
-            ScrollWindow(Handle, DeltaX, 0, @R, @R);
+            Windows.ScrollWindow(Handle, DeltaX, 0, @R, @R);
             if DeltaY <> 0 then
-              ScrollWindow(Handle, 0, DeltaY, ClipRect, ClipRect);
+              Windows.ScrollWindow(Handle, 0, DeltaY, ClipRect, ClipRect);
           end
           else
-            ScrollWindow(Handle, DeltaX, DeltaY, ClipRect, ClipRect);
+            Windows.ScrollWindow(Handle, DeltaX, DeltaY, ClipRect, ClipRect);
         end;
       end;
 

components/virtualtreeview-unstable/demos/mininal/Main.lfm

@@ -25,8 +25,10 @@ object MainForm: TMainForm
     Top = 36
     Width = 397
     Anchors = [akTop, akLeft, akRight, akBottom]
+    BorderStyle = bsSingle
     Colors.BorderColor = clWindowText
     Colors.HotColor = clBlack
+    Ctl3D = True
     Header.AutoSizeIndex = -1
     Header.Font.Height = -11
     Header.Font.Name = 'MS Sans Serif'

components/virtualtreeview-unstable/demos/mininal/Main.lrs

@@ -1,3 +1,5 @@
+{ This is an automatically generated lazarus resource file }
+
 LazarusResources.Add('TMainForm','FORMDATA',[
   'TPF0'#9'TMainForm'#8'MainForm'#4'Left'#3'a'#1#6'Height'#3#225#1#3'Top'#3#172
   +#0#5'Width'#3#169#1#18'HorzScrollBar.Page'#3#168#1#18'VertScrollBar.Page'#3
@@ -7,32 +9,33 @@ LazarusResources.Add('TMainForm','FORMDATA',[
   +'Width'#2'u'#7'Caption'#6#24'Last operation duration:'#5'Color'#7#6'clNone'
   +#11'ParentColor'#8#0#0#18'TVirtualStringTree'#3'VST'#4'Left'#2#8#6'Height'#3
   +'>'#1#3'Top'#2'$'#5'Width'#3#141#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRigh'
-  +'t'#8'akBottom'#0#18'Colors.BorderColor'#7#12'clWindowText'#15'Colors.HotCol'
+  +'t'#8'akBottom'#0#11'BorderStyle'#7#8'bsSingle'#18'Colors.BorderColor'#7#12
-  +'or'#7#7'clBlack'#20'Header.AutoSizeIndex'#2#255#18'Header.Font.Height'#2#245
+  +'clWindowText'#15'Colors.HotColor'#7#7'clBlack'#5'Ctl3D'#9#20'Header.AutoSiz'
-  +#16'Header.Font.Name'#6#13'MS Sans Serif'#17'Header.MainColumn'#2#255#14'Hea'
+  +'eIndex'#2#255#18'Header.Font.Height'#2#245#16'Header.Font.Name'#6#13'MS San'
-  +'der.Options'#11#14'hoColumnResize'#6'hoDrag'#0#13'HintAnimation'#7#7'hatNon'
+  +'s Serif'#17'Header.MainColumn'#2#255#14'Header.Options'#11#14'hoColumnResiz'
-  +'e'#17'IncrementalSearch'#7#5'isAll'#13'RootNodeCount'#2'd'#8'TabOrder'#2#0
+  +'e'#6'hoDrag'#0#13'HintAnimation'#7#7'hatNone'#17'IncrementalSearch'#7#5'isA'
-  +#28'TreeOptions.AnimationOptions'#11#16'toAnimatedToggle'#0#23'TreeOptions.A'
+  +'ll'#13'RootNodeCount'#2'd'#8'TabOrder'#2#0#28'TreeOptions.AnimationOptions'
-  +'utoOptions'#11#16'toAutoDropExpand'#22'toAutoTristateTracking'#0#23'TreeOpt'
+  +#11#16'toAnimatedToggle'#0#23'TreeOptions.AutoOptions'#11#16'toAutoDropExpan'
-  +'ions.MiscOptions'#11#10'toEditable'#12'toInitOnSave'#18'toToggleOnDblClick'
+  +'d'#22'toAutoTristateTracking'#0#23'TreeOptions.MiscOptions'#11#10'toEditabl'
-  +#14'toWheelPanning'#0#24'TreeOptions.PaintOptions'#11#13'toShowButtons'#10't'
+  +'e'#12'toInitOnSave'#18'toToggleOnDblClick'#14'toWheelPanning'#0#24'TreeOpti'
-  +'oShowRoot'#15'toShowTreeLines'#12'toThemeAware'#18'toUseBlendedImages'#0#28
+  +'ons.PaintOptions'#11#13'toShowButtons'#10'toShowRoot'#15'toShowTreeLines'#12
-  +'TreeOptions.SelectionOptions'#11#13'toMultiSelect'#22'toCenterScrollIntoVie'
+  +'toThemeAware'#18'toUseBlendedImages'#0#28'TreeOptions.SelectionOptions'#11
-  +'w'#0#10'OnFreeNode'#7#11'VSTFreeNode'#9'OnGetText'#7#10'VSTGetText'#10'OnIn'
+  +#13'toMultiSelect'#22'toCenterScrollIntoView'#0#10'OnFreeNode'#7#11'VSTFreeN'
-  +'itNode'#7#11'VSTInitNode'#7'Columns'#14#0#0#0#7'TButton'#11'ClearButton'#4
+  +'ode'#9'OnGetText'#7#10'VSTGetText'#10'OnInitNode'#7#11'VSTInitNode'#7'Colum'
-  +'Left'#2'a'#6'Height'#2#25#3'Top'#3#165#1#5'Width'#3#129#0#7'Anchors'#11#6'a'
+  +'ns'#14#0#0#0#7'TButton'#11'ClearButton'#4'Left'#2'a'#6'Height'#2#25#3'Top'#3
-  +'kLeft'#8'akBottom'#0#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#10'Clea'
+  +#165#1#5'Width'#3#129#0#7'Anchors'#11#6'akLeft'#8'akBottom'#0#25'BorderSpaci'
-  +'r tree'#7'OnClick'#7#16'ClearButtonClick'#8'TabOrder'#2#1#0#0#7'TButton'#12
+  +'ng.InnerBorder'#2#4#7'Caption'#6#10'Clear tree'#7'OnClick'#7#16'ClearButton'
-  +'AddOneButton'#4'Left'#2'`'#6'Height'#2#25#3'Top'#3'i'#1#5'Width'#3#130#0#7
+  +'Click'#8'TabOrder'#2#1#0#0#7'TButton'#12'AddOneButton'#4'Left'#2'`'#6'Heigh'
-  +'Anchors'#11#6'akLeft'#8'akBottom'#0#25'BorderSpacing.InnerBorder'#2#4#7'Cap'
+  +'t'#2#25#3'Top'#3'i'#1#5'Width'#3#130#0#7'Anchors'#11#6'akLeft'#8'akBottom'#0
-  +'tion'#6#19'Add node(s) to root'#7'OnClick'#7#14'AddButtonClick'#8'TabOrder'
+  +#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#19'Add node(s) to root'#7'On'
-  +#2#2#0#0#5'TEdit'#5'Edit1'#4'Left'#2#8#6'Height'#2#21#3'Top'#3'y'#1#5'Width'
+  +'Click'#7#14'AddButtonClick'#8'TabOrder'#2#2#0#0#5'TEdit'#5'Edit1'#4'Left'#2
-  +#2'Q'#7'Anchors'#11#6'akLeft'#8'akBottom'#0#8'TabOrder'#2#3#4'Text'#6#1'1'#0
+  +#8#6'Height'#2#21#3'Top'#3'y'#1#5'Width'#2'Q'#7'Anchors'#11#6'akLeft'#8'akBo'
-  +#0#7'TButton'#7'Button1'#3'Tag'#2#1#4'Left'#2'`'#6'Height'#2#25#3'Top'#3#133
+  +'ttom'#0#8'TabOrder'#2#3#4'Text'#6#1'1'#0#0#7'TButton'#7'Button1'#3'Tag'#2#1
-  +#1#5'Width'#3#130#0#7'Anchors'#11#6'akLeft'#8'akBottom'#0#25'BorderSpacing.I'
+  +#4'Left'#2'`'#6'Height'#2#25#3'Top'#3#133#1#5'Width'#3#130#0#7'Anchors'#11#6
-  +'nnerBorder'#2#4#7'Caption'#6#23'Add node(s) as children'#7'OnClick'#7#14'Ad'
+  +'akLeft'#8'akBottom'#0#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#23'Add'
-  +'dButtonClick'#8'TabOrder'#2#4#0#0#7'TButton'#11'CloseButton'#4'Left'#3'J'#1
+  +' node(s) as children'#7'OnClick'#7#14'AddButtonClick'#8'TabOrder'#2#4#0#0#7
-  +#6'Height'#2#25#3'Top'#3#165#1#5'Width'#2'K'#7'Anchors'#11#7'akRight'#8'akBo'
+  +'TButton'#11'CloseButton'#4'Left'#3'J'#1#6'Height'#2#25#3'Top'#3#165#1#5'Wid'
-  +'ttom'#0#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#5'Close'#7'OnClick'#7
+  +'th'#2'K'#7'Anchors'#11#7'akRight'#8'akBottom'#0#25'BorderSpacing.InnerBorde'
-  +#16'CloseButtonClick'#8'TabOrder'#2#5#0#0#0
+  +'r'#2#4#7'Caption'#6#5'Close'#7'OnClick'#7#16'CloseButtonClick'#8'TabOrder'#2
+  +#5#0#0#0
 ]);

components/virtualtreeview-unstable/demos/objects/MVCDemoMain.pas

@@ -88,7 +88,7 @@ end;
 procedure TfmMVCDemo.FormCreate(Sender: TObject);
 begin
   Logger.Channels.Add(TIPCChannel.Create);
-  Logger.ActiveClasses:=[lcEditLink];
+  Logger.ActiveClasses:=[];//[lcEditLink,lcScroll];
   Logger.Clear;
   P:=TMVCPanel.Create(Self);
   with P do

components/virtualtreeview-unstable/demos/objects/MVCTypes.pas

@@ -57,7 +57,7 @@ unit MVCTypes;
 interface
 
 uses Windows, LCLIntf,Messages,SysUtils,Graphics,VirtualTrees,Classes,StdCtrls,
-     Controls,Forms,ImgList,LCLType, delphicompat, vtlogger;
+     Controls,Forms,ImgList,LCLType, delphicompat, vtlogger, LMessages;
 
 type { TMVCNode is the encapsulation of a single Node in the structure.
        This implementation is a bit bloated because in my project
@@ -253,9 +253,12 @@ type { TMVCNode is the encapsulation of a single Node in the structure.
          property OnChange;
        end;
 
+   { TMVCEdit }
+
    TMVCEdit=class(TCustomEdit)
               private
                 FLink:TMVCEditLink;
+                procedure WMMove(var Message: TLMMove); message LM_MOVE;
                 procedure WMChar(var Message: TWMChar); message WM_CHAR;
                 procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
                 procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS;
@@ -921,6 +924,15 @@ begin
   FLink:=Link;
 end;
 
+procedure TMVCEdit.WMMove(var Message: TLMMove);
+begin
+  Logger.EnterMethod(lcEditLink,'TMVCEdit.WMMove');
+  Logger.Send(lcEditLink,'XPos: %d YPos: %d',[Message.XPos, Message.YPos]);
+  Logger.SendCallStack(lcEditLink,'Stack');
+  inherited WMMove(Message);
+  Logger.ExitMethod(lcEditLink,'TMVCEdit.WMMove');
+end;
+
 procedure TMVCEdit.WMChar(var Message: TWMChar);
 // handle character keys
 begin