How can I load Field1 and Field2 from TADOQuery to TTreeView? - delphi

I want information from TADOQuery to be loaded into a TTreeView. For example, I want it to be loaded as Field1->Add in Table1 and as Field2->AddChild with buttonClick. But when I run the code, I am getting an error:
Access violation at adress 0043616B in module "TRV2.exe"
I'm making a mistake or something is missing. Can you guide me?
procedure TForm1.AddButtonClick(Sender: TObject);
var
t: Integer;
MyNode, Node : TTreeNode;
begin
MyNode := Node;
t := Node.AbsoluteIndex;
TreeView1.Items.Add(MyNode, ADOQuery1.FieldByName('CODE_NAME').AsString);
end;
procedure TForm1.AddChildButtonClick(Sender: TObject);
var
t: Integer;
MyNode, Node: TTreeNode;
begin
MyNode := Node;
t := Node.AbsoluteIndex;
TreeView1.Items.Add(MyNode, ADOQuery1.FieldByName('CODE_CHILD').AsString);
end;
procedure TForm1.FormCreate(Sender: TObject);
var
t: Integer;
MyNode, Node: TTreeNode;
begin
MyNode := Node;
t := Node.AbsoluteIndex;
ADOQuery1.Open;
end;
UPDATE: I want to get the whole table and update the TTreeView when I add new Add and Child to the database. With these codes (AddButtonClick and AddChildButtonClick) I can only import the first values into the TTreeView. I wonder if a loop is needed?

MyNode and Node are both local variables that you are not initializing to anything. Your AV is because you are trying to access an object that doesn't exist.
Try using a class member instead, where you initialize it with one button click, and then use it with the other button click, eg:
private
MyNode: TTreeNode;
...
procedure TForm1.AddButtonClick(Sender: TObject);
begin
MyNode := TreeView1.Items.Add(nil, ADOQuery1.FieldByName('CODE_NAME').AsString);
end;
procedure TForm1.AddChildButtonClick(Sender: TObject);
begin
if MyNode <> nil then
TreeView1.Items.AddChild(MyNode, ADOQuery1.FieldByName('CODE_CHILD').AsString);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
ADOQuery1.Open;
end;
UPDATE: to iterate through multiple records in the query result, you need to call TADOQuery.Next() in a loop until TADOQuery.Eof is true.

