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

* Skip animation in Gtk due to poor timeGetTime implementation

Browse Source 
* Dont cancel edit in WMKeydown under gtk1 (LCL bug 8865)
* Cleanup of objects and minimal demos

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@164 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
blikblum
2007-05-14 12:18:53 +00:00
parent 2843f3cd0c
commit 2411bee5e1
15 changed files with 433 additions and 417 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -16475,6 +16475,7 @@ begin
end
else
DoStateChange([tsIncrementalSearchPending]);
VK_ESCAPE: // cancel actions currently in progress
begin
if IsMouseSelecting then
@ -16482,9 +16483,12 @@ begin
DoStateChange([], [tsDrawSelecting, tsDrawSelPending]);
Invalidate;
end
//gtk1 does not like to free a component in KeyDown
{$ifndef LCLGtk}
else
if IsEditing then
CancelEditNode;
{$endif}
end;
VK_SPACE:
if (toCheckSupport in FOptions.FMiscOptions) and Assigned(FFocusedNode) and
@ -17505,6 +17509,10 @@ var
CurrentTime: Cardinal;
begin
{$ifndef Windows}
//Is necessary to properly implement timeGetTime in non Windows
Exit;
{$endif}
if not (tsInAnimation in FStates) and (Duration > 0) then
begin
DoStateChange([tsInAnimation]);
@ -18338,6 +18346,7 @@ begin
if (ClientHeight - FOffsetY < Integer(FRangeY)) and (Y > ClientHeight - Integer(FDefaultNodeHeight)) then
Include(Result, sdDown);
//todo: probably the code below is bug due to poor timeGetTime implementation
// Since scrolling during dragging is not handled via the timer we do a check here whether the auto
// scroll timeout already has elapsed or not.
if (Result <> []) and

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

@ -1,30 +1,31 @@
object MainForm: TMainForm
Left = 437
Height = 481
Top = 278
Width = 425
HorzScrollBar.Page = 424
VertScrollBar.Page = 480
Left = 340
Height = 486
Top = 147
Width = 427
HorzScrollBar.Page = 426
VertScrollBar.Page = 485
ActiveControl = VST
Caption = 'Simple Virtual Treeview demo'
ClientHeight = 486
ClientWidth = 427
Font.Height = -11
Font.Name = 'MS Sans Serif'
OnCreate = FormCreate
object Label1: TLabel
Left = 12
Height = 14
Top = 12
Width = 152
Left = 10
Height = 17
Top = 8
Width = 171
Caption = 'Last operation duration:'
Color = clNone
ParentColor = False
end
object VST: TVirtualStringTree
Left = 8
Height = 318
Top = 36
Width = 397
Anchors = [akTop, akLeft, akRight, akBottom]
Left = 10
Height = 360
Top = 24
Width = 410
BorderStyle = bsSingle
Colors.BorderColor = clWindowText
Colors.HotColor = clBlack
@ -51,31 +52,28 @@ object MainForm: TMainForm
object ClearButton: TButton
Left = 97
Height = 25
Top = 421
Width = 129
Anchors = [akLeft, akBottom]
Top = 452
Width = 183
BorderSpacing.InnerBorder = 4
Caption = 'Clear tree'
OnClick = ClearButtonClick
TabOrder = 1
end
object AddOneButton: TButton
Left = 96
Left = 97
Height = 25
Top = 361
Width = 130
Anchors = [akLeft, akBottom]
Top = 392
Width = 183
BorderSpacing.InnerBorder = 4
Caption = 'Add node(s) to root'
OnClick = AddButtonClick
TabOrder = 2
end
object Edit1: TEdit
Left = 8
Left = 10
Height = 21
Top = 377
Width = 81
Anchors = [akLeft, akBottom]
Top = 392
Width = 79
TabOrder = 3
Text = '1'
end
@ -83,20 +81,18 @@ object MainForm: TMainForm
Tag = 1
Left = 96
Height = 25
Top = 389
Width = 130
Anchors = [akLeft, akBottom]
Top = 422
Width = 184
BorderSpacing.InnerBorder = 4
Caption = 'Add node(s) as children'
OnClick = AddButtonClick
TabOrder = 4
end
object CloseButton: TButton
Left = 330
Left = 345
Height = 25
Top = 421
Top = 452
Width = 75
Anchors = [akRight, akBottom]
BorderSpacing.InnerBorder = 4
Caption = 'Close'
OnClick = CloseButtonClick

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

@ -1,41 +1,38 @@
{ This is an automatically generated lazarus resource file }
LazarusResources.Add('TMainForm','FORMDATA',[
'TPF0'#9'TMainForm'#8'MainForm'#4'Left'#3#181#1#6'Height'#3#225#1#3'Top'#3#22
+#1#5'Width'#3#169#1#18'HorzScrollBar.Page'#3#168#1#18'VertScrollBar.Page'#3
+#224#1#13'ActiveControl'#7#3'VST'#7'Caption'#6#28'Simple Virtual Treeview de'
+'mo'#11'Font.Height'#2#245#9'Font.Name'#6#13'MS Sans Serif'#8'OnCreate'#7#10
+'FormCreate'#0#6'TLabel'#6'Label1'#4'Left'#2#12#6'Height'#2#14#3'Top'#2#12#5
+'Width'#3#152#0#7'Caption'#6#24'Last operation duration:'#5'Color'#7#6'clNon'
+'e'#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'akRi'
+'ght'#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
'TPF0'#9'TMainForm'#8'MainForm'#4'Left'#3'T'#1#6'Height'#3#230#1#3'Top'#3#147
+#0#5'Width'#3#171#1#18'HorzScrollBar.Page'#3#170#1#18'VertScrollBar.Page'#3
+#229#1#13'ActiveControl'#7#3'VST'#7'Caption'#6#28'Simple Virtual Treeview de'
+'mo'#12'ClientHeight'#3#230#1#11'ClientWidth'#3#171#1#11'Font.Height'#2#245#9
+'Font.Name'#6#13'MS Sans Serif'#8'OnCreate'#7#10'FormCreate'#0#6'TLabel'#6'L'
+'abel1'#4'Left'#2#10#6'Height'#2#17#3'Top'#2#8#5'Width'#3#171#0#7'Caption'#6
+#24'Last operation duration:'#5'Color'#7#6'clNone'#11'ParentColor'#8#0#0#18
+'TVirtualStringTree'#3'VST'#4'Left'#2#10#6'Height'#3'h'#1#3'Top'#2#24#5'Widt'
+'h'#3#154#1#11'BorderStyle'#7#8'bsSingle'#18'Colors.BorderColor'#7#12'clWind'
+'owText'#15'Colors.HotColor'#7#7'clBlack'#5'Ctl3D'#9#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'Header.Options'#11#14'hoColumnResize'#6'hoDr'
+'ag'#0#13'HintAnimation'#7#7'hatNone'#17'IncrementalSearch'#7#5'isAll'#13'Ro'
+'otNodeCount'#2'd'#8'TabOrder'#2#0#28'TreeOptions.AnimationOptions'#11#16'to'
+'AnimatedToggle'#0#23'TreeOptions.AutoOptions'#11#16'toAutoDropExpand'#22'to'
+'AutoTristateTracking'#0#23'TreeOptions.MiscOptions'#11#10'toEditable'#12'to'
+'InitOnSave'#18'toToggleOnDblClick'#14'toWheelPanning'#0#24'TreeOptions.Pain'
+'tOptions'#11#13'toShowButtons'#10'toShowRoot'#15'toShowTreeLines'#12'toThem'
+'eAware'#18'toUseBlendedImages'#0#28'TreeOptions.SelectionOptions'#11#13'toM'
+'ultiSelect'#22'toCenterScrollIntoView'#0#10'OnFreeNode'#7#11'VSTFreeNode'#9
+'OnGetText'#7#10'VSTGetText'#10'OnInitNode'#7#11'VSTInitNode'#7'Columns'#14#0
+#0#0#7'TButton'#11'ClearButton'#4'Left'#2'a'#6'Height'#2#25#3'Top'#3#196#1#5
+'Width'#3#183#0#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#10'Clear tree'
+#7'OnClick'#7#16'ClearButtonClick'#8'TabOrder'#2#1#0#0#7'TButton'#12'AddOneB'
+'utton'#4'Left'#2'a'#6'Height'#2#25#3'Top'#3#136#1#5'Width'#3#183#0#25'Borde'
+'rSpacing.InnerBorder'#2#4#7'Caption'#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#10#6'Hei'
+'ght'#2#21#3'Top'#3#136#1#5'Width'#2'O'#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#166#1#5
+'Width'#3#184#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'TButto'
+'n'#11'CloseButton'#4'Left'#3'Y'#1#6'Height'#2#25#3'Top'#3#196#1#5'Width'#2
+'K'#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#5'Close'#7'OnClick'#7#16
+'CloseButtonClick'#8'TabOrder'#2#5#0#0#0
]);

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

@ -12,7 +12,7 @@ uses
{$ifdef DEBUG}
vtlogger, ipcchannel,
{$endif}
LCLIntf, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
LCLIntf, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
VirtualTrees, StdCtrls, ExtCtrls, LResources, Buttons;
type

21
components/virtualtreeview-unstable/demos/mininal/minimal_lcl.lpi
View File

@ -34,32 +34,20 @@
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="4">
<Units Count="2">
<Unit0>
<Filename Value="minimal_lcl.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="minimal_lcl"/>
</Unit0>
<Unit1>
<Filename Value="fmain.pas"/>
<ComponentName Value="Form1"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="fmain.lrs"/>
<UnitName Value="fmain"/>
</Unit1>
<Unit2>
<Filename Value="Main.pas"/>
<ComponentName Value="MainForm"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="Main.lrs"/>
<UnitName Value="Main"/>
</Unit2>
<Unit3>
<Filename Value="../../units/gtk/mmsystem.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="mmsystem"/>
</Unit3>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
@ -70,11 +58,6 @@
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
<Linking>
<Debugging>
<UseLineInfoUnit Value="False"/>
</Debugging>
</Linking>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>

5
components/virtualtreeview-unstable/demos/mininal/minimal_lcl.lpr
View File

@ -8,12 +8,11 @@ uses
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms
{ add your units here }, Main, virtualtreeview_package,
mmsystem;
{ add your units here }, Main;
begin
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.CreateForm(TMainForm,MainForm);
Application.Run;
end.

86
components/virtualtreeview-unstable/demos/objects/MVCDemoMain.lfm
View File

@ -1,66 +1,70 @@
object fmMVCDemo: TfmMVCDemo
Left = 258
Height = 480
Top = 174
Width = 709
HorzScrollBar.Page = 708
VertScrollBar.Page = 479
Left = 165
Height = 518
Top = 154
Width = 742
HorzScrollBar.Page = 741
VertScrollBar.Page = 517
ActiveControl = edCaption
Caption = 'Virtual Tree - MVC Demo written by Marian Aldenhövel'
ClientHeight = 518
ClientWidth = 742
Font.Height = -11
Font.Name = 'MS Sans Serif'
OnCreate = FormCreate
object pnlControls: TPanel
Height = 84
Top = 396
Width = 709
Height = 118
Top = 400
Width = 742
Align = alBottom
BevelInner = bvLowered
BevelOuter = bvNone
Caption = ' '
ClientHeight = 118
ClientWidth = 742
TabOrder = 0
object Label1: TLabel
Left = 51
Height = 14
Top = 8
Width = 42
Left = 72
Height = 17
Top = 7
Width = 61
Alignment = taRightJustify
Caption = 'Caption:'
Color = clNone
ParentColor = False
end
object Label3: TLabel
Left = 33
Height = 14
Left = 47
Height = 17
Top = 31
Width = 58
Width = 86
Alignment = taRightJustify
Caption = 'Subcaption:'
Color = clNone
ParentColor = False
end
object Label4: TLabel
Left = 7
Height = 14
Top = 56
Width = 88
Left = 8
Height = 17
Top = 55
Width = 125
Alignment = taRightJustify
Caption = 'Incidence (0..63):'
Color = clNone
ParentColor = False
end
object Label2: TLabel
Left = 212
Height = 92
Top = 4
Width = 186
Caption = 'Edit the current node.'#13#10#13#10'Note that you are setting data in a structure without referring to a visual component except for the information about what node currently has the focus.'
Left = 256
Height = 97
Top = 5
Width = 296
Caption = 'Edit the current node.'#10'Note that you are setting data in a structure without referring to a visual component except for the information about what node currently has the focus.'
Color = clNone
ParentColor = False
WordWrap = True
end
object edCaption: TEdit
Left = 92
Left = 136
Height = 21
Top = 5
Width = 112
@ -69,7 +73,7 @@ object fmMVCDemo: TfmMVCDemo
Text = 'edCaption'
end
object edSubcaption: TEdit
Left = 92
Left = 136
Height = 21
Top = 29
Width = 112
@ -78,10 +82,10 @@ object fmMVCDemo: TfmMVCDemo
Text = 'edCaption'
end
object edIncidence: TEdit
Left = 92
Left = 136
Height = 21
Top = 53
Width = 59
Width = 51
OnChange = edIncidenceChange
OnKeyDown = nil
OnKeyPress = edIncidenceKeyPress
@ -89,7 +93,7 @@ object fmMVCDemo: TfmMVCDemo
Text = '0'
end
object UpDown1: TUpDown
Left = 151
Left = 187
Height = 21
Top = 53
Width = 15
@ -98,30 +102,30 @@ object fmMVCDemo: TfmMVCDemo
TabOrder = 3
end
object btnAdd: TButton
Left = 429
Left = 560
Height = 25
Top = 4
Width = 75
Top = 8
Width = 112
BorderSpacing.InnerBorder = 4
Caption = '+ Add a child'
OnClick = btnAddClick
TabOrder = 4
end
object btnDelete: TButton
Left = 429
Left = 560
Height = 25
Top = 32
Width = 75
Top = 40
Width = 112
BorderSpacing.InnerBorder = 4
Caption = '- delete node'
Caption = '- Delete node'
OnClick = btnDeleteClick
TabOrder = 5
end
object cbLive: TCheckBox
Left = 618
Height = 13
Top = 9
Width = 48
Left = 680
Height = 24
Top = 8
Width = 58
Caption = 'Live!'
Font.Height = -11
Font.Name = 'MS Sans Serif'

