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

📄 sql_unit.pas

📁 一个小的设备管理系统
💻 PAS
字号:
unit SQL_unit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids, DBGrids, Db, DBTables, StdCtrls,  OleServer, ComObj, ActiveX,
  Excel2000, ADODB, ComCtrls, ExtCtrls;


type
  TSQL_F = class(TForm)
    Bevel1: TBevel;
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    StaticText1: TStaticText;
    DBGrid1: TDBGrid;
    StatusBar1: TStatusBar;
    ADOConnection1: TADOConnection;
    Query: TADOQuery;
    DataSource1: TDataSource;
    SaveDialog1: TSaveDialog;
    ExcelApplication1: TExcelApplication;
    ExcelWorkbook1: TExcelWorkbook;
    ExcelWorksheet1: TExcelWorksheet;
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    ExcelFormatNum: TStrings; //ExcelFormatNum
    ExcelFormatStr: TStrings; //ExcelFormatStr
    function ExportDBGrid(DBGrid: TDBGrid; SheetName: string): boolean;//直接保存,不显示EXCEL
    function ExportDataToExcelV(SheetName: string; DBGrid: TDBGrid; ExcelApplication: TExcelApplication;
        ExcelWorkbook: TExcelWorkbook; ExcelWorksheet: TExcelWorksheet): boolean; //显示EXCEL
    function ConvertIntToCharacters(IntNumber: Integer): string;
    function GetNumberFormat(s: string): string; //判断字段的格式
    function FindExcelFormatStr(s: string): Boolean; //找字符格式
    function FindExcelFormatNum(s: string): Boolean; //找数字格式
  end;


var
  SQL_F: TSQL_F;

implementation

{$R *.dfm}
function TSql_f.ExportDataToExcelV(SheetName: string; DBGrid: TDBGrid; ExcelApplication: TExcelApplication;ExcelWorkbook: TExcelWorkbook; ExcelWorksheet: TExcelWorksheet): boolean; //显示EXCEL

//引用:ActiveX
var
  Row, Col: integer;
  RowFirst, ColEnd: string;
  lcid: integer;
  vNumberFormat: string;
begin
  result := false;
  if DBGrid.DataSource = nil then
    exit;
  if DBGrid.DataSource.DataSet = nil then
    exit;
  if DBGrid.DataSource.DataSet.IsEmpty then
    exit;
  try
    ExcelApplication.Disconnect;
  except
  end;
  try
    try
      lcid := 1; //GetUserDefaultLCID;
      ExcelApplication.ScreenUpdating[lcid] := false;
      ExcelApplication.ConnectKind := ckNewInstance;
      ExcelApplication.Connect;
    except
      Application.MessageBox('系统检测到此机器没有安装EXCEL!如果需要导出功能,请先安装EXCEL!','警告',MB_OK);
      exit;
    end;
    screen.Cursor := crHourGlass;
    ExcelWorkbook.ConnectTo(ExcelApplication.Workbooks.Add(TOleEnum(xlWBATWorksheet), lcid));
    ExcelWorksheet.ConnectTo(ExcelWorkbook.Worksheets[1] as _Worksheet);
    if (SheetName <> '') then
      ExcelWorksheet.Name := SheetName;
    ExcelWorksheet.Cells.Font.Size := 10;

    DBGrid.DataSource.DataSet.DisableControls;
    //导入报头
    for Col := 1 to DBGrid.Columns.Count do
      ExcelWorksheet.Cells.Item[1, Col].value := DBGrid.Columns[Col - 1].Title.caption;

    //导入库数据
    DBGrid.DataSource.DataSet.First;
    for Col := 1 to DBGrid.Columns.Count do
    begin
      RowFirst := ConvertIntToCharacters(Col) + '1';
      ColEnd := ConvertIntToCharacters(Col) + inttostr(DBGrid.DataSource.DataSet.RecordCount + 1);
      if DBGrid.Fields[Col - 1].DataSize < 200 then
        ExcelWorksheet.Range[RowFirst, ColEnd].ColumnWidth := DBGrid.Fields[Col - 1].DataSize
      else
        ExcelWorksheet.Range[RowFirst + '1', ColEnd].ColumnWidth := 21;

      vNumberFormat := GetNumberFormat(DBGrid.Columns[Col - 1].Title.Caption);
       if vNumberFormat <> '' then
        ExcelWorksheet.Range[RowFirst, ColEnd].NumberFormat := vNumberFormat;


      for Row := 1 to DBGrid.DataSource.DataSet.RecordCount do
      begin
        ExcelWorksheet.Cells.Item[Row + 1, Col].value := trim(DBGrid.Fields[Col - 1].AsString);
        DBGrid.DataSource.DataSet.Next;
      end;
      DBGrid.DataSource.DataSet.First;
    end;
    ExcelApplication.Visible[lcid] := True;
    ExcelApplication.ScreenUpdating[lcid] := true;
    DBGrid.DataSource.DataSet.EnableControls;
    result := true;
  finally
    screen.Cursor := crDefault;
  end;
