qbuilder.pas

TxQuery is an SQL engine implemented in a TDataSet descendant component, that can parse SQL syntax,

            else
              begin    //D
                X1:=Tbl2.Left+Tbl2.Width;
                X2:=Tbl1.Left;
                LnkX:=4;
              end;
          end;
      end;

    Y1:=Tbl1.GetRowY(FldN1);
    Y2:=Tbl2.GetRowY(FldN2);
    if Y1<Y2 then
      begin        //M
        Y1:=Tbl1.GetRowY(FldN1)-Hand div 2;
        Y2:=Tbl2.GetRowY(FldN2)+Hand div 2;
        LnkY:=1;
      end
    else
      begin         //N
        Y2:=Tbl1.GetRowY(FldN1)+Hand div 2;
        Y1:=Tbl2.GetRowY(FldN2)-Hand div 2;
        LnkY:=2;
      end;
    SetBounds(X1,Y1,X2-X1,Y2-Y1);
  end;
end;

procedure TOQBArea.ReboundLinks4Table(ATable:TOQBTable);
var
  i    : integer;
  Link : TOQBLink;
begin
  for i:=0 to ControlCount-1 do
  begin
    if Controls[i] is TOQBLink then
    begin
      Link:=TOQBLink(Controls[i]);
      if (Link.Tbl1=ATable) or (Link.Tbl2=ATable) then
        ReboundLink(Link);
    end;
  end;
end;

procedure TOQBArea.Unlink(Sender: TObject);
var
  Link  : TOQBLink;
begin
  if TPopupMenu(Sender).Owner is TOQBLink then
  begin
    Link:=TOQBLink(TPopupMenu(Sender).Owner);
    RemoveControl(Link);
    if not FindOtherLink(Link,Link.tbl1,Link.fldN1) then
    begin
      Link.tbl1.FLbx.UnSelectItemBold(Link.fldN1);
      Link.tbl1.FLbx.Refresh;
    end;
    if not FindOtherLink(Link,Link.tbl2,Link.fldN2) then
    begin
      Link.tbl2.FLbx.UnSelectItemBold(Link.fldN2);
      Link.tbl2.FLbx.Refresh;
    end;
    Link.Free;
  end;
end;

procedure TOQBArea.UnlinkTable(ATable:TOQBTable);
var
  i    : integer;
  TempLink : TOQBLink;
begin
  for i:=ControlCount-1 downto 0 do
  begin
    if Controls[i] is TOQBLink then
    begin
      TempLink:=TOQBLink(Controls[i]);
      if (TempLink.Tbl1=ATable) or (TempLink.Tbl2=ATable) then
      begin
        RemoveControl(TempLink);
        if not FindOtherLink(TempLink,TempLink.tbl1,TempLink.fldN1) then
        begin
          TempLink.tbl1.FLbx.UnSelectItemBold(TempLink.fldN1);
          TempLink.tbl1.FLbx.Refresh;
        end;
        if not FindOtherLink(TempLink,TempLink.tbl2,TempLink.fldN2) then
        begin
          TempLink.tbl2.FLbx.UnSelectItemBold(TempLink.fldN2);
          TempLink.tbl2.FLbx.Refresh;
        end;
        TempLink.Free;
      end;
    end;
  end;
end;

procedure TOQBArea._DragOver(Sender, Source: TObject; X, Y: Integer;
                            State: TDragState; var Accept: Boolean);
begin
  if (Source=TOQBForm(GetParentForm(Self)).QBTables) then
    Accept:=true;
end;

procedure TOQBArea._DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
  if not (Sender is TOQBArea) then
  begin
    X:=X+TControl(Sender).Left;
    Y:=Y+TControl(Sender).Top;
  end;
  if Source=TOQBForm(GetParentForm(Self)).QBTables then
    InsertTable(X,Y);
end;

{ TOQBGrid }

