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, 6 months ago) by tony
Content type:	text/x-pascal
File size:	5258 byte(s)
Log Message:	Updated for IBX 4 release
#	User	Rev	Content
1	tony	21	(*
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	tony	23	* The Original Code is (C) 2015 Tony Whyman, MWA Software
19	tony	21	* (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	tony	315	DB, DBTreeView, IBSQLParser, IBCustomDataSet;
35	tony	21
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	tony	315	TIBTreeNode = TDBTreeNode;
46	tony	21
47	tony	27	{ 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	tony	315	TIBTreeView = class(TDBTreeView)
60	tony	21	private
61			{ Private declarations }
62	tony	27	FIBTreeViewControlLink: TIBTreeViewControlLink;
63	tony	21	procedure UpdateParams(Sender: TObject; Parser: TSelectSQLParser);
64			procedure UpdateSQL(Sender: TObject; Parser: TSelectSQLParser);
65			protected
66	tony	315	procedure DataSourceChanged; override;
67			procedure RefreshDataset; override;
68	tony	21	public
69			{ Public declarations }
70			constructor Create(TheComponent: TComponent); override;
71			destructor Destroy; override;
72			end;
73
74	tony	315	function StrIntListToVar(s: string): TVariantArray;
75			function VarToStrIntList(a: TVariantArray): string;
76	tony	21
77			implementation
78
79	tony	315	uses IBQuery;
80	tony	21
81			function StrIntListToVar(s: string): TVariantArray;
82			begin
83	tony	315	Result := DBTreeView.StrIntListToVar(s);
84	tony	21	end;
85
86			function VarToStrIntList(a: TVariantArray): string;
87			begin
88	tony	315	Result := DBTreeView.VarToStrIntList(a);
89	tony	21	end;
90
91	tony	315
92	tony	27	{ 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	tony	21
111			procedure TIBTreeView.UpdateParams(Sender: TObject; Parser: TSelectSQLParser);
112			begin
113			if not assigned(FExpandNode) and assigned(FUpdateNode) then {Scrolling dataset}
114			begin
115	tony	27	if DataSource.DataSet is TIBQuery then
116			TIBQuery(DataSource.DataSet).ParamByName('IBX_KEY_VALUE').Value :=
117	tony	21	FUpdateNode.KeyValue
118			else
119	tony	27	if DataSource.DataSet is TIBDataSet then
120			TIBDataSet(DataSource.DataSet).ParamByName('IBX_KEY_VALUE').Value :=
121	tony	21	FUpdateNode.KeyValue
122			end
123			else
124			if assigned(FExpandNode) then
125			begin
126	tony	27	if DataSource.DataSet is TIBQuery then
127			TIBQuery(DataSource.DataSet).ParamByName('IBX_PARENT_VALUE').Value :=
128	tony	315	TDBTreeNode(FExpandNode).KeyValue
129	tony	21	else
130	tony	27	if DataSource.DataSet is TIBDataSet then
131			TIBDataSet(DataSource.DataSet).ParamByName('IBX_PARENT_VALUE').Value :=
132	tony	315	TDBTreeNode(FExpandNode).KeyValue
133	tony	21	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	tony	315	Parser.Add2WhereClause(GetRelationNameQualifier + '"' + KeyField + '" = :IBX_KEY_VALUE')
140	tony	21	else
141			if (Items.Count = 0) then
142			{Need to Load Root Nodes}
143	tony	315	Parser.Add2WhereClause(GetRelationNameQualifier + '"' + ParentField + '" is null')
144	tony	21	else
145			if assigned(FExpandNode) then
146	tony	143	begin
147	tony	315	Parser.Add2WhereClause(GetRelationNameQualifier + '"' + ParentField + '" = :IBX_PARENT_VALUE');
148			Parser.Add2WhereClause(GetRelationNameQualifier + '"' + KeyField + '" = :IBX_PARENT_VALUE',true);
149	tony	143	end;
150	tony	21	end;
151
152	tony	315	procedure TIBTreeView.DataSourceChanged;
153	tony	21	begin
154	tony	315	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	tony	21	end;
159
160	tony	315	procedure TIBTreeView.RefreshDataset;
161	tony	21	begin
162	tony	315	DataSet.Active := false;
163			DataSet.Active := true;
164	tony	21	end;
165
166			constructor TIBTreeView.Create(TheComponent: TComponent);
167			begin
168			inherited Create(TheComponent);
169	tony	27	FIBTreeViewControlLink := TIBTreeViewControlLink.Create(self);
170	tony	21	end;
171
172			destructor TIBTreeView.Destroy;
173			begin
174	tony	27	if assigned(FIBTreeViewControlLink) then FIBTreeViewControlLink.Free;
175	tony	21	inherited Destroy;
176			end;
177
178			end.