From 0bd361c6e9136edff02f4476f4a247c19c36f38e Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Sat, 27 Apr 2019 17:15:09 +0000 Subject: [PATCH] jvcllaz: Add new component TDBLookupTreeView with demo. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6870 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/jvcllaz/design/JvDB/JvDBReg.pas | 22 +- .../jvcllaz/design/JvDB/images/images.txt | 3 + .../design/JvDB/images/tjvdblookupcombo.bmp | Bin 0 -> 1654 bytes .../design/JvDB/images/tjvdblookuplist.bmp | Bin 0 -> 1654 bytes .../JvDB/images/tjvdblookuptreeview.bmp | Bin 0 -> 1654 bytes .../JvDBLookupTreeViewDemo.lpi | 73 + .../JvDBLookupTreeViewDemo.lpr | 22 + .../examples/JvDBLookupTreeView/main.lfm | 176 ++ .../examples/JvDBLookupTreeView/main.pas | 111 ++ .../jvcllaz/examples/JvDBTreeView/main.lfm | 2 +- .../jvcllaz/examples/JvDBTreeView/main.pas | 8 + components/jvcllaz/packages/JvDBLazR.lpk | 10 +- components/jvcllaz/packages/jvmmlazr.lpk | 2 +- components/jvcllaz/resource/jvdbreg.res | Bin 12060 -> 13768 bytes components/jvcllaz/run/JvCore/JvJCLUtils.pas | 15 +- components/jvcllaz/run/JvCore/JvTypes.pas | 2 +- components/jvcllaz/run/JvDB/JvDBTreeView.pas | 16 +- components/jvcllaz/run/JvDB/jvdbconst.pas | 17 + .../jvcllaz/run/JvDB/jvdblookuptreeview.pas | 1753 +++++++++++++++++ components/jvcllaz/run/JvDB/jvdbutils.pas | 12 + 20 files changed, 2228 insertions(+), 16 deletions(-) create mode 100644 components/jvcllaz/design/JvDB/images/tjvdblookupcombo.bmp create mode 100644 components/jvcllaz/design/JvDB/images/tjvdblookuplist.bmp create mode 100644 components/jvcllaz/design/JvDB/images/tjvdblookuptreeview.bmp create mode 100644 components/jvcllaz/examples/JvDBLookupTreeView/JvDBLookupTreeViewDemo.lpi create mode 100644 components/jvcllaz/examples/JvDBLookupTreeView/JvDBLookupTreeViewDemo.lpr create mode 100644 components/jvcllaz/examples/JvDBLookupTreeView/main.lfm create mode 100644 components/jvcllaz/examples/JvDBLookupTreeView/main.pas create mode 100644 components/jvcllaz/run/JvDB/jvdbconst.pas create mode 100644 components/jvcllaz/run/JvDB/jvdblookuptreeview.pas diff --git a/components/jvcllaz/design/JvDB/JvDBReg.pas b/components/jvcllaz/design/JvDB/JvDBReg.pas index 77dd2f504..050e5875a 100644 --- a/components/jvcllaz/design/JvDB/JvDBReg.pas +++ b/components/jvcllaz/design/JvDB/JvDBReg.pas @@ -16,13 +16,13 @@ implementation uses Classes, JvDsgnConsts, //JvDBSearchCombobox, - JvDBSearchEdit, JvDBTreeView, JvDBControls, JvDBHTLabel, JvDBLookup; + JvDBSearchEdit, JvDBTreeView, JvDBControls, JvDBHTLabel, JvDBLookup, JvDBLookupTreeView; procedure Register; const // cDataField = 'DataField'; -// cKeyField = 'KeyField'; -// cListField = 'ListField'; + cKeyField = 'KeyField'; + cListField = 'ListField'; // cDisplayField = 'DisplayField'; // cListKeyField = 'ListKeyField'; cMasterField = 'MasterField'; @@ -43,13 +43,19 @@ begin // TJvDBSearchCombobox, TJvDBTreeView, TJvDBHTLabel, - TJvDBLookupList, TJvDBLookupCombo + TJvDBLookupList, TJvDBLookupCombo, TJvDBLookupTreeView ]); - 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); + RegisterPropertyEditor(TypeInfo(string), TJvDBTreeView, cItemField, TFieldProperty); + RegisterPropertyEditor(TypeInfo(string), TJvDBTreeView, cMasterField, TFieldProperty); + RegisterPropertyEditor(TypeInfo(string), TJvDBTreeView, cDetailField, TFieldProperty); + RegisterPropertyEditor(TypeInfo(string), TJvDBTreeView, cIconField, TFieldProperty); + + RegisterPropertyEditor(TypeInfo(string), TJvDBLookupTreeView, cKeyField, TLookupFieldProperty); + RegisterPropertyEditor(TypeInfo(string), TJvDBLookupTreeView, cListField, TLookupFieldProperty); + RegisterPropertyEditor(TypeInfo(string), TJvDBLookupTreeView, cMasterField, TLookupFieldProperty); + RegisterPropertyEditor(TypeInfo(string), TJvDBLookupTreeView, cDetailField, TLookupFieldProperty); + RegisterPropertyEditor(TypeInfo(string), TJvDBLookupTreeView, cIconField, TLookupFieldProperty); end; end. diff --git a/components/jvcllaz/design/JvDB/images/images.txt b/components/jvcllaz/design/JvDB/images/images.txt index 0b2a1a335..dadeb1347 100644 --- a/components/jvcllaz/design/JvDB/images/images.txt +++ b/components/jvcllaz/design/JvDB/images/images.txt @@ -3,3 +3,6 @@ tjvdbhtlabel.bmp tjvdbsearchcombobox.bmp tjvdbsearchedit.bmp tjvdbtreeview.bmp +tjvdblookuptreeview.bmp +tjvdblookuplist.bmp +tjvdblookupcombo.bmp \ No newline at end of file diff --git a/components/jvcllaz/design/JvDB/images/tjvdblookupcombo.bmp b/components/jvcllaz/design/JvDB/images/tjvdblookupcombo.bmp new file mode 100644 index 0000000000000000000000000000000000000000..0ea461940340832bb4ec9e39f9ce5d87a090080b GIT binary patch literal 1654 zcmYk)L2}zL3_wx1|C9i*fi>Sdt zhb9UwVgdyh<_IJTE#d-&fj=Hd6ndXmi3Ud?QD_k^B^3roAW>)@QlKz60*OM4a7rr- zjzFT&V!~sJVjPY@qR{KrREY*hAW`V`+NMN&8XSQ{ zq1PvMB^n%oM4{K`W|9blBakTc+6t*egCmeA^x7t+M1v!cDD>Py(MmKp0*OLP@%|+W zgCmd_N3X4=N;EhEi9)Y!XG%0U0*OMeE$K=$I0A`6uk9L2G&ll@La(iyN;EhEi9)Y! zUP?4L0x7R=7kOb^P*3DCPq|#i6*xwUpFhtZ+SAk1`@?G2EW>9b|Mo`LEzixPy+4rU z-1ZK+9A~@b={V9iCL3+mALF;}`AEloJjGXj-2W`A%<(?{xXtm$4|TX@+sHG=ZT$Oc zBR}T2)~6gd%F~|TuFtcoUGuVC-*=B|yd31T296r1(@CCZ9XY(nX@AhMsQ3Kn*zaJb zJufeZ!{N-Rd!x>_QSop-pM}R=jdfY+%Z2>CW9At>DpP|oV`=9Ck0LWW3bInO)L7q@ ko>|hXam#!>Ij{T}zfb>56425ARBS$$xN|ZT4TzQ2_pF7|bsc{q(o}2?+W^#rUJVM$X&sh0MYS#{> zZy`U?q(t%C_a7f+w6Ckk7p^{^7Wp)C`!LG9DzikiEv6& z7#x8_p@|8PDT;nL0*OMKuck^hI0A`6o3Cw3H8=u^LYqtCN;NnFi9(yp6-qTY0*OMK zOPNYFI0A`6o6B5EH8=u^LK~mJnofSZe{)Aa5``wA0)@d5NEF)qY^GF$ zBakSx`AJ==21g)KX!CP3Nrb@>NEF)K3aM0sBakSxxlKx`21g)KXk!aSQ>wucNEDhB z?_Z)YI0A`&w7IoZsRl(t9@Ymltl`a{hO; z*9TJ0ecq5`o$a1;W4&DZTxWj<>HYWpvaaN_`!VL7c~4}<>-v_jd+)!#ABUm#oqQ)h z+w0kSPP>oKt8UvSPxt&B=l@)`Y<2C^o zXD-jnvRvu)*67beZrgIbUWFwYjrHm|@o|vfZ_IqeOegf;d(_wWGJBKu0a>X&RL^Jc knG%miOx_>)I(m=(=j4w(?mZqaId42Zo6ov?= z428iFNEC*c@S38Sha-?EjGme*(clOq3ZtiON;EhEiNfe5aU~iYfka{Sa)lBNjzFR? zdMQ(h21g)K7`@D;M1v!cD2(+9Y$(y-2qX$ag87Fi=FA=QNEC*I3KRxMAW<0o*-VKB zM<7uc{YhPk21g)K82!0+wJ9Zw@3D*d^PgV&)j;=^WW>* zw(aFJS<>0QMXl3e3##jRe!GGJI_$Z zLH=MI{;}#`y3IUo<>#w1)qUUP_C7!B-}1A3*7x{xeQ39X-?P1r|ERwo=iYOg{c0@g zF63t=-sP{A@A@8X_G|pE-}j4y{yJa3#$$Z)tF1ii__2PU_1j$E*Z29qelAw$-<~+H inDb2EpXU4X$o1TPKWBaCKi1FnTKT7^wLl*_Zu|yd!$Ow; literal 0 HcmV?d00001 diff --git a/components/jvcllaz/examples/JvDBLookupTreeView/JvDBLookupTreeViewDemo.lpi b/components/jvcllaz/examples/JvDBLookupTreeView/JvDBLookupTreeViewDemo.lpi new file mode 100644 index 000000000..450aaaec9 --- /dev/null +++ b/components/jvcllaz/examples/JvDBLookupTreeView/JvDBLookupTreeViewDemo.lpi @@ -0,0 +1,73 @@ + + + + + + + + + + + + <Scaled Value="True"/> + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + <XPManifest> + <DpiAware Value="True"/> + </XPManifest> + <Icon Value="0"/> + </General> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <FormatVersion Value="2"/> + <Modes Count="0"/> + </RunParams> + <RequiredPackages Count="3"> + <Item1> + <PackageName Value="JvDBLazR"/> + </Item1> + <Item2> + <PackageName Value="FCL"/> + </Item2> + <Item3> + <PackageName Value="LCL"/> + </Item3> + </RequiredPackages> + <Units Count="2"> + <Unit0> + <Filename Value="JvDBLookupTreeViewDemo.lpr"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="main.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="Form1"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="..\..\bin\JvDBLookupTreeViewDemo"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Linking> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + </CompilerOptions> +</CONFIG> diff --git a/components/jvcllaz/examples/JvDBLookupTreeView/JvDBLookupTreeViewDemo.lpr b/components/jvcllaz/examples/JvDBLookupTreeView/JvDBLookupTreeViewDemo.lpr new file mode 100644 index 000000000..c9dfea52f --- /dev/null +++ b/components/jvcllaz/examples/JvDBLookupTreeView/JvDBLookupTreeViewDemo.lpr @@ -0,0 +1,22 @@ +program JvDBLookupTreeViewDemo; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Interfaces, // this includes the LCL widgetset + Forms, main + { you can add units after this }; + +{$R *.res} + +begin + RequireDerivedFormResource := True; + Application.Scaled := True; + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. + diff --git a/components/jvcllaz/examples/JvDBLookupTreeView/main.lfm b/components/jvcllaz/examples/JvDBLookupTreeView/main.lfm new file mode 100644 index 000000000..fafd77bb7 --- /dev/null +++ b/components/jvcllaz/examples/JvDBLookupTreeView/main.lfm @@ -0,0 +1,176 @@ +object Form1: TForm1 + Left = 374 + Height = 477 + Top = 164 + Width = 594 + Caption = 'JvDBLookup controls' + ClientHeight = 477 + ClientWidth = 594 + OnShow = FormShow + LCLVersion = '2.1.0.0' + object JvDBLookupTreeView1: TJvDBLookupTreeView + AnchorSideLeft.Control = Bevel1 + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 307 + Height = 349 + Top = 112 + Width = 271 + BorderSpacing.Right = 16 + BorderSpacing.Bottom = 16 + DataField = 'ID' + DataSource = DSPersons + KeyField = 'RelID' + ListField = 'RelName' + ListSource = DSRelationships + TabOrder = 0 + Anchors = [akTop, akLeft, akRight, akBottom] + MasterField = 'RelID' + DetailField = 'RelParentID' + StartMasterValue = '0' + Indent = 15 + end + object Label2: TLabel + AnchorSideTop.Control = DBNavigator1 + AnchorSideTop.Side = asrBottom + Left = 16 + Height = 15 + Top = 92 + Width = 39 + BorderSpacing.Top = 16 + Caption = 'Person:' + ParentColor = False + end + object DBNavigator1: TDBNavigator + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrBottom + Left = 16 + Height = 26 + Top = 50 + Width = 241 + BevelOuter = bvNone + BorderSpacing.Left = 16 + BorderSpacing.Top = 16 + ChildSizing.EnlargeHorizontal = crsScaleChilds + ChildSizing.EnlargeVertical = crsScaleChilds + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 100 + ClientHeight = 26 + ClientWidth = 241 + DataSource = DSPersons + Options = [] + TabOrder = 1 + end + object Label3: TLabel + AnchorSideLeft.Control = Bevel1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label2 + Left = 307 + Height = 15 + Top = 92 + Width = 146 + Caption = 'Relationship to protagonist:' + ParentColor = False + end + object Panel1: TPanel + Left = 0 + Height = 34 + Top = 0 + Width = 594 + Align = alTop + Caption = '(Some) persons in the novel "The Grapes of Wrath" by John Steinbeck' + Color = clBackground + Font.Color = clHighlightText + Font.Height = -16 + Font.Style = [fsBold] + ParentColor = False + ParentFont = False + TabOrder = 2 + end + object DBGrid1: TDBGrid + AnchorSideLeft.Control = DBNavigator1 + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Bevel1 + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 16 + Height = 350 + Top = 111 + Width = 271 + Anchors = [akTop, akLeft, akRight, akBottom] + AutoFillColumns = True + BorderSpacing.Top = 4 + BorderSpacing.Bottom = 16 + Color = clWindow + Columns = < + item + Title.Caption = 'Name' + Width = 238 + FieldName = 'Name' + end> + DataSource = DSPersons + TabOrder = 3 + OnPrepareCanvas = DBGrid1PrepareCanvas + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + Left = 287 + Height = 50 + Top = 78 + Width = 20 + Shape = bsSpacer + end + object Persons: TBufDataset + FieldDefs = < + item + Name = 'ID' + DataType = ftInteger + end + item + Name = 'Name' + DataType = ftString + Size = 30 + end> + left = 80 + top = 160 + end + object Relationships: TBufDataset + FieldDefs = < + item + Name = 'RelID' + DataType = ftInteger + end + item + Name = 'RelName' + DataType = ftString + Size = 30 + end + item + Name = 'RelParentID' + DataType = ftString + Size = 16 + end> + left = 424 + top = 160 + end + object DSPersons: TDataSource + AutoEdit = False + DataSet = Persons + left = 80 + top = 224 + end + object DSRelationships: TDataSource + AutoEdit = False + DataSet = Relationships + left = 424 + top = 224 + end +end diff --git a/components/jvcllaz/examples/JvDBLookupTreeView/main.pas b/components/jvcllaz/examples/JvDBLookupTreeView/main.pas new file mode 100644 index 000000000..6cd405d4d --- /dev/null +++ b/components/jvcllaz/examples/JvDBLookupTreeView/main.pas @@ -0,0 +1,111 @@ +unit main; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, BufDataset, DB, Forms, Controls, Graphics, Dialogs, + DBGrids, JvDBLookup, JvDBLookupTreeView, JvDBTreeView, ExtCtrls, DBCtrls, + StdCtrls, Grids; + +type + + { TForm1 } + + TForm1 = class(TForm) + Bevel1: TBevel; + DBGrid1: TDBGrid; + DBNavigator1: TDBNavigator; + Label2: TLabel; + Label3: TLabel; + Panel1: TPanel; + JvDBLookupTreeView1: TJvDBLookupTreeView; + Persons: TBufDataset; + Relationships: TBufDataset; + DSPersons: TDataSource; + DSRelationships: TDataSource; + procedure DBGrid1PrepareCanvas(sender: TObject; DataCol: Integer; + Column: TColumn; AState: TGridDrawState); + procedure FormShow(Sender: TObject); + private + + public + Image: TImage; + end; + +var + Form1: TForm1; + +implementation + +{$R *.lfm} + +{ TForm1 } + +{ Assignment of table fields to lookup tree + + Table "Persons" --> Master table + Table "Relationships" --> Lookup table + + Establish the tree for lookup table: + DSRelationships --> LookupTreeView.ListSource + Field "RelID" --> LookuptreeView.MasterField + Field "RelParentID" --> LookupTreeView.DetailField + Field "RelName" --> LookupTreeView.ListField // Node text + + Establish lookup connection: + DSPersons --> LookupTreeView.Datasource + Field "ID" --> LookupTreeView.DataField + Field "RelID" --> LookupTreeView.KeyField +} +procedure TForm1.FormShow(Sender: TObject); +begin + Relationships.CreateDataset; + Relationships.Open; + Relationships.AppendRecord([ 1, 'Grandparents', 0]); + Relationships.AppendRecord([10, 'Parents', 1]); + Relationships.AppendRecord([11, 'Uncle', 1]); + Relationships.AppendRecord([12, 'Aunt', 1]); + Relationships.AppendRecord([20, 'Protagonist', 10]); + Relationships.AppendRecord([21, 'Brother', 10]); + Relationships.AppendRecord([22, 'Sister', 10]); + Relationships.AppendRecord([23, 'Brother-in-law', 21]); + Relationships.AppendRecord([24, 'Brother-in-law', 22]); + Relationships.AppendRecord([25, 'Sister-in-law', 21]); + Relationships.AppendRecord([26, 'Sister-in-law', 22]); + Relationships.AppendRecord([30, 'Son', 20]); + Relationships.AppendRecord([31, 'Daughter', 20]); + Relationships.AppendRecord([90, 'Friend', 0]); + Relationships.AppendRecord([91, 'Neighbor', 0]); + + // data from: https://en.wikipedia.org/wiki/The_Grapes_of_Wrath + Persons.CreateDataset; + Persons.Open; + Persons.AppendRecord([20, 'Tom Joad']); // Protagonist + Persons.AppendRecord([11, 'Uncle John Joad']); + Persons.Appendrecord([10, 'Ma Joad']); // name not mentioned + Persons.AppendRecord([10, 'Tom Joad']); // Pa Joad + Persons.AppendRecord([21, 'Al Joad']); + Persons.AppendRecord([21, 'Noah Joad']); + Persons.AppendRecord([22, 'Ruthie Joad']); + Persons.AppendRecord([22, 'Winfield Joad']); + Persons.AppendRecord([22, 'Rose of Sharon Joad Rivers']); + Persons.AppendRecord([ 1, 'William James Joad']); + Persons.AppendRecord([ 1, 'Granma Joad']); // name not mentioned + Persons.AppendRecord([90, 'Jim Casy']); + Persons.AppendRecord([91, 'Muley Graves']); + Persons.AppendRecord([24, 'Connie Rivers']); + Persons.IndexFieldNames := 'Name'; + Persons.First; +end; + +procedure TForm1.DBGrid1PrepareCanvas(sender: TObject; DataCol: Integer; + Column: TColumn; AState: TGridDrawState); +begin + if Persons.FieldByName('ID').AsInteger = 20 then // Protagonist + DBGrid1.Canvas.Font.Style := [fsBold]; +end; + +end. + diff --git a/components/jvcllaz/examples/JvDBTreeView/main.lfm b/components/jvcllaz/examples/JvDBTreeView/main.lfm index 2165dadd7..e530d2e39 100644 --- a/components/jvcllaz/examples/JvDBTreeView/main.lfm +++ b/components/jvcllaz/examples/JvDBTreeView/main.lfm @@ -7,7 +7,7 @@ object Form1: TForm1 ClientHeight = 509 ClientWidth = 758 OnCreate = FormCreate - LCLVersion = '1.9.0.0' + LCLVersion = '2.1.0.0' object DBGrid1: TDBGrid AnchorSideLeft.Control = Owner AnchorSideTop.Control = Owner diff --git a/components/jvcllaz/examples/JvDBTreeView/main.pas b/components/jvcllaz/examples/JvDBTreeView/main.pas index 2710a9446..4a1651779 100644 --- a/components/jvcllaz/examples/JvDBTreeView/main.pas +++ b/components/jvcllaz/examples/JvDBTreeView/main.pas @@ -67,6 +67,14 @@ begin JvDBTreeView1.FullCollapse; end; +{ Assignment of table fields to tree + + Table Tree + ID --> Tree.MasterField + ParentID --> Tree.DetailField + Name --> Tree.itemField + Icon --> Tree.IconField +} procedure TForm1.FormCreate(Sender: TObject); procedure AddRecord(ID, ParentID: Integer; AName: String; AIcon: Integer = -1); diff --git a/components/jvcllaz/packages/JvDBLazR.lpk b/components/jvcllaz/packages/JvDBLazR.lpk index 44b4e4630..98cd8aa38 100644 --- a/components/jvcllaz/packages/JvDBLazR.lpk +++ b/components/jvcllaz/packages/JvDBLazR.lpk @@ -19,7 +19,7 @@ "/> <License Value="The JVCL is released in accordance with the MPL 1.1 license. To get your own copy or read it, go to http://www.mozilla.org/MPL/MPL-1.1.html. "/> <Version Major="1" Release="4"/> - <Files Count="6"> + <Files Count="8"> <Item1> <Filename Value="..\run\JvDB\JvDBHTLabel.pas"/> <UnitName Value="JvDBHTLabel"/> @@ -44,6 +44,14 @@ <Filename Value="..\run\JvDB\jvdbutils.pas"/> <UnitName Value="JvDBUtils"/> </Item6> + <Item7> + <Filename Value="..\run\JvDB\jvdblookuptreeview.pas"/> + <UnitName Value="JvDBLookupTreeView"/> + </Item7> + <Item8> + <Filename Value="..\run\JvDB\jvdbconst.pas"/> + <UnitName Value="jvdbconst"/> + </Item8> </Files> <RequiredPkgs Count="4"> <Item1> diff --git a/components/jvcllaz/packages/jvmmlazr.lpk b/components/jvcllaz/packages/jvmmlazr.lpk index 6f42eb90f..33251c979 100644 --- a/components/jvcllaz/packages/jvmmlazr.lpk +++ b/components/jvcllaz/packages/jvmmlazr.lpk @@ -39,7 +39,7 @@ </Item5> <Item6> <Filename Value="..\run\JvMM\jvid3v2base.pas"/> - <UnitName Value="JvID3v2Base"/> + <UnitName Value="JvId3v2Base"/> </Item6> <Item7> <Filename Value="..\run\JvMM\jvid3v2.pas"/> diff --git a/components/jvcllaz/resource/jvdbreg.res b/components/jvcllaz/resource/jvdbreg.res index 3a52074e14adb55331cc6e8107cc62dee0478bb7..fb1f6a216a0a50867f1cda63c4b26f1d674f212b 100644 GIT binary patch delta 544 zcmYk3y-LJD6on_@CIjL^geY!gLEXk8q!P5*Ok<}3S$na!v=#ONY}9E55vH_R<^?P* zeGD5PU|Gm`?o7hw<o`S8-pS0o-G1LcUq#unc~7Iv{-qD8{w&U;?4=pow%C&VHnrvP zBkW~!O?FjIWBrv<bfHK2M8BTwu`#EG5uMs3S+A2Mse_DT5mB3f;#3=M47m-5L3Pb} z6Y^-nd8KNij>AO%o}(-IJkf#%1}R@)eE+~vqZGJ8Bb1=fwVjwlp7XytC!~~OHsqY& zaE^06^amGWE>Hl#>IdiwYGq`Y72mxCh7jPK#5Lf~bD!6j)ohFv2{|bp4#*i^C(<8P zet>C)Kp42c^SbDtYPW#TI_r(@iJ56vO?V&mc3y@Zv`_m-vA!Ff^5+fN-<`wwA0?gS A5&!@I delta 77 zcmX?+JtuC052L|G-}!8e2Akiq6|+rN&^G}I1hZ^jVXVM3`2ZWs<OU5LpzK-=plkxK Z1*5@4U&+mzc)8etf_p{4I%B1a*#P&`7=i!* diff --git a/components/jvcllaz/run/JvCore/JvJCLUtils.pas b/components/jvcllaz/run/JvCore/JvJCLUtils.pas index e3a7b1b32..183ca09ea 100644 --- a/components/jvcllaz/run/JvCore/JvJCLUtils.pas +++ b/components/jvcllaz/run/JvCore/JvJCLUtils.pas @@ -336,6 +336,11 @@ function StrToBool(const S: string): Boolean; function Var2Type(V: Variant; const DestVarType: Integer): Variant; function VarToInt(V: Variant): Integer; function VarToFloat(V: Variant): Double; +*************) + +function VarIsNullEmpty(const V: Variant): Boolean; + +(****************************** NOT CONVERTED **** { following functions are not documented because they do not work properly sometimes, so do not use them } @@ -1255,7 +1260,7 @@ function FindUnusedFileName(FileName: string; const FileExt: string; NumberPrefi implementation uses - Math, LazFileUtils, LclStrConsts, + Math, Variants, LazFileUtils, LclStrConsts, JvConsts; (******************** NOT CONVERTED @@ -2959,6 +2964,14 @@ function VarToFloat(V: Variant): Double; begin Result := Var2Type(V, varDouble); end; +*********) + +function VarIsNullEmpty(const V: Variant): Boolean; +begin + Result := VarIsNull(V) or VarIsEmpty(V); +end; + +(************************** NOT CONVERTED *** function CopyDir(const SourceDir, DestDir: TFileName): Boolean; var diff --git a/components/jvcllaz/run/JvCore/JvTypes.pas b/components/jvcllaz/run/JvCore/JvTypes.pas index 9d1c05573..3806f8667 100644 --- a/components/jvcllaz/run/JvCore/JvTypes.pas +++ b/components/jvcllaz/run/JvCore/JvTypes.pas @@ -307,6 +307,7 @@ type ckID: TJvFourCC; ckSize: Longint; end; +****************************) TJvAniHeader = packed record dwSizeof: Longint; @@ -322,7 +323,6 @@ type TJvChangeColorEvent = procedure(Sender: TObject; Foreground, Background: TColor) of object; -***********) TJvLayout = (lTop, lCenter, lBottom); TJvBevelStyle = (bsShape, bsLowered, bsRaised); diff --git a/components/jvcllaz/run/JvDB/JvDBTreeView.pas b/components/jvcllaz/run/JvDB/JvDBTreeView.pas index 88f571859..beb536ffd 100644 --- a/components/jvcllaz/run/JvDB/JvDBTreeView.pas +++ b/components/jvcllaz/run/JvDB/JvDBTreeView.pas @@ -48,6 +48,19 @@ Usage: - 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. + +From http://wiki.delphi-jedi.org/wiki/JVCL_Help:TJvDBTreeView: + - MasterField: is equivalent to the absoluteIndex of the TreeView, a unique + ID for each TreeNode or record in the table. + - DetailField: is the hierachical link to the parent item, a foreing key + to the master filed in a self relation table + - ItemField: is the field that contain the display name or the caption of + a treeNode. + - IconField: is a integer field that point to a image index on a TImageList + object that contains the icons for the treeView. + - StartMasterValue: is the begining level to start build the TreeView, + 0 = start from the root itens, 1 = start from the second level, + and so on. -----------------------------------------------------------------------------} // $Id$ @@ -201,9 +214,6 @@ type property MasterValue: Variant read FMasterValue; end; - {$IFDEF RTL230_UP} - [ComponentPlatformsAttribute(pidWin32 or pidWin64)] - {$ENDIF RTL230_UP} TJvDBTreeView = class(TJvCustomDBTreeView) published property DataSource; diff --git a/components/jvcllaz/run/JvDB/jvdbconst.pas b/components/jvcllaz/run/JvDB/jvdbconst.pas new file mode 100644 index 000000000..ad09f6302 --- /dev/null +++ b/components/jvcllaz/run/JvDB/jvdbconst.pas @@ -0,0 +1,17 @@ +unit JvDBConst; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils; + +resourcestring + SPropDefByLookup = 'Property already defined by lookup field.'; + SDataSourceFixed = 'Operation is not allowed with DataSource.'; + +implementation + +end. + diff --git a/components/jvcllaz/run/JvDB/jvdblookuptreeview.pas b/components/jvcllaz/run/JvDB/jvdblookuptreeview.pas new file mode 100644 index 000000000..5224168d7 --- /dev/null +++ b/components/jvcllaz/run/JvDB/jvdblookuptreeview.pas @@ -0,0 +1,1753 @@ +{----------------------------------------------------------------------------- +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: JvDBLookupTreeView.PAS, released on 2002-07-04. + +The Initial Developers of the Original Code are: Andrei Prygounkov <a dott prygounkov att gmx dott de> +Copyright (c) 1999, 2002 Andrei Prygounkov +All Rights Reserved. + +Contributor(s): + +You may retrieve the latest version of this file at the Project JEDI's JVCL home page, +located at http://jvcl.delphi-jedi.org + +Components: + TJvDBLookupTreeView, + TJvDBLookupTreeViewCombo + +Description: + db-aware lookup TreeView + +History: + (JVCL Library versions): + 1.20: + - first release; + 1.61: + - support for non-bde components; + 2.01: + - support for BiDi mode + (thanks to Oussama Al-Rifai); + +Known Issues: +-----------------------------------------------------------------------------} +// $Id$ + +unit JvDBLookupTreeView; + +{$mode objfpc}{$H+} + +interface + +uses + LCLIntf, LCLType, LMessages, + Classes, Controls, Forms, ComCtrls, DB, + JvDBTreeView, {JvToolEdit, }JvComponent, JvExControls; + +type + TJvDBLookupControl = class; + + TJvLookupDataSourceLink = class(TDataLink) + private + FDBLookupControl: TJvDBLookupControl; + protected + procedure FocusControl(Field: TFieldRef); override; + procedure ActiveChanged; override; + procedure RecordChanged(Field: TField); override; + end; + + TJvLookupListSourceLink = class(TDataLink) + private + FDBLookupControl: TJvDBLookupControl; + protected + procedure ActiveChanged; override; + procedure DataSetChanged; override; + end; + + TJvDBLookupControl = class(TJvCustomControl) + private + FLookupSource: TDataSource; + FDataLink: TJvLookupDataSourceLink; + FListLink: TJvLookupListSourceLink; + FDataFieldName: string; + FKeyFieldName: string; + FListFieldName: string; + FListFieldIndex: Integer; + FDataField: TField; + FMasterField: TField; + FKeyField: TField; + FListField: TField; + FListFields: TList; + FKeyValue: Variant; + FUseFilter: Boolean; + FSearchText: string; + FLookupMode: Boolean; + FListActive: Boolean; + FFocused: Boolean; + FSearchTickCount: Integer; + FOnKeyValueChange: TNotifyEvent; + function CanModify: Boolean; + procedure CheckNotCircular; + procedure CheckNotLookup; + procedure DataLinkActiveChanged; + procedure DataLinkRecordChanged(Field: TField); + function GetBorderSize: Integer; + function GetDataSource: TDataSource; + function GetKeyFieldName: string; + function GetListSource: TDataSource; + function GetReadOnly: Boolean; + function GetTextHeight: Integer; + procedure KeyValueChanged; virtual; + procedure ListLinkActiveChanged; virtual; + procedure ListLinkDataChanged; virtual; + function LocateKey: Boolean; + procedure ProcessSearchKey(Key: Char); + procedure SelectKeyValue(const Value: Variant); + procedure SetDataFieldName(const Value: string); + procedure SetDataSource(Value: TDataSource); + procedure SetKeyFieldName(const Value: string); + procedure SetKeyValue(const Value: Variant); + procedure SetListFieldName(const Value: string); + procedure SetListSource(Value: TDataSource); + procedure SetLookupMode(Value: Boolean); + procedure SetReadOnly(Value: Boolean); + procedure CMGetDataLink(var Msg: TLMessage); message CM_GETDATALINK; + protected + procedure FocusKilled(NextWnd: THandle); override; + procedure FocusSet(PrevWnd: THandle); override; + procedure GetDlgCode(var Code: TDlgCodes); override; + procedure Notification(AComponent: TComponent; Operation: TOperation); override; + property DataField: string read FDataFieldName write SetDataFieldName; + property DataSource: TDataSource read GetDataSource write SetDataSource; + property KeyField: string read GetKeyFieldName write SetKeyFieldName; + property KeyValue: Variant read FKeyValue write SetKeyValue; + property ListField: string read FListFieldName write SetListFieldName; + property ListFieldIndex: Integer read FListFieldIndex write FListFieldIndex default 0; + property ListSource: TDataSource read GetListSource write SetListSource; + property UseFilter: Boolean read FUseFilter write FUseFilter default False; + property ParentColor default False; + property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False; + property TabStop default True; + property OnKeyValueChange: TNotifyEvent read FOnKeyValueChange write FOnKeyValueChange; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + property Field: TField read FDataField; + end; + + (************************ NOT CONVERTED *** + + TJvTreePopupDataList = class; + + TDropDownAlign = (daLeft, daRight, daCenter); + + TJvDBLookupTreeViewCombo = class(TJvDBLookupControl) + private + FDataList: TJvTreePopupDataList; + FButtonWidth: Integer; + FText: string; +// FDropDownRows: Integer; + FTracking: Boolean; + FDropDownWidth: Integer; + FDropDownHeight: Integer; + FDropDownAlign: TDropDownAlign; + FListVisible: Boolean; + FPressed: Boolean; + FAlignment: TAlignment; + FLookupMode: Boolean; + FOnDropDown: TNotifyEvent; + FOnCloseUp: TNotifyEvent; + FMasterField: string; {new} + FDetailField: string; {new} + FIconField: string; {new} + FStartMasterValue: string; + FFullExpand: Boolean; {new} + procedure KeyValueChanged; override; + procedure ListLinkActiveChanged; override; +{ procedure ListMouseUp(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer);} + procedure StopTracking; + procedure TrackButton(X, Y: Integer); + procedure CMCtl3DChanged(var Msg: TMessage); message CM_CTL3DCHANGED; + procedure CMGetDataLink(var Msg: TMessage); message CM_GETDATALINK; + procedure WMCancelMode(var Msg: TMessage); message WM_CANCELMODE; + procedure CMCancelMode(var Msg: TCMCancelMode); message CM_CANCELMODE; + procedure PopupCloseUp(Sender: TObject; Accept: Boolean); virtual; + private + FAutoExpand: Boolean; + FChangeDelay: Integer; + FHotTrack: Boolean; + FRowSelect: Boolean; + FToolTips: Boolean; + FAlwaysAcceptOnCloseUp: Boolean; + FOnCustomDraw: TTVCustomDrawEvent; + FOnCustomDrawItem: TTVCustomDrawItemEvent; + FOnGetImageIndex: TTVExpandedEvent; + protected + procedure FontChanged; override; + procedure FocusKilled(NextWnd: THandle); override; + procedure CreateParams(var Params: TCreateParams); override; + procedure Paint; override; + procedure KeyDown(var Key: Word; Shift: TShiftState); override; + procedure KeyPress(var Key: Char); override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + {added by zelen} + {$IFDEF JVCLThemesEnabled} + procedure MouseEnter(Control: TControl); override; + procedure MouseLeave(Control: TControl); override; + {$ENDIF JVCLThemesEnabled} + {/added by zelen} + public + constructor Create(AOwner: TComponent); override; + procedure CloseUp(Accept: Boolean); + procedure DropDown; + procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override; + function CanFocusEx: Boolean; + property KeyValue; + property ListVisible: Boolean read FListVisible; + property Text: string read FText; + published + property AutoSize; + property Color; + property DataField; + property DataSource; + property DragCursor; + property DragMode; + property DropDownAlign: TDropDownAlign read FDropDownAlign write FDropDownAlign default daLeft; +// property DropDownRows: Integer read FDropDownRows write FDropDownRows default 7; + property DropDownWidth: Integer read FDropDownWidth write FDropDownWidth default 0; + {new} + property DropDownHeight: Integer read FDropDownHeight write FDropDownHeight default 100; + + property Enabled; + property Font; + property KeyField; + property ListField; + property UseFilter; + {new} + property MasterField: string read FMasterField write FMasterField; + property DetailField: string read FDetailField write FDetailField; + property IconField: string read FIconField write FIconField; + property StartMasterValue: string read FStartMasterValue write FStartMasterValue; + + property ListFieldIndex; + property ListSource; + property ParentColor; + property ParentFont; + property ParentShowHint; + property PopupMenu; + property ReadOnly; + property ShowHint; + property TabOrder; + property TabStop; + property Visible; + property OnClick; + property OnCloseUp: TNotifyEvent read FOnCloseUp write FOnCloseUp; + property OnDragDrop; + property OnDragOver; + property OnDropDown: TNotifyEvent read FOnDropDown write FOnDropDown; + property OnEndDrag; + property OnEnter; + property OnExit; + property OnKeyDown; + property OnKeyPress; + property OnKeyUp; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnStartDrag; + property ImeMode; + property ImeName; + property Anchors; + property BevelEdges; + property BevelInner; + property BevelKind default bkNone; + property BevelOuter; + property BiDiMode; + property BorderWidth; + property Constraints; + property DragKind; + property ParentBiDiMode; + property OnEndDock; + property OnStartDock; + property AutoExpand: Boolean read FAutoExpand write FAutoExpand default False; + property ChangeDelay: Integer read FChangeDelay write FChangeDelay default 0; + property HotTrack: Boolean read FHotTrack write FHotTrack default False; + property RowSelect: Boolean read FRowSelect write FRowSelect default False; + property ToolTips: Boolean read FToolTips write FToolTips default False; + property AlwaysAcceptOnCloseUp: Boolean read FAlwaysAcceptOnCloseUp write FAlwaysAcceptOnCloseUp default False; + property OnCustomDraw: TTVCustomDrawEvent read FOnCustomDraw write FOnCustomDraw; + property OnCustomDrawItem: TTVCustomDrawItemEvent read FOnCustomDrawItem write FOnCustomDrawItem; + property OnGetImageIndex: TTVExpandedEvent read FOnGetImageIndex write FOnGetImageIndex; + property OnKeyValueChange; + property FullExpand: Boolean read FFullExpand write FFullExpand default False; + end; + +{###################### Borland ######################} + + TJvPopupTree = class(TJvDBTreeView) + private + procedure CNNotify(var Msg: TWMNotify); message CN_NOTIFY; + protected + procedure FocusSet(PrevWnd: THandle); override; + procedure DblClick; override; + end; + + TJvTreePopupDataList = class(TJvPopupWindow) + private + FTree: TJvPopupTree; + protected + function GetValue: Variant; override; + procedure SetValue(const Value: Variant); override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + function GetPopupText: string; override; + end; +*****************) + TJvDBLookupTreeView = class(TJvDBLookupControl) + private + FTree: TJvDBTreeView; + FBorderStyle: TBorderStyle; + InKeyValueChanged: Boolean; + function GetMasterField: string; + procedure SetMasterField(Value: string); + function GetDetailField: string; + procedure SetDetailField(Value: string); + function GetStartMasterValue: string; + procedure SetStartMasterValue(Value: string); + function GetIconField: string; + procedure SetIconField(const Value: string); + procedure KeyValueChanged; override; + {Tree} + function GetShowButtons: Boolean; + function GetShowLines: Boolean; + function GetShowRoot: Boolean; + function GetReadOnly: Boolean; + function GetHideSelection: Boolean; + function GetIndent: Integer; + procedure SetShowButtons(Value: Boolean); + procedure SetShowLines(Value: Boolean); + procedure SetShowRoot(Value: Boolean); + procedure SetReadOnly(Value: Boolean); + procedure SetHideSelection(Value: Boolean); + procedure SetIndent(Value: Integer); + function GetRightClickSelect: Boolean; + procedure SetRightClickSelect(Value: Boolean); + function GetAutoExpand: Boolean; + function GetHotTrack: Boolean; + function GetOnGetImageIndex: TTVExpandedEvent; + function GetRowSelect: Boolean; + function GetToolTips: Boolean; + procedure SetAutoExpand(const Value: Boolean); + procedure SetHotTrack(const Value: Boolean); + procedure SetOnGetImageIndex(const Value: TTVExpandedEvent); + procedure SetRowSelect(const Value: Boolean); + procedure SetToolTips(const Value: Boolean); + function GetOnCustomDraw: TTVCustomDrawEvent; + function GetOnCustomDrawItem: TTVCustomDrawItemEvent; + procedure SetOnCustomDraw(const Value: TTVCustomDrawEvent); + procedure SetOnCustomDrawItem(const Value: TTVCustomDrawItemEvent); + protected + procedure FocusSet(PrevWnd: THandle); override; + procedure CreateParams(var Params: TCreateParams); override; + procedure ListLinkActiveChanged; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + published + property Align; + property BorderSpacing; + property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle; + property Color; + property DataField; + property DataSource; + property DragCursor; + property DragMode; + property Enabled; + property Font; + property KeyField; + property ListField; + property ListFieldIndex; + property ListSource; + property ParentColor; + property ParentFont; + property ParentShowHint; + property PopupMenu; + property ShowHint; + property TabOrder; + property TabStop; + property Visible; + property OnClick; + property OnDblClick; + property OnDragDrop; + property OnDragOver; + property OnEndDrag; + property OnEnter; + property OnExit; + property OnKeyDown; + property OnKeyPress; + property OnKeyUp; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnStartDrag; + property Anchors; + property BiDiMode; + property BorderWidth; + property Constraints; + property DragKind; + property ParentBiDiMode; + property OnEndDock; + property OnStartDock; + + property AutoExpand: Boolean read GetAutoExpand write SetAutoExpand default False; + property HotTrack: Boolean read GetHotTrack write SetHotTrack default False; + property RowSelect: Boolean read GetRowSelect write SetRowSelect default False; + property ToolTips: Boolean read GetToolTips write SetToolTips default True; + property OnCustomDraw: TTVCustomDrawEvent read GetOnCustomDraw write SetOnCustomDraw; + property OnCustomDrawItem: TTVCustomDrawItemEvent read GetOnCustomDrawItem write SetOnCustomDrawItem; + property OnGetImageIndex: TTVExpandedEvent read GetOnGetImageIndex write SetOnGetImageIndex; + property OnKeyValueChange; + {Tree} + property MasterField: string read GetMasterField write SetMasterField; + property DetailField: string read GetDetailField write SetDetailField; + property IconField: string read GetIconField write SetIconField; + property StartMasterValue: string read GetStartMasterValue write SetStartMasterValue; + property ShowButtons: Boolean read GetShowButtons write SetShowButtons default True; + property ShowLines: Boolean read GetShowLines write SetShowLines default True; + property ShowRoot: Boolean read GetShowRoot write SetShowRoot default True; + property ReadOnly: Boolean read GetReadOnly write SetReadOnly default True; + property RightClickSelect: Boolean read GetRightClickSelect write SetRightClickSelect default False; + property HideSelection: Boolean read GetHideSelection write SetHideSelection default False; + property Indent: Integer read GetIndent write SetIndent {default 19}; + end; + + +implementation + +uses + Variants, + CommCtrl, Graphics, DBConst, + JvJclUtils, JvDBConst, JvDBUtils, JvThemes; + +//=== { TJvLookupDataSourceLink } ============================================ + +procedure TJvLookupDataSourceLink.ActiveChanged; +begin + if FDBLookupControl <> nil then + FDBLookupControl.DataLinkActiveChanged; +end; + +procedure TJvLookupDataSourceLink.RecordChanged(Field: TField); +begin + if FDBLookupControl <> nil then + FDBLookupControl.DataLinkRecordChanged(Field); +end; + +procedure TJvLookupDataSourceLink.FocusControl(Field: TFieldRef); +begin + if (Field^ <> nil) and (Field^ = FDBLookupControl.Field) and + (FDBLookupControl <> nil) and FDBLookupControl.CanFocus then + begin + Field^ := nil; + FDBLookupControl.SetFocus; + end; +end; + +procedure TJvLookupListSourceLink.ActiveChanged; +begin + if FDBLookupControl <> nil then + FDBLookupControl.ListLinkActiveChanged; +end; + +procedure TJvLookupListSourceLink.DataSetChanged; +begin + if FDBLookupControl <> nil then + FDBLookupControl.ListLinkDataChanged; +end; + +//=== { TJvDBLookupControl } ================================================= + +function VarEquals(const V1, V2: Variant): Boolean; +begin + Result := False; + try + Result := V1 = V2; + except + end; +end; + +constructor TJvDBLookupControl.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + ControlStyle := [csOpaque]; + IncludeThemeStyle(Self, [csNeedsBorderPaint]); + + ParentColor := False; + TabStop := True; + FLookupSource := TDataSource.Create(Self); + FDataLink := TJvLookupDataSourceLink.Create; + FDataLink.FDBLookupControl := Self; + FListLink := TJvLookupListSourceLink.Create; + FListLink.FDBLookupControl := Self; + FListFields := TList{$IFDEF RTL240_UP}<TField>{$ENDIF RTL240_UP}.Create; + FKeyValue := Null; + FSearchTickCount := 0; +end; + +destructor TJvDBLookupControl.Destroy; +begin + // Deregister FreeNotifications + DataSource := nil; + ListSource := nil; + + FListFields.Free; + FListLink.FDBLookupControl := nil; + FListLink.Free; + FDataLink.FDBLookupControl := nil; + FDataLink.Free; + FDataLink := nil; + inherited Destroy; +end; + +function TJvDBLookupControl.CanModify: Boolean; +begin + Result := FListActive and not ReadOnly and ((FDataLink.DataSource = nil) or + (FMasterField <> nil) and FMasterField.CanModify); +end; + +procedure TJvDBLookupControl.CheckNotCircular; +begin + if (FDataLink.Active and FDataLink.DataSet.IsLinkedTo(ListSource)) or + (FListLink.Active and FListLink.DataSet.IsLinkedTo(DataSource)) then + DatabaseError(SErrCircularDataSourceReferenceNotAllowed); +// DatabaseError(SCircularDataLink); +end; + +procedure TJvDBLookupControl.CheckNotLookup; +begin + if FLookupMode then + DatabaseError(SPropDefByLookup); + if FDataLink.DataSourceFixed then + DatabaseError(SDataSourceFixed); +end; + +procedure TJvDBLookupControl.DataLinkActiveChanged; +begin + FDataField := nil; + FMasterField := nil; + if (csDestroying in ComponentState) then + exit; + if FDataLink.Active and (FDataFieldName <> '') then + begin + CheckNotCircular; + FDataField := GetFieldProperty(FDataLink.DataSet, Self, FDataFieldName); + FMasterField := FDataField; + end; + SetLookupMode((FDataField <> nil) and (FDataField.FieldKind = fkLookup)); + DataLinkRecordChanged(nil); +end; + +procedure TJvDBLookupControl.DataLinkRecordChanged(Field: TField); +begin + if (Field = nil) or (Field = FMasterField) then + if FMasterField <> nil then + SetKeyValue(FMasterField.Value) + else + SetKeyValue(Null); +end; + +function TJvDBLookupControl.GetBorderSize: Integer; +var + Params: TCreateParams; + R: TRect; +begin + CreateParams(Params); + SetRect(R, 0, 0, 0, 0); + AdjustWindowRectEx(R, Params.Style, False, Params.ExStyle); + Result := R.Bottom - R.Top; +end; + +function TJvDBLookupControl.GetDataSource: TDataSource; +begin + Result := FDataLink.DataSource; +end; + +function TJvDBLookupControl.GetKeyFieldName: string; +begin + if FLookupMode then + Result := '' + else + Result := FKeyFieldName; +end; + +function TJvDBLookupControl.GetListSource: TDataSource; +begin + if FLookupMode then + Result := nil + else + Result := FListLink.DataSource; +end; + +function TJvDBLookupControl.GetReadOnly: Boolean; +begin + Result := FDataLink.ReadOnly; +end; + +function TJvDBLookupControl.GetTextHeight: Integer; +var + cnv: TControlCanvas; +begin + cnv := TControlCanvas.Create; + try + cnv.Control := self; + cnv.Font := Screen.SystemFont; + Result := cnv.TextHeight('Tg'); + finally + cnv.Free; + end; +end; +{ +var + DC: HDC; + SaveFont: HFont; + Metrics: TTextMetric; +begin + DC := GetDC(HWND_DESKTOP); + SaveFont := SelectObject(DC, Font.Handle); + GetTextMetrics(DC, Metrics); + SelectObject(DC, SaveFont); + ReleaseDC(HWND_DESKTOP, DC); + Result := Metrics.tmHeight; +end; +} + +procedure TJvDBLookupControl.KeyValueChanged; +begin +end; + +procedure TJvDBLookupControl.ListLinkActiveChanged; +var + DataSet: TDataSet; + ResultField: TField; +begin + FListActive := False; + FKeyField := nil; + FListField := nil; + FListFields.Clear; + if FListLink.Active and (FKeyFieldName <> '') then + begin + CheckNotCircular; + DataSet := FListLink.DataSet; + FKeyField := GetFieldProperty(DataSet, Self, FKeyFieldName); + try + DataSet.GetFieldList(FListFields, FListFieldName); + except + DatabaseErrorFmt(SFieldNotFound, [Self.Name, FListFieldName]); + end; + if FLookupMode then + begin + ResultField := GetFieldProperty(DataSet, Self, FDataField.LookupResultField); + if FListFields.IndexOf(ResultField) < 0 then + FListFields.Insert(0, ResultField); + FListField := ResultField; + end + else + begin + if FListFields.Count = 0 then + FListFields.Add(FKeyField); + if (FListFieldIndex >= 0) and (FListFieldIndex < FListFields.Count) then + FListField := TField(FListFields[FListFieldIndex]) + else + FListField := TField(FListFields[0]); + end; + FListActive := True; + end; +end; + +procedure TJvDBLookupControl.ListLinkDataChanged; +begin +end; + +function TJvDBLookupControl.LocateKey: Boolean; +begin + Result := False; + try + if not VarIsNullEmpty(FKeyValue) and + FListLink.DataSet.Locate(FKeyFieldName, FKeyValue, []) then + Result := True; + except + end; +end; + +procedure TJvDBLookupControl.Notification(AComponent: TComponent; + Operation: TOperation); +begin + inherited Notification(AComponent, Operation); + if (Operation = opRemove) and not (csDestroying in ComponentState) then + begin + if (FDataLink <> nil) and (AComponent = DataSource) then + DataSource := nil; + if (FListLink <> nil) and (AComponent = ListSource) then + ListSource := nil; + end; +end; + +procedure TJvDBLookupControl.ProcessSearchKey(Key: Char); +var + TickCount: Integer; + S: string; +begin + if (FListField <> nil) and (FListField.FieldKind = fkData) and (FListField is TStringField) then + case Ord(Key) of + VK_BACK, VK_ESCAPE: + FSearchText := ''; + VK_SPACE..Ord(High(Char)): + if CanModify then + begin + TickCount := GetTickCount; + if TickCount - FSearchTickCount > 2000 then + FSearchText := ''; + FSearchTickCount := TickCount; + if Length(FSearchText) < 32 then + begin + S := FSearchText + Key; + if FListLink.DataSet.Locate(FListField.FieldName, S, [loCaseInsensitive, loPartialKey]) then + begin + SelectKeyValue(FKeyField.Value); + FSearchText := S; + end; + end; + end; + end; +end; + +procedure TJvDBLookupControl.SelectKeyValue(const Value: Variant); +begin + if FMasterField <> nil then + begin + if FDataLink.Edit then + FMasterField.Value := Value; + end + else + SetKeyValue(Value); + Repaint; + Click; +end; + +procedure TJvDBLookupControl.SetDataFieldName(const Value: string); +begin + if FDataFieldName <> Value then + begin + FDataFieldName := Value; + DataLinkActiveChanged; + end; +end; + +procedure TJvDBLookupControl.SetDataSource(Value: TDataSource); +begin + if FDataLink.DataSource <> nil then + FDataLink.DataSource.RemoveFreeNotification(Self); + FDataLink.DataSource := Value; + if Value <> nil then + Value.FreeNotification(Self); +end; + +procedure TJvDBLookupControl.SetKeyFieldName(const Value: string); +begin + CheckNotLookup; + if FKeyFieldName <> Value then + begin + FKeyFieldName := Value; + ListLinkActiveChanged; + end; +end; + +procedure TJvDBLookupControl.SetKeyValue(const Value: Variant); +begin + if not VarEquals(FKeyValue, Value) then + begin + FKeyValue := Value; + KeyValueChanged; + if Assigned(FOnKeyValueChange) then + FOnKeyValueChange(Self); + end; +end; + +procedure TJvDBLookupControl.SetListFieldName(const Value: string); +begin + if FListFieldName <> Value then + begin + FListFieldName := Value; + ListLinkActiveChanged; + end; +end; + +procedure TJvDBLookupControl.SetListSource(Value: TDataSource); +begin + CheckNotLookup; + if FListLink.DataSource <> nil then + FListLink.DataSource.RemoveFreeNotification(Self); + FListLink.DataSource := Value; + if Value <> nil then + Value.FreeNotification(Self); +end; + +procedure TJvDBLookupControl.SetLookupMode(Value: Boolean); +begin + if FLookupMode <> Value then + if Value then + begin + FMasterField := GetFieldProperty(FDataField.DataSet, Self, FDataField.KeyFields); + FLookupSource.DataSet := FDataField.LookupDataSet; + FKeyFieldName := FDataField.LookupKeyFields; + FLookupMode := True; + FListLink.DataSource := FLookupSource; + end + else + begin + FListLink.DataSource := nil; + FLookupMode := False; + FKeyFieldName := ''; + FLookupSource.DataSet := nil; + FMasterField := FDataField; + end; +end; + +procedure TJvDBLookupControl.SetReadOnly(Value: Boolean); +begin + FDataLink.ReadOnly := Value; +end; + +procedure TJvDBLookupControl.GetDlgCode(var Code: TDlgCodes); +begin + Code := [dcWantArrows, dcWantChars]; +end; + +procedure TJvDBLookupControl.FocusKilled(NextWnd: THandle); +begin + FFocused := False; + inherited FocusKilled(NextWnd); + Invalidate; +end; + +procedure TJvDBLookupControl.FocusSet(PrevWnd: THandle); +begin + FFocused := True; + inherited FocusSet(PrevWnd); + Invalidate; +end; + +procedure TJvDBLookupControl.CMGetDataLink(var Msg: TLMessage); +begin + Msg.Result := LRESULT(FDataLink); +end; + + +(******************************** NOT CONVERTED *** + +//=== { TJvDBLookupTreeViewCombo } =========================================== + +constructor TJvDBLookupTreeViewCombo.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + ControlStyle := ControlStyle + [csReplicatable]; + Width := 145; + Height := 0; + FDataList := TJvTreePopupDataList.Create(Self); +// FDataList.Visible := False; +// FDataList.Parent := Self; + FButtonWidth := GetSystemMetrics(SM_CXVSCROLL); + FDropDownHeight := 100; + FFullExpand := False; +end; + +procedure TJvDBLookupTreeViewCombo.CreateParams(var Params: TCreateParams); +begin + inherited CreateParams(Params); + with Params do + if Ctl3D then + ExStyle := ExStyle or WS_EX_CLIENTEDGE + else + Style := Style or WS_BORDER; +end; + +procedure TJvDBLookupTreeViewCombo.Paint; +var + W, X, Flags: Integer; + Text: string; + Alignment: TAlignment; + Selected: Boolean; + R: TRect; + + {added by zelen} + {$IFDEF JVCLThemesEnabled} + State: TThemedComboBox; + Details: TThemedElementDetails; + {$ENDIF JVCLThemesEnabled} + {/added by zelen} + +begin + Canvas.Font := Font; + Canvas.Brush.Color := Color; + Selected := FFocused and not FListVisible and not (csPaintCopy in ControlState); + + if Selected then + begin + Canvas.Font.Color := clHighlightText; + Canvas.Brush.Color := clHighlight; + end + {added by zelen} + else + if not Enabled then + Canvas.Font.Color := clGrayText; + {/added by zelen} + if (csPaintCopy in ControlState) and (FDataField <> nil) then + begin + Text := FDataField.DisplayText; + Alignment := FDataField.Alignment; + end + else + begin + Text := FText; + Alignment := FAlignment; + end; + W := ClientWidth - FButtonWidth; + X := 2; + case Alignment of + taRightJustify: X := W - Canvas.TextWidth(Text) - 3; + taCenter: X := (W - Canvas.TextWidth(Text)) div 2; + end; + + // Fill the background (Mantis 2723) + SetRect(R, 0, 0, W, ClientHeight); + Canvas.FillRect(R); + + SetRect(R, 1, 1, W - 1, ClientHeight - 1); + Canvas.TextRect(R, X, 2, Text); + if Selected then + Canvas.DrawFocusRect(R); + + SetRect(R, W, 0, ClientWidth, ClientHeight); + {added by zelen} + {$IFDEF JVCLThemesEnabled} + if StyleServices.Enabled then + begin + if (not FListActive) or (not Enabled) or ReadOnly then + State := tcDropDownButtonDisabled + else + if FPressed then + State := tcDropDownButtonPressed + else + if MouseOver and not FListVisible then + State := tcDropDownButtonHot + else + State := tcDropDownButtonNormal; + Details := StyleServices.GetElementDetails(State); + StyleServices.DrawElement(Canvas.Handle, Details, R); + + + + + end + else + {$ENDIF JVCLThemesEnabled} + {/added by zelen} + begin + if not FListActive or not Enabled or ReadOnly then + Flags := DFCS_SCROLLCOMBOBOX or DFCS_INACTIVE + else + if FPressed then + Flags := DFCS_SCROLLCOMBOBOX or DFCS_FLAT or DFCS_PUSHED + else + Flags := DFCS_SCROLLCOMBOBOX; + DrawFrameControl(Canvas.Handle, R, DFC_SCROLL, Flags); + end; +end; + +procedure TJvDBLookupTreeViewCombo.SetBounds(ALeft, ATop, AWidth, AHeight: Integer); +begin + inherited SetBounds(ALeft, ATop, AWidth, GetTextHeight + GetBorderSize + 4); + +end; + +procedure TJvDBLookupTreeViewCombo.KeyValueChanged; +begin + if FLookupMode then + begin + FText := FDataField.DisplayText; + FAlignment := FDataField.Alignment; + end + else + if FListActive and LocateKey then + begin + FText := FListField.DisplayText; + FAlignment := FListField.Alignment; + end + else + begin + FText := ''; + FAlignment := taLeftJustify; + end; + Invalidate; +end; + +procedure TJvDBLookupTreeViewCombo.ListLinkActiveChanged; +begin + inherited ListLinkActiveChanged; + KeyValueChanged; +end; + +function TJvDBLookupTreeViewCombo.CanFocusEx: Boolean; +var + P: TWinControl; +begin + P := Parent; + Result := Visible and Enabled; + while Result and (P <> nil) do + begin + Result := P.Visible and P.Enabled; + P := P.Parent; + end; +end; + +procedure TJvDBLookupTreeViewCombo.CloseUp(Accept: Boolean); +var + ListValue: Variant; +begin + if FListVisible then + begin + if GetCapture <> 0 then + SendMessage(GetCapture, WM_CANCELMODE, 0, 0); + ListValue := FDataList.GetValue; + if CanFocusEx then + SetFocus; + FDataList.Hide; +{ SetWindowPos(FDataList.Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or + SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW); } + FListVisible := False; + // FDataList.ListSource := nil; + FDataList.FTree.DataSource := nil; + Invalidate; + FSearchText := ''; + if Accept and CanModify then + SelectKeyValue(ListValue); + if Assigned(FOnCloseUp) then + FOnCloseUp(Self); + FPressed := False; + Repaint; + end; +end; + +procedure TJvDBLookupTreeViewCombo.DropDown; +var + P: TPoint; + {I,}Y: Integer; + {S: string;} + OldLong: Longword; +begin + if not FListVisible and FListActive then + begin + if Assigned(FOnDropDown) then + FOnDropDown(Self); + FDataList.Color := Color; + FDataList.Font := Font; + if FDropDownWidth > 0 then + FDataList.Width := FDropDownWidth + else + FDataList.Width := Width; + FDataList.Height := FDropDownHeight; + // FDataList.RowCount := FDropDownRows; + // FDataList.KeyField := FKeyFieldName; + FDataList.FTree.MasterField := FKeyFieldName; + FDataList.FTree.DetailField := FDetailField; + FDataList.FTree.IconField := FIconField; + FDataList.FTree.MasterField := FMasterField; + FDataList.FTree.StartMasterValue := FStartMasterValue; + FDataList.FTree.UseFilter := FUseFilter; + + {Source added by Oussama Al-Rifai} + OldLong := GetWindowLong(FDataList.FTree.Handle, GWL_EXSTYLE); + if BiDiMode <> bdLeftToRight then + begin + FDataList.FTree.BiDiMode := bdLeftToRight; + SetWindowLong(FDataList.FTree.Handle, GWL_EXSTYLE, OldLong or $00400000); + end + else + SetWindowLong(FDataList.FTree.Handle, GWL_EXSTYLE, OldLong and not $00400000); + {End of source added by Oussama Al-Rifai} + + FDataList.FTree.AutoExpand := FAutoExpand; + FDataList.FTree.ChangeDelay := FChangeDelay; + FDataList.FTree.HotTrack := FHotTrack; + FDataList.FTree.RowSelect := FRowSelect; + FDataList.FTree.ToolTips := FToolTips; + FDataList.FTree.OnCustomDraw := FOnCustomDraw; + FDataList.FTree.OnCustomDrawItem := FOnCustomDrawItem; + FDataList.FTree.OnGetImageIndex := FOnGetImageIndex; + FDataList.FTree.ReadOnly := not FDataLink.ReadOnly; + + { for I := 0 to FListFields.Count - 1 do + S := S + TField(FListFields[I]).FieldName + ';'; + FDataList.ListField := S;} + FDataList.FTree.ItemField := ListField; + + // FDataList.ListFieldIndex := FListFields.IndexOf(FListField); + // FDataList.ListSource := FListLink.DataSource; + FDataList.FTree.DataSource := FListLink.DataSource; + { FDataList.FTree.FullExpand; + FDataList.FTree.FullCollapse; + FDataList.FTree.DataChanged; } + FDataList.SetValue(FListLink.DataSet.Lookup(FKeyFieldName, FKeyValue, FMasterField)); + + // FDataList.KeyValue := KeyValue; + + P := Parent.ClientToScreen(Point(Left, Top)); + Y := P.Y + Height; + if Y + FDataList.Height > Screen.Height then + Y := P.Y - FDataList.Height; + case FDropDownAlign of + daRight: Dec(P.X, FDataList.Width - Width); + daCenter: Dec(P.X, (FDataList.Width - Width) div 2); + end; +// FDataList.Left := P.X; +// FDataList.Top := P.Y; + P.Y := Y; + FListVisible := True; + FDataList.Show(P); +// FDataList.Visible := True; +// SetWindowPos(FDataList.Handle, HWND_TOP, P.X, Y, 0, 0, +// SWP_NOSIZE or SWP_NOACTIVATE or SWP_SHOWWINDOW); + + if FullExpand then + FDataList.FTree.FullExpand; + + Repaint; + end; +end; + +procedure TJvDBLookupTreeViewCombo.KeyDown(var Key: Word; Shift: TShiftState); +var + Delta: Integer; +begin + inherited KeyDown(Key, Shift); + if FListActive and ((Key = VK_UP) or (Key = VK_DOWN)) then + if ssAlt in Shift then + begin + if FListVisible then + CloseUp(True) + else + DropDown; + Key := 0; + end + else + if not FListVisible then + begin + if not LocateKey then + FListLink.DataSet.First + else + begin + if Key = VK_UP then + Delta := -1 + else + Delta := 1; + FListLink.DataSet.MoveBy(Delta); + end; + SelectKeyValue(FKeyField.Value); + Key := 0; + end; + if (Key <> 0) and FListVisible then + // FDataList.KeyDown(Key, Shift); + SendMessage(FDataList.FTree.Handle, WM_KEYDOWN, Key, 0); +end; + +procedure TJvDBLookupTreeViewCombo.KeyPress(var Key: Char); +begin + inherited KeyPress(Key); + if FListVisible then + if Word(Key) in [VK_RETURN, VK_ESCAPE] then + CloseUp(Word(Key) = VK_RETURN) + else + FDataList.KeyPress(Key) + else + ProcessSearchKey(Key); +end; + +procedure TJvDBLookupTreeViewCombo.MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + if Button = mbLeft then + begin + SetFocus; + if not FFocused then + Exit; + if FListVisible then + CloseUp(AlwaysAcceptOnCloseUp) + else + if FListActive then + begin + MouseCapture := True; + FTracking := True; + TrackButton(X, Y); + DropDown; + end; + end; + inherited MouseDown(Button, Shift, X, Y); +end; + +procedure TJvDBLookupTreeViewCombo.MouseMove(Shift: TShiftState; X, Y: Integer); +var + ListPos: TPoint; + MousePos: TSmallPoint; +begin + if FTracking then + begin + TrackButton(X, Y); + if FListVisible then + begin + ListPos := FDataList.ScreenToClient(ClientToScreen(Point(X, Y))); + if PtInRect(FDataList.ClientRect, ListPos) then + begin + StopTracking; + MousePos := PointToSmallPoint(ListPos); + SendMessage(FDataList.FTree.Handle, WM_LBUTTONDOWN, 0, {$IFDEF RTL230_UP}PointToLParam{$ELSE}LPARAM{$ENDIF RTL230_UP}(MousePos)); + Exit; + end; + end; + end; + inherited MouseMove(Shift, X, Y); +end; + +procedure TJvDBLookupTreeViewCombo.MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + StopTracking; + inherited MouseUp(Button, Shift, X, Y); +end; + +procedure TJvDBLookupTreeViewCombo.StopTracking; +begin + if FTracking then + begin + TrackButton(-1, -1); + FTracking := False; + MouseCapture := False; + end; +end; + +procedure TJvDBLookupTreeViewCombo.TrackButton(X, Y: Integer); +var + NewState: Boolean; +begin + Repaint; + NewState := PtInRect(Rect(ClientWidth - FButtonWidth, 0, ClientWidth, + ClientHeight), Point(X, Y)); + if FPressed <> NewState then + begin + FPressed := NewState; + Repaint; + end; +end; + +procedure TJvDBLookupTreeViewCombo.CMCtl3DChanged(var Msg: TMessage); +begin + RecreateWnd; + Height := 0; + inherited; +end; + +procedure TJvDBLookupTreeViewCombo.FontChanged; +begin + inherited FontChanged; + Height := 0; +end; + +procedure TJvDBLookupTreeViewCombo.CMGetDataLink(var Msg: TMessage); +begin + Msg.Result := LRESULT(FDataLink); +end; + +procedure TJvDBLookupTreeViewCombo.WMCancelMode(var Msg: TMessage); +begin + StopTracking; + inherited; +end; + +procedure TJvDBLookupTreeViewCombo.CMCancelMode(var Msg: TCMCancelMode); +begin + if (Msg.Sender <> Self) and (Msg.Sender <> FDataList) and + ((FDataList <> nil) and + not FDataList.ContainsControl(Msg.Sender)) then + PopupCloseUp(FDataList, AlwaysAcceptOnCloseUp); +end; + +procedure TJvDBLookupTreeViewCombo.FocusKilled(NextWnd: THandle); +begin + if (Handle <> NextWnd) and (FDataList.Handle <> NextWnd) and + (FDataList.FTree.Handle <> NextWnd) then + CloseUp(AlwaysAcceptOnCloseUp); + + inherited FocusKilled(NextWnd); +end; + +procedure TJvDBLookupTreeViewCombo.PopupCloseUp(Sender: TObject; Accept: Boolean); +var + AValue: Variant; +begin + if (FDataList <> nil) and FListVisible then + begin + if Accept then + CloseUp(True) + else + begin + if GetCapture <> 0 then + SendMessage(GetCapture, WM_CANCELMODE, 0, 0); + AValue := FDataList.GetValue; + FDataList.Hide; + try + try + if CanFocus then + SetFocus; + except + { ignore exceptions } + end; + // SetDirectInput(DirectInput); + Invalidate; + finally + FListVisible := False; + end; + end; + end; +end; + +{added by zelen} +{$IFDEF JVCLThemesEnabled} +procedure TJvDBLookupTreeViewCombo.MouseEnter(Control: TControl); +begin + if csDesigning in ComponentState then + Exit; + inherited MouseEnter(Control); + {Windows XP themes use hot track states, hence we have to update the drop down button.} + if StyleServices.Enabled and not MouseOver and not (csDesigning in ComponentState) then + Invalidate; +end; + +procedure TJvDBLookupTreeViewCombo.MouseLeave(Control: TControl); +begin + if csDesigning in ComponentState then + Exit; + if StyleServices.Enabled and MouseOver then + Invalidate; + inherited MouseLeave(Control); +end; +{$ENDIF JVCLThemesEnabled} +{/added by zelen} + +//=== { TJvTreePopupDataList } =============================================== + +constructor TJvTreePopupDataList.Create(AOwner: TComponent); +begin + inherited Create(AOwner); +// ControlStyle := ControlStyle + [csNoDesignVisible, csReplicatable]; +// TabStop := False; + FTree := TJvPopupTree.Create(Self); + FTree.Parent := Self; + FTree.Align := alClient; + FTree.ReadOnly := True; + FTree.BorderStyle := bsNone; + FTree.HideSelection := False; + FTree.TabStop := False; +end; + +destructor TJvTreePopupDataList.Destroy; +begin + FTree.Free; + inherited Destroy; +end; + +function TJvTreePopupDataList.GetPopupText: string; +begin + Result := GetValue; +end; + +function TJvTreePopupDataList.GetValue: Variant; +begin + if FTree.Selected <> nil then +// Result := (FTree.Selected as TJvDBTreeNode).MasterValue + Result := FTree.DataSource.DataSet.Lookup(FTree.MasterField, + (FTree.Selected as TJvDBTreeNode).MasterValue, (Owner as TJvDBLookupControl).KeyField) + else + Result := Null; +end; + +procedure TJvTreePopupDataList.SetValue(const Value: Variant); +begin + FTree.SelectNode(Value); +end; + +//=== { TJvPopupTree } ======================================================= + + // Jean-Luc Mattei + // jlucm dott club-internet att fr +const + NM_CUSTOMDRAW = (NM_FIRST - 12); + CDDS_PREPAINT = $000000001; + CDRF_NOTIFYITEMDRAW = $00000020; + CDDS_ITEM = $000010000; + CDDS_ITEMPREPAINT = (CDDS_ITEM or CDDS_PREPAINT); + CDIS_SELECTED = $0001; + +type + PNMCustomDrawInfo = ^TNMCustomDrawInfo; + TNMCustomDrawInfo = record + hdr: TNMHdr; + dwDrawStage: DWORD; + hdc: HDC; + rc: TRect; + dwItemSpec: {$IFDEF RTL230_UP}DWORD_PTR{$ELSE}Longint{$ENDIF TRL230_UP}; // this is control specific, but it's how to specify an item. valid only with CDDS_ITEM bit set + uItemState: UINT; + lItemlParam: LPARAM; + end; + +procedure TJvPopupTree.CNNotify(var Msg: TWMNotify); +begin + with Msg.NMHdr^ do + case code of + NM_CUSTOMDRAW: + begin + with PNMCustomDrawInfo(Pointer(Msg.NMHdr))^ do + begin + if (dwDrawStage and CDDS_PREPAINT) = CDDS_PREPAINT then + Msg.Result := CDRF_NOTIFYITEMDRAW; + if (dwDrawStage and CDDS_ITEMPREPAINT) = CDDS_ITEMPREPAINT then + begin + if (uItemState and CDIS_SELECTED) <> 0 then + begin + SetTextColor(hdc, ColorToRGB(clHighlightText)); + SetBkColor(hdc, ColorToRGB(clHighlight)); + end; + Msg.Result := CDRF_NOTIFYITEMDRAW; + end; + end; + end; + else + inherited; + end; +end; + +procedure TJvPopupTree.FocusSet(PrevWnd: THandle); +begin + inherited FocusSet(PrevWnd); + (Owner.Owner as TJvDBLookupTreeViewCombo).SetFocus; +end; + +procedure TJvPopupTree.DblClick; +begin + (Owner.Owner as TJvDBLookupTreeViewCombo).CloseUp(True); +end; + +***********************) + +//=== { TJvDBLookupTreeView } ================================================ + +type + TJvDBLookupTreeViewTree = class(TJvDBTreeView) + private + procedure DataScrolled; override; + procedure DataChanged; override; + procedure Change2(Node: TTreeNode); override; + procedure DefaultHandler(var Message); override; + end; + +constructor TJvDBLookupTreeView.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FBorderStyle := bsSingle; + FTree := TJvDBLookupTreeViewTree.Create(Self); + FTree.Parent := Self; + Width := FTree.Width; + Height := FTree.Height; + FTree.Align := alClient; + FTree.ReadOnly := True; + FTree.BorderStyle := bsNone; + FTree.HideSelection := False; +// FTree.TabStop := False; +end; + +destructor TJvDBLookupTreeView.Destroy; +begin + FTree.Free; + inherited Destroy; +end; + +procedure TJvDBLookupTreeView.CreateParams(var Params: TCreateParams); +begin + inherited CreateParams(Params); + with Params do + if FBorderStyle = bsSingle then + Style := Style or WS_BORDER; +end; + +(**** not converted, probably not needed +procedure TJvDBLookupTreeView.SetBorderStyle(Value: TBorderStyle); +begin + if FBorderStyle <> Value then + begin + FBorderStyle := Value; + Invalidate + RecreateWnd; + end; +end; +****) + +function TJvDBLookupTreeView.GetMasterField: string; +begin + Result := FTree.MasterField; +end; + +procedure TJvDBLookupTreeView.SetMasterField(Value: string); +begin + FTree.MasterField := Value; +end; + +function TJvDBLookupTreeView.GetDetailField: string; +begin + Result := FTree.DetailField; +end; + +procedure TJvDBLookupTreeView.SetDetailField(Value: string); +begin + FTree.DetailField := Value; +end; + +function TJvDBLookupTreeView.GetIconField: string; +begin + Result := FTree.IconField; +end; + +procedure TJvDBLookupTreeView.SetIconField(const Value: string); +begin + FTree.IconField := Value; +end; + +function TJvDBLookupTreeView.GetStartMasterValue: string; +begin + Result := FTree.StartMasterValue; +end; + +procedure TJvDBLookupTreeView.SetStartMasterValue(Value: string); +begin + FTree.StartMasterValue := Value; +end; + +procedure TJvDBLookupTreeView.ListLinkActiveChanged; +begin + inherited ListLinkActiveChanged; + FTree.DataSource := ListSource; + FTree.ItemField := ListField; +end; + +procedure TJvDBLookupTreeView.KeyValueChanged; +begin + InKeyValueChanged := True; + try + TJvDBLookupTreeViewTree(FTree).SelectNode(FKeyValue); + finally + InKeyValueChanged := False; + end; +end; + +procedure TJvDBLookupTreeView.FocusSet(PrevWnd: THandle); +begin + FTree.SetFocus; +end; + +function TJvDBLookupTreeView.GetShowButtons: Boolean; +begin + Result := FTree.ShowButtons; +end; + +function TJvDBLookupTreeView.GetShowLines: Boolean; +begin + Result := FTree.ShowLines; +end; + +function TJvDBLookupTreeView.GetShowRoot: Boolean; +begin + Result := FTree.ShowRoot; +end; + +function TJvDBLookupTreeView.GetReadOnly: Boolean; +begin + Result := FTree.ReadOnly; +end; + +function TJvDBLookupTreeView.GetRightClickSelect: Boolean; +begin + Result := FTree.RightClickSelect; +end; + +function TJvDBLookupTreeView.GetHideSelection: Boolean; +begin + Result := FTree.HideSelection; +end; + +function TJvDBLookupTreeView.GetIndent: Integer; +begin + Result := FTree.Indent; +end; + +procedure TJvDBLookupTreeView.SetShowButtons(Value: Boolean); +begin + FTree.ShowButtons := Value; +end; + +procedure TJvDBLookupTreeView.SetShowLines(Value: Boolean); +begin + FTree.ShowLines := Value; +end; + +procedure TJvDBLookupTreeView.SetShowRoot(Value: Boolean); +begin + FTree.ShowRoot := Value; +end; + +procedure TJvDBLookupTreeView.SetReadOnly(Value: Boolean); +begin + FTree.ReadOnly := Value; +end; + +procedure TJvDBLookupTreeView.SetRightClickSelect(Value: Boolean); +begin + FTree.RightClickSelect := Value; +end; + +procedure TJvDBLookupTreeView.SetHideSelection(Value: Boolean); +begin + FTree.HideSelection := Value; +end; + +procedure TJvDBLookupTreeView.SetIndent(Value: Integer); +begin + FTree.Indent := Value; +end; + +function TJvDBLookupTreeView.GetAutoExpand: Boolean; +begin + Result := FTree.AutoExpand; +end; + +function TJvDBLookupTreeView.GetHotTrack: Boolean; +begin + Result := FTree.HotTrack; +end; + +function TJvDBLookupTreeView.GetOnCustomDraw: TTVCustomDrawEvent; +begin + Result := FTree.OnCustomDraw; +end; + +function TJvDBLookupTreeView.GetOnCustomDrawItem: TTVCustomDrawItemEvent; +begin + Result := FTree.OnCustomDrawItem; +end; + +function TJvDBLookupTreeView.GetOnGetImageIndex: TTVExpandedEvent; +begin + Result := FTree.OnGetImageIndex; +end; + +function TJvDBLookupTreeView.GetRowSelect: Boolean; +begin + Result := FTree.RowSelect; +end; + +function TJvDBLookupTreeView.GetToolTips: Boolean; +begin + Result := FTree.ToolTips; +end; + +procedure TJvDBLookupTreeView.SetAutoExpand(const Value: Boolean); +begin + FTree.AutoExpand := Value; +end; + +procedure TJvDBLookupTreeView.SetHotTrack(const Value: Boolean); +begin + FTree.HotTrack := Value; +end; + +procedure TJvDBLookupTreeView.SetOnCustomDraw(const Value: TTVCustomDrawEvent); +begin + FTree.OnCustomDraw := Value; +end; + +procedure TJvDBLookupTreeView.SetOnCustomDrawItem(const Value: TTVCustomDrawItemEvent); +begin + FTree.OnCustomDrawItem := Value; +end; + +procedure TJvDBLookupTreeView.SetOnGetImageIndex(const Value: TTVExpandedEvent); +begin + FTree.OnGetImageIndex := Value; +end; + +procedure TJvDBLookupTreeView.SetRowSelect(const Value: Boolean); +begin + FTree.RowSelect := Value; +end; + +procedure TJvDBLookupTreeView.SetToolTips(const Value: Boolean); +begin + FTree.ToolTips := Value; +end; + +{# Translate properties } + +//=== { TJvDBLookupTreeViewTree } ============================================ + +procedure TJvDBLookupTreeViewTree.DataScrolled; +begin +end; + +procedure TJvDBLookupTreeViewTree.DataChanged; +begin + inherited DataChanged; +end; + +procedure TJvDBLookupTreeViewTree.Change2(Node: TTreeNode); +begin + with Owner as TJvDBLookupTreeView do + if not InKeyValueChanged then + begin + FListLink.DataSet.Locate(MasterField, (Node as TJvDBTreeNode).MasterValue, []); + SelectKeyValue(FKeyField.Value); + KeyValueChanged; + end; +end; + +procedure TJvDBLookupTreeViewTree.DefaultHandler(var Message); +begin + inherited DefaultHandler(Message); + with TLMessage(Message) do + case Msg of + LM_KEYDOWN, LM_KEYUP, LM_CHAR, LM_LBUTTONDOWN, LM_LBUTTONUP, + LM_RBUTTONDOWN, LM_RBUTTONUP, LM_MBUTTONDOWN, LM_MBUTTONUP, + LM_MOUSEMOVE: + PostMessage((Owner as TWinControl).Handle, Msg, WParam, LParam); + end; +end; + + +end. diff --git a/components/jvcllaz/run/JvDB/jvdbutils.pas b/components/jvcllaz/run/JvDB/jvdbutils.pas index 49d7ccde1..327cbe8bc 100644 --- a/components/jvcllaz/run/JvDB/jvdbutils.pas +++ b/components/jvcllaz/run/JvDB/jvdbutils.pas @@ -132,6 +132,9 @@ procedure CheckRequiredField(Field: TField); procedure CheckRequiredFields(const Fields: array of TField); procedure GotoBookmarkEx(DataSet: TDataSet; const Bookmark: TBookmark; Mode: TResyncMode = [rmExact, rmCenter]; ForceScrollEvents: Boolean = False); +function GetFieldProperty(ADataSet: TDataSet; AControl: TComponent; + const AFieldName: string): TField; + { SQL expressions } function DateToSQL(Value: TDateTime): string; @@ -264,6 +267,15 @@ begin end; end; +function GetFieldProperty(ADataSet: TDataSet; AControl: TComponent; + const AFieldName: string): TField; +begin + Result := ADataSet.FindField(AFieldName); + if Result = nil then + DatabaseErrorFmt(SFieldNotFound, [AFieldName], AControl); +end; + + { Refresh Query procedure } procedure RefreshQuery(Query: TDataSet);