其中一些常量及过程请看
http://www.delphibbs.com/delphibbs/dispq.asp?lid=1425701
中Global.pas的声明
//dfm文件
object SQLEditFrame: TSQLEditFrame
Left = 0
Top = 0
Width = 604
Height = 19
AutoScroll = False
AutoSize = True
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
ParentFont = False
TabOrder = 0
object labFieldName: TLabel
Left = 0
Top = 3
Width = 100
Height = 12
Alignment = taRightJustify
AutoSize = False
Caption = 'labFieldName'
FocusControl = CmbWhere1
end
object CmbWhere1: TDBComboBoxEh
Left = 104
Top = 0
Width = 72
Height = 19
Cursor = crArrow
Hint = #36873#25321#26465#20214#20851#31995
AutoSize = False
DropDownBox.Sizable = True
EditButtons = <>
Flat = True
ImeMode = imOpen
TabOrder = 0
Visible = True
OnChange = SQLChange
OnDblClick = CmbDblClick
OnKeyDown = CmbKeyDown
OnKeyPress = CmbKeyPress
end
object CmbValue1: TDBComboBoxEh
Left = 177
Top = 0
Width = 145
Height = 19
Hint = #36873#25321#25110#38190#20837#20540
AutoSize = False
DropDownBox.Sizable = True
EditButtons = <>
Flat = True
ImeMode = imOpen
TabOrder = 1
Visible = True
OnChange = CmbValue1Change
OnDblClick = CmbDblClick
end
object CmbNext: TDBComboBoxEh
Left = 331
Top = 0
Width = 54
Height = 19
Cursor = crArrow
Hint = #21478#19968#20010#26465#20214
AutoSize = False
DropDownBox.Sizable = True
EditButtons = <>
Flat = True
ImeMode = imOpen
Items.Strings = (
#26080
#32780#19988
#25110#32773
#32780#19988#38750
#25110#32773#38750)
TabOrder = 2
Text = #26080
Visible = True
OnChange = CmbNextChange
OnDblClick = CmbDblClick
OnKeyDown = CmbKeyDown
OnKeyPress = CmbKeyPress
end
object CmbWhere2: TDBComboBoxEh
Left = 386
Top = 0
Width = 72
Height = 19
Cursor = crArrow
Hint = #36873#25321#26465#20214#20851#31995
AutoSize = False
DropDownBox.Sizable = True
Enabled = False
EditButtons = <>
Flat = True
ImeMode = imOpen
TabOrder = 3
Visible = True
OnChange = SQLChange
OnDblClick = CmbDblClick
OnKeyDown = CmbKeyDown
OnKeyPress = CmbKeyPress
end
object CmbValue2: TDBComboBoxEh
Left = 459
Top = 0
Width = 145
Height = 19
Hint = #36873#25321#25110#38190#20837#20540
AutoSize = False
DropDownBox.Sizable = True
Enabled = False
EditButtons = <>
Flat = True
ImeMode = imOpen
TabOrder = 4
Visible = True
OnChange = SQLChange
OnDblClick = CmbDblClick
end
end
//------------------------------------------------------------------------------
//SqlEdit.pas,SqlEdit.dfm
//一个字段对应的Frame,根据数据库属性生成
//------------------------------------------------------------------------------
unit SqlEdit;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls,ADODB, DB,StrUtils, DBCtrls,TFlatComboBoxUnit, Mask, DBCtrlsEh,
Global,MainDM;
type
TSQLEditFrame = class(TFrame)
CmbWhere1: TDBComboBoxEh;
CmbValue1: TDBComboBoxEh;
CmbNext: TDBComboBoxEh;
CmbWhere2: TDBComboBoxEh;
CmbValue2: TDBComboBoxEh;
labFieldName: TLabel;
procedure CmbNextChange(Sender: TObject);
procedure SQLChange(Sender: TObject);
procedure CmbKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure CmbKeyPress(Sender: TObject; var Key: Char);
procedure CmbDblClick(Sender: TObject);
procedure CmbValue1Change(Sender: TObject);
private
FOnCreateSQLFrame,FOnDeleteSQLFrame,FOnSQLChange: TNotifyEvent;
FFieldName:string;
FFieldType:integer;
procedure SetFieldName(Value:string);
{ Private declarations }
protected
public
function GetSqlString():string;
property FieldName:string read FFieldName write SetFieldName;
{ Public declarations }
published
property OnCreateSQLFrame: TNotifyEvent read FOnCreateSQLFrame write FOnCreateSQLFrame;
property OnDeleteSQLFrame: TNotifyEvent read FOnDeleteSQLFrame write FOnDeleteSQLFrame;
property OnSQLChange: TNotifyEvent read FOnSQLChange write FOnSQLChange;
end;
implementation
{$R *.dfm}
procedure TSQLEditFrame.SetFieldName(Value:string);
//根据字段名取得属性及设置条件
var
i:integer;
s,sFrom:string;
begin
FFieldName:=value;
labFieldName.Caption:=FFieldName+':';
FFieldType:=0;
if rsTabFields.Locate(SField_Name,FFieldName,[]) then
begin
FFieldType:=rsTabFields.FieldByName(SField_Type).AsInteger;
sFrom:=rsTabFields.FieldByName(SField_DataSource).AsString;
end;
cmbwhere1.Items.Clear;
cmbvalue1.Items.Clear;
cmbwhere2.Items.Clear;
cmbvalue2.Items.Clear;
case FFieldType of
0,1://数值型
begin
with cmbwhere1.Items do begin
Add(SCW0);
Add(SCW1);
Add(SCW2);
Add(SCW3);
Add(SCW4);
Add(SCW5);
end;
with cmbwhere2.Items do begin
Add(SCW1);
Add(SCW2);
Add(SCW3);
Add(SCW4);
Add(SCW5);
end;
try
cmbvalue1.Text:=inttostr(strtoint(cmbvalue1.Text));
except
cmbvalue1.Text:='0';
end;
try
cmbvalue2.Text:=inttostr(strtoint(cmbvalue2.Text));
except
cmbvalue2.Text:='0';
end;
with cmbvalue1.items do
begin
for i:=9 downto 1 do Add(inttostr(i*1000));
for i:=9 downto 1 do Add(inttostr(i*100));
for i:=9 downto 1 do Add(inttostr(i*10));
for i:=9 downto 1 do Add(inttostr(i));
end;
cmbvalue2.Items.AddStrings(cmbvalue1.Items);
end;
2://普通编辑框
begin
with cmbwhere1.Items do
begin
Add(SCW0);
Add(SCW9);
Add(SCW3);
Add(SCW6);
end;
with cmbwhere2.Items do
begin
Add(SCW9);
Add(SCW3);
Add(SCW6);
end;
end;
3://复选框
begin
with cmbwhere1.Items do
begin
Add(SCW0);
Add(SCW3);
end;
with cmbvalue1 do
begin
Items.Add(SVW1);
Items.Add(SVW2);
ItemIndex:=1;
end;
cmbnext.Visible:=false;
cmbwhere2.Visible:=false;
cmbvalue2.Visible:=false;
end;
4://日期型
begin
with cmbwhere1.Items do
begin
Add(SCW0);
Add(SCW7);
Add(SCW8);
Add(SCW3);
end;
with cmbwhere2.Items do
begin
Add(SCW7);
Add(SCW8);
Add(SCW3);
end;
with TDBDateTimeEditEh.Create(self) do
begin
Parent:= cmbvalue1.Parent;
left:= cmbvalue1.Left;
top:= cmbvalue1.Top;
width:= cmbvalue1.Width;
TabOrder:=cmbvalue1.TabOrder;
flat:= cmbvalue1.Flat;
Hint:= cmbvalue1.Hint;
Visible:= cmbValue1.Visible;
value:= date;
s:= cmbvalue1.Name;
cmbvalue1.Free;
name:= s;
onchange:=CmbValue1Change;
ondblclick:=CmbDblClick;
end;
with TDBDateTimeEditEh.Create(self) do
begin
Parent:= cmbvalue2.Parent;
left:= cmbvalue2.Left;
top:= cmbvalue2.Top;
width:= cmbvalue2.Width;
TabOrder:=cmbvalue2.TabOrder;
flat:= cmbvalue2.Flat;
Enabled:= cmbvalue2.Enabled;
Hint:= cmbvalue2.Hint;
Visible:= cmbValue2.Visible;
value:= date;
s:= cmbvalue2.Name;
cmbvalue2.Free;
name:= s;
onchange:=SQLChange;
ondblclick:=CmbDblClick;
end;
end;
5..7://字符串,下拉列表
begin
with cmbwhere1.Items do
begin
Add(SCW0);
Add(SCW9);
Add(SCW3);
Add(SCW6);
end;
cmbvalue1.Items:=getrecordsetstrings(sFrom);
with cmbwhere2.Items do
begin
Add(SCW9);
Add(SCW3);
Add(SCW6);
end;
cmbvalue2.Items:=getrecordsetstrings(sFrom);
end;
end;
cmbwhere1.ItemIndex:=0;
cmbwhere2.ItemIndex:=0;
SQLChange(nil);
end;
procedure TSQLEditFrame.CmbNextChange(Sender: TObject);
//使用/不使用第二个条件
begin
if (cmbnext.ItemIndex=0) then
begin
cmbwhere2.Enabled:=false;
cmbvalue2.Enabled:=false;
end else begin
cmbwhere2.Enabled:=true;
cmbvalue2.Enabled:=true;
end;
SQLChange(nil);
end;
function TSQLEditFrame.GetSqlString():string;
//取得SQL语句
var
sWhere,sValue:string;
begin
result:='';
if cmbWhere1.ItemIndex=0 then exit;
sWhere:=trim(rightstr(cmbwhere1.Text,2));
sValue:=cmbvalue1.text;
case FFieldType of
0,1:
result:=FFieldName+' '+sWhere+' '+sValue;
2,5,6:
if swhere='%' then
result:=FFieldName+' LIKE "%' + svalue+'%"'
else
result:=FFieldName+' '+swhere+' "'+svalue+'"';
3:
if cmbvalue1.ItemIndex=0 then
result:=FFieldName
else
result:='NOT '+FFieldName;
4:
result:=FFieldName+' '+swhere+' #'+svalue+'#';
end;
case cmbNext.ItemIndex of
0:exit;
1:result:=result+' AND';
2:result:=result+' OR';
3:result:=result+' AND NOT';
4:result:=result+' OR NOT';
end;
sWhere:=trim(rightstr(cmbwhere2.Text,2));
sValue:=cmbvalue2.text;
case FFieldType of
0,1:
result:=result+' '+FFieldName+' '+sWhere+' '+sValue;
2,5,6:
if swhere='%' then
result:=result+' '+FFieldName+' LIKE "%' + svalue+'%"'
else
result:=result+' '+FFieldName+' '+swhere+' "'+svalue+'"';
3:
if cmbvalue2.ItemIndex=0 then
result:=result+' '+FFieldName
else
result:=result+' '+'NOT '+FFieldName;
4:
result:=result+' '+FFieldName+' '+swhere+' #'+svalue+'#';
end;
result:='('+result+')';
end;
procedure TSQLEditFrame.SQLChange(Sender: TObject);
//SQLChange事件
begin
if Assigned(FOnSQLChange) then FOnSQLChange(Self);
end;
procedure TSQLEditFrame.CmbKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
key:=0;
TDBComboBoxEh(Sender).DropDown;
end;
procedure TSQLEditFrame.CmbKeyPress(Sender: TObject; var Key: Char);
begin
key:=#0;
TDBComboBoxEh(Sender).DropDown;
end;
procedure TSQLEditFrame.CmbDblClick(Sender: TObject);
begin
TDBComboBoxEh(Sender).DropDown;
end;
procedure TSQLEditFrame.CmbValue1Change(Sender: TObject);
begin
if cmbwhere1.ItemIndex =0 then cmbwhere1.ItemIndex:=1;
SQLChange(sender);
end;
end.
//dfm文件
inherited SQLQueryForm: TSQLQueryForm
Left = 224
Top = 119
Width = 707
Height = 487
Caption = 'SQLQueryForm'
ParentFont = True
Menu = MainMenu
OldCreateOrder = True
PixelsPerInch = 96
TextHeight = 12
object Spl: TSplitter [0]
Left = 0
Top = 282
Width = 699
Height = 4
Cursor = crVSplit
Align = alTop
Color = clBtnFace
MinSize = 1
ParentColor = False
ResizeStyle = rsUpdate
end
object SclBox: TScrollBox [1]
Left = 0
Top = 26
Width = 699
Height = 256
HorzScrollBar.Style = ssFlat
HorzScrollBar.Tracking = True
VertScrollBar.Style = ssFlat
VertScrollBar.Tracking = True
Align = alTop
BevelInner = bvNone
BevelOuter = bvRaised
BevelKind = bkFlat
BorderStyle = bsNone
Constraints.MinHeight = 3
ParentShowHint = False
ShowHint = True
TabOrder = 1
end
inherited ColBar: TCoolBar
Width = 699
Bands = <
item
Control = TolBar
ImageIndex = -1
MinHeight = 22
Width = 695
end>
inherited TolBar: TToolBar
Width = 682
ButtonWidth = 99
object tbField: TToolButton
Left = 63
Top = 0
Hint = #36807#28388#23383#27573
AutoSize = True
Caption = #36807#28388#23383#27573
DropdownMenu = pmField
ImageIndex = 20
end
object ToolButton3: TToolButton
Left = 142
Top = 0
Width = 8
Caption = 'ToolButton3'
ImageIndex = 4
Style = tbsSeparator
end
object ToolButton5: TToolButton
Left = 150
Top = 0
Action = CheckSQL
AutoSize = True
end
object ToolButton2: TToolButton
Left = 247
Top = 0
Action = ClearQuery
AutoSize = True
end
object ToolButton1: TToolButton
Left = 350
Top = 0
Action = StartQuery
AutoSize = True
end
end
end
object tSql: TFlatMemo
Left = 0
Top = 286
Width = 699
Height = 155
Hint = #26597#35810#26465#20214
ColorFlat = clWindow
ParentColor = True
Align = alClient
ScrollBars = ssBoth
TabOrder = 2
end
object MainMenu: TMainMenu
Images = MainDMForm.ImgList
Left = 16
Top = 128
object mQuery: TMenuItem
Caption = #26597#35810'(&Q)'
GroupIndex = 6
Hint = #25968#25454#26597#35810
object mqClearQuery: TMenuItem
Action = ClearQuery
end
object mqCheckSQL: TMenuItem
Action = CheckSQL
end
object mqStartQuery: TMenuItem
Action = StartQuery
end
end
end
object pmField: TPopupMenu
Images = MainDMForm.ImgList
Left = 48
Top = 128
object pmfAll: TMenuItem
Caption = #20840#37096#26174#31034'(&A)'
Checked = True
OnClick = pmfieldClick
end
end
object ActList: TActionList
Images = MainDMForm.ImgList
Left = 16
Top = 96
object StartQuery: TAction
Tag = 3
Category = 'Query'
Caption = #24320#22987#26597#35810
Hint = #24320#22987#26597#35810'|'#24320#22987#26597#35810#24182#26174#31034#26597#35810#32467#26524
ImageIndex = 21
ShortCut = 16397
OnExecute = QueryExecute
end
object ClearQuery: TAction
Tag = 2
Category = 'Query'
Caption = #28165#38500#26597#35810#26465#20214
Hint = #28165#38500#26597#35810#26465#20214
ImageIndex = 24
ShortCut = 24652
OnExecute = QueryExecute
end
object CheckSQL: TAction
Tag = 1
Category = 'Query'
Caption = #26816#26597'SQL'#35821#27861
Hint = #26816#26597'SQL'#35821#27861
ImageIndex = 25
ShortCut = 24643
OnExecute = QueryExecute
end
end
end
//------------------------------------------------------------------------------
//SQLQuery.pas,SQLQuery.dfm
//数据查询MDI子窗体
//------------------------------------------------------------------------------
unit SQLQuery;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, MDIChild, StdCtrls, ExtCtrls, Buttons, ComCtrls, ToolWin,
ImgList, Menus, DB, ADODB, SqlEdit, ActnList, StrUtils,TFlatMemoUnit,
DBBrowse,MainDM, Global,DBCtrlsEh;
type
TSQLQueryForm = class(TMDIChildForm)
SclBox: TScrollBox;
Spl: TSplitter;
tSql: TFlatMemo;
MainMenu: TMainMenu;
mQuery: TMenuItem;
mqStartQuery: TMenuItem;
mqClearQuery: TMenuItem;
pmField: TPopupMenu;
pmfAll: TMenuItem;
tbField: TToolButton;
ToolButton1: TToolButton;
ActList: TActionList;
StartQuery: TAction;
ClearQuery: TAction;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
CheckSQL: TAction;
ToolButton5: TToolButton;
mqCheckSQL: TMenuItem;
procedure SQLStringChange(Sender:TObject);
procedure QueryExecute(Sender: TObject);
procedure pmfieldClick(Sender: TObject);
private
FFieldCount:integer;
Protected
FMasterTabName,FDetailTabName,FMasterFields:string;
FMasterReadOnly,FDetailReadOnly:boolean;
public
constructor Create(AOwner:TComponent;ACaption,TabName,DetailTabName,
AMasterFields:string;MasterReadOnly,DetailReadOnly:boolean
);reintroduce;overload;
end;
procedure OpenSQLQueryForm(MasterTabName:string;
DetailTabName:string='';AMasterFields:string='';
MasterReadOnly:boolean=false;DetailReadOnly:boolean=false);
implementation
uses MDIMain;
{$R *.dfm}
procedure OpenSQLQueryForm(MasterTabName:string;
DetailTabName:string='';AMasterFields:string='';
MasterReadOnly:boolean=false;DetailReadOnly:boolean=false);
//激活查询窗口,如果不存在则建立
var
sCaption:string;
begin
scaption:=MasterTabName+SQuery;
if not ActiveForm(sCaption) then
TSQLQueryForm.Create(Application,sCaption,MasterTabName,
DetailTabName,AMasterFields,MasterReadOnly,DetailReadOnly);
end;
constructor TSQLQueryForm.Create(AOwner:TComponent;ACaption,TabName,
DetailTabName,AMasterFields:string;MasterReadOnly,DetailReadOnly:boolean);
//建立查询窗口,根据表的字段生成TSQLEditFrame自定义查询
var
i,t,y:integer;
mTemp:TMenuItem;
rsTemp:TADODataSet;
begin
screen.Cursor := crHourGlass;
try
inherited Create(AOwner);
Caption := ACaption;
FMasterTabName := TabName;
FDetailTabName := DetailTabName;
FMasterFields := AMasterFields;
FMasterReadOnly := MasterReadOnly;
FDetailReadOnly := DetailReadOnly;
rsTemp := GetRecordSet(format(SSELECT,['TOP 1 *',FMasterTabName]));
FFieldCount := rsTemp.FieldCount;
y := 0;
MDIMainForm.ProgressStart(0,FFieldCount+1);
for i:=0 to FFieldCount-1 do
begin
if rsTabFields.Locate(SField_Name,
rsTemp.Fields.FieldName,[]) then
t:=rsTabFields.FieldByName(SField_Type).AsInteger
else
t:=0;
if t>=0 then
begin
//生成菜单
mTemp:=TMenuItem.Create(pmField);
with mtemp do
begin
Caption := rsTemp.Fields.FieldName;
Hint := rsTemp.Fields.FieldName;
Tag := i+1;
AutoCheck := true;
Checked := true;
OnClick := pmfieldClick;
//如果是关联字段就不能更改
if pos(Hint,FMasterFields)>0 then
Enabled := false;
end;
pmfield.Items.Add(mTemp);
//建立字段的条件编辑框
with TSQLEditFrame.Create(sclbox) do
begin
Name := '';
Parent := sclbox;
Tag := i;
Left := 0;
Top := y*FIELD_MAX_HEIGHT+8;
CmbWhere1.DropDownBox.Rows:= iDropDownCount;
CmbWhere2.DropDownBox.Rows:= iDropDownCount;
CmbValue1.DropDownBox.Rows:= iDropDownCount;
CmbValue2.DropDownBox.Rows:= iDropDownCount;
CmbNext.DropDownBox.Rows := iDropDownCount;
FieldName := rsTemp.Fields.FieldName;
OnSqlChange := sqlstringchange;
end;
y:=y+1;
end; //if
MDIMainForm.ProgressAdd;
end; //for
if SclBox.Height>y*FIELD_MAX_HEIGHT+10 then
SclBox.Height:=y*FIELD_MAX_HEIGHT+10;
MDIMainForm.ProgressAdd;
except
msgbox(format(SEOpenQueryForm,[Caption]),Caption,mb_iconstop);
close;
end;
MDIMainForm.ProgressEnd;
screen.Cursor:=crDefault;
sclbox.SetFocus;
end;
procedure TSQLQueryForm.SQLStringChange(Sender:TObject);
//SQL语句改变
var
i:integer;
s:string;
begin
tsql.lines.Clear;
for i:=0 to SclBox.ComponentCount-1 do
if SclBox.Components is TSQLEditFrame then
begin
s:=TSQLEditFrame(SclBox.Components).GetSqlString;
if length(s)>0 then
begin
if tsql.Lines.count>0 then s:='AND '+s;
tsql.Lines.Add(s);
end;
end;
end;
procedure TSQLQueryForm.QueryExecute(Sender: TObject);
//执行查询动作
var
i : integer;
s,sfield : string;
begin
inherited;
for i:=0 to tsql.Lines.Count-1 do
if length(trim(tsql.Lines))>0 then s:=s+trim(tsql.Lines)+' ';
if length(s)>0 then s:=' WHERE '+s;
case TComponent(sender).Tag of
2://清除查询条件
for i:=0 to SclBox.ComponentCount-1 do
TSQLEditFrame(SclBox.Components).CmbWhere1.ItemIndex:=0;
1,3://检查SQL语句是否正确|开始查询
begin
//符合条件的记录数
i:= GetRecordSetCount(format(SSELECT,
['COUNT(*)',FMasterTabName])+s);
case i of
-1: //语句错误
msgbox(SESQL+#13#13+format(SErrorInfo,[GetLastErrorString]),
Caption,MB_ICONERROR);
0: //没有符合的
MsgBox(SSQLNoReturn,Caption);
else //有符合的
begin
if TComponent(sender).Tag=1 then
//只是检查语句,显示正确并退出
begin
MsgBox(format(SSQLReturn,),Caption);
exit;
end;
if pmfall.Checked then
//所有字段
s:=format(SSELECT,['*',FMasterTabName])+s
else begin
//列出所选字段
for i:=1 to pmfield.ComponentCount-1 do
if TMenuItem(pmfield.Components).Checked then
sField:=sField+TMenuItem(pmField.Components).Hint+',';
Delete(sfield,length(sfield),1);
s:=format(SSELECT,[sField,FMasterTabName])+s;
end; //if
//打开数据浏览窗口
OpenDBBrowseForm(s,FMasterTabName,
iMaxRecords,FDetailTabName,FMasterFields,
'',FMasterReadOnly,FDetailReadOnly)
end; //case i else
end; //case i
end; //case 1,3
end; //case
end;
procedure TSQLQueryForm.pmfieldClick(Sender: TObject);
//动态生成菜单的事件,控制过滤查询字段
var
i:integer;
b:boolean;
begin
inherited;
b:=false;
for i:=1 to pmfield.ComponentCount-1 do
b:=b or TMenuItem(pmfield.Components).Checked;
if not b then TMenuItem(Sender).Checked:=true;
pmfall.Checked:=true;
if TMenuItem(Sender).Tag=0 then
for i:=1 to pmfield.ComponentCount-1 do
TMenuItem(pmfield.Components).Checked:=true
else
for i:=1 to pmfield.ComponentCount-1 do
pmfall.Checked:=pmfall.Checked and
TMenuItem(pmfield.Components).Checked;
end;
end.