Here is a Delphi unit for a modal dialog to support Query By Form (QBF) for DbGrid components which receive data from Table components (not Query components).
The lack of this as a built-in feature makes it harder for Delphi to compete with more resource-intensive tools like Oracle Forms. This unit is not as powerful as the built-in QBF features of Oracle Forms, but it does fill a significant gap in functionality.
Note that the unit is copyrighted, as required by Borland's license, and as desired by me to retain credit for its development. Note that the copyright terms allow free use for any purpose.
--------------------------------------------------------------------------------
unit Db_QBF; { Database Query By Form -- Version 19950731 }
{ Copyright 1995 by Rick Rutt.
This work may be used, copied, or distributed by anyone for any purpose,
provided all copies retain this copyright notice,
and provided no fee is charged for the contents of this work.
The author grants permission to anyone to create a derivative work,
provided each derivative work contains a copyright notice and the notice
"Portions of this work are based on Db_QBF.PAS as written by Rick Rutt."
}
{ This unit provides a basic but effective Query By Form service
for database access applications written using Borland Delphi.
This unit also provides a similar Sort By Form service.
The Query By Form service displays a modal dialog box with a StringGrid
of searchable fields, taken from the calling DbGrid. The user may
enter an exact search value for any number of fields, and may use
drag and drop to rearrange the sort order of the fields.
(Only the fields that contain search values are relevant to the sort.)
When the user clicks the dialog's OK button, this unit modifies the
calling DbGrid's IndexFieldNames property, applies a search range
(of exact values), and refreshes the data.
If the user leaves all search values empty, this unit clears the
calling DbGrid's IndexFieldNames property, clears the search range,
and refreshes the data.
The Sort By Form service works in a similar manner, except that it
does not accept search values from the user. The user drags and drops
the field sort order, then clicks the OK button. This unit modifies
the calling DbGrid's IndexFieldNames property, clears the search range,
and refreshes the data.
}
{ Create the corresponding dialog form using the New Form action,
selecting a Standard Dialog Box. Place a StringGrid on the form
(as found in the Additional tab of the component toolbar.
Set the StringGrid's Height to 161 and its Width to 305.
Finally, replace the new form's .PAS source with this unit.
}
interface
uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Buttons,
StdCtrls, ExtCtrls, Grids, DBGrids;
{ The following two procedures provide the mechanism for accessing
the services of this unit.
Have a button or menu item on the calling form call one of these
procedures, passing the DbGrid as the argument. (Remember to add
"uses Db_QBF;" to the calling form's implementation section.)
Restriction: The DbGrid must reference a DataSource that, in turn,
references a DataSet that is a Table. This unit does not support
a DataSet that is a Query, since it has no IndexFieldNames property.
}
procedure QueryByForm(grid: TDbGrid);
procedure SortByForm(grid: TDbGrid);
{ The following section is managed by the Delphi environment. }
type
TdlgQBF = class(TForm)
OKBtn: TBitBtn;
CancelBtn: TBitBtn;
HelpBtn: TBitBtn;
gridQBF: TStringGrid;
procedure OKBtnClick(Sender: TObject);
procedure CancelBtnClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
dlgQBF: TdlgQBF;
implementation
{ The following section is managed by the programmer,
with assistance from the Delphi environment. }
uses Dialogs, Db, DbTables;
{$R *.DFM}
const
qbfRowHeight = 16;
qbfColWidth = 150;
qbfFieldLabel = '<>';
qbfValueLabel = '<>';
qbfQueryCaption = 'Query for Table ';
qbfSortCaption = 'Sort Order for Table ';
var
{ Remember some things for use by the QBF dialog's OK button. }
CallingGrid: TDbGrid;
CallingMode: (modeQuery, modeSort);
procedure SetupAndShowForm; { Called by the two exported procedures }
var
i, j, n: integer;
tbl: TTable;
f: TField;
begin
n := CallingGrid.FieldCount;
if n <= 0 then begin { Exceptions may be raised instead of showing messages }
MessageDlg(
'Db_QBF unit called for a DbGrid without any Fields',
mtWarning, [mbOK], 0);
end else if CallingGrid.DataSource = NIL then begin
MessageDlg(
'Db_QBF unit called for a DbGrid without a DataSource',
mtWarning, [mbOK], 0);
end else if CallingGrid.DataSource.DataSet = NIL then begin
MessageDlg(
'Db_QBF unit called for a DbGrid with a DataSource without a DataSet',
mtWarning, [mbOK], 0);
end else if not (CallingGrid.DataSource.DataSet is TTable) then begin
MessageDlg(
'Db_QBF unit called for a DbGrid with a DataSource that is not a Table',
mtWarning, [mbOK], 0);
end else with dlgQBF.gridQBF do begin
{ These properties can also be set once at design time }
DefaultRowHeight := qbfRowHeight;
Scrollbars := ssVertical;
ColCount := 2; { Even the Sort service needs a dummy second column }
{ These properties must be set at run time }
RowCount := Succ(n);
Cells[0,0] := qbfFieldLabel;
Options := Options + [goRowMoving];
tbl := TTable(CallingGrid.DataSource.DataSet);
if CallingMode = modeQuery then begin
dlgQBF.Caption := qbfQueryCaption + tbl.TableName;
Cells[1,0] := qbfValueLabel;
Options := Options + [goEditing]; { Allow user to enter values }
DefaultColWidth := qbfColWidth;
end else begin
dlgQBF.Caption := qbfSortCaption + tbl.TableName;
Cells[1,0] := ''; { Dummy "value" column to allow fixed "field" column }
Options := Options - [goEditing]; { User just reorders the rows }
DefaultColWidth := (2 * qbfColWidth); { Shove aside dummy 2nd column }
end;
j := 0; { Actual number of fields shown to user }
for i := 1 to n do begin
f := CallingGrid.Fields[Pred(i)];
if f.DataType in [ftBlob,ftBytes,ftGraphic,ftMemo,ftUnknown,ftVarBytes]
then RowCount := Pred(RowCount) { Ignore unsearchable fields }
else begin
Inc(j);
Cells[0,j] := f.FieldName;
Cells[1,j] := ''; { Empty search value }
end;
end;
dlgQBF.HelpBtn.Visible := False; { We haven't implemented Help }
dlgQBF.ShowModal;
end; { with dlgQBF.gridQBF }
end;
procedure QueryByForm(Grid: TDbGrid);
begin
CallingGrid := Grid; { Save for use by OK button }
CallingMode := modeQuery;
SetupAndShowForm;
end;
procedure SortByForm(Grid: TDbGrid);
begin
CallingGrid := Grid; { Save for use by OK button }
CallingMode := modeSort;
SetupAndShowForm;
end;
procedure TdlgQBF.CancelBtnClick(Sender: TObject);
begin
{ Just dismiss the dialog, without making changes to the calling grid. }
dlgQBF.Hide;
end;
procedure TdlgQBF.OKBtnClick(Sender: TObject);
var
flds, sep, val: string;
i, n, nfld: integer;
begin
flds := ''; { List of fields separated by ';'.}
sep := ''; { Becomes ';' after the 1st field is appended. }
nfld := 0; { Number of fields in the list. }
with dlgQBF.gridQBF do begin
n := Pred(RowCount);
if n > 0 then for i := 1 to n do begin
val := Cells[1,i]; { The user-entered search value (if any) }
if (CallingMode = modeSort)
or (val <> '') then begin
flds := flds + sep + Cells[0,i];
sep := ';';
nfld := Succ(nfld);
end;
end;
with CallingGrid.DataSource.DataSet as TTable do begin
IndexFieldNames := flds;
if (CallingMode = modeSort)
or (flds = '') then begin
CancelRange;
end else begin
SetRangeStart;
for i := 1 to n do begin
val := Cells[1,i];
if val <> '' then begin
FieldByName(Cells[0,i]).AsString := val;
end;
end;
SetRangeEnd; { Set range end to match range start }
for i := 1 to n do begin
val := Cells[1,i];
if val <> '' then begin
FieldByName(Cells[0,i]).AsString := val;
end;
end;
ApplyRange;
end;
Refresh;
end; { with CallingGrid.DataSource.DataSet }
end; { with dlgQBF.gridQBF }
dlgQBF.Hide;
end;
end.