unit
SGridFunction;
{*******************************************
模块名称:StringGrid操作函数模块
编写者:Tony
开始日期:2006年12月05日
版本号:v1.0.7
********************************************}
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;
//成功提示框
//AMsg: 成功提示信息
procedure
SuccessMsgbox(AMsg:
String
);
//错误提示框
//AMsg: 错误提示信息
procedure
ErrorMsgbox(AMsg:
String
);
//询问提示框
//strMsg:询问信息
function
AskMsgbox(AMsg:
String
):
Boolean
;
//信息提示框
//AMsg: 提示信息
procedure
InfoMsgbox(AMsg:
String
);
//导出数据到Excel
//ASGrid:需要导出的StringGrid
//ExcelModalPath: 报表模版全路径,为空则新建工作簿
//ExcelFileName: Excel文件的默认文件名
//AGridStartCol, AGridStartRow: StringGrid的起始列和行,从0开始
//AExcelStartCol, AExcelStartRow: Excel的起始列和行,从1开始
procedure
ExportToExcel(ASGrid: TStringGrid; ExcelModalPath, ExcelFileName:
String
;
AGridStartCol, AGridStartRow, AExcelStartCol, AExcelStartRow:
Integer
);
//取得某一列数据的最大长度
//ASgrid: 目标StringGrid
//ACol: 目标列,从0开始
//AStartRow: 起始行,从0开始
function
GetColMaxDataLength(ASGrid: TStringGrid; ACol, AStartRow:
Integer
):
Integer
;
//根据数据长度自动设置指定列的列宽
//ASgrid: 目标StringGrid
//ACol: 目标列,从0开始
procedure
SetOneColWidth(ASGrid: TStringGrid; ACol:
Integer
);
//根据数据长度自动设置全部列的列宽
//ASgrid: 目标StringGrid
procedure
SetAllColWidth(ASGrid: TStringGrid);
//显示ClientDataSet中的数据
//ASgrid: 目标StringGrid
//ACDSet: 包含数据的ClientDataSet
//AGridStartCol, AGridStartRow: StringGrid的起始列和行,从0开始
procedure
ShowClientDataSetData(ASGrid: TStringGrid; ACDSet: TClientDataSet;
AGridStartCol, AGridStartRow:
Integer
);
//显示ADOQuery中的数据
//ASgrid: 目标StringGrid
//AQuery: 包含数据的ADOQuery
//AGridStartCol, AGridStartRow: StringGrid的起始列和行,从0开始
procedure
ShowQueryData(ASGrid: TStringGrid; AQuery: TADOQuery;
AGridStartCol, AGridStartRow:
Integer
);
//判断是否含有数据
//true: 包含数据
//false: 不包含数据
//ASgrid: 目标StringGrid
//AStartCol, AStartRow: 起始列和行,从0开始
function
HaveData(ASGrid: TStringGrid; AStartCol, AStartRow:
Integer
):
Boolean
;
//取得9位以内整数位数
//>=1: 该整型数的长度
//0: 空值
//-1: 长度超过9位
//ANumber: 需要判断位数的整型数
function
GetIntegerNumberLength(ANumber:
Integer
):
Integer
;
//为指定的序号列赋值
//序号编号从1开始
//ASGrid: 目标StringGrid
//ACol: 目标列,从0开始
//AStartRow: 起始行,从0开始
procedure
SetNumberFields(ASGrid: TStringGrid; ACol, AStartRow:
Integer
);
//设置指定的列的对齐方式为右对齐
//实现方式为在数据左边补空格,所以取数据时应注意去掉空格
//ASGrid: 目标StringGrid
//ACol: 目标列,从0开始
//AStartRow: 起始行,从0开始
procedure
SetColAlignRight(ASGrid: TStringGrid; ACol, AStartRow:
Integer
);
//设置指定行的左边距
//ASGrid: 目标StringGrid
//ARow: 目标行,从0开始
procedure
SetRowLeftSpace(ASGrid: TStringGrid; ARow, SpaceLength:
Integer
);
//设置指定行的最小右边距
//ASGrid: 目标StringGrid
//ARow: 目标行,从0开始
procedure
SetRowMinRightSpace(ASGrid: TStringGrid; ARow, SpaceLength:
Integer
);
//设置指定行的最小边距
//ASGrid: 目标StringGrid
//ARow: 目标行,从0开始
procedure
SetRowMinSpaceWidth(ASGrid: TStringGrid; ARow, SpaceLength:
Integer
);
//获得当前X坐标所在的列
//ASGrid: 目标StringGrid
//AX: 坐标的X值
function
GetColByCX(ASGrid: TStringGrid; AX:
Integer
):
Integer
;
//获得当前Y坐标所在的行
//ASGrid: 目标StringGrid
//AY: 坐标的Y值
function
GetRowByCY(ASGrid: TStringGrid; AY:
Integer
):
Integer
;
//获得当前坐标所处的单元格的行列值
//ASGrid: 目标StringGrid
//AX, AY: 坐标的X,Y值
//ACol, ARow: 单元格的列,行索引,从0开始
procedure
GetCellByCoordinate(ASGrid: TStringGrid; AX, AY:
Integer
;
out ACol, ARow:
Integer
);
//填充空的单元格为指定值
//ASGrid: 目标StringGrid
//AStartCol, AStartRow: 开始列和行,从0开始
//AEndCol, AEndRow: 结束列和行
//AValue: 填充值
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
;
//----------------------------------------------------------------------------//
//导出数据到Excel
//----------------------------------------------------------------------------//
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
;
//Excel文件的保存路径
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
;
//创建Excel对象
try
ExcelApp := CreateOleObject(
'Excel.Application'
);
//创建新Excel对象
except
ErrorMsgBox(
'请确认您的机器已经安装 Microsoft Excel 。'
);
Exit;
end
;
try
//打开Excel工作簿
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
//此处不能使用ASGrid.ColWidths[AGridStartCol + ColIndex];
ExcelApp
.
ActiveSheet
.
Columns[AExcelStartCol + ColIndex].ColumnWidth
:= GetColMaxDataLength(ASGrid, AGridStartCol + ColIndex, AGridStartRow);
end
;
//数字 NumberFormatLocal = "0.00_ "
//日期 NumberFormatLocal = "yyyy-m-d"
//时间 NumberFormatLocal = "[$-F400]h:mm:ss AM/PM"
//文本 NumberFormatLocal = "@"
ExcelApp
.
Cells
.
NumberFormatLocal :=
'@'
;
//设置单元格为文本格式
end
;
ExcelApp
.
WorkSheets[
1
].Activate;
//设置第1个工作表为活动工作表
ExcelApp
.
Cells
.
Item[AExcelStartRow, AExcelStartCol].Select;
//设定Excel起始单元格
except
ErrorMsgBox(
'无法打开报表模版:'
+ #
13
+ ExcelModalPath);
//#13为回车换行
exit;
end
;
try
//通过剪切板导出数据
try
//初始化DataList
DataList := TStringList
.
Create;
DataList
.
Clear;
//将数据保存到DataList
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
;
//#9为制表符
end
;
DataList
.
Add(OneRowData);
//将该行数据添加到DataList
end
;
end
;
ClipBoard
.
AsText := DataList
.
Text;
//将DataList中的数据拷贝到剪切板
ExcelApp
.
ActiveSheet
.
Paste;
//将剪切板中的数据拷贝到Excel
finally
DataList
.
Free;
//释放DataList
ClipBoard
.
Clear;
//清空剪切板
end
;
//保存Excel文件
ExcelApp
.
ActiveWorkbook
.
SaveAs(SaveExcelFilePath);
//另存为到指定目录
SuccessMsgBox(
'成功将文件保存到:'
+ #
13
+ SaveExcelFilePath);
//保存成功
finally
ExcelApp
.
DisplayAlerts :=
false
;
//不弹出保存提示对话框
ExcelApp
.
WorkBooks
.
Close;
//关闭工作簿
end
;
finally
ExcelApp
.
Quit;
//关闭Excel进程
ExcelApp:= Unassigned;
//释放ExcelApp
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
;
//设置为3达到和左边距一致的效果
OneCharPixel :=
6
;
//6对应9号字[*此处最好写成一个根据字号获得像素值的函数*]
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
;
//----------------------------------------------------------------------------//
//显示ClientDataSet中的数据
//----------------------------------------------------------------------------//
procedure
ShowClientDataSetData(ASGrid: TStringGrid; ACDSet: TClientDataSet;
AGridStartCol, AGridStartRow:
Integer
);
var
ColIndex:
Integer
;
RowIndex:
Integer
;
begin
try
with
ASGrid
do
begin
//没有记录时,清空StringGrid并返回
if
ACDSet
.
RecordCount <=
0
then
begin
RowCount :=
2
;
for
ColIndex :=
0
to
ColCount -
1
do
begin
Cells[ColIndex,
1
] :=
''
;
end
;
exit;
end
;
RowCount := AGridStartRow + ACDSet
.
RecordCount;
//StringGrid行数
ColCount := AGridStartCol + ACDSet
.
FieldCount;
//StringGrid列数
RowIndex := AGridStartRow;
//当前行为起始行
while
not
ACDSet
.
Eof
do
begin
//显示数据
for
ColIndex := AGridStartCol
to
ColCount -
1
do
begin
Cells[ColIndex, RowIndex]
:= ACDSet
.
Fields
.
Fields[ColIndex - AGridStartCol].AsString
end
;
//转到下一行
RowIndex := RowIndex +
1
;
ACDSet
.
Next;
end
;
end
;
except
On
e: Exception
do
begin
ErrorMsgBox(e
.
Message);
end
;
end
;
end
;
//----------------------------------------------------------------------------//
//显示ADOQuery中的数据
//----------------------------------------------------------------------------//
procedure
ShowQueryData(ASGrid: TStringGrid; AQuery: TADOQuery;
AGridStartCol, AGridStartRow:
Integer
);
var
ColIndex:
Integer
;
RowIndex:
Integer
;
begin
try
with
ASGrid
do
begin
//没有记录时,清空StringGrid并返回
if
AQuery
.
RecordCount <=
0
then
begin
RowCount :=
2
;
for
ColIndex :=
0
to
ColCount -
1
do
begin
Cells[ColIndex,
1
] :=
''
;
end
;
exit;
end
;
RowCount := AGridStartRow + AQuery
.
RecordCount;
//StringGrid行数
ColCount := AGridStartCol + AQuery
.
FieldCount;
//StringGrid列数
RowIndex := AGridStartRow;
//当前行为起始行
while
not
AQuery
.
Eof
do
begin
//显示数据
for
ColIndex := AGridStartCol
to
ColCount -
1
do
begin
Cells[ColIndex, RowIndex]
:= AQuery
.
Fields
.
Fields[ColIndex - AGridStartCol].AsString
end
;
//转到下一行
RowIndex := RowIndex +
1
;
AQuery
.
Next;
end
;
end
;
except
On
e: Exception
do
begin
ErrorMsgBox(e
.
Message);
end
;
end
;
end
;
//----------------------------------------------------------------------------//
//判断是否含有数据
//----------------------------------------------------------------------------//
function
HaveData(ASGrid: TStringGrid; AStartCol, AStartRow:
Integer
):
Boolean
;
var
ColIndex, RowIndex:
Integer
;
begin
with
ASgrid
do
begin
for
ColIndex := AStartCol
to
ColCount -
1
do
begin
for
RowIndex := AStartRow
to
RowCount -
1
do
begin
//包含数据,返回true
if
Cells[ColIndex, RowIndex] <>
''
then
begin
result :=
true
;
exit;
end
;
end
;
end
;
end
;
//没有数据,返回false
result :=
false
;
end
;
//----------------------------------------------------------------------------//
//取得9位以内整数位数
//----------------------------------------------------------------------------//
function
GetIntegerNumberLength(ANumber:
Integer
):
Integer
;
var
IsNegativeNumber:
Boolean
;
//参数的正负,负数为true
LoopIndex:
Integer
;
//循环变量
ComporeNumber:
Integer
;
//用于比较的数
NumberLength:
Integer
;
//返回值,长度大于10返回-1
begin
if
ANumber = null
then
begin
result :=
0
;
//空值返回0
exit;
end
;
//判断参数的正负
if
ANumber <
0
then
begin
ANumber :=
0
- ANumber;
//转换成正数用于计算长度
IsNegativeNumber :=
true
;
//是负数
end
else
begin
if
ANumber =
0
then
begin
result :=
1
;
//是0,直接返回1
exit;
end
;
IsNegativeNumber :=
false
;
//是正数
end
;
//开始比较
ComporeNumber:=
10
;
for
LoopIndex:=
1
to
9
do
begin
//长度符合要求
if
(ComporeNumber
div
ANumber) >
0
then
begin
//得到长度
if
ComporeNumber = ANumber
then
NumberLength := LoopIndex +
1
else
NumberLength := LoopIndex;
//如果是负数,则长度加1,即包含负号
if
IsNegativeNumber
then
result:= NumberLength +
1
else
result := NumberLength;
exit;
end
;
//增大1位继续比较
ComporeNumber := ComporeNumber *
10
;
continue;
end
;
result := -
1
;
//长度大于9,返回-1
end
;
//----------------------------------------------------------------------------//
//为指定的序号列赋值
//----------------------------------------------------------------------------//
procedure
SetNumberFields(ASGrid: TStringGrid; ACol, AStartRow:
Integer
);
var
RowIndex:
Integer
;
//当前序号
begin
with
ASGrid
do
begin
for
RowIndex :=
1
to
RowCount - AStartRow
do
begin
//添加序号
Cells[ACol, AStartRow + RowIndex -
1
] := VarToStr(RowIndex);
end
;
end
;
end
;
//----------------------------------------------------------------------------//
//设置指定的列的对齐方式为右对齐
//----------------------------------------------------------------------------//
procedure
SetColAlignRight(ASGrid: TStringGrid; ACol, AStartRow:
Integer
);
var
RowIndex:
Integer
;
MaxDataLength:
Integer
;
//该列最大的数据长度
begin
MaxDataLength := GetColMaxDataLength(ASGrid, ACol,
0
);
//取得该列最大的数据长度
with
ASGrid
do
begin
for
RowIndex := AStartRow
to
RowCount -
1
do
begin
while
length(Cells[ACol, RowIndex]) < MaxDataLength
do
begin
Cells[ACol, RowIndex] :=
' '
+ Cells[ACol, RowIndex];
//在前面补空格
end
;
end
;
end
;
end
;
//----------------------------------------------------------------------------//
//设置指定行的左边距
//----------------------------------------------------------------------------//
procedure
SetRowLeftSpace(ASGrid: TStringGrid; ARow, SpaceLength:
Integer
);
var
ColIndex, LoopIndex:
Integer
;
begin
with
ASGrid
do
begin
for
ColIndex :=
0
to
ColCount -
1
do
begin
Cells[ColIndex, ARow] := TrimLeft(Cells[ColIndex, ARow]);
//去掉左边空格
for
LoopIndex :=
1
to
SpaceLength
do
begin
Cells[ColIndex, ARow] :=
' '
+ Cells[ColIndex, ARow];
//在左边补空格
end
;
end
;
end
;
end
;
//----------------------------------------------------------------------------//
//设置指定行的最小右边距
//----------------------------------------------------------------------------//
procedure
SetRowMinRightSpace(ASGrid: TStringGrid; ARow, SpaceLength:
Integer
);
var
ColIndex, LoopIndex:
Integer
;
begin
with
ASGrid
do
begin
for
ColIndex :=
0
to
ColCount -
1
do
begin
Cells[ColIndex, ARow] := TrimRight(Cells[ColIndex, ARow]);
//去掉右边空格
for
LoopIndex :=
1
to
SpaceLength
do
begin
Cells[ColIndex, ARow] := Cells[ColIndex, ARow] +
' '
;
//在右边补空格
end
;
end
;
end
;
end
;
//----------------------------------------------------------------------------//
//设置指定行的最小边距
//----------------------------------------------------------------------------//
procedure
SetRowMinSpaceWidth(ASGrid: TStringGrid; ARow, SpaceLength:
Integer
);
var
ColIndex, LoopIndex:
Integer
;
begin
with
ASGrid
do
begin
for
ColIndex :=
0
to
ColCount -
1
do
begin
Cells[ColIndex, ARow] := Trim(Cells[ColIndex, ARow]);
//去掉两边空格
for
LoopIndex :=
1
to
SpaceLength
do
begin
Cells[ColIndex, ARow] :=
' '
+ Cells[ColIndex, ARow] +
' '
;
//在两边补空格
end
;
end
;
end
;
end
;
//----------------------------------------------------------------------------//
//获得当前X坐标所在的列
//----------------------------------------------------------------------------//
function
GetColByCX(ASGrid: TStringGrid; AX:
Integer
):
Integer
;
var
ColIndex:
Integer
;
CurCellRect: TRect;
//当前列的矩形区域
begin
with
ASGrid
do
begin
for
ColIndex :=
0
to
ColCount -
2
do
begin
CurCellRect := CellRect(ColIndex,
0
);
//当前列被隐藏,继续判断下一列
if
CurCellRect
.
Left = CurCellRect
.
Right
then
continue;
//X坐标在当前列的范围内
if
(AX >= CurCellRect
.
Left)
and
(AX < CurCellRect
.
Right)
then
begin
result := ColIndex;
exit;
end
;
end
;
result := ColCount -
1
;
//返回最后一列的索引
end
;
end
;
//----------------------------------------------------------------------------//
//获得当前Y坐标所在的行
//----------------------------------------------------------------------------//
function
GetRowByCY(ASGrid: TStringGrid; AY:
Integer
):
Integer
;
var
RowIndex:
Integer
;
CurCellRect: TRect;
//当前行的矩形区域
begin
with
ASGrid
do
begin
for
RowIndex :=
0
to
RowCount -
2
do
begin
CurCellRect := CellRect(
0
, RowIndex);
//当前行被隐藏,继续判断下一行
if
CurCellRect
.
Top = CurCellRect
.
Bottom
then
continue;
//Y坐标在当前行的范围内
if
(AY > CurCellRect
.
Top)
and
(AY < CurCellRect
.
Bottom)
then
begin
result := RowIndex;
exit;
end
;
end
;
result := RowCount -
1
;
//返回最后一行的索引
end
;
end
;
//----------------------------------------------------------------------------//
//获得当前坐标所处的单元格的行列值
//----------------------------------------------------------------------------//
procedure
GetCellByCoordinate(ASGrid: TStringGrid; AX, AY:
Integer
;
out ACol, ARow:
Integer
);
begin
ACol := GetColByCX(ASGrid, AX);
//取得列索引
ARow := GetRowByCY(ASGrid, AY);
//取得行索引
end
;
//----------------------------------------------------------------------------//
//填充空的单元格为指定值
//----------------------------------------------------------------------------//
procedure
SetSpaceCells(ASGrid: TStringGrid; AStartCol, AStartRow,
AEndCol, AEndRow:
Integer
; AValue:
String
);
var
ColIndex, RowIndex:
Integer
;
begin
with
ASGrid
do
begin
for
ColIndex := AStartCol
to
AEndCol
do
begin
for
RowIndex := AStartRow
to
AEndRow
do
begin
//单元格为空(不含空格)时填充
if
Trim(Cells[ColIndex, RowIndex]) =
''
then
begin
Cells[ColIndex, RowIndex] := AValue;
end
;
end
;
end
;
end
;
end
;
end
.