143
components/virtualtreeview-unstable/demos/objects/MVCDemoMain.lrs
View File

@ -1,77 +1,78 @@
{ This is an automatically generated lazarus resource file }
LazarusResources.Add('TfmMVCDemo','FORMDATA',[
'TPF0'#10'TfmMVCDemo'#9'fmMVCDemo'#4'Left'#3#2#1#6'Height'#3#224#1#3'Top'#3
+#174#0#5'Width'#3#197#2#18'HorzScrollBar.Page'#3#196#2#18'VertScrollBar.Page'
+#3#223#1#13'ActiveControl'#7#9'edCaption'#7'Caption'#6'5Virtual Tree - MVC D'
+'emo written by Marian Aldenh'#195#182'vel'#11'Font.Height'#2#245#9'Font.Nam'
+'e'#6#13'MS Sans Serif'#8'OnCreate'#7#10'FormCreate'#0#6'TPanel'#11'pnlContr'
+'ols'#6'Height'#2'T'#3'Top'#3#140#1#5'Width'#3#197#2#5'Align'#7#8'alBottom'
+#10'BevelInner'#7#9'bvLowered'#10'BevelOuter'#7#6'bvNone'#7'Caption'#6#1' '#8
+'TabOrder'#2#0#0#6'TLabel'#6'Label1'#4'Left'#2'3'#6'Height'#2#14#3'Top'#2#8#5
+'Width'#2'*'#9'Alignment'#7#14'taRightJustify'#7'Caption'#6#8'Caption:'#5'Co'
+'lor'#7#6'clNone'#11'ParentColor'#8#0#0#6'TLabel'#6'Label3'#4'Left'#2'!'#6'H'
+'eight'#2#14#3'Top'#2#31#5'Width'#2':'#9'Alignment'#7#14'taRightJustify'#7'C'
+'aption'#6#11'Subcaption:'#5'Color'#7#6'clNone'#11'ParentColor'#8#0#0#6'TLab'
+'el'#6'Label4'#4'Left'#2#7#6'Height'#2#14#3'Top'#2'8'#5'Width'#2'X'#9'Alignm'
+'ent'#7#14'taRightJustify'#7'Caption'#6#18'Incidence (0..63):'#5'Color'#7#6
+'clNone'#11'ParentColor'#8#0#0#6'TLabel'#6'Label2'#4'Left'#3#212#0#6'Height'
+#2'\'#3'Top'#2#4#5'Width'#3#186#0#7'Caption'#6#179'Edit the current node.'#13
+#10#13#10'Note that you are setting data in a structure without referring to'
'TPF0'#10'TfmMVCDemo'#9'fmMVCDemo'#4'Left'#3#165#0#6'Height'#3#6#2#3'Top'#3
+#154#0#5'Width'#3#230#2#18'HorzScrollBar.Page'#3#229#2#18'VertScrollBar.Page'
+#3#5#2#13'ActiveControl'#7#9'edCaption'#7'Caption'#6'5Virtual Tree - MVC Dem'
+'o written by Marian Aldenh'#195#182'vel'#12'ClientHeight'#3#6#2#11'ClientWi'
+'dth'#3#230#2#11'Font.Height'#2#245#9'Font.Name'#6#13'MS Sans Serif'#8'OnCre'
+'ate'#7#10'FormCreate'#0#6'TPanel'#11'pnlControls'#6'Height'#2'v'#3'Top'#3
+#144#1#5'Width'#3#230#2#5'Align'#7#8'alBottom'#10'BevelInner'#7#9'bvLowered'
+#10'BevelOuter'#7#6'bvNone'#7'Caption'#6#1' '#12'ClientHeight'#2'v'#11'Clien'
+'tWidth'#3#230#2#8'TabOrder'#2#0#0#6'TLabel'#6'Label1'#4'Left'#2'H'#6'Height'
+#2#17#3'Top'#2#7#5'Width'#2'='#9'Alignment'#7#14'taRightJustify'#7'Caption'#6
+#8'Caption:'#5'Color'#7#6'clNone'#11'ParentColor'#8#0#0#6'TLabel'#6'Label3'#4
+'Left'#2'/'#6'Height'#2#17#3'Top'#2#31#5'Width'#2'V'#9'Alignment'#7#14'taRig'
+'htJustify'#7'Caption'#6#11'Subcaption:'#5'Color'#7#6'clNone'#11'ParentColor'
+#8#0#0#6'TLabel'#6'Label4'#4'Left'#2#8#6'Height'#2#17#3'Top'#2'7'#5'Width'#2
+'}'#9'Alignment'#7#14'taRightJustify'#7'Caption'#6#18'Incidence (0..63):'#5
+'Color'#7#6'clNone'#11'ParentColor'#8#0#0#6'TLabel'#6'Label2'#4'Left'#3#0#1#6
+'Height'#2'a'#3'Top'#2#5#5'Width'#3'('#1#7'Caption'#6#176'Edit the current n'
+'ode.'#10'Note that you are setting data in a structure without referring to'
+' a visual component except for the information about what node currently ha'
+'s the focus.'#5'Color'#7#6'clNone'#11'ParentColor'#8#8'WordWrap'#9#0#0#5'TE'
+'dit'#9'edCaption'#4'Left'#2'\'#6'Height'#2#21#3'Top'#2#5#5'Width'#2'p'#8'On'
+'Change'#7#15'edCaptionChange'#8'TabOrder'#2#0#4'Text'#6#9'edCaption'#0#0#5
+'TEdit'#12'edSubcaption'#4'Left'#2'\'#6'Height'#2#21#3'Top'#2#29#5'Width'#2
+'p'#8'OnChange'#7#18'edSubcaptionChange'#8'TabOrder'#2#1#4'Text'#6#9'edCapti'
+'on'#0#0#5'TEdit'#11'edIncidence'#4'Left'#2'\'#6'Height'#2#21#3'Top'#2'5'#5
+'Width'#2';'#8'OnChange'#7#17'edIncidenceChange'#9'OnKeyDown'#13#10'OnKeyPre'
+'ss'#7#19'edIncidenceKeyPress'#8'TabOrder'#2#2#4'Text'#6#1'0'#0#0#7'TUpDown'
+#7'UpDown1'#4'Left'#3#151#0#6'Height'#2#21#3'Top'#2'5'#5'Width'#2#15#9'Assoc'
+'iate'#7#11'edIncidence'#3'Max'#2'?'#8'TabOrder'#2#3#0#0#7'TButton'#6'btnAdd'
+#4'Left'#3#173#1#6'Height'#2#25#3'Top'#2#4#5'Width'#2'K'#25'BorderSpacing.In'
+'nerBorder'#2#4#7'Caption'#6#13'+ Add a child'#7'OnClick'#7#11'btnAddClick'#8
+'TabOrder'#2#4#0#0#7'TButton'#9'btnDelete'#4'Left'#3#173#1#6'Height'#2#25#3
+'Top'#2' '#5'Width'#2'K'#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#13'-'
+' delete node'#7'OnClick'#7#14'btnDeleteClick'#8'TabOrder'#2#5#0#0#9'TCheckB'
+'ox'#6'cbLive'#4'Left'#3'j'#2#6'Height'#2#13#3'Top'#2#9#5'Width'#2'0'#7'Capt'
+'ion'#6#5'Live!'#11'Font.Height'#2#245#9'Font.Name'#6#13'MS Sans Serif'#10'F'
+'ont.Style'#11#6'fsBold'#0#7'OnClick'#7#11'cbLiveClick'#8'TabOrder'#2#6#0#0#0
+#10'TImageList'#10'ImageList1'#4'left'#2'x'#3'top'#3#143#0#6'Bitmap'#10'.'#8
+#0#0'li'#5#0#0#0#16#0#0#0#16#0#0#0#156#1#0#0'/* XPM */'#10'static char *grap'
+'hic[] = {'#10'"16 16 3 1",'#10'". c None",'#10'", c #000000",'#10'"- c #FFF'
+'FFF",'#10'"................",'#10'"................",'#10'".........,,.....'
+'",'#10'"........,--,....",'#10'"........,---,...",'#10'"........,---,...",'
+#10'"........,---,...",'#10'"........,--,....",'#10'"........,--,....",'#10
+'"........,--,....",'#10'"........,,,,....",'#10'"........,--,....",'#10'"..'
+'......,--,....",'#10'"........,,,,....",'#10'"................",'#10'".....'
+'..........."}'#10#156#1#0#0'/* XPM */'#10'static char *graphic[] = {'#10'"1'
+'6 16 3 1",'#10'". c None",'#10'", c #000000",'#10'"- c #00C0C0",'#10'".....'
+'...........",'#10'"................",'#10'".........,,.....",'#10'"........'
+',--,....",'#10'"........,---,...",'#10'"........,---,...",'#10'"........,--'
+'-,...",'#10'"........,--,....",'#10'"........,--,....",'#10'"........,--,..'
+'..",'#10'"........,,,,....",'#10'"........,--,....",'#10'"........,--,...."'
+','#10'"........,,,,....",'#10'"................",'#10'"................"}'
+#10#156#1#0#0'/* XPM */'#10'static char *graphic[] = {'#10'"16 16 3 1",'#10
+'". c None",'#10'", c #000000",'#10'"- c #00C000",'#10'"................",'
+#10'"................",'#10'".........,,.....",'#10'"........,--,....",'#10
+'"........,---,...",'#10'"........,---,...",'#10'"........,---,...",'#10'"..'
+'......,--,....",'#10'"........,--,....",'#10'"........,--,....",'#10'".....'
+'...,,,,....",'#10'"........,--,....",'#10'"........,--,....",'#10'"........'
+',,,,....",'#10'"................",'#10'"................"}'#10#156#1#0#0'/*'
+' XPM */'#10'static char *graphic[] = {'#10'"16 16 3 1",'#10'". c None",'#10
+'", c #000000",'#10'"- c #FF0000",'#10'"................",'#10'"............'
+'....",'#10'".........,,.....",'#10'"........,--,....",'#10'"........,---,..'
+'.",'#10'"........,---,...",'#10'"........,---,...",'#10'"........,--,....",'
+#10'"........,--,....",'#10'"........,--,....",'#10'"........,,,,....",'#10
+'"........,--,....",'#10'"........,--,....",'#10'"........,,,,....",'#10'"..'
,'..............",'#10'"................"}'#10#156#1#0#0'/* XPM */'#10'static'
+' char *graphic[] = {'#10'"16 16 3 1",'#10'". c None",'#10'", c #000000",'#10
+'"- c #FFFF00",'#10'"................",'#10'"................",'#10'".......'
+'..,,.....",'#10'"........,--,....",'#10'"........,---,...",'#10'"........,-'
+'--,...",'#10'"........,---,...",'#10'"........,--,....",'#10'"........,--,.'
+'...",'#10'"........,--,....",'#10'"........,,,,....",'#10'"........,--,....'
+'",'#10'"........,--,....",'#10'"........,,,,....",'#10'"................",'
+#10'"................"}'#10#0#0#6'TTimer'#7'timLive'#7'Enabled'#8#8'Interval'
+#2'd'#7'OnTimer'#7#12'timLiveTimer'#4'left'#2'x'#3'top'#3#172#0#0#0#0
+'dit'#9'edCaption'#4'Left'#3#136#0#6'Height'#2#21#3'Top'#2#5#5'Width'#2'p'#8
+'OnChange'#7#15'edCaptionChange'#8'TabOrder'#2#0#4'Text'#6#9'edCaption'#0#0#5
+'TEdit'#12'edSubcaption'#4'Left'#3#136#0#6'Height'#2#21#3'Top'#2#29#5'Width'
+#2'p'#8'OnChange'#7#18'edSubcaptionChange'#8'TabOrder'#2#1#4'Text'#6#9'edCap'
+'tion'#0#0#5'TEdit'#11'edIncidence'#4'Left'#3#136#0#6'Height'#2#21#3'Top'#2
+'5'#5'Width'#2'3'#8'OnChange'#7#17'edIncidenceChange'#9'OnKeyDown'#13#10'OnK'
+'eyPress'#7#19'edIncidenceKeyPress'#8'TabOrder'#2#2#4'Text'#6#1'0'#0#0#7'TUp'
+'Down'#7'UpDown1'#4'Left'#3#187#0#6'Height'#2#21#3'Top'#2'5'#5'Width'#2#15#9
+'Associate'#7#11'edIncidence'#3'Max'#2'?'#8'TabOrder'#2#3#0#0#7'TButton'#6'b'
+'tnAdd'#4'Left'#3'0'#2#6'Height'#2#25#3'Top'#2#8#5'Width'#2'p'#25'BorderSpac'
+'ing.InnerBorder'#2#4#7'Caption'#6#13'+ Add a child'#7'OnClick'#7#11'btnAddC'
+'lick'#8'TabOrder'#2#4#0#0#7'TButton'#9'btnDelete'#4'Left'#3'0'#2#6'Height'#2
+#25#3'Top'#2'('#5'Width'#2'p'#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6
+#13'- Delete node'#7'OnClick'#7#14'btnDeleteClick'#8'TabOrder'#2#5#0#0#9'TCh'
+'eckBox'#6'cbLive'#4'Left'#3#168#2#6'Height'#2#24#3'Top'#2#8#5'Width'#2':'#7
+'Caption'#6#5'Live!'#11'Font.Height'#2#245#9'Font.Name'#6#13'MS Sans Serif'
+#10'Font.Style'#11#6'fsBold'#0#7'OnClick'#7#11'cbLiveClick'#8'TabOrder'#2#6#0
+#0#0#10'TImageList'#10'ImageList1'#4'left'#2'x'#3'top'#3#143#0#6'Bitmap'#10
+'.'#8#0#0'li'#5#0#0#0#16#0#0#0#16#0#0#0#156#1#0#0'/* XPM */'#10'static char '
+'*graphic[] = {'#10'"16 16 3 1",'#10'". c None",'#10'", c #000000",'#10'"- c'
+' #FFFFFF",'#10'"................",'#10'"................",'#10'".........,,'
+'.....",'#10'"........,--,....",'#10'"........,---,...",'#10'"........,---,.'
+'..",'#10'"........,---,...",'#10'"........,--,....",'#10'"........,--,...."'
+','#10'"........,--,....",'#10'"........,,,,....",'#10'"........,--,....",'
+#10'"........,--,....",'#10'"........,,,,....",'#10'"................",'#10
+'"................"}'#10#156#1#0#0'/* XPM */'#10'static char *graphic[] = {'
+#10'"16 16 3 1",'#10'". c None",'#10'", c #000000",'#10'"- c #00C0C0",'#10'"'
+'................",'#10'"................",'#10'".........,,.....",'#10'"...'
+'.....,--,....",'#10'"........,---,...",'#10'"........,---,...",'#10'"......'
+'..,---,...",'#10'"........,--,....",'#10'"........,--,....",'#10'"........,'
+'--,....",'#10'"........,,,,....",'#10'"........,--,....",'#10'"........,--,'
+'....",'#10'"........,,,,....",'#10'"................",'#10'"...............'
+'."}'#10#156#1#0#0'/* XPM */'#10'static char *graphic[] = {'#10'"16 16 3 1",'
+#10'". c None",'#10'", c #000000",'#10'"- c #00C000",'#10'"................"'
+','#10'"................",'#10'".........,,.....",'#10'"........,--,....",'
+#10'"........,---,...",'#10'"........,---,...",'#10'"........,---,...",'#10
+'"........,--,....",'#10'"........,--,....",'#10'"........,--,....",'#10'"..'
+'......,,,,....",'#10'"........,--,....",'#10'"........,--,....",'#10'".....'
+'...,,,,....",'#10'"................",'#10'"................"}'#10#156#1#0#0
+'/* XPM */'#10'static char *graphic[] = {'#10'"16 16 3 1",'#10'". c None",'
+#10'", c #000000",'#10'"- c #FF0000",'#10'"................",'#10'".........'
+'.......",'#10'".........,,.....",'#10'"........,--,....",'#10'"........,---'
+',...",'#10'"........,---,...",'#10'"........,---,...",'#10'"........,--,...'
+'.",'#10'"........,--,....",'#10'"........,--,....",'#10'"........,,,,....",'
,#10'"........,--,....",'#10'"........,--,....",'#10'"........,,,,....",'#10
+'"................",'#10'"................"}'#10#156#1#0#0'/* XPM */'#10'sta'
+'tic char *graphic[] = {'#10'"16 16 3 1",'#10'". c None",'#10'", c #000000",'
+#10'"- c #FFFF00",'#10'"................",'#10'"................",'#10'"....'
+'.....,,.....",'#10'"........,--,....",'#10'"........,---,...",'#10'".......'
+'.,---,...",'#10'"........,---,...",'#10'"........,--,....",'#10'"........,-'
+'-,....",'#10'"........,--,....",'#10'"........,,,,....",'#10'"........,--,.'
+'...",'#10'"........,--,....",'#10'"........,,,,....",'#10'"................'
+'",'#10'"................"}'#10#0#0#6'TTimer'#7'timLive'#7'Enabled'#8#8'Inte'
+'rval'#2'd'#7'OnTimer'#7#12'timLiveTimer'#4'left'#2'x'#3'top'#3#172#0#0#0#0
]);

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

