qbuilder.pas

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

    MoveRect.BottomRight:=Parent.ClientToScreen(MoveRect.BottomRight);
    DrawFocusRect(ScreenDC,MoveRect);
  end;
end;

procedure TOQBTable.MouseUp(Button:TMouseButton; Shift:TShiftState; X,Y:Integer);
begin
  inherited MouseUp(Button,Shift,X,Y);
  if Button=mbLeft then
  begin
    ReleaseCapture;
    DrawFocusRect(ScreenDC,MoveRect);
    begin
      if (Self.Left<>Self.Left+X+OldLeft)
          or
         (Self.Top<>Self.Top+Y-OldTop)
      then
      begin
        Self.Visible:=False;
        Self.Left:=Self.Left+X-OldLeft;
        Self.Top:=Self.Top+Y-OldTop;
        Self.Visible:=True;
      end
    end;
    ClipRect:=Rect(0,0,Screen.Width,Screen.Height);
    ClipCursor(@ClipRect);
    DeleteObject(ClipRgn);
    ReleaseDC(0,ScreenDC);
    Moving:=False;
  end;
  TOQBArea(Parent).ReboundLinks4Table(Self);  
end;

{ TOQBLink }

constructor TOQBLink.Create(AOwner: TComponent);
var
  mnuArr   : array [1..4] of TMenuItem;
begin
  inherited Create(AOwner);
  ControlStyle:=ControlStyle+[csReplicatable];
  Width:=105;
  Height:=105;
  Rgn:=CreateRectRgn(0,0,Hand,Hand);
  mnuArr[1]:=NewItem('',0,false,false,nil,0,'mnuLinkName');
  mnuArr[2]:=NewLine;
  mnuArr[3]:=NewItem('Link options',0,false,true,TOQBArea(AOwner).SetOptions,0,'mnuOptions');
  mnuArr[4]:=NewItem('Unlink',0,false,true,TOQBArea(AOwner).Unlink,0,'mnuUnlink');
  PopMenu:=NewPopupMenu(Self,'mnu',paLeft,false,mnuArr);
  PopMenu.PopupComponent:=Self;
  Hint := sLinkHint;
  ShowHint := True;
end;

destructor TOQBLink.Destroy;
begin
  DeleteObject(Rgn);
  inherited Destroy;
end;

procedure TOQBLink.Paint;
var
  ArrRgn,
  pntArray : array [1..4] of TPoint;
  ArrCnt   : integer;
begin
  if tbl1<>tbl2 then
    begin
      if ((LnkX=1) and (LnkY=1))
         or
         ((LnkX=4) and (LnkY=2))
      then
      begin
        pntArray[1].X:=0;
        pntArray[1].Y:=Hand div 2;
        pntArray[2].X:=Hand;
        pntArray[2].Y:=Hand div 2;
        pntArray[3].X:=Width-Hand;
        pntArray[3].Y:=Height-Hand div 2;
        pntArray[4].X:=Width;
        pntArray[4].Y:=Height-Hand div 2;
        ArrRgn[1].X:=pntArray[2].X+5;
        ArrRgn[1].Y:=pntArray[2].Y-5;
        ArrRgn[2].X:=pntArray[2].X-5;
        ArrRgn[2].Y:=pntArray[2].Y+5;
        ArrRgn[3].X:=pntArray[3].X-5;
        ArrRgn[3].Y:=pntArray[3].Y+5;
        ArrRgn[4].X:=pntArray[3].X+5;
        ArrRgn[4].Y:=pntArray[3].Y-5;
      end;
      if Width>Hand+Hand2 then
      begin
        if ((LnkX=2) and (LnkY=1))
           or
           ((LnkX=3) and (LnkY=2))
        then
        begin
          pntArray[1].X:=0;
          pntArray[1].Y:=Hand div 2;
          pntArray[2].X:=Hand;
          pntArray[2].Y:=Hand div 2;
          pntArray[3].X:=Width-5;
          pntArray[3].Y:=Height-Hand div 2;
          pntArray[4].X:=Width-Hand;
          pntArray[4].Y:=Height-Hand div 2;
          ArrRgn[1].X:=pntArray[2].X+5;
          ArrRgn[1].Y:=pntArray[2].Y-5;
          ArrRgn[2].X:=pntArray[2].X-5;
          ArrRgn[2].Y:=pntArray[2].Y+5;
          ArrRgn[3].X:=pntArray[3].X-5;
          ArrRgn[3].Y:=pntArray[3].Y+5;
          ArrRgn[4].X:=pntArray[3].X+5;
          ArrRgn[4].Y:=pntArray[3].Y-5;
        end;
        if ((LnkX=3) and (LnkY=1))
           or
           ((LnkX=2) and (LnkY=2))
        then
        begin
          pntArray[1].X:=Width-Hand;
          pntArray[1].Y:=Hand div 2;
          pntArray[2].X:=Width-5;
          pntArray[2].Y:=Hand div 2;
          pntArray[3].X:=Hand;
          pntArray[3].Y:=Height-Hand div 2;
          pntArray[4].X:=0;
          pntArray[4].Y:=Height-Hand div 2;
          ArrRgn[1].X:=pntArray[2].X-5;
          ArrRgn[1].Y:=pntArray[2].Y-5;
          ArrRgn[2].X:=pntArray[2].X+5;
          ArrRgn[2].Y:=pntArray[2].Y+5;
          ArrRgn[3].X:=pntArray[3].X+5;
          ArrRgn[3].Y:=pntArray[3].Y+5;
          ArrRgn[4].X:=pntArray[3].X-5;
          ArrRgn[4].Y:=pntArray[3].Y-5;
        end;
      end
      else
      begin
        if ((LnkX=2) and (LnkY=1))
           or
           ((LnkX=3) and (LnkY=2))
           or
           ((LnkX=3) and (LnkY=1))
           or
           ((LnkX=2) and (LnkY=2))
        then
        begin
          pntArray[1].X:=0;
          pntArray[1].Y:=Hand div 2;
          pntArray[2].X:=Width-Hand2;
          pntArray[2].Y:=Hand div 2;
          pntArray[3].X:=Width-Hand2;
          pntArray[3].Y:=Height-Hand div 2;
          pntArray[4].X:=0;
          pntArray[4].Y:=Height-Hand div 2;
          ArrRgn[1].X:=pntArray[2].X-5;
          ArrRgn[1].Y:=pntArray[2].Y-5;
          ArrRgn[2].X:=pntArray[2].X+5;
          ArrRgn[2].Y:=pntArray[2].Y+5;
          ArrRgn[3].X:=pntArray[3].X+5;
          ArrRgn[3].Y:=pntArray[3].Y+5;
          ArrRgn[4].X:=pntArray[3].X-5;
          ArrRgn[4].Y:=pntArray[3].Y-5;
        end;
      end;
      if ((LnkX=4) and (LnkY=1))
         or
         ((LnkX=1) and (LnkY=2))
      then
      begin
        pntArray[1].X:=Width;
        pntArray[1].Y:=Hand div 2;
        pntArray[2].X:=Width-Hand;
        pntArray[2].Y:=Hand div 2;
        pntArray[3].X:=Hand;
        pntArray[3].Y:=Height-Hand div 2;
        pntArray[4].X:=0;
        pntArray[4].Y:=Height-Hand div 2;
        ArrRgn[1].X:=pntArray[2].X-5;
        ArrRgn[1].Y:=pntArray[2].Y-5;
        ArrRgn[2].X:=pntArray[2].X+5;
        ArrRgn[2].Y:=pntArray[2].Y+5;
        ArrRgn[3].X:=pntArray[3].X+5;
        ArrRgn[3].Y:=pntArray[3].Y+5;
        ArrRgn[4].X:=pntArray[3].X-5;
        ArrRgn[4].Y:=pntArray[3].Y-5;
      end;
    end
  else
    begin
      pntArray[1].X:=0;
      pntArray[1].Y:=Hand div 2;
      pntArray[2].X:=Hand-5;
      pntArray[2].Y:=Hand div 2;
      pntArray[3].X:=Hand-5;
      pntArray[3].Y:=Height-Hand div 2;
      pntArray[4].X:=0;
      pntArray[4].Y:=Height-Hand div 2;
      ArrRgn[1].X:=pntArray[2].X+5;
      ArrRgn[1].Y:=pntArray[2].Y-5;
      ArrRgn[2].X:=pntArray[2].X-5;
      ArrRgn[2].Y:=pntArray[2].Y+5;
      ArrRgn[3].X:=pntArray[3].X-5;
      ArrRgn[3].Y:=pntArray[3].Y+5;
      ArrRgn[4].X:=pntArray[3].X+5;
      ArrRgn[4].Y:=pntArray[3].Y-5;
    end;
  if FLinkOpt > 0 then  { is a geographic link?}
  begin
     Canvas.Pen.Color:=clBlue;
     Canvas.Pen.Width:=2;
  end else
  begin
     Canvas.Pen.Color:=clBlack;
     Canvas.Pen.Width:=1;
  end;
  Canvas.PolyLine(pntArray);
  Canvas.Brush:=Parent.Brush;
  DeleteObject(Rgn);
  ArrCnt:=4;
  Rgn:=CreatePolygonRgn(ArrRgn,ArrCnt,ALTERNATE);
