diff --git a/components/jvcllaz/design/JvDB/JvDBReg.pas b/components/jvcllaz/design/JvDB/JvDBReg.pas
index 43fbc8c8f..3eaa16512 100644
--- a/components/jvcllaz/design/JvDB/JvDBReg.pas
+++ b/components/jvcllaz/design/JvDB/JvDBReg.pas
@@ -15,7 +15,8 @@ implementation
{$R ../../resource/jvdbreg.res}
uses
- Classes, JvDsgnConsts, {JvDBSearchCombobox,} JvDBSearchEdit, JvDBHTLabel; //, JvDBTreeView;
+ Classes, JvDsgnConsts, //JvDBSearchCombobox,
+ JvDBSearchEdit, JvDBTreeView, JvDBHTLabel;
procedure Register;
const
@@ -39,15 +40,14 @@ begin
RegisterComponents(RsPaletteJvclDB, [ // was: TsPaletteDBVisual
TJvDBSearchEdit,
// TJvDBSearchCombobox,
-// TJvDBTreeView,
+ TJvDBTreeView,
TJvDBHtLabel
]);
- (*
+
RegisterPropertyEditor(TypeInfo(string), TJvDBTreeView, cItemField, TFieldProperty); //TJvDataFieldProperty);
RegisterPropertyEditor(TypeInfo(string), TJvDBTreeView, cMasterField, TFieldProperty); //TJvDataFieldProperty);
RegisterPropertyEditor(TypeInfo(string), TJvDBTreeView, cDetailField, TFieldProperty); //TJvDataFieldProperty);
RegisterPropertyEditor(TypeInfo(string), TJvDBTreeView, cIconField, TFieldProperty); //TJvDataFieldProperty);
- *)
end;
end.
diff --git a/components/jvcllaz/examples/JvDBTreeView/JVDBTreeViewDemo.lpi b/components/jvcllaz/examples/JvDBTreeView/JVDBTreeViewDemo.lpi
new file mode 100644
index 000000000..cc48c9590
--- /dev/null
+++ b/components/jvcllaz/examples/JvDBTreeView/JVDBTreeViewDemo.lpi
@@ -0,0 +1,88 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/components/jvcllaz/examples/JvDBTreeView/JVDBTreeViewDemo.lpr b/components/jvcllaz/examples/JvDBTreeView/JVDBTreeViewDemo.lpr
new file mode 100644
index 000000000..a560d1714
--- /dev/null
+++ b/components/jvcllaz/examples/JvDBTreeView/JVDBTreeViewDemo.lpr
@@ -0,0 +1,24 @@
+program JVDBTreeViewDemo;
+
+{$mode objfpc}{$H+}
+
+uses
+ {$IFDEF UNIX}{$IFDEF UseCThreads}
+ cthreads,
+ {$ENDIF}{$ENDIF}
+ Interfaces, // this includes the LCL widgetset
+ LCLVersion, Forms, Main
+ { you can add units after this };
+
+{$R *.res}
+
+begin
+ RequireDerivedFormResource := True;
+ {$IFDEF LCLVersion >= 1080000}
+ Application.Scaled := True;
+ {$ENDIF}
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
+
diff --git a/components/jvcllaz/examples/JvDBTreeView/main.lfm b/components/jvcllaz/examples/JvDBTreeView/main.lfm
new file mode 100644
index 000000000..2165dadd7
--- /dev/null
+++ b/components/jvcllaz/examples/JvDBTreeView/main.lfm
@@ -0,0 +1,456 @@
+object Form1: TForm1
+ Left = 310
+ Height = 509
+ Top = 127
+ Width = 758
+ Caption = 'JvDBTreeViewDemo'
+ ClientHeight = 509
+ ClientWidth = 758
+ OnCreate = FormCreate
+ LCLVersion = '1.9.0.0'
+ object DBGrid1: TDBGrid
+ AnchorSideLeft.Control = Owner
+ AnchorSideTop.Control = Owner
+ AnchorSideRight.Control = Bevel1
+ AnchorSideBottom.Control = Owner
+ AnchorSideBottom.Side = asrBottom
+ Left = 0
+ Height = 509
+ Top = 0
+ Width = 378
+ Anchors = [akTop, akLeft, akRight, akBottom]
+ AutoFillColumns = True
+ Color = clWindow
+ Columns = <>
+ DataSource = DataSource1
+ Options = [dgEditing, dgTitles, dgIndicator, dgColumnResize, dgColumnMove, dgColLines, dgRowLines, dgTabs, dgAlwaysShowSelection, dgConfirmDelete, dgCancelOnExit, dgThumbTracking]
+ TabOrder = 0
+ end
+ object JvDBTreeView1: TJvDBTreeView
+ AnchorSideLeft.Control = Bevel1
+ AnchorSideTop.Control = Owner
+ AnchorSideRight.Control = Owner
+ AnchorSideRight.Side = asrBottom
+ AnchorSideBottom.Control = Panel1
+ Left = 378
+ Height = 453
+ Top = 0
+ Width = 380
+ DataSource = DataSource1
+ MasterField = 'ID'
+ DetailField = 'ParentID'
+ IconField = 'Icon'
+ ItemField = 'Name'
+ StartMasterValue = '0'
+ UseFilter = True
+ PersistentNode = False
+ SelectedIndex = 0
+ Anchors = [akTop, akLeft, akRight, akBottom]
+ Images = ImageList1
+ ParentColor = False
+ TabOrder = 1
+ OnCustomDrawItem = JvDBTreeView1CustomDrawItem
+ OnGetSelectedIndex = JvDBTreeView1GetSelectedIndex
+ end
+ object Bevel1: TBevel
+ AnchorSideLeft.Control = Owner
+ AnchorSideLeft.Side = asrCenter
+ Left = 378
+ Height = 50
+ Top = 149
+ Width = 2
+ Shape = bsSpacer
+ end
+ object StatusBar1: TStatusBar
+ Left = 0
+ Height = 23
+ Top = 486
+ Width = 758
+ Panels = <>
+ SimpleText = 'Icons provided by icons8.com'
+ end
+ object Panel1: TPanel
+ AnchorSideLeft.Control = JvDBTreeView1
+ AnchorSideRight.Control = Owner
+ AnchorSideRight.Side = asrBottom
+ AnchorSideBottom.Control = StatusBar1
+ Left = 378
+ Height = 33
+ Top = 453
+ Width = 380
+ Anchors = [akLeft, akRight, akBottom]
+ AutoSize = True
+ BevelOuter = bvNone
+ ClientHeight = 33
+ ClientWidth = 380
+ TabOrder = 3
+ object Button1: TButton
+ AnchorSideLeft.Control = Panel1
+ Left = 4
+ Height = 25
+ Top = 4
+ Width = 79
+ AutoSize = True
+ BorderSpacing.Left = 4
+ BorderSpacing.Top = 4
+ BorderSpacing.Bottom = 4
+ Caption = 'Expand all'
+ OnClick = Button1Click
+ TabOrder = 0
+ end
+ object Button2: TButton
+ AnchorSideLeft.Control = Button1
+ AnchorSideLeft.Side = asrBottom
+ AnchorSideTop.Control = Button1
+ AnchorSideTop.Side = asrCenter
+ Left = 87
+ Height = 25
+ Top = 4
+ Width = 86
+ AutoSize = True
+ BorderSpacing.Left = 4
+ BorderSpacing.Top = 4
+ BorderSpacing.Bottom = 4
+ Caption = 'Collapse all'
+ OnClick = Button2Click
+ TabOrder = 1
+ end
+ end
+ object DataSource1: TDataSource
+ DataSet = BufDataset1
+ left = 72
+ top = 128
+ end
+ object ImageList1: TImageList
+ left = 632
+ top = 208
+ Bitmap = {
+ 4C690A0000001000000010000000000000000000000000000000000000000000
+ 00002E45730B3A55837A3B59889F3C5A878F35557F1800000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000003048
+ 85153D5C89CF4C6EA2FE4E71A6FF4E70A5FF3F5C8CD23A56805B000000010000
+ 0000000000000000000000000000000000000000000000000000000000003D5B
+ 8AA74E70A5FF4E71A6FF4E71A6FF4E71A6FF4E71A6FF496D9FFC3C5887980000
+ 0000000000000000000000000000000000000000000000000000000000004161
+ 90D74E71A6FF4E71A6FF4E71A6FF4B6FA2FF4D75A1FF4A6EA0FE406191D80000
+ 0000000000000000000000000000000000000000000000000000000000004161
+ 90DE4A6F9FFF537CA9FF5783AEFF679DC7FF84CDF4FF5482ACFF405F8FDD0000
+ 0000000000000000000000000000000000000000000000000000000000003D5E
+ 8AE05E92BAFF85CEF5FF85CEF5FF85CEF5FF85CEF5FF69A4CBFF3C5C89E10000
+ 000000000000000000000000000000000000000000000000000000000000446B
+ 93F26DACD2FF85CEF5FF85CEF5FF85CEF5FF85CEF5FF6DACD2FF436D94F20000
+ 0000000000000000000000000000000000000000000000000000000000004C84
+ A1A373B6DBFD85CEF5FF85CEF5FF85CEF5FF85CEF5FF73B6DBFD4C85A19F0000
+ 000000000000000000000000000000000000000000000000000000000000486D
+ 910767A7C9D885CEF5FF85CEF5FF85CEF5FF85CEF5FF65A5C7D8486D91070000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 00005591B06B6EB1D4FE85CEF5FF85CEF5FF6FB0D4FE5692AF6A000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000B4744A185B95B4EF62A0C2FF62A0C2FF5B94B5EFB1794D17000000000000
+ 0000000000000000000000000000000000000000000000000000C2865C48CC90
+ 64C5DCA175EB7896A3FF70B3D8FF70B3D8FF7896A4FFDBA276EBCB9064C5C085
+ 5C450000000000000000000000000000000000000000C2885E54DA9F74E9F0B7
+ 8BFFF0B78BFFEAB58CFFB3A495FFB3A495FFEBB58BFFF0B78BFFF0B78BFFD89F
+ 74E9BF855950000000000000000000000000CC666605CF9468D1F0B78BFFF0B7
+ 8BFFF0B78BFFF0B78BFFF0B78BFFF0B78BFFF0B78BFFF0B78BFFF0B78BFFF0B7
+ 8BFFCE9367D1CC6666050000000000000000C082564AE5AD81FCF0B78BFFF0B7
+ 8BFFF0B78BFFF0B78BFFF0B78BFFF0B78BFFF0B78BFFF0B78BFFF0B78BFFF0B7
+ 8BFFE5AD80FCBC8457490000000000000000C0855845CB9065A4CB9165A3CB91
+ 65A3CB9165A3CB9165A3CB9165A3CB9165A3CB9165A3CB9165A3CB9165A3CB91
+ 65A3CB9065A4C085584500000000000000000000000000000000000000000000
+ 0000334C7F0A395786743C5A889B3D57868E3758791700000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000003A5B
+ 7C273F5F8DD14C6FA4FF4E71A6FF4E70A5FF3F5F8DDE385683673F3F7F040000
+ 0000000000000000000000000000000000000000000000000000000000003E5C
+ 8BC34E71A6FF4E71A6FF4E71A6FF4E71A6FF4E71A6FF4B6EA1FF3C5B89B80000
+ 00000000000000000000000000000000000000000000000000003B517C2F4768
+ 9AF64E71A6FF4E71A6FF4E71A6FF4E71A6FF486B9CFF4E71A5FF47699BFA364F
+ 813D0000000000000000000000000000000000000000000000003957856F4D6F
+ A4FF4E71A6FF4E71A6FF4C70A4FF4B72A0FF6DA8D1FF4A709EFF4E6FA5FF3957
+ 83740000000000000000000000000000000000000000000000003A5683764D70
+ A4FF4B6FA2FF537EAAFF6195BFFF80C7EEFF85CEF5FF527EA9FF4C6FA2FF3854
+ 8363000000000000000000000000000000000000000000000000375381494A6C
+ A0FF5079A6FF85CEF5FF85CEF5FF85CEF5FF85CEF5FF527FA9FF47699CFC3750
+ 7D33000000000000000000000000000000000000000000000000345278224767
+ 9AF34E78A3FA85CEF5FF85CEF5FF85CEF5FF85CEF5FF4E77A3FA456495EB2D4B
+ 781100000000000000000000000000000000000000000000000038537F56496B
+ 9EFB446894F283CCF3FF85CEF5FF85CEF5FF83CBF3FF446895F2476899F03954
+ 7F4200000000000000000000000000000000000000003F3F7F083B5886D34C6F
+ A4FF47689AFB467098FD76BBE0FF76BBE0FF466F98FD46689AFC4B6EA3FF3A56
+ 84CE3F3F7F080000000000000000000000000000000000000000334C7F143955
+ 846E4C57785D5E9ABAEA69ABCEFF69ABCEFF5E9ABAEA4A57785D3956846A3854
+ 7109000000000000000000000000000000000000000000000000C2865C48CC90
+ 64C5DCA175EB7896A3FF70B3D8FF70B3D8FF7896A4FFDBA276EBCB9064C5C085
+ 5C450000000000000000000000000000000000000000C2885E54DA9F74E9F0B7
+ 8BFFF0B78BFFEAB58CFFB3A495FFB3A495FFEBB58BFFF0B78BFFF0B78BFFD89F
+ 74E9BF855950000000000000000000000000CC666605CF9468D1F0B78BFFF0B7
+ 8BFFF0B78BFFF0B78BFFF0B78BFFF0B78BFFF0B78BFFF0B78BFFF0B78BFFF0B7
+ 8BFFCE9367D1CC6666050000000000000000C082564AE5AD81FCF0B78BFFF0B7
+ 8BFFF0B78BFFF0B78BFFF0B78BFFF0B78BFFF0B78BFFF0B78BFFF0B78BFFF0B7
+ 8BFFE5AD80FCBC8457490000000000000000C0855845CB9065A4CB9165A3CB91
+ 65A3CB9165A3CB9165A3CB9165A3CB9165A3CB9165A3CB9165A3CB9165A3CB91
+ 65A3CB9065A4C085584500000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 000000000000000000000000000058483BE0645442E0645442E0645442E06454
+ 42E0645442E0645442E0645442E0645442E0645442E0645442E0645442E06454
+ 42E0645442E0645442E058483BE0645240E577644BFF77644BFF77644BFF7764
+ 4BFF77644BFF77644BFF77644BFF77644BFF77644BFF77644BFF77644BFF7764
+ 4BFF77644BFF77644BFF645240E5645240E577644BFF77644BFF77644BFF7764
+ 4BFF77644BFF77644BFF77644BFF77644BFF77644BFF77644BFF77644BFF7764
+ 4BFF77644BFF77644BFF645240E5584B4AF8645650F8645650F8645650F86456
+ 50F8645650F8645650F8645650F8645650F8645650F8645650F8645650F86456
+ 50F8645650F8645650F8584B4AF86C6CDFE58F8FF7FF8F8FF7FF8F8FF7FF8F8F
+ F7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8F
+ F7FF8F8FF7FF8F8FF7FF6C6CDFE56C6CDFE58F8FF7FF8F8FF7FF8F8FF7FF8F8F
+ F7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8F
+ F7FF8F8FF7FF8F8FF7FF6C6CDFE56C6CDFE58F8FF7FF8F8FF7FF8F8FF7FF8F8F
+ F7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8F
+ F7FF8F8FF7FF8F8FF7FF6C6CDFE5595DD6EF6C72E2F16C72E2F16C72E2F16C72
+ E2F16C72E2F16C72E2F16C72E2F16C72E2F16C72E2F16C72E2F16C72E2F16C72
+ E2F16C72E2F16C72E2F1595DD6EF8ED9FAE5A3EEFFFFA3EEFFFFA3EEFFFFA3EE
+ FFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EE
+ FFFFA3EEFFFFA3EEFFFF8ED9FAE58ED9FAE5A3EEFFFFA3EEFFFFA3EEFFFFA3EE
+ FFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EE
+ FFFFA3EEFFFFA3EEFFFF8ED9FAE58ED9FAE5A3EEFFFFA3EEFFFFA3EEFFFFA3EE
+ FFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EE
+ FFFFA3EEFFFFA3EEFFFF8ED9FAE581CEF8E08EDAFAE08EDAFAE08EDAFAE08EDA
+ FAE08EDAFAE08EDAFAE08EDAFAE08EDAFAE08EDAFAE08EDAFAE08EDAFAE08EDA
+ FAE08EDAFAE08EDAFAE081CEF8E0000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000D7C3B9EDE0CBBAE3D29C75AACB9165A3CB91
+ 65A3CB9165A3CE9B75AC897BBBEB897BBBEBCE9B75ACCB9165A3CB9165A3CB91
+ 65A3CB9367A3DAC1B0D49389BFF58380CDFFD6D6F3FFFEF8F4FFF5CDAEFFF0B7
+ 8BFFF0B78BFFF3C49FFF8B8BE5FF8B8BE5FFF3C49FFFF0B78BFFF0B78BFFF2C0
+ 9AFFD9CDDDFF8A8ADCFFCEC6D6FFDDB495EDA9A5DEFFA1A1E3FFF9F9FDFFFAE5
+ D5FFF1BC93FFF3C49FFF8B8BE5FF8B8BE5FFF3C49FFFF0B78BFFF4D3BBFFA9A8
+ E3FFA2A2E3FFFBF9FBFFE5CAB3F3D49A6EE5F1BB91FFDBC7CEFF8B8BDCFFD6D6
+ F3FFFEF8F4FFF6D5BCFF8B8BE5FF8B8BE5FFF4CBACFFE2D5DDFF8989DCFFD5D5
+ F2FFFCF0E7FFF2C39EFFD49A6EE5D9A882EAF3C5A2FFF3C5A2FFF3D3BAFFA8A5
+ DFFFC0C0ECFFFFFFFFFF8B8BE5FF8B8BE5FFD5D4F0FF9B9BE1FFF8F6FBFFF9E1
+ CEFFF3C6A4FFF3C5A2FFD9A882EA7570CDFE8C8CE6FF8C8CE6FF8C8CE6FF8C8C
+ E6FF8C8CE6FF8C8CE6FF8383E8FF8383E8FF8C8CE6FF8C8CE6FF8C8CE6FF8C8C
+ E6FF8C8CE6FF8C8CE6FF7570CDFE7570CDFE8C8CE6FF8C8CE6FF8C8CE6FF8C8C
+ E6FF8C8CE6FF8C8CE6FF8383E8FF8383E8FF8C8CE6FF8C8CE6FF8C8CE6FF8C8C
+ E6FF8C8CE6FF8C8CE6FF7570CDFED9A882EAF3C5A2FFF3C7A5FFF9E5D5FFF8F7
+ FCFF9B9BE1FFD5D4EFFF8B8BE5FF8B8BE5FFFDF4EEFFFCFCFEFFA6A6E4FFBEB7
+ DDFFF5CDAFFFF3C5A2FFD9A882EAD49A6EE5F3C7A4FFFDF3ECFFD5D5F2FF8989
+ DCFFE1D2D9FFF3C9A9FF8B8BE5FF8B8BE5FFF3C5A0FFF7D8C0FFFEFCFBFFB8B8
+ EAFF908FDCFFECCCBDFFD49A6FE5E7CFBBF5FBFAFDFFA2A2E3FFA9A8E2FFF4D1
+ B6FFF0B78BFFF3C49FFF8B8BE5FF8B8BE5FFF3C49FFFF0B78BFFF2C29DFFFCEF
+ E5FFE8E8F8FF8888DBFFC1B5CEFBCEC6D6FF8A8ADCFFD9CCDAFFF2BF98FFF0B7
+ 8BFFF0B78BFFF3C49FFF8B8BE5FF8B8BE5FFF3C49FFFF0B78BFFF0B78BFFF0B8
+ 8CFFF7D8C0FFFEFCFBFF9F9AD1FF9389BFF5DAC1AED2CB9367A3CB9165A3CB91
+ 65A3CB9165A3CE9B75AC897BBBEB897BBBEBCE9B75ACCB9165A3CB9165A3CB91
+ 65A3CB9165A3D6AA8AB5DCC7B7EB000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 00000000000000000000000000005656D4E06C6CE2E06C6CE2E06C6CE2E06C6C
+ E2E06C6CE2E06C6CE2E06C6CE2E06C6CE2E06C6CE2E06C6CE2E06C6CE2E06C6C
+ E2E06C6CE2E06C6CE2E05656D4E06C6CDFE58F8FF7FF8F8FF7FF8F8FF7FF8F8F
+ F7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8F
+ F7FF8F8FF7FF8F8FF7FF6C6CDFE56264DBEE7F7FEEFF7F7FEEFF7F7FEEFF7F7F
+ EEFF7F7FEEFF7F7FEEFF7F7FEEFF7F7FEEFF7F7FEEFF7F7FEEFF7F7FEEFF7F7F
+ EEFF7F7FEEFF7F7FEEFF6264DBEE79B5EEEE88C4F2FF88C4F2FF88C4F2FF88C4
+ F2FF88C4F2FF88C4F2FF88C4F2FF88C4F2FF88C4F2FF88C4F2FF88C4F2FF88C4
+ F2FF88C4F2FF88C4F2FF79B5EEEE8ED9FAE5A3EEFFFFA3EEFFFFA3EEFFFFA3EE
+ FFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EE
+ FFFFA3EEFFFFA3EEFFFF8ED9FAE58ED9FAE5A3EEFFFFA3EEFFFFA3EEFFFFA3EE
+ FFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EE
+ FFFFA3EEFFFFA3EEFFFF8ED9FAE58ED9FAE5A3EEFFFFA3EEFFFFA3EEFFFFA3EE
+ FFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EE
+ FFFFA3EEFFFFA3EEFFFF8ED9FAE58ED9FAE5A3EEFFFFA3EEFFFFA3EEFFFFA3EE
+ FFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EE
+ FFFFA3EEFFFFA3EEFFFF8ED9FAE579B5EEEE88C4F2FF88C4F2FF88C4F2FF88C4
+ F2FF88C4F2FF88C4F2FF88C4F2FF88C4F2FF88C4F2FF88C4F2FF88C4F2FF88C4
+ F2FF88C4F2FF88C4F2FF79B5EEEE6264DBEE7F7FEEFF7F7FEEFF7F7FEEFF7F7F
+ EEFF7F7FEEFF7F7FEEFF7F7FEEFF7F7FEEFF7F7FEEFF7F7FEEFF7F7FEEFF7F7F
+ EEFF7F7FEEFF7F7FEEFF6264DBEE6C6CDFE58F8FF7FF8F8FF7FF8F8FF7FF8F8F
+ F7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8F
+ F7FF8F8FF7FF8F8FF7FF6C6CDFE55656D4E06C6CE2E06C6CE2E06C6CE2E06C6C
+ E2E06C6CE2E06C6CE2E06C6CE2E06C6CE2E06C6CE2E06C6CE2E06C6CE2E06C6C
+ E2E06C6CE2E06C6CE2E05656D4E0000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000C48A5DE0D49B6FE0D49B6FE0D49B6FE0CF95
+ 69EAD9C4AFEAE8DBCEE0E8DBCEE0E8DBCEE0E8DBCEE0C4B9C6EA6665DCEA6C6C
+ E2E06C6CE2E06C6CE2E05656D4E0D49A6EE5F0B78BFFF0B78BFFF0B78BFFE6AD
+ 80FFEBDACAFFFFFAF2FFFFFAF2FFFFFAF2FFFFFAF2FFD7D0DFFF8282EEFF8F8F
+ F7FF8F8FF7FF8F8FF7FF6C6CDFE5D49A6EE5F0B78BFFF0B78BFFF0B78BFFE6AD
+ 80FFEBDACAFFFFFAF2FFFFFAF2FFFFFAF2FFFFFAF2FFD7D0DFFF8282EEFF8F8F
+ F7FF8F8FF7FF8F8FF7FF6C6CDFE5D49A6EE5F0B78BFFF0B78BFFF0B78BFFE6AD
+ 80FFEBDACAFFFFFAF2FFFFFAF2FFFFFAF2FFFFFAF2FFD7D0DFFF8282EEFF8F8F
+ F7FF8F8FF7FF8F8FF7FF6C6CDFE5D49A6EE5F0B78BFFF0B78BFFF0B78BFFE6AD
+ 80FFEBDACAFFFFFAF2FFFFFAF2FFFFFAF2FFFFFAF2FFD7D0DFFF8282EEFF8F8F
+ F7FF8F8FF7FF8F8FF7FF6C6CDFE5D49A6EE5F0B78BFFF0B78BFFF0B78BFFE6AD
+ 80FFEBDACAFFFFFAF2FFFFFAF2FFFFFAF2FFFFFAF2FFD7D0DFFF8282EEFF8F8F
+ F7FF8F8FF7FF8F8FF7FF6C6CDFE5D49A6EE5F0B78BFFF0B78BFFF0B78BFFE6AD
+ 80FFEBDACAFFFFFAF2FFFFFAF2FFFFFAF2FFFFFAF2FFD7D0DFFF8282EEFF8F8F
+ F7FF8F8FF7FF8F8FF7FF6C6CDFE5D49A6EE5F0B78BFFF0B78BFFF0B78BFFE6AD
+ 80FFEBDACAFFFFFAF2FFFFFAF2FFFFFAF2FFFFFAF2FFD7D0DFFF8282EEFF8F8F
+ F7FF8F8FF7FF8F8FF7FF6C6CDFE5D49A6EE5F0B78BFFF0B78BFFF0B78BFFE6AD
+ 80FFEBDACAFFFFFAF2FFFFFAF2FFFFFAF2FFFFFAF2FFD7D0DFFF8282EEFF8F8F
+ F7FF8F8FF7FF8F8FF7FF6C6CDFE5D49A6EE5F0B78BFFF0B78BFFF0B78BFFE6AD
+ 80FFEBDACAFFFFFAF2FFFFFAF2FFFFFAF2FFFFFAF2FFD7D0DFFF8282EEFF8F8F
+ F7FF8F8FF7FF8F8FF7FF6C6CDFE5D49A6EE5F0B78BFFF0B78BFFF0B78BFFE6AD
+ 80FFEBDACAFFFFFAF2FFFFFAF2FFFFFAF2FFFFFAF2FFD7D0DFFF8282EEFF8F8F
+ F7FF8F8FF7FF8F8FF7FF6C6CDFE5C48A5DE0D49B6FE0D49B6FE0D49B6FE0CF95
+ 69EAD9C4AFEAE8DBCEE0E8DBCEE0E8DBCEE0E8DBCEE0C4B9C6EA6665DCEA6C6C
+ E2E06C6CE2E06C6CE2E05656D4E0000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 000000000000000000000000000080A86EE08CB57EE08CB57EE08CB57EE08CB3
+ 7FE6A0B688F6E8DBCEE0E8DBCEE0E8DBCEE0E8DBCEE0837FCFF66E6DDFE66C6C
+ E2E06C6CE2E06C6CE2E05656D4E08BB47DE59EC999FF9EC999FF9EC999FF9EC9
+ 99FFADC39BFFFFFAF2FFFFFAF2FFFFFAF2FFFFFAF2FF9491DDFF8F8FF7FF8F8F
+ F7FF8F8FF7FF8F8FF7FF6C6CDFE58BB47DE59EC999FF9EC999FF9EC999FF9EC9
+ 99FFADC39BFFFFFAF2FFFFFAF2FFFFFAF2FFFFFAF2FF9491DDFF8F8FF7FF8F8F
+ F7FF8F8FF7FF8F8FF7FF6C6CDFE58BB47DE59EC999FF9EC999FF9EC999FF9EC9
+ 99FFADC39BFFFFFAF2FFFFFAF2FFFFFAF2FFFFFAF2FF9491DDFF8F8FF7FF8F8F
+ F7FF8F8FF7FF8F8FF7FF6C6CDFE58BB47DE59EC999FF9EC999FF9EC999FF9EC9
+ 99FFADC39BFFFFFAF2FFFFFAF2FFFFFAF2FFFFFAF2FF9491DDFF8F8FF7FF8F8F
+ F7FF8F8FF7FF8F8FF7FF6C6CDFE58BB47DE59EC999FF9EC999FF9EC999FF9EC9
+ 99FFADC39BFFFFFAF2FFFFFAF2FFFFFAF2FFFFFAF2FF9491DDFF8F8FF7FF8F8F
+ F7FF8F8FF7FF8F8FF7FF6C6CDFE58BB47DE59EC999FF9EC999FF9EC999FF9EC9
+ 99FFADC39BFFFFFAF2FFFFFAF2FFFFFAF2FFFFFAF2FF9491DDFF8F8FF7FF8F8F
+ F7FF8F8FF7FF8F8FF7FF6C6CDFE58BB47DE59EC999FF9EC999FF9EC999FF9EC9
+ 99FFADC39BFFFFFAF2FFFFFAF2FFFFFAF2FFFFFAF2FF9491DDFF8F8FF7FF8F8F
+ F7FF8F8FF7FF8F8FF7FF6C6CDFE58BB47DE59EC999FF9EC999FF9EC999FF9EC9
+ 99FFADC39BFFFFFAF2FFFFFAF2FFFFFAF2FFFFFAF2FF9491DDFF8F8FF7FF8F8F
+ F7FF8F8FF7FF8F8FF7FF6C6CDFE58BB47DE59EC999FF9EC999FF9EC999FF9EC9
+ 99FFADC39BFFFFFAF2FFFFFAF2FFFFFAF2FFFFFAF2FF9491DDFF8F8FF7FF8F8F
+ F7FF8F8FF7FF8F8FF7FF6C6CDFE58BB47DE59EC999FF9EC999FF9EC999FF9EC9
+ 99FFADC39BFFFFFAF2FFFFFAF2FFFFFAF2FFFFFAF2FF9491DDFF8F8FF7FF8F8F
+ F7FF8F8FF7FF8F8FF7FF6C6CDFE580A86EE08CB57EE08CB57EE08CB57EE08CB3
+ 7FE6A0B688F6E8DBCEE0E8DBCEE0E8DBCEE0E8DBCEE0837FCFF66E6DDFE66C6C
+ E2E06C6CE2E06C6CE2E05656D4E0000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000005EAD
+ CA8458A6C72E0000000000000000000000000000000000000000000000000000
+ 000000000000000000000000000000000000000000004998BA2D6EBED8E693DF
+ F4F882D0E8EA60AFCBC600000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000060AFCB9196E1F8FF85CE
+ F5FF8AD4F7FF7CCBE1DB58A6C72E000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000061B3CB9B96E1F9FF85CF
+ F5FF8AD4F7FF7ECCE4DF59A9C939000000000000000000000000000000000000
+ 000000000000000000000000000000000000000000004998BA2D6EBED8E694DF
+ F5FB84D1E9EB60AFCBC600000000000000000000000000000000000000000000
+ 00007FA46B687FA46B6800000000000000000000000000000000000000005EAF
+ CB9157ABC53A0000000000000000000000000000000000000000000000007AA0
+ 671B8BB47DDB8BB47DDB7AA0671B000000000000000000FF000171A05E1B0000
+ 00000000000000000000000000000000000000000000000000000000000083AA
+ 72B69DC998FF9DC998FF83AA72B6000000000000000085AE74788CB27CC755AA
+ 55030000000000000000000000000000000000000000000000007FA76B7498C1
+ 90F99EC999FF9EC999FF98C190F97FA76B7487A570229EC493E1B6D9B2FD87AF
+ 768700000000000000000000000000000000000000007BA765238DB680DF9EC9
+ 99FF9EC999FF9EC999FF9EC999FF8DB680DF8FB47DC3BCE0B9FFBDE0BAFFA4C7
+ 98E67FA86B3200000000000000000000000000FF000184AC72BD9DC998FF9EC9
+ 99FF9EC999FF9EC999FF9EC999FF92BC88FFB3D6ADFDBDE0BAFFBDE0BAFFBDE0
+ BAFF92B581C355AA5503000000000000000080AA6E7F99C493FB9EC999FF9EC9
+ 99FF9EC999FF9EC999FF9AC393FF9FC595FFBDE0BAFFBDE0BAFFBDE0BAFFBDE0
+ BAFFB7D9B1FD87AF7687000000007C9E652D8EB883E39EC999FF9EC999FF9EC9
+ 99FF9EC999FF9DC998FF93BB86FFBCE0B9FFBDE0BAFFBDE0BAFFBDE0BAFFBDE0
+ BAFFBDE0BAFFA4C798E67FA86B327DA367A788B17AC288B17AC288B17AC288B1
+ 7AC288B17AC284AC73D48EB37DF294B986F194B986F194B986F193B783EA97BA
+ 8AC297BA8AC297BA8AC283A76FA7000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 00000000000000000000000000000000000000000000427A971B427A971B0000
+ 0000000000000000000000000000B6794C3F0000000000000000000000000000
+ 000000000000000000000000000000000000000000004C86A1964C86A1960000
+ 000000000000B8784D24CC9166C9CC9367DBC28A5C8C00000000000000000000
+ 0000000000000000000000000000000000000000000064A3C5E764A3C5E70000
+ 000000000000C59066E3DBB38AFDDBB38AFDC8946AFCBB77550F000000009E8D
+ 762D9E8D762D0000000000000000000000004D89A5665995B3EA5995B3EA4D89
+ A56600000000CC976EE3FFE8C2FFFFE8C2FFDBAF86FEB57C4F2D00000000B0A2
+ 91A5B1A190A4000000000000000038718D095087A69C6FB2D6FF6FB2D6FF5087
+ A69C38718D09CC956BE7FDE6BFFFFFE8C2FFDCAE84FFC186595BAAAA5503B7A9
+ 98F5B7A998F5AAAA550300000000437C932D65A5C6FF67A6C9FF67A6C9FF65A5
+ C6FF4E7C9131CF966CECF7DCB5FFFFE8C2FFDDAD83FFC3895E84ACA08E66DCD1
+ C5FDDCD1C5FDAE9C8D6500000000437C932D71B4D7FF7AC0E6FF7AC0E6FF71B4
+ D7FF6D7B7848D79C70F5F0D1AAFFFFE8C2FFDCAA80FFC78E6298AB9C8B8FD6CB
+ BEFFD6CBBEFFAB9C8B8F00000000437C932D71B4D7FF7AC0E6FF7AC0E6FF71B4
+ D7FF897F7068E1A77BFFE9C69EFFFFE8C2FFDCA87EFFC99067ADBCAE9FD0D3C9
+ BBFFD3C9BBFFBCAE9FD091916D07437C932D6EAFD1FF76BADFFF76BADFFF6EAF
+ D1FF9A836C90ECB387FFE1BA90FFFFE8C2FFDAA57AFFCD956BC8D2C7BAFFDED4
+ C9FFDED4C9FFD2C7BAFF9E8D762D437C932D6EAFD2FF76BADFFF76BADFFF6EAF
+ D2FFA3876DA5F0B78BFFE0B48CFFFAE1BBFFDDA87BFFD1986DD6D3C8BAFFDED5
+ C8FFDED5C8FFD3C8BAFF9E8D762D437C932D71B4D7FF7AC0E6FF7AC0E6FF71B4
+ D7FFA88C71B4F0B78BFFDEB188FFF4D7B1FFE2A97DFFD49A6FE5D8CDBEFFE4DB
+ D0FFE4DBD0FFD8CEC0FF9E8D762D437C932D71B4D7FF7AC0E6FF7AC0E6FF71B4
+ D7FFAD8E73C3F0B78BFFDEAF86FFECCCA5FFE6AD81FFDCA378F3D4C4B2FFE4DB
+ D0FFE4DBD0FFD8CEC0FF9E8D762D548EADAD5F9EBEF363A2C2F263A2C2F25F9E
+ BEF376929CEDF0B78BFFDCAC82FFE6C097FFEBB386FFE7AD81FFC8B099FFDCD2
+ C5FFDCD2C5FFCCC1B2FF9C8A78465B98B8A768A9CBFF76BADFFF76BADFFF68A9
+ CBFF8198A2F2F0B78BFFDDAA80FFE0B68DFFF0B78BFFEDB488FFD4B49AFFB9AC
+ 9BFFB9AC9BFFE1D8CCFFB7A999BA5B98B8A76FB2D5FF7AC0E6FF7AC0E6FF6FB2
+ D5FF859BA3F7F0B78BFFDAA67DFFDEB28AFFF0B78BFFF0B78BFFD3AE91FFE4DB
+ D0FFE4DBD0FFE4DBD0FFB9AC9CB3558FAD6E5C99BAA35C99BAA35C99BAA36097
+ B4AC8B8F8ACDCB9165A3C89266C0CA966BD6CB9165A3C5956DCBBF9A7CC9BBAF
+ 9FA3BBAF9FA3BBAF9FA3B2A4926E0000000000000000000000003F3F7F043A56
+ 83763E59899C3955826600000000000000000000000000000000000000000000
+ 00000000000000000000000000000000000000000000000000013C5A87B84C6F
+ A1FE4E71A6FF496B9DF73A57879E457F9C3E538CAB744C84A832000000000000
+ 0000000000000000000000000000000000000000000038527F44496A9DFD4E71
+ A6FF4E71A6FF496C9DFB568DB1FD76BADFFD82CAF0FF70B3D7EE528BA9755555
+ AA03000000000000000000000000000000000000000039558277486A9DFD4C72
+ A0FF4F77A5FF5E99BCFF84CCF3FF85CEF5FF85CEF5FF85CEF5FF79BFE3FC5A96
+ B5B500000000000000000000000000000000000000003952814742668FF285CE
+ F5FF85CEF5FF6AABCDFF85CEF5FF85CEF5FF84CCF3FF6EADCFFF64A0BFFD6CAF
+ D2F4467B951D000000000000000000000000000000004C87A3645283A9FD85CE
+ F5FF85CEF5FF67A8CAFF6BA9C8FF75B2D3FF7AB5D5FF9BD7F7FF9AD5F6FF5B9A
+ BAF5447C97250000000000000000000000000000000038718D095D9ABADD85CE
+ F5FF85CEF5FF5995B4FF82BDDBFFA3DEFFFFA3DEFFFFA3DEFFFFA3DEFFFF4C84
+ A1FA486D910E00000000000000000000000000000000000000005491AF7075BB
+ DFFD85CEF5FF639EBCFF8AC4E3FFA3DEFFFFA3DEFFFFA3DEFFFFA3DEFFFF5E96
+ B3F8437893130000000000000000000000000000000000000000B67F480E5B93
+ B3F063A1C3FF5A95B4FE89C2E2FAA3DEFFFFA3DEFFFFA3DEFFFF9ED9FAFF5990
+ ABA200000000000000000000000000000000BF7F562CCC9164BBD9A074E89399
+ 97FE739FB3FF84999FFF73A0B7FDA3DEFFFFA3DEFFFFA3DEFFFF76AFCDF4517F
+ 9616000000000000000000000000B4875A11D2996DD0F0B78BFFF0B78BFFF0B7
+ 8BFFF0B78BFFF0B78BFF979E9DFF77B0CFFF86BFDFFF7AB2D1FF6098B7C00000
+ 0000000000000000000000000000C2875C87EEB488FFF0B78BFFF0B78BFFF0B7
+ 8BFFEDB48AFFE1B28BFFAFA79AFF95CBE9FF96D1F1FF9CD6F7FF8DA2A8E3D6AE
+ 8AA2CC9F7F280000000000000000C187584BC1885C85C1885C85C1885C85C591
+ 689CDBB592EDFCE4BEFFFFE8C2FFB0C0BBFF96B9C4FFA3BABCFFFAE5C1FFFEE7
+ C1FFE5C49FE4CFA6855C00000000000000000000000000000000FF7F7F02DAB5
+ 91CCFFE8C1FFFFE8C2FFFFE8C2FFFFE8C2FFFFE8C2FFFFE8C2FFFFE8C2FFFFE8
+ C2FFFFE8C2FFE2C09BE0C5967F16000000000000000000000000CBA28145F0D5
+ AFFAFFE8C2FFFFE8C2FFFFE8C2FFFFE8C2FFFFE8C2FFFFE8C2FFFFE8C2FFFFE8
+ C2FFFFE8C2FFFCE3BEFFD2A98689000000000000000000000000CEA68145D9B4
+ 90A4D9B591A3D9B591A3D9B591A3D9B591A3D9B591A3D9B591A3D9B591A3D9B5
+ 91A3D9B591A3D9B591A3D3A78569
+ }
+ end
+ object BufDataset1: TBufDataset
+ FieldDefs = <>
+ left = 192
+ top = 128
+ end
+end
diff --git a/components/jvcllaz/examples/JvDBTreeView/main.pas b/components/jvcllaz/examples/JvDBTreeView/main.pas
new file mode 100644
index 000000000..2710a9446
--- /dev/null
+++ b/components/jvcllaz/examples/JvDBTreeView/main.pas
@@ -0,0 +1,162 @@
+unit Main;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, BufDataset, db, Forms, Controls, Graphics, Dialogs,
+ DBGrids, DbCtrls, StdCtrls, ExtCtrls, ComCtrls,
+ JvDBTreeView;
+
+type
+
+ { TForm1 }
+
+ TForm1 = class(TForm)
+ Bevel1: TBevel;
+ BufDataset1: TBufDataset;
+ Button1: TButton;
+ Button2: TButton;
+ DataSource1: TDataSource;
+ DBGrid1: TDBGrid;
+ ImageList1: TImageList;
+ JvDBTreeView1: TJvDBTreeView;
+ Panel1: TPanel;
+ StatusBar1: TStatusBar;
+ procedure Button1Click(Sender: TObject);
+ procedure Button2Click(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure JvDBTreeView1CustomDrawItem(Sender: TCustomTreeView;
+ Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
+ procedure JvDBTreeView1GetSelectedIndex(Sender: TObject; Node: TTreeNode);
+ private
+
+ public
+
+ end;
+
+var
+ Form1: TForm1;
+
+implementation
+
+{$R *.lfm}
+
+const
+ ICON_MALE = 0;
+ ICON_FEMALE = 1;
+ ICON_DE = 2;
+ ICON_UK = 3;
+ ICON_ES = 4;
+ ICON_FR = 5;
+ ICON_IT = 6;
+ ICON_LANDSCAPE = 7;
+ ICON_CITY = 8;
+ ICON_PEOPLE = 9;
+
+{ TForm1 }
+
+procedure TForm1.Button1Click(Sender: TObject);
+begin
+ JvDBTreeView1.FullExpand;
+end;
+
+procedure TForm1.Button2Click(Sender: TObject);
+begin
+ JvDBTreeView1.FullCollapse;
+end;
+
+procedure TForm1.FormCreate(Sender: TObject);
+
+ procedure AddRecord(ID, ParentID: Integer; AName: String; AIcon: Integer = -1);
+ begin
+ //with Dbf1 do begin
+ with BufDataset1 do begin
+ Insert;
+ Fields[0].AsInteger := ID;
+ Fields[1].AsInteger := ParentID;
+ Fields[2].AsString := AName;
+ Fields[3].AsInteger := AIcon;
+ Post;
+ end;
+ end;
+
+begin
+ BufDataset1.Filename := Application.Location + 'JvDBGridDemoData.dat';
+
+ if not FileExists(BufDataset1.FileName) then begin
+ if BufDataset1.FieldDefs.IndexOf('ID') = -1 then;
+ BufDataset1.FieldDefs.Add('ID', ftInteger);
+ if BufDataset1.FieldDefs.IndexOf('ParentID') = -1 then
+ BufDataset1.FieldDefs.Add('ParentID', ftInteger);
+ if BufDataset1.FieldDefs.IndexOf('Name') = -1 then
+ BufDataset1.FieldDefs.Add('Name', ftString, 20);
+ if BufDataset1.FieldDefs.IndexOf('Icon') = -1 then
+ BufDataset1.FieldDefs.Add('Icon', ftInteger);
+ BufDataset1.CreateDataset;
+
+ BufDataset1.Open;
+
+ AddRecord( 1, 0, 'Politicians', ICON_PEOPLE);
+ AddRecord( 2, 0, 'Cities', ICON_CITY);
+ AddRecord( 3, 0, 'Rivers', ICON_LANDSCAPE);
+ AddRecord( 4, 1, 'France', ICON_FR);
+ AddRecord( 5, 1, 'Germany', ICON_DE);
+ AddRecord( 6, 1, 'Great Britain', ICON_UK);
+ AddRecord( 7, 1, 'Italy', ICON_IT);
+ AddRecord( 8, 4, 'Charles de Gaulles', ICON_MALE);
+ AddRecord( 9, 4, 'Emmanuel Macron', ICON_MALE);
+ AddRecord(10, 4, 'François Mitterrand', ICON_MALE);
+ AddRecord(11, 5, 'Angela Merkel', ICON_FEMALE);
+ AddRecord(12, 6, 'Tony Blair', ICON_MALE);
+ AddRecord(13, 6, 'Theresa May', ICON_FEMALE);
+ AddRecord(14, 5, 'Konrad Adenauer', ICON_MALE);
+ AddRecord(15, 5, 'Willy Brandt', ICON_MALE);
+ AddRecord(16, 7, 'Matteo Renzi', ICON_MALE);
+ AddRecord(20, 3, 'France');
+ AddRecord(21, 20, 'Seine');
+ AddRecord(22, 20, 'Rhône');
+ AddRecord(23, 3, 'England');
+ AddRecord(24, 23, 'Thames');
+// AddRecord(25, 2, 'France');
+ AddRecord(26, 2, 'Paris', ICON_FR);
+ AddRecord(27, 2, 'Marseilles', ICON_FR);
+ AddRecord(29, 2, 'London', ICON_UK);
+ AddRecord(30, 2, 'Oxford', ICON_UK);
+ AddRecord(31, 2, 'Lyon', ICON_FR);
+ AddRecord(33, 2, 'Berlin', ICON_DE);
+ AddRecord(34, 2, 'Hamburg', ICON_DE);
+ AddRecord(35, 2, 'Munich', ICON_DE);
+ AddRecord(36, 2, 'Frankfurt', ICON_DE);
+ AddRecord(38, 2, 'Rome', ICON_IT);
+ AddRecord(39, 2, 'Venice', ICON_IT);
+ AddRecord(40, 2, 'Madrid', ICON_ES);
+ AddRecord(41, 2, 'Barcelona', ICON_ES);
+
+ BufDataset1.SaveToFile;
+ BufDataset1.Close;
+ end;
+
+ BufDataset1.Open;
+ BufDataset1.IndexFieldNames := 'ParentID;Name';
+end;
+
+procedure TForm1.JvDBTreeView1CustomDrawItem(Sender: TCustomTreeView;
+ Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
+begin
+ if Node.Level = 0 then
+ Sender.Canvas.Font.Style := [fsBold]
+ else
+ Sender.Canvas.Font.Style := [];
+end;
+
+procedure TForm1.JvDBTreeView1GetSelectedIndex(Sender: TObject; Node: TTreeNode
+ );
+begin
+ Node.SelectedIndex := Node.ImageIndex;
+end;
+
+end.
+
+
diff --git a/components/jvcllaz/packages/JvDBLazR.lpk b/components/jvcllaz/packages/JvDBLazR.lpk
index 86b3cbf4c..4de6a5855 100644
--- a/components/jvcllaz/packages/JvDBLazR.lpk
+++ b/components/jvcllaz/packages/JvDBLazR.lpk
@@ -17,7 +17,7 @@
- Hypertext components "/>
-
+
@@ -26,6 +26,10 @@
+
+
+
+
diff --git a/components/jvcllaz/run/JvDB/JvDBTreeView.pas b/components/jvcllaz/run/JvDB/JvDBTreeView.pas
new file mode 100644
index 000000000..adb7d17f1
--- /dev/null
+++ b/components/jvcllaz/run/JvDB/JvDBTreeView.pas
@@ -0,0 +1,1596 @@
+{-----------------------------------------------------------------------------
+The contents of this file are subject to the Mozilla Public License
+Version 1.1 (the "License"); you may not use this file except in compliance
+with the License. You may obtain a copy of the License at
+http://www.mozilla.org/MPL/MPL-1.1.html
+
+Software distributed under the License is distributed on an "AS IS" basis,
+WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
+the specific language governing rights and limitations under the License.
+
+The Original Code is: JvDBTreeView.PAS, released on 2002-07-04.
+
+The Initial Developers of the Original Code are: Andrei Prygounkov
+Copyright (c) 1999, 2002 Andrei Prygounkov
+All Rights Reserved.
+
+Contributor(s):
+Peter Zolja
+Marc Geldon
+
+You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
+located at http://jvcl.delphi-jedi.org
+
+component : JvDBTreeView
+description : db-aware TreeView
+
+History:
+ (JVCL Library versions) :
+ 1.20:
+ - first release;
+ 1.61:
+ - support for non-bde components,
+ by Yakovlev Vacheslav (jwe att belkozin dott com)
+ 3.3: martinalex, Jan 2007
+ - Fix: Add Node, IconField, value set, same value as parent
+ - Fix: Add Node, MasterField, unique value ensured
+ - Fix: Delete node, delete records for all childs
+ - Fix: Drag&drop, move node only for node drop, not for drop of other objects
+
+Known Issues:
+ Some russian comments were translated to english; these comments are marked
+ with [translated]
+
+Usage:
+ - Dataset must have a unique field (e. g., ID) - link it to "MasterField"
+ - There must be another field with the ID of the parent node - link it to
+ "DetailField"
+ - The text to be displayed as node text is taken from field "ItemField"
+ - Optionally, there can ba an "IconField" from which the icon index into the
+ ImageList is taken.
+-----------------------------------------------------------------------------}
+// $Id$
+
+unit JvDBTreeView;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ LCLIntf, LCLType, LMessages,
+ Messages, CommCtrl,
+ Classes, Controls, ExtCtrls, ComCtrls, DB;
+// JvExtComponent;
+
+type
+ TJvDBTreeNode = class;
+ TJvDBTreeViewDataLink = class;
+ TFieldTypes = set of TFieldType;
+ TGetDetailValue = function(const AMasterValue: Variant; var DetailValue: Variant): Boolean;
+
+ TJvCustomDBTreeView = class(TCustomTreeView) //TJvCustomTreeView)
+ private
+ FDataLink: TJvDBTreeViewDataLink;
+ FMasterField: string;
+ FDetailField: string;
+ FItemField: string;
+ FIconField: string;
+ FStartMasterValue: Variant;
+ FGetDetailValue: TGetDetailValue;
+ FUseFilter: Boolean;
+ FSelectedIndex: Integer;
+ {Update flags}
+ FUpdateLock: Byte;
+ InTreeUpdate: Boolean;
+ InDataScrolled: Boolean;
+ InAddChild: Boolean;
+ InDelete: Boolean;
+ Sel: TTreeNode;
+ OldRecCount: Integer;
+ FPersistentNode: Boolean;
+ { wp: removed
+ FMirror: Boolean;
+ }
+ {**** Drag'n'Drop ****}
+ YDragPos: Integer;
+ TimerDnD: TTimer;
+ procedure InternalDataChanged;
+ procedure InternalDataScrolled;
+ procedure InternalRecordChanged(Field: TField);
+ procedure SetMasterField(Value: string);
+ procedure SetDetailField(Value: string);
+ procedure SetItemField(Value: string);
+ procedure SetIconField(Value: string);
+ function GetStartMasterValue: string;
+ procedure SetStartMasterValue(Value: string);
+ function GetDataSource: TDataSource;
+ procedure SetDataSource(Value: TDataSource);
+ procedure CMGetDataLink(var Msg: TMessage); message CM_GETDATALINK;
+ { wp -- removed
+ procedure SetMirror(Value: Boolean);
+ }
+ {**** Drag'n'Drop ****}
+ procedure TimerDnDTimer(Sender: TObject);
+ protected
+ FMastersStream: TStream;
+
+ procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState;
+ var Accept: Boolean); override;
+
+ procedure CreateWnd; override;
+ procedure DestroyWnd; override;
+ protected
+ procedure Warning(Msg: string);
+ procedure HideEditor;
+ function ValidDataSet: Boolean;
+ procedure CheckDataSet;
+ function ValidField(FieldName: string; AllowFieldTypes: TFieldTypes): Boolean;
+ procedure KeyDown(var Key: Word; Shift: TShiftState); override;
+ procedure Notification(Component: TComponent; Operation: TOperation); override;
+ procedure Change(Node: TTreeNode); override;
+ { data }
+ procedure DataChanged; dynamic;
+ procedure DataScrolled; dynamic;
+ procedure Change2(Node: TTreeNode); dynamic;
+ procedure RecordChanged(Field: TField); dynamic;
+
+ function CanExpand(Node: TTreeNode): Boolean; override;
+ procedure Collapse(Node: TTreeNode); override;
+ function CreateNode: TTreeNode; override;
+ function CanEdit(Node: TTreeNode): Boolean; override;
+ { *** FIXME
+ procedure Edit(const Item: TTVItem); override;
+ }
+ procedure MoveTo(Source, Destination: TJvDBTreeNode; Mode: TNodeAttachMode);
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure DragDrop(Source: TObject; X, Y: Integer); override;
+ procedure RefreshChild(ANode: TJvDBTreeNode);
+ procedure UpdateTree;
+ procedure LinkActive(Value: Boolean); virtual;
+ procedure UpdateLock;
+ procedure UpdateUnLock(const AUpdateTree: Boolean);
+ function UpdateLocked: Boolean;
+ function AddChildNode(const Node: TTreeNode; const ASelect: Boolean): TJvDBTreeNode;
+ procedure DeleteNode(Node: TTreeNode);
+ function DeleteChildren(ParentNode: TTreeNode): Boolean;
+ function FindNextNode(const Node: TTreeNode): TTreeNode;
+ function FindNode(AMasterValue: Variant): TJvDBTreeNode;
+ function SelectNode(AMasterValue: Variant): TTreeNode;
+
+ property DataSource: TDataSource read GetDataSource write SetDataSource;
+ property DataLink: TJvDBTreeViewDataLink read FDataLink;
+ property MasterField: string read FMasterField write SetMasterField;
+ // alias for MasterField
+ property ParentField: string read FMasterField write SetMasterField;
+ property DetailField: string read FDetailField write SetDetailField;
+ // alias for DetailField
+ property KeyField: string read FDetailField write SetDetailField;
+
+ property ItemField: string read FItemField write SetItemField;
+ property IconField: string read FIconField write SetIconField;
+ property StartMasterValue: string read GetStartMasterValue write SetStartMasterValue;
+ property GetDetailValue: TGetDetailValue read FGetDetailValue write FGetDetailValue;
+ property PersistentNode: Boolean read FPersistentNode write FPersistentNode;
+ property SelectedIndex: Integer read FSelectedIndex write FSelectedIndex default 1;
+ property UseFilter: Boolean read FUseFilter write FUseFilter;
+ { wp --- removed
+ property Mirror: Boolean read FMirror write SetMirror;
+ }
+ property Items;
+ end;
+
+ TJvDBTreeViewDataLink = class(TDataLink)
+ private
+ FTreeView: TJvCustomDBTreeView;
+ protected
+ procedure ActiveChanged; override;
+ procedure RecordChanged(Field: TField); override;
+ procedure DataSetChanged; override;
+ procedure DataSetScrolled(Distance: Integer); override;
+ public
+ constructor Create(ATreeView: TJvCustomDBTreeView);
+ end;
+
+ TJvDBTreeNode = class(TTreeNode)
+ private
+ FMasterValue: Variant;
+ public
+ procedure SetMasterValue(AValue: Variant);
+ procedure MoveTo(Destination: TTreeNode; Mode: TNodeAttachMode); override;
+ property MasterValue: Variant read FMasterValue;
+ end;
+
+ {$IFDEF RTL230_UP}
+ [ComponentPlatformsAttribute(pidWin32 or pidWin64)]
+ {$ENDIF RTL230_UP}
+ TJvDBTreeView = class(TJvCustomDBTreeView)
+ published
+ property DataSource;
+ property MasterField;
+ property DetailField;
+ property IconField;
+ property ItemField;
+ property StartMasterValue;
+ property UseFilter;
+ property PersistentNode;
+ property SelectedIndex;
+
+ property Align;
+ property Anchors;
+ property AutoExpand;
+ property BackgroundColor;
+ property BorderSpacing;
+ property BorderStyle;
+ property BorderWidth;
+ property Color;
+ property Constraints;
+ property Cursor;
+ property DefaultItemHeight;
+ property DragCursor;
+ property DragKind;
+ property DragMode;
+ property Enabled;
+ property ExpandSignColor;
+ property ExpandSignSize;
+ property ExpandSignType;
+ property Font;
+ property Height;
+ property HelpContext;
+ property HelpKeyword;
+ property HelpType;
+ property HideSelection;
+ property Hint;
+ property HotTrack;
+ property HotTrackColor;
+ property Images;
+ property Indent;
+ property Items;
+ property Left;
+ property MultiSelect;
+ property MultiSelectStyle;
+ property ParentColor;
+ property ParentFont;
+ property ParentShowHint;
+ property ReadOnly;
+ property RightClickSelect;
+ property RowSelect;
+ property Scrollbars;
+ property SelectionColor;
+ property SelectionFontColor;
+ property SelectionFontColorUsed;
+ property SeparatorColor;
+ property ShowButtons;
+ property ShowHint;
+ property ShowLines;
+ property ShowRoot;
+ property SortType;
+ property StateImages;
+ property TabOrder;
+ property TabStop;
+ property ToolTips;
+ property Top;
+ property TreeLineColor;
+ property TreeLinePenStyle;
+ property Visible;
+ property Width;
+
+ property OnAddition;
+ property OnAdvancedCustomDraw;
+ property OnAdvancedCustomDrawItem;
+ property OnChange;
+ property OnChanging;
+ property OnClick;
+ property OnCollapsed;
+ property OnCollapsing;
+ property OnContextPopup;
+ property OnCreateNodeClass;
+ property OnCustomDraw;
+ property OnCustomDrawArrow;
+ property OnCustomDrawItem;
+ property OnDblClick;
+ property OnDeletion;
+ property OnDragDrop;
+ property OnDragOver;
+ property OnEdited;
+ property OnEditing;
+ property OnEditingEnd;
+ property OnEndDrag;
+ property OnEnter;
+ property OnExit;
+ property OnExpanded;
+ property OnExpanding;
+ property OnGetImageIndex;
+ property OnGetSelectedIndex;
+ property OnKeyDown;
+ property OnKeyPress;
+ property OnKeyUp;
+ property OnMouseDown;
+ property OnMouseEnter;
+ property OnMouseMove;
+ property OnMouseWheel;
+ property OnMouseWheelDown;
+ property OnMouseWheelUp;
+ property OnNodeChanged;
+ property OnResize;
+ property OnSelectionChanged;
+ property OnShowHint;
+ property OnStartDrag;
+ property OnUTF8KeyPress;
+ { wp --- removed
+ property Mirror;
+ }
+ end;
+
+ EJvDBTreeViewError = class(ETreeViewError);
+
+
+implementation
+
+uses
+ Variants, SysUtils, Dialogs, ImgList,
+ JvResources;
+
+// (rom) moved to implementation and removed type
+// (rom) never rely on assignable consts
+const
+ DnDScrollArea = 15;
+ DnDInterval = 200;
+ DefaultValidMasterFields = [ftSmallInt, ftInteger, ftAutoInc, ftWord, ftFloat, ftString, ftWideString, ftBCD, ftFMTBCD];
+ DefaultValidDetailFields = DefaultValidMasterFields;
+ DefaultValidItemFields = [ftString, ftWideString, ftMemo, ftFmtMemo, ftSmallInt, ftInteger, ftAutoInc,
+ ftWord, ftBoolean, ftFloat, ftCurrency, ftDate, ftTime, ftDateTime, ftBCD, ftFMTBCD
+ {$IFDEF COMPILER10_UP}
+ , ftFixedWideChar, ftWideMemo, ftOraTimeStamp
+ {$ENDIF COMPILER10_UP}
+ {$IFDEF COMPILER12_UP}
+ ,ftLongWord, ftShortint, ftByte, ftExtended
+ {$ENDIF COMPILER12_UP}];
+ DefaultValidIconFields = [ftSmallInt, ftAutoInc, ftInteger, ftWord, ftBCD, ftFMTBCD
+ {$IFDEF COMPILER12_UP}
+ ,ftLongWord, ftShortint
+ {$ENDIF COMPILER12_UP}];
+
+function Var2Type(V: Variant; const VarType: Integer): Variant;
+begin
+ if V = Null then
+ begin
+ case VarType of
+ varString, varOleStr:
+ Result := '';
+ varInteger, varSmallint, varByte:
+ Result := 0;
+ varBoolean:
+ Result := False;
+ varSingle, varDouble, varCurrency, varDate:
+ Result := 0.0;
+ else
+ Result := VarAsType(V, VarType);
+ end;
+ end
+ else
+ Result := VarAsType(V, VarType);
+end;
+
+{ --- wp -- removed
+procedure MirrorControl(Control: TWinControl; RightToLeft: Boolean);
+var
+ OldLong: Longword;
+begin
+ OldLong := GetWindowLong(Control.Handle, GWL_EXSTYLE);
+ if RightToLeft then
+ begin
+ Control.BiDiMode := bdLeftToRight;
+ SetWindowLong(Control.Handle, GWL_EXSTYLE, OldLong or $00400000);
+ end
+ else
+ SetWindowLong(Control.Handle, GWL_EXSTYLE, OldLong and not $00400000);
+ Control.Repaint;
+end; }
+
+//=== { TJvDBTreeViewDataLink } ==============================================
+
+constructor TJvDBTreeViewDataLink.Create(ATreeView: TJvCustomDBTreeView);
+begin
+ inherited Create;
+ FTreeView := ATreeView;
+end;
+
+procedure TJvDBTreeViewDataLink.ActiveChanged;
+begin
+ FTreeView.LinkActive(Active);
+end;
+
+procedure TJvDBTreeViewDataLink.RecordChanged(Field: TField);
+begin
+ FTreeView.InternalRecordChanged(Field);
+end;
+
+procedure TJvDBTreeViewDataLink.DataSetChanged;
+begin
+ FTreeView.InternalDataChanged;
+end;
+
+procedure TJvDBTreeViewDataLink.DataSetScrolled(Distance: Integer);
+begin
+ FTreeView.InternalDataScrolled;
+end;
+
+//=== { TJvDBTreeNode } ======================================================
+
+procedure TJvDBTreeNode.MoveTo(Destination: TTreeNode; Mode: TNodeAttachMode);
+var
+ PersistNode: Boolean;
+ TV: TJvCustomDBTreeView;
+begin
+ if Destination <> nil then
+ begin
+ // If we are trying to move ourselves in the same parent and we are
+ // already the last child, there is no point in moving us.
+ // It's even dangerous as it triggers Mantis 3934
+ if not ((Parent = Destination) and (Self = Destination.GetLastChild) and (Mode = naAddChild)) then
+ begin
+ TV := TreeView as TJvCustomDBTreeView;
+ PersistNode := TV.FPersistentNode;
+ TV.MoveTo(Self as TJvDBTreeNode, Destination as TJvDBTreeNode, Mode);
+ TV.FPersistentNode := True;
+ if (Destination <> nil) and Destination.HasChildren and (Destination.Count = 0) then
+ Free
+ else
+ inherited MoveTo(Destination, Mode);
+ TV.FPersistentNode := PersistNode;
+ end;
+ end;
+end;
+
+procedure TJvDBTreeNode.SetMasterValue(AValue: Variant);
+begin
+ FMasterValue := AValue;
+end;
+
+//=== { TJvCustomDBTreeView } ================================================
+
+constructor TJvCustomDBTreeView.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FDataLink := TJvDBTreeViewDataLink.Create(Self);
+ TimerDnD := TTimer.Create(Self);
+ TimerDnD.Enabled := False;
+ TimerDnD.Interval := DnDInterval;
+ TimerDnD.OnTimer := @TimerDnDTimer;
+ FStartMasterValue := Null;
+ FSelectedIndex := 1;
+ FMastersStream := nil;
+end;
+
+destructor TJvCustomDBTreeView.Destroy;
+begin
+ FDataLink.Free;
+ FDataLink := nil;
+ TimerDnD.Free;
+ FMastersStream.Free;
+ inherited Destroy;
+end;
+
+procedure TJvCustomDBTreeView.CheckDataSet;
+begin
+ if not ValidDataSet then
+ raise EJvDBTreeViewError.CreateRes(@RsEDataSetNotActive);
+end;
+
+procedure TJvCustomDBTreeView.Warning(Msg: string);
+begin
+ MessageDlg('TJvCustomDBTreeView.Warning()' + #13#10 + Name + ': ' + Msg, mtWarning, [mbOk], 0);
+end;
+
+function TJvCustomDBTreeView.ValidField(FieldName: string; AllowFieldTypes: TFieldTypes): Boolean;
+var
+ AField: TField;
+begin
+ Result := (csLoading in ComponentState) or (Length(FieldName) = 0) or
+ (FDataLink.DataSet = nil) or not FDataLink.DataSet.Active;
+ if not Result and (Length(FieldName) > 0) then
+ begin
+ AField := FDataLink.DataSet.FindField(FieldName); { no exceptions }
+ Result := (AField <> nil) and (AField.DataType in AllowFieldTypes);
+ end;
+end;
+
+procedure TJvCustomDBTreeView.SetMasterField(Value: string);
+begin
+ if ValidField(Value, DefaultValidMasterFields) then
+ begin
+ FMasterField := Value;
+ RefreshChild(nil);
+ end
+ else
+ Warning(RsMasterFieldError);
+end;
+
+procedure TJvCustomDBTreeView.SetDetailField(Value: string);
+begin
+ if ValidField(Value, DefaultValidDetailFields) then
+ begin
+ FDetailField := Value;
+ RefreshChild(nil);
+ end
+ else
+ Warning(RsDetailFieldError);
+end;
+
+procedure TJvCustomDBTreeView.SetItemField(Value: string);
+begin
+ if ValidField(Value, DefaultValidItemFields) then
+ begin
+ FItemField := Value;
+ RefreshChild(nil);
+ end
+ else
+ Warning(RsItemFieldError);
+end;
+
+procedure TJvCustomDBTreeView.SetIconField(Value: string);
+begin
+ if ValidField(Value, DefaultValidIconFields) then
+ begin
+ FIconField := Value;
+ RefreshChild(nil);
+ end
+ else
+ Warning(RsIconFieldError);
+end;
+
+function TJvCustomDBTreeView.GetStartMasterValue: string;
+begin
+ if FStartMasterValue = Null then
+ Result := ''
+ else
+ Result := FStartMasterValue;
+end;
+
+procedure TJvCustomDBTreeView.SetStartMasterValue(Value: string);
+begin
+ if Length(Value) > 0 then
+ FStartMasterValue := Value
+ else
+ FStartMasterValue := Null;
+end;
+
+function TJvCustomDBTreeView.GetDataSource: TDataSource;
+begin
+ Result := FDataLink.DataSource;
+end;
+
+procedure TJvCustomDBTreeView.SetDataSource(Value: TDataSource);
+begin
+ if Value = FDataLink.DataSource then
+ Exit;
+ Items.Clear;
+ if FDataLink.DataSource <> nil then
+ FDataLink.DataSource.RemoveFreeNotification(Self);
+ FDataLink.DataSource := Value;
+ if Value <> nil then
+ Value.FreeNotification(Self);
+end;
+
+procedure TJvCustomDBTreeView.CMGetDataLink(var Msg: TMessage);
+begin
+ Msg.Result := LRESULT(FDataLink);
+end;
+
+procedure TJvCustomDBTreeView.Notification(Component: TComponent; Operation: TOperation);
+begin
+ inherited Notification(Component, Operation);
+ if (FDataLink <> nil) and (Component = DataSource) and (Operation = opRemove) then
+ DataSource := nil;
+end;
+
+function TJvCustomDBTreeView.CreateNode: TTreeNode;
+begin
+ Result := TJvDBTreeNode.Create(Items);
+end;
+
+procedure TJvCustomDBTreeView.HideEditor;
+begin
+ if Selected <> nil then
+ Selected.EndEdit(True);
+end;
+
+function TJvCustomDBTreeView.ValidDataSet: Boolean;
+begin
+ Result := Assigned(FDataLink) and FDataLink.Active and Assigned(FDataLink.DataSet) and FDataLink.DataSet.Active;
+end;
+
+procedure TJvCustomDBTreeView.LinkActive(Value: Boolean);
+
+ function AllFieldsValid: Boolean;
+ begin
+ Result := False;
+ if ValidDataSet then
+ begin
+ if (FMasterField = '') or (FDataLink.DataSet.FindField(FMasterField) = nil) then
+ begin
+ Warning(RsMasterFieldEmpty);
+ Exit;
+ end;
+ if (FDetailField = '') or (FDataLink.DataSet.FindField(FDetailField) = nil) then
+ begin
+ Warning(RsDetailFieldEmpty);
+ Exit;
+ end;
+ if (FItemField = '') or (FDataLink.DataSet.FindField(FItemField) = nil) then
+ begin
+ Warning(RsItemFieldEmpty);
+ Exit;
+ end;
+ { if (FDataLink.DataSet.FindField(FMasterField).DataType <> FDataLink.DataSet.FindField(FDetailField).DataType) then
+ begin
+ Warning(RsMasterDetailFieldError);
+ Exit;
+ end; }
+ if (FDataLink.DataSet.FindField(FItemField).DataType in
+ [ftBytes, ftVarBytes, ftBlob, ftGraphic, ftFmtMemo, ftParadoxOle, ftDBaseOle, ftTypedBinary]) then
+ begin
+ Warning(RsItemFieldError);
+ Exit;
+ end;
+ if (FIconField <> '') and not (FDataLink.DataSet.FindField(FIconField).DataType in
+ [ftSmallInt, ftInteger, ftWord]) then
+ begin
+ Warning(RsIconFieldError);
+ Exit;
+ end;
+ end;
+ Result := True;
+ end;
+begin
+ if not Value then
+ HideEditor;
+ if not AllFieldsValid then
+ Exit;
+ //if ( csDesigning in ComponentState ) then Exit;
+ if ValidDataSet then
+ begin
+ RefreshChild(nil);
+ OldRecCount := FDataLink.DataSet.RecordCount;
+ end
+ else
+ if FUpdateLock = 0 then
+ Items.Clear;
+end;
+
+procedure TJvCustomDBTreeView.UpdateLock;
+begin
+ Inc(FUpdateLock);
+end;
+
+procedure TJvCustomDBTreeView.UpdateUnLock(const AUpdateTree: Boolean);
+begin
+ if FUpdateLock > 0 then
+ Dec(FUpdateLock);
+ if (FUpdateLock = 0) then
+ if AUpdateTree then
+ UpdateTree
+ else
+ OldRecCount := FDataLink.DataSet.RecordCount;
+end;
+
+function TJvCustomDBTreeView.UpdateLocked: Boolean;
+begin
+ Result := FUpdateLock > 0;
+end;
+
+procedure TJvCustomDBTreeView.RefreshChild(ANode: TJvDBTreeNode);
+var
+ ParentValue: Variant;
+ BK: TBookmark;
+ OldFilter: string;
+ OldFiltered: Boolean;
+ PV: string;
+ I: Integer;
+
+ cNode: TTreeNode;
+ fbnString: string;
+ flt: String;
+begin
+// CheckDataSet;
+ if not ValidDataSet or UpdateLocked then
+ Exit;
+ Inc(FUpdateLock);
+ with FDataLink.DataSet do
+ begin
+ BK := GetBookmark;
+ try
+ DisableControls;
+ if ANode <> nil then
+ begin
+ ANode.DeleteChildren;
+ ParentValue := ANode.FMasterValue;
+ end
+ else
+ begin
+ Items.Clear;
+ ParentValue := FStartMasterValue;
+ end;
+ OldFiltered := False;
+ OldFilter := '';
+ if FUseFilter then
+ begin
+ if ParentValue = Null then
+ PV := 'Null'
+ else
+// PV := '''' + Var2Type(ParentValue, varString) + '''';
+ PV := Var2Type(ParentValue, varString);
+ OldFilter := Filter;
+ OldFiltered := Filtered;
+ if Filtered and (OldFilter <> '') then
+ flt := '(' + OldFilter + ') and '
+ else
+ flt := '';
+ flt := flt + '(' + FDetailField + '=' + PV + ')';
+ Filter := flt;
+ Filtered := True;
+ end;
+ try
+ First;
+ while not Eof do
+ begin
+ fbnString := FieldByName(FDetailField).AsString; // avoid overhead
+ if FUseFilter or
+ (((ParentValue = Null) and
+ ((fbnString = '') or
+ (Copy(Trim(fbnString), 1, 1) = '-'))) or
+ (FieldByName(FDetailField).Value = ParentValue)) then
+ begin
+ with Items.AddChild(ANode, FieldByName(FItemField).Text) as TJvDBTreeNode do
+ begin
+ FMasterValue := FieldValues[FMasterField];
+ if FIconField <> '' then
+ begin
+ I := Var2Type(FieldValues[FIconField], varInteger);
+ ImageIndex := I;
+ SelectedIndex := ImageIndex + FSelectedIndex;
+ end;
+ end;
+ end;
+ Next;
+ end;
+ finally
+ if FUseFilter then
+ begin
+ Filtered := OldFiltered;
+ Filter := OldFilter;
+ end;
+ end;
+ if ANode = nil then
+ begin
+ cNode := Items.GetFirstNode;
+ while Assigned(cNode) do
+ with TJvDBTreeNode(cNode) do
+ begin
+ HasChildren := Lookup(FDetailField, FMasterValue, FDetailField) <> Null;
+ cNode := cNode.GetNext;
+ end;
+ {
+ // Peter Zolja - inefficient code, faster code above
+ for I := 0 to Items.Count - 1 do
+ with Items[I] as TJvDBTreeNode do
+ HasChildren := Lookup(FDetailField, FMasterValue, FDetailField) <> Null
+ }
+ end
+ else
+ begin
+ cNode := ANode.getFirstChild;
+ while Assigned(cNode) do
+ with TJvDBTreeNode(cNode) do
+ begin
+ HasChildren := Lookup(FDetailField, FMasterValue, FDetailField) <> Null;
+ cNode := cNode.GetNext;
+ end;
+ {
+ // Peter Zolja - inefficient code, faster code above
+ for I := 0 to ANode.Count - 1 do
+ with ANode[I] as TJvDBTreeNode do
+ HasChildren := Lookup(FDetailField, FMasterValue, FDetailField) <> Null
+ }
+ end;
+ if ANode <> nil then
+ OldRecCount := RecordCount;
+ finally
+ try
+ GotoBookmark(BK);
+ FreeBookmark(BK);
+ EnableControls;
+ finally
+ Dec(FUpdateLock);
+ end;
+ end;
+ end;
+end;
+
+function TJvCustomDBTreeView.CanExpand(Node: TTreeNode): Boolean;
+begin
+ Result := inherited CanExpand(Node);
+ if Result and (Node.Count = 0) then
+ RefreshChild(Node as TJvDBTreeNode);
+end;
+
+procedure TJvCustomDBTreeView.Collapse(Node: TTreeNode);
+var
+ HasChildren: Boolean;
+begin
+ inherited Collapse(Node);
+ if not FPersistentNode then
+ begin
+ HasChildren := Node.HasChildren;
+ Node.DeleteChildren;
+ Node.HasChildren := HasChildren;
+ end;
+end;
+
+function TJvCustomDBTreeView.FindNode(AMasterValue: Variant): TJvDBTreeNode;
+var
+ I: Integer;
+begin
+ for I := 0 to Items.Count - 1 do
+ begin
+ Result := Items[I] as TJvDBTreeNode;
+ if Result.FMasterValue = AMasterValue then
+ Exit;
+ end;
+ Result := nil;
+end;
+
+function TJvCustomDBTreeView.SelectNode(AMasterValue: Variant): TTreeNode;
+var
+ V: Variant;
+ Node: TJvDBTreeNode;
+ Parents: Variant; {varArray}
+ I: Integer;
+
+ function DoGetDetailValue(const AMasterValue: Variant; var DetailValue: Variant): Boolean;
+ var
+ V: Variant;
+ begin
+ if Assigned(FGetDetailValue) then
+ begin
+ Result := FGetDetailValue(AMasterValue, DetailValue);
+ if DetailValue = FStartMasterValue then
+ raise EJvDBTreeViewError.CreateRes(@RsEErrorValueForDetailValue);
+ end
+ else
+ begin
+ V := FDataLink.DataSet.Lookup(FMasterField, AMasterValue, FMasterField + ';' + FDetailField);
+ Result := ((VarType(V) and varArray) = varArray) and (V[1] <> Null);
+ if Result then
+ begin
+ DetailValue := V[1];
+ if DetailValue = FStartMasterValue then
+ raise EJvDBTreeViewError.CreateRes(@RsEInternalError);
+ end;
+ end;
+ end;
+
+begin
+ Result := FindNode(AMasterValue);
+ if Result = nil then
+ try
+ // Inc(FUpdateLock);
+ Parents := VarArrayCreate([0, 0], varVariant);
+ V := AMasterValue;
+ I := 0;
+ repeat
+ if not DoGetDetailValue(V, V) then
+ Exit;
+ Node := FindNode(V);
+ if Node <> nil then
+ begin
+ { To open all branches from that found to the necessary [translated] }
+ //..
+ Node.Expand(False);
+ while I > 0 do
+ begin
+ FindNode(Parents[I]).Expand(False);
+ Dec(I);
+ end;
+ Result := FindNode(AMasterValue);
+ end
+ else
+ begin
+ { To add in the array of parents [translated] }
+ Inc(I);
+ VarArrayRedim(Parents, I);
+ Parents[I] := V;
+ end;
+ until Node <> nil;
+ finally
+ // Dec(FUpdateLock);
+ end;
+ if Result <> nil then
+ Result.Selected := True;
+end;
+
+procedure TJvCustomDBTreeView.UpdateTree;
+var
+ I: Integer;
+ BK: TBookmark;
+ AllChecked: Boolean;
+
+ procedure AddRecord;
+ var
+ Node, ParentNode: TJvDBTreeNode;
+ idx: Integer;
+ begin
+ { If the current record is absent from the tree, but it must be in it, then
+ add [translated] }
+ Node := FindNode(FDataLink.DataSet[FMasterField]);
+ if Node = nil then
+ begin
+ ParentNode := FindNode(FDataLink.DataSet[FDetailField]);
+ if (((ParentNode <> nil) and (not ParentNode.HasChildren or (ParentNode.Count <> 0))) or
+ (FDataLink.DataSet[FDetailField] = FStartMasterValue)) then
+ begin
+ if FDataLink.DataSet[FDetailField] = FStartMasterValue then
+ Node := nil
+ else
+ begin
+ Node := FindNode(FDataLink.DataSet[FDetailField]);
+ if (Node = nil) or (Node.HasChildren and (Node.Count = 0)) then
+ Exit;
+ end;
+ with FDataLink.DataSet, Items.AddChild(Node, FDataLink.DataSet.FieldByName(FItemField).Text) as TJvDBTreeNode do
+ begin
+ FMasterValue := FieldValues[FMasterField];
+ if FIconField <> '' then
+ begin
+ idx := Var2Type(FieldValues[FIconField], varInteger);
+ ImageIndex := idx;
+ SelectedIndex := ImageIndex + FSelectedIndex;
+ end;
+ HasChildren := Lookup(FDetailField, FMasterValue, FDetailField) <> Null
+ end;
+ end;
+ end;
+ end;
+
+begin
+ CheckDataSet;
+ if UpdateLocked or (InTreeUpdate) then
+ Exit;
+ InTreeUpdate := True;
+ Items.BeginUpdate;
+ try
+ with FDataLink.DataSet do
+ begin
+ BK := GetBookmark;
+ DisableControls;
+ try
+ {*** To delete from a tree the remote/removed records [translated] }
+ repeat
+ AllChecked := True;
+ for I := 0 to Items.Count - 1 do
+ if not Locate(FMasterField, (Items[I] as TJvDBTreeNode).FMasterValue, []) then
+ begin
+ Items[I].Free;
+ AllChecked := False;
+ Break;
+ end
+ else
+ Items[I].HasChildren := Lookup(FDetailField, (Items[I] as TJvDBTreeNode).FMasterValue, FDetailField) <>
+ Null;
+ until AllChecked;
+ {###}
+ {*** To add new [translated]}
+ First;
+ while not Eof do
+ begin
+ AddRecord;
+ Next;
+ end;
+ {###}
+ finally
+ GotoBookmark(BK);
+ FreeBookmark(BK);
+ EnableControls;
+ end;
+ OldRecCount := RecordCount;
+ end;
+ finally
+ Items.EndUpdate;
+ InTreeUpdate := False;
+ end;
+end;
+
+procedure TJvCustomDBTreeView.InternalDataChanged;
+begin
+ if not HandleAllocated or UpdateLocked or InDataScrolled then
+ Exit;
+// InDataScrolled := True;
+ try
+ DataChanged;
+ finally
+// InDataScrolled := False;
+ end;
+end;
+
+procedure TJvCustomDBTreeView.DataChanged;
+var
+ RecCount: Integer;
+begin
+ case FDataLink.DataSet.State of
+ dsBrowse:
+ begin
+ RecCount := FDataLink.DataSet.RecordCount;
+ if (RecCount = -1) or (RecCount <> OldRecCount) then
+ UpdateTree;
+ OldRecCount := RecCount;
+ end;
+ dsInsert:
+ OldRecCount := -1; { TQuery don't change RecordCount value after insert new record }
+ end;
+ Selected := FindNode(FDataLink.DataSet[FMasterField]);
+end;
+
+procedure TJvCustomDBTreeView.InternalDataScrolled;
+begin
+ if not HandleAllocated or UpdateLocked then
+ Exit;
+ InDataScrolled := True;
+ try
+ DataScrolled;
+ finally
+ InDataScrolled := False;
+ end;
+end;
+
+procedure TJvCustomDBTreeView.DataScrolled;
+begin
+ Selected := FindNode(FDataLink.DataSet[FMasterField]);
+end;
+
+procedure TJvCustomDBTreeView.Change(Node: TTreeNode);
+var
+ OldState: TDataSetState;
+begin
+ if ValidDataSet and Assigned(Node) and not InDataScrolled and
+ (FUpdateLock = 0) and
+ (FDataLink.DataSet.State in [dsBrowse, dsEdit, dsInsert]) then
+ begin
+ OldState := FDataLink.DataSet.State;
+ Inc(FUpdateLock);
+ try
+ Change2(Node);
+ finally
+ Dec(FUpdateLock);
+ end;
+ case OldState of
+ dsEdit:
+ FDataLink.DataSet.Edit;
+ dsInsert:
+ FDataLink.DataSet.Insert;
+ end;
+ end;
+ inherited Change(Node);
+end;
+
+procedure TJvCustomDBTreeView.Change2(Node: TTreeNode);
+begin
+ if Node <> nil then
+ begin
+ if VarIsEmpty((Node as TJvDBTreeNode).FMasterValue) then
+ Exit;
+ FDataLink.DataSet.Locate(FMasterField, TJvDBTreeNode(Node).FMasterValue, []);
+ if TJvDBTreeNode(Node).FMasterValue = Null then
+ TJvDBTreeNode(Node).SetMasterValue(FDataLink.DataSet.FieldByName(MasterField).AsVariant);
+ end;
+end;
+
+procedure TJvCustomDBTreeView.InternalRecordChanged(Field: TField);
+begin
+ if not (HandleAllocated and ValidDataSet) then
+ Exit;
+ if (Selected <> nil) and (FUpdateLock = 0) and
+ (FDataLink.DataSet.State = dsEdit) then
+ begin
+ Inc(FUpdateLock);
+ try
+ RecordChanged(Field);
+ finally
+ Dec(FUpdateLock);
+ end;
+ end;
+end;
+
+procedure TJvCustomDBTreeView.RecordChanged(Field: TField);
+var
+ Node: TJvDBTreeNode;
+ idx: Integer;
+begin
+ Selected.Text := FDataLink.DataSet.FieldByName(FItemField).Text;
+ with Selected as TJvDBTreeNode do
+ if FIconField <> '' then
+ begin
+ idx := Var2Type(FDataLink.DataSet[FIconField], varInteger);
+ ImageIndex := idx;
+ SelectedIndex := ImageIndex + FSelectedIndex;
+ end;
+ {*** ParentNode changed ?}
+ if ((Selected.Parent <> nil) and
+ (FDataLink.DataSet[FDetailField] <> (Selected.Parent as TJvDBTreeNode).FMasterValue)) or
+ ((Selected.Parent = nil) and
+ (FDataLink.DataSet[FDetailField] <> FStartMasterValue)) then
+ begin
+ Node := FindNode(FDataLink.DataSet[FDetailField]);
+ if (FDataLink.DataSet[FDetailField] = FStartMasterValue) or (Node <> nil) then
+ (Selected as TJvDBTreeNode).MoveTo(Node, naAddChild)
+ else
+ Selected.Free;
+ end;
+ {###}
+ {*** MasterValue changed ?}
+ if (FDataLink.DataSet[FMasterField] <> (Selected as TJvDBTreeNode).FMasterValue) then
+ begin
+ with (Selected as TJvDBTreeNode) do
+ begin
+ FMasterValue := FDataLink.DataSet[FMasterField];
+ if FIconField <> '' then
+ begin
+ idx := Var2Type(FDataLink.DataSet[FIconField], varInteger);
+ ImageIndex := idx;
+ SelectedIndex := ImageIndex + FSelectedIndex;
+ end;
+ end;
+ {what have I do with Children ?}
+ {if you know, place your code here...}
+ end;
+ {###}
+end;
+
+function TJvCustomDBTreeView.CanEdit(Node: TTreeNode): Boolean;
+begin
+ Result := inherited CanEdit(Node);
+ if FDataLink.DataSet <> nil then
+ Result := Result and not FDataLink.ReadOnly and not ReadOnly;
+end;
+
+{ wp -- removed
+procedure TJvCustomDBTreeView.Edit(const Item: TTVItem);
+begin
+ CheckDataSet;
+ inherited Edit(Item);
+ if Assigned(Selected) then
+ begin
+ Inc(FUpdateLock);
+ try
+ if Item.pszText <> nil then
+ begin
+ if FDataLink.Edit then
+ FDataLink.DataSet.FieldByName(FItemField).Text := Item.pszText;
+ try
+ FDataLink.DataSet.Post;
+ Change2(Self.Selected); {?}
+ except
+ on E: Exception do
+ begin
+ DataLink.DataSet.Cancel;
+ if InAddChild then
+ begin
+ Self.Selected.Free;
+ if Sel <> nil then
+ Selected := Sel;
+ end;
+ raise;
+ end;
+ end;
+ end
+ else
+ begin
+ FDataLink.DataSet.Cancel;
+ if InAddChild then
+ begin
+ Self.Selected.Free;
+ if Sel <> nil then
+ Selected := Sel;
+ end;
+ end;
+ finally
+ InAddChild := False;
+ Dec(FUpdateLock);
+ end;
+ end;
+end;
+}
+
+function TJvCustomDBTreeView.AddChildNode(const Node: TTreeNode; const ASelect: Boolean): TJvDBTreeNode;
+var
+ MV, MField: Variant;
+ M: string;
+ iIndex: Integer;
+begin
+ iIndex := 1;
+ CheckDataSet;
+ if Assigned(Node) then
+ begin
+ MV := (Node as TJvDBTreeNode).FMasterValue;
+ MField := FDataLink.DataSet.RecordCount + 1;
+ repeat
+ MField := MField + 1;
+ until FDataLink.DataSet.Lookup(FMasterField, MField, FMasterField) = Null;
+ end
+ else
+ begin
+ MV := FStartMasterValue;
+ MField := FStartMasterValue + 1;
+ end;
+ if Assigned(Node) and Node.HasChildren and (Node.Count = 0) then
+ RefreshChild(Node as TJvDBTreeNode);
+ Inc(FUpdateLock);
+ InAddChild := True;
+ try
+ OldRecCount := FDataLink.DataSet.RecordCount + 1;
+ if FIconField <> '' then
+ begin
+ iIndex := Var2Type(FDataLink.DataSet[FIconField], varInteger);
+ end;
+
+ FDataLink.DataSet.Append;
+ FDataLink.DataSet[FDetailField] := MV;
+ FDataLink.DataSet[FMasterField] := MField;
+ if FDataLink.DataSet.FieldValues[FItemField] = Null then
+ M := ''
+ else
+ M := FDataLink.DataSet.FieldByName(FItemField).Text;
+ Result := Items.AddChild(Node, M) as TJvDBTreeNode;
+ with Result do
+ begin
+ FMasterValue := FDataLink.DataSet.FieldValues[FMasterField];
+ if FIconField <> '' then
+ begin
+ ImageIndex := iIndex;
+ SelectedIndex := ImageIndex + FSelectedIndex;
+ FDataLink.DataSet[FIconField] := ImageIndex;
+ end;
+ end;
+ Result.Selected := ASelect;
+ { This line is very necessary, well it(he) does not understand from the first [translated]}
+ Result.Selected := ASelect;
+ finally
+ Dec(FUpdateLock);
+ end;
+end;
+
+procedure TJvCustomDBTreeView.DeleteNode(Node: TTreeNode);
+var
+ NewSel: TTreeNode;
+ NewMV: Variant;
+ MV: Integer;
+begin
+ MV := 0;
+ CheckDataSet;
+ Inc(FUpdateLock);
+ InDelete := True;
+ try
+ NewSel := FindNextNode(Selected);
+
+ if NewSel = nil then
+ begin
+ NewSel := Items.GetFirstNode;
+ if NewSel = Selected then
+ NewSel := nil;
+ end;
+
+ if NewSel <> nil then
+ begin
+ NewMV := TJvDBTreeNode(NewSel).FMasterValue;
+ MV := NewMV;
+ end;
+
+ DeleteChildren(Node);
+ // Selected.Free; // removes selected node, why?
+
+ NewSel := FindNode(MV);
+ if NewSel <> nil then
+ begin
+ NewSel.Selected := True;
+ Change2(NewSel);
+ end;
+
+ finally
+ InDelete := False;
+ Dec(FUpdateLock);
+ end;
+end;
+
+function TJvCustomDBTreeView.DeleteChildren(ParentNode: TTreeNode): Boolean;
+var
+ ChildNode: TTreeNode;
+begin
+ CheckDataSet;
+ Inc(FUpdateLock);
+ InDelete := True;
+ try
+ with ParentNode as TJvDBTreeNode do
+ begin
+ while ParentNode.HasChildren do
+ begin
+ ChildNode := ParentNode.GetNext;
+ // (rom) make it compile, but no idea if it is correct
+ Self.DeleteChildren(ChildNode);
+ end;
+
+ if FDataLink.DataSet.Locate(FMasterField, TJvDBTreeNode(ParentNode).FMasterValue, []) then
+ begin
+ FDataLink.DataSet.Delete;
+ end;
+ ParentNode.Delete;
+ end;
+
+ finally
+ InDelete := False;
+ Dec(FUpdateLock);
+ Result := true;
+ end;
+end;
+
+function TJvCustomDBTreeView.FindNextNode(const Node: TTreeNode): TTreeNode;
+begin
+ if Node <> nil then
+ begin
+ if Node.Parent <> nil then
+ if Node.Parent.Count > 1 then
+ if Node.Index = Node.Parent.Count - 1 then
+ Result := Node.Parent[Node.Index - 1]
+ else
+ Result := Node.Parent[Node.Index + 1]
+ else
+ Result := Node.Parent
+ else
+ if Items.Count > 1 then
+ if Node.Index = Items.Count - 1 then
+ Result := Items[Node.Index - 1]
+ else
+ Result := Items[Node.Index + 1]
+ else
+ Result := nil;
+ end
+ else
+ Result := nil;
+end;
+
+procedure TJvCustomDBTreeView.MoveTo(Source, Destination: TJvDBTreeNode; Mode: TNodeAttachMode);
+var
+ MV, V: Variant;
+begin
+ CheckDataSet;
+ if FUpdateLock = 0 then
+ begin
+ Inc(FUpdateLock);
+ try
+ MV := Source.FMasterValue;
+ if FDataLink.DataSet.Locate(FMasterField, MV, []) and FDataLink.Edit then
+ begin
+ case Mode of
+ naAdd:
+ if Destination.Parent <> nil then
+ V := (Destination.Parent as TJvDBTreeNode).FMasterValue
+ else
+ V := FStartMasterValue;
+ naAddChild:
+ V := Destination.FMasterValue;
+ else
+ raise EJvDBTreeViewError.CreateRes(@RsEMoveToModeError);
+ end;
+ FDataLink.DataSet[FDetailField] := V;
+ end;
+ finally
+ Dec(FUpdateLock);
+ end;
+ end;
+end;
+
+{******************* Drag'n'Drop ********************}
+
+procedure TJvCustomDBTreeView.TimerDnDTimer(Sender: TObject);
+begin
+ if YDragPos < DnDScrollArea then
+ Perform(WM_VSCROLL, SB_LINEUP, 0)
+ else
+ if YDragPos > ClientHeight - DnDScrollArea then
+ Perform(WM_VSCROLL, SB_LINEDOWN, 0);
+end;
+
+procedure TJvCustomDBTreeView.DragOver(Source: TObject; X, Y: Integer;
+ State: TDragState; var Accept: Boolean);
+var
+ Node: TTreeNode;
+ HT: THitTests;
+begin
+ inherited DragOver(Source, X, Y, State, Accept);
+
+ if ValidDataSet and (DragMode = dmAutomatic) and not FDataLink.ReadOnly and
+ not ReadOnly then
+ begin
+ HT := GetHitTestInfoAt(X, Y);
+ Node := GetNodeAt(X, Y);
+
+ { Mantis #4815: Do not allow drag over if the user callback said no; see TControl.DragOver impl. }
+ if not Assigned(OnDragOver) then
+ Accept := True;
+
+ Accept := Accept and
+ (Source = Self) and Assigned(Selected) and
+ (Node <> Selected) and Assigned(Node) and
+ not Node.HasAsParent(Selected) and
+ (HT - [htOnLabel, htOnItem, htOnIcon, htNowhere, htOnIndent, htOnButton] <> HT);
+ YDragPos := Y;
+ TimerDnD.Enabled := ((Y < DnDScrollArea) or (Y > ClientHeight - DnDScrollArea));
+ end;
+end;
+
+procedure TJvCustomDBTreeView.DragDrop(Source: TObject; X, Y: Integer);
+var
+ AnItem: TTreeNode;
+ AttachMode: TNodeAttachMode;
+ HT: THitTests;
+begin
+ TimerDnD.Enabled := False;
+ inherited DragDrop(Source, X, Y);
+ if Source is TJvCustomDBTreeView then
+ begin
+ AnItem := GetNodeAt(X, Y);
+ if ValidDataSet and (DragMode = dmAutomatic) and Assigned(Selected) and Assigned(AnItem) then
+ begin
+ HT := GetHitTestInfoAt(X, Y);
+ if (HT - [htOnItem, htOnLabel, htOnIcon, htNowhere, htOnIndent, htOnButton] <> HT) then
+ begin
+ if (HT - [htOnItem, htOnLabel, htOnIcon] <> HT) then
+ AttachMode := naAddChild
+ else
+ AttachMode := naAdd;
+ (Selected as TJvDBTreeNode).MoveTo(AnItem, AttachMode);
+ end;
+ end;
+ end;
+{
+var
+ AnItem: TTreeNode;
+ AttachMode: TNodeAttachMode;
+ HT: THitTests;
+begin
+ if TreeView1.Selected = nil then
+ Exit;
+ HT := TreeView1.GetHitTestInfoAt(X, Y);
+ AnItem := TreeView1.GetNodeAt(X, Y);
+ if (HT - [htOnItem, htOnIcon, htNowhere, htOnIndent] <> HT) then
+ begin
+ if (htOnItem in HT) or (htOnIcon in HT) then
+ AttachMode := naAddChild
+ else
+ if htNowhere in HT then
+ AttachMode := naAdd
+ else
+ if htOnIndent in HT then
+ AttachMode := naInsert;
+ TreeView1.Selected.MoveTo(AnItem, AttachMode);
+ end;
+end;
+ }
+end;
+
+{################### Drag'n'Drop ####################}
+
+procedure TJvCustomDBTreeView.KeyDown(var Key: Word; Shift: TShiftState);
+
+ procedure DeleteSelected;
+ var
+ M: string;
+ begin
+ if Selected.HasChildren then
+ M := RsDeleteNode2
+ else
+ M := RsDeleteNode;
+ if MessageDlg(Format(M, [Selected.Text]), mtConfirmation, [mbYes, mbNo], 0) = mrYes then
+ DeleteNode(Selected);
+ end;
+
+begin
+ inherited KeyDown(Key, Shift);
+ if not ValidDataSet or (FDataLink.ReadOnly) or ReadOnly then
+ Exit;
+ case Key of
+ VK_DELETE:
+ if ([ssCtrl] = Shift) and Assigned(Selected) then
+ DeleteSelected;
+ VK_INSERT:
+ if not IsEditing then
+ begin
+ Sel := Selected;
+ if not Assigned(Selected) or ([ssAlt] = Shift) then
+ //AddChild
+ AddChildNode(Selected, True).EditText
+ else
+ //Add
+ AddChildNode(Selected.Parent, True).EditText;
+ end;
+ VK_F2:
+ if Selected <> nil then
+ Selected.EditText;
+ end;
+end;
+
+{ wp --- removed
+procedure TJvCustomDBTreeView.SetMirror(Value: Boolean);
+begin
+ if Value and SysLocale.MiddleEast and not (csDesigning in ComponentState) then
+ MirrorControl(Self, Value);
+ FMirror := Value;
+end;
+}
+
+// Note about the code in CreateWnd/DestroyWnd: When docking/undocking a form
+// containing a DBTreeView, or even when showing/hiding such a form, the tree
+// is emptied then refilled. But this makes it lose all it's master values
+// The initial solution was to close then reopen the dataset, but this is
+// ungraceful and was replaced by the code below, proposed in issue 3256.
+procedure TJvCustomDBTreeView.CreateWnd;
+var
+ Node: TTreeNode;
+ temp: string;
+ strLength: Integer;
+ HasChildren: Byte;
+begin
+ inherited CreateWnd;
+ // tree is restored. Now we must restore information about Master Values
+ if Assigned(FMastersStream) and (Items.Count > 0) then
+ begin
+ Node := Items.GetFirstNode;
+ FMastersStream.Position := 0;
+ while Assigned(Node) do
+ begin
+ FMastersStream.Read(strLength, SizeOf(strLength));
+ SetLength(temp, strLength);
+ if strLength > 0 then
+ FMastersStream.Read(temp[1], strLength * SizeOf(Char)); // internally used stream
+ TJvDBTreeNode(Node).SetMasterValue(temp);
+ FMastersStream.Read(HasChildren, SizeOf(HasChildren));
+ Node.HasChildren := HasChildren <> 0;
+ Node := Node.GetNext;
+ end;
+ // nil is required, for the destructor not to try to destroy an already
+ // destroyed object;
+ FreeAndNil(FMastersStream);
+ end;
+end;
+
+procedure TJvCustomDBTreeView.DestroyWnd;
+var
+ Node: TTreeNode;
+ temp: string;
+ strLength: Integer;
+ HasChildren: Byte;
+begin
+ if Items.Count > 0 then
+ begin
+ // save master values into stream
+ FMastersStream := TMemoryStream.Create;
+ Node := Items.GetFirstNode;
+ while Assigned(Node) do
+ begin
+ // save MasterValue as string
+ temp := VarToStr(TJvDBTreeNode(Node).MasterValue);
+ strLength := Length(temp);
+ FMastersStream.Write(strLength, SizeOf(strLength));
+ if strLength > 0 then
+ FMastersStream.Write(temp[1], strLength * SizeOf(Char)); // internally used stream
+ HasChildren := Byte(Node.HasChildren);
+ FMastersStream.Write(HasChildren, SizeOf(HasChildren));
+ Node := Node.GetNext;
+ end;
+ end;
+ inherited DestroyWnd;
+end;
+
+
+end.