@ -15,11 +15,13 @@ unit MVCDemoMain;
interface
uses LCLIntf,Messages,SysUtils,Classes,Graphics,Controls,Forms,Dialogs,
MVCTypes,MVCPanel,StdCtrls,ExtCtrls,ImgList,VirtualTrees,ComCtrls,
uses
LCLIntf, SysUtils,Classes,Graphics,Controls,Forms,Dialogs,
MVCTypes,MVCPanel,StdCtrls,ExtCtrls,VirtualTrees,ComCtrls,
Buttons, LResources, vtlogger,ipcchannel;
type TfmMVCDemo=class(TForm)
type
TfmMVCDemo=class(TForm)
pnlControls:TPanel;
ImageList1:TImageList;
edCaption:TEdit;
@ -52,7 +54,8 @@ type TfmMVCDemo=class(TForm)
function CreateDefaultTree:TMVCTree;
end;
var fmMVCDemo:TfmMVCDemo;
var
fmMVCDemo:TfmMVCDemo;
implementation

5
components/virtualtreeview-unstable/demos/objects/MVCPanel.pas
View File

@ -25,8 +25,9 @@ unit MVCPanel;
interface
uses LCLIntf,Controls,Graphics,SysUtils,Classes,ExtCtrls,StdCtrls,
MVCTypes,VirtualTrees;
uses
LCLIntf, Controls, Graphics, SysUtils, Classes, ExtCtrls, StdCtrls,
MVCTypes, VirtualTrees;
type TMVCPanel=class(TCustomPanel)
private

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