The database was taken into treview with the following codes. There is something missing. Because Field1=Add and Field2=Child. Same Fields repeating.
procedure TForm1.AddButtonClick(Sender: TObject);
var
CurrentDeptID, RecordDeptID: Integer; RootNode, DeptNode: TTreeNode;
begin
CurrentDeptID := 0;
TreeView1.Items.Clear;
RootNode := TreeView1.Items.Add(DeptNode, 'CODE_NAME');
DeptNode := nil;
ADOQuery1.SQL.Text := 'Select * from Tablo1 where CODE_NAME= CODE_NAME';
ADOQuery1.Open;
try
ADOQuery1.First;
while not ADOQuery1.Eof do
begin
RecordDeptID := ADOQuery1.FieldByName('ID').AsInteger;
if ( DeptNode = nil) or (RecordDeptID <> CurrentDeptID) then
begin
DeptNode := TreeView1.Items.AddChild(RootNode,
ADOQuery1.FieldByName('CODE_NAME').AsString); //
CurrentDeptID := RecordDeptID;
end;
TreeView1.Items.AddChild(DeptNode,
ADOQuery1.FieldByName('CODE_CHILD').AsString);
ADOQuery1.Next;
end;
finally
ADOQuery1.close;
end;
end;
[https://i.stack.imgur.com/kNojV.jpg]
Blockquote

Related

OmniThreadLibrary: How to run Parallel.For.Execute without using anonymous procedure?

The Execute method of Parallel.For has a TOmniIteratorDelegate parameter. But I'm unsure on how to assign a procedure to a variable of that type. The reason for doing this is that I do not want to use anonymous procedures.
Is this possible? If yes, can someone show me how to do it?
type
TBookmark = record
URL: String;
PageTitle: String;
end;
PBookmark = ^TBookmark;
var
FBookmarkList: TThreadList<PBookmark>;
procedure TfmMain.FormCreate(Sender: TObject);
begin
FBookmarkList := TThreadList<PBookmark>.Create;
end;
procedure TfmMain.FormDestroy(Sender: TObject);
var
B: PBookmark;
L: TList<PBookmark>;
begin
L := FBookmarkList.LockList;
for B in L do
Dispose(B);
FBookmarkList.UnlockList;
FBookmarkList.Free;
end;
procedure SetValue(const Value: TOmniValue);
begin
// P := Value.ToRecord<PBookmark>;
// P.PageTitle := P.URL;
end;
procedure TfmMain.btRefreshClick(Sender: TObject);
var
L: TList<PBookmark>;
P: TOmniIteratorDelegate<PBookmark>;
t: IOmniParallelLoop<PBookmark>;
begin
P := TOmniIteratorDelegate<PBookmark>(Addr(SetValue)); // <---- Program crashes at runtime on this line!
L := FBookmarkList.LockList;
try
t := Parallel.ForEach<PBookmark>(L).NumTasks(5);
t.Execute(P);
vstBkmk.Clear;
FvstBkmkIter := 0;
vstBkmk.RootNodeCount := L.Count;
finally
FBookmarkList.UnlockList;
end;
end;
I got it to work by changing the definition of the SetValue procedure as illustrated in the code below. Thanks to David Heffernan for pointing me in the right direction.
procedure SetValue(const Value: PBookmark);
var
P: PBookmark;
begin
Value.PageTitle := Value.URL;
end;
procedure TfmMain.btRefreshClick(Sender: TObject);
var
L: TList<PBookmark>;
P: TOmniIteratorDelegate<PBookmark>;
t: IOmniParallelLoop<PBookmark>;
begin
P := SetValue;
L := FBookmarkList.LockList;
try
t := Parallel.ForEach<PBookmark>(L).NumTasks(5);
t.Execute(P);
vstBkmk.Clear;
FvstBkmkIter := 0;
vstBkmk.RootNodeCount := L.Count;
finally
FBookmarkList.UnlockList;
end;
end;

MDI Application, check if a child form with the same caption is open

I have a Delphi MDI application that has a customer search child form which can only be opened once (checking isAssigned), however the view / edit form can be opened multiple times so that the end user can open multiple customers at once (Tabbed), what I'd like to do is be able to stop them from opening the same customer record more than once, on the open of the customer form I set the caption to the customers account reference and if that form exists I would like to .BringToFront, if not I'll create it.
What would be the best way to achieve this please, as I'm scratching my head!
Thanks in advance.
procedure TfrmCustomerSearch.ViewCustomerExecute(Sender: TObject);
begin
screen.cursor := crappstart;
if not IsMDIChildOpen(frmMainMenu, 'frmCustomerView', pfrmCaption) then
frmCustomerView := TfrmCustomerView.createform(nil,dmCustomerSearchfrm.FDQCustSearchreference.Value,cxGrid1DBTableView1.DataController.FocusedRecordIndex)
else
frmCustomerView.BringToFront;
screen.cursor := crdefault;
end;
function TfrmCustomerSearch.IsMDIChildOpen(const AFormName: TForm; const AMDIChildName, AMDICaption : string): Boolean;
var
i: Integer;
begin
Result := False;
for i := Pred(AFormName.MDIChildCount) DownTo 0 do
if (AFormName.MDIChildren[i].name = AMDIChildName) then
begin
if (AFormName.MDIChildren[i].caption = AMDICaption) then
begin
Result := True;
Break;
end
end;
end;
Try something more like this instead:
procedure TfrmCustomerSearch.ViewCustomerExecute(Sender: TObject);
begin
Screen.Cursor := crAppStart;
try
frmCustomerView := TfrmCustomerView(FindMDIChildOpen(frmMainMenu, TfrmCustomerView, pfrmCaption));
if frmCustomerView = nil then
frmCustomerView := TfrmCustomerView.CreateForm(nil, dmCustomerSearchfrm.FDQCustSearchreference.Value, cxGrid1DBTableView1.DataController.FocusedRecordIndex);
frmCustomerView.BringToFront;
finally
Screen.Cursor := crDefault;
end;
end;
function TfrmCustomerSearch.FindMDIChildOpen(const AParentForm: TForm; const AMDIChildClass: TFormClass; const AMDICaption : string): TForm;
var
i: Integer;
Child: TForm;
begin
Result := nil;
for i := Pred(AParentForm.MDIChildCount) DownTo 0 do
begin
Child := AParentForm.MDIChildren[i];
if Child.InheritsFrom(AMDIChildClass) and
(Child.Caption = AMDICaption) then
begin
Result := Child;
Exit;
end;
end;
end;

Object reference to treeview items are changing after undock?

I have a frame with an TLMDDockPanel component as the parent, on the frame there is a TTreeView component:
unit devices;
...
Tmaster = class(TObject)
...
devTreeNode : ttreenode;
...
end;
...
end.
unit deviceTree;
...
TfrmDevTree = class(TFrame)
JvTreeView1: TTreeView;
...
end;
procedure TfrmDevTree.GetSlavesOnSelectedClick(Sender: TObject);
var
Node: TTreeNode;
begin
...
Node := self.JvTreeView1.Selected;
...
end;
...
end.
unit mainForm;
...
TfrmMain = class(TForm)
...
LMDDockSite1: TLMDDockSite;
LMDDockPanel_DevTree: TLMDDockPanel;
...
var
frmDevTree : TfrmDevTree;
...
procedure TfrmMain.FormCreate(Sender: TObject);
begin
...
frmDevTree := TfrmDevTree.Create(self);
frmDevTree.Parent := LMDDockPanel_DevTree;
...
end;
...
end.
At application start, i fill the 'Data' fields for all the nodes of JvTreeView1:
master := Tmaster.create;
Node.Data := master;
master.devtreenode := node; //I also save the treenode that is representing the master in JvTreeView1 into a master field.
The LMDDockPanel_DevTree dock panel is docked at the left of the docksite by default and there is no any problem while the dock panel sits there, but after undocking it, the obj. references for the treenodes are changing so the references stored in the masters (master.devtreenode) are no longer valid.
Can someone please explain why are the treenode references changing? How to avoid this? Should i refresh all the references stored in the masters every time i dock/undock the dock panel?
Thank You.
The reason it happens is because docking/undocking destroys and recreates the TreeView's HWND, which in turn destroys and recreates its node objects. A TreeView is designed to cache and restore the TTreeNode.Data values automatically during this recreation process, but it knows nothing about TMaster.DevTreeNode. As such, you need to detect when the nodes have been recreated so you can manually update their DevTreeNode values with the new TTreeNode pointers.
A TreeView has OnAddition and OnDeletion events that one would think would be ideal for this task. However, they are inconveniently NOT triggered during HWND recreation!
So you have two choices:
subclass the TreeView's WindowProc property to catch the recreation messages.
private
{ Private declarations }
DefTreeViewWndProc: TWndMethod;
procedure TreeViewWndProc(var Message: TMessage);
procedure TfrmDevTree.FormCreate(Sender: TObject);
begin
DefTreeViewWndProc := JvTreeView1.WindowProc;
JvTreeView1.WindowProc := TreeViewWndProc;
end;
procedure UpdateMasterDevNode(Node: TTreeNode; Destroying: Boolean);
var
Child: TTreeNode;
begin
if Node.Data <> nil then
begin
if Destroying then
TMaster(Node.Data).DevTreeNode := nil
else
TMaster(Node.Data).DevTreeNode := Node;
end;
Child := Node.getFirstChild;
while Child <> nil do
begin
UpdateMasterDevNode(Child, Destroying);
Child := Child.getNextSibling;
end;
end;
procedure UpdateMasterDevNodes(Nodes: TTreeNodes; Destroying: Boolean);
var
Node: TTreeNode;
begin
Node := Nodes.GetFirstNode;
while Node <> nil do
begin
UpdateMasterDevNode(Node, Destroying);
Node := Node.getNextSibling;
end;
end;
procedure TfrmDevTree.TreeViewWndProc(var Message: TMessage);
const
WM_UPDATEMASTERDEVNODES = WM_APP + 1;
begin
if Message.Msg = CM_RECREATEWND then
UpdateMasterDevNodes(JvTreeView1.Items, True);
DefTreeViewWndProc(Message);
if Message.Msg = WM_CREATE then
begin
// the cached nodes have not been recreated yet, so delay the DevTreeNode updates
PostMessage(TreeView1.Handle, WM_UPDATEMASTERDEVNODES, 0, 0)
end
else if Message.Msg = WM_UPDATEMASTERDEVNODES then
UpdateMasterDevNodes(JvTreeView1.Items, False);
end;
use an interceptor class to override the virtual CreateWnd() and DestroyWnd() methods.
type
TJvTreeView = class(JVCL.ListsAndTrees.Trees.TJvTreeView)
protected
procedure CreateWnd; override;
procedure DestroyWnd; override;
end;
TfrmDevTree = class(TForm)
JvTreeView1: TJvTreeView;
...
end;
procedure UpdateMasterDevNode(Node: TTreeNode; Destroying: Boolean);
var
Child: TTreeNode;
begin
if Node.Data <> nil then
begin
if Destroying then
TMaster(Node.Data).DevTreeNode := nil
else
TMaster(Node.Data).DevTreeNode := Node;
end;
Child := Node.getFirstChild;
while Child <> nil do
begin
UpdateMasterDevNode(Child, Destroying);
Child := Child.getNextSibling;
end;
end;
procedure UpdateMasterDevNodes(Nodes: TTreeNodes; Destroying: Boolean);
var
Node: TTreeNode;
begin
Node := Nodes.GetFirstNode;
while Node <> nil do
begin
UpdateMasterDevNode(Node, Destroying);
Node := Node.getNextSibling;
end;
end;
procedure TJvTreeView.CreateWnd;
begin
inherited;
UpdateMasterDevNodes(Items, False);
end;
procedure TTreeView.DestroyWnd;
begin
if csRecreating in ControlState then
UpdateMasterDevNodes(Items, True);
inherited;
end;
Either way, be sure that any code which uses TMaster.DevTreeNode checks for nil first before using the TTreeNode.

How to retrieve data from database and display in Ttreeview in delphi

Please help me to populate a tree view from SQL database dynamically. I am very new to delphi
and step by step processes are welcome. I have two table formats given in the picture below and i want to fill the tree view from database accordingly. I searched on other resource sites also but didn't find the solution what i am looking for.
I am stuck. Please help me guys....
Many many thanks in advance.
procedure TForm1.Button1Click(Sender: TObject);
var
// node : TTreeList;
i: Integer;
MyTreeNode1,MyTreeNode2 : TTreeNode;
begin
with TreeList1.Items do
begin
Clear;
MyTreeNode1 := Add(nil, 'Table');
ADOTable1.First;
while ADOTable1 do
begin
AddChild(MyTreeNode1,'B') ;
AddChild(MyTreeNode1,'c');
Next;
end;
end;
end;
Switch to TADOQuery and then try something like this:
procedure TForm1.Button1Click(Sender: TObject);
var
CurrentDeptID, RecordDeptID: Integer;
RootNode, DeptNode: TTreeNode;
begin
CurrentDeptID := 0;
TreeList1.Items.Clear;
RootNode := TreeList1.Items.Add(nil, 'Departments');
DeptNode := nil;
ADOQuery1.SQL.Text := 'SELECT sd.DeptID, sd.Name, d.Dept FROM SubDepartments sd INNER JOIN Departments d ON (sd.DeptID = d.DeptID) ORDER BY d.Dept, sd.Name';
ADOQuery1.Open;
try
ADOQuery1.First;
while not ADOQuery1.Eof do
begin
RecordDeptID := ADOQuery1.FieldByName('DeptID').AsInteger;
if (DeptNode = nil) or (RecordDeptID <> CurrentDeptID) then
begin
DeptNode := TreeList1.Items.AddChild(RootNode, ADOQuery1.FieldByName('Dept').AsString);
CurrentDeptID := RecordDeptID;
end;
TreeList1.Items.AddChild(DeptNode, ADOQuery1.FieldByName('Name').AsString);
ADOQuery1.Next;
end;
finally
ADOQuery1.Close;
end;
end;

Sortable DBGrid

I want to implement a sortable DBgrid (that sorts its rows when clicked on column title). I managed to make it sortable in an ascending order but I can't do it in a descending order. Here are my design settings:
Query1.DatabaseName:='Test';
DataSetProvider1.DataSet:=Query1;
ClientDataSet1.ProviderName:=DataSetProvider1;
DataSource1.DataSet:=ClientDataSet1;
DBGrid1.DatSource:=DataSource1;
And here are fragments of my code:
procedure TForm2.FormShow(Sender: TObject);
begin
Query1.Open;
ClientDataSet1.Data:=DataSetProvider1.Data;
ClientDataSet1.AddIndex('objnameDESC','objname',[ixDescending]);
ClientDataSet1.AddIndex('SUM(cd.worktime)DESC','SUM(cd.worktime)',[ixDescending]);
end;
procedure TForm2.DBGrid1TitleClick(Column: TColumn);
begin
case Column.Index of
0: if ClientDataSet1.IndexFieldNames='objname' then
ClientDataSet1.IndexFieldNames:='objnameDESC'
else
ClientDataSet1.IndexFieldNames:='objname';
1: if ClientDataSet1.IndexFieldNames='SUM(cd.worktime)' then
ClientDataSet1.IndexFieldNames:='SUM(cd.worktime)DESC'
else
ClientDataSet1.IndexFieldNames:='SUM(cd.worktime)';
end;
end;
When I click on a column title for the first time, sorting is done in an ascending order - so up to here everything is OK. When I click for the second time I expect sorting in a descending order to be done but instead I get the message:
Project ... raised Exception class EDatabaseError with message
'ClientDataSet1: Field 'objnameDESC' not found'.
Any ideas about what I am doing wrong?
As you are already using TClientDataSet you might make use of a component I made for exactly that purpose. Create an instance, set its Grid property and it will automatically connect to the OnTitleClick event.
type
TDBGridSorter = class(TComponent)
strict private
FSortColumn: TColumn;
FGrid: TDBGrid;
procedure CreateIndex(const FieldName: string; Descending: Boolean);
function GetDataSet: TClientDataSet;
function MakeIndexName(const FieldName: string; Descending: Boolean): string;
procedure SetSortColumn(const Value: TColumn);
procedure SortByField(const FieldName: string; out Descending: Boolean);
private
procedure SetGrid(const Value: TDBGrid);
strict protected
procedure GridTitleClick(Column: TColumn);
property DataSet: TClientDataSet read GetDataSet;
public
property Grid: TDBGrid read FGrid write SetGrid;
property SortColumn: TColumn read FSortColumn write SetSortColumn;
end;
procedure TDBGridSorter.CreateIndex(const FieldName: string; Descending: Boolean);
var
cds: TClientDataSet;
indexDef: TIndexDef;
indexName: string;
begin
cds := DataSet;
if cds <> nil then begin
indexName := MakeIndexName(FieldName, Descending);
if cds.IndexDefs.IndexOf(indexName) < 0 then begin
indexDef := cds.IndexDefs.AddIndexDef;
indexDef.Name := indexName;
indexDef.Fields := FieldName;
indexDef.CaseInsFields := FieldName;
if Descending then
indexDef.DescFields := FieldName;
end;
end;
end;
function TDBGridSorter.GetDataSet: TClientDataSet;
begin
if (Grid <> nil) and (Grid.DataSource <> nil) and (Grid.DataSource.DataSet is TClientDataSet) then
Result := TClientDataSet(Grid.DataSource.DataSet)
else
Result := nil;
end;
procedure TDBGridSorter.GridTitleClick(Column: TColumn);
begin
SortColumn := Column;
end;
function TDBGridSorter.MakeIndexName(const FieldName: string; Descending: Boolean): string;
const
cAscDesc: array[Boolean] of string = ('_ASC', '_DESC');
begin
Result := FieldName + cAscDesc[Descending];
end;
procedure TDBGridSorter.SetGrid(const Value: TDBGrid);
begin
if FGrid <> Value then begin
if FGrid <> nil then begin
FGrid.OnTitleClick := nil;
FGrid.RemoveFreeNotification(Self);
end;
FGrid := Value;
if FGrid <> nil then begin
FGrid.FreeNotification(Self);
FGrid.OnTitleClick := GridTitleClick;
end;
end;
end;
procedure TDBGridSorter.SetSortColumn(const Value: TColumn);
const
cOrder: array[Boolean] of string = ('˄', '˅');
var
descending: Boolean;
S: string;
begin
if FSortColumn <> nil then begin
S := FSortColumn.Title.Caption;
if StartsStr(cOrder[false], S) or StartsStr(cOrder[true], S) then begin
Delete(S, 1, 2);
FSortColumn.Title.Caption := S;
end;
end;
FSortColumn := Value;
if FSortColumn <> nil then begin
SortByField(FSortColumn.FieldName, descending);
FSortColumn.Title.Caption := Format('%s %s', [cOrder[descending], FSortColumn.Title.Caption]);
end;
end;
procedure TDBGridSorter.SortByField(const FieldName: string; out Descending:
Boolean);
var
cds: TClientDataSet;
curIndex: TIndexDef;
N: Integer;
begin
cds := DataSet;
if cds <> nil then begin
descending := false;
N := cds.IndexDefs.IndexOf(cds.IndexName);
if N >= 0 then begin
curIndex := cds.IndexDefs[N];
if SameText(FieldName, curIndex.Fields) then
descending := not (ixDescending in curIndex.Options)
end;
{ make sure the index exists }
CreateIndex(FieldName, descending);
cds.IndexName := MakeIndexName(FieldName, descending);
end;
end;
Wrong assignment
Apart from the fact that an incorrect assignment is made, a switch back to "ascending" is not possible.
For 2 Colums you need 4 Indexes.
Assuming 'objname' and 'SUM(cd.worktime)' are Fields.
procedure TForm2.FormShow(Sender: TObject);
....
ClientDataSet1.AddIndex('col0_asc','objname',[]);
ClientDataSet1.AddIndex('col0_desc','objname',[ixDescending]);
ClientDataSet1.AddIndex('col1_asc','SUM(cd.worktime)',[]);
ClientDataSet1.AddIndex('col1_desc','SUM(cd.worktime)',[ixDescending]);
....
Use ClientDataSet1.IndexName
procedure TForm2.DBGrid1TitleClick(Column: TColumn);
begin
case Column.Index of
0: if ClientDataSet1.IndexName='col0_asc' then
ClientDataSet1.IndexName:='col0_desc'
else
ClientDataSet1.IndexName:='col0_asc';
1: if ClientDataSet1.IndexName='col1_asc' then
ClientDataSet1.IndexName:='col1_desc'
else
ClientDataSet1.IndexName:='col1_asc';
end;
....
Or shorter
procedure TForm2.DBGrid1TitleClick(Column: TColumn);
begin
if ClientDataSet1.IndexName='col'+IntToStr(Column.Index)+'_asc' then
ClientDataSet1.IndexName:='col'+IntToStr(Column.Index)+'_desc'
else
ClientDataSet1.IndexName:='col'+IntToStr(Column.Index)+'_asc';
....
But it is better to test the number of columns that are active (AddIndex = done).
procedure TForm2.DBGrid1TitleClick(Column: TColumn);
begin
if Column.Index < 2 then begin
if ClientDataSet1.IndexName='col'+IntToStr(Column.Index)+'_asc' then
ClientDataSet1.IndexName:='col'+IntToStr(Column.Index)+'_desc'
else
ClientDataSet1.IndexName:='col'+IntToStr(Column.Index)+'_asc';
end;
....
You should be setting the IndexName and not IndexFieldNames. IndexFieldNames accepts field names and creates an index on the fly.
procedure TForm2.DBGrid1TitleClick(Column: TColumn);
begin
case Column.Index of
0: if ClientDataSet1.IndexFieldNames='objname' then
ClientDataSet1.IndexName:='objnameDESC'
else
ClientDataSet1.IndexFieldNames:='objname';
1: if ClientDataSet1.IndexFieldNames='SUM(cd.worktime)' then
ClientDataSet1.IndexFieldNames:='SUM(cd.worktime) DESC'
else
ClientDataSet1.IndexFieldNames:='SUM(cd.worktime)';
end;
end;
Many of my programs need this, so I wrote a general procedure which builds two indices for each field in the dataset
Procedure BuildIndices (cds: TClientDataSet);
var
i, j: integer;
alist: tstrings;
begin
with cds do
begin
open;
for i:= 0 to FieldCount - 1 do
if fields[i].fieldkind <> fkCalculated then
begin
j:= i * 2;
addindex ('idx' + inttostr (j), fieldlist.strings[i], [], '', '', 0);
addindex ('idx' + inttostr (j+1), fieldlist.strings[i], [ixDescending], '', '',0);
end;
alist:= tstringlist.create;
getindexnames (alist);
alist.free;
close;
end;
end;
At this stage, I have indices idx0 and idx1 for the first field, idx2 and idx3 for the second field, etc.
Then, in the form which displays the dbgrid (here the active query is called qShowFees)
procedure TShowFees.DBGrid1TitleClick(Column: TColumn);
var
n, ex: word;
begin
n:= column.Index;
try
dbGrid1.columns[prevcol].title.font.color:= clNavy
except
end;
dbGrid1.columns[n].title.font.color:= clRed;
prevcol:= n;
directions[n]:= not directions[n];
ex:= n * 2;
if directions[n] then inc (ex);
with qShowFees do
try
disablecontrols;
close;
indexname:= 'idx' + inttostr (ex);
open
finally
enablecontrols
end;
end;
'Directions' is a form array of booleans which 'remembers' which way each column is currently sorted (ascending or descending) so clicking the dbgrid's title bar a second time will cause the grid to be sorted in the opposing manner to which it was sorted before. 'Prevcol' is a form variable which stores the currently selected column; this is saved between invocations, so the next time the user opens the form, it is sorted in the same way as she left it previously.

Resources