499 lines
13 KiB
ObjectPascal
499 lines
13 KiB
ObjectPascal
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.
|