trunk/ibcontrols/IBTreeView.pas

(*
 *  IBX For Lazarus (Firebird Express)
 *
 *  The contents of this file are subject to the Initial Developer's
 *  Public License Version 1.0 (the "License"); you may not use this
 *  file except in compliance with the License. You may obtain a copy
 *  of the License here:
 *
 *    http://www.firebirdsql.org/index.php?op=doc&id=idpl
 *
 *  Software distributed under the License is distributed on an "AS
 *  IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 *  implied. See the License for the specific language governing rights
 *  and limitations under the License.
 *
 *  The Initial Developer of the Original Code is Tony Whyman.
 *
 *  The Original Code is (C) 2015 Tony Whyman, MWA Software
 *  (http://www.mwasoftware.co.uk).
 *
 *  All Rights Reserved.
 *
 *  Contributor(s): ______________________________________.
 *
*)
unit IBTreeView;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ComCtrls,
  DB, DBTreeView, IBSQLParser, IBCustomDataSet;

type
  {
    TIBTreeView is intended to be a data aware descendent of TCustomTreeView and used to display
    hierarchically structured data in a natural manner. Nodes can be deleted, moved
    and added to the tree and each change is reflected in the underlying dataset. The
    Node text can similarly be edited.
  }

  TIBTreeView = class;
  TIBTreeNode = TDBTreeNode;

  { TIBTreeViewControlLink }

  TIBTreeViewControlLink = class(TIBControlLink)
  private
    FOwner: TIBTreeView;
  protected
    procedure UpdateSQL(Sender: TObject); override;
    procedure UpdateParams(Sender: TObject); override;
  public
    constructor Create(AOwner: TIBTreeView);
  end;

  TIBTreeView = class(TDBTreeView)
  private
    { Private declarations }
    FIBTreeViewControlLink: TIBTreeViewControlLink;
    procedure UpdateParams(Sender: TObject; Parser: TSelectSQLParser);
    procedure UpdateSQL(Sender: TObject; Parser: TSelectSQLParser);
   protected
     procedure DataSourceChanged; override;
     procedure RefreshDataset; override;
  public
    { Public declarations }
    constructor Create(TheComponent: TComponent); override;
    destructor Destroy; override;
  end;

function StrIntListToVar(s: string): TVariantArray;
function VarToStrIntList(a: TVariantArray): string;

implementation

uses IBQuery;

function StrIntListToVar(s: string): TVariantArray;
begin
  Result := DBTreeView.StrIntListToVar(s);
end;

function VarToStrIntList(a: TVariantArray): string;
begin
  Result := DBTreeView.VarToStrIntList(a);
end;


{ TIBTreeViewControlLink }

constructor TIBTreeViewControlLink.Create(AOwner: TIBTreeView);
begin
  inherited Create;
  FOwner := AOwner;
end;

procedure TIBTreeViewControlLink.UpdateParams(Sender: TObject);
begin
  FOwner.UpdateParams(self,TIBParserDataSet(Sender).Parser)
end;

procedure TIBTreeViewControlLink.UpdateSQL(Sender: TObject);
begin
  FOwner.UpdateSQL(self,TIBParserDataSet(Sender).Parser)
end;


procedure TIBTreeView.UpdateParams(Sender: TObject; Parser: TSelectSQLParser);
begin
  if not assigned(FExpandNode) and assigned(FUpdateNode)  then {Scrolling dataset}
   begin
     if DataSource.DataSet is TIBQuery then
       TIBQuery(DataSource.DataSet).ParamByName('IBX_KEY_VALUE').Value :=
         FUpdateNode.KeyValue
     else
     if DataSource.DataSet is TIBDataSet then
       TIBDataSet(DataSource.DataSet).ParamByName('IBX_KEY_VALUE').Value :=
         FUpdateNode.KeyValue
   end
  else
  if assigned(FExpandNode) then
  begin
    if DataSource.DataSet is TIBQuery then
      TIBQuery(DataSource.DataSet).ParamByName('IBX_PARENT_VALUE').Value :=
        TDBTreeNode(FExpandNode).KeyValue
    else
    if DataSource.DataSet is TIBDataSet then
      TIBDataSet(DataSource.DataSet).ParamByName('IBX_PARENT_VALUE').Value :=
        TDBTreeNode(FExpandNode).KeyValue
  end;
end;

procedure TIBTreeView.UpdateSQL(Sender: TObject; Parser: TSelectSQLParser);
begin
    if not assigned(FExpandNode) and assigned(FUpdateNode)  then {Scrolling dataset}
      Parser.Add2WhereClause(GetRelationNameQualifier + '"' + KeyField + '" = :IBX_KEY_VALUE')
    else
    if (Items.Count = 0) then
      {Need to Load Root Nodes}
      Parser.Add2WhereClause(GetRelationNameQualifier + '"' + ParentField + '" is null')
    else
    if assigned(FExpandNode) then
    begin
      Parser.Add2WhereClause(GetRelationNameQualifier + '"' + ParentField + '" = :IBX_PARENT_VALUE');
      Parser.Add2WhereClause(GetRelationNameQualifier + '"' + KeyField + '" = :IBX_PARENT_VALUE',true);
    end;
end;

procedure TIBTreeView.DataSourceChanged;
begin
    if assigned(DataSource) and (DataSource.DataSet <> nil) and (DataSource.DataSet is TIBParserDataset) then
      FIBTreeViewControllink.IBDataSet := TIBCustomDataSet(DataSource.DataSet)
    else
      FIBTreeViewControllink.IBDataSet := nil;
end;

procedure TIBTreeView.RefreshDataset;
begin
  DataSet.Active := false;
  DataSet.Active := true;
end;

constructor TIBTreeView.Create(TheComponent: TComponent);
begin
  inherited Create(TheComponent);
  FIBTreeViewControlLink := TIBTreeViewControlLink.Create(self);
end;

destructor TIBTreeView.Destroy;
begin
  if assigned(FIBTreeViewControlLink) then FIBTreeViewControlLink.Free;
  inherited Destroy;
end;

end.
Revision:	315
Committed:	Thu Feb 25 11:56:36 2021 UTC (3 years, 8 months ago) by tony
Content type:	text/x-pascal
File size:	5258 byte(s)
Log Message:	Updated for IBX 4 release
#	Content
1	(*
2	* IBX For Lazarus (Firebird Express)
3	*
4	* The contents of this file are subject to the Initial Developer's
5	* Public License Version 1.0 (the "License"); you may not use this
6	* file except in compliance with the License. You may obtain a copy
7	* of the License here:
8	*
9	* http://www.firebirdsql.org/index.php?op=doc&id=idpl
10	*
11	* Software distributed under the License is distributed on an "AS
12	* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
13	* implied. See the License for the specific language governing rights
14	* and limitations under the License.
15	*
16	* The Initial Developer of the Original Code is Tony Whyman.
17	*
18	* The Original Code is (C) 2015 Tony Whyman, MWA Software
19	* (http://www.mwasoftware.co.uk).
20	*
21	* All Rights Reserved.
22	*
23	* Contributor(s): ______________________________________.
24	*
25	*)
26	unit IBTreeView;
27
28	{$mode objfpc}{$H+}
29
30	interface
31
32	uses
33	Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ComCtrls,
34	DB, DBTreeView, IBSQLParser, IBCustomDataSet;
35
36	type
37	{
38	TIBTreeView is intended to be a data aware descendent of TCustomTreeView and used to display
39	hierarchically structured data in a natural manner. Nodes can be deleted, moved
40	and added to the tree and each change is reflected in the underlying dataset. The
41	Node text can similarly be edited.
42	}
43
44	TIBTreeView = class;
45	TIBTreeNode = TDBTreeNode;
46
47	{ TIBTreeViewControlLink }
48
49	TIBTreeViewControlLink = class(TIBControlLink)
50	private
51	FOwner: TIBTreeView;
52	protected
53	procedure UpdateSQL(Sender: TObject); override;
54	procedure UpdateParams(Sender: TObject); override;
55	public
56	constructor Create(AOwner: TIBTreeView);
57	end;
58
59	TIBTreeView = class(TDBTreeView)
60	private
61	{ Private declarations }
62	FIBTreeViewControlLink: TIBTreeViewControlLink;
63	procedure UpdateParams(Sender: TObject; Parser: TSelectSQLParser);
64	procedure UpdateSQL(Sender: TObject; Parser: TSelectSQLParser);
65	protected
66	procedure DataSourceChanged; override;
67	procedure RefreshDataset; override;
68	public
69	{ Public declarations }
70	constructor Create(TheComponent: TComponent); override;
71	destructor Destroy; override;
72	end;
73
74	function StrIntListToVar(s: string): TVariantArray;
75	function VarToStrIntList(a: TVariantArray): string;
76
77	implementation
78
79	uses IBQuery;
80
81	function StrIntListToVar(s: string): TVariantArray;
82	begin
83	Result := DBTreeView.StrIntListToVar(s);
84	end;
85
86	function VarToStrIntList(a: TVariantArray): string;
87	begin
88	Result := DBTreeView.VarToStrIntList(a);
89	end;
90
91
92	{ TIBTreeViewControlLink }
93
94	constructor TIBTreeViewControlLink.Create(AOwner: TIBTreeView);
95	begin
96	inherited Create;
97	FOwner := AOwner;
98	end;
99
100	procedure TIBTreeViewControlLink.UpdateParams(Sender: TObject);
101	begin
102	FOwner.UpdateParams(self,TIBParserDataSet(Sender).Parser)
103	end;
104
105	procedure TIBTreeViewControlLink.UpdateSQL(Sender: TObject);
106	begin
107	FOwner.UpdateSQL(self,TIBParserDataSet(Sender).Parser)
108	end;
109
110
111	procedure TIBTreeView.UpdateParams(Sender: TObject; Parser: TSelectSQLParser);
112	begin
113	if not assigned(FExpandNode) and assigned(FUpdateNode) then {Scrolling dataset}
114	begin
115	if DataSource.DataSet is TIBQuery then
116	TIBQuery(DataSource.DataSet).ParamByName('IBX_KEY_VALUE').Value :=
117	FUpdateNode.KeyValue
118	else
119	if DataSource.DataSet is TIBDataSet then
120	TIBDataSet(DataSource.DataSet).ParamByName('IBX_KEY_VALUE').Value :=
121	FUpdateNode.KeyValue
122	end
123	else
124	if assigned(FExpandNode) then
125	begin
126	if DataSource.DataSet is TIBQuery then
127	TIBQuery(DataSource.DataSet).ParamByName('IBX_PARENT_VALUE').Value :=
128	TDBTreeNode(FExpandNode).KeyValue
129	else
130	if DataSource.DataSet is TIBDataSet then
131	TIBDataSet(DataSource.DataSet).ParamByName('IBX_PARENT_VALUE').Value :=
132	TDBTreeNode(FExpandNode).KeyValue
133	end;
134	end;
135
136	procedure TIBTreeView.UpdateSQL(Sender: TObject; Parser: TSelectSQLParser);
137	begin
138	if not assigned(FExpandNode) and assigned(FUpdateNode) then {Scrolling dataset}
139	Parser.Add2WhereClause(GetRelationNameQualifier + '"' + KeyField + '" = :IBX_KEY_VALUE')
140	else
141	if (Items.Count = 0) then
142	{Need to Load Root Nodes}
143	Parser.Add2WhereClause(GetRelationNameQualifier + '"' + ParentField + '" is null')
144	else
145	if assigned(FExpandNode) then
146	begin
147	Parser.Add2WhereClause(GetRelationNameQualifier + '"' + ParentField + '" = :IBX_PARENT_VALUE');
148	Parser.Add2WhereClause(GetRelationNameQualifier + '"' + KeyField + '" = :IBX_PARENT_VALUE',true);
149	end;
150	end;
151
152	procedure TIBTreeView.DataSourceChanged;
153	begin
154	if assigned(DataSource) and (DataSource.DataSet <> nil) and (DataSource.DataSet is TIBParserDataset) then
155	FIBTreeViewControllink.IBDataSet := TIBCustomDataSet(DataSource.DataSet)
156	else
157	FIBTreeViewControllink.IBDataSet := nil;
158	end;
159
160	procedure TIBTreeView.RefreshDataset;
161	begin
162	DataSet.Active := false;
163	DataSet.Active := true;
164	end;
165
166	constructor TIBTreeView.Create(TheComponent: TComponent);
167	begin
168	inherited Create(TheComponent);
169	FIBTreeViewControlLink := TIBTreeViewControlLink.Create(self);
170	end;
171
172	destructor TIBTreeView.Destroy;
173	begin
174	if assigned(FIBTreeViewControlLink) then FIBTreeViewControlLink.Free;
175	inherited Destroy;
176	end;
177
178	end.