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
This commit is contained in:
wp_xxyyzz
2019-04-27 17:15:09 +00:00
parent 0d39fd7dfd
commit 0bd361c6e9
20 changed files with 2228 additions and 16 deletions

View File

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

View File

@ -3,3 +3,6 @@ tjvdbhtlabel.bmp
tjvdbsearchcombobox.bmp
tjvdbsearchedit.bmp
tjvdbtreeview.bmp
tjvdblookuptreeview.bmp
tjvdblookuplist.bmp
tjvdblookupcombo.bmp

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.6 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.6 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.6 KiB

View File

@ -0,0 +1,73 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<PathDelim Value="\"/>
<General>
<Flags>
<CompatibilityMode Value="True"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<Title Value="JvDBLookupTreeViewDemo"/>
<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>

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

File diff suppressed because it is too large Load Diff

View File

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