@ -56,8 +56,9 @@ unit MVCTypes;
interface
uses LCLIntf, Types, Messages,SysUtils,Graphics,VirtualTrees,Classes,StdCtrls,
Controls,Forms,ImgList,LCLType, DelphiCompat, vtlogger, LMessages;
uses
LCLIntf, Types, SysUtils, Graphics, VirtualTrees, Classes, StdCtrls,
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
@ -65,230 +66,234 @@ type { TMVCNode is the encapsulation of a single Node in the structure.
In such an implementation there is not much "virtual" about the
tree anymore - still it's of incredible usefulness as you will
see. }
TMVCNode=class(TObject)
private
{ Here's the data associated with a single Node in the
tree. This structure defines a caption and a subcaption, add
whatever defines your data completely. }
FParent:TMVCNode;
FChildren:TList;
FCheckState:TCheckState;
FCaption,FSubCaption:string;
{ The FIncidence-Field is special in the way that it's
value is never displayed directly but used to
graphically alter the node's display. In my project it
is a "weight" showing the number of hits from a
database. Here it is displayed next to the caption
as a colored speck. }
FIncidence:integer;
TMVCNode = class(TObject)
private
{ Here's the data associated with a single Node in the
tree. This structure defines a caption and a subcaption, add
whatever defines your data completely. }
FParent:TMVCNode;
FChildren:TFpList;
FCheckState:TCheckState;
FCaption,FSubCaption:string;
{ The FIncidence-Field is special in the way that it's
value is never displayed directly but used to
graphically alter the node's display. In my project it
is a "weight" showing the number of hits from a
database. Here it is displayed next to the caption
as a colored speck. }
FIncidence:integer;
{ Here's where we start to think of visualization. This
field points to the VirtualNode in a virtual tree that
is associated with the Node - if there is one,
otherwise it is NIL, there may be no virtual node
allocated for the TMVCNode or no tree linked. }
FVirtualNode:PVirtualNode;
{ Here's where we start to think of visualization. This
field points to the VirtualNode in a virtual tree that
is associated with the Node - if there is one,
otherwise it is NIL, there may be no virtual node
allocated for the TMVCNode or no tree linked. }
FVirtualNode:PVirtualNode;
{ Here are reader/writer-methods for the properties that
define our data. We need set-properties because we want
to update linked nodes directly. }
procedure SetCaption(aCaption:string);
procedure SetSubCaption(aSubCaption:string);
procedure SetCheckState(aCheckState:TCheckState);
procedure SetIncidence(aValue:integer);
function GetChildCount:integer;
function GetChild(n:integer):TMVCNode;
public
constructor Create;
destructor Destroy; override;
{ Here are reader/writer-methods for the properties that
define our data. We need set-properties because we want
to update linked nodes directly. }
procedure SetCaption(aCaption:string);
procedure SetSubCaption(aSubCaption:string);
procedure SetCheckState(aCheckState:TCheckState);
procedure SetIncidence(aValue:integer);
function GetChildCount:integer;
function GetChild(n:integer):TMVCNode;
public
constructor Create;
destructor Destroy; override;
{ Take a look at our data and pick an icon from the
Imagelist to be displayed in the tree. }
function GetImageIndex:integer; virtual;
{ Tell the tree to invalidate the node it displayes the
information for this Node in. It will be repainted
next }
procedure InvalidateVirtualNode;
{ Take a look at our data and pick an icon from the
Imagelist to be displayed in the tree. }
function GetImageIndex:integer; virtual;
{ Tell the tree to invalidate the node it displayes the
information for this Node in. It will be repainted
next }
procedure InvalidateVirtualNode;
{ properties exposing our internal data to the world.
set-methods are given so the Node can always invalidate
its node. }
property CheckState:TCheckState read FCheckState write SetCheckState;
property Caption:string read FCaption write SetCaption;
property SubCaption:string read FSubCaption write SetSubCaption;
property Incidence:integer read FIncidence write SetIncidence;
{ properties exposing our internal data to the world.
set-methods are given so the Node can always invalidate
its node. }
property CheckState:TCheckState read FCheckState write SetCheckState;
property Caption:string read FCaption write SetCaption;
property SubCaption:string read FSubCaption write SetSubCaption;
property Incidence:integer read FIncidence write SetIncidence;
property Parent:TMVCNode read FParent;
property ChildCount:integer read GetChildCount;
property Child[n:integer]:TMVCNode read GetChild;
function CreateChild:TMVCNode;
procedure RemoveChild(n:integer);
procedure DestroyChild(n:integer);
property Parent:TMVCNode read FParent;
property ChildCount:integer read GetChildCount;
property Child[n:integer]:TMVCNode read GetChild;
function CreateChild:TMVCNode;
procedure RemoveChild(n:integer);
procedure DestroyChild(n:integer);
{ This field is only exposed because I advise you to put
the Tree-Code in a separate unit and then you won't get
far privatizing it. Allowing public write-access to it
is a bit hairy though, you should never write to the
field outside of this or the Tree-unit.
This is where a friend-declaration is missing from OP}
property VirtualNode:PVirtualNode read FVirtualNode write FVirtualNode;
end;
{ This field is only exposed because I advise you to put
the Tree-Code in a separate unit and then you won't get
far privatizing it. Allowing public write-access to it
is a bit hairy though, you should never write to the
field outside of this or the Tree-unit.
This is where a friend-declaration is missing from OP}
property VirtualNode:PVirtualNode read FVirtualNode write FVirtualNode;
end;
{ TMVCTree keeps the TMVCNodes. It also maintains the link to a
virtual treeview. }
TMVCTree=class
private
{ This is the Root of the Tree. In this Demo that Root is there
purely to hold the structure together, it is never displayed -
just like TVirtualTrees own Root. }
FRoot:TMVCNode;
{ TMVCTree keeps the TMVCNodes. It also maintains the link to a
virtual treeview. }
TMVCTree=class
private
{ This is the Root of the Tree. In this Demo that Root is there
purely to hold the structure together, it is never displayed -
just like TVirtualTrees own Root. }
FRoot:TMVCNode;
{ The Viewer-Field points to any component or object
used to visualize or edit this structure. It is
not really used in this demo, in a real application
you will find situations where you have to find out
whether you are linked and if so where to.
{ The Viewer-Field points to any component or object
used to visualize or edit this structure. It is
not really used in this demo, in a real application
you will find situations where you have to find out
whether you are linked and if so where to.
Why is the Viewer declared as TObject and not as
the specific class? Two reasons:
Why is the Viewer declared as TObject and not as
the specific class? Two reasons:
1) The viewer should be implemented in a different
unit, either there or here you will have to
cast or you will build a circular reference. I
choose to cast here because
1) The viewer should be implemented in a different
unit, either there or here you will have to
cast or you will build a circular reference. I
choose to cast here because
2) You may want to have _different_ viewers for
the same structure. Keeping that in mind you
may even want to change the declaration to
a list of linked viewers... }
FSettingViewer:integer;
FViewer:TObject;
2) You may want to have _different_ viewers for
the same structure. Keeping that in mind you
may even want to change the declaration to
a list of linked viewers... }
FSettingViewer:integer;
FViewer:TObject;
{ Access-methods to expose the list in a type safe
way. }
{ Access-methods to expose the list in a type safe
way. }
{ A set-method that updates the link to a viewer. }
procedure SetViewer(aViewer:TObject);
{ A set-method that updates the link to a viewer. }
procedure SetViewer(aViewer:TObject);
public
constructor Create;
destructor Destroy; override;
public
constructor Create;
destructor Destroy; override;
property Root:TMVCNode read FRoot;
property Root:TMVCNode read FRoot;
{ Assign to this to create or break the link with
a viewer. If you are about to add, remove or edit
a zillion Nodes you can call BeginUpdate and
EndUpdate. In this demo they just do the same for
any assigned viewer - Caution: The demo does not
make provisions for the case where you call
BeginUpdate and then switch to another viewer! }
property Viewer:TObject read FViewer write SetViewer;
procedure BeginUpdate;
procedure EndUpdate;
end;
{ Assign to this to create or break the link with
a viewer. If you are about to add, remove or edit
a zillion Nodes you can call BeginUpdate and
EndUpdate. In this demo they just do the same for
any assigned viewer - Caution: The demo does not
make provisions for the case where you call
BeginUpdate and then switch to another viewer! }
property Viewer:TObject read FViewer write SetViewer;
procedure BeginUpdate;
procedure EndUpdate;
end;
{ Here's the Viewer. I have descended from the base class to maximize
the functionality that is moved to our code, should you be happy
with any of the predeclared descendants use of them. }
TMVCEditLink=class;
TMVCTreeView=class(TBaseVirtualTree)
private
{ This is a pointer to the structure associated with
this viewer. }
FTree:TMVCTree;
FInternalDataOffset: Cardinal; // offset to the internal data
{ Here's the Viewer. I have descended from the base class to maximize
the functionality that is moved to our code, should you be happy
with any of the predeclared descendants use of them. }
TMVCEditLink=class;
TMVCTreeView=class(TBaseVirtualTree)
private
{ This is a pointer to the structure associated with
this viewer. }
FTree:TMVCTree;
FInternalDataOffset: Cardinal; // offset to the internal data
{ Make and break the link with a list }
procedure SetTree(aTree:TMVCTree);
{ Make and break the link with a list }
procedure SetTree(aTree:TMVCTree);
{ These are for direct access to our structure
through the viewer. You can use them to find
the TMVCNode that corresponds to a selected
VirtualNode for instance. }
function GetMVCNode(VirtualNode:PVirtualNode):TMVCNode;
procedure SetMVCNode(VirtualNode:PVirtualNode; aNode:TMVCNode);
{ These are for direct access to our structure
through the viewer. You can use them to find
the TMVCNode that corresponds to a selected
VirtualNode for instance. }
function GetMVCNode(VirtualNode:PVirtualNode):TMVCNode;
procedure SetMVCNode(VirtualNode:PVirtualNode; aNode:TMVCNode);
function GetOptions: TVirtualTreeOptions;
procedure SetOptions(const Value: TVirtualTreeOptions);
protected
{ Overridden methods of the tree, see their implementation for
details on what they do and why they are overridden. }
function DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): Integer; override;
procedure DoPaintNode(var PaintInfo: TVTPaintInfo); override;
procedure DoInitChildren(Node:PVirtualNode;var ChildCount:Cardinal); override;
procedure DoInitNode(aParent,aNode:PVirtualNode;
var aInitStates:TVirtualNodeInitStates); override;
procedure DoFreeNode(aNode:PVirtualNode); override;
function DoGetImageIndex(Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
var Ghosted: Boolean; var Index: Integer): TCustomImageList; override;
procedure DoChecked(aNode:PVirtualNode); override;
function DoCreateEditor(Node: PVirtualNode; Column: TColumnIndex): IVTEditLink; override;
function InternalData(Node: PVirtualNode): Pointer;
function InternalDataSize: Cardinal;
function GetOptions: TVirtualTreeOptions;
procedure SetOptions(const Value: TVirtualTreeOptions);
protected
{ Overridden methods of the tree, see their implementation for
details on what they do and why they are overridden. }
function DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): Integer; override;
procedure DoPaintNode(var PaintInfo: TVTPaintInfo); override;
procedure DoInitChildren(Node:PVirtualNode;var ChildCount:Cardinal); override;
procedure DoInitNode(aParent,aNode:PVirtualNode;
var aInitStates:TVirtualNodeInitStates); override;
procedure DoFreeNode(aNode:PVirtualNode); override;
function DoGetImageIndex(Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
var Ghosted: Boolean; var Index: Integer): TCustomImageList; override;
procedure DoChecked(aNode:PVirtualNode); override;
function DoCreateEditor(Node: PVirtualNode; Column: TColumnIndex): IVTEditLink; override;
function InternalData(Node: PVirtualNode): Pointer;
function InternalDataSize: Cardinal;
function GetOptionsClass: TTreeOptionsClass; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function GetOptionsClass: TTreeOptionsClass; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
{ Properties for the link to a list and the individual Node.
these form the interface to the application. See the main form
to check it out. }
property Tree:TMVCTree read FTree write SetTree;
property MVCNode[VirtualNode:PVirtualNode]:TMVCNode read GetMVCNode;
{ Properties for the link to a list and the individual Node.
these form the interface to the application. See the main form
to check it out. }
property Tree:TMVCTree read FTree write SetTree;
property MVCNode[VirtualNode:PVirtualNode]:TMVCNode read GetMVCNode;
function GetNodeText(aNode:TMVCNode;
aColumn:integer):string;
procedure SetNodeText(aNode:TMVCNode;
aColumn:integer;
aText:string);
published
{ We descend from the base class, publish whatever you want to.
The demo only needs the Header, it is initialized in the fixed
panel-code. }
property TreeOptions: TVirtualTreeOptions read GetOptions write SetOptions;
property Header;
property Images;
property OnChange;
end;
function GetNodeText(aNode:TMVCNode;
aColumn:integer):string;
procedure SetNodeText(aNode:TMVCNode;
aColumn:integer;
aText:string);
published
{ We descend from the base class, publish whatever you want to.
The demo only needs the Header, it is initialized in the fixed
panel-code. }
property TreeOptions: TVirtualTreeOptions read GetOptions write SetOptions;
property Header;
property Images;
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;
protected
procedure AutoAdjustSize;
procedure CreateParams(var Params:TCreateParams); override;
public
constructor Create(Link:TMVCEditLink); reintroduce;
end;
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;
//gtk1 has problems freeing a control inside keydow
{$ifdef LCLGtk}
procedure WMKeyUp(var Message: TWMKeyUp); message WM_KEYUP;
{$endif}
procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS;
protected
procedure AutoAdjustSize;
procedure CreateParams(var Params:TCreateParams); override;
public
constructor Create(Link:TMVCEditLink); reintroduce;
end;
TMVCEditLink=class(TInterfacedObject,IVTEditLink)
private
FEdit:TMVCEdit; // a normal custom edit control
FTree:TMVCTreeView; // a back reference to the tree calling
FNode:PVirtualNode; // the node to be edited
FColumn:Integer; // the column of the node
public
constructor Create;
destructor Destroy; override;
TMVCEditLink=class(TInterfacedObject,IVTEditLink)
private
FEdit:TMVCEdit; // a normal custom edit control
FTree:TMVCTreeView; // a back reference to the tree calling
FNode:PVirtualNode; // the node to be edited
FColumn:Integer; // the column of the node
public
constructor Create;
destructor Destroy; override;
function BeginEdit: Boolean; stdcall;
function CancelEdit: Boolean; stdcall;
function EndEdit: Boolean; stdcall;
function GetBounds: TRect; stdcall;
function PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean; stdcall;
procedure ProcessMessage(var Message: TMessage); stdcall;
procedure SetBounds(R:TRect); stdcall;
function BeginEdit: Boolean; stdcall;
function CancelEdit: Boolean; stdcall;
function EndEdit: Boolean; stdcall;
function GetBounds: TRect; stdcall;
function PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean; stdcall;
procedure ProcessMessage(var Message: TMessage); stdcall;
procedure SetBounds(R:TRect); stdcall;
property Tree:TMVCTreeView read FTree;
end;
property Tree:TMVCTreeView read FTree;
end;
implementation
@ -300,7 +305,7 @@ implementation
constructor TMVCNode.Create;
begin
inherited Create;
FChildren:=TList.Create;
FChildren:=TFpList.Create;
end;
destructor TMVCNode.Destroy;
@ -956,8 +961,10 @@ begin
VK_UP,
VK_DOWN:
FLink.FTree.WndProc(TMessage(Message));
{$ifndef LCLGtk}
VK_RETURN:
FLink.FTree.DoEndEdit;
{$endif}
// standard clipboard actions,
// Caution: to make these work you must not use default TAction classes like TEditPaste etc. in the application!
Ord('C'):
@ -986,6 +993,14 @@ begin
Logger.ExitMethod([lcEditLink],'TMVCEdit.WMKeyDown');
end;
{$ifdef LCLGtk}
procedure TMVCEdit.WMKeyUp(var Message: TWMKeyUp);
begin
if Message.CharCode = VK_RETURN then
FLink.FTree.DoEndEdit;
end;
{$endif}
procedure TMVCEdit.WMKillFocus(var Msg: TWMKillFocus);
begin
Logger.EnterMethod([lcEditLink],'TMVCEdit.WMKillFocus');
@ -1018,7 +1033,7 @@ end;
procedure TMVCEdit.CreateParams(var Params:TCreateParams);
begin
//todo: propbably remove this since CTL3D does nothing in LCL
//todo: probably remove this since CTL3D does nothing in LCL
Ctl3D := False;
inherited;
end;

