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.