ucondition.pas

AbsDataBase5.16 最新版

unit uCondition;

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls,
  StdCtrls, Buttons, ExtCtrls, Grids, ComCtrls;

type
  TCondition = (CoWhere, CoOr, CoHaving, CoCalc);

  TfrmCondition = class(TForm)
    OKBtn: TButton;
    CancelBtn: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    EditNumeric: TEdit;
    TreeView1: TTreeView;
    TreeView2: TTreeView;
    Label5: TLabel;
    EditString: TEdit;
    Label6: TLabel;
    EditFalse: TEdit;
    EditTrue: TEdit;
    Label7: TLabel;
    LbFlds: TTreeView;
    lbFieldTypes: TTreeView;
    edFieldName: TEdit;
    btnSelNext: TButton;
    cbAutoSelNext: TCheckBox;
    Memo1: TMemo;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure LbFuncDblClick(Sender: TObject);
    procedure TreeView2CustomDrawItem(Sender: TCustomTreeView;
      Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: boolean);
    procedure btnSelNextClick(Sender: TObject);
    procedure EditNumericKeyPress(Sender: TObject; var Key: Char);
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  Private
    aCond: TCondition;
    procedure SelectNextItem;
  Public
  end;

function ExecuteCondition(AList: TList; var ACondition: string;
  var AFldName: string; Cond: TCondition): boolean;

implementation

uses
  uQueryMaker, ABSTypes, ABSConverts, ABSLexer, TypInfo;

const
  sWhere = 'WHERE condition for Data Field';
  sOr = 'OR condition for Data Field';
  sCalc = 'Definition for Calc Field';
  sHaving = 'HAVING condition';
  sfTableFields = 'Table Fields: ''%s''';
  sfDTableFields = 'Table Fields: "%s"';
  sfDFields = '%s."%s" %s %s';
  chCopyRight = #169;

function CorrStr(InStr: string): string;
var
  I: integer;
  S, OutS, Token: string;
begin
  OutS  := Trim(InStr);
  Token := '';
  I     := Pos(' ', OutS);
  while I <> 0 do begin
    Application.ProcessMessages;
    S     := Copy(OutS, 1, I);
    S     := Trim(S);
    Token := Token + S + ' ';
    OutS  := Copy(OutS, I, Length(OutS));
    OutS  := Trim(OutS);
    I     := Pos(' ', OutS);
  end;
  OutS  := Trim(Token + OutS);
  Token := '';
  I     := Pos('( ', OutS);
  while I <> 0 do begin
    Application.ProcessMessages;
    S     := Copy(OutS, 1, I);
    Token := Token + S;
    OutS  := Copy(OutS, I + 1,
      Length(OutS));
    OutS  := Trim(OutS);
    I     := Pos('( ', OutS);
  end;
  OutS  := Trim(Token + OutS);
  Token := '';
  I     := Pos(' )', OutS);
  while I <> 0 do begin
    Application.ProcessMessages;
    S     := Copy(OutS, 1, I - 1);
    Token := Token + S + ')';
    OutS  := Copy(OutS, I + 2, Length(OutS));
    I     := Pos(' )', OutS);
  end;
  OutS  := Trim(Token + OutS);
  Token := '';
  I     := Pos(' ,', OutS);
  while I <> 0 do begin
    Application.ProcessMessages;
    S     := Copy(OutS, 1, I - 1);
    Token := Token + S + ',';
    OutS  := Copy(OutS, I + 2, Length(OutS));
    I     := Pos(' ,', OutS);
  end;
  S := Trim(Token + OutS);
  if Pos('CASE ', UpperCase(S)) <> 0 then begin
    S := S + ' ';
    Insert(#13#10'  ', S, Pos('CASE ', UpperCase(S)));
    while Pos('WHEN ', UpperCase(S)) <> 0 do begin
      Insert(#13#10'    ', S, Pos('WHEN ', UpperCase(S)));
      OutS := S;
      S := Copy(S, 1, Pos('WHEN ', UpperCase(S)) - 1) + chCopyRight + Copy(OutS, Pos('WHEN ', UpperCase(OutS)) + 4, Length(OutS));
    end;
    while Pos(chCopyRight, S) <> 0 do begin
      OutS := S;
      S := Copy(S, 1, Pos(chCopyRight, S) - 1) + 'WHEN' + Copy(OutS, Pos(chCopyRight, OutS) + 1, Length(OutS))
    end;
    if Pos('ELSE ', UpperCase(S)) <> 0 then
      Insert(#13#10'    ', S, Pos('ELSE ', UpperCase(S)));
    if Pos('END ', UpperCase(S)) <> 0 then
      Insert(#13#10'  ', S, Pos('END ', UpperCase(S)));
  end;
  result := S;
end;

function ExecuteCondition(AList: TList; var ACondition: string;
  var AFldName: string; Cond: TCondition): boolean;
var
  I, J:  integer;
  Ti: TTableImage;
  S, S1: string;
  Node: TTreeNode;
begin
  with TfrmCondition.Create(Application) do begin
    try
      aCond := Cond;
      edFieldName.ReadOnly := True;
      edFieldName.Color := clBtnFace;
      case Cond of
        CoWhere:
          Caption := sWhere;
        CoOr:
          Caption := sOr;
        CoHaving:
          Caption := sHaving;
        CoCalc: begin
          Caption := sCalc;
          edFieldName.ReadOnly := False;
          edFieldName.Color := clWindow;
        end;
      end;
      LbFlds.Items.Clear;
      for I := 0 to AList.Count - 1 do begin
        Ti := TTableImage(AList[I]);
          S := Format(sfDTableFields, [Ti.CaptionTable]);
        Node := LbFlds.Items.AddChild(nil, S);
        for J := 0 to Ti.Columns.Count - 1 do begin
          S  := Ti.Columns[J];
          S1 := (Ti.Columns.Objects[J] as TColumnsParams).FieldType;
          S  := Trim(S);
          if (AFldName <> S) or (Cond = CoHaving) then
            LbFlds.Items.AddChild(Node, Format(sfDFields, [Ti.TableAlias, S, sDelimiter, S1]));
        end;
      end;
      Memo1.Text := Trim(ACondition);
      edFieldName.Text := AFldName;
      if ShowModal = mrOk then begin
        S := Memo1.Text;
        ACondition := CorrStr(S);
        AFldName := Trim(edFieldName.Text);
        Result := True;
      end
      else
        Result := False;
    finally
      Release;
    end;
  end;
end;

{$R *.dfm}

procedure TfrmCondition.FormCreate(Sender: TObject);
var
  I: integer;
  Node: TTreeNode;
begin
  with LbFieldTypes do begin
    Node := lbFieldTypes.Items.AddChild(nil, 'Char');
    for I := 1 to 9 do
      lbFieldTypes.Items.AddChild(Node, SQLFieldTypes[I].SqlName);
    Node := lbFieldTypes.Items.AddChild(nil, 'Integer');
    for I := 10 to 24 do
      lbFieldTypes.Items.AddChild(Node, SQLFieldTypes[I].SqlName);
    Node := lbFieldTypes.Items.AddChild(nil, 'Autoinc');
    for I := 25 to 32 do
      lbFieldTypes.Items.AddChild(Node, SQLFieldTypes[I].SqlName);
    Node := lbFieldTypes.Items.AddChild(nil, 'Float');
    for I := 33 to 37 do
      lbFieldTypes.Items.AddChild(Node, SQLFieldTypes[I].SqlName);
    Node := lbFieldTypes.Items.AddChild(nil, 'Logical');
    for I := 38 to 41 do
      lbFieldTypes.Items.AddChild(Node, SQLFieldTypes[I].SqlName);
    Node := lbFieldTypes.Items.AddChild(nil, 'Currency');
    for I := 42 to 43 do
      lbFieldTypes.Items.AddChild(Node, SQLFieldTypes[I].SqlName);
    Node := lbFieldTypes.Items.AddChild(nil, 'DateTime');
    for I := 44 to 47 do
      lbFieldTypes.Items.AddChild(Node, SQLFieldTypes[I].SqlName);
    Node := lbFieldTypes.Items.AddChild(nil, 'Byte');
    for I := 48 to 49 do
      lbFieldTypes.Items.AddChild(Node, SQLFieldTypes[I].SqlName);
    Node := lbFieldTypes.Items.AddChild(nil, 'Blob');
    for I := 50 to 60 do
      lbFieldTypes.Items.AddChild(Node, SQLFieldTypes[I].SqlName);
  end;
end;

procedure TfrmCondition.LbFuncDblClick(Sender: TObject);
var
  S, S1, S2: string;
  I, Position:  integer;
begin
  Position := Memo1.Selstart;
  if Memo1.Sellength > 0 then begin
    I := Memo1.Selstart + 1;
    S := Memo1.Text;
    Delete(S, I, Memo1.Sellength);
    if (Sender is TEdit) then begin
      if (Sender as TEdit).Name = 'EditNumeric' then begin
        S1 := (Sender as TEdit).Text;
        if Pos(',', S1) <> 0 then begin
          S1 := Format('%s.%s', [Copy(S1, 1, Pos(',', S1) - 1), Copy(S1, Pos(',', S1) + 1, Length(S1))]);
        end;
      end else
      if (Sender as TEdit).Name = 'EditString' then begin
        S1 := (Sender as TEdit).Text + ' ';
        if S1 <> ' ' then
          S1 := Trim((Sender as TEdit).Text);
        S1 := Format('"%s"', [S1])
      end
      else
        S1 := (Sender as TEdit).Text;
    end
    else if not (Sender as TTreeView).Selected.HasChildren then
    if (Sender as TTreeView).Name = 'LbFlds' then begin
      S1 := (Sender as TTreeView).Selected.Text;
        S1 := Copy(S1, 0, Pos(sDelimiter, S1) - 1);
    end else begin
      S1 := (Sender as TTreeView).Selected.Text
    end
    else
      Exit;
    if Length(S1) <> 0 then begin
      if S1[1] <> ' ' then
        S1 := Format(' %s ', [S1]);
      Insert(S1, S, I);
      S2 := S1;
    end;
    Memo1.Text := S;
  end
  else begin
    if (Sender is TEdit) then begin
      if (Sender as TEdit).Name = 'EditNumeric' then begin
        S := (Sender as TEdit).Text;
        if Pos(',', S) <> 0 then begin
          S := Format('%s.%s', [Copy(S, 1, Pos(',', S) - 1), Copy(S, Pos(',', S) + 1, Length(S))]);
        end;
      end else
      if (Sender as TEdit).Name = 'EditString' then begin
        S := (Sender as TEdit).Text;
        S := Trim((Sender as TEdit).Text);
        if Length(S) = 0 then S := ' ';
        S := Format('"%s"', [S])
      end
      else begin
        S := Trim((Sender as TEdit).Text);
        if Length(S) = 0 then S := '0';
      end;
    end
    else if not (Sender as TTreeView).Selected.HasChildren then
    if (Sender as TTreeView).Name = 'LbFlds' then begin
      S := (Sender as TTreeView).Selected.Text;
        S := Copy(S, 0, Pos(sDelimiter, S) - 1);
    end else begin
      S := (Sender as TTreeView).Selected.Text
    end
    else
      Exit;
    if S <> '' then begin
      if S[1] <> ' ' then
        S := Format(' %s ', [S]);
      S1 := Memo1.Text;
      if Memo1.SelStart > -1 then
        Insert(S, S1, Memo1.Selstart + 1)
      else
        S1 := S1 + S;
      Memo1.Text := S1;
      S2 := S;
    end;
  end;
  if cbAutoSelNext.Checked then
    SelectNextItem
  else begin
    Memo1.SetFocus;
    Application.ProcessMessages;
    Memo1.Selstart  := Position + Length(S2);
    Memo1.Sellength := 0;
  end;
end;

procedure TfrmCondition.SelectNextItem;
var
  I, J: Integer;
  S: string;
begin
  I := Pos(sDelimiter, Memo1.Text);
  J := 0;
  if I <> 0 then begin
    S := Copy(Memo1.Text, I + 1, Length(Memo1.Text));
    J := Pos(sDelimiter, S) + 1;
  end;
  if I > 0 then begin
    Memo1.SetFocus;
    Application.ProcessMessages;
    Memo1.SelStart  := I - 1;
    Memo1.SelLength := J;
  end
  else begin
    Memo1.SetFocus;
    Application.ProcessMessages;
    Memo1.Selstart  := Length(Memo1.Text);
    Memo1.Sellength := 0;
  end;
end;

procedure TfrmCondition.TreeView2CustomDrawItem(Sender: TCustomTreeView;
  Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: boolean);
begin
  with(Sender as TTreeView).Canvas do
    if Node.HasChildren then
      Font.Style := [FsBold];
end;

procedure TfrmCondition.btnSelNextClick(Sender: TObject);
begin
  SelectNextItem;
end;

procedure TfrmCondition.EditNumericKeyPress(Sender: TObject;
  var Key: Char);
begin
  if (Key = '.') then begin
    Key := DecimalSeparator;
  end;
  if not ((Key in ['0'..'9']) or (Key = DecimalSeparator) or (Key = Char(VK_BACK))) then begin
    Key := #0;
  end;
end;

procedure TfrmCondition.Button1Click(Sender: TObject);
begin
  Memo1.Clear;
end;

procedure TfrmCondition.FormShow(Sender: TObject);
begin
  if aCond = CoCalc then
    edFieldName.SetFocus
  else
    Memo1.SetFocus;
end;

end.