The following Delphi function can be used to add a fkInternalCalc to a TClientDataset.
This is useful because I can store some information for each record, make calculation or store temporary flag.
The same code does not work in Lazarus, it stops on DataSet.FieldDefs.Update.
Are there means to achieve the same functionality?
Remember that one could change database fields and apply the changes made.
A working Delphi code using the function is:
AddDummyField(qry,TIntegerField,'PROCESS_ACTION');
qry.Open;
...
function AddDummyField(Dataset:TDataset;fieldClass:TFieldClass;fieldName:string;size:integer):TField;
var
i: Integer;
begin
if Dataset.FieldDefs.Count = 0 then
begin
DataSet.FieldDefs.Update;
for i := 0 to DataSet.FieldDefs.Count - 1 do
DataSet.FieldDefs[i].CreateField(DataSet);
end;
Result := Dataset.FindField(fieldName);
if Result <> nil then
exit;
Result := fieldClass.Create(Dataset);
Result.FieldName := fieldName;
Result.FieldKind := fkInternalCalc;
Result.DataSet := Dataset;
if size>0 then
Result.Size := size;
end;
You have to open the dataset before.
...
DataSet.Open;
DataSet.FieldDefs.Update;
DataSet.Close;
for i := 0 to DataSet.FieldDefs.Count - 1 do
DataSet.FieldDefs[i].CreateField(DataSet);
...
Related
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.
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.
I have Inherited form and a Ehlib dbgrid on it for selecting-listing records... The form is ready made for a lot of buttons and im using this form with different queries.
Like this...
If Dm.QrTmp.Active then Dm.QrTmp.Active:=False;
Dm.QrTmp.SQL.Clear;
Dm.QrTmp.SQL.Add(' SELECT ');
Dm.QrTmp.SQL.Add(' ch.cari_RECno AS KayitNo ');
Dm.QrTmp.SQL.Add(' FROM CARI_HESAPLAR ch ');
if FrmTmp=nil then FrmTmp:=TFrmTmp.Create(Self);
FrmTmp.StatusBar.Hide;
Dm.QrTmp.Open;
FrmTmp.DbGrid.DataSource:=Dm.DsQrTmp;
This query is cutted down but i have of course use a lot of fields. And Queries changes alot of time in the application.
The problem is column width. Manager wants to set column widths and restore them again. Actually my grid component supports save - restore column properties but as you can see my usage i m not using static columns. also i dont want to use xgrid.columns[0].width percent by percent.
Im using a ini in may app.
I want to add new section on it and named "Gridwidth"...
[Gridname]
Colwidths=x,y,z (where they are width values)
I'm now coding this line by line.
My write procedure is like this.
With dbgridx do
begin
For i:=0 to columns.count-1
begin
widthstr:=widthstr+Column[i].width+',';
end;
end;
Widthstr will be "15,23,45,67" etc...
But i want to know if this is good solution and if somebody know a better way and has some good code.
This should do it:
uses
IniFiles;
const
SETTINGS_FILE = 'Edijus\Settings.ini';
procedure TForm1.LoadDBGridColumnsWidth(const ADBGrid: TDBGrid);
var
_MemIniU: TMemIniFile;
_SettingsPath: string;
i, j: integer;
_ParentClass: TWinControl;
begin
_SettingsPath := GetHomePath + PathDelim + SETTINGS_FILE;
if (not Assigned(ADBGrid)) or (not Assigned(ADBGrid.DataSource)) or
(not Assigned(ADBGrid.DataSource.DataSet)) then
Exit;
_MemIniU := TMemIniFile.Create(_SettingsPath, TEncoding.UTF8);
try
_ParentClass := ADBGrid.Parent;
while not(_ParentClass is TForm) do
_ParentClass := _ParentClass.Parent;
for i := 0 to Pred(ADBGrid.DataSource.DataSet.Fields.Count) do
for j := 0 to Pred(ADBGrid.Columns.Count) do
begin
if (ADBGrid.DataSource.DataSet.Fields[i].FieldName = ADBGrid.Columns[j]
.FieldName) then
ADBGrid.Columns[j].Width :=
_MemIniU.ReadInteger(_ParentClass.Name + '_' + ADBGrid.Name,
ADBGrid.Columns[j].FieldName, 64);
end;
finally
FreeAndNil(_MemIniU);
end;
end;
procedure TForm1.SaveDBGridColumnsWidth(const ADBGrid: TDBGrid);
var
_MemIniU: TMemIniFile;
_SettingsPath: string;
i: integer;
_ParentClass: TWinControl;
begin
_SettingsPath := GetHomePath + PathDelim + SETTINGS_FILE;
if (not Assigned(ADBGrid)) or
(not ForceDirectories(ExtractFilePath(_SettingsPath))) then
Exit;
_MemIniU := TMemIniFile.Create(_SettingsPath, TEncoding.UTF8);
try
_ParentClass := ADBGrid.Parent;
while not(_ParentClass is TForm) do
_ParentClass := _ParentClass.Parent;
for i := 0 to Pred(ADBGrid.Columns.Count) do
if (ADBGrid.Columns[i].FieldName <> '') then
_MemIniU.WriteInteger(_ParentClass.Name + '_' + ADBGrid.Name,
ADBGrid.Columns[i].FieldName, ADBGrid.Columns[i].Width);
_MemIniU.UpdateFile;
finally
FreeAndNil(_MemIniU);
end;
end;
I have been tasked with creating a Indy server in Delphi 2007 which communicates with clients and returns json formatted data from Sql based databases. Someone from our office created a prototype using php. And in the prototype they use the jSon_encode function extensively to return the data from tables. I was wondering if there was a similar Delphi function which could accept a TDataSet parameter and return properly formatted json data.
Anyone know of such function?
Update 12/10/2013 - my modification to #user2748835 answer:
function jsonencode(mString: String): String;
begin
result := StringReplace(mString,'''','\''',[rfReplaceAll,rfIgnoreCase]);
result := StringReplace(mString,'\','\\',[rfReplaceAll,rfIgnoreCase]);
result := StringReplace(result,crlf,'\n',[rfReplaceAll,rfIgnoreCase]);
result := StringReplace(result,'"','\"',[rfReplaceAll,rfIgnoreCase]);
result := StringReplace(result,'/','\/',[rfReplaceAll,rfIgnoreCase]);
result := StringReplace(result,'#9','\t',[rfReplaceAll,rfIgnoreCase]);
end;
function jSon_encode(aDataset:TDataset):string;
function fieldToJSON(thisField:TField):string;
begin
try
result := '"'+thisField.fieldName+'":';
case thisField.DataType of
ftInteger,ftSmallint,ftLargeint:
result := result+inttostr(thisField.AsInteger);
ftDateTime:
result := result+'"'+formatdatetime('YYYY-MM-DD HH:NN:SS',thisField.AsDateTime)+'"';
ftCurrency,
ftFloat:
result := result + floattostr(thisField.AsFloat);
ftString :
result := result + '"'+jsonencode(thisField.AsString)+'"';
else
end; // case
result := result + ',';
except
on e: Exception do begin
appendtolog('problem escaping field '+thisfield.fieldname);
end;
end;
end; // of fieldToJSON
function rowToJSON(ds:TDataset):string;
var
fieldIx : integer;
begin
result := '';
for fieldIx := 0 to ds.fieldcount-1 do
result := result + fieldToJSON(ds.Fields[fieldIx]);
// trim comma after last col
result := '{'+copy(result,1,length(result)-1)+'},';
end; // of rowToJSON
begin
result := '';
with aDataset do
begin
if not bof then first;
while not eof do
begin
result := result + rowToJSON(aDataset);
next;
end;
end;
//strip last comma and add
if length(result)>0 then
result := copy(result,1,length(result)-1);
result := '['+result+']';
end; // of DSToJSON
In a TDataset, you can loop through the Fields collection and construct the json output and then in the loop, check the fieldtype and encode the value accordingly.
Something like:
uses db;
function DSToJSON(aDataset:TDataset):string;
function fieldToJSON(thisField:TField):string;
begin
result := '"'+thisField.fieldName+'":';
case thisField.DataType of
ftInteger,
ftSmallint,
ftCurrency,
ftFloat,
ftLargeInt:
result := result+thisField.value+^n^j;
ftString :
result := noSingleQuotes(thisField.value)+^n^j;
else
end; // case
end; // of fieldToJSON
function rowToJSON(ds:TDataset):string;
var
fieldIx : integer;
begin
for fieldIx := 0 to ds.fieldcount-1 do
result := result + fieldToJSON(ds.Fields[fieldIx]);
// trim comma after last col
result := '{'+copy(result,1,length(result)-1)+'},';
end; // of rowToJSON
begin
result := '';
with aDataset do
begin
if not bof then first;
while not eof do
begin
result := result + rowToJSON(aDataset);
next;
end;
end;
//strip last comma and add
if length(result)>0 then
result := copy(result,1,length(result)-1);
result := '['+result+']';
end; // of DSToJSON
We just added a more complete and faster function, in our Open Source repository.
It is part of our mORMot framework, but can be used as a stand-alone unit, not tied to other features.
See in SynVirtualDataSet.pas:
function DataSetToJSON(Data: TDataSet): RawUTF8
See this commit and the associated forum thread.
You can change every row into object and use serializing http://docwiki.embarcadero.com/RADStudio/XE5/en/Serializing_User_Objects
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;