{*******************************************} { } { FastQueryBuilder 1.03 } { } { Copyright (c) 2005 } { Fast Reports Inc. } { } {*******************************************} {$I fqb.inc} unit fqbClass; interface uses Windows, Messages, Classes, Controls, Menus, Forms, Graphics, StdCtrls, Grids, DB, SysUtils, ExtCtrls, CheckLst, Buttons, Comctrls, Types {$IFDEF FQB_COM} ,FastQueryBuilder_TLB ,FastReport_TLB ,VCLCOM ,ComServ ,ComObj {$ENDIF} {$IFDEF Delphi6} ,Variants {$ENDIF}; type TfqbTable = class; TfqbTableArea = class; EfqbError = class(Exception) end; TfqbField = class(TCollectionItem) private FFieldName: string; FFielType: Integer; FLinked: Boolean; function GetFieldName: string; public property FieldName: string read GetFieldName write FFieldName; property FieldType: Integer read FFielType write FFielType; property Linked: Boolean read FLinked write FLinked; end; TfqbFieldList = class(TOwnedCollection) private function GetItem(Index: Integer): TfqbField; procedure SetItem(Index: Integer; const Value: TfqbField); public function Add: TfqbField; property Items[Index: Integer]: TfqbField read GetItem write SetItem; default; end; TfqbLink = class(TCollectionItem) protected FArea: TfqbTableArea; FDestField: TfqbField; FDestTable: TfqbTable; FJOp: Integer; FJType: Integer; FMenu: TPopupMenu; FSelected: Boolean; FSourceField: TfqbField; FSourceTable: TfqbTable; procedure DoDelete(Sender: TObject); procedure DoOptions(Sender: TObject); procedure Draw; function GetDestCoords: TPoint; function GetSourceCoords: TPoint; procedure SetSelected(const Value: Boolean); public constructor Create(Collection: TCollection); override; destructor Destroy; override; property DestCoords: TPoint read GetDestCoords; property DestField: TfqbField read FDestField; property DestTable: TfqbTable read FDestTable; property JoinOperator: Integer read FJOp write FJOp; property JoinType: Integer read FJType write FJType; property Selected: Boolean read FSelected write SetSelected; property SourceCoords: TPoint read GetSourceCoords; property SourceField: TfqbField read FSourceField; property SourceTable: TfqbTable read FSourceTable; end; TfqbLinkList = class(TOwnedCollection) private function GetItem(Index: Integer): TfqbLink; procedure SetItem(Index: Integer; const Value: TfqbLink); public function Add: TfqbLink; property Items[Index: Integer]: TfqbLink read GetItem write SetItem; default; end; TfqbCheckListBox = class(TCheckListBox) protected procedure ClickCheck; override; procedure DragOver(Sender: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); override; public procedure DragDrop(Sender: TObject; X, Y: Integer); override; end; TfqbTable = class(TPanel) private FAliasName: string; FButtonClose: TSpeedButton; FButtonMinimize: TSpeedButton; FCheckListBox: TfqbCheckListBox; FFieldList: TfqbFieldList; FImage: TImage; FLabel: TLabel; FOldHeight: Integer; FTableName: string; function GetSellectedField: TfqbField; procedure SetTableName(const Value: string); procedure SetXPStyle(const AComp: TControl); protected procedure CreateParams(var Params: TCreateParams); override; function GetLinkPoint(AIndex: integer; ASide: char): TPoint; procedure Resize; override; procedure WMMove(var Message: TWMMove); message WM_MOVE; procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCHitTest; procedure WMPaint(var Message: TWMPaint); message WM_PAINT; procedure CMRelease(var Message: TMessage); message CM_RELEASE; procedure _DoExit(Sender: TObject); procedure _DoMinimize(Sender: TObject); procedure _DoRestore(Sender: TObject); property ChBox: TfqbCheckListBox read FCheckListBox; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure UpdateFieldList; procedure UpdateLinkList; property AliasName: string read FAliasName; property FieldList: TfqbFieldList read FFieldList write FFieldList; property SellectedField: TfqbField read GetSellectedField; property TableName: string read FTableName write SetTableName; end; TfqbTableArea = class(TScrollBox) private FCanvas: TCanvas; FInstX: Integer; FInstY: Integer; FLinkList: TfqbLinkList; protected procedure Click; override; function GenerateAlias(const ATableNAme: string): string; virtual; function GetLineAtCursor: Integer; procedure WMPaint(var Message: TWMPaint); message WM_PAINT; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function CompareFields(TableID1: integer; FIndex1: integer; TableID2: integer; FIndex2: integer): Boolean; procedure DragDrop(Source: TObject; X, Y: Integer); override; procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); override; function FindTable(const AName, AAlias: string): TfqbTable; procedure InsertTable(const X, Y : integer; const Name: string); overload; procedure InsertTable(const Name : string); overload; property LinkList: TfqbLinkList read FLinkList; end; TfqbTableListBox = class(TListBox) protected procedure DblClick; override; procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override; procedure CreateWnd; override; public constructor Create(AOwner: TComponent); override; end; PGridColumn = ^TGridColumn; TGridColumn = record Table: string; Alias: string; Field: string; Visibl: Boolean; Where: string; Sort: Integer; Func: Integer; Group: Integer; end; TfqbEdit = class(TEdit) private FButton: TSpeedButton; FOnButtonClick: TNotifyEvent; FPanel: TPanel; FShowButton: Boolean; procedure SetShowButton(const Value: Boolean); protected procedure ButtonClick(Sender: TObject); procedure CreateParams(var Params: TCreateParams); override; procedure CreateWnd; override; procedure SetEditRect; procedure WMSize(var Message: TWMSize); message WM_SIZE; public constructor Create(AOwner: TComponent); override; property OnButtonClick: TNotifyEvent read FOnButtonClick write FOnButtonClick; property ShowButton: Boolean read FShowButton write SetShowButton; end; TfqbColumnResizeEvent = procedure (Sender: TCustomListview; ColumnIndex: Integer; ColumnWidth: Integer) of object; TfqbGrid = class(TListView) private FEndColumnResizeEvent: TfqbColumnResizeEvent; FFunctionList: TComboBox; FGroupList: TComboBox; FPopupMenu: TPopupMenu; FSortList: TComboBox; FVisibleList: TComboBox; FWhereEditor: TfqbEdit; procedure fqbOnChange(Sender: TObject); procedure fqbOnMenu(Sender: TObject); procedure fqbOnPopup(Sender: TObject); procedure fqbOnSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean); procedure fqbSetBounds(var Contr: TControl); protected procedure CreateWnd; override; procedure DoColumnResize(ColumnIndex, ColumnWidth: Integer); virtual; function FindColumnIndex(pHeader: pNMHdr): Integer; function FindColumnWidth(pHeader: pNMHdr): Integer; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure RecalcColWidth; procedure Resize; override; procedure WMNotify(var Msg: TWMNotify); message WM_NOTIFY; procedure WMVscroll(var Msg: TWMNotify); message WM_VSCROLL; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function AddColumn: Integer; procedure Exchange(const AItm1, AItm2: integer); procedure fqbUpdate; procedure UpdateColumn; property OnEndColumnResize: TfqbColumnResizeEvent read FEndColumnResizeEvent write FEndColumnResizeEvent; end; TfqbEngine = class(TComponent) private FShowSystemTables: Boolean; public procedure ReadFieldList(const ATableName: string; var AFieldList: TfqbFieldList); virtual; abstract; procedure ReadTableList(ATableList: TStrings); virtual; abstract; function ResultDataSet: TDataSet; virtual; abstract; procedure SetSQL(const Value: string); virtual; abstract; published property ShowSystemTables: Boolean read FShowSystemTables write FShowSystemTables default False; end; {$IFDEF FQB_COM} TfqbDialog = class( TComponent, IFastQueryBuilder ) {$ELSE} TfqbDialog = class(TComponent) {$ENDIF} private FEngine: TfqbEngine; function GetSchemaInsideSQL: Boolean; function GetSQL: string; function GetSQLSchema: string; procedure SetEngine(const Value: TfqbEngine); procedure SetSchemaInsideSQL(const Value: Boolean); procedure SetSQL(Value: string); procedure SetSQLSchema(const Value: string); protected {$IFDEF FQB_COM} function DesignQuery(const Param1: IfrxCustomQuery; out ModalResult: WordBool): HResult; stdcall; function Get_SQL(out Value: WideString): HResult; stdcall; function Set_SQL(const Value: WideString): HResult; stdcall; function Get_SQLSchema(out Value: WideString): HResult; stdcall; function Set_SQLSchema(const Value: WideString): HResult; stdcall; {$ENDIF} procedure Notification(AComponent: TComponent; Operation: TOperation); override; public constructor Create(AOwner: TComponent); override; function Execute: Boolean; virtual; property SQL: string read GetSQL write SetSQL; property SQLSchema: string read GetSQLSchema write SetSQLSchema; published property Engine: TfqbEngine read FEngine write SetEngine; property SchemaInsideSQL: Boolean read GetSchemaInsideSQL write SetSchemaInsideSQL default True; end; TfqbCore = class(TObject) private FEngine: TfqbEngine; FGrid: TfqbGrid; FSchemaInsideSQL: Boolean; FSQL: string; FSQLSchema: string; FTableArea: TfqbTableArea; FUseCoding: Boolean; FText: string; FUsingQuotes: Boolean; function ExtractSchema(const Value: string): string; function ExtractSQL(const Str: string): string; function GetEngine: TfqbEngine; function GetGrid: TfqbGrid; function GetSQL: string; function GetSQLSchema: string; function GetTableArea: TfqbTableArea; procedure SetSchemaInsideSQL(const Value: Boolean); procedure SetSQL(Value: string); procedure SetSQLSchema(const Value: string); public constructor Create; virtual; destructor Destroy; override; procedure Clear; function GenerateSQL: string; procedure LoadFromFile(const FileName: string); procedure LoadFromStr(const Str: TStringList); procedure RecognizeModel(const crc32: Cardinal; const FileName: string); procedure SaveToFile(const FileName: string); procedure SaveToStr(var Str: TStringList); property Engine: TfqbEngine read GetEngine write FEngine; property Grid: TfqbGrid read GetGrid write FGrid; property SQL: string read GetSQL write SetSQL; property SQLSchema: string read GetSQLSchema write SetSQLSchema; property TableArea: TfqbTableArea read GetTableArea write FTableArea; property SchemaInsideSQL: Boolean read FSchemaInsideSQL write SetSchemaInsideSQL default True; property UsingQuotes: Boolean read FUsingQuotes write FUsingQuotes; end; function fqbCore: TfqbCore; const StrFieldType : array [0..{$IFNDEF Delphi7}29 {$ELSE} {$IFNDEF Delphi11}37 {$ELSE} {$IFNDEF Delphi12}41 {$ELSE} {$IFNDEF Delphi16}48 {$ELSE}51 {$ENDIF} {$ENDIF} {$ENDIF} {$ENDIF}] of string = (''{0}, 'String'{1}, 'Smallint'{2}, 'Integer'{3}, 'Word'{4}, 'Boolean'{5}, 'Float'{6}, 'Currency'{7}, 'BCD'{8}, 'Date'{9}, 'Time'{10}, 'DateTime'{11}, 'Bytes'{12}, 'VarBytes'{13}, 'AutoInc'{14}, 'Blob'{15}, 'Memo'{16}, 'Graphic'{17}, 'FmtMemo'{18}, 'ParadoxOle'{19}, 'DBaseOle'{20}, 'TypedBinary'{21}, 'Cursor'{22}, 'FixedChar'{23}, 'WideString'{24}, 'Largeint'{25}, 'ADT'{26}, 'Array'{27}, 'Reference'{28}, 'DataSet'{29}{$IFDEF Delphi7}, 'OraBlob' {30}, 'OraClob'{31}, 'Variant'{32}, 'Interface'{33}, 'IDispatch'{34}, 'Guid'{35}, 'TimeStamp'{36}, 'FMTBcd'{37}{$IFDEF Delphi11}, 'FixedWideChar'{38}, 'WideMemo'{39}, 'OraTimeStamp'{40}, 'OraInterval'{41}{$IFDEF Delphi12}, 'LongWord'{42}, 'ShortInt'{43}, 'Byte'{44}, 'Extended'{45}, 'Connection'{46}, 'Params'{47}, 'Stream'{48}{$IFDEF Delphi16}, 'SQLTimeStampOffset'{49}, 'Object'{50}, 'Single'{51}{$ENDIF}{$ENDIF}{$ENDIF}{$ENDIF}); _fqbBeginModel = '/*_FQBMODEL'; _fqbEndModel = '_FQBEND*/'; implementation {$R images.res} uses Math, IniFiles, Dialogs, Commctrl, fqbDesign, fqbLinkForm, fqbUtils, fqbRes, fqbrcDesign {$IFDEF Delphi7} ,Themes {$ENDIF} {$IFDEF FQB_COM} ,frxCustomDB {$ENDIF} ; const clSelectedLink = clGreen; clNotSelectedLink = clBlack; LinkType: array[0..5] of string = ('=', '>', '<', '>=', '<=', '<>'); JoinType: array[0..3] of string = ('INNER JOIN', 'LEFT OUTER JOIN', 'RIGHT OUTER JOIN', 'FULL OUTER JOIN'); rowColumn = 0; rowVisibility = 1; rowWhere = 2; rowSort = 3; rowFunction = 4; rowGroup = 5; CompatibleIntTypes = [2, 3, 4, 12, 14, 25, 42]; CompatibleDateTimeTypes = [9, 10, 11]; CompatibleFloatTypes = [6, 7]; type TcrTControl = class(TControl) end; var FfqbCore: TfqbCore = nil; FExternalCreation: Boolean = True; function fqbCore: TfqbCore; begin if FfqbCore = nil then begin FExternalCreation := False; try FfqbCore := TfqbCore.Create; finally FExternalCreation := True; end; end; Result := FfqbCore; end; function FindFQBcomp(const AClassName: string; const Source: TComponent): TComponent; var i: integer; begin Result := nil; if UpperCase(Source.ClassName) = UpperCase(AClassName) then Result := Source else for i := 0 to Source.ComponentCount - 1 do if Result = nil then Result := FindFQBcomp(AClassName, Source.Components[i]) else Exit end; {----------------------- TfqbField -----------------------} function TfqbField.GetFieldName: string; begin if ((Pos(' ', FFieldName) > 0) or (Pos('/', FFieldName) > 0) or ((UpperCase(FFieldName) <> FFieldName)) and fqbCore.UsingQuotes) then Result := '"' + FFieldName + '"' else Result := FFieldName end; {----------------------- TfqbFieldList -----------------------} function TfqbFieldList.Add: TfqbField; begin Result := TfqbField(inherited Add) end; function TfqbFieldList.GetItem(Index: Integer): TfqbField; begin Result := TfqbField(inherited Items[Index]) end; procedure TfqbFieldList.SetItem(Index: Integer; const Value: TfqbField); begin Items[Index].Assign(Value) end; {----------------------- TfqbLinkList -----------------------} function TfqbLinkList.Add: TfqbLink; begin Result := TfqbLink(inherited Add) end; function TfqbLinkList.GetItem(Index: Integer): TfqbLink; begin Result := TfqbLink(inherited Items[Index]) end; procedure TfqbLinkList.SetItem(Index: Integer; const Value: TfqbLink); begin Items[Index].Assign(Value) end; {----------------------- TfqbLink -----------------------} constructor TfqbLink.Create(Collection: TCollection); var tmp: TMenuItem; begin inherited Create(Collection); FJOp := 0; FJType:= 0; FMenu:= TPopupMenu.Create(nil); tmp:= TMenuItem.Create(FMenu); tmp.Caption:= 'Link options'; tmp.OnClick:= DoOptions; FMenu.Items.Add(tmp); tmp:= TMenuItem.Create(FMenu); tmp.Caption:= 'Delete'; tmp.OnClick:= DoDelete; FMenu.Items.Add(tmp) end; destructor TfqbLink.Destroy; begin SourceField.Linked := false; DestField.Linked := false; FMenu.Free; inherited Destroy; end; procedure TfqbLink.DoDelete(Sender: TObject); begin Free end; procedure TfqbLink.DoOptions(Sender: TObject); var fqbLinkForm: TfqbLinkForm; begin fqbLinkForm := TfqbLinkForm.Create(nil); try fqbLinkForm.txtTable1.Caption := SourceTable.TableName; fqbLinkForm.txtCol1.Caption := SourceField.FieldName; fqbLinkForm.txtTable2.Caption := DestTable.TableName; fqbLinkForm.txtCol2.Caption := DestField.FieldName;; fqbLinkForm.RadioOpt.ItemIndex := JoinOperator; fqbLinkForm.RadioType.ItemIndex := JoinType; if fqbLinkForm.ShowModal = mrOk then begin JoinOperator := fqbLinkForm.RadioOpt.ItemIndex; JoinType := fqbLinkForm.RadioType.ItemIndex end; finally fqbLinkForm.Free end end; procedure TfqbLink.Draw; var pnt1, pnt2: TPoint; cnt1, cnt2: Integer; dSrc, dDest: Integer; const Delta = 15; begin pnt1:= SourceCoords; pnt2:= DestCoords; cnt1:= SourceTable.BoundsRect.Left + (SourceTable.Width div 2); cnt2:= DestTable.BoundsRect.Left + (DestTable.Width div 2); if cnt1 < cnt2 then begin dSrc:= Delta; dDest:= -Delta end else begin dSrc:= -Delta; dDest:= Delta end; FArea.FCanvas.MoveTo(pnt1.x, pnt1.y); FArea.FCanvas.Pen.Color:= clNotSelectedLink; FArea.FCanvas.Pen.Width:= 3; FArea.FCanvas.LineTo(pnt1.x + dSrc, pnt1.y); FArea.FCanvas.Pen.Width:= 1; if Selected then FArea.FCanvas.Pen.Color:= clSelectedLink else FArea.FCanvas.Pen.Color:= clNotSelectedLink; FArea.FCanvas.LineTo(pnt2.x + dDest, pnt2.y); FArea.FCanvas.Pen.Width:= 3; FArea.FCanvas.Pen.Color:= clNotSelectedLink; FArea.FCanvas.LineTo(pnt2.x, pnt2.y) end; function TfqbLink.GetDestCoords: TPoint; var cnt1, cnt2: Integer; begin cnt1:= SourceTable.BoundsRect.Left + (SourceTable.Width div 2); cnt2:= DestTable.BoundsRect.Left + (DestTable.Width div 2); if cnt1 < cnt2 then Result:= DestTable.GetLinkPoint(DestField.Index,'L') else Result:= DestTable.GetLinkPoint(DestField.Index,'R') end; function TfqbLink.GetSourceCoords: TPoint; var cnt1, cnt2: Integer; begin cnt1:= SourceTable.BoundsRect.Left + (SourceTable.Width div 2); cnt2:= DestTable.BoundsRect.Left + (DestTable.Width div 2); if cnt1 < cnt2 then Result:= SourceTable.GetLinkPoint(SourceField.Index,'R') else Result:= SourceTable.GetLinkPoint(SourceField.Index,'L') end; procedure TfqbLink.SetSelected(const Value: Boolean); var i: Integer; begin for i:= 0 to Collection.Count - 1 do TfqbLinkList(Collection).Items[i].FSelected := false; FSelected := Value end; {----------------------- TfqbTableArea -----------------------} constructor TfqbTableArea.Create(AOwner: TComponent); begin inherited Create(AOwner); FCanvas := TControlCanvas.Create; TControlCanvas(FCanvas).Control := Self; Color := clBtnFace; FCanvas.Brush.Color := clBtnFace; FLinkList := TfqbLinkList.Create(Self, TfqbLink); FInstX := 15; FInstY := 15; end; destructor TfqbTableArea.Destroy; begin FCanvas.Free; FLinkList.Free; inherited Destroy; end; procedure TfqbTableArea.Click; var n: Integer; begin n := GetLineAtCursor; if ((n >= 0) and (n < LinkList.Count)) then begin LinkList[n].Selected := true; Invalidate; LinkList[n].FMenu.Popup(Mouse.CursorPos.X,Mouse.CursorPos.Y) end; inherited Click; end; function TfqbTableArea.CompareFields(TableID1: integer; FIndex1: integer; TableID2: integer; FIndex2: integer): Boolean; var tp1, tp2: Integer; begin if ((TableID1 > ComponentCount) or (TableID2 > ComponentCount)) then Result := false else begin tp1 := TfqbTable(Components[TableID1]).FieldList[Findex1].FieldType; tp2 := TfqbTable(Components[TableID2]).FieldList[Findex2].FieldType; if ((tp1 in CompatibleIntTypes) and (tp2 in CompatibleIntTypes)) then Result := True else if ((tp1 in CompatibleDateTimeTypes) and (tp2 in CompatibleDateTimeTypes)) then Result := True else if ((tp1 in CompatibleFloatTypes) and (tp2 in CompatibleFloatTypes)) then Result := True else Result := TfqbTable(Components[TableID1]).FieldList[Findex1].FieldType = TfqbTable(Components[TableID2]).FieldList[Findex2].FieldType end end; procedure TfqbTableArea.DragDrop(Source: TObject; X, Y: Integer); begin InsertTable(X, Y, (Source as TfqbTableListBox).Items[(Source as TfqbTableListBox).ItemIndex]) end; procedure TfqbTableArea.DragOver(Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin Accept := Source is TfqbTableListBox end; function TfqbTableArea.FindTable(const AName, AAlias: string): TfqbTable; var i: Integer; begin Result:= nil; for i:= 0 to ComponentCount - 1 do if ((TfqbTable(Components[i]).TableName = AName) and (TfqbTable(Components[i]).AliasName = AAlias)) then Result:= TfqbTable(Components[i]) end; function TfqbTableArea.GenerateAlias(const ATableNAme: string): string; var n: Integer; function FindDublicat(AAlias: string): boolean; var i: integer; begin Result:= False; for i:= 0 to ComponentCount - 1 do begin if AAlias = TfqbTable(Components[i]).AliasName then begin Result:= True; Break end end end; begin Result:= ATableName[1]; n:=1; while FindDublicat(Result) do begin Result:= ATableName[1] + IntToStr(n); Inc(n) end end; function TfqbTableArea.GetLineAtCursor: Integer; procedure SwapInt(var X, Y: Integer); var T: Integer; begin T := X; X := Y; Y := T end; function InRange(const AValue, AMin, AMax: Integer): Boolean; begin Result := (AValue >= AMin) and (AValue <= AMax) end; const sf = 6; //Scale factor var i,TX1, TX2, TY1,TY2,X1,Y1, X2,Y2,Lx, Ly, C: integer; MousePos: TPoint; Delta: Real; begin Result:= - 1; for i:= 0 to LinkList.Count - 1 do begin MousePos:= Mouse.CursorPos; MousePos:= ScreenToClient(MousePos); X1:= TfqbLink(LinkList[i]).GetSourceCoords.X; X2:= TfqbLink(LinkList[i]).GetDestCoords.X; Y1:= TfqbLink(LinkList[i]).GetSourceCoords.Y; Y2:= TfqbLink(LinkList[i]).GetDestCoords.Y; TX1:= X1; TX2:= X2; TY1:= Y1; TY2:= Y2; if TX1> TX2 then SwapInt(TX1, TX2); if TY1> TY2 then SwapInt(TY1, TY2); Lx:= X2-X1; Ly:= Y2-Y1; C:= -Ly*X1 + Lx*Y1; Delta:= Sqrt(Power((X1-X2), 2) + Power((Y1-Y2), 2)) * sf; if (Abs(-Ly*MousePos.X + Lx*MousePos.Y - C)<= Delta) and InRange(MousePos.X, TX1 - sf, TX2 + sf) and InRange(MousePos.Y, TY1 - sf, TY2 + sf) then begin Result:= i; break end end end; procedure TfqbTableArea.InsertTable(const X, Y : integer; const Name: string); var tmp: TfqbTable; begin tmp := TfqbTable.Create(Self); tmp.Left := X; tmp.Top := Y; tmp.Parent := Self; tmp.TableName := Name; fqbCore.Engine.ReadFieldList(Name, tmp.FFieldList); tmp.UpdateFieldList end; procedure TfqbTableArea.InsertTable(const Name : string); begin InsertTable(FInstX, FInstY, Name); if FInstY > Height then FInstY:= 15 else FInstY:= FInstY + 15; if FInstX > Width then FInstX := 15 else FInstX:= FInstX + 15 end; procedure TfqbTableArea.WMPaint(var Message: TWMPaint); var i: Integer; {$IFDEF TRIAL} str: string; l, dx: integer; {$ENDIF} begin inherited; {$IFDEF TRIAL} FCanvas.Font.Size := 50; FCanvas.Font.Color:= clRed; FCanvas.Font.Name := 'Tahoma'; str := 'deretsigern'; l := FCanvas.TextWidth(str + 'U'); dx := (Width div 2) - (l div 2); FCanvas.TextOut(dx, 100, 'U'); for i := 11 downto 1 do FCanvas.TextOut(FCanvas.PenPos.x, FCanvas.PenPos.y, str[i]); {$ENDIF} for i := 0 to LinkList.Count - 1 do LinkList[i].Draw end; {----------------------- TfqbTable -----------------------} constructor TfqbTable.Create(AOwner: TComponent); begin inherited; Width := 130; Height := 150; BevelOuter := bvNone; BorderWidth := 1; FLabel := TLabel.Create(Self); with FLabel do begin Parent := Self; Align := alTop; Color := clActiveCaption; Font.Charset := DEFAULT_CHARSET; Font.Color := clCaptionText; AutoSize := False; Height := Height + 6; Font.Size := Font.Size + 1; Layout := tlCenter; SetXPStyle(FLabel); end; FImage := TImage.Create(Self); with FImage do begin Parent := Self; Top := 3; Left := 3; Width := 16; Height := 16; AutoSize := True; FImage.Picture.Bitmap.LoadFromResourceName(HInstance,'TABLEIMAGE1'); Transparent := True; SetXPStyle(FImage); end; FButtonClose := TSpeedButton.Create(Self); with FButtonClose do begin Parent := Self; Top := 3; Width := 17; Height := 15; OnClick := _DoExit; Glyph.LoadFromResourceName(HInstance,'BTN_CLOSE'); end; FButtonMinimize := TSpeedButton.Create(Self); with FButtonMinimize do begin Parent := Self; Top := 3; Width := 17; Height := 15; OnClick := _DoMinimize; Glyph.LoadFromResourceName(HInstance,'BTN_MINI'); end; FCheckListBox := TfqbCheckListBox.Create(Self); with FCheckListBox do begin Parent := Self; Align := alClient; ItemHeight := 13; Style := lbOwnerDrawVariable; DragMode := dmAutomatic end; Constraints.MinHeight := FLabel.Height + 8; Constraints.MinWidth := 120; Caption := ''; FFieldList := TfqbFieldList.Create(Self, TfqbField); DragMode := dmAutomatic; DoubleBuffered := true; ShowHint := False; Height := 200; Width := 150; SetXPStyle(Self); end; destructor TfqbTable.Destroy; var i: Integer; begin if GetParentForm(Self) <> nil then begin for i:= fqbCore.Grid.Items.Count - 1 downto 0 do begin if TGridColumn(fqbCore.Grid.Items[i].Data^).Table = TableName then begin FreeMem(fqbCore.Grid.Items[i].Data,SizeOf(TGridColumn)); fqbCore.Grid.Items[i].Delete; end end; fqbCore.Grid.UpdateColumn end; UpdateLinkList; FLabel.Free; FCheckListBox.Free; FFieldList.Free; FImage.Free; FButtonClose.Free; FButtonMinimize.Free; if Parent <> nil then begin Parent.Invalidate; Parent:= nil end; inherited end; procedure TfqbTable.CreateParams(var Params: TCreateParams); begin inherited CreateParams(Params); with Params do begin Style:= Style or WS_SIZEBOX; WindowClass.Style:= WindowClass.Style xor CS_VREDRAW end end; function TfqbTable.GetLinkPoint(AIndex: integer; ASide: char): TPoint; var tmpRec: TRect; begin tmpRec := ChBox.ItemRect(AIndex); tmpRec.Top := tmpRec.Top + FLabel.Height + (ChBox.Height - ChBox.ClientHeight); tmpRec.Bottom := tmpRec.Bottom + FLabel.Height + (ChBox.Height - ChBox.ClientHeight); if tmpRec.Bottom > ClientHeight then Result.y := ClientHeight else if tmpRec.Top < 0 then Result.y := 0 else Result.y := tmpRec.Top + (tmpRec.Bottom - tmpRec.Top) div 2; Result := Parent.ScreenToClient(ClientToScreen(Result)); // if ASide = 'L' then Left side else if ASide = 'R' then Right side if ASide = 'L' then Result.x := BoundsRect.Left else Result.x := BoundsRect.Right end; function TfqbTable.GetSellectedField: TfqbField; begin Result := FFieldList[ChBox.ItemIndex] end; procedure TfqbTable.Resize; begin inherited Resize; FButtonClose.Left := Width - 25; FButtonMinimize.Left := Width - 42 end; procedure TfqbTable.SetTableName(const Value: string); function GetSpace(const Width: integer):string; begin Result := ''; repeat Result := Result + ' ' until FLabel.Canvas.TextWidth(Result) > Width end; begin FTableName := Value; FAliasName:= TfqbTableArea(Parent).GenerateAlias(Value); FLabel.Caption := GetSpace(FImage.Width + 2) + Value + ' - ' + FAliasName end; procedure TfqbTable.SetXPStyle(const AComp: TControl); begin {$IFDEF Delphi7} if ThemeServices.ThemesEnabled then AComp.ControlStyle := AComp.ControlStyle - [csParentBackground] + [csOpaque]; {$ENDIF}; end; procedure TfqbTable.UpdateFieldList; var i: Integer; begin ChBox.Items.BeginUpdate; ChBox.Items.Clear; if FFieldList.Count > 0 then ChBox.Items.Add(TfqbField(FFieldList[0]).FieldName); for i:= 1 to FFieldList.Count - 1 do ChBox.Items.Add(TfqbField(FFieldList[i]).FieldName + ' (' + StrFieldType[TfqbField(FFieldList[i]).FieldType] + ')'); ChBox.Items.EndUpdate end; procedure TfqbTable.UpdateLinkList; var i: Integer; begin if Parent = nil then Exit; for i:= (Parent as TfqbTableArea).LinkList.Count - 1 downto 0 do if (((Parent as TfqbTableArea).LinkList[i].SourceTable = self) or ((Parent as TfqbTableArea).LinkList[i].DestTable = self)) then (Parent as TfqbTableArea).LinkList[i].Free end; procedure TfqbTable.WMMove(var Message: TWMMove); begin inherited; Parent.Invalidate end; procedure TfqbTable.WMNCHitTest(var M: TWMNCHitTest); var x: Integer; begin inherited; x := ClientToScreen(Point(FButtonMinimize.Left,0)).X; if ((M.Result = htClient) and (M.XPos - x < 0)) then M.Result := htCaption end; procedure TfqbTable.WMPaint(var Message: TWMPaint); begin inherited; Parent.Invalidate end; procedure TfqbTable._DoExit(Sender: TObject); begin PostMessage(Handle, CM_RELEASE, 0, 0); end; procedure TfqbTable._DoMinimize(Sender: TObject); begin FOldHeight := Height; Height := 0; FButtonMinimize.OnClick := _DoRestore end; procedure TfqbTable._DoRestore(Sender: TObject); begin Height := FOldHeight; FButtonMinimize.OnClick := _DoMinimize end; {----------------------- TfqbTableListBox -----------------------} constructor TfqbTableListBox.Create(AOwner: TComponent); begin inherited Create(AOwner); DragMode := dmAutomatic; end; procedure TfqbTableListBox.CreateWnd; begin Style := lbOwnerDrawFixed; //ItemHeight := 18; inherited; end; procedure TfqbTableListBox.DblClick; begin inherited DblClick; fqbCore.TableArea.InsertTable(Items[ItemIndex]) end; procedure TfqbTableListBox.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); var Bitmap: TBitmap; BMPRect: TRect; begin inherited DrawItem(Index, Rect, State); Canvas.FillRect(Rect); Bitmap := TBitmap.Create; Bitmap.LoadFromResourceName(HInstance,'TABLEIMAGE1'); if Bitmap <> nil then begin BMPRect := Bounds(Rect.Left + 3, Rect.Top + 1, 16, 16); Canvas.BrushCopy(BMPRect,Bitmap, Bounds(0, 0, Bitmap.Width, Bitmap.Height), Bitmap.Canvas.Pixels[0, Bitmap.Height-1]); end; Canvas.TextOut(Rect.Left+24, Rect.Top+2, Items[Index]); Bitmap.Free end; {----------------------- TfqbDialog -----------------------} constructor TfqbDialog.Create(AOwner: TComponent); begin inherited; fqbCore.SchemaInsideSQL := True; end; function TfqbDialog.Execute: Boolean; var tmp: TStringList; begin {$IFDEF TRIAL} ShowMessage(' Fast Query Builder'#10#13'Unregistered version'); {$ENDIF} fqbDesigner := TfqbDesigner.Create(Self); fqbCore.Engine := Engine; fqbCore.Grid := fqbDesigner.fqbGrid1; fqbCore.TableArea := fqbDesigner.fqbTableArea1; tmp:= TStringList.Create; tmp.Text := fqbCore.FText; try try fqbCore.LoadFromStr(tmp); except end; if fqbDesigner.ShowModal = mrOk then begin tmp.Clear; fqbCore.SaveToStr(tmp); fqbCore.FText := tmp.Text; Result := true end else Result := false; fqbCore.Clear; finally tmp.Free; fqbDesigner.Free end end; {$IFDEF FQB_COM} function TfqbDialog.DesignQuery( const Param1: IfrxCustomQuery; out ModalResult: WordBool): HResult; stdcall; var SQLText: WideString; SQLSchemaText: WideString; idsp: IInterfaceComponentReference; obj: TComponent; //TfqbEngine; begin try Result := Param1.QueryInterface( IInterfaceComponentReference, idsp); if Result = S_OK then begin obj := idsp.GetComponent; if obj is TfrxCustomQuery then begin Engine := TfrxCustomQuery(obj).QBEngine; SchemaInsideSQL := False; Param1.Get_SQL(SQLText); SQL := SQLText; Param1.Get_SQLSchema(SQLSchemaText); SQLSchema := SQLSchemaText; ModalResult := Execute; end else begin ShowMessage(' Fast Query Builder'#10#13'Received object is not TfrxCustomQuery'); end end; except Result := E_FAIL; end; end; function TfqbDialog.Get_SQL(out Value: WideString): HResult; stdcall; begin Value := SQL; Result := S_OK; end; function TfqbDialog.Set_SQL(const Value: WideString): HResult; stdcall; begin SQL := Value; Result := S_OK; end; function TfqbDialog.Get_SQLSchema(out Value: WideString): HResult; stdcall; begin Value := SQLSchema; Result := S_OK; end; function TfqbDialog.Set_SQLSchema(const Value: WideString): HResult; stdcall; begin SQLSchema := Value; Result := S_OK; end; {$ENDIF} function TfqbDialog.GetSchemaInsideSQL: Boolean; begin Result := fqbCore.SchemaInsideSQL; end; function TfqbDialog.GetSQL: string; begin Result := fqbCore.SQL; end; function TfqbDialog.GetSQLSchema: string; begin Result := fqbCore.SQLSchema; end; procedure TfqbDialog.Notification(AComponent: TComponent; Operation: TOperation); begin inherited; if (AComponent = FEngine) and (Operation = opRemove) then begin FEngine := nil; fqbCore.Engine := nil; end; end; procedure TfqbDialog.SetEngine(const Value: TfqbEngine); begin if FEngine <> Value then begin FEngine := Value; fqbCore.Engine := Value; FreeNotification(FEngine); end end; procedure TfqbDialog.SetSchemaInsideSQL(const Value: Boolean); begin fqbCore.SchemaInsideSQL := Value; end; procedure TfqbDialog.SetSQL(Value: string); begin fqbCore.SQL := Value; end; procedure TfqbDialog.SetSQLSchema(const Value: string); begin fqbCore.SQLSchema := Value; end; {----------------------- TfqbCore -----------------------} constructor TfqbCore.Create; begin if FfqbCore <> nil then raise EfqbError.Create('TfqbCore class already initialized.'); if FExternalCreation then raise EfqbError.Create('Call fqbCore function to reference this class.'); inherited; FUseCoding := True; FUsingQuotes := False; end; destructor TfqbCore.Destroy; begin FfqbCore := nil; inherited; end; procedure TfqbCore.Clear; var i: Integer; begin for i:= Grid.Items.Count - 1 downto 0 do Dispose(PGridColumn(Grid.Items[i].Data)); Grid.Items.Clear; for i := TableArea.ComponentCount - 1 downto 0 do TableArea.Components[i].Free end; function TfqbCore.ExtractSchema(const Value: string): string; var e, b: Integer; begin b := Pos(_fqbBeginModel, Value) + Length(_fqbBeginModel); e := Pos(_fqbEndModel, Value); if not (e = 0) then begin Result := Copy(Value, b, e-b); Result := fqbTrim(Result, [#10, #13]); end else Result := Value; end; function TfqbCore.ExtractSQL(const Str: string): string; var e, b: Integer; begin b := Pos(_fqbBeginModel, Str); e := Pos(_fqbEndModel, Str); Result := Str; Delete(Result, b, e); end; function TfqbCore.GenerateSQL: string; const strTab = ' '; strSel = 'SELECT '; strFrom = 'FROM'; strWhere = 'WHERE'; strOrder = 'ORDER BY '; strGroup = 'GROUP BY '; var i, h: integer; tmpStr, orderStr, prd, groupStr: string; slFrom, slWhere: TStringList; Tbl1, Tbl2, Tbl3: TfqbTable; CopyLL: TList; flg: boolean; SQL: TStringList; HookList: String; function FormingFrom(const Ind: integer):string; var tmp: TfqbLink; begin tmp := TableArea.LinkList[Ind]; Result := {strTab + }JoinType[tmp.JoinType] + ' ' + Tbl2.TableName + ' ' + Tbl2.AliasName + ' ON (' + Tbl1.AliasName + '.' + tmp.SourceField.FieldName + LinkType[tmp.JoinOperator] + Tbl2.AliasName + '.' + tmp.DestField.FieldName + ')' end; function FormingFromAnd(const Ind: integer):string; var tmp: TfqbLink; begin tmp := TfqbLink(TableArea.LinkList[Ind]); Result := ' AND (' + Tbl1.AliasName + '.' + tmp.SourceField.FieldName + LinkType[tmp.JoinOperator] + Tbl3.AliasName + '.' + tmp.DestField.FieldName + ') ' end; begin if Grid.Items.Count = 0 then Exit; SQL := TStringList.Create; //SELECT tmpStr := strSel; for i := 0 to Grid.Items.Count - 1 do if TGridColumn(Grid.Items[i].Data^).Visibl then begin if Grid.Items[i].SubItems[rowFunction - 1] <> '' then prd := Grid.Items[i].SubItems[rowFunction - 1] + '(' else prd := ''; tmpStr := tmpStr + prd + TGridColumn(Grid.Items[i].Data^).Alias + '.' + TGridColumn(Grid.Items[i].Data^).Field; if prd <> '' then prd := ')'; tmpStr := tmpStr + prd + ', ' end; tmpStr := Copy(tmpStr,1,Length(tmpStr) - 2); SQL.Add(tmpStr); //FROM tmpStr := ''; slFrom := TStringList.Create; CopyLL := TList.Create; for i := 0 to TableArea.LinkList.Count - 1 do CopyLL.Add(Pointer(i)); while CopyLL.Count <> 0 do begin for h := 0 to CopyLL.Count - 1 do HookList := HookList + '('; Tbl1 := TableArea.LinkList[0].SourceTable; Tbl2 := TableArea.LinkList[0].DestTable; slFrom.Add(strTab + Hooklist+ Tbl1.TableName + ' ' + Tbl1.AliasName); if CopyLL.Count > 1 then slFrom.Add(strTab + FormingFrom(0)) else slFrom.Add(strTab + FormingFrom(0) + ')'); for i := 1 to CopyLL.Count - 1 do begin Tbl3 := TableArea.LinkList[i].DestTable; if (Tbl3.AliasName = Tbl2.AliasName) then begin if i = CopyLL.Count - 1 then slFrom[slFrom.Count - 1] := slFrom[slFrom.Count - 1] + FormingFromAnd(Integer(CopyLL[i])) + '))' else slFrom[slFrom.Count - 1] := slFrom[slFrom.Count - 1] + FormingFromAnd(Integer(CopyLL[i])) + ')'; CopyLL[i] := Pointer(-1); end else begin Tbl1 := TableArea.LinkList[Integer(CopyLL[i])].SourceTable; Tbl2 := Tbl3; slFrom.Add(strTab + FormingFrom(Integer(CopyLL[i])) + ')'); CopyLL[i] := Pointer(-1) end end; CopyLL.Delete(0); for i := CopyLL.Count - 1 downto 0 do if Integer(CopyLL[i]) = -1 then CopyLL.Delete(i) end; flg := false; for i := 0 to Grid.Items.Count - 1 do begin tmpStr := TGridColumn(Grid.Items[i].Data^).Table + ' ' + TGridColumn(Grid.Items[i].Data^).Alias; if Pos(tmpStr, slFrom.Text) = 0 then begin if slFrom.Count <> 0 then slFrom[slFrom.Count - 1] := slFrom[slFrom.Count - 1] + ', '; slFrom.Add(strTab + tmpStr); flg := true end end; if flg then slFrom.Text := Copy(slFrom.Text,1,Length(slFrom.Text) - 2); CopyLL.Free; //WHERE slWhere := TStringList.Create; for i := 0 to Grid.Items.Count - 1 do if TGridColumn(Grid.Items[i].Data^).Where <> '' then slWhere.Add('(' + strTab + TGridColumn(Grid.Items[i].Data^).Alias + '.' + TGridColumn(Grid.Items[i].Data^).Field + ' ' + TGridColumn(Grid.Items[i].Data^).Where + ') AND'); if slWhere.Count <> 0 then begin slWhere.Text:= Copy(slWhere.Text,1,Length(slWhere.Text) - 6); slWhere.Insert(0,strWhere) end; //ORDER orderStr:= ''; prd:= ''; flg:= false; for i:= 0 to Grid.Items.Count - 1 do begin if TGridColumn(Grid.Items[i].Data^).Sort <> 0 then begin if Grid.Items[i].SubItems[rowFunction - 1] <> '' then prd := Grid.Items[i].SubItems[rowFunction - 1] + '(' else prd := ''; prd := prd + TGridColumn(Grid.Items[i].Data^).Alias + '.' + TGridColumn(Grid.Items[i].Data^).Field; if Grid.Items[i].SubItems[rowFunction - 1] <> '' then prd := prd + ')'; if TGridColumn(Grid.Items[i].Data^).Sort = 2 then prd := prd + ' DESC'; orderStr:= orderStr + prd + ', '; flg:= true; end; end; if flg then orderStr := Trim(Copy(orderStr,1,Length(orderStr) - 2)); //GROUP groupStr:= ''; flg:= false; for i:= 0 to Grid.Items.Count - 1 do begin if TGridColumn(Grid.Items[i].Data^).Group <> 0 then begin groupStr:= groupStr + TGridColumn(Grid.Items[i].Data^).Alias + '.' + TGridColumn(Grid.Items[i].Data^).Field + ', '; flg:= true; end; end; if flg then groupStr:= Copy(groupStr,1,Length(groupStr) - 2); SQL.Add(strFrom); SQL.AddStrings(slFrom); SQL.AddStrings(slWhere); if groupStr <> '' then SQL.Add(strGroup + groupStr); if orderStr <> '' then SQL.Add(strOrder + orderStr); slFrom.Free; slWhere.Free; FText := SQL.Text; Result := SQL.Text; SQL.Free end; function TfqbCore.GetEngine: TfqbEngine; begin Result := FEngine; if not Assigned(FEngine) then raise EfqbError.Create('fqbCore.Engine not assigned'); end; function TfqbCore.GetGrid: TfqbGrid; begin Result := FGrid; if not Assigned(FGrid) then raise EfqbError.Create('fqbCore.Grid not assigned'); end; function TfqbCore.GetSQL: string; begin if SchemaInsideSQL then Result := Ftext else Result := fqbCore.ExtractSQL(Ftext); end; function TfqbCore.GetSQLSchema: string; begin if SchemaInsideSQL then Result := '' else Result := fqbCore.ExtractSchema(Ftext); end; function TfqbCore.GetTableArea: TfqbTableArea; begin Result := FTableArea; if not Assigned(FTableArea) then raise EfqbError.Create('fqbCore.TableArea not assigned'); end; procedure TfqbCore.LoadFromFile(const FileName: string); var StrLst, StrSrc: TStringList; tmp, tmp2: string; begin StrLst := TStringList.Create; StrSrc := TStringList.Create; StrSrc.LoadFromFile(FileName); try tmp2 := ExtractSQL(StrSrc.Text); tmp := ExtractSchema(StrSrc.Text); if fqbCore.FUseCoding then begin tmp := fqbTrim(tmp, [#10,#13]); if tmp = '' then Exit; tmp:= fqbDeCompress(tmp) end; StrLst.Clear; StrLst.Text := tmp; tmp := fqbGetUniqueFileName('fqb'); StrLst.SaveToFile(tmp); tmp2 := fqbTrim(tmp2, [#10,#13]); fqbCore.RecognizeModel(fqbStringCRC32(tmp2), tmp); finally DeleteFile(tmp); StrLst.Free; StrSrc.Free; end; end; procedure TfqbCore.LoadFromStr(const Str: TStringList); var tmp: string; begin tmp := fqbGetUniqueFileName('fqb'); Str.SaveToFile(tmp); try fqbCore.LoadFromFile(tmp); finally DeleteFile(tmp) end end; procedure TfqbCore.RecognizeModel(const crc32: Cardinal; const FileName: string); var fqbFile: TIniFile; tbl: TStringList; i: Integer; Rec: TRect; parstr, tmpstr: string; vis: TfqbTable; lnk: TfqbLink; c: Cardinal; function IndexOf(const FieldName: string): integer; var i: integer; begin Result:= -1; for i:= 0 to vis.FieldList.Count - 1 do if TfqbField(vis.FieldList[i]).FieldName = FieldName then Result:= i; end; begin fqbFile:= TIniFile.Create(FileName); tbl:= TStringList.Create; tmpstr := fqbFile.ReadString('DataBase','SQL',''); c := StrToInt64(tmpstr); if c <> crc32 then begin ShowMessage('The file was changed. The Model can not be loaded.'); fqbFile.Free; tbl.Free; Exit end; try fqbCore.Engine.ReadTableList(TfqbTableListBox(FindFQBcomp('TfqbTableListBox',GetParentForm(TableArea))).Items); fqbFile.ReadSectionValues('Tables',tbl); try for i:= 0 to tbl.Count - 1 do begin parstr:= tbl.Values[tbl.Names[i]]; tmpstr:= fqbParse(',',parstr,1); Rec.Top:= StrToInt(fqbParse(',',parstr,2)); Rec.Left:= StrToInt(fqbParse(',',parstr,3)); Rec.Right:= StrToInt(fqbParse(',',parstr,4)); Rec.Bottom:= StrToInt(fqbParse(',',parstr,5)); if Rec.Left < 0 then Rec.Left := 0; if Rec.Top < 0 then Rec.Top := 0; TableArea.InsertTable(Rec.Left, Rec.Top, tmpstr); TfqbTable(TableArea.Components[i]).Height:= Rec.Right; TfqbTable(TableArea.Components[i]).Width:= Rec.Bottom end except fqbCore.Clear; Exit end; tbl.Clear; fqbFile.ReadSectionValues('Grid',tbl); try for i:= 0 to tbl.Count - 1 do begin parstr:=tbl.Values[tbl.Names[i]]; vis:= TableArea.FindTable(fqbParse(',',parstr,2),fqbParse(',',parstr,3)); if vis = nil then Exit; vis.ChBox.Checked[IndexOf(fqbParse(',',parstr,1))]:= true; vis.ChBox.ItemIndex:= IndexOf(fqbParse(',',parstr,1)); vis.ChBox.ClickCheck; // n:= Grid.Items.Count - 1; TGridColumn(Grid.Items[i].Data^).Table:= fqbParse(',',parstr,2); TGridColumn(Grid.Items[i].Data^).Alias:= fqbParse(',',parstr,3); TGridColumn(Grid.Items[i].Data^).Field:= fqbParse(',',parstr,1); TGridColumn(Grid.Items[i].Data^).Visibl:= Boolean(StrToInt(fqbParse(',',parstr,4))); TGridColumn(Grid.Items[i].Data^).Sort:= StrToInt(fqbParse(',',parstr,5)); TGridColumn(Grid.Items[i].Data^).Func:= StrToInt(fqbParse(',',parstr,6)); TGridColumn(Grid.Items[i].Data^).Group:= StrToInt(fqbParse(',',parstr,7)); TGridColumn(Grid.Items[i].Data^).Where:= fqbParse(',',parstr,8, True); // format: // field_name = table_name, alias, visible, sorting, function, group, where end; except fqbCore.Clear; Exit end; tbl.Clear; fqbFile.ReadSectionValues('Links',tbl); try for i:= 0 to tbl.Count - 1 do begin parstr:=tbl.Values[tbl.Names[i]]; lnk:= TfqbLink(TableArea.LinkList.Add); lnk.FArea:= TableArea; lnk.FSourceTable := TfqbTable(TableArea.Components[StrToInt(fqbParse(',',parstr,2))]); lnk.FSourceField := lnk.SourceTable.FieldList[StrToInt(fqbParse(',',parstr,1))]; lnk.SourceField.Linked := True; lnk.FDestTable := TfqbTable(TableArea.Components[StrToInt(fqbParse(',',parstr,4))]); lnk.FDestField := lnk.DestTable.FieldList[StrToInt(fqbParse(',',parstr,3))]; lnk.FDestField.Linked := True; lnk.FJType := StrToInt(fqbParse(',',parstr, 5)); lnk.FJOp := StrToInt(fqbParse(',',parstr, 6)); // format: // index = sind,slst,dind,dlst,JType,JOper end; except fqbCore.Clear; Exit end; Grid.UpdateColumn; finally fqbFile.Free; tbl.Free end end; procedure TfqbCore.SaveToFile(const FileName: string); var tmp: TStringList; begin tmp := TStringList.Create; fqbCore.SaveToStr(tmp); tmp.SaveToFile(FileName); tmp.Free; end; procedure TfqbCore.SaveToStr(var Str: TStringList); var i: Integer; tmp, tmp2: string; begin Str.Clear; tmp2 := fqbCore.GenerateSQL; tmp := fqbTrim(tmp2, [#10,#13]); if tmp = '' then Exit; Str.Add('[DataBase]'); Str.Add('SQL=' + IntToStr(fqbStringCRC32(tmp))); Str.Add('[Tables]'); for i:= 0 to TableArea.ComponentCount - 1 do begin tmp := TfqbTable(TableArea.Components[i]).AliasName + '='; tmp := tmp + TfqbTAble(TableArea.Components[i]).TableName; tmp := tmp + ',' + IntToStr(TfqbTable(TableArea.Components[i]).Top); tmp := tmp + ',' + IntToStr(TfqbTable(TableArea.Components[i]).Left); tmp := tmp + ',' + IntToStr(TfqbTable(TableArea.Components[i]).Height); tmp := tmp + ',' + IntToStr(TfqbTable(TableArea.Components[i]).Width); Str.Add(tmp); // format: // alias= tablename,top,left,height,width end; Str.Add('[Grid]'); for i:= 0 to Grid.Items.Count - 1 do begin tmp := IntToStr(i) + '='; tmp:= tmp + TGridColumn(Grid.Items[i].Data^).Field; tmp:= tmp + ',' + TGridColumn(Grid.Items[i].Data^).Table; tmp:= tmp + ',' + TGridColumn(Grid.Items[i].Data^).Alias; tmp:= tmp + ',' + IntToStr(Integer(TGridColumn(Grid.Items[i].Data^).Visibl)); tmp:= tmp + ',' + IntToStr(TGridColumn(Grid.Items[i].Data^).Sort); tmp:= tmp + ',' + IntToStr(TGridColumn(Grid.Items[i].Data^).Func); tmp:= tmp + ',' + IntToStr(TGridColumn(Grid.Items[i].Data^).Group); tmp:= tmp + ',' + TGridColumn(Grid.Items[i].Data^).Where; Str.Add(tmp); // format: // field_name = table_name, alias, visible, sorting, function, group, where end; Str.Add('[Links]'); for i:= 0 to TableArea.LinkList.Count - 1 do begin tmp:= IntToStr(i) + '='; tmp:= tmp + IntToStr(TableArea.LinkList[i].SourceField.Index); tmp:= tmp + ',' + IntToStr(TableArea.LinkList[i].SourceTable.ComponentIndex); tmp:= tmp + ',' + IntToStr(TableArea.LinkList[i].DestField.Index); tmp:= tmp + ',' + IntToStr(TableArea.LinkList[i].DestTable.ComponentIndex); tmp:= tmp + ',' + IntToStr(TfqbLink(TableArea.LinkList[i]).JoinType); tmp:= tmp + ',' + IntToStr(TfqbLink(TableArea.LinkList[i]).JoinOperator); Str.Add(tmp); // format: // index = sind,slst,dind,dlst,JType,JOper end; if fqbCore.FUseCoding then tmp := fqbCompress(str.Text) else tmp := str.Text; Str.Clear; Str.Add(tmp2); Str.Add(_fqbBeginModel); Str.Add(tmp); Str.Add(_fqbEndModel); end; procedure TfqbCore.SetSchemaInsideSQL(const Value: Boolean); begin FSchemaInsideSQL := Value; if SchemaInsideSQL then begin FSQL := fqbCore.ExtractSQL(Ftext); FSQLSchema := fqbCore.ExtractSchema(Ftext); end end; procedure TfqbCore.SetSQL(Value: string); begin FSQL := fqbCore.ExtractSQL(Value); FSQLSchema := fqbCore.ExtractSchema(Value); Ftext := FSQL + _fqbBeginModel + #$D#$A + FSQLSchema + #$D#$A + _fqbEndModel end; procedure TfqbCore.SetSQLSchema(const Value: string); begin FSQLSchema := fqbCore.ExtractSchema(Value); Ftext := FSQL + _fqbBeginModel + #$D#$A + FSQLSchema + #$D#$A + _fqbEndModel end; {----------------------- TfqbCheckListBox -----------------------} procedure TfqbCheckListBox.ClickCheck; var tmp: TfqbGrid; tbl: TfqbTable; i: Integer; begin tmp := fqbCore.Grid; tbl := (Parent as TfqbTable); if not Assigned(tmp) then raise EfqbError.Create('Class TfqbGrid not fount on form.'); if State[ItemIndex] = cbChecked then begin i:= tmp.AddColumn; TGridColumn(tmp.Items[i].Data^).Table:= tbl.TableName; TGridColumn(tmp.Items[i].Data^).Field:= tbl.FieldList[ItemIndex].FieldName; TGridColumn(tmp.Items[i].Data^).Alias:= tbl.AliasName; TGridColumn(tmp.Items[i].Data^).Where:= ''; TGridColumn(tmp.Items[i].Data^).Sort:= 0; TGridColumn(tmp.Items[i].Data^).Func:= 0; TGridColumn(tmp.Items[i].Data^).Group:= 0; TGridColumn(tmp.Items[i].Data^).Visibl:= True end else if State[ItemIndex] = cbUnchecked then begin for i:= tmp.Items.Count - 1 downto 0 do begin if ((TGridColumn(tmp.Items[i].Data^).Table = tbl.TableName) and (TGridColumn(tmp.Items[i].Data^).Field = tbl.FieldList[ItemIndex].FieldName)) then begin FreeMem(tmp.Items[i].Data, SizeOf(TGridColumn)); tmp.Items.Delete(i) end end end; tmp.UpdateColumn; Repaint; inherited ClickCheck; end; procedure TfqbCheckListBox.DragDrop(Sender: TObject; X, Y: Integer); var lnk: TfqbLink; begin lnk := (Parent.Parent as TfqbTableArea).LinkList.Add; lnk.FArea := Parent.Parent as TfqbTableArea; lnk.FSourceField := ((Sender as TControl).Parent as TfqbTable).SellectedField; lnk.FSourceField.Linked := true; lnk.FSourceTable := (Sender as TControl).Parent as TfqbTable; lnk.FDestField := (Self.Parent as TfqbTable).SellectedField; lnk.FDestField.Linked := true; lnk.FDestTable := Self.Parent as TfqbTable; TfqbTableArea(Parent.Parent).Invalidate; TfqbTable((Sender as TControl).Parent).Invalidate; Invalidate end; procedure TfqbCheckListBox.DragOver(Sender: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); var int: Integer; begin Accept := False; if ((not (Sender is TfqbCheckListBox)) or (Self = Sender)) then Exit; int := (Self as TfqbCheckListBox).ItemAtPos(Point(X,Y),True); if (int > (Self as TfqbCheckListBox).Items.Count - 1) or (int < 0) then Exit; (Self as TfqbCheckListBox).ItemIndex:= int; if not (Parent.Parent as TfqbTableArea).CompareFields(Parent.ComponentIndex, int, (Sender as TfqbCheckListBox).Parent.ComponentIndex, (Sender as TfqbCheckListBox).ItemIndex) then Exit; Accept := True end; {----------------------- TfqbGrid -----------------------} constructor TfqbGrid.Create(AOwner: TComponent); var i: Integer; mi: TMenuItem; begin inherited Create(AOwner); for i:= 0 to 5 do with Columns.Add do begin case i of rowColumn : Caption := fqbGet(1820); rowVisibility: Caption := fqbGet(1821); rowWhere : Caption := fqbGet(1822); rowSort : Caption := fqbGet(1823); rowFunction : Caption := fqbGet(1824); rowGroup : Caption := fqbGet(1825); end; Width := 80; end; ViewStyle := vsReport; ColumnClick := False; HideSelection := False; Width := 300; DragMode := dmAutomatic; OnSelectItem := fqbOnSelectItem; FPopupMenu := TPopupMenu.Create(Self); mi := TMenuItem.Create(FPopupMenu); mi.Caption := fqbGet(1826); mi.OnClick := fqbOnMenu; mi.Tag := -1; FPopupMenu.Items.Add(mi); mi := TMenuItem.Create(FPopupMenu); mi.Caption := fqbGet(1827); mi.OnClick := fqbOnMenu; mi.Tag := 1; FPopupMenu.Items.Add(mi); FPopupMenu.OnPopup := fqbOnPopup; PopupMenu := FPopupMenu; end; destructor TfqbGrid.Destroy; var i: Integer; begin for i:= 0 to Items.Count - 1 do Dispose(PGridColumn(Items[i])); inherited end; function TfqbGrid.AddColumn: Integer; var tmp: TListItem; p: PGridColumn; begin tmp := Items.Add; tmp.SubItems.Add(''); tmp.SubItems.Add(''); tmp.SubItems.Add(''); tmp.SubItems.Add(''); tmp.SubItems.Add(''); New(p); tmp.Data := p; Result:= tmp.Index end; procedure TfqbGrid.CreateWnd; var wnd: HWND; begin inherited CreateWnd; FVisibleList := TComboBox.Create(Self); FVisibleList.Visible := false; FVisibleList.Parent := Self; FVisibleList.Style := csOwnerDrawFixed; FVisibleList.ItemHeight := 12; FVisibleList.Items.Add(fqbGet(1828)); FVisibleList.Items.Add(fqbGet(1829)); FVisibleList.OnChange := fqbOnChange; FVisibleList.Tag := rowVisibility; FWhereEditor:= TfqbEdit.Create(Self); FWhereEditor.Visible := false; FWhereEditor.Parent := Self; FWhereEditor.OnChange := fqbOnChange; FWhereEditor.Tag := rowWhere; FSortList := TComboBox.Create(Self); FSortList.Visible := false; FSortList.Parent := Self; FSortList.Style := csOwnerDrawFixed; FSortList.ItemHeight := 12; FSortList.Items.Add(fqbGet(1830)); FSortList.Items.Add(fqbGet(1831)); FSortList.Items.Add(fqbGet(1832)); FSortList.OnChange := fqbOnChange; FSortList.Tag := rowSort; FFunctionList := TComboBox.Create(Self); FFunctionList.Visible := false; FFunctionList.Parent := Self; FFunctionList.Style := csOwnerDrawFixed; FFunctionList.ItemHeight := 12; FFunctionList.Items.Add(fqbGet(1830)); FFunctionList.Items.Add('AVG'); FFunctionList.Items.Add('COUNT'); FFunctionList.Items.Add('MAX'); FFunctionList.Items.Add('MIN'); FFunctionList.Items.Add('SUM'); FFunctionList.OnChange := fqbOnChange; FFunctionList.Tag := rowFunction; FGroupList := TComboBox.Create(Self); FGroupList.Visible := False; FGroupList.Parent := Self; FGroupList.Style := csOwnerDrawFixed; FGroupList.ItemHeight := 12; FGroupList.Items.Add(fqbGet(1830)); FGroupList.Items.Add(fqbGet(1833)); FGroupList.OnChange := fqbOnChange; FGroupList.Tag := rowGroup; RecalcColWidth; wnd := GetWindow(Handle, GW_CHILD); SetWindowLong(wnd, GWL_STYLE, GetWindowLong(wnd, GWL_STYLE) and not HDS_FULLDRAG) end; procedure TfqbGrid.DoColumnResize(ColumnIndex, ColumnWidth: Integer); begin // RecalcColWidth; fqbUpdate; if Assigned(FEndColumnResizeEvent) then FEndColumnResizeEvent(Self, ColumnIndex, ColumnWidth) end; procedure TfqbGrid.Exchange(const AItm1, AItm2: integer); var tmpStr: string; tmpDat: Pointer; begin tmpStr := Items[AItm1].Caption; tmpDat := Items[AItm1].Data; Items[AItm1].Caption := Items[AItm2].Caption; Items[AItm1].Data := Items[AItm2].Data; Items[AItm2].Caption := tmpStr; Items[AItm2].Data := tmpDat; fqbUpdate; end; function TfqbGrid.FindColumnIndex(pHeader: pNMHdr): Integer; var hwndHeader: HWND; ItemInfo: THdItem; ItemIndex: Integer; buf: array [0..128] of Char; begin Result := -1; hwndHeader := pHeader^.hwndFrom; ItemIndex := pHDNotify(pHeader)^.Item; FillChar(iteminfo, SizeOf(iteminfo), 0); iteminfo.Mask := HDI_TEXT; iteminfo.pszText := buf; iteminfo.cchTextMax := SizeOf(buf) - 1; Header_GetItem(hwndHeader, ItemIndex, iteminfo); if CompareStr(Columns[ItemIndex].Caption, iteminfo.pszText) = 0 then Result := ItemIndex else begin for ItemIndex := 0 to Columns.Count - 1 do if CompareStr(Columns[ItemIndex].Caption, iteminfo.pszText) = 0 then begin Result := ItemIndex; Break; end end end; function TfqbGrid.FindColumnWidth(pHeader: pNMHdr): Integer; begin Result := -1; if Assigned(PHDNotify(pHeader)^.pItem) and ((PHDNotify(pHeader)^.pItem^.mask and HDI_WIDTH) <> 0) then Result := PHDNotify(pHeader)^.pItem^.cxy; end; procedure TfqbGrid.fqbOnChange(Sender: TObject); var tmp: TcrTControl; begin if Selected = nil then Exit; tmp := TcrTControl(Sender); if tmp.ClassName = 'TComboBox' then if TComboBox(tmp).ItemIndex = 0 then Selected.SubItems[tmp.tag - 1] := '' else Selected.SubItems[tmp.tag - 1] := tmp.Text; if tmp.ClassName = 'TfqbEdit' then Selected.SubItems[tmp.tag - 1] := tmp.Text; if tmp.tag = rowVisibility then TGridColumn(Selected.Data^).Visibl := (TComboBox(tmp).ItemIndex = 0); if tmp.tag = rowWhere then TGridColumn(Selected.Data^).Where := tmp.Caption; if tmp.tag = rowSort then TGridColumn(Selected.Data^).Sort := TComboBox(tmp).ItemIndex; if tmp.tag = rowFunction then TGridColumn(Selected.Data^).Func := TComboBox(tmp).ItemIndex; if tmp.tag = rowGroup then TGridColumn(Selected.Data^).Group := TComboBox(tmp).ItemIndex; end; procedure TfqbGrid.fqbOnMenu(Sender: TObject); begin Exchange(Selected.Index, Selected.Index + (Sender as TComponent).Tag); Items[Selected.Index + (Sender as TComponent).Tag].Selected := True; UpdateColumn end; procedure TfqbGrid.fqbOnPopup(Sender: TObject); begin if Assigned(Selected) then begin FPopupMenu.Items[0].Enabled := Selected.Index <> 0; FPopupMenu.Items[1].Enabled := Selected.Index <> Items.Count - 1; end else begin FPopupMenu.Items[0].Enabled := False; FPopupMenu.Items[1].Enabled := False; end end; procedure TfqbGrid.fqbOnSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean); var tmp: TfqbTableArea; tbl: TfqbTable; i: Integer; begin fqbUpdate; tmp := fqbCore.TableArea; if not Assigned(tmp) then Exit; tbl := tmp.FindTable(TGridColumn(Item.Data^).Table, TGridColumn(Item.Data^).Alias); if not Assigned(tbl) then Exit; tbl.BringToFront; for i:= 0 to tbl.FieldList.Count - 1 do if tbl.FieldList[i].FieldName = TGridColumn(Item.Data^).Field then tbl.ChBox.ItemIndex := i; end; procedure TfqbGrid.fqbSetBounds(var Contr: TControl); var i: Integer; begin Contr.Visible := false; if Selected = nil then Exit; if Assigned(TopItem) then if TopItem.Index > Selected.Index then Exit; Contr.Width := Columns[Contr.Tag].Width + 1; Contr.Top := Selected.Top - 2; Contr.Left := 0; for i:= 0 to Contr.Tag - 1 do Contr.Left := Contr.Left + Columns[i].Width; Contr.Height := 19; if Contr.ClassName = 'TComboBox' then begin TComboBox(Contr).ItemIndex := TComboBox(Contr).Items.IndexOf(Selected.SubItems[Contr.Tag - 1]); end else if Contr.ClassName = 'TfqbEdit' then begin TcrTControl(Contr).Text := Selected.SubItems[Contr.Tag - 1]; end; Contr.Visible := true; end; procedure TfqbGrid.fqbUpdate; begin if not (Assigned(FVisibleList) and Assigned(FWhereEditor) and Assigned(FSortList) and Assigned(FFunctionList) and Assigned(FGroupList)) then Exit; fqbSetBounds(TControl(FVisibleList)); fqbSetBounds(TControl(FWhereEditor)); fqbSetBounds(TControl(FSortList)); fqbSetBounds(TControl(FFunctionList)); fqbSetBounds(TControl(FGroupList)); FWhereEditor.Height := 18; end; procedure TfqbGrid.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin Selected := GetItemAt(5, Y); ItemFocused := Selected end; procedure TfqbGrid.RecalcColWidth; var i, n: Integer; w, dw: Integer; p: Real; begin if not Assigned(FVisibleList) then Exit; w:= 0; n := Columns.Count - 1; for i := 0 to n do w := w + Columns[i].Width; dw := 0; for i := 0 to n do begin if (w = 0) then p := Columns[i].Width else p := Columns[i].Width / w; Columns[i].Width := Round(p * (Width - 4)); dw := dw + Columns[i].Width; end; Columns[n].Width := Columns[n].Width + (Width - dw - 4); end; procedure TfqbGrid.Resize; begin inherited; RecalcColWidth; fqbUpdate end; procedure TfqbGrid.UpdateColumn; var i: Integer; begin for i:= 0 to Items.Count - 1 do begin Items[i].Caption := TGridColumn(Items[i].Data^).Field; if TGridColumn(Items[i].Data^).Visibl then Items[i].SubItems[rowVisibility - 1] := '' else Items[i].SubItems[rowVisibility - 1] := FVisibleList.Items[1]; Items[i].SubItems[rowWhere - 1]:= TGridColumn(Items[i].Data^).Where; if TGridColumn(Items[i].Data^).Sort = 0 then Items[i].SubItems[rowSort - 1]:= '' else Items[i].SubItems[rowSort - 1]:= FSortList.Items[TGridColumn(Items[i].Data^).Sort]; if TGridColumn(Items[i].Data^).Func = 0 then Items[i].SubItems[rowFunction - 1]:= '' else Items[i].SubItems[rowFunction - 1]:= FFunctionList.Items[TGridColumn(Items[i].Data^).Func]; if TGridColumn(Items[i].Data^).Group = 0 then Items[i].SubItems[rowGroup - 1]:= '' else Items[i].SubItems[rowGroup - 1]:= FGroupList.Items[TGridColumn(Items[i].Data^).Group]; end end; procedure TfqbGrid.WMNotify(var Msg: TWMNotify); begin inherited; case Msg.NMHdr^.code of HDN_ENDTRACK: DoColumnResize(FindColumnIndex(Msg.NMHdr), FindColumnWidth(Msg.NMHdr)); end end; procedure TfqbGrid.WMVscroll(var Msg: TWMNotify); begin inherited; fqbUpdate end; {----------------------- TfqbEdit -----------------------} constructor TfqbEdit.Create(AOwner: TComponent); begin inherited Create(AOwner); FPanel := TPanel.Create(Self); FPanel.Parent := Self; FPanel.Align := alRight; FPanel.Width := Height - 3; FPanel.BevelOuter := bvNone; FButton := TSpeedButton.Create(Self); FButton.Parent := FPanel; FButton.Align := alClient; FButton.OnClick := ButtonClick; end; procedure TfqbEdit.ButtonClick(Sender: TObject); begin SetFocus; if Assigned(FOnButtonClick) then FOnButtonClick(Self); end; procedure TfqbEdit.CreateParams(var Params: TCreateParams); begin inherited CreateParams(Params); Params.Style := Params.Style or WS_CLIPCHILDREN; end; procedure TfqbEdit.CreateWnd; begin inherited; ShowButton := false; end; procedure TfqbEdit.SetEditRect; var Rec: TRect; begin SendMessage(Handle, EM_GETRECT, 0, LongInt(@Rec)); if ShowButton then begin Rec.Bottom := ClientHeight + 1; Rec.Right := ClientWidth - FPanel.Width - 1 end else begin Rec.Bottom := ClientHeight + 1; Rec.Right := ClientWidth; end; Rec.Top := 0; Rec.Left := 0; SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@Rec)); end; procedure TfqbEdit.SetShowButton(const Value: Boolean); begin FShowButton := Value; FPanel.Visible := Value; SetEditRect end; procedure TfqbEdit.WMSize(var Message: TWMSize); begin inherited; SetEditRect end; procedure TfqbTable.CMRelease(var Message: TMessage); begin Free end; initialization RegisterClasses([TComboBox, TfqbEdit]); {$IFDEF FQB_COM} TComponentFactory.Create(ComServer, TfqbDialog, CLASS_FastQueryBuilder_, ciMultiInstance, tmApartment); {$ENDIF} finalization if FfqbCore <> nil then FfqbCore.Free; end.