end;

procedure TOQBLink._Click(X,Y:integer);
var
  pnt : TPoint;
begin
  pnt.X:=X;
  pnt.Y:=Y;
  pnt:=ClientToScreen(pnt);
  PopMenu.Popup(pnt.X,pnt.Y);
end;

procedure TOQBLink.CMHitTest(var Message: TCMHitTest);
begin
  if PtInRegion(Rgn,Message.XPos,Message.YPos) then
    Message.Result:=1;
end;

function TOQBLink.ControlAtPos(const Pos: TPoint): TControl;
var
  I      : integer;
  scrnP,
  P      : TPoint;
begin
  scrnP:=ClientToScreen(Pos);
  for I:=Parent.ControlCount-1 downto 0 do
  begin
    Result:=Parent.Controls[I];
    if (Result is TOQBLink) and (Result<>Self) then
      with Result do
      begin
        P := Result.ScreenToClient(scrnP);
        if Perform(CM_HITTEST,0,integer(PointToSmallPoint(P)))<>0 then
          Exit;
      end;
    end;
  Result := nil;
end;

procedure TOQBLink.WndProc(var Message: TMessage);
begin
  if (Message.Msg=WM_RBUTTONDOWN) or (Message.Msg=WM_LBUTTONDOWN)  then
    if not PtInRegion(Rgn,TWMMouse(Message).XPos,TWMMouse(Message).YPos) then
      ControlAtPos(SmallPointToPoint(TWMMouse(Message).Pos))
    else
      _Click(TWMMouse(Message).XPos,TWMMouse(Message).YPos);  
  inherited WndProc(Message);
end;

{ TOQBArea }

procedure TOQBArea.CreateParams(var Params: TCreateParams);
begin
  inherited;
  OnDragOver:=_DragOver;
  OnDragDrop:=_DragDrop;
end;

procedure TOQBArea.SetOptions(Sender: TObject);
var
  AForm : TOQBLinkForm;
  ALink : TOQBLink;
begin
  if TPopupMenu(Sender).Owner is TOQBLink then
  begin
    ALink:=TOQBLink(TPopupMenu(Sender).Owner);
    AForm:=TOQBLinkForm.Create(Application);
    AForm.txtTable1.Caption:=ALink.tbl1.FTableName;
    AForm.txtCol1.Caption:=ALink.fldNam1;
    AForm.txtTable2.Caption:=ALink.tbl2.FTableName;
    AForm.txtCol2.Caption:=ALink.fldNam2;
    AForm.CboOpt.ItemIndex:=ALink.FLinkOpt;
    case ALink.FLinkType of
       0 : AForm.Label2.OnClick(nil);
       1 : AForm.Label3.OnClick(nil);
    end;
    if AForm.ShowModal=mrOk then
    begin
      ALink.FLinkOpt:=AForm.CboOpt.ItemIndex;
      ALink.FLinkType:=AForm.JoinType;
    end;
    AForm.Free;
  end;
end;

procedure TOQBArea.InsertTable(X,Y: Integer);
var
  NewTable: TOQBTable;
begin
  if FindTable(TOQBForm(GetParentForm(Self)).QBTables.Items[TOQBForm(GetParentForm(Self)).QBTables.ItemIndex])<>nil then
  begin
    ShowMessage('This table is already inserted.');
    Exit;
  end;
  NewTable:=TOQBTable.Create(Self);
  NewTable.Parent:=Self;
  try
    NewTable.Activate(TOQBForm(GetParentForm(Self)).QBTables.Items[TOQBForm(GetParentForm(Self)).QBTables.ItemIndex],
                      X,Y);
  except
    NewTable.Free;
  end;
end;