constructor TOQBGrid.Create(AOwner: TComponent);
begin
   inherited Create(Aowner);
   FFieldList := TOQBFieldList.Create;
   Options:=[goFixedVertLine,goFixedHorzLine,goVertLine,goHorzLine,goColSizing,goColMoving];
   OnColumnMoved:=_ColumnMoved;
   Hint := 'Double click to edit Field or'+#10#10+'Right click for popup menu';
   ShowHint:=True;
end;

destructor TOQBGrid.Destroy;
begin
   FFieldList.Free;
   inherited Destroy;
end;

procedure TOQBGrid.CreateParams(var Params: TCreateParams);
begin
   inherited CreateParams(Params);
   ColCount:=2;
   RowCount:=9;
   Height:=Parent.ClientHeight div 3;
   DefaultRowHeight:=Height div (6+1) - GridLineWidth;
   OnDragOver:=_DragOver;
   OnDragDrop:=_DragDrop;
end;

function TOQBGrid.IsEmpty: Boolean;
begin
   Result:=(FFieldList.Count=0);
end;

procedure TOQBGrid.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
var
   Text: string;
   Justif: Word;
begin
   inherited DrawCell(ACol,ARow,ARect,AState);
   { pendiente aqui }
   with Canvas do
   begin
      if ACol = 0 then
      begin
         Text:= sRows[ARow];
      end else if (FieldList.Count>0) and (ARow <9) then
      begin
         case ARow of
            0 : Text := FieldList[ACol - 1].FieldName;
            1 : Text := FieldList[ACol - 1].Table;
            2 : Text := sShow[FieldList[ACol - 1].ShowAction];
            3 : Text := sSort[FieldList[ACol - 1].SortType];
            4..8 :
               begin
               if Length(FieldList[ACol - 1].Filters[ARow-4].FCustomExpres)>0 then
                  Text := FieldList[ACol - 1].Filters[ARow-4].FCustomExpres
               else
                  Text := FieldList[ACol - 1].Filters[ARow-4].FilterVerb;
               end;
         end;
      end;
      Font.Style:= [];
      Justif:= DT_LEFT;
      DrawText(Handle, PChar(Text), -1, ARect, Justif or DT_SINGLELINE or DT_VCENTER);
   end;
end;

procedure TOQBGrid.WndProc(var Message: TMessage);
begin
  if (Message.Msg=WM_RBUTTONDOWN) then
    ClickCell(TWMMouse(Message).XPos,TWMMouse(Message).YPos);
  inherited WndProc(Message);
end;

procedure TOQBGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
   inherited MouseDown(Button,Shift,X,Y);
   if (Button=mbLeft) and (ssDouble in Shift) then
      DblClickCell(X,Y);
end;

function TOQBGrid.MaxSW(const s1,s2:string):integer;
begin
  Result:=Canvas.TextWidth(s1);
  if Result<Canvas.TextWidth(s2) then
    Result:=Canvas.TextWidth(s2);
end;

procedure TOQBGrid.ResetWidths;
var
   i: Integer;
begin
   if FieldList.Count > 0 then
   begin
      ColCount:= FieldList.Count+1;
      for i:= 0 to FieldList.Count - 1 do
      ColWidths[i+1]:=MaxSW(FieldList[i].FieldName,FieldList[i].Table)+8;
   end else
   begin
      ColCount:=2;
      ColWidths[1]:= Canvas.TextWidth('WWWWWWWW');
   end;
end;

procedure TOQBGrid.Insert(aCol:integer;const aField,aTable,aTableAlias:string);
var
  i : integer;
  OQBField : TOQBField;
