qbuilder.pas

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

  begin
    s:=s+SQLfrom[i];
    if (i<SQLfrom.Count-1) then
      s:=s+', ';
    if (i=SQLfrom.Count-1) then
    begin
      SQL.Add(s);
      s:='  ';
    end;
  end;

  s:='   WHERE ';
  for i:=0 to SQLwhere.Count-1 do
  begin
    if (i<SQLwhere.Count-1) then
      s:=s+Format('(%s) OR ', [SQLwhere[i]])
    else
      s:=s+Format('(%s) ', [SQLwhere[i]]);
    if (i=SQLwhere.Count-1) then
    begin
      SQL.Add(s);
      s:='  ';
    end;
  end;

  s:='GROUP BY ';
  for i:=0 to SQLgroupby.Count-1 do
  begin
    if (i<SQLgroupby.Count-1) then
      s:=s+SQLgroupby[i]+', '
    else
      s:=s+SQLgroupby[i];
    if (i=SQLgroupby.Count-1) then
    begin
      SQL.Add(s);
      s:='  ';
    end;
  end;

  s:='ORDER BY ';
  for i:=0 to SQLorderby.Count-1 do
  begin
    if (i<SQLorderby.Count-1) then
      s:=s+SQLorderby[i]+', '
    else
      s:=s+SQLorderby[i];
    if (i=SQLorderby.Count-1) then
    begin
      SQL.Add(s);
      s:='  ';
    end;
  end;

  Result:=SQL.Text;
end;

{ TOQBLbx }

constructor TOQBLbx.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Style:=lbOwnerDrawFixed;
  ParentFont:=false;
  Font.Style:=[];
  Font.Size:=8;
  Color:= clGray;
  FArrBold:=nil;
  FLoading:=false;
end;

destructor TOQBLbx.Destroy;
begin
  if FArrBold<>nil then FreeMem(FArrBold);
  inherited;
end;

function TOQBLbx.GetCheckW: Integer;
begin
  Result:=GetCheckWidth;
end;

procedure TOQBLbx.CNDrawItem(var Message: TWMDrawItem);
var
  State: TOwnerDrawState;
  Idx: integer;
begin
  with Message.DrawItemStruct^ do
  begin
    rcItem.Left := rcItem.Left + GetCheckWidth; //*** check
    {$IFDEF LEVEL5}
    State := TOwnerDrawState(LongRec(itemState).Lo);
    {$ELSE}
    State := TOwnerDrawState(WordRec(LongRec(itemState).Lo).Lo);
    {$ENDIF}
    Canvas.Font := Font;
    Canvas.Brush := Brush;
    Idx:=Integer(itemID);
    if (Idx>=0) and (Idx<=Items.Count-1) then
      begin
        {$R-}
        if (FArrBold<>nil) then
          if FArrBold^[Idx]=1 then
            Canvas.Font.Style:=[fsBold];
        Canvas.Font.Color:=clBlack;
        DrawItem(itemID, rcItem, State);
        if (FArrBold<>nil) then
          if FArrBold^[Idx]=1 then
            Canvas.Font.Style:=[];
        {$R+}
      end
    else
      Canvas.FillRect(rcItem);
  end;
end;

procedure TOQBLbx.WMLButtonDown(var Message: TWMLButtonDblClk);
begin
  inherited;
  BeginDrag(false);
end;

procedure TOQBLbx.WMRButtonDown(var Message: TWMLButtonDblClk);
var
  pnt : TPoint;
begin
  inherited;
  pnt.X:=Message.XPos;
  pnt.Y:=Message.YPos;
  pnt:=ClientToScreen(pnt);
  PopupMenu.Popup(pnt.X,pnt.Y);
end;

procedure TOQBLbx.ClickCheck;
var
  iCol : integer;
begin
  inherited;
  if FLoading then
    Exit;
  if Checked[ItemIndex] then
    begin
      TOQBForm(GetParentForm(Self)).QBGrid.Insert(
        TOQBForm(GetParentForm(Self)).QBGrid.ColCount,
        Items[ItemIndex],TOQBTable(Parent).FTableName,TOQBTable(Parent).FTableAlias);
    end
  else
    begin
      iCol:=TOQBForm(GetParentForm(Self)).QBGrid.FindColumn(Items[ItemIndex]);
      while iCol<>-1 do
      begin
        TOQBForm(GetParentForm(Self)).QBGrid.RemoveColumn(iCol);
        iCol:=TOQBForm(GetParentForm(Self)).QBGrid.FindColumn(Items[ItemIndex]);
      end;
    end;
  TOQBForm(GetParentForm(Self)).QBGrid.Refresh; // StringGrid bug