3
components/virtualtreeview-unstable/demos/objects/mvcdemo.lpi
View File

@ -65,6 +65,9 @@
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
<SearchPaths>
<LCLWidgetType Value="gtk2"/>
</SearchPaths>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>

6
components/virtualtreeview-unstable/units/gtk/mmsystem.pas
View File

@ -26,8 +26,12 @@ begin
end;
function timeGetTime: DWORD;
var
ATime: TSystemTime;
begin
//todo: properly implement
GetLocalTime(ATime);
Result := ATime.MilliSecond;
end;
end.

6
components/virtualtreeview-unstable/units/gtk2/mmsystem.pas
View File

@ -26,8 +26,12 @@ begin
end;
function timeGetTime: DWORD;
var
ATime: TSystemTime;
begin
//todo: properly implement
GetLocalTime(ATime);
Result := ATime.MilliSecond;
end;
end.

9
components/virtualtreeview-unstable/virtualtreeview_package.lpk
View File

@ -1,14 +1,12 @@
<?xml version="1.0"?>
<CONFIG>
<Package Version="2">
<PathDelim Value="\"/>
<Name Value="virtualtreeview_package"/>
<CompilerOptions>
<Version Value="5"/>
<PathDelim Value="\"/>
<SearchPaths>
<OtherUnitFiles Value="units\$(LCLWidgetType)\"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
<OtherUnitFiles Value="units/$(LCLWidgetType)/"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<CodeGeneration>
<Generate Value="Faster"/>
@ -53,11 +51,10 @@
</Item3>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)\"/>
<UnitPath Value="$(PkgOutDir)/"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
<DestinationDirectory Value="$(TestDir)\publishedpackage\"/>
<IgnoreBinaries Value="False"/>
</PublishOptions>
</Package>