📄 uquerymaker.pas
字号:
unit uQueryMaker;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, DB, ABSMain, Grids, ExtCtrls, Menus, ABSTypes,
ComCtrls, ToolWin, StdCtrls;
const
ClSelectedField = $00F3D9D9;
ClBasicTable = $00D76544;
ClFieldType = $00D76544;
ClIndexField = $00FAE8E6;
MaxHorz = 1000;
MaxVert = 1000;
const
TJoinColors: array[TABSJoinType] of TColor = (ClBlack, ClPurple, ClBlue, ClGreen, ClRed);
TJoinDescrUpper: array[TABSJoinType] of string[20] =
(#13#10' CROSS JOIN', #13#10' INNER JOIN', #13#10' LEFT OUTER JOIN',
#13#10' RIGHT OUTER JOIN', #13#10' FULL OUTER JOIN');
TJoinDescrLower: array[TABSJoinType] of string[20] =
(#13#10' cross join', #13#10' inner join', #13#10' left outer join',
#13#10' right outer join', #13#10' full outer join');
SNameField = 'Field name';
SSort = 'Order by';
SOrCond = 'Or condition';
SAgregate = 'Agregate function';
STypeField = 'Field type';
SCondition = 'Where condition';
SGroup = 'Group by';
SHaving = 'Having';
SAliasTable = 'Table alias';
SNameTable = 'Table name';
SVisible = 'Displaying';
SDatabase = 'Database file';
SCalcField = 'calc';
sNewProject = 'New project';
sMakerCaption = 'Query maker {%s}';
SDelCalcField = 'Delete ''%s'' defined as:'#13#10 + '%s';
SAddEditCalcField = 'Definition of ''%s'' is empty.'#13#10 + 'Operation cancelled';
SAddCalcField = 'Calc field name is empty.'#13#10 + 'Operation cancelled';
SDefCalcField = 'Calc field ''%s'' defined as:'#13#10 + ' %s';
SWhereCondition = 'First define ''Where condition'' for this field';
SHavingCondition = 'First define ''Agregate function'' or ''Group'' for this field';
sfRemove = 'Remove ''%s''';
sEditCalcFld = 'Edit Calc Field';
sDelCalcFld = 'Del Calc Field';
sfEditCalcFld = 'Edit Calc Field ''%s''';
sfDelCalcFld = 'Del Calc Field ''%s''';
sRemoveAllCols = 'Remove All Cols';
sFileNotFound = 'File "%s" not found';
ChmHelpFileName = 'QueryMaker.chm';
sIntoTable = 'NewTable';
sShowQueryMaker = 'Show Query Maker';
sHideQueryMaker = 'Hide Query Maker';
sqmFileExt = '.sqm';
SFAgregate: array[0..5] of string[10] =
('None', 'Average', 'Count', 'Max', 'Min', 'Sum');
SFSort: array[0..2] of string[10] =
('None', 'Ascending', 'Descending');
SFShow: array[0..2] of string[11] = ('Show', 'Hide', 'On new line');
sDelimiter = #149;
type
TCols = class(TComponent)
Private
FSel: TStringList;
FObj: TStringList;
Public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
Published
property Sel: TStringList Read FSel Write FSel;
property Obj: TStringList Read FObj Write FObj;
end;
TItem = class(TObject)
Private
FItem: string;
Public
constructor Create(Value: string);
Published
property Item: string Read FItem Write FItem;
end;
TJoinImage = class(TGraphicControl)
Private
FFromTableJoin: longint;
FToTableJoin: longint;
FFromFieldJoin: integer;
FToFieldJoin: integer;
FABSJoinType: TABSJoinType;
FDescription: string;
FFromPoint: TPoint;
FToPoint: TPoint;
procedure WriteToFile(Fs: TFileStream);
procedure ReadFromFile(Fs: TFileStream);
Public
constructor Create(AOwner: TComponent); override;
procedure Paint; override;
Published
property FromTableJoin: longint Read FFromTableJoin Write FFromTableJoin;
property ToTableJoin: longint Read FToTableJoin Write FToTableJoin;
property FromFieldJoin: integer Read FFromFieldJoin Write FFromFieldJoin;
property ToFieldJoin: integer Read FToFieldJoin Write FToFieldJoin;
property ABSJoinType: TABSJoinType Read FABSJoinType Write FABSJoinType;
property Description: string Read FDescription Write FDescription;
property FromPointX: integer Read FFromPoint.X Write FFromPoint.X;
property FromPointY: integer Read FFromPoint.Y Write FFromPoint.Y;
property ToPointX: integer Read FToPoint.X Write FToPoint.X;
property ToPointY: integer Read FToPoint.Y Write FToPoint.Y;
end;
TColumnsParams = class(TComponent)
Private
FType: string;
FIsIndex: boolean;
FFormula: string;
FIsCalc: boolean;
FCoord: TPoint;
FNameWidth: integer;
FTypeWidth: integer;
FNameColor: TColor;
FTypeColor: TColor;
procedure WriteToFile(Fs: TFileStream);
procedure ReadFromFile(Fs: TFileStream);
Public
constructor Create(AOwner: TComponent); override;
Published
property IsIndex: boolean Read FIsIndex Write FIsIndex;
property Formula: string Read FFormula Write FFormula;
property IsCalc: boolean Read FIsCalc Write FIsCalc;
property FieldType: string Read FType Write FType;
property XCoord: integer Read FCoord.X Write FCoord.X;
property YCoord: integer Read FCoord.Y Write FCoord.Y;
property NameWidth: integer Read FNameWidth Write FNameWidth;
property TypeWidth: integer Read FTypeWidth Write FTypeWidth;
property NameColor: TColor Read FNameColor Write FNameColor;
property TypeColor: TColor Read FTypeColor Write FTypeColor;
end;
TPosChange = procedure(Sender: TObject; Top, Left: integer) of object;
TTableImage = class(TCustomPanel)
Private
FTableNumber: integer;
FColumns: TStrings;
FDatabaseFileName: string;
FMouseIn: boolean;
FlastPosYTop: integer;
FlastPosYBottom: integer;
FSelItem: integer;
FClearSel: boolean;
FOnPosChange: TPosChange;
FHeaderHeight: Integer;
procedure SetCaptionTable(const Value: TCaption);
function GetCaptionTable: TCaption;
procedure ColumnsChange(Sender: TObject);
function GetTableAlias: string;
procedure WriteToFile(Fs: TFileStream);
procedure ReadFromFile(Fs: TFileStream);
Protected
procedure Paint; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: integer); override;
procedure MouseEnter(var Msg: Tmessage); message CM_MOUSEENTER;
procedure MouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
procedure WMWINDOWPOSCHANGED(var Msg: Tmessage); message WM_WINDOWPOSCHANGED;
Public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function GetMaxWidth: integer;
function GetMaxHeight: integer;
function GetSelItem(Y: integer): integer;
procedure SetWidthHeight;
Published
property OnPosChange: TPosChange Read FOnPosChange Write FOnPosChange;
property CaptionTable: TCaption Read GetCaptionTable Write SetCaptionTable;
property SelectedItem: integer Read FSelItem Write FSelItem;
property Columns: TStrings Read FColumns Write FColumns;
property TableAlias: string Read GetTableAlias;
property DatabaseFileName: string Read FDatabaseFileName Write FDatabaseFileName;
property TableNumber: integer Read FTableNumber Write FTableNumber;
property HeaderHeight: Integer read FHeaderHeight write FHeaderHeight;
end;
TfrmQueryMaker = class(TForm)
SgColumns: TStringGrid;
PmGrid: TPopupMenu;
PmTable: TPopupMenu;
RemoveTable: TMenuItem;
AddCalcFld: TMenuItem;
PmJoin: TPopupMenu;
Crossjoin: TMenuItem;
Innerjoin: TMenuItem;
Leftouterjoin: TMenuItem;
Rightouterjoin: TMenuItem;
Fullouterjoin: TMenuItem;
N1: TMenuItem;
Removejoin: TMenuItem;
EditCalcFld: TMenuItem;
DelCalcFld: TMenuItem;
N2: TMenuItem;
RemoveAllTbls: TMenuItem;
ToolBar1: TToolBar;
CbDistinct: TCheckBox;
ToolButton1: TToolButton;
RemoveAllCols: TMenuItem;
RemoveSelCol: TMenuItem;
cbLowerCase: TCheckBox;
cbDoubleQuotes: TCheckBox;
Label1: TLabel;
cbIntoTable: TCheckBox;
cbSaveComments: TCheckBox;
cbMemory: TCheckBox;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure PmNoSortClick(Sender: TObject);
procedure PmASCClick(Sender: TObject);
procedure PmDESCClick(Sender: TObject);
procedure PmJoinPopup(Sender: TObject);
procedure CrossjoinClick(Sender: TObject);
procedure PmTablePopup(Sender: TObject);
procedure AddCalcFldClick(Sender: TObject);
procedure EditCalcFldClick(Sender: TObject);
procedure DelCalcFldClick(Sender: TObject);
procedure RemoveTableClick(Sender: TObject);
procedure RemoveAllTblsClick(Sender: TObject);
procedure CbDistinctClick(Sender: TObject);
procedure RemoveSelColClick(Sender: TObject);
procedure RemoveAllColsClick(Sender: TObject);
procedure SgColumnsDrawCell(Sender: TObject; ACol, ARow: integer; Rect: TRect; State: TGridDrawState);
procedure SgColumnsSelectCell(Sender: TObject; ACol, ARow: integer; var CanSelect: boolean);
procedure SgColumnsColumnMoved(Sender: TObject; FromIndex, ToIndex: integer);
procedure SgColumnsContextPopup(Sender: TObject; MousePos: TPoint; var Handled: boolean);
procedure SgColumnsMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: boolean);
procedure SgColumnsDragOver(Sender, Source: TObject; X, Y: integer; State: TDragState; var Accept: boolean);
procedure SgColumnsDragDrop(Sender, Source: TObject; X, Y: integer);
procedure SgColumnsClick(Sender: TObject);
procedure Label1Click(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure Label1MouseEnter(Sender: TObject);
procedure Label1MouseLeave(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormHide(Sender: TObject);
Protected
procedure CreateParams(var Params: TCreateParams); override;
Private
FTablesBoard: TForm;
FTableCounter: integer;
FSelectedJoin: integer;
FTablesList: TList;
FJoinsList: TList;
IsWheel: boolean;
procedure WheelWndProc(var Msg: TMsg; var Handled: boolean);
procedure AgregateClick(Sender: TObject);
procedure VisibleClick(Sender: TObject);
procedure tbMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: integer);
procedure tbDragOver(Sender, Source: TObject; X, Y: integer; State: TDragState; var Accept: boolean);
procedure tbDragDrop(Sender, Source: TObject; X, Y: integer);
procedure SetGrouped;
procedure ResetGrouped(Col: integer);
procedure ResetSort(Col: integer);
procedure SgColumnsInit;
procedure SelectColumn(ACol: longint);
procedure DeleteColumn(ColNo: integer);
procedure SetDescrJoin(IndJoin: integer);
procedure ExecJoin(IndMenu, IndJoin: integer);
procedure AjustPosWidthTables(var APos: TPoint; var AWidth: integer);
procedure AddColumn(T: TTableImage);
procedure TableImageDragOver(Sender, Source: TObject; X, Y: integer; State: TDragState; var Accept: boolean);
procedure TableImageDragDrop(Sender, Source: TObject; X, Y: integer);
procedure TableImagePosChange(Sender: TObject; Top, Left: integer);
procedure TableImageDblClick(Sender: TObject);
function IsValidColRow(ACol, ARow: integer): boolean;
procedure GenerateSQL(Re: TRichEdit);
function AreTypesCompatible(T1, T2: TABSAdvancedFieldType): boolean;
Public
FCurCaption: TCaption;
procedure RemoveAllTables(LblShow: boolean);
procedure AddTable(Table: TABSTable; APos: TPoint);
procedure WriteToFile(const FileName: string);
procedure ReadFromFile(const FileName: string);
end;
var
FrmQueryMaker: TfrmQueryMaker;
implementation
uses Main, ABSConverts, ABSLexer, UCondition, ShellApi;
{$R *.dfm}
function TfrmQueryMaker.AreTypesCompatible(T1, T2: TABSAdvancedFieldType): boolean;
const
BadTypes1: set of TABSAdvancedFieldType =
[AftUnknown, AftBytes, AftVarBytes, AftBlob, AftGraphic, AftMemo, AftFormattedMemo, AftWideMemo, AftGuid];
IntTypes1: set of TABSAdvancedFieldType =
[AftShortint, AftSmallint, AftInteger, AftLargeint, AftByte, AftWord,
AftCardinal, AftAutoInc, AftAutoIncShortint, AftAutoIncSmallint, AftAutoIncInteger,
AftAutoIncLargeint, AftAutoIncByte, AftAutoIncWord, AftAutoIncCardinal];
NumTypes1: set of TABSAdvancedFieldType = [AftSingle, AftDouble, AftExtended, AftCurrency];
DateTypes1: set of TABSAdvancedFieldType = [AftDate, AftTime, AftDateTime, AftTimeStamp];
begin
Result := False;
if (T1 in BadTypes1) or (T2 in Badtypes1) then begin
Exit
end;
case T1 of
AftChar: begin
Result := T2 = AftChar
end;
AftString: begin
Result := T2 = AftString
end;
AftWideChar: begin
Result := T2 = AftWideChar
end;
AftWideString: begin
Result := T2 = AftWideString
end;
AftShortint, AftSmallint, AftInteger, AftLargeint, AftByte, AftWord, AftCardinal,
AftAutoInc, AftAutoIncShortint, AftAutoIncSmallint, AftAutoIncInteger, AftAutoIncLargeint,
AftAutoIncByte, AftAutoIncWord, AftAutoIncCardinal: begin
Result := T2 in IntTypes1
end;
AftBoolean: begin
Result := T2 = AftBoolean
end;
AftSingle, AftDouble, AftExtended, AftCurrency: begin
Result := T2 in NumTypes1
end;
AftDate, AftTime, AftDateTime, AftTimeStamp: begin
Result := T2 in DateTypes1
end;
end;
end;
procedure TfrmQueryMaker.CreateParams(var Params: TCreateParams);
begin
inherited;
with Params do begin
Style := Style or WS_OVERLAPPED;
WndParent := FrmMain.Handle;
end;
end;
procedure TfrmQueryMaker.AddTable(Table: TABSTable; APos: TPoint);
function IsItIndex(Table: TABSTable; FieldName: string): boolean;
var
I: integer;
begin
Result := False;
for I := 0 to Table.IndexDefs.Count - 1 do begin
if Pos(FieldName, Table.IndexDefs[I].Fields) <> 0 then begin
Result := True;
Break;
end;
end;
end;
var
I, AWidth: integer;
S: string;
T: TTableImage;
PosTable: TPoint;
begin
Label1.Visible := False;
Inc(FTableCounter);
T := TTableImage.Create(Self);
T.TableNumber := FTableCounter;
T.DatabaseFileName := ExtractFileName(Table.Database.DatabaseFileName);
T.Parent := FTablesBoard;
T.HeaderHeight := Canvas.TextHeight('Wj') + 4;
T.Caption := Table.TableName;
S := '*';
T.FColumns.AddObject(S, TColumnsParams.Create(T));
with(T.FColumns.Objects[T.FColumns.Count - 1] as TColumnsParams) do begin
FNameWidth := Canvas.TextWidth(S);
FIsIndex := IsItIndex(Table, Trim(S));
FType := 'all fields';
FTypeWidth := Canvas.TextWidth(FType);
FNameColor := ClBlack;
FTypeColor := ClFieldType;
end;
for I := 0 to Table.AdvFieldDefs.Count - 1 do begin
S := Table.AdvFieldDefs[I].Name;
T.FColumns.AddObject(S, TColumnsParams.Create(T));
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -