Delphi/FastReport_2022_VCL
Delphi/FastReport_2022_VCL
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
master
FastReport_2022_VCL/LibD28/fqbClass.pas
Daso e6303fc1c0 Inicijalizacija
2024-01-01 16:13:08 +01:00

2395 lines
64 KiB
ObjectPascal
Raw Permalink Blame History

{*******************************************}
{ }
{ 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.
Reference in New Issue View Git Blame Copy Permalink