create a popupmenu from a SQL [duplicate] - delphi

I have a table like this:
id parent_id name
1 1 Root
2 1 Car
3 1 Plane
4 2 BMW
5 4 CLK
How can I dynamically create popup menu with all subitems in Delphi?
This is how it should look like:

Assuming root element has NULL as Parent_ID you can issue the request
Select ID, Parent_ID, Name from all_my_menus
order by Parent_ID nulls first, ID
where Menu_ID = :MenuIDParameter
1 <NULL> Root
8 <NULL> another root
2 1 Car
4 1 Plane
3 2 BMW
5 4 CLK
You would also cache in-memory created menu items: var MI_by_id: TDictionary<integer, TMenuItem>;
The traversing through the results would look like
var MI: TMenuItem;
MI_by_id: TDictionary<integer, TMenuItem>;
begin
MI_by_id := TDictionary<integer, TMenuItem>.Create;
try
While not Query.EOF do begin
MI := TMenuItem.Create(Self);
MI.Caption := Query.Fields[2].AsString;
MI.Tag := Query.Fields[0].AsInteger; // ID, would be helpful for OnClick event
MI.OnClick := ...some click handler
if Query.Fields[1].IsNull {no parent}
then MainMenu.Items.Add(MI)
else MI_by_id.Items[Query.Fields[1].AsInteger].Add(MI);
MI_by_id.Add(MI.Tag, MI); //save shortcut to potential parent for future searching
Query.Next;
end;
finally
MI_by_id.Free;
end;
end;
Actually, since we made sort upon Parent_ID on the query, all the children for given parent make single continuous list, so could be better to remove populated parents from the dictionary after we populated last child (i.e. after parent_ID got new value) and caching previously found parent otherwise in another local variable (instead of making yet another search through the dictionary).
However reasonable size for human-targeted menu should be much less to worth this. But you have to understand this approach most probably scales as O(n*n) thus would start loose speed very fast as the table grows.
http://docwiki.embarcadero.com/Libraries/XE3/en/Vcl.Menus.TMenuItem.Add
http://docwiki.embarcadero.com/CodeExamples/XE2/en/Generics.Collections.TDictionary_(Delphi)
Note: this also requires that for every non-root element ID > ParentID (put CHECK CONSTRAINT on the table)
1 <NULL> Root
8 <NULL> another root
7 1 Plane
3 4 BMW
4 7 CLK
5 8 Car
This would lead to BMW tied to create before its parent CLK created.
Violation for that conditions can be overcome by few means:
recursive load: select <items> where Parent_id is null, then for each of the added menu items do select <items> where Parent_id = :current_memuitem_id and so on that. This is like VirtualTreeView would work
ask SQL server to sort and flatten the tree - this is usually called self-recursive SQL selection and is server-dependant.
introduce one more collection variable - menu items w/o parent. After each new item added to the menu this collection should be searched if there are pending children to extract from it and move into the newly created parent.

