Componentes.Terceros.RemObj.../internal/5.0.30.691/1/Data Abstract for Delphi/Samples/Dynamic Where/WhereExpression.pas

418 lines
10 KiB
ObjectPascal

unit WhereExpression;
interface
uses
Forms, Controls, StdCtrls, Classes, ExtCtrls,
uDAInterfaces, ComCtrls
;
type
TWhereExpressionForm = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
btnOK: TButton;
btnCancel: TButton;
Label1: TLabel;
cmbFldName: TComboBox;
Label2: TLabel;
cmbOper: TComboBox;
lbValue: TLabel;
edtValue: TEdit;
dtValue: TDateTimePicker;
emValue: TRichEdit;
cmbLogOper: TComboBox;
procedure cmbOperKeyPress(Sender: TObject; var Key: Char);
procedure cmbOperClick(Sender: TObject);
procedure cmbFldNameClick(Sender: TObject);
procedure cmbFldNameKeyPress(Sender: TObject; var Key: Char);
procedure edtValueChange(Sender: TObject);
procedure btnOKClick(Sender: TObject);
procedure cmbLogOperClick(Sender: TObject);
procedure cmbLogOperKeyPress(Sender: TObject; var Key: Char);
private
{ Private declarations }
fFlds: TDAFieldCollection;
fDT: TDADataType;
procedure CheckOper();
procedure CheckButtons();
function CheckExpresion(): Boolean;
public
{ Public declarations }
function ExecuteEx(AFlds: TDAFieldCollection;
var FldName: string; var LogOper, Oper: TDABinaryOperator; var Value: variant): Boolean;
class function Execute(AFlds: TDAFieldCollection;
var FldName: string; var LogOper, Oper: TDABinaryOperator; var Value: variant): Boolean;
end;
implementation
uses
SysUtils, Variants, Dialogs
;
{$R *.dfm}
const
c_is_NULL = -2;
c_is_not_NULL = -3;
var
Frm: TWhereExpressionForm = nil;
class function TWhereExpressionForm.Execute(AFlds: TDAFieldCollection;
var FldName: string; var LogOper, Oper: TDABinaryOperator; var Value: variant): Boolean;
begin
if not Assigned(Frm) then
Frm := TWhereExpressionForm.Create(Application);
Result := Frm.ExecuteEx(AFlds, FldName, LogOper, Oper, Value);
end;
function TWhereExpressionForm.ExecuteEx(AFlds: TDAFieldCollection;
var FldName: string; var LogOper, Oper: TDABinaryOperator; var Value: variant): Boolean;
var
i, ii: integer;
begin
Result := False;
fFlds := AFlds;
ii := -1;
fDT := datUnknown;
lbValue.Visible := False;
emValue.Visible := False;
dtValue.Visible := False;
edtValue.Visible := False;
for i := 0 to fFlds.Count - 1 do
begin
cmbFldName.Items.AddObject(fFlds[i].Name, TObject(fFlds[i].DataType));
if AnsiSameText(FldName, fFlds[i].Name) then
ii := i;
end;
emValue.Lines.Clear();
edtValue.Clear();
cmbFldName.ItemIndex := ii;
CheckOper();
if ii >= 0 then
begin
if VarIsNULL(Value) then
if Oper = dboEqual then
ii := c_is_NULL
else
ii := c_is_not_NULL
else
ii := integer(Oper);
if LogOper = dboAnd then
cmbLogOper.ItemIndex := 0
else
if LogOper = dboOr then
cmbLogOper.ItemIndex := 1
else
if LogOper = dboXor then
cmbLogOper.ItemIndex := 2;
for i := 0 to cmbOper.Items.Count - 1 do
if integer(cmbOper.Items.Objects[i]) = ii then
begin
cmbOper.ItemIndex := i;
cmbOperClick(cmbOper);
if emValue.Visible then
emValue.Lines.CommaText := Value
else
if dtValue.Visible then
dtValue.Date := Value
else
if edtValue.Visible then
edtValue.Text := Value;
break;
end;
end
else
cmbLogOper.ItemIndex := 0;
btnOK.Enabled := False;
if ShowModal = mrOK then
begin
FldName := cmbFldName.Items[cmbFldName.ItemIndex];
ii := integer(cmbOper.Items.Objects[cmbOper.ItemIndex]);
if ii = c_is_NULL then
begin
Oper := dboEqual;
Value := NULL;
end
else
if ii = c_is_not_NULL then
begin
Oper := dboNotEqual;
Value := NULL;
end
else
begin
if emValue.Visible then
begin
for i := emValue.Lines.Count - 1 downto 0 do
if Trim(emValue.Lines[i]) = '' then
emValue.Lines.Delete(i);
if emValue.Lines.Count > 0 then
Value := Trim(emValue.Lines.CommaText)
else
begin
Result := False;
exit;
end;
end
else
if dtValue.Visible then
Value := VarFromDateTime(Trunc(dtValue.Date))
else
if edtValue.Visible then
Value := Trim(edtValue.Text);
Oper := TDABinaryOperator(ii);
end;
if cmbLogOper.ItemIndex = 0 then
LogOper := dboAnd
else
if cmbLogOper.ItemIndex = 1 then
LogOper := dboOr
else
if cmbLogOper.ItemIndex = 2 then
LogOper := dboXor;
Result := True;
end;
end;
procedure TWhereExpressionForm.cmbOperClick(Sender: TObject);
begin
if cmbOper.DroppedDown
or (cmbOper.ItemIndex < 0) then
exit;
if integer(cmbOper.Items.Objects[cmbOper.ItemIndex]) < 0 then
begin
lbValue.Visible := False;
emValue.Visible := False;
dtValue.Visible := False;
edtValue.Visible := False;
end
else
begin
lbValue.Visible := True;
if TDABinaryOperator(cmbOper.Items.Objects[cmbOper.ItemIndex]) = dboIn then
begin
emValue.Visible := True;
dtValue.Visible := False;
edtValue.Visible := False;
end
else
begin
emValue.Visible := False;
if TDADataType(cmbFldName.Items.Objects[cmbFldName.ItemIndex]) = datDateTime then
begin
dtValue.Visible := True;
edtValue.Visible := False;
end
else
begin
dtValue.Visible := False;
edtValue.Visible := True;
end;
end;
end;
CheckButtons();
end;
procedure TWhereExpressionForm.cmbOperKeyPress(Sender: TObject;
var Key: Char);
begin
if Key = #13 then
begin
if cmbOper.DroppedDown then
cmbOper.DroppedDown := False;
cmbOperClick(Sender);
Key := #0;
end;
end;
procedure TWhereExpressionForm.cmbFldNameClick(Sender: TObject);
begin
if cmbFldName.DroppedDown
or (cmbFldName.ItemIndex < 0) then
exit;
CheckOper();
end;
procedure TWhereExpressionForm.cmbFldNameKeyPress(Sender: TObject;
var Key: Char);
begin
if Key = #13 then
begin
if cmbFldName.DroppedDown then
cmbFldName.DroppedDown := False;
cmbFldNameClick(Sender);
Key := #0;
end;
end;
procedure TWhereExpressionForm.cmbLogOperClick(Sender: TObject);
begin
if cmbLogOper.DroppedDown
or (cmbLogOper.ItemIndex < 0) then
exit;
CheckButtons();
end;
procedure TWhereExpressionForm.cmbLogOperKeyPress(Sender: TObject;
var Key: Char);
begin
if Key = #13 then
begin
if cmbLogOper.DroppedDown then
cmbLogOper.DroppedDown := False;
cmbLogOperClick(Sender);
Key := #0;
end;
end;
procedure TWhereExpressionForm.CheckOper();
procedure Add_CmbOper(const Oper: array of TDABinaryOperator;
const Txt: array of string);
var
i: integer;
begin
cmbOper.Items.Clear;
for i := Low(Oper) to High(Oper) do
cmbOper.Items.AddObject(Txt[i], TObject(integer(Oper[i])));
cmbOper.Items.AddObject('in', TObject(dboIn));
cmbOper.Items.AddObject('is NULL', TObject(c_is_NULL));
cmbOper.Items.AddObject('is not NULL', TObject(c_is_not_NULL));
cmbOper.ItemIndex := 0;
end;
var
DT: TDADataType;
begin
cmbOper.Enabled := (cmbFldName.ItemIndex >= 0);
if cmbOper.Enabled then
begin
DT := TDADataType(cmbFldName.Items.Objects[cmbFldName.ItemIndex]);
if fDT <> DT then
begin
if DT in [datString, datWideString, datMemo, datWideMemo] then
Add_CmbOper([dboLike, dboEqual, dboNotEqual], ['like', '=', '!='])
else
Add_CmbOper([dboEqual, dboNotEqual, dboGreater, dboGreaterOrEqual, dboLess, dboLessOrEqual],
['=', '!=', '>', '>=', '<', '<=']);
fDT := DT;
end;
end
else
cmbOper.Items.Clear;
cmbOperClick(cmbOper);
CheckButtons();
end;
procedure TWhereExpressionForm.CheckButtons();
begin
btnOK.Enabled := (cmbFldName.ItemIndex >= 0)
and (cmbOper.ItemIndex >= 0);
if btnOK.Enabled then
if integer(cmbOper.Items.Objects[cmbOper.ItemIndex]) >= 0 then
begin
if emValue.Visible then
btnOK.Enabled := (Trim(emValue.Text) <> '')
else
if dtValue.Visible then
btnOK.Enabled := dtValue.Date > 0
else
if edtValue.Visible then
btnOK.Enabled := (Trim(edtValue.Text) <> '')
else
btnOK.Enabled := False;
end;
end;
procedure TWhereExpressionForm.edtValueChange(Sender: TObject);
begin
CheckButtons();
end;
procedure TWhereExpressionForm.btnOKClick(Sender: TObject);
begin
if CheckExpresion() then
ModalResult := mrOK
else
ModalResult := mrNone;
end;
function TWhereExpressionForm.CheckExpresion(): Boolean;
function CheckData(const S: string): Boolean;
begin
Result := False;
try
if S = '' then
else
if fDT in [datFloat, datCurrency, datDecimal, datSingleFloat] then
StrToFloat(S)
else
if fDT in [datAutoInc, datInteger, datLargeInt, datLargeAutoInc,
datShortInt, datWord, datSmallInt, datCardinal, datLargeUInt] then
StrToInt(S)
else
if fDT = datDateTime then
StrToDateTime(S);
Result := True;
except
MessageDlg(Format('"%s" is not valid field value', [S]), mtError, [mbOK], 0);
end;
end;
var
i: integer;
begin
Result := True;
if emValue.Visible then
begin
for i := 0 to emValue.Lines.Count - 1 do
if not CheckData(Trim(emValue.Lines[i])) then
begin
Result := False;
break;
end;
end
else
if edtValue.Visible then
Result := CheckData(Trim(edtValue.Text));
end;
end.