The program I'm working on uses an if statement to add a line to the SQL for the contents of another combo box
procedure TFmNewGarage.ComboBoxCountryEnter(Sender: TObject);
begin
ADOQueryCountry.SQL.Clear;
ADOQueryCountry.SQL.Add('SELECT DISTINCT Country');
ADOQueryCountry.SQL.Add(' FROM TblBaseCar');
ADOQueryCountry.Open;
while not ADOQueryCountry.Eof do
begin
ComboBoxCountry.Items.Add(ADOQueryCountry['Country']);
ADOQueryCountry.Next;
end;
end;
procedure TFmNewGarage.ComboBoxCountryChange(Sender: TObject);
begin
SelA:=True;
ComboBoxManufacturer.Show;
ComboBoxCountry.Hide;
end;
procedure TFmNewGarage.ComboBoxManufacturerEnter(Sender: TObject);
begin
ADOQueryManufacturer.SQL.Clear;
ADOQueryManufacturer.SQL.Add('SELECT DISTINCT Manufacturer');
ADOQueryManufacturer.SQL.Add(' FROM TblBaseCar');
if SelA=true then
ADOQueryManufacturer.SQL.Add(' WHERE Country=(ComboBoxCountry.seltext)');
ADOQueryManufacturer.Open;
while not ADOQueryManufacturer.Eof do
begin
ComboBoxManufacturer.Items.Add(ADOQueryManufacturer['Manufacturer']);
ADOQueryManufacturer.Next;
end;
end;
At runtime this results in the error ComboBoxCountry.seltext has no default value, can anyone help me to rectify this?
SelText is not the property you should be using. You need the combobox Items value for the chosen ItemIndex:
var
Country: string;
begin
...
if ComboBoxCountry.ItemIndex <> -1 then
begin
Country := ComboBoxCountryItems[ComboBoxCountry.ItemIndex];
ADOQueryManufacturer.SQL.Add('WHERE Country = ' + QuotedStr(Country));
end;
end;
Related
I have two procedures that almost identical the only difference is the data type of one of the parameters.
procedure InsertNewStringAnswer(AidQuestion: Integer; AAnswer: String);
and
procedure InsertNewBoolAnswer(AidQuestion: Integer; AAnswer: Boolean);
I need to change the answer type based on the question. Do I have to write two procedures and call them with a third or is there a way I can change the data type of the parameter AAnswer at runtime?
I am editing this to show How I build the solution. In this case I used Variant type. I cannot verify if this is best practice but it works:).
procedure InsertNewAnswer(AidQuestion: Integer; AAnswer: Variant);
var
idNextRecord: string;
isBoolean: Boolean;
StrAAnswer: String;
BoolAAnswer: Boolean;
begin
With Connection.queryMain Do
begin
SQL.Clear;
SQL.Text := 'select count(*) as summe from dbo.Answer';
Open;
end;
idNextRecord := Connection.queryMain.FieldByName('summe').Asstring;
With Connection.queryMain Do
begin
SQL.Clear;
//Here I check if the question has a boolean or string answer.
SQL.Text :=('select isBool from dbo.Questions AS ISBOOL WHERE idQuestion= :SQLAidQuestion;');
ParamByName('SQLAidQuestion').AsInteger := AidQuestion;
Prepare;
Open;
end;
//and write it to a Variable.
isBoolean := Connection.queryMain.FieldByName('isBool').AsBoolean;
Connection.queryMain.SQL.Clear;
//I then use a if statement to change the Variant Type accordingly
if isBoolean = True then
begin
//Note that System.Variants does not have VarToBool so I use a workaround
BoolAAnswer := StrToBool(VarToStr(AAnswer));
AAnswer := BoolAAnswer;
Connection.queryMain.SQL.Text :=
('INSERT INTO Frueherkennung.dbo.Answer' +
'(idAnswer, idQuestion, Answer)VALUES(' + idNextRecord +
', :sqlQuestion, :sqlAAnswer);');
Connection.queryMain.ParamByName('sqlQuestion').AsInteger := AidQuestion;
Connection.queryMain.ParamByName('sqlAAnswer').AsBoolean := AAnswer;
end
else
begin
StrAAnswer := VarToStr(AAnswer);
MessageDlg('iSBool:= False', mtError, [mbok], 0);
AAnswer := StrAAnswer;
Connection.queryMain.SQL.Text :=('INSERT INTO Frueherkennung.dbo.Answer' +
'(idAnswer, idQuestion, Answer)VALUES(' + idNextRecord +
', :sqlQuestion, :sqlAAnswer);');
Connection.queryMain.ParamByName('sqlQuestion').AsInteger := AidQuestion;
Connection.queryMain.ParamByName('sqlAAnswer').Asstring := AAnswer
end;
With Connection.queryMain Do
begin
Prepare;
Execute;
SQL.Clear;
end;
end;
Thank you everyone for your awesome answers.
You can write a single function if the AAnswer argument is of type variant which allows almost anything in it.
You can also keep two procedures but with same name using the overload keyword.
And you can also have a single procedure taking AAnswer as untyped pointer to the storage the caller want to use. Of course at that moment, the question must contain the necessary information to decide if the point point to a boolean or to a string.
This last option is really not recommended. For me the cleanest solution is using overloaded procedures.
Forgot another possibility: use AAnswer of type array of const.
Sounds like a job for Generics.
In XE7 and later, you can do this:
type
TQuestion = class
public
class procedure InsertNewAnswer<T>(AidQuestion: Integer; AAnswer: T);
end;
class procedure TQuestion.InsertNewAnswer<T>(AidQuestion: Integer; AAnswer: T);
begin
case GetTypeKind(T) of
tkString, tkLString, tkUString, tkWString:
InsertNewStringAnswer(AidQuestion, AAnswer);
tkEnumeration:
if GetTypeData(TypeInfo(T))^.BaseType^ = TypeInfo(Boolean) then
InsertNewBoolAnswer(AidQuestion, PBoolean(#AAnswer)^);
...
end;
end;
Prior to XE7, you can do this instead:
type
TQuestion = class
public
class procedure InsertNewAnswer<T>(AidQuestion: Integer; AAnswer: T);
end;
...
uses
..., TypInfo;
class procedure TQuestion.InsertNewAnswer<T>(AidQuestion: Integer; AAnswer: T);
begin
case PTypeInfo(TypeInfo(T)).Kind of
tkString:
InsertNewStringAnswer(AidQuestion, PShortString(#AAnswer)^);
tkLString:
InsertNewStringAnswer(AidQuestion, PAnsiString(#AAnswer)^);
tkUString:
InsertNewStringAnswer(AidQuestion, PUnicodeString(#AAnswer)^);
tkWString:
InsertNewStringAnswer(AidQuestion, PWideString(#AAnswer)^);
tkEnumeration:
if GetTypeData(TypeInfo(T))^.BaseType^ = TypeInfo(Boolean) then
InsertNewBoolAnswer(AidQuestion, PBoolean(#AAnswer)^);
...
end;
end;
Either way, you can then call it like this:
TQuestion.InsertNewAnswer<String>(id, '...');
TQuestion.InsertNewAnswer<Boolean>(id, true);
...
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;
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;
I are using Delphi Berlin 10.1
When I create a TFDQuery it dont seem to be able to access it in my code using Findcomponent.
creation
procedure TDataModule1.QuVerConAfterOpen(DataSet: TDataSet);
begin
QuVerCon.First;
while not QuVerCon.Eof do
begin
if QuVerCon.FieldByName('Table').AsString <> 'versioncontrol' then
begin
TFDQuery.Create(self).Name := 'Qu' + QuVerCon.FieldByName('Table').AsString;
with TFDQuery(FindComponent('Qu' + QuVerCon.FieldByName('Table').AsString)) do
begin
Connection := SqlConn;
Open('select * From ' + QuVerCon.FieldByName('Table').AsString);
end;
end;
QuVerCon.Next;
end;
FMMain.Filter1.FormatScrn(FMMain.Filter1);
end;
Disconnection
procedure TDataModule1.SqlConnBeforeDisconnect(Sender: TObject);
var
Tbl: TFDQuery;
begin
with QuVerCon do
begin
First;
if FieldByName('Table').AsString <> 'versioncontrol' then
begin
Tbl := TFDQuery(FindComponent('Qu' + FieldByName('Table').AsString));
if Assigned(Tbl) then
TFDQuery(FindComponent('Qu' + FieldByName('Table').AsString)).Free;
end;
Next;
end;
QuVerCon.Close;
end;
The code skips over "if Assigned(Tbl) then" as it cant find it
where are I going wrong?
Is the a way to show a message box with a list of components of the data module so I can check when is disappears?
While showing a save dialog, I want to hook user's filter type change and change file extension automatically. (e.g. like MSPaint's "Save As" operation.)
With TSaveDialog and setting UseLatestCommonDialogs := False,
I can handle this by the following code. (without latest common dialog support, of cource.)
procedure TForm1.SaveDialog1TypeChange(Sender: TObject);
var
FName, Ext: string;
begin
with TSaveDialog(Sender) do
begin
if DirectoryExists(FileName) then // FileName is Empty
exit;
case FilterIndex of
1: Ext := '.png';
2: Ext := '.bmp';
3: Ext := '.jpg';
end;
FName := ChangeFileExt(ExtractFileName(FileName), Ext);
SendMessage(Windows.GetParent(Handle), CDM_SETCONTROLTEXT, 1152, LongInt(PChar(FName)));
end;
end;
I want to support both XP, and vista/7 with Delphi 2007.
Should I use TFileSaveDialog instead of TSaveDialog with internal wrapper ?
(And I have to struggle with COM programming using IFileDialogControlEvents ?)
Or can I achieve this with TFileSaveDialog and it's standard properties only ?
(My development environment is still on XP machine, so I've never tried. sorry.)
I think it's very common task, but I couldn't find any sample code supporting Vista/7...
As far as I know, TFileSaveDialog will raise an exception on XP. It needs Vista or up.
Update: some D2010 code for TFileSaveDialog adapted from your event handler....
(I don't have D2007 on Vista; use PWideChar instead of PChar)
procedure TForm1.FileSaveDialog1TypeChange(Sender: TObject);
var
FName, Ext: string;
pName: PChar;
begin
with TFileSaveDialog(Sender) do
begin
if DirectoryExists(FileName) then // FileName is Empty
exit;
case FileTypeIndex of
1: Ext := '.png';
2: Ext := '.bmp';
3: Ext := '.jpg';
end;
Dialog.GetFileName(pName);
FName := ChangeFileExt(ExtractFileName(pName), Ext);
Dialog.SetFileName(PChar(FName));
end;
end;
Where the FileSaveDialog is:
object FileSaveDialog1: TFileSaveDialog
FavoriteLinks = <>
FileTypes = <
item
DisplayName = 'png files'
FileMask = '*.png'
end
item
DisplayName = 'bmp files'
FileMask = '*.bmp'
end
item
DisplayName = 'jpg files'
FileMask = '*.jpg'
end>
Options = []
OnTypeChange = FileSaveDialog1TypeChange
end
You wrote that you couldn't hack the wrapper. I use this code for my XLSX/XLS/ODS exporting library to change the file extension on both XP and Vista+.
One drawback: Class helpers cannot access private fields in Delphi 2007, so this code works only in Delphi 2009+. If you want Delphi 2007 compatibility, use the same hack for TOpenDialog like I used for TFileDialogWrapper in this example.
{ interface }
//some hacking needed to change the file extension at type change,
//empty class is just fine...
TFileDialogWrapper = class(TObject)
private
{$HINTS OFF}
procedure AssignFileTypes;
procedure AssignOptions;
function GetFileName: TFileName;
function GetHandle: HWND;
procedure HandleShareViolation(Sender: TObject;
var Response: TFileDialogShareViolationResponse);
procedure OnFileOkEvent(Sender: TObject; var CanClose: Boolean);
procedure OnFolderChangeEvent(Sender: TObject);
procedure OnSelectionChangeEvent(Sender: TObject);
procedure OnTypeChangeEvent(Sender: TObject);
protected
FFileDialog: TCustomFileDialog;
{$HINTS ON}
end;
TOpenDialogHelper = class helper for TOpenDialog
public
function GetInternalWrapper: TFileDialogWrapper;
end;
{ implementation }
{ TOpenDialogHelper }
function TOpenDialogHelper.GetInternalWrapper: TFileDialogWrapper;
begin
Result := TFileDialogWrapper(Self.FInternalWrapper);
end;
{ TFileDialogWrapper }
procedure TFileDialogWrapper.AssignFileTypes;
begin
end;
procedure TFileDialogWrapper.AssignOptions;
begin
end;
function TFileDialogWrapper.GetFileName: TFileName;
begin
end;
function TFileDialogWrapper.GetHandle: HWND;
begin
end;
procedure TFileDialogWrapper.HandleShareViolation(Sender: TObject;
var Response: TFileDialogShareViolationResponse);
begin
end;
procedure TFileDialogWrapper.OnFileOkEvent(Sender: TObject;
var CanClose: Boolean);
begin
end;
procedure TFileDialogWrapper.OnFolderChangeEvent(Sender: TObject);
begin
end;
procedure TFileDialogWrapper.OnSelectionChangeEvent(Sender: TObject);
begin
end;
procedure TFileDialogWrapper.OnTypeChangeEvent(Sender: TObject);
begin
end;
//use this for OnTypeChane event of a "normal" TOpenDialog / TSaveDialog
procedure TForm1.DialogTypeChange(Sender: TObject);
var
xFN: WideString;
xExporter: TOCustomExporter;
xFileName: PWideChar;
xFD: TFileDialogWrapper;
xFilterIndex: UINT;
begin
if Sender is TOpenDialog then
with TOpenDialog(Sender) do begin
xFD := GetInternalWrapper;
if (xFD <> nil) and (xFD.FFileDialog <> nil)
then begin
//Vista file dialog
xFD.FFileDialog.Dialog.GetFileName(xFileName);
if xFileName = '' then
exit;
xFN := xFileName;
xFD.FFileDialog.Dialog.GetFileTypeIndex(xFilterIndex);
// DO WHATEVER YOU WANT WITH THE FILENAME HERE //
xFD.FFileDialog.Dialog.SetFileName(PWideChar(xFN));
end else begin
//Old dialog
xFN := ExtractFileName(FileName);
if xFN = '' then
exit;
// DO WHATEVER YOU WANT WITH THE FILENAME HERE //
{$HINTS OFF}
SendMessage(Windows.GetParent(Handle), CDM_SETCONTROLTEXT, 1152, LongInt(PWideChar(xFN)));
{$HINTS ON}
end;
end;
end;
EDIT: actually, if you set the DefaultExt property, Delphi/Windows care about the file extension change for you. In that case you don't have to do anything in the OnTypeChange event.
This feature is implemented in Delphi, but disabled by default.
In order to activate it, just entry the default extension in DefaultExt property.