Too many solutions for such a simple problem. Too bad you got ordered ID's because without ordered ID's things would have been more fun. Here's my own solution. On an empty form drop a button, a TClientDataSet and a TPopupMenu. Make the form's PopupMenu = PopupMenu1 so you can see the result. Add this to Button1.OnClick:
Note: I'm intentionally using TClientDataSet and not a real Query. This question is not about the query and this solution works with whatever TDataSet descendant you throw at it. Just make sure the result set is ordered on id, or else you could see the child nodes before the parents. Also note, half the code is used to fill up the ClientDataSet with the sample data in the question!
procedure TForm16.Button1Click(Sender: TObject);
var Prev: TDictionary<Integer, TMenuItem>; // We will use this to keep track of previously generated nodes so we do not need to search for them
CurrentItem, ParentItem: TMenuItem;
begin
if not ClientDataSet1.Active then
begin
// Prepare the ClientDataSet1 structure
ClientDataSet1.FieldDefs.Add('id', ftInteger);
ClientDataSet1.FieldDefs.Add('parent_id', ftInteger);
ClientDataSet1.FieldDefs.Add('name', ftString, 100);
ClientDataSet1.CreateDataSet;
// Fill the dataset
ClientDataSet1.AppendRecord([1, 1, 'Root']);
ClientDataSet1.AppendRecord([2, 1, 'Car']);
ClientDataSet1.AppendRecord([3, 1, 'Plane']);
ClientDataSet1.AppendRecord([4, 2, 'BMW']);
ClientDataSet1.AppendRecord([5, 4, 'CLK']);
end;
// Clear the existing menu
PopupMenu1.Items.Clear;
// Prepare the loop
Prev := TDictionary<Integer, TMenuItem>.Create;
try
ClientDataSet1.First; // Not required for a true SQL Query, only required here for re-entry
while not ClientDataSet1.Eof do
begin
CurrentItem := TMenuItem.Create(Self);
CurrentItem.Caption := ClientDataSet1['name'];
if (not ClientDataSet1.FieldByName('parent_id').IsNull) and Prev.TryGetValue(ClientDataSet1['parent_id'], ParentItem) then
ParentItem.Add(CurrentItem)
else
PopupMenu1.Items.Add(CurrentItem);
// Put the current Item in the dictionary for future reference
Prev.Add(ClientDataSet1['id'], CurrentItem);
ClientDataSet1.Next;
end;
finally Prev.Free;
end;
end;

Try this
procedure TForm1.MyPopup(Sender: TObject);
begin
with Sender as TMenuItem do ShowMessage(Caption);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
MyItem,MySubItem1: TMenuItem;
begin
Inc(Num);
MyItem:=TMenuItem.Create(Self);
MySubItem1:=TMenuItem.Create(Self);
MyItem.Caption:='Hello'+IntToStr(Num);
MySubItem1.Caption:='Good Bye'+IntToStr(Num);
MainMenu1.Items.Add(MyItem);
MainMenu1.Items[0].Insert(num-1,MySubItem1);
MyItem.OnClick:=MyPopUp;
MySubItem1.OnClick:=MyPopUp;
end;
Taken from http://www.greatis.com/delphicb/tips/lib/components-addmenuitem.html

This solution requires parent_id of root to be 0, tested with
Select 1 as ID, 0 as Parent_ID, 'Root' as Name
union
Select 2, 1, ' Car'
union
Select 3 , 1, 'Plane'
union
Select 4, 2, 'BMW'
union
Select 5, 4, 'CLK'
should by optimized, have just a lack of time ...
Function GetMenu(pop:TPopupmenu;ID:Integer):TMenuItem;
var
i:Integer;
Function CheckItem(mi:TMenuItem):TMenuItem;
var
i:Integer;
begin
Result := nil;
if mi.Name = 'DYN_' + INtToStr(ID) then Result := mi
else for i := 0 to mi.Count-1 do
if not Assigned(Result) then Result := CheckItem(mi[i]);
end;
begin
Result := nil;
for i := 0 to pop.Items.Count-1 do
begin
if not Assigned(Result) then Result := CheckItem(pop.Items[i]);
if Assigned(Result) then Break;
end;
end;
Function InsertMenuItem(pop:TPopupMenu;mi:TMenuItem;ID:Integer;Const caption:String):TMenuItem;
begin
Result := TMenuItem.Create(pop);
Result.Caption := caption;
Result.Name := 'DYN_' + INtToStr(ID) ;
if not Assigned(mi) then pop.Items.Add(Result) else mi.Add(Result);
end;
Function AddMenuItem(pop:TPopupmenu;ID:Integer;Ads:TDataset):TMenuItem;
begin
Ads.Locate('ID',ID,[]);
Result := GetMenu(pop,id);
if (not Assigned(Result)) then
begin
if (Ads.FieldByName('parent_ID').AsInteger<>0) then
begin
result := AddMenuItem(pop,Ads.FieldByName('parent_ID').AsInteger,Ads);
Ads.Locate('ID',ID,[]);
end;
Result := InsertMenuItem(pop,Result,ID,Ads.FieldByName('Name').AsString);
end;
Ads.Locate('ID',ID,[]);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
while not ADS.Eof do
begin
AddMenuItem(Popupmenu1,ads.FieldByName('ID').AsInteger,Ads);
Ads.Next
end;
end;