end;

procedure TOQBLbx.AllocArrBold;
begin
  FArrBold:=AllocMem(Items.Count*SizeOf(integer));
end;

procedure TOQBLbx.SelectItemBold(Item:integer);
begin
  if FArrBold<>nil then
  begin
    {$R-}
    if FArrBold[Item]=0 then
      FArrBold^[Item]:=1;
    {$R+}
  end;
end;

procedure TOQBLbx.UnSelectItemBold(Item:integer);
begin
  if FArrBold<>nil then
  begin
    {$R-}
    if FArrBold[Item]=1 then
      FArrBold^[Item]:=0;
    {$R+}
  end;
end;

function TOQBLbx.GetItemY(Item:integer):integer;
begin
  Result:=Item*ItemHeight+ItemHeight div 2 +1;
end;

{ TOQBTable }

constructor TOQBTable.Create(AOwner: TComponent);
var
  mnuArr   : array [1..5] of TMenuItem;
begin
  inherited Create(AOwner);
  Visible:=false;
  ShowHint:=True;
  BevelInner:=bvRaised;
  BevelOuter:=bvRaised;
  BorderWidth:=1;
  FCloseBtn:=TSpeedButton.Create(Self);
  FCloseBtn.Parent:=Self;
  FCloseBtn.Hint:='Close';
  FUnlinkBtn:=TSpeedButton.Create(Self);
  FUnlinkBtn.Parent:=Self;
  FUnlinkBtn.Hint:='Unlink';

  FLbx:=TOQBLbx.Create(Self);
  FLbx.Parent:=Self;
  FLbx.Style:=lbOwnerDrawFixed;
  FLbx.Align:=alBottom;
  FLbx.TabStop:=false;
  FLbx.Visible:=false;

  mnuArr[1]:=NewItem('Select All',0,false,true,_SelectAll,0,'mnuSelectAll');
  mnuArr[2]:=NewItem('Unselect All',0,false,true,_UnSelectAll,0,'mnuUnSelectAll');
  mnuArr[3]:=NewLine;
  mnuArr[4]:=NewItem('Unlink',0,false,true,_UnlinkBtn,0,'mnuUnLink');
  mnuArr[5]:=NewItem('Close',0,false,true,_CloseBtn,0,'mnuClose');
  PopMenu:=NewPopupMenu(Self,'mnu',paLeft,false,mnuArr);
  PopMenu.PopupComponent:=Self;

  FLbx.PopupMenu:=PopMenu;
end;

destructor TOQBTable.Destroy;
begin
  inherited Destroy;
end;

procedure TOQBTable.WMRButtonDown(var Message: TWMLButtonDblClk);
var
  pnt : TPoint;
begin
  inherited;
  pnt.X:=Message.XPos;
  pnt.Y:=Message.YPos;
  pnt:=ClientToScreen(pnt);
  PopMenu.Popup(pnt.X,pnt.Y);
end;

procedure TOQBTable.Paint;
begin
  inherited Paint;
  if TOQBForm(GetParentForm(Self)).QBDialog.OQBEngine.UseTableAliases then
    Canvas.TextOut(4,4,FTableName+' : '+FTableAlias)
  else
    Canvas.TextOut(4,4,FTableName);
end;

function  TOQBTable.GetRowY(FldN:integer):integer;
var
  pnt  : TPoint;
begin
  pnt.X:=FLbx.Left;
  pnt.Y:=FLbx.Top+FLbx.GetItemY(FldN);
  pnt:=Parent.ScreenToClient(ClientToScreen(pnt));
  Result:=pnt.Y;
end;

function TOQBTable.Activate(const ATableName:string; X,Y:Integer):boolean;
var
  i      : integer;
  W,W1   : integer;
  OQBEngine : TOQBEngine;
begin
  Result:=false;
  Top:=Y;
  Left:=X;
  Font.Style:=[fsBold];
  Font.Size:=8;
  Canvas.Font:=Font;
  Hint:=ATableName;

  FTableName:=ATableName;
  FTableAlias:=TOQBForm(GetParentForm(Self)).QBDialog.FOQBEngine.AliasList[
                TOQBForm(GetParentForm(Self)).QBDialog.FOQBEngine.TableList.IndexOf(ATableName)];
  OQBEngine:=TOQBForm(GetParentForm(Self)).QBDialog.FOQBEngine;
  try
    OQBEngine.ReadFieldList(ATableName);
    FLbx.Items.Assign(OQBEngine.FieldList);
  except
    on E:EDatabaseError do
      begin
        ShowMessage(E.Message);
        Exit;
      end;
  end;

  FLbx.AllocArrBold;
  FLbx.ParentFont:=false;
  FLbx.TabStop:=false;
  FLbx.Height:=FLbx.ItemHeight*FLbx.Items.Count+4;

  Height:=FLbx.Height+22;
  W:=110;
  for i:=0 to FLbx.Items.Count-1 do
  begin
    W1:=Canvas.TextWidth(FLbx.Items[i]);
    if W<W1 then
      W:=W1;
  end;
  Width:=W+20+FLbx.GetCheckW; //*** check

  if TOQBForm(GetParentForm(Self)).QBDialog.OQBEngine.UseTableAliases then
    begin
      if Canvas.TextWidth(FTableName+' : '+FTableAlias)>Width-34 then
        Width:=Canvas.TextWidth(FTableName+' : '+FTableAlias)+34
    end
  else
    if Canvas.TextWidth(FTableName)>Width-34 then
      Width:=Canvas.TextWidth(FTableName)+34;

  FLbx.Visible:=true;
  FLbx.OnDragOver:=_DragOver;
  FLbx.OnDragDrop:=_DragDrop;
  FCloseBtn.Top:=4;
  FCloseBtn.Left:=Self.ClientWidth-16;
  FCloseBtn.Width:=12;                        
  FCloseBtn.Height:=12;
  FCloseBtn.Glyph.LoadFromResourceName(HInstance,'CLOSEBMP');;
  FCloseBtn.Margin:=-1;
  FCloseBtn.Spacing:=0;
  FCloseBtn.OnClick:=_CloseBtn;
  FCloseBtn.Visible:=true;
  FCloseBtn.Hint:='Close';
  FCloseBtn.ShowHint:=True;
  FUnlinkBtn.Top:=4;
  FUnlinkBtn.Left:=Self.ClientWidth-16-FCloseBtn.Width;
  FUnlinkBtn.Width:=12;
  FUnlinkBtn.Height:=12;
  FUnlinkBtn.Glyph.LoadFromResourceName(HInstance,'UNLINKBMP');;
  FUnlinkBtn.Margin:=-1;
  FUnlinkBtn.Spacing:=0;
  FUnlinkBtn.OnClick:=_UnlinkBtn;
  FUnlinkBtn.Visible:=true;
  FUnlinkBtn.Hint:= 'Unlink';
  FUnlinkBtn.ShowHint:=True;
  Visible:=true;
  Result:=True;
end;

procedure TOQBTable._CloseBtn(Sender: TObject);
begin
  TOQBArea(Parent).UnlinkTable(Self);
  TOQBForm(GetParentForm(Self)).QBGrid.RemoveColumn4Tbl(FTableName);
  Parent.RemoveControl(Self);
  Free;
end;

procedure TOQBTable._UnlinkBtn(Sender: TObject);
begin
  TOQBArea(Parent).UnlinkTable(Self);
end;

procedure TOQBTable._SelectAll(Sender: TObject);
var
  i : integer;
begin
  if FLbx.Items.Count=1 then
    Exit;
  for i:=1 to (FLbx.Items.Count-1) do
  begin
    FLbx.Checked[i]:=True;
    TOQBForm(GetParentForm(Self)).QBGrid.Insert(
      TOQBForm(GetParentForm(Self)).QBGrid.ColCount,
      FLbx.Items[i],FTableName,FTableAlias);
  end;
end;

procedure TOQBTable._UnSelectAll(Sender: TObject);
var
  i : integer;
begin
  if FLbx.Items.Count=1 then
    Exit;
  for i:=1 to (FLbx.Items.Count-1) do
  begin
    FLbx.Checked[i]:=False;
    TOQBForm(GetParentForm(Self)).QBGrid.RemoveColumn4Tbl(FTableName);
  end;
end;

procedure TOQBTable._DragOver(Sender, Source: TObject; X, Y: Integer;
                            State: TDragState; var Accept: Boolean);
begin
  if (Source is TCustomListBox)
     and
     (TWinControl(Source).Parent is TOQBTable)
  then
    Accept:=true;
end;

procedure TOQBTable._DragDrop(Sender, Source: TObject; X, Y: Integer);
var
  nRow : integer;
  hRow : integer;
begin
  if (Source is TCustomListBox) then
  begin
    if (TWinControl(Source).Parent is TOQBTable) then
      begin
        hRow:=FLbx.ItemHeight;
        if hRow<>0 then
          nRow:=Y div hRow
        else
          nRow:=0;
        if nRow>FLbx.Items.Count-1 then
          nRow:=FLbx.Items.Count-1;
        // handler for target's '*' row
        if nRow=0 then
          Exit;
        // handler for source's '*' row
        if TOQBTable(TWinControl(Source).Parent).FLbx.ItemIndex=0 then
          Exit;
        if Source<>FLbx then
          TOQBArea(Parent).InsertLink(
            TOQBTable(TWinControl(Source).Parent), Self,
            TOQBTable(TWinControl(Source).Parent).FLbx.ItemIndex, nRow)
        else
          begin
            if nRow<>FLbx.ItemIndex then
              TOQBArea(Parent).InsertLink(Self, Self, FLbx.ItemIndex, nRow);
          end;
      end
    else
      if Source=TOQBForm(GetParentForm(Self)).QBTables then
      begin
        X:=X+Left+TWinControl(Sender).Left;
        Y:=Y+Top+TWinControl(Sender).Top;
        TOQBArea(Parent).InsertTable(X,Y);
      end;
  end
end;

procedure TOQBTable.SetParent(AParent: TWinControl);
begin
  if (AParent<>nil) and (not (AParent is TScrollBox)) then
    raise Exception.Create(sNotValidTableParent);
  inherited SetParent(AParent);
end;

procedure TOQBTable.MouseDown(Button:TMouseButton; Shift:TShiftState; X,Y:Integer);
begin
  inherited MouseDown(Button,Shift,X,Y);
  BringToFront;
  if (Button=mbLeft) then
  begin
    SetCapture(Self.Handle);
    ScreenDC:=GetDC(0);

    ClipRect:=Bounds(Parent.Left,Parent.Top,Parent.Width,Parent.Height);
    ClipRect.TopLeft:=Parent.Parent.ClientToScreen(ClipRect.TopLeft);
    ClipRect.BottomRight:=Parent.Parent.ClientToScreen(ClipRect.BottomRight);
    ClipRgn:=CreateRectRgn(ClipRect.Left,ClipRect.Top,ClipRect.Right,ClipRect.Bottom);
    SelectClipRgn(ScreenDC,ClipRgn);
    ClipCursor(@ClipRect);
    OldX:=X;
    OldY:=Y;
    OldLeft:=X;
    OldTop:=Y;
    MoveRect:=Rect(Self.Left,Self.Top,Self.Left+Self.Width,Self.Top+Self.Height);
    MoveRect.TopLeft:=Parent.ClientToScreen(MoveRect.TopLeft);
    MoveRect.BottomRight:=Parent.ClientToScreen(MoveRect.BottomRight);
    DrawFocusRect(ScreenDC,MoveRect);
    Moving:=True;
  end;
end;

procedure TOQBTable.MouseMove(Shift: TShiftState; X,Y: Integer);
begin
  inherited MouseMove(Shift,X,Y);
  if Moving then
  begin
    DrawFocusRect(ScreenDC,MoveRect);
    OldX:=X;
    OldY:=Y;
    MoveRect:=Rect(Self.Left+OldX-OldLeft,Self.Top+OldY-OldTop,
                   Self.Left+Self.Width+OldX-OldLeft,Self.Top+Self.Height+OldY-OldTop);
    MoveRect.TopLeft:=Parent.ClientToScreen(MoveRect.TopLeft);