⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 sqlexecuteform.pas

📁 进销存·完整的·有数据库的·非常完整·只得参考
💻 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 + -