Interesting conundrum ...another late night thought, a practical answer for re-use :)
Make a derived component:
type
TCascadeMenuItem = class(TMenuItem)
private
Id: Integer;
public
function AddItem(const ToId, WithId: Integer; AName: string): Boolean;
end;
with code
function TCascadeMenuItem.AddItem(const ToId, WithId: Integer; AName: string): Boolean;
var
i: Integer;
cmi: TCascadeMenuItem;
begin
if ToId = Id then
begin
cmi := TCascadeMenuItem.Create(Owner);
cmi.Caption := AName;
cmi.Id := WithId;
Add(cmi);
Result := True;
end
else begin
i := 0;
Result := False;
while (i < Count) and (not Result) do
begin
Result := TCascadeMenuItem(Items[i]).AddItem(ToId,WithId, ANAme);
inc(i);
end;
end;
end;
Main form, Assumes your data:
procedure TForm4.Button2Click(Sender: TObject);
var
mi: TCascadeMenuItem;
i: Integer;
Added: Boolean;
begin
cds1.First;
while not cds1.Eof do
begin
i := 0;
Added := False;
while (i < pup.Items.Count) and (not Added) do
begin
Added := TCascadeMenuItem(pup.Items[i]).AddItem(cds1Parent_Id.AsInteger, cds1id.AsInteger, cds1name.AsString);
inc(i);
end;
if not Added then
begin // new root
mi := TCasCadeMenuItem.Create(Self);
mi.Caption := cds1name.AsString;
mi.id := cds1Parent_Id.AsInteger;
pup.Items.Add(mi);
end;
cds1.Next;
end;
end;
You could derive a TCascasePopupMenu and put it on the palette :)

Related

Recursive procedure for getting child records in hierarchical dataset

I have a data table (MDTasks) that has records represented in a tree view. Each record has a unique field, 'ID', and a field 'Parent_ID', which refers to the ID of the parent. I am trying to make a list of all the children at any level of a record with a given ID. I have the following, which gets the first child at each level, but doesn't go back up to get the siblings at any level. I would be grateful for any help. Thank you.
procedure TfmList.GetChildren(TaskID: integer);
var
iChildID: integer;
begin
with MDTasks do
begin
first;
while not EOF do
begin
if FieldByName('Parent_ID').AsInteger = TaskID then
begin
iChildID := FieldByName('ID').AsInteger;
Memo1.Lines.Add(IntToStr(iChildID));
GetChildren(iChildID);
end;
next;
end;
end;
end;
The code below should do what you want, if I understand you correctly. It uses a ClientDataSet so that my answer is self contained and so that the test data can easily be set up.
It uses a call to CloneCursor to do the recursive search for the children of the specified parent node ID.
procedure TForm1.FormCreate(Sender: TObject);
begin
CDS1.CreateDataSet;
CDS1.InsertRecord([1, -1]);
CDS1.InsertRecord([2, -1]);
CDS1.InsertRecord([3, -1]);
CDS1.InsertRecord([4, 2]); // This and the following rows are all children of ID = 2
CDS1.InsertRecord([5, 2]);
CDS1.InsertRecord([6, 4]);
CDS1.InsertRecord([7, 4]);
CDS1.InsertRecord([8, 7]);
FindChildren(2);
end;
procedure TForm1.FindChildren(ParentID : Integer);
procedure FindChildrenInner(ParentID : Integer);
var
TempCDS : TClientDataSet;
ID : Integer;
begin
TempCDS := TClientDataSet.Create(Nil);
try
TempCDS.CloneCursor(CDS1, False, True);
TempCDS.First;
while not TempCDS.Eof do begin
if TempCDS.FieldByName('Parent_ID').AsInteger = ParentID then begin
ID := TempCDS.FieldByName('ID').AsInteger;
Memo1.Lines.Add(Format('ID: %d, Parent: %d', [ID, ParentID]));
FindChildrenInner(ID);
end;
TempCDS.Next;
end;
finally
TempCDS.Free;
end;
end;
begin
Memo1.Lines.BeginUpdate;
try
Memo1.Lines.Clear;
Assert(CDS1.Locate('ID', ParentID, []));
FindChildrenInner(ParentID);
finally
Memo1.Lines.EndUpdate;
end;
end;
Looking at the code, I would say that it gets all the childs at the last level (not only first one). The problem is that you "share" the dataset (MDTasks) between levels - so when the last level iterates to the end of the table and returns to the caller the while not EOF do evaluates to false (on the parent level now) and loop ends, thus only the first child is gotten on levels above the last one.
One solution would be to iterate each level fully, logging Parent_IDs into local array, then use that array to get the next level below it.
Another solution is probably to use bookmarks in the table MDTasks. Let your procedure set a bookmark at the beginning and return to this bookmark at the end so the position/cursor in MDTasks is not changed from GetChildren.
your problem is that you are calling recursive function against the same data. you can use filtering, for example:
procedure GoGoGo (Id: integer);
var
OldFilter: string;
begin
OldFilter := Table.Filter;
Table.Filter := 'ParentId = ' + IntToStr (Id);
try
Table.First;
while not Table.Eof do begin
Memo.Lines.Add (Format('ID: %d, Parent: %d',
[Table.FieldByName ('I'd).AsInteger,
Table.FieldByName ('ParentID').AsInteger]));
GoGoGo (Table.FieldByName ('Id').AsInteger);
if Table.Locate ('Id', Id, []) then
Table.Next;
end;
finally
Table.Filter := OldFilter;
end;
end;
<...>
Memo.Lines.Clear;
Table.Filtered := TRUE;
Table.First;
GoGoGo (Table.FieldByName ('Id').AsInteger);
haven't tested this code, it may contain errors, but hopefully, idea is quite clear. with the same idea you can use another approaches, like create new TQuery with dynamically generated where clause, etc. I'm not a fan of such things just because in a really big tree, creating new objects in every iteration of recursive function may result in a stack overflow.
gl there ;)

Load database field of all records into ListView Item Detail Object

Using Delphi XE8 I'm currently testing functionality with Firemonkey TListViews.
One thing I'm trying to do is to load a field of all records from a TFDMemtable component into a Listview Item, specifically into the DetailObject of the ListView Item.
For example, I have 3 records in a table (db field is called 'Name'):
Record 1 = Name 1
Record 2 = Name 2
Record 3 = Name 3
There is only 1 DetailObject property per ListView Item so my question is, would I be able to add all of the fields (Name 1, Name 2, Name 3) into that one DetailObject?
Below is what I've attempted so far but no luck. Not 100% sure what I need to do.
procedure MainForm.BuildList;
var LItem : TListViewItem;
begin
ListView1.BeginUpdate;
try
ListView1.CLearItems;
LItem := ListView1.Items.Add;
LItem.Objects.DetailObject.Visible := True;
with memtable do
begin
while not eof do
begin
LItem.Detail := FieldByName('Name').AsString;
end;
end;
finally
ListView1.EndUpdate;
end;
end;
I'm sorry if this isn't clear enough, please let me know.
Any help would be great.
I think I should warn you that before seeing your q, I'd never done anything with FMX ListViews and Master/Detail datasets. The Following is a little rough around the edges, and the layout isn't ideal, but it shows one way to populate a ListView from Master + Detail datasets. I have no idea whether there are better ways. Personally, I would see if I could use Live Bindings to do the job.
procedure TMasterDetailForm.BuildList;
var
LItem : TListViewItem;
DetailItem : TListViewItem;
ListItemText : TListItemText;
DetailIndex : Integer;
begin
ListView1.BeginUpdate;
ListView1.ItemAppearanceObjects.ItemEditObjects.Text.TextVertAlign := TTextAlign.Leading; // The default
// seems to be `Center`, whereas we want the Master field name to be at the top of the item
try
ListView1.Items.Clear; //Items;
Master.First;
while not Master.eof do begin
LItem := ListView1.Items.Add;
LItem.Text := Master.FieldByName('Name').AsString;
LItem.Height := 25;
Detail.First;
DetailIndex := 0;
while not Detail.Eof do begin
Inc(DetailIndex);
ListItemText := TListItemText.Create(LItem);
ListItemText.PlaceOffset.X := 100;
ListItemText.PlaceOffset.Y := 25 * (DetailIndex - 1);
ListItemText.TextAlign := TTextAlign.Leading;
ListItemText.Name := 'Name' + IntToStr(DetailIndex); //Detail.FieldByName('Name').AsString;
LItem.Data['Name' + IntToStr(DetailIndex)] := Detail.FieldByName('Name').AsString;
Detail.Next;
end;
LItem.Height := LItem.Height * (1 + DetailIndex);
Master.Next;
end;
finally
ListView1.EndUpdate;
end;
end;
TListItemText is one of a number of "drawable" FMX objects that can be added to do the TListViewItem. They seem to need unique names so that they can be accessed via the Names property.
FWIW, I used 2 TClientDataSets as the Master and Detail in my code.
Also FWIW, for FMX newbies like me, populating an FMX TreeView is a lot more like what you'd do in a VCL project:
procedure TMasterDetailForm.BuildTree;
var
PNode,
ChildNode : TTreeViewItem;
begin
TreeView1.BeginUpdate;
try
TreeView1.Clear;
Master.First;
while not Master.eof do begin
PNode := TTreeViewItem.Create(TreeView1);
TreeView1.AddObject(PNode);
PNode.Text := Master.FieldByName('Name').AsString;
Detail.First;
while not Detail.Eof do begin
ChildNode := TTreeViewItem.Create(TreeView1);
ChildNode.Text := Detail.FieldByName('Name').AsString;
PNode.AddObject(ChildNode);
Detail.Next;
end;
Master.Next;
end;
finally
TreeView1.EndUpdate;
end;
end;
Btw, in your code you should have been calling
memtable.Next;
in your while not eof loop, and memtable.First immediately before the loop.

Updating field in cxGrid acting strange

I have a function to update a cxGrid made with help from answers to Loop through records on a cxgrid and update a field/column
But it is sometimes acting a bit strange. If I open the form with the cxGrid and click the columnheader without doing anything else, the records are updateted OK. But if the 'selectorbar' is moved away from the top, the record marked is not updated.
I am sure it is a property that needs to be changed, but which one.
The variable fSelected is set to False at FormShow and is ther so that the user can unselect records as well.
procedure TfrmContactsSelect.colContactSelectedHeaderClick(Sender: TObject);
var
i: Integer;
Index: Integer;
BookMark : TBookMark;
Contact: variant;
begin
if fMulti = True then
begin
Screen.Cursor := crHourGlass;
fSelected := not fSelected;
BookMark := qryContacts.GetBookmark;
qryContacts.DisableControls;
try
for i := 0 to grdContactsView1.DataController.FilteredRecordCount - 1 do
begin
Index := grdContactsView1.DataController.FilteredRecordIndex[i];
Contact := grdContactsView1.DataController.Values[Index, 4];
if grdContactsView1.DataController.LocateByKey(Contact) then
begin
qryContacts.Edit;
qryContacts.FieldByName('fldcontact_selected').AsBoolean := fSelected;
qryContacts.Post;
end;
end;
finally
qryContacts.EnableControls;
qryContacts.GotoBookmark(BookMark);
qryContacts.FreeBookmark(BookMark);
end;
Screen.Cursor := crDefault;
end;
end;
Delphi XE7, DevExpress 14.2.2, UniDAC 5.5.12 for DB access
Comment:
I have ended up with the following solution based on the answer and input from MartynA
procedure TfrmContactsSelect.colContactSelectedHeaderClick(Sender: TObject);
var
i: Integer;
Index: Integer;
MarkedRecord: variant;
CurrentRecord: variant;
begin
if fMulti = True then
begin
Screen.Cursor := crHourGlass;
fSelected := not fSelected;
Index := grdContactsView1.DataController.FocusedRecordIndex;
MarkedRecord := grdContactsView1.DataController.Values[Index, colContactGuid.ID];
try
for i := 0 to grdContactsView1.DataController.FilteredRecordCount - 1 do
begin
Index := grdContactsView1.DataController.FilteredRecordIndex[i];
CurrentRecord := grdContactsView1.DataController.Values[Index, colContactGuid.ID];
if grdContactsView1.DataController.LocateByKey(CurrentRecord) then
begin
grdContactsView1.DataController.Edit;
grdContactsView1.DataController.SetEditValue(colContactSelected.ID, fSelected, evsText);
grdContactsView1.DataController.Post;
end;
end;
finally
grdContactsView1.DataController.LocateByKey(MarkedRecord);
end;
Screen.Cursor := crDefault;
end;
end;
I can reproduce your problem using the sample project I posted in my answer to your other q.
Try this: Add a TMemo to your form, and inside the 'if grdContactsView1.DataController.LocateByKey(Contact) then' block, write the value of a row-unique datafield and the Selected datafield value to the memo.
Then, what I get when some row other than the top row is selected is that one row is listed twice in the memo, with Selected both false and true, and one of the rows in the filter isn't listed at all, which I think accounts for the behaviour you're seeing. If I then comment out the .Edit .. .Post lines, it correctly lists all the rows in the filter.
So evidently doing the Selected field changes inside a block which iterated the FilteredRecordIndex property of the DBTableView is what's causing the problem.
Personally, I find that it goes a bit against the grain to modify dataset rows in code via a DB-aware control (because you usually end up fighting the DB-awareness of the control), but in this case, it's straightforward to do the processing via the DBTableView of the cxGrid.
procedure TForm1.ProcessFilteredRecords;
var
PrevV,
V : Variant;
i,
Index: Integer;
S : String;
begin
// First, pick up a reference to the current record
// so that we can return to it afterwards
Index := cxGrid1DBTableView1.DataController.FocusedRecordIndex;
PrevV := cxGrid1DBTableView1.DataController.Values[Index, 0];
try
for i := 0 to cxGrid1DBTableView1.DataController.FilteredRecordCount - 1 do begin
Index := cxGrid1DBTableView1.DataController.FilteredRecordIndex[i];
V := cxGrid1DBTableView1.DataController.Values[Index, 0];
if cxGrid1DBTableView1.DataController.LocateByKey(V) then begin
cxGrid1DBTableView1.DataController.Edit;
// 2 is the index of my Selected column in the grid
if cxGrid1DBTableView1.DataController.SetEditValue(2, True, evsText) then
Caption := 'OK'
else
Caption := 'Failed';
cxGrid1DBTableView1.DataController.Post;
end;
end;
finally
if cxGrid1DBTableView1.DataController.LocateByKey(PrevV) then
Caption := 'OK'
else
Caption := 'Failed';
end;
end;
Another way to avoid the problem is to change the Selected states in two steps:
Iterate the FilteredRecordIndex to build a list of rows to change - in your case this would be a list of guids
Then, iterate the list of rows and update their Selected states.
Code:
procedure TForm1.ProcessFilteredRecords;
var
V : Variant;
i,
Index: Integer;
BM : TBookMark;
S : String;
TL : TStringList;
begin
Memo1.Lines.Clear;
TL := TStringList.Create;
try
for i := 0 to cxGrid1DBTableView1.DataController.FilteredRecordCount - 1 do begin
Index := cxGrid1DBTableView1.DataController.FilteredRecordIndex[i];
V := cxGrid1DBTableView1.DataController.Values[Index, 0];
if cxGrid1DBTableView1.DataController.LocateByKey(V) then begin
if CDS1.FieldByName('Selected').AsBoolean then
S := 'True'
else
S := 'False';
S := CDS1.FieldByName('Name').AsString + ' ' + S;
Memo1.Lines.Add(S);
TL.Add(CDS1.FieldByName('Guid').AsString);
end;
end;
try
BM := CDS1.GetBookMark;
CDS1.DisableControls;
for i := 0 to TL.Count - 1 do begin
if CDS1.Locate('guid', TL[i], []) then begin
CDS1.Edit;
CDS1.FieldByName('Selected').AsBoolean := True;
CDS1.Post;
end
end;
finally
CDS1.EnableControls;
CDS1.GotoBookmark(BM);
CDS1.FreeBookmark(BM);
end;
finally
TL.Free;
end;
end;
Like you, I was expecting that changing a property or two of the cxGrid might avoid the problem without any code, but I haven't been able to find anything which does.

How to delete selected records from TDBAdvGrid?

I want to delete multiple selected records which I have displayed at TDBAdvGrid. A number of records are being selected by checking checkbox in front of them. After clicking on Delete button it triggers procedure as follows. It is returning values of selected rows id successfully only problem with deletion of all records. It deletes only first selected record.
procedure TForm5.Button3Click(Sender: TObject);
var
i,j,idn: Integer;
State: Boolean;
begin
j := 0;
for i := 1 to DBAdvGrid1.RowCount - 1 do
begin
if DBAdvGrid1.GetCheckBoxState(1,i,state) then
begin
if state then
begin
idn := StrToInt(DBAdvGrid1.Cells[6,i]);
UniQuery1.SQL.Text := 'Delete from userplays where id = :id';
UniQuery1.ParamByName('id').AsInteger := idn;
UniQuery1.ExecSQL;
end;
end;
end;
end;
It is deleting only first record in lineup. After deleting first record it breaks for loop and control goes back to TDBAdvGrid with updated data after delete.
Final code based on suggestion is as follows
j := 0;
DBAdvGrid1.BeginUpdate;
for i := 1 to DBAdvGrid1.RowCount - 1 do
begin
showmessage('inside rowcount loop');
if DBAdvGrid1.GetCheckBoxState(1,i,state) then
begin
if state then
begin
DBAdvGrid1.DataSource.DataSet.First;
DBAdvGrid1.DataSource.DataSet.MoveBy(i - 1 - j);
DBAdvGrid1.DataSource.DataSet.Delete;
j := j+1;
continue;
end;
end;
end;
This code works perfectly only when PageMode := False
Based on the suggestion above, I would like to make another suggestion...
//DBAdvGrid1.BeginUpdate;
query.First;
for i := 1 to DBAdvGrid1.RowCount - 1 do
begin
if DBAdvGrid1.GetCheckBoxState(1,i,state) then
begin
if state then
begin
//you can do whatever you want with the current selected record
end;
end;
query.Next;
end;
I think this is easier then using the MoveBy...
I even never changed PageMode, it's still on true. No idea if it's coincidence or not.
You can use cyBookmarks in the OnCheck event , with Virtual Table.
It creates a list of all records selected, and you can list them with
cyBookmarks.bookmarklits.count, so my example is like this :
procedure TForm2.cyDBGrid1CheckBoxClick(Sender: TObject);
begin
if cyBookmarks1.AddCurrentRecord then
begin
cyBookmarks1.BookmarkList.InsertBookmark(cyDBGrid1.CheckedList.CurrentRecord);
cyDBGrid1.Invalidate ;
end
else
begin
cyBookmarks1.RemoveCurrentRecord;
cyDBGrid1.Invalidate;
end;
if cyBookmarks1.BookmarkList.Count>0 then
begin
VirtualTable1.GotoBookmark(cyBookmarks1.BookmarkList.Items[0]);
lbl1.Caption:=VirtualTable1.FieldByName('N_ENREGISTREMENT').AsString;
end;
end;

Dynamic TList of TList

i have this problem: as i can add list to one list? i have tried so, but main list return always one list, and not understand where i mistake.
The structure is this:
PCombArray = array of Integer;
PStatsRecord = record
Comb: PCombArray;
Freq: Integer;
end;
PStatsList = TList<PStatsRecord>;
TStatsList = TList<PStatsList>;
Where Comb is a field that work as primary key. But here all ok. i define main list as:
var
MainList: TStatsList;
MySubList: PStatsList;
and create it, without problem. A procedure work for populate a subList; for esample i call this procedure as MakeSubList and assign a MySubList the list maked, then i add it to main list:
MainList := TList<PStatsList>.Create;
try
MainList.Clear;
for index := 1 to N do // generate N subList
begin
...
MySubList := MakeSubList(index); // contain correct sub list, no problem here
...
MainList.Add(MySubList); // add mysublist to mainlist
end;
writeln (mainList.count); // return 1, and not N-1 sublist
finally
MainList.Free;
end;
Thank who help me to understand so i can solve it. Thanks again.
Your make sub list function might be wrong, or you might have confused yourself with your naming conventions which did not follow in any way the usual Delphi/Pascal naming conventions for types.
The following code works, though.
Note that a TList is an Object so if you want to make a List of TList be sure to use TObjectList instead of plain TList unless you like memory leaks. Your inner list is around a record type and does not need to be TObjectList, but if you changed StatsRecord to TStatsData as a TObject (class) type, you should also change to TObjectList.
unit aUnit5;
interface
uses Generics.Collections;
procedure Test;
implementation
type
CombArray = array of Integer;
StatsRecord = record
Comb: CombArray;
Freq: Integer;
end;
TStatsList2 = TList<StatsRecord>;
TStatsList = TObjectList<TStatsList2>;
var
MainList: TStatsList;
MySubList: TStatsList2;
index:Integer;
procedure Test;
begin
MainList := TStatsList.Create;
try
for index := 1 to 10 do // generate N subList
begin
MySubList := TStatsList2.Create;
MainList.Add(MySubList); // add mysublist to mainlist
end;
finally
MainList.Free;
end;
end;
end.
MainList is a list of PStatsList, so you're certainly allowed to add instances of PStatsList to it. If you weren't allowed, your code would not have compiled or run at all.
If the loop runs N times, then MainList.Add will be called N times, and MainList.Count will be N. So, if WriteLn(MainList.Count) prints 1, then we can only conclude that N = 1.
TList allows duplicates, so even if MakeSubList is returning the same object each time, it can still get added to the main list multiple times.
..
implementation
type
S64 = string[64];
art_ptr = ^art_rec;
art_rec = record
sDes: S64;
rCost: real;
iQty: integer;
end;
art_file = file of art_rec;
var
lCatalog: TList;
procedure disp_all;
var
lArt: TList;
pA: art_ptr;
c,
a: integer;
begin
for c:= 0 to lCatalog.Count -1 do begin
lArt:= lCatalog[c];
for a:= 0 to lArt.Count -1 do begin
pA:= lArt[a];
Dispose(pA);
end;
lArt.Clear;
lArt.Free;
end;
lCatalog.Clear;
end;// disp_all
procedure TfrmMain.FormCreate(Sender: TObject);
begin
lCatalog:= TList.Create;
end;// FormCreate
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
disp_all;
lCatalog.Free;
end;// FormDestroy
// a normal BitButton click that adds 3 records to each art list (2)
procedure TfrmMain.bbMCreate_Click(Sender: TObject);
const
nArt = 2;
nRec = 3;
var
pA: art_ptr;
lArt: TList;
c: integer;
begin
// clears any previous added pointer record to art list that was added to the catalog
disp_all;
// creates art lists and add 'em to the catalog list
for c:= 0 to nArt -1 do begin
lArt:= TList.Create;
lCatalog.Add(lArt);
// creates records and add 'em to the art list
for a:= 0 to nArt -1 do begin
pA:= New(art_ptr);
with pA^ do begin
sDes:= Format('cat%d-art%d', [c, a]);
rCost:= (c+1) * (a +1) *1.0;
iQty:= (c+1) *10 + (a +1);
end;
lArt.Add(pA);
end;
end;
end;// bbMCreate_Click
// a normal BitButton click that reads 1 record from 1 art list
procedure TfrmMain.bbMRead_Click(Sender: TObject);
const
c = 1;
a = 2;
var
pA: art_ptr;
lArt: TList;
begin
// gets art list #2 from catalog (index is 0 based. c=1)
lArt:= lCatalog[c];
// gets record #3 from art list (index is 0 based. a=2)
pA:= lArt[a];
// displays the record in a string grid called sgArt... at row a+1
with sgArt, pA^ do begin
// col 0 contains cat index and art index, can be useful...
cells[0,a+1]:= Format('\%d\%d', [c,a]);
cells[1,a+1]:= sDes;
cells[2,a+1]:= FormatFloat('0.00', rCost);
cells[3,a+1]:= IntToStr(iQty);
end;
end;// bbMRead_Click

Resources