function TOQBArea.InsertLink(_tbl1,_tbl2: TOQBTable; _fldN1,_fldN2: Integer):TOQBLink;
begin
  Result:=TOQBLink.Create(Self);
  with Result do
  begin
    Parent:=Self;
    tbl1:=_tbl1;
    tbl2:=_tbl2;
    fldN1:=_fldN1;
    fldN2:=_fldN2;
    fldNam1:=tbl1.FLbx.Items[fldN1];
    fldNam2:=tbl2.FLbx.Items[fldN2];
  end;
  if FindLink(Result) then
  begin
    ShowMessage('These tables are already linked.');
    Result.Free;
    Result:=nil;
    Exit;
  end;
  with Result do
  begin
    tbl1.FLbx.SelectItemBold(fldN1);
    tbl1.FLbx.Refresh;
    tbl2.FLbx.SelectItemBold(fldN2);
    tbl2.FLbx.Refresh;
    OnDragOver:=_DragOver;
    OnDragDrop:=_DragDrop;
  end;
  ReboundLink(Result);
  Result.Visible:=True;
end;

function TOQBArea.FindTable(TableName:string):TOQBTable;
var
  i : integer;
  TempTable : TOQBTable;
begin
  Result:=nil;
  for i:=ControlCount-1 downto 0 do
    if Controls[i] is TOQBTable then
    begin
      TempTable:=TOQBTable(Controls[i]);
      if (TempTable.FTableName=TableName) then
      begin
        Result:=TempTable;
        Exit;
      end;
    end;
end;

function TOQBArea.FindLink(Link:TOQBLink):boolean;
var
  i : integer;
  TempLink : TOQBLink;
begin
  Result:=false;
  for i:=ControlCount-1 downto 0 do
    if Controls[i] is TOQBLink then
    begin
      TempLink:=TOQBLink(Controls[i]);
      if (TempLink<>Link) then
        if (((TempLink.tbl1=Link.tbl1) and (TempLink.fldN1=Link.fldN1))
            and
           ((TempLink.tbl2=Link.tbl2) and (TempLink.fldN2=Link.fldN2)))
           or
           (((TempLink.tbl1=Link.tbl2) and (TempLink.fldN1=Link.fldN2))
            and
           ((TempLink.tbl2=Link.tbl1) and (TempLink.fldN2=Link.fldN1)))
        then
        begin
          Result:=true;
          Exit;
        end;
    end;
end;

function  TOQBArea.FindOtherLink(Link:TOQBLink;Tbl:TOQBTable;FldN:integer):boolean;
var
  i         : integer;
  OtherLink : TOQBLink;
begin
  Result:=false;
  for i:=ControlCount-1 downto 0 do
    if Controls[i] is TOQBLink then
    begin
      OtherLink:=TOQBLink(Controls[i]);
      if (OtherLink<>Link) then
        if ((OtherLink.tbl1=Tbl) and (OtherLink.fldN1=FldN))
           or
           ((OtherLink.tbl2=Tbl) and (OtherLink.fldN2=FldN))
        then
        begin
          Result:=true;
          Exit;
        end;
    end;
end;

procedure TOQBArea.ReboundLink(Link:TOQBLink);
var
  X1,X2,
  Y1,Y2  : integer;
begin
  Link.PopMenu.Items[0].Caption:=Link.tbl1.FTableName+' :: '+Link.tbl2.FTableName;
  with Link do
  begin
    if Tbl1=Tbl2 then
      begin
        X1:=Tbl1.Left+Tbl1.Width;
        X2:=Tbl1.Left+Tbl1.Width+Hand;
      end
    else
      begin
        if Tbl1.Left<Tbl2.Left then
          begin
            if Tbl1.Left+Tbl1.Width+Hand<Tbl2.Left then
              begin    //A
                X1:=Tbl1.Left+Tbl1.Width;
                X2:=Tbl2.Left;
                LnkX:=1;
              end
            else
              begin    //B
                if Tbl1.Left+Tbl1.Width>Tbl2.Left+Tbl2.Width then
                  begin
                    X1:=Tbl2.Left+Tbl2.Width;
                    X2:=Tbl1.Left+Tbl1.Width+Hand;
                    LnkX:=3;
                  end
                else
                  begin
                    X1:=Tbl1.Left+Tbl1.Width;
                    X2:=Tbl2.Left+Tbl2.Width+Hand;
                    LnkX:=2;
                  end;
              end;
          end
        else
          begin
            if Tbl2.Left+Tbl2.Width+Hand>Tbl1.Left then
              begin    //C
                if Tbl2.Left+Tbl2.Width>Tbl1.Left+Tbl1.Width then
                  begin
                    X1:=Tbl1.Left+Tbl1.Width;
                    X2:=Tbl2.Left+Tbl2.Width+Hand;
                    LnkX:=2;
                  end
                else
                  begin
                    X1:=Tbl2.Left+Tbl2.Width;
                    X2:=Tbl1.Left+Tbl1.Width+Hand;
                    LnkX:=3;
                  end;
              end