begin
  if FieldList.Count=0 then
    begin
      with FieldList.Add do
      begin
          Table     := aTable;
          TableAlias:= aTableAlias;
          FieldName := aField;
      end;
      aCol:=FieldList.Count;
      Invalidate;
    end
  else
    begin
      if aCol=-1 then
        begin
          with FieldList.Add do
          begin
              Table     := aTable;
              TableAlias:= aTableAlias;
              FieldName := aField;
          end;
          aCol:=FieldList.Count;
        end
      else
        begin
          FieldList.Insert(aCol-1);
          {FieldList.Add;
          for i:=FieldList.Count-1 downto aCol+1 do
            FieldList.Exchange(i-1,i); }
          FieldList[aCol-1].FieldName:=aField;
          FieldList[aCol-1].Table:=aTable;
          FieldList[aCol-1].TableAlias:=aTableAlias;
        end;
      //* Fix StringGrid Bug *
        {if aCol>1 then
          ColWidths[aCol-1]:=MaxSW(FieldList[aCol-2].FieldName,FieldList[aCol-2].Table)+8;
        if aCol<ColCount-1 then
          ColWidths[aCol+1]:=MaxSW(FieldList[aCol].FieldName,FieldList[aCol].Table)+8;
        ColWidths[ColCount-1]:=MaxSW(FieldList[ColCount-2].FieldName,FieldList[ColCount-2].Table)+8; }
      end;
  if FieldList.Count=0 then
     ColCount := 2
  else
     ColCount := FieldList.Count + 1;
  ColWidths[aCol]:=MaxSW(aTable,aField)+8;
  Invalidate;
end;

procedure TOQBGrid._ColumnMoved(Sender: TObject; FromIndex,ToIndex: Integer);
begin
   FieldList.ColumnMoved(FromIndex-1,ToIndex-1);
   Invalidate;
end;

function TOQBGrid.FindColumn(const sCol:string):integer;
var
  i : integer;
begin
  Result:=-1;
  for i:=0 to FieldList.Count-1 do
     if FieldList[i].Fieldname=sCol then
     begin
        Result:=i+1;
        Exit;
     end;
end;

function TOQBGrid.FindSameColumn(aCol:integer):boolean;
var
  i : integer;
begin
  Result:=false;
  for i:=0 to FieldList.Count-1 do
  begin
    if i=aCol-1 then
      Continue
    else
      if FieldList[i].FieldName=FieldList[aCol-1].FieldName then
      begin
        Result:=True;
        Exit;
      end;
  end;
end;

procedure TOQBGrid.RemoveColumn(aCol:integer);
var
  i  : integer;
begin
  if (FieldList.Count>0) then
  begin
      FieldList.Delete(aCol-1);
      if FieldList.Count=0 then
         ColCount:=2
      else
         ColCount:=FieldList.Count+1;
  end;
end;

procedure TOQBGrid.RemoveColumn4Tbl(const Tbl:string);
var
  i     : integer;
  found : boolean;
begin
  repeat
    found:= false;
    for i:=0 to FieldList.Count - 1 do
       if FieldList[i].Table=Tbl then
       begin
          RemoveColumn(i+1);
          found:= true;
          Break;
       end;
  until not found;
end;

procedure TOQBGrid.ClickCell(X,Y:integer);
var
  P     : TPoint;
  mCol,
  mRow  : integer;
begin
  MouseToCell(X,Y,mCol,mRow);
  CurrCol:=mCol;
  P.X:=X;
  P.Y:=Y;
  P:=ClientToScreen(P);
  if (mCol>0) and (mCol<=FieldList.Count) and (not IsEmpty) then
  begin
    if (FieldList[mCol-1].FieldName='*') and (mRow<>0) then
      Exit;
    TOQBForm(GetParentForm(Self)).mnuTbl.Popup(P.X,P.Y);
  end;
end;

procedure TOQBGrid.DblClickCell(X,Y:integer);
var
  P     : TPoint;
  mCol,
  mRow  : integer;
begin
  MouseToCell(X,Y,mCol,mRow);
  CurrCol:=mCol;
  if (mCol>0) and (mCol<=FieldList.Count) and (not IsEmpty) then
  begin
    if (FieldList[mCol-1].FieldName='*') and (mRow<>0) then
      Exit;
    with TfrmEdQBField.Create(Application) do
    begin
       try
          if Enter((GetParentForm(Self) as TOQBForm).QBDialog.OQBEngine.ResultQuery,
                  FieldList[mCol-1],
            IMax(mRow-4,0)) = mrOk then
             Self.Invalidate;
       finally
          Free;
       end;
    end;
  end;
end;

procedure TOQBGrid._DragOver(Sender, Source: TObject; X, Y: Integer;
                            State: TDragState; var Accept: Boolean);
begin
  if (Source<>TOQBForm(GetParentForm(Self)).QBTables) then
    Accept:=true;
end;

procedure TOQBGrid._DragDrop(Sender, Source: TObject; X, Y: Integer);
var
  dCol,
  dRow    : integer;
begin
  if ((Source is TOQBLbx) and
      (Source<>TOQBForm(GetParentForm(Self)).QBTables))
  then
  begin
    TOQBTable(TWinControl(Source).Parent).FLbx.Checked[TOQBTable(TWinControl(Source).Parent).FLbx.ItemIndex]:=True;//*** check
    MouseToCell(X,Y,dCol,dRow);
    if dCol=0 then
      Exit;
    Insert(dCol, TOQBTable(TWinControl(Source).Parent).FLbx.Items[TOQBTable(TWinControl(Source).Parent).FLbx.ItemIndex],
                 TOQBTable(TWinControl(Source).Parent).FTableName,
                 TOQBTable(TWinControl(Source).Parent).FTableAlias);
  end;
end;


{ TOQBForm }

procedure TOQBForm.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  QBArea:=TOQBArea.Create(Self);
  QBArea.Parent:=TabColumns;
  QBArea.Align:=alClient;
  QBArea.Color:=clSilver;//clAqua;
  {QBGrid:=TOQBGrid.Create(Self);
  QBGrid.Parent:=TabColumns;
  VSplitter.Tag:=VSplitter.Left;
  HSplitter.Tag:=HSplitter.Top;
  HSplitter.Align:=alBottom;
  HSplitter.Top:=0;}        { just a trick }
  //QBGrid.Align:=alBottom;  //alClient;
end;

procedure TOQBForm.mnuRemoveClick(Sender: TObject);
var
  TempTable : TOQBTable;
begin
  TempTable:=QBArea.FindTable(QBGrid.FieldList[QBGrid.CurrCol-1].Table);
  if not QBGrid.FindSameColumn(QBGrid.CurrCol) then
    TempTable.FLbx.Checked[TempTable.FLbx.Items.IndexOf(QBGrid.FieldList[QBGrid.CurrCol-1].FieldName)]:=false;
  QBGrid.RemoveColumn(QBGrid.CurrCol);
  QBGrid.Refresh; // fix for StringGrid bug
end;

procedure TOQBForm.ClearAll;
var
  i : integer;
  TempTable : TOQBTable;
begin
  for i:=QBArea.ControlCount-1 downto 0 do
    if QBArea.Controls[i] is TOQBTable then
      begin
        TempTable:=TOQBTable(QBArea.Controls[i]);
        QBGrid.RemoveColumn4Tbl(TempTable.FTableName);
        TempTable.Free;
      end
    else
      QBArea.Controls[i].Free; // QBLink
  QBGrid.ResetWidths;
  MemoSQL.Lines.Clear;
  QBDialog.OQBEngine.ResultQuery.Close;
  QBDialog.OQBEngine.ClearQuerySQL;
  Pages.ActivePage:=TabColumns;
end;

procedure TOQBForm.btnNewClick(Sender: TObject);
begin
  ClearAll;
end;

procedure TOQBForm.btnOpenClick(Sender: TObject);
var
  i,ii,j,k,n : integer;
  s,ss : string;
  NewTable : TOQBTable;
  TableName : string;
  X,Y : integer;
  NewLink : TOQBLink;
  Table1,Table2 : TOQBTable;
  FieldN1,FieldN2 : integer;
  ColField, ColTable : string;
  StrList