end;

function Tsql_f.ConvertIntToCharacters(IntNumber: Integer): string;
begin
  if IntNumber < 1 then
    Result := 'A'
  else
  begin
    if IntNumber > 702 then
      Result := 'ZZ'
    else
    begin
      if IntNumber > 26 then
      begin
        if (IntNumber mod 26) = 0 then
          Result := Chr(64 + (IntNumber div 26) - 1)
        else
          Result := Chr(64 + (IntNumber div 26));
        if (IntNumber mod 26) = 0 then
          result := result + chr(64 + 26)
        else
          result := Result + Chr(64 + (IntNumber mod 26));
      end
      else
        Result := Chr(64 + IntNumber);
    end;
  end;
end;

function Tsql_f.GetNumberFormat(s: string): string; //判断字段的格式
begin

  result := '@';
end;

function TSql_f.FindExcelFormatStr(s: string): Boolean; //找字符格式
var
  i: integer;
begin
  Result := True;
  for i := 0 to ExcelFormatStr.Count - 1 do
  begin
    if Pos(ExcelFormatStr[i], s) > 0 then
    begin
      Result := True;
      Exit;
    end;
  end;
end;

function Tsql_f.FindExcelFormatNum(s: string): Boolean; //找数字格式

begin
   result:=false;
end;

function Tsql_f.ExportDBGrid(DBGrid: TDBGrid; SheetName: string): boolean;//直接保存,不显示EXCEL
//引用:ComObj
var
  c, r, i, j: integer;
  app: Olevariant;
  TempFileName, ResultFileName: string;
begin
  try
    result := True;
      app := CreateOLEObject('Excel.application');
      app.WorkBooks.Add(xlWBatWorkSheet);
    except
      Application.MessageBox('Excel没有正确安装!','警告',MB_OK);
      result := False;
      exit;
    end;
    SaveDialog1.DefaultExt := 'xls';
    SaveDialog1.FileName := SheetName;
    if SaveDialog1.Execute then
      TempFileName := SaveDialog1.FileName
    else
      Exit;

    app.Workbooks.add;
    app.Visible := false;
    Screen.Cursor := crHourGlass;
    DBGrid.DataSource.DataSet.First;
    c := DBGrid.DataSource.DataSet.FieldCount;
    r := DBGrid.DataSource.DataSet.RecordCount;
    Application.ProcessMessages;
    for i := 0 to c - 1 do
      app.cells(1, 1 + i) := DBGrid.DataSource.DataSet.Fields[i].DisplayLabel;
    for j := 1 to r do
    begin
      for i := 0 to c - 1 do
        app.cells(j + 1, 1 + i) := DBGrid.DataSource.DataSet.Fields[i].AsString;

      DBGrid.DataSource.DataSet.Next;
    end;

    ResultFileName := TempFileName;
    if ResultFileName = '' then
      ResultFileName := '自动报表';
    if FileExists(TempFileName) then
      DeleteFile(TempFileName);
    app.Activeworkbook.saveas(TempFileName);
    app.Activeworkbook.close(false);
    app.quit;

end;

procedure Tsql_f.Button2Click(Sender: TObject);
begin
  try
    Screen.Cursor := crHourGlass;
    //ExportDBGrid(DBGrid1, '查询结果'); //直接保存,不显示EXCEL
    ExportDataToExcelV('查询结果', DBGrid1, ExcelApplication1, ExcelWorkbook1, ExcelWorksheet1); //显示EXCEL

  finally
    Screen.Cursor := crDefault;
  end;
end;

procedure Tsql_f.FormCreate(Sender: TObject);
begin
  ExcelFormatNum := TStringList.Create;
  ExcelFormatStr := TStringList.Create;
end;
procedure Tsql_f.FormDestroy(Sender: TObject);
begin
  ExcelFormatNum.Free;
  ExcelFormatStr.Free;
end;


procedure TSQL_F.Button1Click(Sender: TObject);
var
  aSQL:string;
begin
  aSQL:=Trim(memo1.Text);
  with Query do
  begin
    Close;
    SQL.Clear;
    SQL.Add(aSQL);
    Query.Open;
    DBGrid1.DataSource:=DataSource1;
  end;

end;

procedure TSQL_F.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  action:=cafree;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -