I have a tcxtreelist
Does anyone know how to get all the checkedNodes?
I need to go through my tcxtreelist
get a certain value from the tcxtreelist
and write it to a string with comma delimited
Anyone can help me with this?
Thanks
Kind Regards
Suppose you have a cxTreeList with 3 columns, colChecked, colYear and colMonth.
If you go to colChecked in the IDE, you can set its Properties property to
CheckBox and, at run-time, use it as a checkbox.
How to get at the Checked value in a given tree node is actually quite simple.
If you declare a variable Node : TcxTreeList node, you can assign it to any
node in the tree, as in
Node := cxTreeList1.Items[i];
Having done that, you can get at the values in the three columns of the node by
accessing the Values property of the node, which is a zero-based array of variants
which represent the values stored in the node and displayed in the tree.
So, you can write
var
Node : TcxTreeListNode;
Checked : Boolean;
Year : Integer;
Month : Integer;
begin
Node := cxTreeList1.Items[i];
Checked := Node.Values[0];
Year := Node.Values[1];
Month := Node.Values[2];
end;
and, of course, you can set the node's Values by assignments in the opposite
direction (but don't try that with the db-aware version, TcxDBTreeList, because the displayed values are determined by the contents of the fields
of the dataset connected to it).
There's no need to use the Node local variable, I've have only in the interests of clarity. You could just as easily (but not so clearly) write
Checked := cxTreeList1.Items[i].Values[0]
Here's some example code that sets up a cxTreeList with a checkbox column, populates it with rows, and generates a list of the rows which have the checkbox checked:
uses
[...]cxTLData, cxDBTL, cxInplaceContainer, cxTextEdit,
cxCheckBox, cxDropDownEdit;
type
TForm1 = class(TForm)
cxTreeList1: TcxTreeList;
Memo1: TMemo;
btnGetCheckedValues: TButton;
procedure btnGetCheckedValuesClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
protected
colChecked : TcxTreeListColumn;
colYear : TcxTreeListColumn;
colMonth : TcxTreeListColumn;
public
procedure GetCheckedValues;
end;
[...]
procedure TForm1.FormCreate(Sender: TObject);
var
i : Integer;
Year,
Month : Integer;
YearNode,
MonthNode : TcxTreeListNode;
begin
cxTreeList1.BeginUpdate;
try
// Set up the cxTreeList's columns
colChecked := cxTreeList1.CreateColumn(Nil);
colChecked.Caption.Text := 'Checked';
colChecked.PropertiesClassName := 'TcxCheckBoxProperties';
colYear := cxTreeList1.CreateColumn(Nil);
colYear.Caption.Text := 'Year';
colMonth := cxTreeList1.CreateColumn(Nil);
colMonth.Caption.Text := 'Month';
// Set up the top level (Year) and next level (Month) nodes
for Year := 2012 to 2016 do begin
YearNode := cxTreeList1.Root.AddChild;
YearNode.Values[0] := Odd(Year);
YearNode.Values[1] := Year;
for Month := 1 to 12 do begin
MonthNode := YearNode.AddChild;
MonthNode.Values[0] := False;
MonthNode.Values[1] := Year;
MonthNode.Values[2] := Month;
end;
end;
finally
cxTreeList1.FullExpand;
cxTreeList1.EndUpdate;
end;
end;
procedure TForm1.GetCheckedValues;
var
i : Integer;
Node : TcxTreeListNode;
S : String;
begin
for i := 0 to cxTreeList1.Count - 1 do begin
Node := cxTreeList1.Items[i];
if Node.Values[0] then begin
S := Format('Item: %d, col0: %s col1: %s col2: %s', [i, Node.Values[0], Node.Values[1], Node.Values[2]]);
Memo1.Lines.Add(S);
end;
end;
end;
procedure TForm1.btnGetCheckedValuesClick(Sender: TObject);
begin
GetCheckedValues;
end;
Related
i want to ask how to retain controlls when im making a copy of a control. for example i have an edit box that can be controlled with a slider for value change. when i make a copy using this code i achieve a copy of the items but the slider stops controlling editbox values. how can i fix that?
TypInfo;
procedure CloneProperties(const Source: TControl; const Dest: TControl);
var
ms: TMemoryStream;
OldName: string;
begin
OldName := Source.Name;
Source.Name := ''; // needed to avoid Name collision
try
ms := TMemoryStream.Create;
try
ms.WriteComponent(Source);
ms.Position := 0;
ms.ReadComponent(Dest);
finally
ms.Free;
end;
finally
Source.Name := OldName;
end;
end;
procedure CloneEvents(Source, Dest: TControl);
var
I: Integer;
PropList: TPropList;
begin
for I := 0 to GetPropList(Source.ClassInfo, [tkMethod], #PropList) - 1 do
SetMethodProp(Dest, PropList[I], GetMethodProp(Source, PropList[I]));
end;
procedure DuplicateChildren(const ParentSource: TWinControl;
const WithEvents: Boolean = True);
var
I: Integer;
CurrentControl, ClonedControl: TControl;
begin
for I := ParentSource.ControlCount - 1 downto 0 do
begin
CurrentControl := ParentSource.Controls[I];
ClonedControl := TControlClass(CurrentControl.ClassType).Create(CurrentControl.Owner);
ClonedControl.Parent := ParentSource;
CloneProperties(CurrentControl, ClonedControl);
ClonedControl.Name := CurrentControl.Name + '_';
if WithEvents then
CloneEvents(CurrentControl, ClonedControl);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
DuplicateChildren(Panel1);
end;
Unless I'm misunderstanding you, your CloneProperties doesn't seem to have anything to do with the question you're asking. In your example of an edit control E1 and a slider S1, you can clone both of them to produce E2 and S2, but somewhere in your code there must be a statement that changes the value in E1 depending on the value of S1. However, in the way you've most likely written it, that statement doesn't apply to E2 and S2.
The simplest way around that is to write a method which takes the component instances and links the operation of the two together. e.g.
procedure TForm1.SetEditControlFromSlider(AnEdit : TEdit; ASlider : { TWhatever the slider actually is);
begin
// Set AnEdit's value from ASlider's properties
end;
Then, you can call this with Edit/Slider pairs like this
SetEditControlFromSlider(E1, S1);
[...]
SetEditControlFromSlider(E2, S2);
I can imagine you might not like having to do that.
IMO, the cleanest solution is to avoid attempting to clone components altogether and create a TFrame containing the Edit, Slider and the code that connects them, and then add to your form as many instances of the frame as you need. It's as easy as falling off a log.
type
TEditFrame = class(TFrame) // needs to be in its own unit, Used by your form
Edit1: TEdit;
TrackBar1: TTrackBar;
procedure TrackBar1Change(Sender: TObject);
private
public
end;
[...]
procedure TEditFrame.TrackBar1Change(Sender: TObject);
begin
Edit1.Text := IntToStr(TrackBar1.Position)
end;
Then, you can add clones of the frame to TForm1 by
procedure TForm1.Button1Click(Sender: TObject);
var
AFrame : TEditFrame;
begin
Inc(FrameCount); // Field of TForm1
AFrame := TEditFrame.Create(Self);
AFrame.Name := AFrame.Name + IntToStr(FrameCount);
AFrame.Parent := Self;
AFrame.Top := AFrame.Height * FrameCount;
end;
Note that because the code which links the two components, TrackBar1Change, it compiled into the frame's unit, it is automatically shared by every instance of the frame you create, without any need to "clone" the code.
Short Version: Is there any way to control or modify LisBox items individually? for example set their Visible property to False separately.
I found a TListBoxItem class in Fire Monkey when I was searching, but I don't want to use Fire Monkey and want it in VCL.
Detailed Version:
I tried to filter my ListBox using two TStringList and an Edit, one StringList is global to keep the original list (list_files_global) and another StringList to help filtering procedure (list_files_filter) and my primary list of files is my ListBox (list_files).
I created my global StringList on onCreate event while program is starting to store my original list:
procedure Tfrm_main.FormCreate(Sender: TObject);
Begin
list_files_global := TStringList.Create;
list_files_global.Assign(list_files.Items);
End;
and used Edit's onChange event for filtering:
procedure Tfrm_main.edit_files_filterChange(Sender: TObject);
Var
list_files_filter: TStringList;
i: Integer;
Begin
list_files_filter := TStringList.Create;
list_files_filter.Assign(list_files.Items);
list_files.Clear;
for i := 0 to list_files_filter.Count - 1 do
if pos(edit_files_filter.text, list_files_filter[i]) > 0 then
list_files.Items.Add(list_files_filter[i]);
End;
and for switching off the filter, just recover the list from my global list that I created at first:
list_files.Items := list_files_global;
here so far, everything works just fine, but problem is when I'm trying to edit/rename/delete items from filtered list, for example I change an item:
list_files.Items[i] := '-- Changed Item --';
list will be edited, but when I switch off the filter, the original list will be back and all changes are lost.
so I want to know is there any proper way to solve this problem? Something like hiding items individually or change items visibility, etc... so I can change the filtering algorithm and get rid of all this making extra lists.
I searched the internet and looked into Delphi's help file for a whole day and nothing useful came up.
The items of a VCL listbox, List Box in the API, does not have any visibility property. The only option for not showing an item is to delete it.
You can use the control in virtual mode however, where there are no items at all. You decide what data to keep, what to display. That's LBS_NODATA window style in the API. In VCL, set the style property to lbVirtual.
Extremely simplified example follows.
Let's keep an array of records, one record per virtual item.
type
TListItem = record
FileName: string;
Visible: Boolean;
end;
TListItems = array of TListItem;
You can extend the fields as per your requirements. Visibility is one of the main concerns in the question, I added that. You'd probably add something that represents the original name so that you know what name have been changed, etc..
Have one array per listbox. This example contains one listbox.
var
ListItems: TListItems;
Better make it a field though, this is for demonstration only.
Required units.
uses
ioutils, types;
Some initialization at form creation. Empty the filter edit. Set listbox style accordingly. Fill up some file names. All items will be visible at startup.
procedure TForm1.FormCreate(Sender: TObject);
var
ListFiles: TStringDynArray;
i: Integer;
begin
ListFiles := ioutils.TDirectory.GetFiles(TDirectory.GetCurrentDirectory);
SetLength(ListItems, Length(ListFiles));
for i := 0 to High(ListItems) do begin
ListItems[i].FileName := ListFiles[i];
ListItems[i].Visible := True;
end;
ListBox1.Style := lbVirtual;
ListBox1.Count := Length(ListFiles);
Edit1.Text := '';
end;
In virtual mode the listbox is only interested in the Count property. That will arrange how many items will show, accordingly the scrollable area.
Here's the filter part, this is case sensitive.
procedure TForm1.Edit1Change(Sender: TObject);
var
Text: string;
Cnt: Integer;
i: Integer;
begin
Text := Edit1.Text;
if Text = '' then begin
for i := 0 to High(ListItems) do
ListItems[i].Visible := True;
Cnt := Length(ListItems);
end else begin
Cnt := 0;
for i := 0 to High(ListItems) do begin
ListItems[i].Visible := Pos(Text, ListItems[i].FileName) > 0;
if ListItems[i].Visible then
Inc(Cnt);
end;
end;
ListBox1.Count := Cnt;
end;
The special case in the edit's OnChange is that when the text is empty. Then all items will show. Otherwise code is from the question. Here we also keep the total number of visible items, so that we can update the listbox accordingly.
Now the only interesting part, listbox demands data.
procedure TForm1.ListBox1Data(Control: TWinControl; Index: Integer;
var Data: string);
var
VisibleIndex: Integer;
i: Integer;
begin
VisibleIndex := -1;
for i := 0 to High(ListItems) do begin
if ListItems[i].Visible then
Inc(VisibleIndex);
if VisibleIndex = Index then begin
Data := ListItems[i].FileName;
Break;
end;
end;
end;
What happens here is that the listbox requires an item to show providing its index. We loop through the master list counting visible items to find out which one matches that index, and supply its text.
This is something I often do, but with list views instead of list boxes. The basic principles are the same, though.
I tend to store the individual items as objects, which are reference types in Delphi. And I keep them all in one main unfiltered list, which owns the objects, while I maintain a filtered list (which does not own the objects) for display purposes. Like #Sertac, I combine this with a virtual list view.
To see how this works in practice, create a new VCL application and drop a list view (lvDisplay) and an edit control (eFilter) on the main form:
Notice I have added three columns to the list view control: "Name", "Age", and "Colour". I also make it virtual (OwnerData = True).
Now define the class for the individual data items:
type
TDogInfo = class
Name: string;
Age: Integer;
Color: string;
constructor Create(const AName: string; AAge: Integer; const AColor: string);
function Matches(const AText: string): Boolean;
end;
where
{ TDogInfo }
constructor TDogInfo.Create(const AName: string; AAge: Integer;
const AColor: string);
begin
Name := AName;
Age := AAge;
Color := AColor;
end;
function TDogInfo.Matches(const AText: string): Boolean;
begin
Result := ContainsText(Name, AText) or ContainsText(Age.ToString, AText) or
ContainsText(Color, AText);
end;
And let us create the unfiltered list of dogs:
TForm1 = class(TForm)
eFilter: TEdit;
lvDisplay: TListView;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
FList, FFilteredList: TObjectList<TDogInfo>;
public
end;
where
function GetRandomDogName: string;
const
DogNames: array[0..5] of string = ('Buster', 'Fido', 'Pluto', 'Spot', 'Bill', 'Rover');
begin
Result := DogNames[Random(Length(DogNames))];
end;
function GetRandomDogColor: string;
const
DogColors: array[0..2] of string = ('Brown', 'Grey', 'Black');
begin
Result := DogColors[Random(Length(DogColors))];
end;
procedure TForm1.FormCreate(Sender: TObject);
var
i: Integer;
begin
FList := TObjectList<TDogInfo>.Create(True); // Owns the objects
// Populate with sample data
for i := 1 to 1000 do
FList.Add(
TDogInfo.Create(GetRandomDogName, Random(15), GetRandomDogColor)
);
FFilteredList := FList;
lvDisplay.Items.Count := FFilteredList.Count;
lvDisplay.Invalidate;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if FFilteredList <> FList then
FreeAndNil(FFilteredList);
FreeAndNil(FList);
end;
The idea is that the list view control always displays the FFilteredList, which either points to the same object instance as FList, or points to a filtered (or sorted) version of it:
// The list view's OnData event handler
procedure TForm1.lvDisplayData(Sender: TObject; Item: TListItem);
begin
if FFilteredList = nil then
Exit;
if not InRange(Item.Index, 0, FFilteredList.Count - 1) then
Exit;
Item.Caption := FFilteredList[Item.Index].Name;
Item.SubItems.Add(FFilteredList[Item.Index].Age.ToString);
Item.SubItems.Add(FFilteredList[Item.Index].Color);
end;
// The edit control's OnChange handler
procedure TForm1.eFilterChange(Sender: TObject);
var
i: Integer;
begin
if string(eFilter.Text).IsEmpty then // no filter, display all items
begin
if FFilteredList <> FList then
begin
FreeAndNil(FFilteredList);
FFilteredList := FList;
end;
end
else
begin
if (FFilteredList = nil) or (FFilteredList = FList) then
FFilteredList := TObjectList<TDogInfo>.Create(False); // doesn't own the objects
FFilteredList.Clear;
for i := 0 to FList.Count - 1 do
if FList[i].Matches(eFilter.Text) then
FFilteredList.Add(FList[i]);
end;
lvDisplay.Items.Count := FFilteredList.Count;
lvDisplay.Invalidate;
end;
The result:
Notice that there always is only one in-memory object for each dog, so if you rename a dog, the changes will reflect in the list view, filtered or not. (But don't forget to invalidate it!)
In the following tFDMemTable I try to sum value of records whose ID field starting letter A. A1, A2 and the result should be 4.
type
TForm1 = class(TForm)
FDMemTable1: TFDMemTable;
DBGrid1: TDBGrid;
DataSource1: TDataSource;
Button1: TButton;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
end;
procedure TForm1.FormCreate(Sender: TObject);
var
_FieldDef: TFieldDef;
begin
_FieldDef := FDMemTable1.FieldDefs.AddFieldDef;
_FieldDef.Name := 'ID';
_FieldDef.DataType := ftString;
_FieldDef.Size := 5;
_FieldDef := FDMemTable1.FieldDefs.AddFieldDef;
_FieldDef.Name :='value';
_FieldDef.DataType := ftInteger;
FDMemTable1.CreateDataSet;
FDMemTable1.Append;
FDMemTable1.FieldValues['ID'] := 'A1';
FDMemTable1.FieldValues['value'] := 1;
FDMemTable1.Append;
FDMemTable1.FieldValues['ID'] := 'B1';
FDMemTable1.FieldValues['value'] := 2;
FDMemTable1.Append;
FDMemTable1.FieldValues['ID'] := 'A2';
FDMemTable1.FieldValues['value'] := 3;
FDMemTable1.Append;
FDMemTable1.FieldValues['ID'] := 'B2';
FDMemTable1.FieldValues['value'] := 4;
end;
I wrote the following code but it changes tDBGrid as filtered. What I want is just an internal process that tDBGrid should stay without any change.
procedure TForm1.Button1Click(Sender: TObject);
var
_ValueSum: Integer;
i: Integer;
begin
FDMemTable1.Filter := 'ID like ' + QuotedStr('A%');
FDMemTable1.Filtered := True;
_ValueSum := 0;
FDMemTable1.FindFirst;
for i := 0 to FDMemTable1.RecordCount - 1 do
begin
_ValueSum := _ValueSum + FDMemTable1.FieldValues['value'];
FDMemTable1.FindNext;
end;
Button1.Caption := IntToStr(_ValueSum);
end;
I know tDataSet.Locate doesn't allow NEXT SEARCH that I tried a primitive way like this. It works fine but seems a little stupid.
procedure TForm1.Button2Click(Sender: TObject);
var
_ValueSum: Integer;
i: Integer;
begin
_ValueSum := 0;
FDMemTable1.First;
for i := 0 to FDMemTable1.RecordCount do
begin
if Copy(FDMemTable1.FieldValues['ID'], 1, 1) = 'A' then
begin
_ValueSum := _ValueSum + FDMemTable1.FieldValues['value'];
end;
FDMemTable1.FindNext;
end;
Button2.Caption := IntToStr(_ValueSum);
end;
When I disconnect tFDMemTable and tDBGrid or set inactive before filtering to hold the last grid status, the grid changes to blank one. Is the last code the best solution or is there any better way which shows not filtered result while the filtering is working?
There are several things which, if not "wrong", are not quite right with your code.
You should be using Next, not FindNext to move to the next row in the dataset. Next moves to the next row in the dataset, whereas FindNext moves to the next row which matches search criteria you have already set up e.g. using DataSet.SetKey; ... - read the online help for FindKey usage.
You should NOT be trying to traverse the dataset using a For loop; use a While not FDMemData.Eof do loop. Eof stands for 'End of file' and returns true once the dataset is on its last row.
You should be calling FDMemTable1.DisableControls before the loop and FDMemTable1.EnableControls after it. This prevents db-aware controls like your DBGrid from updating inside the loop, which would otherwise slow the loop down as the grid is updating.
Unless you have a very good reason not to, ALWAYS clear a dataset filter in the same method as you set it, otherwise you can get some very confusing errors if you forget the filter is active.
Try to avoid using RecordCount when you don't absolutely need to. Depending on the RDMS you are using, it can cause a lot of avoidable processing overhead on the server and maybe the network (because with some server types it will cause the entire dataset to be retrieved to the client).
Change your first loop to
procedure TForm1.Button1Click(Sender: TObject);
var
_ValueSum : Integer;
begin
_ValueSum := 0;
FDMemTable1.Filter := 'ID like ' + QuotedStr('A%');
try
FDMemTable1.DisableControls;
FDMemTable1.First;
while not FDMemTable1.Eof do begin
_ValueSum:= _ValueSum + FDMemTable1.FieldByName('Value').AsInteger;
FDMemTable1.Next;
end
finally
FDMemTable1.Filter := '';
FDMemTable1.Filtered := False;
FDMemTable1.EnableControls;
end;
Button1.Caption := IntToStr(_ValueSum);
end;
If you do that, you don't need your Button2Click method at all.
As noted in a comment, you can use a TBookMark to record your position in the dataset before the loop and return to it afterwards, as in
var
_ValueSum : Integer;
BM : TBookMark;
begin
_ValueSum := 0;
BM := FDMemTable.GetBookMark;
FDMemTable1.Filter := 'ID like ' + QuotedStr('A%');
try
[etc]
finally
FDMemTable1.Filter := '';
FDMemTable1.Filtered := False;
FDMemTable1.GotoBookMark(BM);
FDMemTable1.FeeBookMark(BM);
FDMemTable1.EnableControls;
end;
By the way, you can save yourself some typing and get more concise code by using the InsertRecord method as in
FDMemTable1.InsertRecord(['A1', 1]);
FDMemTable1.InsertRecord(['B1', 2]);
FDMemTable1.InsertRecord(['A2', 3]);
FDMemTable1.InsertRecord(['B2', 4]);
Btw#2: The time to use FindKey is after you've set up a key to find, using by calling SetKey than then setting the key value(s).
For ordinary navigation of a dataset, use the standard navigation methods, e.g. Next, Prior, First, Last, MoveBy etc.
FireDAC has another interesting option - Aggregates:
procedure TForm1.Button1Click(Sender: TObject);
begin
FDMemTable1.Aggregates.Clear;
with FDMemTable1.Aggregates.Add do
begin
Name := 'SUM';
Expression := 'sum(iif(ID like ''A%'', value, 0))';
Active := True;
end;
FDMemTable1.AggregatesActive := True;
FDMemTable1.Refresh;
Button1.Caption := VarToStr(FDMemTable1.Aggregates[0].Value));
end;
At work we have a component called a "ClientdatasetGrid",
which allows the user to sort the records of the grid by clicking on one or multiple column-titles.
I have made a component for work also, a descendant from TEdit, which I call TDBFilterEdit.
once you assign a DataSet or DBGrid to it, it creates an OnFilterRecord event for the DataSet and after you stop changing the text that Event is executed.
the problem arises whenever the Dataset is already filtered and the user sorts the grid.
the grid-component adds IndexDefs to the Clientdataset by first deleteing the current IndexDef, Updating, Adding the new Index and updating again.
whenever an index is deleted or added my OnFilterRecord event is triggered.
I mitigated this by disableing controls and NIL-ing the OnFilterRecord event from inside the grid until the new index is added.
cds.DisableControls();
try
extProc:=nil;
if (TMethod(cds.OnFilterRecord).Code<>nil) and (TMethod(cds.OnFilterRecord).Data<>nil) then
begin
TMethod(extProc):=TMethod(cds.OnFilterRecord);
cds.OnFilterRecord:=nil;
end;
...
... //<-- Delete Index & create new Index
...
finally
cds.OnFilterRecord:=extProc;
cds.EnableControls();
end;
Once the Event is assigned again, it is immeadeately called and is iterating through all X records even though the user may only see 5.
Now I am searching for a way to see if a record is already filtered out so I can skip it inside my filter-method if the text hasn't changed.
Edit: Since a MVCE has been demanded I'll post a short version of my OnFilterRecord procedure.
the following procedure is executed everytime the component hasn't recieved an input for 1 second
fStringtypes and fTimeTypes are both a set of TFieldType
fStringTypes:=[ftString,ftMemo,ftFMTMemo,ftFixedChar,ftWideString];
fTimeTypes:=[ftDate,ftTime,ftDateTime,ftTimeStamp];
after the procedure is completely finished the timer is disabled and controls are enabled again.
procedure TDBEditFilter.FilterRecords(DataSet:TDataSet; var Accept:Boolean);
var
...
begin
//initiliaztion//
s:=FilterText; //Filtertext=User Input into the TDBEditFilters Textfield
TestFloat:=0;
Accept:=False;
/////////////////
for i:=0 to fDBGrid.Columns.Count-1 do //for all DBGrid-Columns
begin
if fDataSet.FieldByName(fDBGrid.Columns[i].FieldName).DataType in fStringTypes then
begin
Strvalue:=fDataSet.FieldByName(fDBGrid.Columns[i].FieldName).AsString;
Accept:=AnsiContainsText(Strvalue,s); //<--to ignore Upper/lowercase
end
else if fDataSet.FieldByName(fDBGrid.Columns[i].FieldName).DataType in fTimeTypes then
begin
StrValue:=DateTimeToStr(fDataSet.FieldByName(fDBGrid.Columns[i].FieldName).As DateTime,Local_Form_Settings);
Accept:=Pos(StrValue,s)<>0;
end
else if fDataSet.FieldByName(fDBGrid.Columns[i].FieldName).DataType=ftBlob then
begin
//ignore Blob
end
else //whatever fieldtype is left must be a numeric Field-type like integer or float
begin
if TryStrToFloat(s,TestFloat)=True then
begin
Accept:=(TestFloat=fDataSet.FieldByName(fDBGrid.Columns[i].FieldName).AsFloat);
end;
end;
if Accept=True then break; //stop checking this record and check next record
end;
end;
I thought I would post this as a separate answer because I've been experimenting
with a "Filter TEdit" that works in a similar way as I'm guessing yours does, and it doesn't
seem to exhibit any particular performance problems. My main assumption is that you are using one filter TEdit per datafield of interest, rather that a single one into which the user types a compound Sql-like expression including the field names, comparison operators, etc.
The number of guesses I've had to make is why I said it would have been helpful for you to include an MCVE.
I've written it to be self-contained, i.e. it generates its own data instead of needing
an external database.
As you'll see if you try it, with a CDS containing, say, 3000 records,
the time to update the filters is a few tens of milliseconds (under 20 on my laptop).
If the CDS contains 30000 records, the filter update time increases roughly linearly
to about 200 ms which seems perfectly acceptable from a gui-responsivenes pov.
(Traditionally, TCDSs have been regarded as hitting a brick wall performance-wise when the number of records gets into the tens of thousands)
Note that for simplicity
a) I haven't used a DateTime fiield for BirthDate or whatever,
because of the complications of dealing with partial dates inputted by the user.
b) In the OnFilterRecord event, the LastName, FirstName and Age comparisons
are done by comparing the field as a string with the corresponding filter expression.
c) The Filter expressions, if non-blank are left- and right-padded with asterisks
and the value comparisons are done using the MatchesMask function from the Masks unit.
See FilterExpr.
d) The IndexDef's FieldNames are composed of the names of the fields for which
the filter edit's text is non-blank.
e) If the gui-updating is too slow if the user rapidly types several
characters in succession into the TEdits, you can work around this by
replacing the TEdits' OnChange event code by code in their KeyUp event
which enables a TTimer which has an interval of, say, 150 ms. Then, in its OnTimer, call UpdateFilter.
Code:
TForm1 = class(TForm)
DBGrid1: TDBGrid;
CDS1: TClientDataSet;
DataSource1: TDataSource;
Memo1: TMemo;
CDS1ID: TIntegerField;
CDS1Age: TIntegerField;
CDS1LastName: TStringField;
CDS1FirstName: TStringField;
edLastNameFilter: TEdit;
edFirstNameFilter: TEdit;
edAgeFilter: TEdit;
procedure CDS1FilterRecord(DataSet: TDataSet; var Accept: Boolean);
procedure edLastNameFilterChange(Sender: TObject); // Set the OnChange events for the
// FirstName and Age TEdits to this, too
procedure FormCreate(Sender: TObject);
private
procedure Log(const Title, Msg: String);
function FilterExpr(const Input: String): String;
protected
public
LastNameFilter,
FirstNameFilter,
AgeFilter : String;
IndexFields : String;
IndexDef : TIndexDef;
procedure UpdateFilterExprsAndIndex;
procedure UpdateFilter;
end;
[...]
rocedure TForm1.FormCreate(Sender: TObject);
var
i : Integer;
Ch1,
Ch2 : Char;
LastName,
FirstName : String;
Age : Integer;
begin
CDS1.CreateDataSet;
CDS1.DisableControls;
try
for i := 1 to 30000 do begin
Ch1 := Chr(Ord('a') + random(26));
Ch2 := Chr(Ord('a') + random(26));
LastName:= StringOfChar(Ch1, 1 + Random(10));
FirstName := StringOfChar(Ch2, 1 + Random(10));
Age := Trunc(Random(71));
CDS1.InsertRecord([i, LastName, FirstName, Age]);
end;
finally
CDS1.First;
CDS1.EnableControls;
end;
end;
procedure TForm1.Log(const Title, Msg : String);
begin
Memo1.Lines.Add(Title + ' : ' + Msg);
end;
procedure TForm1.CDS1FilterRecord(DataSet: TDataSet; var Accept: Boolean);
begin
Accept := True;
if LastNameFilter <> '' then
Accept := MatchesMask(CDS1LastName.AsString, LastNameFilter);
if not Accept then exit;
if FirstNameFilter <> '' then
Accept := Accept and MatchesMask(CDS1FirstName.AsString, FirstNameFilter);
if not Accept then exit;
if AgeFilter <> '' then
Accept := Accept and MatchesMask(CDS1Age.AsString, AgeFilter);
end;
procedure TForm1.edLastNameFilterChange(Sender: TObject);
begin
UpdateFilter;
end;
procedure TForm1.UpdateFilter;
var
T1 : Integer;
begin
T1 := GetTickCount;
UpdateFilterExprsAndIndex;
CDS1.DisableControls;
try
CDS1.Filtered := False;
if (edLastNameFilter.Text <> '') or (edFirstNameFilter.Text <> '') or (edAgeFilter.Text <> '') then begin
CDS1.Filtered := True;
end;
if IndexFields <> '' then
CDS1.IndexDefs[0].Fields := IndexFields; // Warning: This IndexDef needs to exist
Log('Filter update time', IntToStr(GetTickCount - T1) + 'ms');
finally
CDS1.EnableControls;
end;
end;
function TForm1.FilterExpr(const Input : String) : String;
begin
Result := Input;
if Result <> '' then
Result := '*' + Result + '*';
end;
procedure TForm1.UpdateFilterExprsAndIndex;
begin
LastNameFilter := FilterExpr(edLastNameFilter.Text);
FirstNameFilter := FilterExpr(edFirstNameFilter.Text);
AgeFilter := FilterExpr(edAgeFilter.Text);
IndexFields := '';
if LastNameFilter <> '' then
IndexFields := 'LastName';
if FirstNameFilter <> '' then begin
if IndexFields <> '' then
IndexFields := IndexFields + ';';
IndexFields := IndexFields + 'FirstName';
end;
if AgeFilter <> '' then begin
if IndexFields <> '' then
IndexFields := IndexFields + ';';
IndexFields := IndexFields + 'Age';
end;
end;
I hope this at least gives you a basis for comparison with your own
code so that you can identify any bottlenecks.
Update Rather to my surprise, I found that with the compound filter expression I used for testing, it is much faster to set the CDS's Filter to the expression and leave it do to the filtering using OnFilterRecord, With 30000 records, UpdateFilter2 takes under 20 ms, compared with 200 ms for a similar expression set using the `UpdateFilter'.
procedure TForm1.btnSetFilterExprClick(Sender: TObject);
begin
edFilter.Text := 'LastName=''aaa'' and FirstName = ''zz'' and Age > 30 ';
UpdateFilter2;
end;
procedure TForm1.UpdateFilter2;
var
T1 : Integer;
begin
CDS1.OnFilterRecord := Nil;
T1 := GetTickCount;
CDS1.DisableControls;
try
CDS1.Filtered := False;
CDS1.Filter := edFilter.Text;
if CDS1.Filter <> '' then begin
CDS1.Filtered := True;
end;
Log('Filter update time', IntToStr(GetTickCount - T1) + 'ms');
finally
CDS1.EnableControls;
end;
end;
I don't think you could do this using the standard TClientDataset's implementations
of indexing and filtering.
Changes to the index or filter on a TCDS both invoke a traversal of its data records
and you have no control over that because in both cases, the TCDS functionality depends
on calls into the interfaces provided by Midas.Dll.
Setting up a new or changed index involves calling procedure TCustomClientDataSet.SortOnFields
which in turn calls Cursor.SortOnFields, where Cursor is of type IDSCursor - see DSIntf.Pas
Equally, changing the CDS filter involves calling TCustomClientDataSet.AddExprFilter, which in
turn calls FDSCursor.AddFilter, where FDSCursor is again of type IDSCursor.
So, you would need to re-implement both of these at the Midas level, on the other side
of the IDSCursor interfave to avoid the default behaviour.
Im going through one of my old exam papers, preparing for my finals, and for the love of life, I cant figure out how to do this!
The program was working earlier, but it wasn't sorting the array. Now Im getting an error saying EAccess violation with message: access violation at address 00404BDE
Here's my code (its kind of long, maybe you can help me spot my error) :
private
{ Private declarations }
iCount : Integer;
arrDams : array [1..200] of string;
Procedure List;
procedure Display;
procedure Sort;
procedure Search (sDam : String);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Display; //Display with Numbers
var
k : Integer;
begin
for K := 1 to 200 do
begin
RedOut.Lines.Add (IntToStr(k) + '.) ' + (arrDams[k]));
end;
end;
procedure TForm1.FormCreate(Sender: TObject); // Create
begin
//
end;
procedure TForm1.List; // TextFile to array
var
MyFile : TextFile;
k : Integer;
begin
If FileExists('Dams.txt') <> True
then Application.Terminate;
AssignFile (MyFile, 'Dams.txt');
Reset(MyFile);
For K := 1 to 200 do
begin
Readln(MyFile, arrDams[k])
end;
end;
procedure TForm1.Search(sDam: String); // Search
begin
end;
procedure TForm1.Sort; // Sort;
var
K,L : byte;
sKeep : string;
begin
for k := 1 to iCount -1 do
begin
for l := k + 1 to iCount do
begin
if arrDams[k] > arrDams[L] then
begin
sKeep := arrDams[k];
arrDams[k] := arrDams[L];
arrDams[L] := sKeep
end;
end;
end;
end;
procedure TForm1.btnListClick(Sender: TObject);
begin
List;
Display;
end;
procedure TForm1.btnDisplayClick(Sender: TObject);
begin
display;
sort;
end; //<---------- ERROR OVER HERE!
end.
Theres 3 buttons at the top of the form, namely Show list, Make new textfile with list and Sort list alphabetically. The button Im working on is to sort the list. This question paper says I must make a sort procedure and must be called when the Sort Button is clicked.
Thanks for any advice/help
P.S.
Can you please point me to a link where they explain Selection Sorting in depth - the logic isn't with me on this..
You don't initialize iCount. So it is 0. Therefore iCount-1 is -1. However, you use Byte, an unsigned type, for your loop variable. Now, -1 when interpreted as an unsigned Byte is 255. If you follow this all through it means that you access the array out of bounds. In fact what happens is that the inner loop executes exactly once with a value of l equal to 0 and k equal to 255.
Were you to enable the range checking compiler option, you would have encountered a runtime error as soon as you run off the end of the array.
Presumably you want to initialize iCount to some value. I cannot tell what, but you will know.
Beyond that, stop using unsigned types for loop variables. Replace Byte with Integer.