📄 sql_unit.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 + -