📄 sqlexecuteform.pas
字号:
unit SQLExecuteForm;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ListForm, dxBar, dxBarExtItems, KsSkinForms,
KsSkinPanels, ExtCtrls, DBData, dxExEdtr, dxEdLib,
dxCntner, dxEditor, KsSkinLabels, dxTL, dxDBCtrl, dxDBGrid, DB,
ADODB, KsSkinListBoxs, SysPublic, KsSkinMessages,
StdCtrls, se_controls, ksskinsplitter;
type
TfrmSQLExecuteForm = class(TfrmListForm)
MainGrid: TdxDBGrid;
bbExecute: TdxBarLargeButton;
dsSource: TDataSource;
dSetQuery: TADODataSet;
pnlTop: TSeSkinPanel;
SeSkinPanel2: TSeSkinPanel;
SeSkinPanel3: TSeSkinPanel;
SeSkinPanel4: TSeSkinPanel;
SeSkinLabel1: TSeSkinLabel;
SeSkinLabel2: TSeSkinLabel;
edtFieldS: TdxEdit;
edtSumField: TdxEdit;
memSQL: TdxMemo;
listTable: TSeSkinListBox;
ListField: TSeSkinListBox;
dSetField: TADODataSet;
bbBrowse: TdxBarLargeButton;
lblCaption: TSeSkinLabel;
edtCaption: TdxEdit;
listTableName: TSeSkinListBox;
Splitter1: TSeSkinSplitter;
Splitter2: TSeSkinSplitter;
Splitter3: TSeSkinSplitter;
procedure bbExecuteClick(Sender: TObject);
procedure bbSelectClick(Sender: TObject);
procedure memSQLDragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure ListFieldMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure memSQLDragDrop(Sender, Source: TObject; X, Y: Integer);
procedure edtSumFieldDragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure edtSumFieldDragDrop(Sender, Source: TObject; X, Y: Integer);
procedure bbSaveClick(Sender: TObject);
procedure bbBrowseClick(Sender: TObject);
procedure memSQLChange(Sender: TObject);
procedure edtCaptionChange(Sender: TObject);
procedure bbFindClick(Sender: TObject);
procedure bbFilterClick(Sender: TObject);
procedure bbDelClick(Sender: TObject);
procedure listTableNameClick(Sender: TObject);
procedure listTableNameDblClick(Sender: TObject);
private
{ Private declarations }
bExesSucceed, bDBSave, bReturn: Boolean;
procedure LoadGrid;
function ExecEditSqL: Boolean;
function ReturnSQL: string;
function GetRadioBill(lMode: Integer): Integer;
procedure MainShow;
procedure EditClear;
public
{ Public declarations }
end;
function SQLExecuteFormShow: Boolean;
implementation
{$R *.dfm}
function SQLExecuteFormShow: Boolean;
var
frmSQLExecuteForm: TfrmSQLExecuteForm;
begin
frmSQLExecuteForm := TfrmSQLExecuteForm.Create(Application);
with frmSQLExecuteForm do
begin
MainShow;
Result := bReturn;
Free;
end;
end;
procedure TfrmSQLExecuteForm.MainShow;
begin
LoadGrid;
ShowModal;
end;
procedure TfrmSQLExecuteForm.LoadGrid;
begin
Caption := '万能查询-SQL执行器';
bExesSucceed := False;
bDBSave := False;
bbSave.Enabled := bExesSucceed;
bbBrowse.Enabled := bExesSucceed;
pnlTop.Visible := not bExesSucceed;
bbDel.Enabled := bDBSave;
end;
function TfrmSQLExecuteForm.ExecEditSqL: Boolean;
var
sField: string;
sFieldN: string;
begin
Result := False;
if not (Pos('SELECT', ReturnSQL) > 0) then
begin
ShowMsg('请输入正确的SQL语句,DIY报表只能执行查询SQL语句!');
Exit;
end;
if OpenDataSet(dSetQuery, ReturnSQL) then
begin
sField := StringReplace(dSetQuery.FieldList.Text, #13, ',', [rfReplaceAll]);
if edtFieldS.Text <> '' then
sFieldN := edtFieldS.Text
else
sFieldN := sField;
StrToGridField(MainGrid, sField, sFieldN, '');
bExesSucceed := True;
Result := True;
end
else
ShowMsg('SQL执行出错,请输入正确的SQL语句!');
end;
function TfrmSQLExecuteForm.GetRadioBill(lMode: Integer): Integer;
var
sSql, sID: string;
lIndex: Integer;
sF1, sF2, sF3: string;
tsList: TStrings;
ADOSetTmp: TADODataSet;
begin
Result := 0;
sID := '';
tsList := TStringList.Create;
sF1 := 'Name';
sF2 := 'ID';
sF3 := '';
sSql := 'SELECT * FROM SQLExecute';
if GetDataSetEmpty(sSql) then
Exit;
if TableToStrings(sSql, sF1, sF2, sF3, #13) then
begin
tsList.Text := sF2;
lIndex := GetListBox('自定义报表选择', sF1, lMode);
if (lIndex >= 0) and (lIndex <= tsList.Count) then
sID := tsList.Strings[lIndex];
end;
if sID = '' then
Exit;
ADOSetTmp := nil;
ADOSetTmp := TADODataSet.Create(ADOSetTmp);
sSql := sSql + ' WHERE ID=' + sID;
OpenDataSet(ADOSetTmp, sSql);
if ADOSetTmp.IsEmpty then
Exit;
edtCaption.Text := ADOSetTmp.FieldByName('Name').AsString;
edtFieldS.Text := ADOSetTmp.FieldByName('TopField').AsString;
edtSumField.Text := ADOSetTmp.FieldByName('SumField').AsString;
memSQL.Lines.Text := ADOSetTmp.FieldByName('SQLText').AsString;
ADOSetTmp.Close;
ADOSetTmp.Free;
bDBSave := True;
Result := 1;
end;
procedure TfrmSQLExecuteForm.EditClear;
begin
edtCaption.Text := '';
edtFieldS.Text := '';
edtSumField.Text := '';
memSQL.Lines.Text := '';
dSetQuery.Close;
bDBSave := False;
bExesSucceed := False;
MainGrid.DestroyColumns;
end;
procedure TfrmSQLExecuteForm.bbExecuteClick(Sender: TObject);
begin
inherited;
ExecEditSql;
bbBrowse.Enabled := bExesSucceed;
bbSave.Enabled := bExesSucceed;
end;
function TfrmSQLExecuteForm.ReturnSQL: string;
var
sSql: string;
begin
sSql := memSQL.Lines.Text;
Result := sSql;
end;
procedure TfrmSQLExecuteForm.bbSelectClick(Sender: TObject);
begin
inherited;
if GetRadioBill(0) > 0 then
begin
bbDel.Enabled := bDBSave;
ExecEditSql;
end;
end;
procedure TfrmSQLExecuteForm.memSQLDragOver(Sender, Source: TObject; X,
Y: Integer; State: TDragState; var Accept: Boolean);
var
aPoint: TPoint;
begin
inherited;
aPoint.x := x;
aPoint.y := y;
if (source = ListField) and (ListField.ItemAtPos(apoint, true) <> -1) then
Accept := true;
end;
procedure TfrmSQLExecuteForm.ListFieldMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
inherited;
ListField.BeginDrag(False);
end;
procedure TfrmSQLExecuteForm.memSQLDragDrop(Sender, Source: TObject; X,
Y: Integer);
var
sField: string;
begin
inherited;
sField := ListField.Items.Strings[ListField.ItemIndex];
MemoAddStart(memSQL, ',' + sField);
end;
procedure TfrmSQLExecuteForm.edtSumFieldDragOver(Sender, Source: TObject; X,
Y: Integer; State: TDragState; var Accept: Boolean);
var
aPoint: TPoint;
begin
inherited;
aPoint.x := x;
aPoint.y := y;
if (source = ListField) and (ListField.ItemAtPos(apoint, true) <> -1) then
Accept := true;
end;
procedure TfrmSQLExecuteForm.edtSumFieldDragDrop(Sender, Source: TObject; X,
Y: Integer);
var
sField: string;
begin
inherited;
sField := ListField.Items.Strings[ListField.ItemIndex];
if edtSumField.Text = '' then
edtSumField.Text := sField
else
edtSumField.Text := edtSumField.Text + ',' + sField;
end;
procedure TfrmSQLExecuteForm.bbSaveClick(Sender: TObject);
var
sSql: string;
begin
inherited;
if not bExesSucceed then
Exit;
if Trim(edtCaption.Text) = '' then
begin
ShowMsg('请输入窗口标题');
Exit;
end;
if CheckSameField('SQLExecute', 'Name', Trim(edtCaption.Text)) > 0 then
begin
if MsgBox('已存在相同名称的DIY报表,是否覆盖?', '提示',
MB_OKCANCEL) <> IDOK then
Exit;
sSql := ' DELETE FROM SQLExecute WHERE Name= ''' + Trim(edtCaption.Text) +
'''';
ExecSql(sSql);
end;
sSql := 'INSERT INTO SQLExecute(Name,TopField,SumField,SQLText) ' +
'VALUES(''' + Trim(edtCaption.Text) + ''',''' + Trim(edtFieldS.Text) +
''',''' + Trim(edtSumField.Text) + ''',''' + Trim(memSQL.Lines.Text) +
''')';
if ExecSql(sSql) then
begin
ShowMsg('已成功保存DIY报表,下次你可以通过窗口标题真接选择此报表!');
bDBSave := True;
end
else
ShowMsg('保存DIY报表出错,请检查后重新保存!');
bbDel.Enabled := bDBSave;
end;
procedure TfrmSQLExecuteForm.bbBrowseClick(Sender: TObject);
begin
inherited;
if pnlTop.Visible then
begin
bbBrowse.Caption := '浏览';
pnlTop.Visible := False;
end
else
begin
bbBrowse.Caption := '编辑';
pnlTop.Visible := True;
end;
bbExecute.Enabled := pnlTop.Visible;
bbPrint.Enabled := not pnlTop.Visible;
end;
procedure TfrmSQLExecuteForm.memSQLChange(Sender: TObject);
begin
inherited;
bExesSucceed := False;
end;
procedure TfrmSQLExecuteForm.edtCaptionChange(Sender: TObject);
begin
inherited;
Caption := edtCaption.Text;
end;
procedure TfrmSQLExecuteForm.bbFindClick(Sender: TObject);
begin
inherited;
FindPublic(MainGrid, sPubFindText, lPubFindFiled);
end;
procedure TfrmSQLExecuteForm.bbFilterClick(Sender: TObject);
begin
inherited;
FilterPublic(MainGrid);
end;
procedure TfrmSQLExecuteForm.bbDelClick(Sender: TObject);
var
sSql, sN: string;
begin
inherited;
sN := Trim(edtCaption.Text);
if MsgBox(PChar('DIY报表[' + sN +
']保存在数据库中,你确定要从数据库中删除它?'), '提示',
MB_OKCANCEL) = IDOK then
begin
sSql := ' DELETE FROM SQLExecute WHERE Name= ''' + sN + '''';
ExecSql(sSql);
EditClear;
end;
end;
procedure TfrmSQLExecuteForm.listTableNameClick(Sender: TObject);
var
sField, sSql: string;
begin
inherited;
sField := listTable.Items.Strings[listTableName.ItemIndex];
sSql := 'Select * From ' + sField;
if OpenDataSet(dSetField, sSql) then
begin
listField.Items := dSetField.FieldList;
dSetField.Close;
end;
end;
procedure TfrmSQLExecuteForm.listTableNameDblClick(Sender: TObject);
var
sField, sSql: string;
begin
inherited;
sField := listTable.Items.Strings[listTableName.ItemIndex];
sSql := 'SELECT * FROM ' + sField;
MemoAddStart(memSQL, sSql);
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -