unit DynWhere_ClientMain;

interface

uses
  Forms, StdCtrls, Controls, Grids, DBGrids, Classes, ExtCtrls,
  ActnList, Buttons, ImgList, ComCtrls, ToolWin, Menus,
  uROPoweredByRemObjectsButton,
  uDAPoweredByDataAbstractButton,
  uDAInterfaces
  ;

type
  TFldOperator = record
    FldName: string;
    LogOper: TDABinaryOperator;
    Oper: TDABinaryOperator;
    Value: variant;
  end;

  TDynWhere_ClientForm = class(TForm)
    Panel1: TPanel;
    DBGrid: TDBGrid;
    Panel2: TPanel;
    DAPoweredByDataAbstractButton1: TDAPoweredByDataAbstractButton;
    btnOpenClose: TButton;
    Pan_Cond: TPanel;
    panSet: TPanel;
    btnXML: TButton;
    Panel4: TPanel;
    lbOper: TListBox;
    Panel5: TPanel;
    Panel6: TPanel;
    CondActionList: TActionList;
    aCondEdit: TAction;
    aCondNew: TAction;
    aCondDelete: TAction;
    aCondUp: TAction;
    ImageList1: TImageList;
    ToolBar1: TToolBar;
    aCondDown: TAction;
    tbCondNew: TToolButton;
    btnDelphi: TButton;
    procedure btnXMLClick(Sender: TObject);
    procedure btnOpenCloseClick(Sender: TObject);
    procedure lbOperDblClick(Sender: TObject);
    procedure aCondEditExecute(Sender: TObject);
    procedure aCondNewExecute(Sender: TObject);
    procedure aCondDeleteExecute(Sender: TObject);
    procedure aCondUpExecute(Sender: TObject);
    procedure aCondDownExecute(Sender: TObject);
    procedure lbOperKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure btnDelphiClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure lbOperClick(Sender: TObject);
  private
    { Private declarations }
    fExpression: array of TFldOperator;
    fXML: string;
    fDelphiCode: string;
    procedure CheckEditButtons();
    procedure RebuildCondList();
    function  GetXML(): string;
  public
    { Public declarations }
  end;

var
  DynWhere_ClientForm: TDynWhere_ClientForm;

implementation

uses
  Windows, SysUtils, Variants, TypInfo,
  uDADataTable, uDASQL92QueryBuilder,
  DynWhere_ClientData, memoForm, WhereExpression;

{$R *.dfm}

const
  c_Invalid_XML = '*';

procedure TDynWhere_ClientForm.FormCreate(Sender: TObject);
begin
  fXML := c_Invalid_XML;
  ActiveControl := btnOpenClose;
end;

procedure TDynWhere_ClientForm.btnOpenCloseClick(Sender: TObject);
var
  Tbl: TDADataTable;
  OldCur: TCursor;
  XML: string;
begin
  OldCur := Screen.Cursor;

  try
    Screen.Cursor := crHourGlass;
    Tbl := DynWhere_ClientDataForm.tbl_Data;

    if  Pan_Cond.Visible  then
    begin
      Tbl.Active := False;
      XML := GetXML();

      if  XML = ''  then
        Tbl.DynamicWhere.Clear()
      else
        Tbl.DynamicWhere.Xml := GetXML();

      Tbl.Active := True;
    end
    else
    begin
      Tbl.Active := True;
      Pan_Cond.Visible := True;
      btnOpenClose.Caption := 'Refresh';
      btnXML.Visible := True;
      btnDelphi.Visible := True;
    end;

    ActiveControl := lbOper;
    CheckEditButtons();
  finally
    Screen.Cursor := OldCur;
  end;
end;

procedure TDynWhere_ClientForm.btnXMLClick(Sender: TObject);
begin
  TfrmMemo.Execute('XML pass to Server', GetXML(), True);
end;

procedure TDynWhere_ClientForm.lbOperDblClick(Sender: TObject);
begin
  aCondEdit.Execute();
end;

procedure TDynWhere_ClientForm.lbOperClick(Sender: TObject);
begin
  CheckEditButtons();
end;

procedure TDynWhere_ClientForm.aCondEditExecute(Sender: TObject);
var
  i: integer;
begin
  i := integer(lbOper.Items.Objects[lbOper.ItemIndex]);

  if  TWhereExpressionForm.Execute(DynWhere_ClientDataForm.tbl_Data.Fields,
            fExpression[i].FldName, fExpression[i].LogOper,
            fExpression[i].Oper, fExpression[i].Value) then
    RebuildCondList();
end;

procedure TDynWhere_ClientForm.aCondNewExecute(Sender: TObject);
var
  FldName: string;
  LogOper, Oper: TDABinaryOperator;
  Value: variant;
  i: integer;
begin
  if  TWhereExpressionForm.Execute(DynWhere_ClientDataForm.tbl_Data.Fields,
            FldName, LogOper, Oper, Value) then
  begin
    SetLength(fExpression, Length(fExpression) + 1);
    i := High(fExpression);
    fExpression[i].FldName := FldName;
    fExpression[i].LogOper := LogOper;
    fExpression[i].Oper := Oper;
    fExpression[i].Value := Value;
    RebuildCondList();
    lbOper.ItemIndex := lbOper.Items.Count - 1;
    CheckEditButtons();
  end;
end;

procedure TDynWhere_ClientForm.aCondDeleteExecute(Sender: TObject);
var
  i, ii: integer;
begin
  ii := lbOper.ItemIndex;

  if  ii >= 0  then
  begin
    ii := integer(lbOper.Items.Objects[ii]);

    for i := ii + 1 to High(fExpression) do
      fExpression[i - 1] := fExpression[i];

    SetLength(fExpression, Length(fExpression) - 1);
    RebuildCondList();
  end;
end;

procedure TDynWhere_ClientForm.aCondUpExecute(Sender: TObject);
var
  i: integer;
  Oper: TFldOperator;
begin
  i := integer(lbOper.Items.Objects[lbOper.ItemIndex]);
  Oper := fExpression[i];
  fExpression[i] := fExpression[i - 1];
  fExpression[i - 1] := Oper;
  lbOper.ItemIndex := i - 1;
  RebuildCondList();
end;

procedure TDynWhere_ClientForm.aCondDownExecute(Sender: TObject);
var
  i: integer;
  Oper: TFldOperator;
begin
  i := integer(lbOper.Items.Objects[lbOper.ItemIndex]);
  Oper := fExpression[i];
  fExpression[i] := fExpression[i + 1];
  fExpression[i + 1] := Oper;
  lbOper.ItemIndex := i + 1;
  RebuildCondList();
end;

procedure TDynWhere_ClientForm.CheckEditButtons();
var
  ii: integer;
begin
  ii := lbOper.ItemIndex;
  aCondUp.Enabled := (ii > 0);
  aCondDown.Enabled := (ii >= 0) and (ii < (lbOper.Items.Count - 1));
  aCondEdit.Enabled := (ii >= 0);
  aCondDelete.Enabled := (ii >= 0);
  btnXML.Enabled := (lbOper.Items.Count > 0);
end;

procedure TDynWhere_ClientForm.RebuildCondList();
  function  Val2Str(const FldName: string; const Val: variant; IsList: Boolean): string;
  var
    DT: TDADataType;
    Lst: TStrings;
    i: integer;
  begin
    if  IsList  then
    begin
      Result := '';
      Lst := TStringList.Create();

      try
        Lst.CommaText := string(Val);
        for i := 0 to Lst.Count - 1 do
          if  Result = '' then
            Result := Val2Str(FldName, Lst[i], False)
          else
            Result := Result + ',' + Val2Str(FldName, Lst[i], False);
      finally
        Lst.Free();
      end;
    end
    else
    begin
      DT := DynWhere_ClientDataForm.tbl_Data.FieldByName(FldName).DataType;

      if  DT = datDateTime  then
        if  VarType(Val) = varString then
          Result := '''' + Val + ''''
        else
          Result := '''' + DateTimeToStr(Val) + ''''
      else
      if  DT in [datString, datWideString, datMemo, datWideMemo] then
        Result := '''' + Val + ''''
      else
        Result := Val;
    end;
  end;
const
  c_Oper: array[TDABinaryOperator] of string =
    ('AND', 'OR', 'XOR', '<', '<=', '>', '>=', '!=', '=', 'like', 'in', '+', '-', '*', '/');
var
  i, ii: integer;
  sOper, sValue: string;
begin
  fXML := c_Invalid_XML;
  ii := lbOper.ItemIndex;
  lbOper.Items.BeginUpdate;

  try
    lbOper.Items.Clear;

    for i := Low(fExpression) to High(fExpression) do
    begin
      if  fExpression[i].Oper = dboIn then
        sValue := Format('in (%s)', [Val2Str(fExpression[i].FldName, fExpression[i].Value, True)])
      else
      if  VarIsNULL(fExpression[i].Value) then
        if  fExpression[i].Oper = dboEqual  then
          sValue := 'is NULL'
        else
          sValue := 'is not NULL'
      else
        sValue := c_Oper[fExpression[i].Oper] + ' ' +
                  Val2Str(fExpression[i].FldName, fExpression[i].Value, False);

      sOper := c_Oper[fExpression[i].LogOper];

      if  lbOper.Items.Count = 0  then
        sOper := '/* ' + sOper + ' */';

      lbOper.Items.AddObject(Format('%s %s %s',
          [sOper, fExpression[i].FldName, sValue]),
          TObject(i));
    end;
  finally
    lbOper.Items.EndUpdate;
  end;

  if  ii >= lbOper.Items.Count  then
    ii := lbOper.Items.Count - 1;

  lbOper.ItemIndex := ii;
  CheckEditButtons();
end;

procedure TDynWhere_ClientForm.lbOperKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
  if  Key = VK_INSERT then
    aCondNew.Execute()
  else if Key = VK_DELETE then
    aCondDelete.Execute()
  else if (Key = VK_F2) or (Key = VK_RETURN)  then
    aCondEdit.Execute()
  else if (Shift = [ssCtrl]) and (Key = VK_UP)  then
    aCondUp.Execute()
  else if (Shift = [ssCtrl]) and (Key = VK_DOWN)  then
    aCondDown.Execute();
