{*******************************************************} { } { Delphi Visual Component Library } { QBuilder dialog component } { } { Copyright (c) 1996-2003 Sergey Orlik } { } { Written by: } { Sergey Orlik } { product manager } { Russia, C.I.S. and Baltic States (former USSR) } { Borland Moscow office } { Internet: support@fast-report.com, } { sorlik@borland.com } { http://www.fast-report.com } { } { Converted to Lazarus/Free Pascal by Jean Patrick } { Data: 14/02/2013 } { E-mail: jpsoft-sac-pa@hotmail.com } { } { Modifications by Reinier Olislagers, 2014 } {*******************************************************} unit QBuilder; {$IFDEF FPC} {$MODE Delphi} {$ENDIF} interface uses SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Buttons, ExtCtrls, StdCtrls, ComCtrls, Menus, CheckLst, Grids, DB, DBGrids, LMessages, LCLIntf, LCLType, LCLProc, lclplatformdef, //=== ct9999 ========= GraphType, InterfaceBase; type TOQBbutton = (bSelectDBDialog, bOpenDialog, bSaveDialog, bRunQuery, bSaveResultsDialog); TOQBbuttons = set of TOQBbutton; TOQBEngine = class; { TOQBuilderDialog } TOQBuilderDialog = class(TComponent) private FDatabase: string; FSystemTables: Boolean; FOQBForm: TForm; FSQL: TStrings; FOQBEngine: TOQBEngine; FShowButtons: TOQBbuttons; procedure SetOQBEngine(const Value: TOQBEngine); protected procedure Notification(AComponent: TComponent; Operation: TOperation); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function Execute: Boolean; virtual; property SQL: TStrings read FSQL; property SystemTables: Boolean read FSystemTables write FSystemTables default False; property Database: string read FDatabase write FDatabase; published property OQBEngine: TOQBEngine read FOQBEngine write SetOQBEngine; property ShowButtons: TOQBbuttons read FShowButtons write FShowButtons default [bSelectDBDialog, bOpenDialog, bSaveDialog, bRunQuery, bSaveResultsDialog]; end; TOQBEngine = class(TComponent) private FDatabaseName: string; FUserName: string; FPassword: string; FShowSystemTables: Boolean; FTableList: TStringList; FAliasList: TStringList; FFieldList: TStringList; FSQL: TStringList; FSQLcolumns: TStringList; FSQLcolumns_table: TStringList; FSQLcolumns_func: TStringList; FSQLfrom: TStringList; FSQLwhere: TStringList; FSQLgroupby: TStringList; FSQLorderby: TStringList; FUseTableAliases: Boolean; FOQBDialog: TOQBuilderDialog; procedure SetShowSystemTables(const Value: Boolean); protected procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure SetDatabaseName(const Value: string); virtual; procedure SetUserName(const Value: string); virtual; procedure SetPassword(const Value: string); virtual; procedure SetQuerySQL(const Value: string); virtual; abstract; procedure GenerateAliases; virtual; // Read list of tables (system tables etc) into FTableList procedure ReadTableList; virtual; abstract; procedure ReadFieldList(const ATableName: string); virtual; abstract; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function SelectDatabase: Boolean; virtual; abstract; function GenerateSQL: string; virtual; procedure ClearQuerySQL; virtual; abstract; function ResultQuery: TDataSet; virtual; abstract; procedure OpenResultQuery; virtual; abstract; procedure CloseResultQuery; virtual; abstract; procedure SaveResultQueryData; virtual; abstract; // All tables in the database property TableList: TStringList read FTableList; property AliasList: TStringList read FAliasList; property FieldList: TStringList read FFieldList; property SQL: TStringList read FSQL; property SQLcolumns: TStringList read FSQLcolumns; property SQLcolumns_table: TStringList read FSQLcolumns_table; property SQLcolumns_func: TStringList read FSQLcolumns_func; property SQLfrom: TStringList read FSQLfrom; property SQLwhere: TStringList read FSQLwhere; property SQLgroupby: TStringList read FSQLgroupby; property SQLorderby: TStringList read FSQLorderby; property UserName: string read FUserName write SetUserName; property Password: string read FPassword write SetPassword; published property DatabaseName: string read FDatabaseName write SetDatabaseName; property ShowSystemTables: Boolean read FShowSystemTables write SetShowSystemTables default False; property UseTableAliases: Boolean read FUseTableAliases write FUseTableAliases default True; end; type TArr = array [0..0] of Integer; PArr = ^TArr; { TOQBLbx } TOQBLbx = class(TCheckListBox) private FArrBold: PArr; FLoading: Boolean; // procedure CNDrawItem(var Message: TWMDrawItem); message CN_DrawItem; procedure WMLButtonDown(var Message: TLMLButtonDblClk); message LM_LBUTTONDOWN; procedure WMRButtonDown(var Message: TLMRButtonDblClk); message LM_RBUTTONDOWN; function GetCheckW: Integer; procedure AllocArrBold; procedure SelectItemBold(Item: Integer); procedure UnSelectItemBold(Item: Integer); function GetItemY(Item: Integer): Integer; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; // procedure ClickCheck; override; procedure ItemClick(const AIndex: Integer); override; end; TOQBTable = class(TPanel) private ScreenDC: HDC; OldX: Integer; OldY: Integer; OldLeft: Integer; OldTop: Integer; ClipRgn: HRGN; ClipRect: TRect; MoveRect: TRect; Moving: Boolean; FCloseBtn: TSpeedButton; FUnlinkBtn: TSpeedButton; FLbx: TOQBLbx; FTableName: string; FTableAlias: string; PopMenu: TPopupMenu; procedure WMRButtonDown(var Message: TLMRButtonDblClk); message LM_RBUTTONDOWN; function Activate(const ATableName: string; X, Y: Integer): Boolean; function GetRowY(FldN: Integer):Integer; procedure _CloseBtn(Sender: TObject); procedure _UnlinkBtn(Sender: TObject); procedure _SelectAll(Sender: TObject); procedure _UnSelectAll(Sender: TObject); procedure _DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure _DragDrop(Sender, Source: TObject; X, Y: Integer); protected procedure SetParent(AParent: TWinControl); override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; property Align; public constructor Create(AOwner: TComponent); override; procedure Paint; override; end; { TOQBLink } TOQBLink = class(TShape) private Tbl1: TOQBTable; Tbl2: TOQBTable; FldN1: Integer; FldN2: Integer; FldNam1: string; FldNam2: string; FLinkOpt: Integer; FLinkType: Integer; LnkX: Byte; LnkY: Byte; Rgn: HRgn; PopMenu: TPopupMenu; procedure _Click(X, Y: Integer); procedure CMHitTest(var Message: TCMHitTest); message CM_HitTest; function ControlAtPos(const Pos: TPoint): TControl; function PtInRegion(RGN: HRGN; X, Y: Integer) : Boolean; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure WndProc(var Message: TLMessage); override; procedure Paint; override; end; TOQBArea = class(TScrollBox) public procedure CreateParams(var Params: TCreateParams); override; procedure SetOptions(Sender: TObject); procedure InsertTable(X, Y: Integer); function InsertLink(_tbl1, _tbl2: TOQBTable; _fldN1, _fldN2: Integer): TOQBLink; function FindTable(const TableName: string): TOQBTable; function FindLink(Link: TOQBLink): Boolean; function FindOtherLink(Link: TOQBLink; Tbl: TOQBTable; FldN: Integer): Boolean; procedure ReboundLink(Link: TOQBLink); procedure ReboundLinks4Table(ATable: TOQBTable); procedure Unlink(Sender: TObject); procedure UnlinkTable(ATable: TOQBTable); procedure _DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure _DragDrop(Sender, Source: TObject; X, Y: Integer); end; TOQBGrid = class(TStringGrid) public CurrCol: Integer; IsEmpty: Boolean; procedure CreateParams(var Params: TCreateParams); override; procedure WndProc(var Message: TLMessage); override; function MaxSW(const s1, s2: string): Integer; procedure InsertDefault(aCol: Integer); procedure Insert(aCol: Integer; const aField, aTable: string); function FindColumn(const sCol: string): Integer; function FindSameColumn(aCol: Integer): Boolean; procedure RemoveColumn(aCol: Integer); procedure RemoveColumn4Tbl(const Tbl: string); procedure ClickCell(X, Y: Integer); function SelectCell(ACol, ARow: Integer): Boolean; override; procedure _DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure _DragDrop(Sender, Source: TObject; X, Y: Integer); end; TOQBForm = class(TForm) QBPanel: TPanel; Pages: TPageControl; TabColumns: TTabSheet; QBTables: TListBox; VSplitter: TSplitter; mnuTbl: TPopupMenu; Remove1: TMenuItem; mnuFunc: TPopupMenu; Nofunction1: TMenuItem; N1: TMenuItem; Average1: TMenuItem; Count1: TMenuItem; Minimum1: TMenuItem; Maximum1: TMenuItem; Sum1: TMenuItem; mnuGroup: TPopupMenu; Group1: TMenuItem; mnuSort: TPopupMenu; Sort1: TMenuItem; N2: TMenuItem; Ascending1: TMenuItem; Descending1: TMenuItem; mnuShow: TPopupMenu; Show1: TMenuItem; HSplitter: TSplitter; TabSQL: TTabSheet; MemoSQL: TMemo; TabResults: TTabSheet; ResDBGrid: TDBGrid; ResDataSource: TDataSource; QBBar: TToolBar; btnNew: TToolButton; btnOpen: TToolButton; btnSave: TToolButton; ToolButton1: TToolButton; btnTables: TToolButton; ToolImages: TImageList; btnPages: TToolButton; ToolButton2: TToolButton; DlgSave: TSaveDialog; DlgOpen: TOpenDialog; btnDB: TToolButton; btnSQL: TToolButton; btnResults: TToolButton; ToolButton3: TToolButton; btnAbout: TToolButton; btnSaveResults: TToolButton; btnOK: TToolButton; btnCancel: TToolButton; ToolButton6: TToolButton; procedure mnuFunctionClick(Sender: TObject); procedure mnuGroupClick(Sender: TObject); procedure mnuRemoveClick(Sender: TObject); procedure mnuShowClick(Sender: TObject); procedure mnuSortClick(Sender: TObject); procedure btnNewClick(Sender: TObject); procedure btnOpenClick(Sender: TObject); procedure btnSaveClick(Sender: TObject); procedure btnTablesClick(Sender: TObject); procedure btnPagesClick(Sender: TObject); procedure btnDBClick(Sender: TObject); procedure btnSQLClick(Sender: TObject); procedure btnResultsClick(Sender: TObject); procedure btnAboutClick(Sender: TObject); procedure btnSaveResultsClick(Sender: TObject); procedure btnOKClick(Sender: TObject); procedure btnCancelClick(Sender: TObject); protected QBDialog: TOQBuilderDialog; QBArea: TOQBArea; QBGrid: TOQBGrid; procedure CreateParams(var Params: TCreateParams); override; procedure ClearAll; procedure OpenDatabase; procedure SelectDatabase; end; implementation {$R QBBUTTON.RES} uses QBLnkFrm, QBAbout; {$R *.lfm} resourcestring sMainCaption = 'QBuilder'; sNotValidTableParent = 'Parent must be TScrollBox or its descendant.'; const cFld = 0; cTbl = 1; cShow = 2; cSort = 3; cFunc = 4; cGroup = 5; sShow = 'Show'; sGroup = 'Group'; sSort: array [1..3] of string = ('', 'Asc', 'Desc'); sFunc: array [1..6] of string = ('', 'Avg', 'Count', 'Max', 'Min', 'Sum'); sLinkOpt: array [0..5] of string = ('=', '<', '>', '=<', '=>', '<>'); sOuterJoin: array [1..3] of string = (' LEFT OUTER JOIN ', ' RIGHT OUTER JOIN ', ' FULL OUTER JOIN '); Hand = 15; Hand2 = 12; QBSignature = '# QBuilder'; { TQueryBuilderDialog} constructor TOQBuilderDialog.Create(AOwner: TComponent); begin inherited; FSystemTables := False; FShowButtons := [bSelectDBDialog, bOpenDialog, bSaveDialog, bRunQuery, bSaveResultsDialog]; FSQL := TStringList.Create; end; destructor TOQBuilderDialog.Destroy; begin if FSQL <> nil then FSQL.Free; FOQBEngine := nil; inherited; end; function TOQBuilderDialog.Execute: Boolean; begin Result := False; if (not Assigned(FOQBForm)) and Assigned((FOQBEngine)) then begin TOQBForm(FOQBForm) := TOQBForm.Create(Application); TOQBForm(FOQBForm).QBDialog := Self; TOQBForm(FOQBForm).btnDB.Visible := bSelectDBDialog in FShowButtons; TOQBForm(FOQBForm).btnOpen.Visible := bOpenDialog in FShowButtons; TOQBForm(FOQBForm).btnSave.Visible := bSaveDialog in FShowButtons; TOQBForm(FOQBForm).btnResults.Visible := bRunQuery in FShowButtons; TOQBForm(FOQBForm).btnSaveResults.Visible := bSaveResultsDialog in FShowButtons; if OQBEngine.DatabaseName <> EmptyStr then TOQBForm(FOQBForm).OpenDatabase else TOQBForm(FOQBForm).SelectDatabase; if TOQBForm(FOQBForm).ShowModal = mrOk then begin FSQL.Assign(TOQBForm(FOQBForm).MemoSQL.Lines); Result := True; end; OQBEngine.CloseResultQuery; FOQBForm.Free; FOQBForm := nil; end; end; procedure TOQBuilderDialog.Notification(AComponent: TComponent; Operation: TOperation); begin inherited; if (AComponent = FOQBEngine) and (Operation = opRemove) then FOQBEngine := nil; end; procedure TOQBuilderDialog.SetOQBEngine(const Value: TOQBEngine); begin if FOQBEngine <> nil then FOQBEngine.FOQBDialog := nil; FOQBEngine := Value; if FOQBEngine <> nil then begin FOQBEngine.FOQBDialog := Self; FOQBEngine.FreeNotification(Self); end; end; { TOQBEngine } constructor TOQBEngine.Create(AOwner: TComponent); begin inherited; FShowSystemTables := False; FTableList := TStringList.Create; FAliasList := TStringList.Create; FFieldList := TStringList.Create; FSQL := TStringList.Create; FSQLcolumns := TStringList.Create; FSQLcolumns_table := TStringList.Create; FSQLcolumns_func := TStringList.Create; FSQLfrom := TStringList.Create; FSQLwhere := TStringList.Create; FSQLgroupby := TStringList.Create; FSQLorderby := TStringList.Create; FUseTableAliases := True; end; destructor TOQBEngine.Destroy; begin FSQL.Free; FSQLcolumns.Free; FSQLcolumns_table.Free; FSQLcolumns_func.Free; FSQLfrom.Free; FSQLwhere.Free; FSQLgroupby.Free; FSQLorderby.Free; FFieldList.Free; FAliasList.Free; FTableList.Free; FreeNotification(Self); inherited; end; procedure TOQBEngine.Notification(AComponent: TComponent; Operation: TOperation); begin inherited; if (AComponent = FOQBDialog) and (Operation = opRemove) then FOQBDialog := nil; end; procedure TOQBEngine.SetDatabaseName(const Value: string); begin TableList.Clear; FDatabaseName := Value; if ResultQuery.Active then ResultQuery.Close; end; procedure TOQBEngine.SetUserName(const Value: string); begin FUserName := Value; end; procedure TOQBEngine.SetPassword(const Value: string); begin FPassword := Value; end; procedure TOQBEngine.SetShowSystemTables(const Value: Boolean); begin if FShowSystemTables <> Value then FShowSystemTables := Value; end; procedure TOQBEngine.GenerateAliases; var i, j: Integer; s, s1: string; begin FAliasList.Clear; for i := 0 to FTableList.Count - 1 do begin s := ' '; s[1] := FTableList[i][1]; // get the first character [1] of the table name [i] if FAliasList.IndexOf(s) = -1 then FAliasList.Add(s) else begin j := 1; repeat Inc(j); s1 := s + IntToStr(j); until FAliasList.IndexOf(s1) = -1; FAliasList.Add(s1); end; end; end; function TOQBEngine.GenerateSQL: string; var s: string; i: Integer; begin SQL.Clear; s := 'SELECT '; for i := 0 to SQLcolumns.Count - 1 do begin if SQLcolumns_func[i] = EmptyStr then s := s + SQLcolumns[i] else s := s + SQLcolumns_func[i] + '(' + SQLcolumns[i] + ')'; if (i < SQLcolumns.Count - 1) then s := s + ', '; if (Length(s) > 70) or (i = SQLcolumns.Count - 1) then begin SQL.Add(s); s := ' '; end; end; s := 'FROM '; for i := 0 to SQLfrom.Count - 1 do begin s := s + SQLfrom[i]; if (i < SQLfrom.Count - 1) then s := s + ', '; if (Length(s) > 70) or (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 + SQLwhere[i] + ' AND ' else s := s + SQLwhere[i]; if (Length(s) > 70) or (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 (Length(s) > 70) or (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 (Length(s) > 70) or (i = SQLorderby.Count - 1) then begin SQL.Add(s); s := ' '; end; end; Result := SQL.Text; end; { TOQBLbx } constructor TOQBLbx.Create(AOwner: TComponent); begin inherited; Style := lbStandard; ParentFont := False; Font.Style := []; Font.Size := 8; FArrBold := nil; FLoading := False; end; destructor TOQBLbx.Destroy; begin if FArrBold <> nil then FreeMem(FArrBold); inherited; end; function TOQBLbx.GetCheckW: Integer; begin Result := GetCheckW; end; {procedure TOQBLbx.CNDrawItem(var Message: TWMDrawItem); begin with Message.DrawItemStruct^ do begin rcItem.Left := rcItem.Left + GetCheckW; //*** check Canvas.Font := Font; Canvas.Brush := Brush; if (Integer(itemID) >= 0) and (Integer(itemID) <= Items.Count - 1) then begin if (FArrBold <> nil) then if FArrBold^[Integer(itemID)] = 1 then Canvas.Font.Style := [fsBold]; DrawItem(itemID, rcItem, []); if (FArrBold <> nil) then if FArrBold^[Integer(itemID)] = 1 then Canvas.Font.Style := []; end else Canvas.FillRect(rcItem); end; end;} procedure TOQBLbx.WMLButtonDown(var Message: TLMLButtonDblClk); begin inherited; BeginDrag(False); end; procedure TOQBLbx.WMRButtonDown(var Message: TLMRButtonDblClk); 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); 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.ItemClick(const AIndex: Integer); var iCol: Integer; begin inherited ItemClick(AIndex); if FLoading then Exit; if Checked[ItemIndex] then begin TOQBForm(GetParentForm(Self)).QBGrid.Insert( TOQBForm(GetParentForm(Self)).QBGrid.ColCount, Items[ItemIndex], TOQBTable(Parent).FTableName); 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 if FArrBold[Item] = 0 then FArrBold^[Item] := 1; end; procedure TOQBLbx.UnSelectItemBold(Item: Integer); begin if FArrBold <> nil then if FArrBold[Item] = 1 then FArrBold^[Item] := 0; 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; 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 all'; FLbx := TOQBLbx.Create(Self); FLbx.Parent := Self; FLbx.Style := lbStandard; 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; procedure TOQBTable.WMRButtonDown(var Message: TLMLButtonDblClk); 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; 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; case WidgetSet.LCLPlatform of lpGtk: FLbx.Height := ((FLbx.ItemHeight + 6) * FLbx.Items.Count) + 4; lpGtk2: FLbx.Height := ((FLbx.ItemHeight + 6) * FLbx.Items.Count) + 4; lpWin32: FLbx.Height := ((FLbx.ItemHeight + 4) * FLbx.Items.Count) + 4; lpCarbon:FLbx.Height := ((FLbx.ItemHeight + 8) * FLbx.Items.Count) + 4; lpQT: FLbx.Height := ((FLbx.ItemHeight + 8) * FLbx.Items.Count) + 4; lpfpGUI: FLbx.Height := ((FLbx.ItemHeight + 8) * FLbx.Items.Count) + 4; else FLbx.Height := ((FLbx.ItemHeight + 8) * FLbx.Items.Count) + 4; end; 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 + 22;//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; Color := clForm; 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; 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; 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); 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 if nRow <> FLbx.ItemIndex then TOQBArea(Parent).InsertLink(Self, Self, FLbx.ItemIndex, nRow); 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; end; procedure TOQBTable.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited; 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; 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); MoveRect.BottomRight := Parent.ClientToScreen(MoveRect.BottomRight); DrawFocusRect(ScreenDC, MoveRect); end; end; procedure TOQBTable.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited; if Button = mbLeft then begin ReleaseCapture; DrawFocusRect(ScreenDC, MoveRect); 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; 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; 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; end; destructor TOQBLink.Destroy; begin DeleteObject(Rgn); inherited; 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; 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; function TOQBLink.PtInRegion(RGN: HRGN; X, Y: Integer): Boolean; {$IFDEF MSWINDOWS} begin Result := LCLIntf.PtInRegion(RGN, X, Y); {$ELSE} var APoint : TPoint; ARect : TRect; begin GetRgnBox(RGN, @ARect); APoint.X := X; APoint.Y := Y; Result := LclIntf.PtInRect(ARect, APoint); {$ENDIF} end; procedure TOQBLink.WndProc(var Message: TLMessage); begin if (Message.Msg = LM_RBUTTONDOWN) or (Message.Msg = LM_LBUTTONDOWN) then if not PtInRegion(Rgn, TLMMouse(Message).XPos, TLMMouse(Message).YPos) then ControlAtPos(SmallPointToPoint(TLMMouse(Message).Pos)) else _Click(TLMMouse(Message).XPos, TLMMouse(Message).YPos); inherited; 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.RadioOpt.ItemIndex := ALink.FLinkOpt; AForm.RadioType.ItemIndex := ALink.FLinkType; if AForm.ShowModal = mrOk then begin ALink.FLinkOpt := AForm.RadioOpt.ItemIndex; ALink.FLinkType := AForm.RadioType.ItemIndex; 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; Application.ProcessMessages; // importante no gtk2 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(const 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 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 } procedure TOQBGrid.CreateParams(var Params: TCreateParams); begin inherited; FocusRectVisible := False; DefaultColWidth := 64; Options := [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goColSizing, goColMoving]; ColCount := 2; RowCount := 6; Height := Parent.ClientHeight; // DefaultRowHeight := Parent.Height div (6 + 1) - GridLineWidth; DefaultRowHeight := 20; Cells[0, cFld] := 'Field'; Cells[0, cTbl] := 'Table'; Cells[0, cShow] := 'Show'; Cells[0, cSort] := 'Sort'; Cells[0, cFunc] := 'Function'; Cells[0, cGroup] := 'Group'; OnDragOver := _DragOver; OnDragDrop := _DragDrop; IsEmpty := True; end; procedure TOQBGrid.WndProc(var Message: TLMessage); begin if (Message.Msg = LM_RBUTTONDOWN) then ClickCell(TLMMouse(Message).XPos, TLMMouse(Message).YPos); inherited; 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.InsertDefault(aCol: Integer); begin Cells[aCol, cShow] := sShow; Cells[aCol, cSort] := ''; Cells[aCol, cFunc] := ''; Cells[aCol, cGroup] := ''; end; procedure TOQBGrid.Insert(aCol: Integer; const aField, aTable: string); var i: Integer; begin if IsEmpty then begin IsEmpty := False; aCol := 1; Cells[aCol, cFld] := aField; Cells[aCol, cTbl] := aTable; InsertDefault(aCol); end else begin if aCol = -1 then begin ColCount := ColCount + 1; aCol := ColCount - 1; Cells[aCol, cFld] := aField; Cells[aCol, cTbl] := aTable; InsertDefault(aCol); end else begin ColCount := ColCount + 1; for i := ColCount - 1 downto aCol + 1 do MoveColRow(True,i - 1, i); Cells[aCol, cFld] := aField; Cells[aCol, cTbl] := aTable; InsertDefault(aCol); end; //* Fix StringGrid Bug * if aCol > 1 then ColWidths[aCol - 1] := MaxSW(Cells[aCol - 1, cFld], Cells[aCol - 1, cTbl]) + 8; if aCol < ColCount - 1 then ColWidths[aCol + 1] := MaxSW(Cells[aCol + 1, cFld], Cells[aCol + 1, cTbl]) + 8; ColWidths[ColCount - 1] := MaxSW(Cells[ColCount - 1, cFld], Cells[ColCount - 1, cTbl]) + 8; end; ColWidths[aCol] := MaxSW(aTable, aField) + 8; end; function TOQBGrid.FindColumn(const sCol: string): Integer; var i: Integer; begin Result := -1; for i := 1 to ColCount - 1 do if Cells[i, cFld] = sCol then begin Result := i; Exit; end; end; function TOQBGrid.FindSameColumn(aCol: Integer): Boolean; var i: Integer; begin Result := False; for i := 1 to ColCount - 1 do if i = aCol then Continue else if Cells[i, cFld] = Cells[aCol, cFld] then begin Result := True; Exit; end; end; procedure TOQBGrid.RemoveColumn(aCol: Integer); var i: Integer; begin if (ColCount > 2) then DeleteCol(aCol) else begin for i := 0 to RowCount - 1 do Cells[1, i] := ''; IsEmpty := True; end; end; procedure TOQBGrid.RemoveColumn4Tbl(const Tbl: string); var i: Integer; begin for i := ColCount - 1 downto 1 do if Cells[i, cTbl] = Tbl then RemoveColumn(i); 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 < ColCount) and (not IsEmpty) then begin if (Cells[mCol, 0] = '*') and (mRow <> cFld) then Exit; case mRow of cFld: TOQBForm(GetParentForm(Self)).mnuTbl.Popup(P.X, P.Y); cShow: begin TOQBForm(GetParentForm(Self)).mnuShow.Items[0].Checked := Cells[mCol, cShow] = sShow; TOQBForm(GetParentForm(Self)).mnuShow.Popup(P.X, P.Y); end; cSort: begin if Cells[mCol, cSort] = sSort[1] then TOQBForm(GetParentForm(Self)).mnuSort.Items[0].Checked := True else if Cells[mCol, cSort] = sSort[2] then TOQBForm(GetParentForm(Self)).mnuSort.Items[2].Checked := True else TOQBForm(GetParentForm(Self)).mnuSort.Items[3].Checked := True; TOQBForm(GetParentForm(Self)).mnuSort.Popup(P.X, P.Y); end; cFunc: begin if Cells[mCol, cFunc] = sFunc[1] then TOQBForm(GetParentForm(Self)).mnuFunc.Items[0].Checked := True else if Cells[mCol, cFunc] = sFunc[2] then TOQBForm(GetParentForm(Self)).mnuFunc.Items[2].Checked := True else if Cells[mCol, cFunc] = sFunc[3] then TOQBForm(GetParentForm(Self)).mnuFunc.Items[3].Checked := True else if Cells[mCol, cFunc] = sFunc[4] then TOQBForm(GetParentForm(Self)).mnuFunc.Items[4].Checked := True else if Cells[mCol, cFunc] = sFunc[5] then TOQBForm(GetParentForm(Self)).mnuFunc.Items[5].Checked := True else TOQBForm(GetParentForm(Self)).mnuFunc.Items[6].Checked := True; TOQBForm(GetParentForm(Self)).mnuFunc.Popup(P.X, P.Y); end; cGroup: begin TOQBForm(GetParentForm(Self)).mnuGroup.Items[0].Checked := Cells[mCol, cGroup] = sGroup; TOQBForm(GetParentForm(Self)).mnuGroup.Popup(P.X, P.Y); end; end; end; end; function TOQBGrid.SelectCell(ACol, ARow: Integer): Boolean; begin inherited SelectCell(ACol, ARow); Result := ARow > cGroup; 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); end; end; { TOQBForm } procedure TOQBForm.CreateParams(var Params: TCreateParams); begin inherited; QBArea := TOQBArea.Create(Self); QBArea.Parent := QBPanel; QBArea.Align := alClient; QBArea.Color := $009E9E9E; QBGrid := TOQBGrid.Create(Self); QBGrid.DefaultRowHeight := 22; QBGrid.DefaultColWidth := 150; QBGrid.Parent := TabColumns; QBGrid.Align := alClient; VSplitter.Tag := VSplitter.Left; HSplitter.Tag := HSplitter.Top; Application.ProcessMessages; end; procedure TOQBForm.mnuFunctionClick(Sender: TObject); var Item: TMenuItem; begin if Sender is TMenuItem then begin Item := (Sender as TMenuItem); if not Item.Checked then begin Item.Checked := True; QBGrid.Cells[QBGrid.CurrCol, cFunc] := sFunc[Item.Tag]; end; end; end; procedure TOQBForm.mnuGroupClick(Sender: TObject); begin if mnuGroup.Items[0].Checked then begin QBGrid.Cells[QBGrid.CurrCol, cGroup] := ''; mnuGroup.Items[0].Checked := False; end else begin QBGrid.Cells[QBGrid.CurrCol, cGroup] := sGroup; mnuGroup.Items[0].Checked := True; end; end; procedure TOQBForm.mnuRemoveClick(Sender: TObject); var TempTable: TOQBTable; begin TempTable := QBArea.FindTable(QBGrid.Cells[QBGrid.CurrCol, cTbl]); if not QBGrid.FindSameColumn(QBGrid.CurrCol) then TempTable.FLbx.Checked[TempTable.FLbx.Items.IndexOf(QBGrid.Cells[QBGrid.CurrCol, cFld])] := False; QBGrid.RemoveColumn(QBGrid.CurrCol); QBGrid.Refresh; // fix for StringGrid bug end; procedure TOQBForm.mnuShowClick(Sender: TObject); begin if mnuShow.Items[0].Checked then begin QBGrid.Cells[QBGrid.CurrCol, cShow] := ''; mnuShow.Items[0].Checked := False; end else begin QBGrid.Cells[QBGrid.CurrCol, cShow] := sShow; mnuShow.Items[0].Checked := True; end; end; procedure TOQBForm.mnuSortClick(Sender: TObject); var Item: TMenuItem; begin if Sender is TMenuItem then begin Item := (Sender as TMenuItem); if not Item.Checked then begin Item.Checked := True; QBGrid.Cells[QBGrid.CurrCol, cSort] := sSort[Item.Tag]; end; end; 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 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: Integer; s, ss: string; TempDatabaseName: string; ShowSystemTables: Boolean; NewTable: TOQBTable; TableName: string; X, Y: Integer; NewLink: TOQBLink; Table1, Table2: TOQBTable; FieldN1, FieldN2: Integer; ColField, ColTable: string; StrList: TStringList; function GetNextVal(var s: string): string; var p: Integer; begin Result := EmptyStr; p := Pos(',', s); if p = 0 then begin p := Pos(';', s); if p = 0 then Exit; end; Result := System.Copy(s, 1, p - 1); System.Delete(s, 1, p); end; begin j := -1; if not DlgOpen.Execute then Exit; StrList := TStringList.Create; StrList.LoadFromFile(DlgOpen.FileName); if StrList[0] <> QBSignature then begin ShowMessage('File ' + DlgOpen.FileName + ' is not QBuilder''s query file.'); StrList.Free; Exit; end; ClearAll; try s := StrList[3]; // read options if s = '+' then WindowState := wsMaximized else begin WindowState := wsNormal; Top := StrToInt(GetNextVal(s)); Left := StrToInt(GetNextVal(s)); Height := StrToInt(GetNextVal(s)); Width := StrToInt(GetNextVal(s)); end; s := StrList[4]; btnTables.Down := Boolean(StrToInt(GetNextVal(s))); VSplitter.Visible := btnTables.Down; QBTables.Visible := btnTables.Down; QBTables.Width := StrToInt(GetNextVal(s)); btnPages.Down := Boolean(StrToInt(GetNextVal(s))); HSplitter.Visible := btnPages.Down; Pages.Visible := btnPages.Down; Pages.Height := StrToInt(GetNextVal(s)); s := StrList[6]; // read database TempDatabaseName := GetNextVal(s); ShowSystemTables := Boolean(StrToInt(GetNextVal(s))); QBDialog.OQBEngine.DatabaseName := TempDatabaseName; QBDialog.OQBEngine.ShowSystemTables := ShowSystemTables; OpenDatabase; for i := 8 to StrList.Count - 1 do // read tables begin if StrList[i] = '[Links]' then begin j := i + 1; Break; end; s := StrList[i]; TableName := GetNextVal(s); Y := StrToInt(GetNextVal(s)); X := StrToInt(GetNextVal(s)); NewTable := TOQBTable.Create(Self); NewTable.Parent := QBArea; try NewTable.Activate(TableName, X, Y); NewTable.FLbx.FLoading := True; for ii := 0 to NewTable.FLbx.Items.Count - 1 do begin ss := GetNextVal(s); if ss <> EmptyStr then NewTable.FLbx.Checked[ii] := Boolean(StrToInt(ss)); end; NewTable.FLbx.FLoading := False; except NewTable.Free; end; end; if j <> -1 then for i := j to StrList.Count - 1 do // read links begin if StrList[i] = '[Columns]' then begin j := i + 1; Break; end; s := StrList[i]; ss := GetNextVal(s); Table1 := QBArea.FindTable(ss); ss := GetNextVal(s); FieldN1 := StrToInt(ss); ss := GetNextVal(s); Table2 := QBArea.FindTable(ss); ss := GetNextVal(s); FieldN2 := StrToInt(ss); NewLink := QBArea.InsertLink(Table1, Table2, FieldN1, FieldN2); ss := GetNextVal(s); NewLink.FLinkOpt := StrToInt(ss); ss := GetNextVal(s); NewLink.FLinkType := StrToInt(ss); end; if j <> -1 then for i := j to StrList.Count - 1 do // read columns begin if StrList[i] = '[End]' then Break; s := StrList[i]; ii := StrToInt(GetNextVal(s)); ColField := GetNextVal(s); ColTable := GetNextVal(s); QBGrid.Insert(ii, ColField, ColTable); QBGrid.Cells[ii, cShow] := GetNextVal(s); QBGrid.Cells[ii, cSort] := GetNextVal(s); QBGrid.Cells[ii, cFunc] := GetNextVal(s); QBGrid.Cells[ii, cGroup] := GetNextVal(s); end; finally StrList.Free; end; end; procedure TOQBForm.btnSaveClick(Sender: TObject); var i, j: Integer; s: string; TempTable: TOQBTable; TempLink: TOQBLink; StrList: TStringList; begin if not DlgSave.Execute then Exit; StrList := TStringList.Create; StrList.Add(QBSignature); StrList.Add('# Don''t change this file !'); StrList.Add('[Options]'); if WindowState = wsMaximized then s := '+' else s := IntToStr(Top) + ',' + IntToStr(Left) + ',' + IntToStr(Height) + ',' + IntToStr(Width) + ';'; StrList.Add(s); s := IntToStr(Integer(btnTables.Down)) + ',' + IntToStr(QBTables.Width) + ',' + IntToStr(Integer(btnPages.Down)) + ',' + IntToStr(Pages.Height) + ';'; StrList.Add(s); StrList.Add('[Database]'); s := QBDialog.OQBEngine.DatabaseName + ',' + IntToStr(Integer(QBDialog.OQBEngine.ShowSystemTables)) + ';'; StrList.Add(s); StrList.Add('[Tables]'); // save tables for i := 0 to QBArea.ControlCount - 1 do if QBArea.Controls[i] is TOQBTable then begin TempTable := TOQBTable(QBArea.Controls[i]); s := TempTable.FTableName + ',' + IntToStr(TempTable.Top + QBArea.VertScrollBar.ScrollPos) + ',' + IntToStr(TempTable.Left + QBArea.HorzScrollBar.ScrollPos); for j := 0 to TempTable.FLbx.Items.Count - 1 do if TempTable.FLbx.Checked[j] then s := s + ',1' else s := s + ',0'; s := s + ';'; StrList.Add(s); end; StrList.Add('[Links]'); // save links for i := 0 to QBArea.ControlCount - 1 do if QBArea.Controls[i] is TOQBLink then begin TempLink := TOQBLink(QBArea.Controls[i]); s := TempLink.Tbl1.FTableName + ',' + IntToStr(TempLink.FldN1) + ',' + TempLink.Tbl2.FTableName + ',' + IntToStr(TempLink.FldN2) + ',' + IntToStr(TempLink.FLinkOpt) + ',' + IntToStr(TempLink.FLinkType); s := s + ';'; StrList.Add(s); end; StrList.Add('[Columns]'); // save columns if not QBGrid.IsEmpty then for i := 1 to QBGrid.ColCount - 1 do begin s := IntToStr(i) + ',' + QBGrid.Cells[i, cFld] + ',' + QBGrid.Cells[i, cTbl]; s := s + ',' + QBGrid.Cells[i, cShow] + ',' + QBGrid.Cells[i, cSort] + ',' + QBGrid.Cells[i, cFunc] + ',' + QBGrid.Cells[i, cGroup]; s := s + ';'; StrList.Add(s); end; StrList.Add('[End]'); // end of QBuilder information StrList.SaveToFile(DlgSave.FileName); StrList.Free; end; procedure TOQBForm.btnTablesClick(Sender: TObject); begin VSplitter.Visible := TToolButton(Sender).Down; QBTables.Visible := TToolButton(Sender).Down; if not VSplitter.Visible then VSplitter.Tag := VSplitter.Left else VSplitter.Left := VSplitter.Tag; end; procedure TOQBForm.btnPagesClick(Sender: TObject); begin HSplitter.Visible := TToolButton(Sender).Down; Pages.Visible := TToolButton(Sender).Down; if not HSplitter.Visible then HSplitter.Tag := HSplitter.Top else HSplitter.Top := HSplitter.Tag; end; procedure TOQBForm.OpenDatabase; begin try QBDialog.OQBEngine.ReadTableList; QBDialog.OQBEngine.GenerateAliases; QBTables.Items.Assign(QBDialog.OQBEngine.TableList); ResDataSource.DataSet := QBDialog.OQBEngine.ResultQuery; Caption := sMainCaption + ' [' + QBDialog.OQBEngine.DatabaseName + ']'; except // ignore errors end; end; procedure TOQBForm.SelectDatabase; begin if QBDialog.OQBEngine.SelectDatabase then begin ClearAll; QBTables.Items.Clear; OpenDatabase; end end; procedure TOQBForm.btnDBClick(Sender: TObject); begin SelectDatabase; end; procedure TOQBForm.btnSQLClick(Sender: TObject); var Lst, Lst1, Lst2: TStringList; // temporary string lists i: Integer; s: string; tbl1, tbl2: string; Link: TOQBLink; function ExtractName(s: string):string; var p: Integer; begin Result := s; p := Pos('.', s); if p = 0 then Exit; Result := System.Copy(s, 1, p - 1); end; begin if QBGrid.IsEmpty then begin ShowMessage('Columns are not selected.'); Exit; end; Lst := TStringList.Create; try with QBDialog.OQBEngine do begin SQLcolumns.Clear; SQLcolumns_func.Clear; SQLcolumns_table.Clear; SQLfrom.Clear; SQLwhere.Clear; SQLgroupby.Clear; SQLorderby.Clear; end; // SELECT clause with QBGrid do begin for i := 1 to ColCount - 1 do if Cells[i, cShow] = sShow then begin if QBDialog.OQBEngine.UseTableAliases then tbl1 := QBDialog.OQBEngine.AliasList[QBDialog.OQBEngine.TableList.IndexOf(Cells[i, cTbl])] else tbl1 := Cells[i, cTbl]; s := tbl1 + '.' + Cells[i, cFld]; Lst.Add(LowerCase(s)); if Cells[i, cFunc] <> EmptyStr then s := UpperCase(Cells[i, cFunc]) else s := EmptyStr; if QBDialog.OQBEngine.UseTableAliases then QBDialog.OQBEngine.SQLcolumns_table.Add(LowerCase( QBDialog.OQBEngine.AliasList[QBDialog.OQBEngine.TableList.IndexOf(Cells[i, cTbl])])) else QBDialog.OQBEngine.SQLcolumns_table.Add(LowerCase(Cells[i, cTbl])); QBDialog.OQBEngine.SQLcolumns_func.Add(s); end; if Lst.Count = 0 then begin ShowMessage('Columns are not selected.'); Lst.Free; Exit; end; QBDialog.OQBEngine.SQLcolumns.Assign(Lst); Lst.Clear; end; // FROM clause with QBArea do begin Lst1 := TSTringList.Create; // tables in joins Lst2 := TSTringList.Create; // outer joins for i := 0 to ControlCount - 1 do // search tables for joins if Controls[i] is TOQBLink then begin Link := TOQBLink(Controls[i]); if Link.FLinkType > 0 then begin if QBDialog.OQBEngine.UseTableAliases then begin tbl1 := LowerCase(Link.Tbl1.FTableAlias); tbl2 := LowerCase(Link.Tbl2.FTableAlias); end else begin tbl1 := LowerCase(Link.Tbl1.FTableName); tbl2 := LowerCase(Link.Tbl2.FTableName); end; if Lst1.IndexOf(tbl1) = -1 then Lst1.Add(tbl1); if Lst1.IndexOf(tbl2) = -1 then Lst1.Add(tbl2); if QBDialog.OQBEngine.UseTableAliases then Lst2.Add(LowerCase(Link.Tbl1.FTableName) + ' ' + tbl1 + sOuterJoin[Link.FLinkType] + LowerCase(Link.Tbl2.FTableName) + ' ' + tbl2 + ' ON ' + tbl1 + '.' + LowerCase(Link.FldNam1) + sLinkOpt[Link.FLinkOpt] + tbl2 + '.' + LowerCase(Link.FldNam2)) else Lst2.Add(tbl1 + sOuterJoin[Link.FLinkType] + tbl2 + ' ON ' + tbl1 + '.' + LowerCase(Link.FldNam1) + sLinkOpt[Link.FLinkOpt] + tbl2 + '.' + LowerCase(Link.FldNam2)); end; end; for i := 0 to ControlCount - 1 do if Controls[i] is TOQBTable then begin if QBDialog.OQBEngine.UseTableAliases then tbl1 := LowerCase(TOQBTable(Controls[i]).FTableAlias) else tbl1 := LowerCase(TOQBTable(Controls[i]).FTableName); if (Lst.IndexOf(tbl1) = -1) and (Lst1.IndexOf(tbl1) = -1) then if QBDialog.OQBEngine.UseTableAliases then Lst.Add(LowerCase(TOQBTable(Controls[i]).FTableName) + ' ' + tbl1) else Lst.Add(tbl1); end; Lst1.Free; QBDialog.OQBEngine.SQLfrom.Assign(Lst2); QBDialog.OQBEngine.SQLfrom.AddStrings(Lst); Lst2.Free; Lst.Clear; end; // WHERE clause with QBArea do begin for i := 0 to ControlCount - 1 do if Controls[i] is TOQBLink then begin Link := TOQBLink(Controls[i]); if Link.FLinkType = 0 then begin if QBDialog.OQBEngine.UseTableAliases then s := Link.tbl1.FTableAlias + '.' + Link.fldNam1 + sLinkOpt[Link.FLinkOpt] + Link.tbl2.FTableAlias + '.' + Link.fldNam2 else s := Link.tbl1.FTableName + '.' + Link.fldNam1 + sLinkOpt[Link.FLinkOpt] + Link.tbl2.FTableName + '.' + Link.fldNam2; Lst.Add(LowerCase(s)); end; end; QBDialog.OQBEngine.SQLwhere.Assign(Lst); Lst.Clear; end; // GROUP BY clause with QBGrid do begin for i := 1 to ColCount - 1 do begin if Cells[i, cGroup] <> EmptyStr then begin if QBDialog.OQBEngine.UseTableAliases then tbl1 := QBDialog.OQBEngine.AliasList[QBDialog.OQBEngine.TableList.IndexOf(Cells[i, cTbl])] else tbl1 := Cells[i, cTbl]; s := tbl1 + '.' + Cells[i, cFld]; Lst.Add(LowerCase(s)); end; end; QBDialog.OQBEngine.SQLgroupby.Assign(Lst); Lst.Clear; end; // ORDER BY clause with QBGrid do begin for i := 1 to ColCount - 1 do begin if Cells[i, cSort] <> EmptyStr then begin if QBDialog.OQBEngine.UseTableAliases then tbl1 := QBDialog.OQBEngine.AliasList[QBDialog.OQBEngine.TableList.IndexOf(Cells[i, cTbl])] else tbl1 := Cells[i, cTbl]; // --- to order result set by the result of an aggregate function if Cells[i, cFunc] = EmptyStr then s := LowerCase(tbl1 + '.' + Cells[i, cFld]) else s := IntToStr(i); // --- if Cells[i, cSort] = sSort[3] then s := s + ' DESC'; Lst.Add(s); end; end; QBDialog.OQBEngine.SQLorderby.Assign(Lst); Lst.Clear; end; MemoSQL.Lines.Text := QBDialog.OQBEngine.GenerateSQL; Pages.ActivePage := TabSQL; finally Lst.Free; end; end; procedure TOQBForm.btnResultsClick(Sender: TObject); begin // We may be able to generate the SQL if the user has // visually created one if MemoSQL.Lines.Text='' then btnSQLClick(Sender); QBDialog.OQBEngine.CloseResultQuery; // OQB 4.0a QBDialog.OQBEngine.SetQuerySQL(MemoSQL.Lines.Text); QBDialog.OQBEngine.OpenResultQuery; Pages.ActivePage := TabResults; end; procedure TOQBForm.btnAboutClick(Sender: TObject); var QBAboutForm: TOQBAboutForm; begin QBAboutForm := TOQBAboutForm.Create(Application); QBAboutForm.ShowModal; QBAboutForm.Free; end; procedure TOQBForm.btnSaveResultsClick(Sender: TObject); begin QBDialog.OQBEngine.SaveResultQueryData; end; procedure TOQBForm.btnOKClick(Sender: TObject); begin ModalResult := mrOk; end; procedure TOQBForm.btnCancelClick(Sender: TObject); begin ModalResult := mrCancel; end; end.