pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

Implemented BorderStyle

Browse Source 
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
This commit is contained in:
blikblum
2007-02-22 12:57:35 +00:00
parent ffb8a94c7c
commit a82be98ef4
5 changed files with 74 additions and 45 deletions
Download Patch File Download Diff File Expand all files Collapse all files

42
components/virtualtreeview-unstable/VirtualTrees.pas
View File

@ -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;

2
components/virtualtreeview-unstable/demos/mininal/Main.lfm
View File

@ -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'

59
components/virtualtreeview-unstable/demos/mininal/Main.lrs
View File

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

2
components/virtualtreeview-unstable/demos/objects/MVCDemoMain.pas
View File

@ -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

14
components/virtualtreeview-unstable/demos/objects/MVCTypes.pas
View File

@ -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