end;

procedure TDynWhere_ClientForm.btnDelphiClick(Sender: TObject);
begin
  GetXML();
  TfrmMemo.Execute('Delphi Code', fDelphiCode, False);
end;

function  TDynWhere_ClientForm.GetXML(): string;
var
  i, j: integer;
  L, R, Where, Expr: TDAWhereExpression;
  Lst: TStrings;
  aExpr: array of TDAWhereExpression;
  DT: TDADataType;
  NeedNot: Boolean;
  LogOper: TDABinaryOperator;
  WB: TDAWhereBuilder;
  Log: TStrings;
  S: string;

  function  sMake_Const(const V: variant): string;
  begin
    if  VarIsNULL(V)  then
      Result := 'NewNull()'
    else
    begin
      if  DT = datDateTime  then
        if  VarType(V) = varString then
          Result := Format('StrToDateTime(''%s'')', [string(V)])
        else
          Result := Format('StrToDateTime(''%s'')', [DateToStr(V)])
      else
      if  DT in [datString, datWideString, datMemo, datWideMemo] then
        Result := Format('''%s''', [string(V)])
      else
        Result := V;

      Result := Format('NewConstant(%s, %s)',
          [Result, GetEnumName(TypeInfo(TDADataType), integer(DT))]);
    end;
  end;

begin
  if  fXML = c_Invalid_XML  then
  begin
    WB := nil;
    Where := nil;
    Log := TStringList.Create;

    try
      Log.Add('procedure Make_DynamicWhere;');
      Log.Add('var');
      Log.Add('  L, R, Expr: TDAWhereExpression;');
      Log.Add('begin');
      Log.Add('  DADataTable.Close();');
      Log.Add('');
      Log.Add('  with DADataTable.DynamicWhere do');
      Log.Add('  begin');
      Log.Add('    Clear();');

      for i := Low(fExpression) to High(fExpression) do
      begin
        if  WB = nil  then
          WB := TDAWhereBuilder.Create();

        NeedNot := False;
        LogOper := fExpression[i].Oper;
        DT := DynWhere_ClientDataForm.tbl_Data.FieldByName(fExpression[i].FldName).DataType;

        if  LogOper = dboIn then
        begin
          Lst := TStringList.Create();

          try
            Lst.CommaText := fExpression[i].Value;
            SetLength(aExpr, Lst.Count);
            S := '';

            for j := 0 to Lst.Count - 1 do
            begin
              if  DT = datDateTime  then
                aExpr[j] := WB.NewConstant(StrToDateTime(Lst[j]), DT)
              else
                aExpr[j] := WB.NewConstant(Lst[j], DT);

              if  S = ''  then
                S := sMake_Const(Lst[j])
              else
                S := Format('%s, %s', [S, sMake_Const(Lst[j])]);
            end;
          finally
            Lst.Free;
          end;

          R := WB.NewList(aExpr);
          Log.Add(Format('    R := NewList([%s]);', [S]));
        end
        else
        begin
          if  VarIsNULL(fExpression[i].Value) then
          begin
            R := WB.NewNull();

            if  LogOper = dboNotEqual then
            begin
              LogOper := dboEqual;
              NeedNot := True;
            end;
          end
          else
            R := WB.NewConstant(fExpression[i].Value, DT);
        end;

        Log.Add(Format('    R := %s;', [sMake_Const(fExpression[i].Value)]));
        L := WB.NewField('', fExpression[i].FldName);
        Log.Add(Format('    L := NewField('''', ''%s'');', [fExpression[i].FldName]));
        Expr := WB.NewBinaryExpression(L, R, LogOper);
        Log.Add(Format('    Expr := NewBinaryExpression(L, R, %s);',
                [GetEnumName(TypeInfo(TDABinaryOperator), integer(LogOper))]));

        if  NeedNot then
        begin
          Expr := WB.NewUnaryExpression(Expr, duoNot);
          Log.Add('    Expr := NewUnaryExpression(Expr, duoNot);');
        end;

        if  Assigned(Where) then
        begin
          Where := WB.NewBinaryExpression(Where, Expr, fExpression[i].LogOper);
          Log.Add(Format('    Expression := NewBinaryExpression(Expression, Expr, %s);',
                [GetEnumName(TypeInfo(TDABinaryOperator), integer(fExpression[i].LogOper))]));
        end
        else
        begin
          Where := Expr;
          Log.Add('    Expression := Expr;');
        end;
      end;

      if  Assigned(WB)  then
      begin
        WB.Expression := Where;
        fXML := WB.XML;
      end
      else
        fXML := '';

      Log.Add('  end;');
      Log.Add('');
      Log.Add('  DADataTable.Open();');
      Log.Add('end;');
      fDelphiCode := Log.Text;
    finally
      WB.Free;
      Log.Free;
    end;
  end;

  Result := fXML;
end;


end.