unit
SGridFunction;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,SConnect,
Dialogs, Global, Grids, DBGrids, DB, DBClient, WinSkinData, StdCtrls,
Buttons, ExtCtrls, ComCtrls, ComObj, Clipbrd, ADODB;
procedure
SuccessMsgbox(AMsg:
String
);
procedure
ErrorMsgbox(AMsg:
String
);
function
AskMsgbox(AMsg:
String
):
Boolean
;
procedure
InfoMsgbox(AMsg:
String
);
procedure
ExportToExcel(ASGrid: TStringGrid; ExcelModalPath, ExcelFileName:
String
;
AGridStartCol, AGridStartRow, AExcelStartCol, AExcelStartRow:
Integer
);
function
GetColMaxDataLength(ASGrid: TStringGrid; ACol, AStartRow:
Integer
):
Integer
;
procedure
SetOneColWidth(ASGrid: TStringGrid; ACol:
Integer
);
procedure
SetAllColWidth(ASGrid: TStringGrid);
procedure
ShowClientDataSetData(ASGrid: TStringGrid; ACDSet: TClientDataSet;
AGridStartCol, AGridStartRow:
Integer
);
procedure
ShowQueryData(ASGrid: TStringGrid; AQuery: TADOQuery;
AGridStartCol, AGridStartRow:
Integer
);
function
HaveData(ASGrid: TStringGrid; AStartCol, AStartRow:
Integer
):
Boolean
;
function
GetIntegerNumberLength(ANumber:
Integer
):
Integer
;
procedure
SetNumberFields(ASGrid: TStringGrid; ACol, AStartRow:
Integer
);
procedure
SetColAlignRight(ASGrid: TStringGrid; ACol, AStartRow:
Integer
);
procedure
SetRowLeftSpace(ASGrid: TStringGrid; ARow, SpaceLength:
Integer
);
procedure
SetRowMinRightSpace(ASGrid: TStringGrid; ARow, SpaceLength:
Integer
);
procedure
SetRowMinSpaceWidth(ASGrid: TStringGrid; ARow, SpaceLength:
Integer
);
function
GetColByCX(ASGrid: TStringGrid; AX:
Integer
):
Integer
;
function
GetRowByCY(ASGrid: TStringGrid; AY:
Integer
):
Integer
;
procedure
GetCellByCoordinate(ASGrid: TStringGrid; AX, AY:
Integer
;
out ACol, ARow:
Integer
);
procedure
SetSpaceCells(ASGrid: TStringGrid; AStartCol, AStartRow,
AEndCol, AEndRow:
Integer
; AValue:
String
);
implementation
procedure
SuccessMsgbox(AMsg:
String
);
begin
Application
.
MessageBox(
Pchar
(AMsg),
'完成'
, MB_ICONINFORMATION + MB_OK);
end
;
procedure
ErrorMsgbox(AMsg:
String
);
begin
Application
.
MessageBox(
Pchar
(AMsg),
'错误'
, MB_ICONSTOP + MB_OK);
end
;
function
AskMsgbox(AMsg:
String
):
Boolean
;
begin
if
Application
.
MessageBox(
Pchar
(AMsg),
'确认'
,
MB_ICONQUESTION + MB_YESNO) = IDYES
then
begin
result :=
true
;
end
else
begin
result :=
false
;
end
;
end
;
procedure
InfoMsgbox(AMsg:
String
);
begin
Application
.
MessageBox(
Pchar
(AMsg),
'提示'
, MB_ICONINFORMATION + MB_OK);
end
;
procedure
ExportToExcel(ASGrid: TStringGrid; ExcelModalPath, ExcelFileName:
String
;
AGridStartCol, AGridStartRow, AExcelStartCol, AExcelStartRow:
Integer
);
var
ExcelApp: Variant;
ColIndex, RowIndex:
Integer
;
OneRowData:
String
;
DataList: TStringList;
SaveDlg: TSaveDialog;
SaveExcelFilePath:
String
;
begin
try
if
not
HaveData(ASGrid, AGridStartCol, AGridStartRow)
then
begin
InfoMsgBox(
'没有数据需要导出。'
);
exit;
end
;
try
SaveDlg := TSaveDialog
.
Create(ASGrid);
SaveDlg
.
InitialDir := ExtractFilePath(Application
.
ExeName);
SaveDlg
.
Filter :=
'Excel Files(*.xls)| *.xls'
;
SaveDlg
.
FileName := ExcelFileName + VarToStr(date);
if
SaveDlg
.
Execute
then
begin
SaveExcelFilePath := SaveDlg
.
FileName;
end
else
begin
exit;
end
;
finally
SaveDlg
.
Free;
end
;
try
ExcelApp := CreateOleObject(
'Excel.Application'
);
except
ErrorMsgBox(
'请确认您的机器已经安装 Microsoft Excel 。'
);
Exit;
end
;
try
try
if
(excelModalPath <> null)
and
(excelModalPath <>
''
)
then
begin
ExcelApp
.
WorkBooks
.
Open(ExcelModalPath);
end
else
begin
ExcelApp
.
WorkBooks
.
Add;
for
ColIndex :=
0
to
ASGrid
.
ColCount - AGridStartCol -
1
do
begin
ExcelApp
.
ActiveSheet
.
Columns[AExcelStartCol + ColIndex].ColumnWidth
:= GetColMaxDataLength(ASGrid, AGridStartCol + ColIndex, AGridStartRow);
end
;
ExcelApp
.
Cells
.
NumberFormatLocal :=
'@'
;
end
;
ExcelApp
.
WorkSheets[
1
].Activate;
ExcelApp
.
Cells
.
Item[AExcelStartRow, AExcelStartCol].Select;
except
ErrorMsgBox(
'无法打开报表模版:'
+ #
13
+ ExcelModalPath);
exit;
end
;
try
try
DataList := TStringList
.
Create;
DataList
.
Clear;
with
ASGrid
do
begin
for
RowIndex := AGridStartRow
to
RowCount -
1
do
begin
OneRowData :=
''
;
for
ColIndex := AGridStartCol
to
ColCount -
1
do
begin
OneRowData := OneRowData + Trim(Cells[ColIndex, RowIndex]) + #
9
;
end
;
DataList
.
Add(OneRowData);
end
;
end
;
ClipBoard
.
AsText := DataList
.
Text;
ExcelApp
.
ActiveSheet
.
Paste;
finally
DataList
.
Free;
ClipBoard
.
Clear;
end
;
ExcelApp
.
ActiveWorkbook
.
SaveAs(SaveExcelFilePath);
SuccessMsgBox(
'成功将文件保存到:'
+ #
13
+ SaveExcelFilePath);
finally
ExcelApp
.
DisplayAlerts :=
false
;
ExcelApp
.
WorkBooks
.
Close;
end
;
finally
ExcelApp
.
Quit;
ExcelApp:= Unassigned;
end
;
except
On
e: Exception
do
begin
ErrorMsgbox(e
.
Message);
end
;
end
;
end
;
function
GetColMaxDataLength(ASGrid: TStringGrid; ACol, AStartRow:
Integer
):
Integer
;
var
ColIndex, RowIndex:
Integer
;
MaxColLength:
Integer
;
begin
MaxColLength :=
0
;
with
ASGrid
do
begin
for
RowIndex := AStartRow
to
RowCount -
1
do
begin
if
length(Cells[ACol, RowIndex]) > MaxColLength
then
begin
MaxColLength:= length(Cells[ACol, RowIndex]);
end
;
end
;
end
;
result := MaxColLength;
end
;
procedure
SetOneColWidth(ASGrid: TStringGrid; ACol:
Integer
);
var
OneCharPixel:
Integer
;
RightSpaceWidth:
Integer
;
begin
RightSpaceWidth :=
3
;
OneCharPixel :=
6
;
ASGrid
.
ColWidths[ACol] := GetColMaxDataLength(ASGrid, ACol,
0
) * OneCharPixel
+ RightSpaceWidth;
end
;
procedure
SetAllColWidth(ASGrid: TStringGrid);
var
ColIndex:
Integer
;
begin
for
ColIndex :=
0
to
ASGrid
.
ColCount -
1
do
begin
SetOneColWidth(ASGrid, ColIndex);
end
;
end
;
procedure
ShowClientDataSetData(ASGrid: TStringGrid; ACDSet: TClientDataSet;
请发表评论