unit ads_DlgDBFilter;
{Copyright(c)2016 Advanced Delphi Systems
Richard Maley
Advanced Delphi Systems
12613 Maidens Bower Drive
Potomac, MD 20854 USA
phone 301-840-1554
dickmaley@advdelphisys.com
The code herein can be used or modified by anyone. Please retain references
to Richard Maley at Advanced Delphi Systems. If you make improvements to the
code please send your improvements to dickmaley@advdelphisys.com so that the
entire Delphi community can benefit. All comments are welcome.
}
(*
Description: ads_DlgDBFilter.pas.pas
This unit contains
*)
(*UnitIndex Master Index Implementation Section Download UnitsDescription: ads_DlgDBFilter.pas This unit contains the following routines.
ButtonReSizer CenterChildren_H DlgDBFilter_ads GetCenterFormLeft GetCenterFormTop SetChildWidths TDBTableFilterDlg_ads.Append_cbChange TDBTableFilterDlg_ads.ButtonAddClick TDBTableFilterDlg_ads.ButtonCancelClick TDBTableFilterDlg_ads.ButtonClearClick TDBTableFilterDlg_ads.ButtonOKClick TDBTableFilterDlg_ads.Case_cbClick TDBTableFilterDlg_ads.ComboBoxOperatorChange TDBTableFilterDlg_ads.EditFilterChange TDBTableFilterDlg_ads.Exact_cbClick TDBTableFilterDlg_ads.FilterButtonsEnabled TDBTableFilterDlg_ads.FormActivate TDBTableFilterDlg_ads.FormCreate TDBTableFilterDlg_ads.FormResize TDBTableFilterDlg_ads.lb_FieldNameChange TDBTableFilterDlg_ads.lb_FieldNameClick TDBTableFilterDlg_ads.MakeBeveled TDBTableFilterDlg_ads.RemoveFilter TDBTableFilterDlg_ads.ResizeAll TDBTableFilterDlg_ads.SetBevel TDBTableFilterDlg_ads.SetBeveled TDBTableFilterDlg_ads.SetColorOfComboBoxs TDBTableFilterDlg_ads.SetColorOfFilterEdit TDBTableFilterDlg_ads.SetColorOfMemo TDBTableFilterDlg_ads.SetComboBoxColor TDBTableFilterDlg_ads.SetFilter TDBTableFilterDlg_ads.SetMinFormHeight TDBTableFilterDlg_ads.SetMinFormWidth TDBTableFilterDlg_ads.SetReSizeNow TDBTableFilterDlg_ads.TypeFieldFromDataSet
*)
interface
Uses DB;
{!~DlgDBFilter_ads
Presents a Dataset Filter dialog
}
Function DlgDBFilter_ads(DataSet: TDataSet): Boolean;
implementation
Uses
ads_Exception,
SysUtils,
WinTypes,
WinProcs,
Messages,
Classes,
Graphics,
Controls,
Forms,
Dialogs,
StdCtrls,
Buttons,
ExtCtrls
;
Var
UnitName : String;
ProcName : String;
//Unit Description UnitIndex Master Index
procedure ButtonReSizer(
ButtonBase : TPanel;
ButtonSlider : TPanel;
ButtonWidth : Integer;
ButtonSpacer : Integer;
ButtonsReSize : Boolean;
ButtonsAlignment: TAlignment;
Beveled : Boolean);
Var
MinFormWidth : Integer;
NButtons : Integer;
i : Integer;
NSpacers : Integer;
SpacerWidth : Integer;
SpacersWidth : Integer;
W : Integer;
LeftPos : Integer;
Begin
NButtons := ButtonSlider.ControlCount;
If ButtonSpacer > 0 Then
Begin
SpacerWidth := ButtonSpacer;
NSpacers := NButtons +1;
SpacersWidth := ButtonSpacer * NSpacers;
End
Else
Begin
SpacerWidth := 0;
SpacersWidth:= 0;
End;
MinFormWidth :=
SpacersWidth +
(NButtons * ButtonWidth) +
(ButtonBase.BorderWidth * 2) +
(ButtonBase.BevelWidth * 4) +
25;
Try
If ButtonBase.Parent is TForm Then
Begin
If ButtonBase.Parent.Width < MinFormWidth Then
Begin
ButtonBase.Parent.Width := MinFormWidth;
End;
End
Else
Begin
Try
If ButtonBase.Parent.Parent is TForm Then
Begin
If ButtonBase.Parent.Parent.Width < MinFormWidth Then
Begin
ButtonBase.Parent.Parent.Width := MinFormWidth;
End;
End
Else
Begin
Try
If ButtonBase.Parent.Parent.Parent is TForm Then
Begin
If ButtonBase.Parent.Parent.Parent.Width < MinFormWidth Then
Begin
ButtonBase.Parent.Parent.Parent.Width := MinFormWidth;
End;
End
Else
Begin
Try
If ButtonBase.Parent.Parent.Parent.Parent is TForm Then
Begin
If ButtonBase.Parent.Parent.Parent.Parent.Width < MinFormWidth Then
Begin
ButtonBase.Parent.Parent.Parent.Parent.Width := MinFormWidth;
End;
End
Else
Begin
{Not going to set a minimum form width}
End;
Except
End;
End;
Except
End;
End;
Except
End;
End;
Except
End;
If Beveled Then
Begin
ButtonBase.Height :=
(ButtonBase.BorderWidth * 2) +
(ButtonBase.BevelWidth * 4) +
2 {for borderStyle} +
25 {for standard button height} +
3;
End
else
Begin
ButtonBase.Height :=
(ButtonBase.BorderWidth * 2) +
25 {for standard button height} +
4;
End;
If ButtonsReSize Then
Begin
Buttonslider.Align := alClient;
W := (Buttonslider.Width - SpacersWidth) div NButtons;
LeftPos := SpacerWidth;
For i := 0 To NButtons - 1 Do
Begin
ButtonSlider.Controls[i].Align := alNone;
ButtonSlider.Controls[i].Top := 0;
ButtonSlider.Controls[i].Height := 25;
ButtonSlider.Controls[i].Width := W;
ButtonSlider.Controls[i].Left := LeftPos;
LeftPos := LeftPos + W + SpacerWidth;
End;
End
Else
Begin
ButtonSlider.Align := alNone;
If Beveled Then
Begin
ButtonSlider.Top :=
ButtonBase.BorderWidth +
(ButtonBase.BevelWidth * 2)+
1 + {For BorderStyle}
0; {For Margin}
End
Else
Begin
ButtonSlider.Top :=
ButtonBase.BorderWidth +
1; {For Margin}
End;
ButtonSlider.Height := 25;
ButtonSlider.Width :=
SpacersWidth +
(NButtons * ButtonWidth);
If (Not Beveled) Then
Begin
{Align totally left with not leftmost spacer}
If ButtonsAlignment = taLeftJustify Then
Begin
LeftPos := 0;
End
Else
Begin
If ButtonsAlignment = taRightJustify Then
Begin
{Align totally Right with not rightmost spacer}
LeftPos := 2 * SpacerWidth;
End
Else
Begin
LeftPos := SpacerWidth;
End;
End;
End
Else
Begin
LeftPos := SpacerWidth;
End;
For i := 0 To NButtons - 1 Do
Begin
ButtonSlider.Controls[i].Align := alNone;
ButtonSlider.Controls[i].Top := 0;
ButtonSlider.Controls[i].Height := 25;
ButtonSlider.Controls[i].Width := ButtonWidth;
ButtonSlider.Controls[i].Left := LeftPos;
LeftPos := LeftPos + ButtonWidth+ SpacerWidth;
End;
If ButtonsAlignment = taLeftJustify Then ButtonSlider.Align := alLeft;
If ButtonsAlignment = taRightJustify Then ButtonSlider.Align := alRight;
If ButtonsAlignment = taCenter Then
Begin
ButtonSlider.Align := alNone;
ButtonSlider.Left :=
(ButtonBase.Width -
ButtonSlider.Width) div 2;
End;
End;
ButtonBase.Refresh;
End;
//Unit Description UnitIndex Master Index
procedure SetChildWidths(Panel : TPanel);
Var
i : Integer;
Width : Integer;
Begin
Width :=
(Panel.Width -
(Panel.BorderWidth * 2) -
(Panel.BevelWidth * 4)) div Panel.ControlCount;
For i := 0 To Panel.ControlCount - 1 Do
Begin
Panel.Controls[i].Width := Width;
End;
End;
//Unit Description UnitIndex Master Index
procedure CenterChildren_H(Panel : TPanel);
Var
i : Integer;
Begin
For i := 0 To Panel.ControlCount - 1 Do
Begin
Panel.Controls[i].Left :=
(Panel.Width - Panel.Controls[i].Width) div 2;
End;
End;
//Unit Description UnitIndex Master Index
Function GetCenterFormLeft(FormWidth : Integer): Integer;
Begin
If Screen.Width < FormWidth Then
Begin
Result := Screen.Width-26;
End
Else
Begin
Result := (Screen.Width - FormWidth) div 2;
End;
End;
//Unit Description UnitIndex Master Index
Function GetCenterFormTop(FormHeight : Integer): Integer;
Begin
If Screen.Height < FormHeight Then
Begin
Result := Screen.Height-26;
End
Else
Begin
Result := (Screen.Height - FormHeight) div 2;
End;
End;
type
{custom type - enumerated type representing the operator to use in the filter}
TFilterOperator = (foEqual,foNotEqual,foGreaterThan,foLessThan,foGreaterEqualThan,foLessEqualThan);
type
TDBTableFilterDlg_ads = Class(TScrollingWinControl)
Public
Constructor Create(AOwner: TComponent); Override;
Destructor Destroy; Override;
Public
pnl_base: TPanel;
PanelButtons: TPanel;
PanelFilterTop: TPanel;
PanelFilter: TPanel;
FiltersOld: TMemo;
FiltersNew: TMemo;
PanelAddFilter: TPanel;
Field_Name_Base: TPanel;
L_FieldName: TPanel;
Filter_Base: TPanel;
Panel7: TPanel;
GroupBox1: TGroupBox;
Panel1: TPanel;
EditFilter: TEdit;
Panel2: TPanel;
Panel3: TPanel;
Case_cb: TCheckBox;
Exact_cb: TCheckBox;
Append_Base: TPanel;
Append_Label: TPanel;
Append_cb: TComboBox;
PanelTopMiddle: TPanel;
Panel4: TPanel;
Panel5: TPanel;
ComboBoxOperator: TComboBox;
PanelButtonSlider: TPanel;
ButtonOK: TBitBtn;
ButtonCancel: TBitBtn;
lb_FieldName: TListBox;
GroupBox2: TGroupBox;
PanelActions: TPanel;
ButtonAdd: TBitBtn;
ButtonClear: TBitBtn;
procedure FormCreate(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure EditFilterChange(Sender: TObject);
procedure ComboBoxOperatorChange(Sender: TObject);
procedure lb_FieldNameChange(Sender: TObject);
procedure ButtonAddClick(Sender: TObject);
procedure ButtonClearClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure ButtonCancelClick(Sender: TObject);
procedure Exact_cbClick(Sender: TObject);
procedure Case_cbClick(Sender: TObject);
procedure Append_cbChange(Sender: TObject);
procedure ButtonOKClick(Sender: TObject);
procedure lb_FieldNameClick(Sender: TObject);
private
{ Private declarations }
FDataSet:{$IFDEF WIN32} TDataSet {$ELSE} TTable {$ENDIF};
FField: string; {stores fieldname}
FFilter : string; {stores filter}
{$IFDEF WIN32}
FFilterOperator : string; {stores filter-operator}
{$ELSE}
fFilterOperator : TFilterOperator;
{$ENDIF}
FFilters : String;
FAppend : String;
FCaseInsensitive : Boolean;
FExactMatch : Boolean;
FFiltered : Boolean;
FWildCard : Boolean;
FColorOfComboBoxs : TColor;
FColorOfFilterEdit : TColor;
FColorOfMemo : TColor;
FTitle : String; {stores the Dialog Title}
FBeveled : Boolean; {Selected panels have beveling if true}
FButtonsReSize : Boolean; {Buttons resize if true}
FButtonsAlignment : TAlignment; {taLeftJustify, taCenter, taRightJustify}
FButtonWidth : Integer; {Sets Button Widths}
FButtonSpacer : Integer; {Sets Button Spacer Width}
FApplyChanges : Boolean; {True if changes should be made. = mrOk}
FModal : Boolean; {True if Form is being shown modal}
FIsComponent : Boolean; {True if Form is part of a component,
False if Form is a standalone form,
Default is False}
FReSizeNow : Boolean; {Causes the form to resize when the
property is set}
FMinFormWidth : Integer; {Sets a Minimum FormWidth}
FMinFormHeight : Integer; {Sets a Minimum FormHeight}
FDialogComponentName : String;
{$IFNDEF WIN32}
FTable : TTable;
{$ENDIF}
procedure SetReSizeNow(Value : Boolean);
procedure SetMinFormWidth(Value : Integer);
procedure SetMinFormHeight(Value : Integer);
procedure SetBeveled(Value : Boolean);
Procedure SetColorOfMemo(Value : TColor);
Procedure SetColorOfFilterEdit(Value : TColor);
Procedure SetColorOfComboBoxs(Value : TColor);
public
{ Public declarations }
procedure ReSizeAll;
procedure SetBevel;
property IsComponent : Boolean
Read FIsComponent
Write FIsComponent;
property ReSizeNow : Boolean
Read FReSizeNow
Write SetReSizeNow;
Procedure FilterButtonsEnabled;
Function TypeFieldFromDataSet(DataSet: TDataSet; FieldName: String): String;
Procedure MakeBeveled(B : Boolean);
Procedure SetComboBoxColor(C : TColor);
{$IFNDEF WIN32}
procedure SetFilter; {set filter on table}
procedure RemoveFilter; {remove filter from table}
property Table : TTable
Read FTable
Write FTable;
{$ENDIF}
published
{ Published declarations }
property DataSet:
{$IFDEF WIN32} TDataSet {$ELSE} TTable {$ENDIF}
read FDataSet
write FDataSet;
property Field: string read FField write FField;
property Filter: string read FFilter write FFilter;
{$IFDEF WIN32}
property FilterOperator: string read FFilterOperator write FFilterOperator;
{$ELSE}
property FilterOperator: TFilterOperator read FFilterOperator write FFilterOperator;
{$ENDIF}
property Filters: String read FFilters write FFilters;
property Append: String read FAppend write FAppend;
property CaseInsensitive : Boolean
Read FCaseInsensitive
Write FCaseInsensitive;
property ExactMatch : Boolean
Read FExactMatch
Write FExactMatch;
property Filtered : Boolean
Read FFiltered
Write FFiltered;
property WildCard : Boolean
Read FWildCard
Write FWildCard;
property ColorOfComboBoxs : TColor
Read FColorOfComboBoxs
Write SetColorOfComboBoxs;
property ColorOfFilterEdit : TColor
Read FColorOfFilterEdit
Write SetColorOfFilterEdit;
property ColorOfMemo : TColor
Read FColorOfMemo
Write SetColorOfMemo;
property Title : String {stores the Dialog Title}
read FTitle
write FTitle;
property Beveled : Boolean {Selected panels have beveling if true}
Read FBeveled
Write SetBeveled;
property ButtonsReSize : Boolean {Buttons resize if true}
Read FButtonsReSize
Write FButtonsReSize;
property ButtonsAlignment : TAlignment {taLeftJustify, taCenter, taRightJustify}
Read FButtonsAlignment
Write FButtonsAlignment;
property ButtonWidth : Integer {Sets Button Widths}
Read FButtonWidth
Write FButtonWidth;
property ButtonSpacer : Integer {Sets Button Spacer Width}
Read FButtonSpacer
Write FButtonSpacer;
property ApplyChanges: Boolean {True if changes should be made. = mrOk}
Read FApplyChanges
Write FApplyChanges;
property Modal : Boolean {True if Form is being shown modal}
Read FModal
Write FModal;
property MinFormWidth : Integer {Sets the form's Minimum Width}
Read FMinFormWidth
Write SetMinFormWidth;
property MinFormHeight : Integer {Sets the form's Minimum Height}
Read FMinFormHeight
Write SetMinFormHeight;
property DialogComponentName : String {Used in messages to display the }
Read FDialogComponentName {dialog component name}
Write FDialogComponentName;
end;
//Unit Description UnitIndex Master Index
Procedure TDBTableFilterDlg_ads.ResizeAll;
Begin
If Width < MinFormWidth Then Width := MinFormWidth;
If Height < MinFormHeight Then Height := MinFormHeight;
ButtonReSizer(
PanelButtons, {ButtonBase}
PanelButtonSlider, {ButtonSlider}
ButtonWidth, {ButtonWidth}
ButtonSpacer, {ButtonSpacer}
ButtonsReSize, {ButtonsReSize}
ButtonsAlignment, {ButtonsAlignment}
Beveled); {Beveled}
SetChildWidths(PanelAddFilter);
CenterChildren_H(PanelActions);
End;
//Unit Description UnitIndex Master Indexprocedure TDBTableFilterDlg_ads.FormResize(Sender: TObject); begin ResizeAll; end; //Unit Description UnitIndex Master Index
Procedure TDBTableFilterDlg_ads.FilterButtonsEnabled;
Begin
If (lb_FieldName.ItemIndex = -1) Or
(ComboBoxOperator.Text = '') Or
(EditFilter.Text = '') Or
(DataSet = nil)
Then
Begin
{$IFDEF WIN32}
ButtonAdd.Enabled := False;
ButtonAdd.Default := False;
{$ENDIF}
ButtonOK.Enabled := False;
ButtonOK.Default := True;
End
Else
Begin
{$IFDEF WIN32}
ButtonAdd.Enabled := True;
ButtonAdd.Default := True;
{$ENDIF}
ButtonOK.Enabled := True;
ButtonOK.Default := False;
End;
{$IFDEF WIN32}
ButtonOK.Enabled := Not (FiltersNew.Lines[0] = '');
Append_cb.Enabled := Not (FiltersNew.Lines[0] = '');
{$ELSE}
Append_cb.Enabled := False;
{$ENDIF}
End;
//Unit Description UnitIndex Master Index
procedure TDBTableFilterDlg_ads.EditFilterChange(Sender: TObject);
begin
FilterButtonsEnabled;
Filter := EditFilter.Text;
{
If EditFilter.Text = '' Then
Begin
Filter := '';
End
Else
Begin
Filter := EditFilter.Text;
End;
}
end;
//Unit Description UnitIndex Master Index
procedure TDBTableFilterDlg_ads.ComboBoxOperatorChange(Sender: TObject);
begin
FilterButtonsEnabled;
{$IFDEF WIN32}
FilterOperator := ComboBoxOperator.Text;
{$ELSE}
FilterOperator := TFilterOperator(ComboBoxOperator.ItemIndex);
{$ENDIF}
end;
//Unit Description UnitIndex Master Indexprocedure TDBTableFilterDlg_ads.lb_FieldNameChange(Sender: TObject); begin FilterButtonsEnabled; Field := lb_FieldName.Items[lb_FieldName.ItemIndex]; end; //Unit Description UnitIndex Master Index
procedure TDBTableFilterDlg_ads.ButtonAddClick(Sender: TObject);
Var
TempFilter : String;
WildAfter : String;
QuoteString: String;
FieldType : String;
begin
{$IFDEF WIN32}
FieldType := '';
Field := lb_FieldName.Items[lb_FieldName.ItemIndex];
FilterOperator := ComboBoxOperator.Text;
Filter := EditFilter.Text;
Append := Append_cb.Text;
FieldType := UpperCase(TypeFieldFromDataSet(DataSet,Field));
If (FieldType = 'STRING') Or
(FieldType = 'DATE') Or
(FieldType = 'DATETIME') Or
(FieldType = 'TIME') Or
(FieldType = 'MEMO') Then
Begin
QuoteString := '''';
If WildCard Then
Begin
WildAfter := '*';
Exact_cb.Checked := False;
ExactMatch := False;
CaseInsensitive := True;
Case_cb.Checked := Not CaseInsensitive;
End
Else
Begin
WildAfter := '';
End;
End
Else
Begin
QuoteString := '';
WildAfter := '';
End;
TempFilter := '(['+Field +
'] '+FilterOperator+
' ('+
QuoteString+
Filter+
WildAfter+
QuoteString+
'))';
If FiltersNew.Lines[0] = '' Then
Begin
FiltersNew.Lines[0] := TempFilter;
End
Else
Begin
FiltersNew.Lines.Add(' '+Append+' ');
FiltersNew.Lines.Add(TempFilter);
End;
Filter := '';
EditFilter.Text:= '';
FilterButtonsEnabled;
{$ENDIF}
end;
//Unit Description UnitIndex Master Index
procedure TDBTableFilterDlg_ads.ButtonClearClick(Sender: TObject);
begin
{$IFDEF WIN32}
FiltersNew.Lines.Clear;
{$ELSE}
RemoveFilter;
{$ENDIF}
end;
//Unit Description UnitIndex Master Index
procedure TDBTableFilterDlg_ads.FormCreate(Sender: TObject);
begin
ColorOfMemo := clWindow;
ColorOfFilterEdit := clWindow;
ColorOfComboBoxs := clWindow;
{$IFDEF WIN32}
Height := 422;
{$ELSE}
Height := 422 - PanelFilterHeight;
{$ENDIF}
Width := 495;
EditFilter.Text := '';
ButtonAdd.Enabled := False;
ButtonClear.Enabled := True;
ComboBoxOperator.Align := alTop;
EditFilter.Align := alTop;
FiltersNew.Align := alClient;
Append_cb.Align := alTop;
WildCard := True;
Title := 'Table Filter Dialog';{stores the Dialog Title}
Beveled := False; {Selected panels have beveling if true}
ButtonsReSize := False; {Buttons resize if true}
ButtonsAlignment := taCenter; {taLeftJustify, taCenter, taRightJustify}
ButtonWidth := 75; {Sets Button Widths}
ButtonSpacer := 10; {Sets Button Spacer Width}
ApplyChanges := False; {True if changes should be made. = mrOk}
Modal := True; {True if Form is being shown modal}
IsComponent := False; {True if Form is part of a component,
False if Form is a standalone form,
Default is False}
FMinFormWidth := 435; {Sets a Minimum FormWidth}
{$IFDEF WIN32}
FMinFormHeight := 422; {Sets a Minimum FormHeight}
{$ELSE}
FMinFormHeight := 422 - {Sets a Minimum FormHeight}
PanelFilterHeight;
{$ENDIF}
FDialogComponentName := 'TDBTableFilterDialog_ads';
{Set bevel prior to resizing}
SetBevel;
{ReSize at the end of the create}
{$IFNDEF WIN32}
GroupBox1.Caption := '';
GroupBox2.Caption := '';
ButtonAdd.Visible := False;
PanelFilter.Visible := False;
Append_cb.Visible := False;
Case_cb.Visible := False;
Exact_cb.Visible := False;
PanelAddFilter.Align := alClient;
ButtonClear.ModalResult := mrOK;
{$ENDIF}
ReSizeAll;
end;
//Unit Description UnitIndex Master Indexprocedure TDBTableFilterDlg_ads.ButtonCancelClick(Sender: TObject); begin ApplyChanges := False; end; //Unit Description UnitIndex Master Index
procedure TDBTableFilterDlg_ads.FormActivate(Sender: TObject);
Var i : Integer;
begin
If IsComponent Then
Begin
{}
End
Else
Begin
Caption := Title; {stores the Dialog Title}
SetBevel;
Left := GetCenterFormLeft(Width);
Top := GetCenterFormTop(Height);
End;
WildCard := True;
If Not (DataSet = nil) Then
Begin
lb_FieldName.Items.Clear;
For i := 0 to (DataSet.FieldCount -1) Do
Begin
lb_FieldName.Items.Add(DataSet.Fields[i].FieldName);
End;
lb_FieldName.ItemIndex := 0;
{$IFDEF WIN32}
FiltersOld.Lines.Clear;
If DataSet.Filter = '' Then
Begin
FiltersOld.Lines.Add('');
End
Else
Begin
FiltersOld.Lines.Add(DataSet.Filter);
End;
FiltersNew.Lines.Clear;
If DataSet.Filter = '' Then
Begin
FiltersNew.Lines.Add('');
End
Else
Begin
FiltersNew.Lines.Add(DataSet.Filter);
End;
Filtered := True;
If DataSet.FilterOptions = [foCaseInsensitive] Then
Begin
CaseInsensitive := True;
ExactMatch := False;
WildCard := True;
End;
If DataSet.FilterOptions = [foNoPartialCompare] Then
Begin
CaseInsensitive := False;
ExactMatch := True;
WildCard := False;
End;
If DataSet.FilterOptions = [foCaseInsensitive,foNoPartialCompare] Then
Begin
CaseInsensitive := True;
ExactMatch := True;
WildCard := False;
End;
If DataSet.FilterOptions = [] Then
Begin
CaseInsensitive := True;
ExactMatch := False;
WildCard := True;
End;
Case_cb.Checked := Not CaseInsensitive;
Exact_cb.Checked := ExactMatch;
{$ENDIF}
End;
{$IFNDEF WIN32}
Table := DataSet;
{$ENDIF}
ComboBoxOperator.ItemIndex := 0;
EditFilter.Text := '';
FilterButtonsEnabled;
end;
//Unit Description UnitIndex Master Index
procedure TDBTableFilterDlg_ads.Exact_cbClick(Sender: TObject);
begin
ExactMatch := Exact_cb.Checked;
If ExactMatch Then
Begin
WildCard := False;
End
Else
Begin
WildCard := True;
End;
end;
//Unit Description UnitIndex Master Index
procedure TDBTableFilterDlg_ads.Case_cbClick(Sender: TObject);
begin
CaseInsensitive := Not Case_cb.Checked;
If Not CaseInsensitive Then
Begin
WildCard := False;
End
Else
Begin
WildCard := True;
End;
end;
//Unit Description UnitIndex Master Indexprocedure TDBTableFilterDlg_ads.Append_cbChange(Sender: TObject); begin FilterButtonsEnabled; Append := Append_cb.Text; end; //Unit Description UnitIndex Master Index
procedure TDBTableFilterDlg_ads.ButtonOKClick(Sender: TObject);
Var
i : Integer;
begin
{$IFDEF WIN32}
//ModalResult := mrOK;
If Not (EditFilter.Text = '') Then
Begin
If MessageDlg('Data in the Value field has'+
' not been added to the filters! Continue?',
mtInformation, [mbYes, mbNo], 0) = mrNo Then
Begin
//ModalResult := mrNone;
Exit;
End;
End;
DataSet.Active := False;
If CaseInsensitive Then
Begin
If ExactMatch Then
Begin
DataSet.FilterOptions := [foCaseInsensitive,foNoPartialCompare];
End
Else
Begin
DataSet.FilterOptions := [foCaseInsensitive];
End;
End
Else
Begin
If ExactMatch Then
Begin
DataSet.FilterOptions := [foNoPartialCompare];
End
Else
Begin
DataSet.FilterOptions := [];
End;
End;
DataSet.Filtered := Filtered;
DataSet.Filter := '';
For i := 0 To FiltersNew.Lines.Count -1 Do
Begin
DataSet.Filter := DataSet.Filter + FiltersNew.Lines[i];
End;
Try
DataSet.Active := True;
Except
DataSet.Active := False;
DataSet.Filter := '';
For i := 0 To FiltersOld.Lines.Count -1 Do
Begin
DataSet.Filter := DataSet.Filter + FiltersOld.Lines[i];
End;
Try
DataSet.Active := True;
Except
DataSet.Filter := '';
DataSet.Filtered := False;
End;
End;
{$ELSE}
Field := lb_FieldName.Items[lb_FieldName.ItemIndex];
FilterOperator := TFilterOperator(ComboBoxOperator.ItemIndex);
Filter := EditFilter.Text;
SetFilter;
{$ENDIF}
ApplyChanges := True;
end;
{Returns the database field type as a string. If there
is an error a null string is returned.}
//Unit Description UnitIndex Master Index
Function TDBTableFilterDlg_ads.TypeFieldFromDataSet(DataSet: TDataSet; FieldName: String): String;
Var
FieldIndex : Integer;
FieldType : TFieldType;
Begin
Try
DataSet.Active := True;
FieldIndex :=
DataSet.FieldDefs.IndexOf(FieldName);
FieldType :=
DataSet.FieldDefs[FieldIndex].DataType;
{TFieldType Possible values are
ftUnknown, ftString, ftSmallint,
ftInteger, ftWord, ftBoolean,
ftFloat, ftCurrency, ftBCD, ftDate,
ftTime, ftDateTime, ftBytes, ftVarBytes,
ftBlob, ftMemo or ftGraphic}
If FieldType=ftUnknown Then Result := 'Unknown';
If FieldType=ftString Then Result := 'String';
If FieldType=ftSmallInt Then Result := 'SmallInt';
If FieldType=ftInteger Then Result := 'Integer';
If FieldType=ftWord Then Result := 'Word';
If FieldType=ftBoolean Then Result := 'Boolean';
If FieldType=ftFloat Then Result := 'Float';
If FieldType=ftCurrency Then Result := 'Currency';
If FieldType=ftBCD Then Result := 'BCD';
If FieldType=ftDate Then Result := 'Date';
If FieldType=ftTime Then Result := 'Time';
If FieldType=ftDateTime Then Result := 'DateTime';
If FieldType=ftBytes Then Result := 'Bytes';
If FieldType=ftVarBytes Then Result := 'VarBytes';
If FieldType=ftBlob Then Result := 'Blob';
If FieldType=ftMemo Then Result := 'Memo';
If FieldType=ftGraphic Then Result := 'Graphic';
Except
End;
End;
//Unit Description UnitIndex Master Index
Procedure TDBTableFilterDlg_ads.MakeBeveled(B : Boolean);
Var
i : Integer;
Begin
If Not B Then
Begin
For I := 0 to ComponentCount -1 Do
Begin
If Components[I] is TPanel Then
Begin
TPanel(Components[I]).BevelOuter := bvNone;
TPanel(Components[I]).BevelInner := bvNone;
End;
End;
End
Else
Begin
For I := 0 to PanelFilterTop.ComponentCount -1 Do
Begin
If PanelFilterTop.Components[I] is TPanel Then
Begin
TPanel(Components[I]).BevelOuter := bvRaised;
TPanel(Components[I]).BevelInner := bvLowered;
End;
End;
End;
End;
//Unit Description UnitIndex Master Index
Procedure TDBTableFilterDlg_ads.SetComboBoxColor(C : TColor);
Var
I : Integer;
Begin
For I := 0 to ComponentCount -1 Do
Begin
If Components[I] is TComboBox Then
Begin
TComboBox(Components[I]).Color := C;
TComboBox(Components[I]).ParentColor := False;
End;
End;
End;
//Unit Description UnitIndex Master Index
procedure TDBTableFilterDlg_ads.lb_FieldNameClick(Sender: TObject);
Var
FieldType : String;
begin
FieldType := '';
FilterButtonsEnabled;
Field := lb_FieldName.Items[lb_FieldName.ItemIndex];
If Not (Field = '') Then
Begin
FieldType := UpperCase(TypeFieldFromDataSet(DataSet,Field));
If (FieldType = 'STRING') Or
(FieldType = 'MEMO') Then
Begin
WildCard := True;
ComboBoxOperator.Items.Clear;
ComboBoxOperator.Items.Clear;
ComboBoxOperator.Items.Add('=');
ComboBoxOperator.ItemIndex := 0;
ComboBoxOperator.Text := '=';
End
Else
Begin
WildCard := False;
ComboBoxOperator.Items.Clear;
ComboBoxOperator.Items.Add('=');
ComboBoxOperator.Items.Add('<>');
ComboBoxOperator.Items.Add('>');
ComboBoxOperator.Items.Add('<');
ComboBoxOperator.Items.Add('>=');
ComboBoxOperator.Items.Add('<=');
ComboBoxOperator.ItemIndex := 0;
ComboBoxOperator.Text := '=';
End;
End
Else
Begin
WildCard := False;
ComboBoxOperator.Items.Clear;
ComboBoxOperator.Items.Add('=');
ComboBoxOperator.Items.Add('<>');
ComboBoxOperator.Items.Add('>');
ComboBoxOperator.Items.Add('<');
ComboBoxOperator.Items.Add('>=');
ComboBoxOperator.Items.Add('<=');
End;
end;
//Unit Description UnitIndex Master IndexProcedure TDBTableFilterDlg_ads.SetColorOfMemo(Value : TColor); Begin FColorOfMemo := Value; FiltersNew.Color := Value; End; //Unit Description UnitIndex Master Index
Procedure TDBTableFilterDlg_ads.SetColorOfFilterEdit(Value : TColor); Begin FColorOfFilterEdit := Value; EditFilter.Color := Value; End; //Unit Description UnitIndex Master Index
Procedure TDBTableFilterDlg_ads.SetColorOfComboBoxs(Value : TColor); Begin FColorOfComboBoxs := Value; SetComboBoxColor(Value); End; //Unit Description UnitIndex Master Index
procedure TDBTableFilterDlg_ads.SetBeveled(Value : Boolean); Begin FBeveled := Value; SetBevel; End; //Unit Description UnitIndex Master Index
procedure TDBTableFilterDlg_ads.SetReSizeNow(Value : Boolean); Begin ReSizeAll; FReSizeNow := Value; End; //Unit Description UnitIndex Master Index
procedure TDBTableFilterDlg_ads.SetMinFormWidth(Value : Integer); Begin If FMinFormWidth <> Value Then FMinFormWidth := Value; End; //Unit Description UnitIndex Master Index
procedure TDBTableFilterDlg_ads.SetMinFormHeight(Value : Integer); Begin If FMinFormHeight <> Value Then FMinFormHeight := Value; End; //Unit Description UnitIndex Master Index
procedure TDBTableFilterDlg_ads.SetBevel;
Begin
MakeBeveled(Beveled);
End;
{$IFNDEF WIN32}
{***BDE Routines***************************************************************}
{set filter on table}
//Unit Description UnitIndex Master Index
procedure TDBTableFilterDlg_ads.SetFilter;
{custom type - stores filter expression and components}
type
TmyFilter = record
Expr: CANExpr;
Nodes: array[0..2] of CANNode;
literals: array[0..276] of char;
end;
{******************************************************}
var
Table : TTable;
myFilter: TmyFilter; {instance of custom type}
fldName,
fldFilter: pChar; {fieldname and filter char's}
dbResult: DBiResult; {result from BDE}
hFilter: hDBiFilter; {handle to filter}
si: integer; {stores filter for smallint field type}
li, liT: longint; {stores filter for longint field type}
ex: extended; {stores filter for date,time,float and currency fields}
dt: TDateTime; {used in date\time fields}
dl: double; {used for timeStamp fields}
yr, mh, dy,
hr, mn, sc, ms: word; {used for date\time fields}
{******************************************************}
begin
{exit if fields not set}
if Table = nil then exit; if Field = '' then exit; if Filter = '' then exit;
{find field type}
case FTable.FieldByName(FField).DataType of
ftString:
myFilter.nodes[2].canConst.iType := fldZSTRING;
ftCurrency:
myFilter.nodes[2].canConst.iType := fldstMONEY;
ftDate:
myFilter.nodes[2].canConst.iType := fldDATE;
ftTime:
myFilter.nodes[2].canConst.iType := fldTIME;
ftFloat:
myFilter.nodes[2].canConst.iType := fldFLOAT;
ftInteger:
myFilter.nodes[2].canConst.iType := fldINT32;
ftSmallInt:
myFilter.nodes[2].canConst.iType := fldINT16;
ftDateTime:
myFilter.nodes[2].canConst.iType := fldTIMESTAMP;
ftBoolean:
myFilter.nodes[2].canConst.iType := fldBool;
end;
{******************************************************}
fldName := StrAlloc(DBiMAXNAMELEN+1); {allocate space for field name}
try
{allocate resources and copy}
StrPCopy(fldName,FField);
StrCopy(myFilter.Literals,fldName);
{*****************************************************}
{switch to account for field type - setting filter}
case FTable.FieldByName(FField).DataType of
{string}
ftString:
begin
fldFilter := StrAlloc(sizeOf(FFilter)+1);
try
{the literals must contain the fieldname (terminated by a null) followed
by the filter expression (terminated by a null)}
StrPCopy(fldFilter,FFilter);
StrCat(myFilter.Literals,'Z'); {catenate temp char value}
StrCat(myFilter.Literals,fldFilter); {add filter to literals}
myFilter.Literals[StrLen(fldName)] := #0; {replace temp with null}
StrCat(myFilter.Literals,#0); {add null to end of filter}
finally
StrDispose(fldFilter);
end;
end;
{long int}
ftInteger:
begin
try
li := StrToInt(FFilter);
move(li,myFilter.Literals[StrLen(fldName)+1],sizeOf(li));
except
on EConvertError do
begin
messageDlg('Please enter an integer value',mtError,[mbOK],0); exit;
end;
end;
end;
{small int}
ftSmallInt:
begin
try
si := StrToInt(FFilter);
move(si,myFilter.Literals[StrLen(fldName)+1],sizeOf(si));
except
on EConvertError do
begin
messageDlg('Please enter an integer value',mtError,[mbOK],0); exit;
end;
end;
end;
{float}
ftFloat:
begin
try
dl := StrToFloat(FFilter);
move(dl,myFilter.Literals[StrLen(fldName)+1],sizeOf(dl));
except
on EConvertError do
begin
messageDlg('Please enter a valid value',mtError,[mbOK],0); exit;
end;
end;
end;
{date}
ftDate:
begin
try
dt := StrToDate(FFilter);
DecodeDate(dt,yr,mh,dy);
dbResult := DBiDateEncode(mh,dy,integer(yr),li);
if dbResult = DBIERR_NONE then
move(li,myFilter.Literals[StrLen(fldName)+1],sizeOf(li))
else
begin
messageDlg('Could not encode date.',mtError,[mbOK],0); exit;
end;
except
on EConvertError do
begin
messageDlg('Please enter a date value',mtError,[mbOK],0); exit;
end;
end;
end;
{logical}
ftBoolean:
begin
fldFilter := StrAlloc(sizeOf(FFilter)+1);
try
{the literals must contain the fieldname (terminated by a null) followed
by the filter expression (terminated by a null)}
StrPCopy(fldFilter,FFilter);
StrCat(myFilter.Literals,'Z'); {catenate temp char value}
StrCat(myFilter.Literals,fldFilter); {add filter to literals}
myFilter.Literals[StrLen(fldName)] := #0; {replace temp with null}
StrCat(myFilter.Literals,#0); {add null to end of filter}
finally
StrDispose(fldFilter);
end;
end;
{time}
ftTime:
begin
messageDlg('Can not place filters on time fields',mtError,[mbOK],0);
exit;
{dt := StrToTime(FFilter);
DecodeTime(dt,hr,mn,sc,ms);
dbResult := DBiTimeEncode(hr,mn,ms,li);
if dbResult = DBiERR_NONE then
move(li,myFilter.Literals[StrLen(fldName)+1],sizeOf(li))
else
begin
messageDlg('Could not encode time.',mtError,[mbOK],0);
exit;
end;}
end;
ftDateTime:
begin
messageDlg('Can not place filters on TimeStamp fields',mtError,[mbOK],0);
exit;
{dt := StrToDateTime(FFilter);
li := trunc(dt);
DecodeTime(dt,hr,mn,sc,ms);
dbResult := DBiTimeEncode(hr,mn,ms,liT);
dbResult := DBiTimeStampEncode(li,liT,dl);
move(dl,myFilter.Literals[StrLen(fldName)+1],sizeOf(dl));}
end;
{money}
ftCurrency:
begin
messageDlg('Can not place filters on currency fields.',mtError,[mbOK],0);
exit;
{dl := StrToFloat(FFilter);
move(dl,myFilter.Literals[StrLen(fldName)+1],sizeOf(dl));}
end;
end;
{*****************************************************}
{set the CANExpr field of the filter expression}
myFilter.Expr.iVer := 1;
myFilter.Expr.iTotalSize := sizeOf(myFilter);
myFilter.Expr.iNodes := 3;
myFilter.Expr.iNodeStart := sizeOf(CANExpr);
myFilter.Expr.iLiteralStart := sizeOf(CANExpr) + 3 * sizeOf(CANNode);
{set the Nodes field of the filter expression}
{first part of array}
myFilter.nodes[0].canBinary.NodeClass := nodeBinary;
{switch on filter operator}
case FFilterOperator of
foEqual: myFilter.nodes[0].canBinary.canOP := canEQ;
foNotEqual: myFilter.nodes[0].canBinary.canOP := canNE;
foGreaterThan: myFilter.nodes[0].canBinary.canOP := canGT;
foLessThan: myFilter.nodes[0].canBinary.canOP := canLT;
foGreaterEqualThan: myFilter.nodes[0].canBinary.canOP := canGE;
foLessEqualThan: myFilter.nodes[0].canBinary.canOP := canLE;
end;
myFilter.nodes[0].canBinary.iOperand1 := sizeOf(CANNode);
myFilter.nodes[0].canBinary.iOperand2 := 2 * sizeOf(CANNode);
{second part of array}
myFilter.nodes[1].canField.nodeClass := nodeField;
myFilter.nodes[1].canField.canOP := canField2;
myFilter.nodes[1].canField.iFieldNum := 0;
myFilter.nodes[1].canField.iNameOffset := 0;
{third part of array}
myFilter.nodes[2].canConst.nodeClass := nodeConst;
myFilter.nodes[2].canConst.canOP := canCONST2;
myFilter.nodes[2].canConst.iSize := 3;
myFilter.nodes[2].canConst.iOffset := StrLen(fldName) + 1;
{run filter}
dbResult := DBiAddFilter(FTable.handle,1,1,False,addr(myFilter),nil,hFilter);
if dbResult = DBIERR_NONE then
begin
dbResult := DBiActivateFilter(FTable.handle,hFilter);
if dbResult = DBIERR_NONE then
FTable.first
else
messageDlg('Could not activate filter',mtError,[mbOK],0);
end
else
messageDlg('Could not set filter',mtError,[mbOK],0);
finally
StrDispose(fldName); {free resources allocated to fieldname}
end;
end;
{remove filter}
//Unit Description UnitIndex Master Index
procedure TDBTableFilterDlg_ads.RemoveFilter;
var
dbResult: DBiResult; {result from BDE}
hFilter: hDBiFilter; {handle to filter}
begin
{exit if fields not set}
if Table = nil then exit;
dbResult := DBiDeactivateFilter(FTable.handle,nil); {if filter handle is null, then all table filters are deactivated}
if dbResult = DBIERR_NONE then
begin
dbResult := DBiDropFilter(FTable.handle,nil); {if filter handle is null, then all table filters are dropped}
if dbResult = DBIERR_NONE then
begin
FTable.First;
end
else
messageDlg('Could not dispose of filter',mtError,[mbOK],0);
end
else
messageDlg('Could not deactivate filter',mtError,[mbOK],0);
end;
{$ENDIF}
Constructor TDBTableFilterDlg_ads.Create(AOwner: TComponent);
Begin
ProcName := 'TDBTableFilterDlg_ads.Create'; Try
inherited;
Self.Parent := TWincontrol(AOwner);
pnl_base := TPanel.Create(AOwner);
With pnl_base Do
Begin
Parent := Self;
Left := 0;
Top := 0;
Width := 476;
Height := 395;
Align := alClient;
BevelOuter := bvNone;
Caption := ' ';
ParentColor := True;
TabOrder := 0;
End;
PanelButtons := TPanel.Create(AOwner);
With PanelButtons Do
Begin
Parent := pnl_base;
Left := 0;
Top := 346;
Width := 476;
Height := 49;
Align := alBottom;
BevelInner := bvNone;
BorderWidth := 10;
Caption := ' ';
Ctl3D := False;
ParentColor := True;
ParentCtl3D := False;
TabOrder := 1;
End;
PanelButtonSlider := TPanel.Create(AOwner);
With PanelButtonSlider Do
Begin
Parent := PanelButtons;
Left := 12;
Top := 12;
Width := 453;
Height := 25;
BevelOuter := bvNone;
Caption := ' ';
ParentColor := True;
TabOrder := 0;
End;
ButtonOK := TBitBtn.Create(AOwner);
With ButtonOK Do
Begin
Parent := PanelButtonSlider;
Left := 233;
Top := 0;
Width := 108;
Height := 25;
Hint := 'Execute the filter changes.';
Caption := 'Apply';
TabOrder := 0;
OnClick := ButtonOKClick;
Kind := bkOK;
End;
ButtonCancel := TBitBtn.Create(AOwner);
With ButtonCancel Do
Begin
Parent := PanelButtonSlider;
Left := 345;
Top := 0;
Width := 108;
Height := 25;
Hint := 'Close this dialog and make no changes.';
TabOrder := 1;
OnClick := ButtonCancelClick;
Kind := bkCancel;
End;
PanelFilterTop := TPanel.Create(AOwner);
With PanelFilterTop Do
Begin
Parent := pnl_base;
Left := 0;
Top := 0;
Width := 476;
Height := 346;
Align := alClient;
BevelOuter := bvNone;
Caption := ' ';
ParentColor := True;
TabOrder := 0;
End;
PanelFilter := TPanel.Create(AOwner);
With PanelFilter Do
Begin
Parent := PanelFilterTop;
Left := 0;
Top := 205;
Width := 476;
Height := 141;
Align := alClient;
BevelInner := bvNone;
BorderWidth := 10;
Caption := ' ';
ParentColor := True;
TabOrder := 1;
End;
FiltersOld := TMemo.Create(AOwner);
With FiltersOld Do
Begin
Parent := PanelFilter;
Left := 12;
Top := 12;
Width := 452;
Height := 117;
TabStop := False;
Align := alClient;
ScrollBars := ssVertical;
TabOrder := 0;
Visible := False;
Lines.Clear;
With Lines Do
Begin
Try Add('FiltersOld'); Except End;
End;
End;
FiltersNew := TMemo.Create(AOwner);
With FiltersNew Do
Begin
Parent := PanelFilter;
Left := 12;
Top := 12;
Width := 452;
Height := 117;
Hint := 'You can edit the filters.';
Align := alClient;
ScrollBars := ssVertical;
TabOrder := 1;
End;
PanelAddFilter := TPanel.Create(AOwner);
With PanelAddFilter Do
Begin
Parent := PanelFilterTop;
Left := 0;
Top := 0;
Width := 476;
Height := 205;
Align := alTop;
BevelInner := bvNone;
BorderWidth := 10;
Caption := ' ';
ParentColor := True;
TabOrder := 0;
End;
Field_Name_Base := TPanel.Create(AOwner);
With Field_Name_Base Do
Begin
Parent := PanelAddFilter;
Left := 12;
Top := 12;
Width := 144;
Height := 181;
Align := alLeft;
BevelOuter := bvNone;
BorderWidth := 5;
Caption := ' ';
ParentColor := True;
TabOrder := 0;
End;
L_FieldName := TPanel.Create(AOwner);
With L_FieldName Do
Begin
Parent := Field_Name_Base;
Left := 5;
Top := 5;
Width := 134;
Height := 18;
Align := alTop;
Alignment := taLeftJustify;
BevelOuter := bvNone;
Caption := 'Field Name';
ParentColor := True;
TabOrder := 0;
End;
lb_FieldName := TListBox.Create(AOwner);
With lb_FieldName Do
Begin
Parent := Field_Name_Base;
Left := 5;
Top := 23;
Width := 134;
Height := 153;
Hint := 'Select a field.';
Align := alClient;
ItemHeight := 16;
TabOrder := 1;
OnClick := lb_FieldNameClick;
End;
Filter_Base := TPanel.Create(AOwner);
With Filter_Base Do
Begin
Parent := PanelAddFilter;
Left := 300;
Top := 12;
Width := 164;
Height := 181;
Align := alRight;
BevelOuter := bvNone;
BorderWidth := 5;
Caption := ' ';
ParentColor := True;
TabOrder := 1;
End;
Panel7 := TPanel.Create(AOwner);
With Panel7 Do
Begin
Parent := Filter_Base;
Left := 5;
Top := 5;
Width := 154;
Height := 18;
Align := alTop;
Alignment := taLeftJustify;
BevelOuter := bvNone;
Caption := 'Value';
ParentColor := True;
TabOrder := 0;
End;
GroupBox1 := TGroupBox.Create(AOwner);
With GroupBox1 Do
Begin
Parent := Filter_Base;
Left := 5;
Top := 53;
Width := 154;
Height := 123;
Align := alClient;
Caption := 'Options';
TabOrder := 1;
End;
Panel2 := TPanel.Create(AOwner);
With Panel2 Do
Begin
Parent := GroupBox1;
Left := 2;
Top := 18;
Width := 15;
Height := 103;
Align := alLeft;
BevelOuter := bvNone;
Caption := ' ';
ParentColor := True;
TabOrder := 0;
End;
Panel3 := TPanel.Create(AOwner);
With Panel3 Do
Begin
Parent := GroupBox1;
Left := 17;
Top := 18;
Width := 135;
Height := 103;
Align := alClient;
BevelOuter := bvNone;
Caption := ' ';
ParentColor := True;
TabOrder := 1;
End;
Case_cb := TCheckBox.Create(AOwner);
With Case_cb Do
Begin
Parent := Panel3;
Left := 10;
Top := 48;
Width := 111;
Height := 25;
Hint := 'Check if the filter is case sensitive.';
Caption := 'Case';
Ctl3D := True;
ParentCtl3D := False;
TabOrder := 0;
OnClick := Case_cbClick;
End;
Exact_cb := TCheckBox.Create(AOwner);
With Exact_cb Do
Begin
Parent := Panel3;
Left := 10;
Top := 72;
Width := 119;
Height := 33;
Hint := 'Check if the filter should use only exact matches.';
Caption := 'Exact';
Ctl3D := True;
ParentCtl3D := False;
TabOrder := 1;
OnClick := Exact_cbClick;
End;
Append_Base := TPanel.Create(AOwner);
With Append_Base Do
Begin
Parent := Panel3;
Left := 0;
Top := 0;
Width := 135;
Height := 51;
Align := alTop;
BevelOuter := bvNone;
BorderWidth := 5;
Caption := ' ';
ParentColor := True;
TabOrder := 2;
End;
Append_Label := TPanel.Create(AOwner);
With Append_Label Do
Begin
Parent := Append_Base;
Left := 5;
Top := 5;
Width := 125;
Height := 14;
Align := alTop;
Alignment := taLeftJustify;
BevelOuter := bvNone;
Caption := 'Append';
ParentColor := True;
TabOrder := 0;
End;
Append_cb := TComboBox.Create(AOwner);
With Append_cb Do
Begin
Parent := Append_Base;
Left := 8;
Top := 21;
Width := 116;
Height := 24;
Hint :=
'Select whether AND or OR should separate this from previous fil' +
'ters.';
Ctl3D := True;
DropDownCount := 2;
ItemHeight := 16;
ParentCtl3D := False;
TabOrder := 1;
Text := 'And';
OnChange := Append_cbChange;
Items.Clear;
With Items Do
Begin
Try Add('And'); Except End;
Try Add('And Not'); Except End;
Try Add('Or'); Except End;
Try Add('Or Not'); Except End;
End;
End;
Panel1 := TPanel.Create(AOwner);
With Panel1 Do
Begin
Parent := Filter_Base;
Left := 5;
Top := 23;
Width := 154;
Height := 30;
Align := alTop;
BevelOuter := bvNone;
Caption := ' ';
ParentColor := True;
TabOrder := 2;
End;
EditFilter := TEdit.Create(AOwner);
With EditFilter Do
Begin
Parent := Panel1;
Left := 5;
Top := 1;
Width := 146;
Height := 24;
Hint := 'Enter a value for the field selected.';
Ctl3D := True;
ParentCtl3D := False;
TabOrder := 0;
OnChange := EditFilterChange;
End;
PanelTopMiddle := TPanel.Create(AOwner);
With PanelTopMiddle Do
Begin
Parent := PanelAddFilter;
Left := 156;
Top := 12;
Width := 144;
Height := 181;
Align := alClient;
BevelOuter := bvNone;
BorderWidth := 5;
Caption := ' ';
ParentColor := True;
TabOrder := 2;
End;
Panel4 := TPanel.Create(AOwner);
With Panel4 Do
Begin
Parent := PanelTopMiddle;
Left := 5;
Top := 5;
Width := 134;
Height := 48;
Align := alTop;
BevelOuter := bvNone;
Caption := ' ';
ParentColor := True;
TabOrder := 0;
End;
Panel5 := TPanel.Create(AOwner);
With Panel5 Do
Begin
Parent := Panel4;
Left := 0;
Top := 0;
Width := 134;
Height := 18;
Align := alTop;
Alignment := taLeftJustify;
BevelOuter := bvNone;
Caption := 'Operator';
ParentColor := True;
TabOrder := 0;
End;
ComboBoxOperator := TComboBox.Create(AOwner);
With ComboBoxOperator Do
Begin
Parent := Panel4;
Left := 3;
Top := 20;
Width := 126;
Height := 24;
Hint := 'Select the filter operator.';
Style := csDropDownList;
Ctl3D := True;
ItemHeight := 16;
ParentCtl3D := False;
TabOrder := 1;
OnChange := ComboBoxOperatorChange;
Items.Clear;
With Items Do
Begin
Try Add('='); Except End;
Try Add('<>'); Except End;
Try Add('>'); Except End;
Try Add('<'); Except End;
Try Add('>='); Except End;
Try Add('<='); Except End;
End;
End;
GroupBox2 := TGroupBox.Create(AOwner);
With GroupBox2 Do
Begin
Parent := PanelTopMiddle;
Left := 5;
Top := 53;
Width := 134;
Height := 123;
Align := alClient;
Caption := 'Actions';
TabOrder := 1;
End;
PanelActions := TPanel.Create(AOwner);
With PanelActions Do
Begin
Parent := GroupBox2;
Left := 2;
Top := 18;
Width := 130;
Height := 103;
Align := alClient;
BevelOuter := bvNone;
Caption := ' ';
ParentColor := True;
TabOrder := 0;
End;
ButtonAdd := TBitBtn.Create(AOwner);
With ButtonAdd Do
Begin
Parent := PanelActions;
Left := 29;
Top := 14;
Width := 75;
Height := 25;
Hint := 'Add a filter to the current filter.';
Caption := 'Add';
ParentShowHint := False;
ShowHint := True;
TabOrder := 0;
OnClick := ButtonAddClick;
End;
ButtonClear := TBitBtn.Create(AOwner);
With ButtonClear Do
Begin
Parent := PanelActions;
Left := 30;
Top := 54;
Width := 75;
Height := 25;
Hint := 'Clear all filters.';
Caption := 'Clear';
TabOrder := 1;
OnClick := ButtonClearClick;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
Destructor TDBTableFilterDlg_ads.Destroy;
Begin
ProcName := 'TDBTableFilterDlg_ads.Destroy'; Try
ButtonClear .Free;
ButtonAdd .Free;
PanelActions .Free;
GroupBox2 .Free;
ComboBoxOperator .Free;
Panel5 .Free;
Panel4 .Free;
PanelTopMiddle .Free;
EditFilter .Free;
Panel1 .Free;
Append_cb .Free;
Append_Label .Free;
Append_Base .Free;
Exact_cb .Free;
Case_cb .Free;
Panel3 .Free;
Panel2 .Free;
GroupBox1 .Free;
Panel7 .Free;
Filter_Base .Free;
lb_FieldName .Free;
L_FieldName .Free;
Field_Name_Base .Free;
PanelAddFilter .Free;
FiltersNew .Free;
FiltersOld .Free;
PanelFilter .Free;
PanelFilterTop .Free;
ButtonCancel .Free;
ButtonOK .Free;
PanelButtonSlider .Free;
PanelButtons .Free;
pnl_base .Free;
inherited Destroy;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
{!~DlgDBFilter_ads
}
//Unit Description UnitIndex Master Index
Function DlgDBFilter_ads(DataSet: TDataSet): Boolean;
Var
Dialog : TForm;
Form : TDBTableFilterDlg_ads;
Begin
Result := False;
Dialog := nil;
ProcName := 'DlgDBFilter_ads'; Try
Try
Dialog := TForm.Create(nil);
Form := TDBTableFilterDlg_ads.Create(Dialog);
Form.Parent:= Dialog;
Form.Align := alClient;
With Dialog Do
Begin
Left := 245;
Top := 89;
Width := 484;
Height := 422;
BorderIcons := [biSystemMenu, biMaximize];
Caption := 'Table Filter Dialog';
Color := clBtnFace;
Font.Color := clWindowText;
Font.Height := -14;
Font.Name := 'System';
Font.Style := [];
OldCreateOrder := True;
Position := poScreenCenter;
OnActivate := Form.FormActivate;
OnCreate := Form.FormCreate;
OnResize := Form.FormResize;
PixelsPerInch := 96;
End;
Form.FormCreate(Dialog);
Form.DataSet := Dataset;
Form.Case_cb.Checked := False;
Dialog.ShowModal;
If Dialog.ModalResult = mrOK Then
Begin
//Do Something here
Result := True;
End;
Finally
Dialog.Free;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
Initialization
UnitName := 'ads_DlgDBFilter';
ProcName := 'Unknown';
End.
//