unit MyLib;
interface
uses
classes, Printers, DBGrids, Graphics, Sysutils, Windows, Forms, DB, Grids,
Dialogs, ComObj, Controls,StdCtrls;
type
TPrnOut = class(TObject)
procedure PrintHeader(s:string);
procedure PrintFoot(s:string);
procedure PrintLine(x1,y1,x2,y2:integer);
procedure PrintRow(Items:TStringList;rowDBGrid:TDBGrid);
procedure PrintColumns(colDBGrid:TDBGrid);
procedure PrintRecords(recDBGrid:TDBGrid);
procedure PrintPart(MDBG,PDBG:TDBGrid);
procedure SingleDBGPrint(DBgrid:TDBGrid;Header,Footer:string);
procedure DoubleDBGPrint(MainDBG,PartDBG:TDBGrid;Header,Footer:string);
private
{ Private declarations }
strHead,strFoot:string;
iPage:integer;
iWordWidth,iWordHeight:integer; //单位字宽与字高
iAmount:integer;
iPageHeight,iPageWidth:integer; //有效打印区域高度与宽度
PixelsInInchX:integer;
{Number of pixels in 1/10 of an inch.This is used for lin spacing}
TenthsOfInchPixelsY: Integer;
public
{ Public declarations }
end;
{TStrGridPrn}
type
TStrGridPrn = class(TObject)
procedure PrintHeader(s:string);
procedure PrintFoot(s:string);
procedure PrintLine(x1,y1,x2,y2:integer);
procedure PrintRow(Items:TStringList;StrGrid:TStringGrid);
procedure PrintColumns(StrGrid:TStringGrid);
procedure PrintRecords(StrGrid:TStringGrid);
procedure StrGridPrint(StrGrid:TStringGrid;Header,Footer:string);
private
{ Private declarations }
strHead,strFoot:string;
iPage:integer;
iWordWidth,iWordHeight:integer; //单位字宽与字高
iAmount:integer;
iPageHeight,iPageWidth:integer; //有效打印区域高度与宽度
PixelsInInchX:integer;
{Number of pixels in 1/10 of an inch.This is used for lin spacing}
TenthsOfInchPixelsY: Integer;
public
{ Public declarations }
end;
type
TRMB = Class(TObject)
Function BigRBM(sn:Double):String;
private
{ Private declarations }
public
{ Public declarations }
end;
type
TDBExcel =class(TObject)
procedure DBToExcel(DBGrid:TDBGrid);
private
{ Private declarations }
public
{ Public declarations }
end;
{我的自编函数集}
function StrFormat(ch:Char;s:string;len,index:integer):string;
//格式化一个字符串s，在index处加字符ch，使其长度len，
funCtion FormatStr(ch,s:string;Len:Integer):string;
//在字符串S前加若干个CH使期长度变为LEN
function CharInStr(ch:char;s:string):integer;
//计算字符串s里字符ch的数量
function IsNumeric(s:string):Boolean;
{判断字符串是否可以转换成数值。返回True表示可以}
function ClearSpace(s:string):string;
{清除字符串中的所有空格}
function IsEndOfMonth(Date:TDateTime):Boolean;
{判断Date是否为月末最后一天}
function IsEndOfYear(Date:TDateTime):Boolean;
{判断Date是否为年末最后一天}
function GetOSInfo:string;
{获取操作系统信息}
procedure StrGridMove(sg:TStringGrid;FromIndex,ToIndex:Integer);
{移动字符串栅格行}
procedure StrGridDel(strgrd:TStringGrid;id:Integer);
{删除一行}
function RunSQL:String;
{生成万能查询语句}
(*procedure RunFile(FileName,paramer,path:string);
{运行文件，fn为文件名，pm为参数，出错则显示信息}
*)
function ToTime(DateTime:TDateTime;day,hour,minute,second:{加减量}integer):TDateTime;
//加减时间
procedure TimeMinus(dt1,dt2:TDateTime;var Day,Hour,Minute,Second:Integer);
//求两时间差值，返回日、时、分、秒。
funCtion InputStr(t,p,DefaultValue:string;Pass:Boolean):string;
//类似于InputBox
implementation
uses RunSQL,ShellAPI;
{我的函数}
funCtion InputStr(t,p,DefaultValue:string;Pass:Boolean):string;
var
Form:TForm;
edit:TEdit;
btnOK,btnCancel:TButton;
begin
Form :=TForm.Create(Application);
with Form do
begin
BorderStyle :=bsDialog;
FormStyle :=fsStayOnTop;
with Font do
begin
Height :=-14;
Name :='宋体';
Size :=11;
Pitch :=fpDefault;
style :=[];
end;
Height :=151;
Width :=293;
Position :=poDesktopCenter;
Caption :=t;
with TLabel.Create(Form) do
begin
Parent := Form;
Top :=16;
Left :=24;
Caption :=p;
end;
Edit :=TEdit.Create(Form);
with Edit do
begin
Parent := Form;
Top :=40;
Left :=24;
Width :=241;
Text :=DefaultValue;
if pass then PasswordChar :='*'
else PasswordChar :=#0;
SelectAll;
end;
btnOK :=TButton.Create(Form);
with btnOK do
begin
Parent := Form;
Top := 88;
Left := 58;
Caption :='确定(&O)';
ModalResult :=mrOK;
Default :=True;
end;
btnCancel :=TButton.Create(Form);
with btnCancel do
begin
Parent := Form;
Top := 88;
Left := 154;
Caption :='取消(&C)';
ModalResult :=mrCancel;
end;
if ShowModal=mrOK then
begin
Result := Edit.Text;
end;
Free;
end;
end;
procedure TimeMinus(dt1,dt2:TDateTime;var Day,Hour,Minute,Second:Integer);
var
d:Real;
h,m,s:integer;
hh1,mm1,ss1,ms1,hh2,mm2,ss2,ms2:word;
begin
try
{两个时间差}
DecodeTime(dt1,hh1,mm1,ss1,ms1);
DecodeTime(dt2,hh2,mm2,ss2,ms2);
except
Exit;
end;
d:=int(dt1-dt2);
h:=hh1;
m:=mm1;
s:=ss1;
if s<ss2 then
begin
m:=m-1;
s:=s+60;
end;
if m<mm2 then
begin
h:=h-1;
m:=m+60;
end;
if h<hh2 then
begin
d :=d-1;
h:=h+24;
end;
{返回day,hour,minute,second}
day :=round(d);
hour :=h-hh2;
minute :=m-mm2;
second :=s-ss2;
end;
function ToTime(DateTime:TDateTime;day,hour,minute,second:{加减量}integer):TDateTime;
var
hh,mm,ss,ms:word;
hx,mx,sx:integer; //新时间值
dt:TDate;
begin
dt :=DateTime;
DecodeTime(DateTime,hh,mm,ss,ms);
hx:=hh;
mx:=mm;
sx:=ss;
{秒}
sx:=sx+second;
if sx<0 then
begin
minute :=minute + (sx div 60)-1;
sx :=60 +(sx mod 60);
end
else if sx>=60 then
begin
minute :=minute+(sx div 60);
sx :=sx mod 60;
end;
{分}
mx :=mx+minute;
if mx<0 then
begin
hour :=hour+(mx div 60)-1;
mx :=60+(mx mod 60);
end
else if mx>=24 then
begin
hour :=hour+(mx div 60);
mx :=mx mod 60;
end;
{时}
hx :=hx+hour;
if hx<0 then
begin
day :=day+(hx div 24)-1;
hx :=24+(hx mod 24);
end
else if hx>=24 then
begin
day :=day+(hx div 24);
hx :=hx mod 24;
end;
{天}
dt :=dt+day;
DateTime :=StrToDateTime(DateToStr(dt)+' '+IntToStr(hx)+':'+IntToStr(mx)+
':'+IntToStr(sx)+':');
Result :=DateTime;
end;
funCtion FormatStr(ch,s:string;Len:Integer):string;
//在字符串S前加若干个CH使期长度变为LEN
begin
while (len-length(s)>0) do s:=ch+s;
Result :=s;
end;
function StrFormat(ch:Char;s:string;len,index:integer):string;
begin
while Len>=Length(s) do
Insert(ch,s,index);
Result :=s;
end;
function CharInStr(ch:char;s:string):integer;
//计算字符串s里字符ch的数量
var
i,count:integer;
begin
count:=0;
for i:=1 to length(s) do
if s[i]=ch then inc(count);
Result:=count;
end;
{判断数值}
function IsNumeric(S:string):Boolean;
var
i:integer;
begin
Result :=True;
for i:=1 to Length(s) do
begin
if (s[i] in ['0'..'9','.','+','-']) then
begin
if i>1 then
if (s[i]='+') or (s[i]='-') then Result :=False;
end
else Result :=false;
end; //for
if CharInStr('.',s)>1 then Result :=False;
end;
{清除空格}
function ClearSpace(s:string):string;
begin
while pos(' ',s)>0 do
delete(s,pos(' ',s),1);
Result:=s;
end;
//判断Date是否为月末最后一天
function IsEndOfMonth(Date:TDateTime):Boolean;
var
yy,mm,dd:Word;
begin
DecodeDate(Date,yy,mm,dd);
inc(mm);
if mm=13 then
begin
inc(yy);
mm :=1;
end;
Result :=(EncodeDate(yy,mm,1)-Date<1);
end;
//判断Date是否为年末最后一天
function IsEndOfYear(Date:TDateTime):Boolean;
var
yy,mm,dd:Word;
begin
DecodeDate(Date,yy,mm,dd);
Result :=(EncodeDate(yy+1,1,1)-Date<1);
end;
{获取操作系统信息}
function GetOSInfo:string;
var
Platform: string;
BuildNumber: Integer;
begin
case Win32Platform of
VER_PLATFORM_WIN32_WINDOWS:
begin
Platform := 'Windows 95/98';
BuildNumber := Win32BuildNumber and $0000FFFF;
end;
VER_PLATFORM_WIN32_NT:
begin
Platform := 'Windows NT';
BuildNumber := Win32BuildNumber;
end;
else
begin
Platform := 'Windows';
BuildNumber := 0;
end;
end;
if (Win32Platform = VER_PLATFORM_WIN32_WINDOWS) or
(Win32Platform = VER_PLATFORM_WIN32_NT) then
begin
if Win32CSDVersion = '' then
Result := Format('%s %d.%d (Build %d)', [Platform, Win32MajorVersion,
Win32MinorVersion, BuildNumber])
else
Result := Format('%s %d.%d (Build %d: %s)', [Platform, Win32MajorVersion,
Win32MinorVersion, BuildNumber, Win32CSDVersion]);
end
else
Result := Format('%s %d.%d', [Platform, Win32MajorVersion,
Win32MinorVersion])
end;
procedure StrGridMove(sg:TStringGrid;FromIndex,ToIndex:Integer);
var
lst:TStringList;
i,id,x:integer;
begin
lst :=TStringList.Create;
id:=ToIndex; //目标指针
if FromIndex>=ToIndex then x:=1 else x:=-1; //判断指针下移还上移
with sg do
begin
while id<>FromIndex do
begin
lst.clear;
for i:=0 to ColCount-1 do
lst.Add(Cells[i,id]);
for i:=0 to ColCount-1 do
Cells[i,id] :=Cells[i,FromIndex];
for i:=0 to ColCount-1 do
Cells[i,FromIndex] :=lst.Strings[i];
id :=id+x; //指针转移(x=-1 or x=1)
end;
end;
lst.Free;
end;
procedure StrGridDel(strgrd:TStringGrid;id:Integer);
{删除一行}
var
i,j:integer;
begin
with strgrd do
begin
if id<1 then exit;
for i:=id to RowCount-1 do
for j:=0 to colCount-1 do
begin
cells[j,i] :='';
if i<>RowCount-1 then
cells[j,i] :=cells[j,i+1]
end;
if RowCount>2 then RowCount :=RowCount-1;
end;
end;
function RunSQL:String;
begin
frmRunSQL.ShowModal;
if frmRunSQL.ModalResult=1 then
begin
Result :=frmRunSQL.SQLString;
end;
frmRunSQL.close;
frmRunSQL.Free;
end;
(*
procedure RunFile(FileName,paramer,path:string);
var
Resulr:THandle;
begin
result:=ShellExecute(Handle,nil,PChar(FileName),
PChar(paramer),PChar(path),SW_SHOW);
case Result of
0:Application.MessageBox('操作系统内存资源不足！',PChar('打开文件'+FileName),MB_OK+MB_ICONError);
ERROR_FILE_NOT_FOUND：
Application.MessageBox('文件找不到！',PChar('打开文件'+FileName),MB_OK+MB_ICONError);
ERROR_PATH_NOT_FOUND：
Application.MessageBox('路径找不到！',PChar('打开文件'+FileName),MB_OK+MB_ICONError);
ERROR_BAD_FORMAT：
Application.MessageBox('文件执行格式错误，不能打开！',PChar('打开文件'+FileName),MB_OK+MB_ICONError);
SE_ERR_ASSOCINCOMPLETE：
Application.MessageBox('文件名错误！',PChar('打开文件'+FileName),MB_OK+MB_ICONError);
else
Application.MessageBox('文件运行错误！',PChar('打开文件'+FileName),MB_OK+MB_ICONError);
end;
end;
*)
{TPrnOut}
procedure TPrnOut.PrintHeader(s:string);
begin
{页头打印}
if s='' then s :='<无标题>';
With Printer do
begin
with Canvas.Font do
begin
Size :=12;
Name:='宋体';
end;
if (not Aborted) then
Canvas.TextOut((PageWidth div 2)-(Canvas.TextWidth(s) div 2),0,s);
iAmount :=iAmount+Canvas.TextHeight(s)*2;
end;
end;
procedure TPrnOut.PrintFoot(s:string);
var
str:string;
begin
{页脚打印}
if s='' then str:=s+'第'+IntToStr(iPage)+'页'
else str:= s +' '+'第'+IntToStr(iPage)+'页';
With Printer do
if (not Aborted) then
Canvas.TextOut((PageWidth div 2)-(Canvas.TextWidth(str) div 2),
(iPageHeight-iWordHeight),str);
iAmount :=0;
iPage :=iPage+1;
end;
procedure TPrnOut.PrintLine(x1,y1,x2,y2:integer);
begin
with Printer.Canvas do
begin
MoveTo(x1,y1);
LineTo(x2,y2);
end;
end;
procedure TPrnOut.PrintRow(Items:TStringList;rowDBGrid:TDBGrid);
var
OutRect:TRect;
i:integer;
Inches:Double;
begin
OutRect.Left :=50;
OutRect.Top :=iAmount;
With Printer.Canvas do
begin
for i := 0 to Items.Count -1 do
begin
Inches :=LongInt(Items.Objects[i])*0.1;
OutRect.Right :=OutRect.Left + Round(PixelsInInchx * Inches);
if OutRect.Right>iPageWidth then
begin
{换行打印}
OutRect.Left :=70;
OutRect.Right :=70+OutRect.Left + Round(PixelsInInchx * Inches);
iAmount := iAmount + iWordHeight;
OutRect.Top := iAmount;
end;
{换页}
if (iAmount+iWordHeight)>(iPageHeight-iWordHeight) then
begin
PrintFoot(''); //打印页脚
iAmount :=0;
if not Printer.Aborted then
Printer.NewPage;
PrintHeader('');
PrintColumns(rowDBGrid); //打印列头
OutRect.Left :=70;
OutRect.Right :=70+OutRect.Left + Round(PixelsInInchx * Inches);
iAmount := iAmount + iWordHeight;
OutRect.Top := iAmount;
end;
if not printer.Aborted then
TextRect(OutRect,OutRect.Left,OutRect.Top,Items[i]);
OutRect.Left :=OutRect.Right;
end;
end;
iAmount :=iAmount + iWordHeight+2;
end;
procedure TPrnOut.PrintColumns(colDBGrid:TDBGrid);
var
lst:TStringList;
i:integer;
begin
{打印列标题}
lst :=TStringList.Create;
try
{获取打印机字的大小}
with printer.Canvas do
begin
Font.Style :=[fsBold,fsUnderline];
iWordWidth :=TextWidth('x');
iWordHeight :=TextHeight('x');
end;
for i:=0 to colDBGrid.Columns.Count-1 do
lst.AddObject(colDBGrid.Columns[i].Title.Caption,
Pointer((colDBGrid.Columns[i].Width div 10)+2));
PrintRow(lst,colDBGrid);
Printer.Canvas.Font.Style :=[];
Except
lst.Free;
printer.EndDoc;
end;
end;
procedure TPrnOut.PrintRecords(recDBGrid:TDBGrid);
var
lst:TStringList;
i:integer;
begin
{打印记录}
lst :=TStringList.Create;
try
with recDBGrid.DataSource.DataSet do
begin
First;
While (not Eof) or Printer.Aborted do
begin
Application.ProcessMessages;
for i:=0 to recDBGrid.Columns.Count-1 do
lst.AddObject(recDBGrid.Columns[i].Field.DisplayText,
Pointer((recDBGrid.Columns[i].Width div 10)+2));
PrintRow(lst,recDBGrid); //行打印
lst.Clear;
Next;
end;
end;
finally
lst.Free;
end;
end;
procedure TPrnOut.PrintPart(MDBG,PDBG:TDBGrid);
var
lst:TStringList;
i:integer;
begin
lst :=TStringList.Create;
try
with MDBG.DataSource.DataSet do
begin
First;
While (not Eof) do
begin
Application.ProcessMessages;
for i:=0 to FieldDefs.Count-1 do
lst.AddObject(MDBG.Columns[i].Field.DisplayText,
Pointer((MDBG.Columns[i].Width div 10)+2));
PrintRow(lst,MDBG); //行打印
lst.Clear;
PrintColumns(PDBG);
PrintRecords(PDBG);
Next;
end;
end;
finally
lst.Free;
end;
end;
procedure TPrnOut.SingleDBGPrint(DBGrid:TDBGrid;
Header,Footer:string);
begin
screen.Cursor :=crHourglass;
strHead :=Header;
strFoot :=Footer;
iPage :=1;
{单表打印}
try
with Printer do
begin
PixelsInInchX :=GetDeviceCaps(Handle,LOGPIXELSX);
TenthsOfInchPixelsY :=GetDeviceCaps(Printer.Handle,LOGPIXELSY) div 10;
iPageHeight :=PageHeight;
iPageWidth :=PageWidth; //减去左右边距
Canvas.Font.Size :=11;
BeginDoc;
end;
{打印页头}
PrintHeader(Header);
{打印标题栏：粗体，下划线}
PrintColumns(DBGrid);
{循环打印记录}
PrintRecords(DBGrid);
{打印页脚：页码}
PrintFoot(Footer);
finally
printer.EndDoc;
screen.Cursor :=crDefault;
end;
end;
procedure TPrnOut.DoubleDBGPrint(MainDBG,PartDBG:TDBGrid;
Header,Footer:string);
begin
screen.Cursor :=crHourglass;
iPage :=1;
{明细表打印}
try
with Printer do
begin
PixelsInInchX :=GetDeviceCaps(Handle,LOGPIXELSX);
TenthsOfInchPixelsY :=GetDeviceCaps(Printer.Handle,LOGPIXELSY) div 10;
iPageHeight :=PageHeight;
iPageWidth :=PageWidth; //减去左右边距
Canvas.Font.Size :=11;
BeginDoc;
end;
{打印页头}
PrintHeader(Header);
{打印标题栏：粗体，下划线}
PrintColumns(MainDBG);
{循环打印记录}
PrintPart(MainDBG,PartDBG);
{打印页脚：页码}
PrintFoot(Footer);
{新页起始：重复上面工作}
finally
printer.EndDoc;
screen.Cursor :=crDefault;
end;
end;
{TStrGridPrn}
procedure TStrGridPrn.PrintHeader(s:string);
begin
{页头打印}
if s='' then s :='<无标题>';
With Printer do
begin
with Canvas.Font do
begin
Size :=12;
Name:='宋体';
end;
if (not Aborted) then
Canvas.TextOut((PageWidth div 2)-(Canvas.TextWidth(s) div 2),0,s);
iAmount :=iAmount+Canvas.TextHeight(s)*2;
end;
end;
procedure TStrGridPrn.PrintFoot(s:string);
var
str:string;
begin
{页脚打印}
if s='' then str:=s+'第'+IntToStr(iPage)+'页'
else str:= s +' '+'第'+IntToStr(iPage)+'页';
With Printer do
if (not Aborted) then
Canvas.TextOut((PageWidth div 2)-(Canvas.TextWidth(str) div 2),
(iPageHeight-iWordHeight),str);
iAmount :=0;
iPage :=iPage+1;
end;
procedure TStrGridPrn.PrintLine(x1,y1,x2,y2:integer);
begin
with Printer.Canvas do
begin
MoveTo(x1,y1);
LineTo(x2,y2);
end;
end;
procedure TStrGridPrn.PrintRow(Items:TStringList;StrGrid:TStringGrid);
var
OutRect:TRect;
i:integer;
Inches:Double;
begin
OutRect.Left :=50;
OutRect.Top :=iAmount;
With Printer.Canvas do
begin
for i := 0 to Items.Count -1 do
begin
Inches :=LongInt(Items.Objects[i])*0.1;
OutRect.Right :=OutRect.Left + Round(PixelsInInchx * Inches);
if OutRect.Right>iPageWidth then
begin
{换行打印}
OutRect.Left :=70;
OutRect.Right :=70+OutRect.Left + Round(PixelsInInchx * Inches);
iAmount := iAmount + iWordHeight;
OutRect.Top := iAmount;
end;
{换页}
if (iAmount+iWordHeight)>(iPageHeight-iWordHeight) then
begin
PrintFoot(''); //打印页脚
iAmount :=0;
if not Printer.Aborted then
Printer.NewPage;
PrintHeader('');
PrintColumns(StrGrid); //打印列头
OutRect.Left :=70;
OutRect.Right :=70+OutRect.Left + Round(PixelsInInchx * Inches);
iAmount := iAmount + iWordHeight;
OutRect.Top := iAmount;
end;
if not printer.Aborted then
TextRect(OutRect,OutRect.Left,OutRect.Top,Items[i]);
OutRect.Left :=OutRect.Right;
end;
end;
iAmount :=iAmount + iWordHeight+2;
end;
procedure TStrGridPrn.PrintColumns(StrGrid:TStringGrid);
var
lst:TStringList;
i:integer;
begin
{打印列标题}
lst :=TStringList.Create;
try
{获取打印机字的大小}
with printer.Canvas do
begin
Font.Style :=[fsBold,fsUnderline];
iWordWidth :=TextWidth('x');
iWordHeight :=TextHeight('x');
end;
for i:=0 to StrGrid.ColCount-1 do
lst.AddObject(StrGrid.Cells[i,0],
Pointer((StrGrid.ColWidths[i] div 10)+2));
PrintRow(lst,StrGrid);
Printer.Canvas.Font.Style :=[];
Except
lst.Free;
printer.EndDoc;
end;
end;
procedure TStrGridPrn.PrintRecords(StrGrid:TStringGrid);
var
lst:TStringList;
i,iRow:integer;
begin
{打印记录}
lst :=TStringList.Create;
try
for iRow :=1 to StrGrid.RowCount-1 do
begin
Application.ProcessMessages;
for i:=0 to StrGrid.ColCount-1 do
lst.AddObject(StrGrid.Cells[i,iRow],
Pointer((StrGrid.ColWidths[i] div 10)+2));
PrintRow(lst,StrGrid); //行打印
lst.Clear;
end;
finally
lst.Free;
end;
end;
procedure TStrGridPrn.StrGridPrint(StrGrid:TStringGrid;
Header,Footer:string);
begin
screen.Cursor :=crHourglass;
strHead :=Header;
strFoot :=Footer;
iPage :=1;
{单表打印}
try
with Printer do
begin
PixelsInInchX :=GetDeviceCaps(Handle,LOGPIXELSX);
TenthsOfInchPixelsY :=GetDeviceCaps(Printer.Handle,LOGPIXELSY) div 10;
iPageHeight :=PageHeight;
iPageWidth :=PageWidth; //减去左右边距
Canvas.Font.Size :=11;
BeginDoc;
end;
{打印页头}
PrintHeader(Header);
{打印标题栏：粗体，下划线}
PrintColumns(StrGrid);
{循环打印记录}
PrintRecords(StrGrid);
{打印页脚：页码}
PrintFoot(Footer);
finally
printer.EndDoc;
screen.Cursor :=crDefault;
end;
end;
{TRMB}
function TRMB.BigRBM(sn:Double):String;
var
dx:array[1..14] of string;
dd:array[0..9] of string;
s,ss:string;
L,i,n:integer;
zero,plus:boolean;
begin
{单位}
dx[1]:='分';
dx[2]:='角';
dx[3]:='元';
dx[4]:='拾';
dx[5]:='佰';
dx[6]:='仟';
dx[7]:='万';
dx[8]:='拾';
dx[9]:='佰';
dx[10]:='仟';
dx[11]:='亿';
dx[12]:='拾';
dx[13]:='佰';
dx[14]:='仟';
{数值}
dd[0]:='零';
dd[1]:='壹';
dd[2]:='贰';
dd[3]:='叁';
dd[4]:='肆';
dd[5]:='伍';
dd[6]:='陆';
dd[7]:='柒';
dd[8]:='捌';
dd[9]:='玖';
zero :=False;
sn :=sn*100; //把小数前两位转换成整数
if sn<0 then //取得符号标志值plus
begin
plus:=False; //负数
sn:=sn*(-1); //变成正数
end
else if sn>0 then plus:=True
else //等于0
begin
Result :='零元整';
exit;
end;
ss:=FloatToStr(int(sn)); //截取整数部份，再转换为字符串
L:=length(ss); //取得长度
for i:=1 to L do
begin
n:=StrToInt(copy(ss,L-i+1,1)); //取得单个数字
if n=0 then
begin
if (i=3) or (i=11) then s:=dx[i]+s //元、亿前不写0
else if (i=7) then
begin
if (StrToInt(Copy(ss,L-9,4))<>0) then
begin
if zero then s:=dx[i]+s //当千万至万不为0时，只写"万"
else if (not zero) then s:=dx[i]+dd[n]+s;
end
else
begin
if not zero then s:=dd[n]+s;
end;
end
else if (not zero) and (i>1) then s:=dd[n]+s; //当后耐不是0并为整数位时，写0
Zero :=True;
end
else
begin
s:=dd[n]+dx[i]+s; //正常
Zero:=False;
end;
end;
if plus then Result :=s+'整'
else Result :='负'+s+'整';
end;
{ TDBExcel }
procedure TDBExcel.DBToExcel(DBGrid: TDBGrid);
var
eclApp,WorkBook:Variant; {声明为OLE Automation对象}
xlsFileName:string;
i,j:integer;
sDlg :TSaveDialog;
begin
screen.Cursor :=crHourglass;
xlsFileName:='NoName.xls';
try
{创建OLE对象：Excel Application与WordBook}
eclApp:=CreateOleObject('Excel.Application');
WorkBook:=CreateOleObject('Excel.Sheet');
Except
screen.Cursor :=crDefault;
Application.MessageBox('你的机器没有安装Microsoft Excel',
'数据导出',MB_OK+MB_ICONWarning);
Exit;
End;
{读出记录，并写入EXCEL}
with DBGrid.DataSource.DataSet do
begin
if Active=False then
begin
Application.MessageBox('数据库没有打开！',
'数据导出',MB_OK+MB_ICONWarning);
Workbook.Close;
EclApp.Quit; //退出Excel Application
{释放Variant变量}
eclApp:=Unassigned;
Exit;
end;
try
WorkBook:=eclApp.workbooks.Add;
Except
screen.Cursor :=crDefault;
Application.MessageBox('Excel工作表添加操作失败！',
'数据导出',MB_OK+MB_ICONError);
Workbook.Close;
EclApp.Quit; //退出Excel Application
{释放Variant变量}
eclApp:=Unassigned;
Exit;
end;
{写标题}
screen.Cursor :=crHourGlass;
for i:=0 to DBGrid.Columns.Count-1 do
begin
try
EclApp.Cells(1,i+1):=DBGrid.Columns[i].Title.Caption;
except
screen.Cursor :=crDefault;
Application.MessageBox('数据写入Excel失败！',
'数据导出',MB_OK+MB_ICONError);
Workbook.Close;
EclApp.Quit; //退出Excel Application
{释放Variant变量}
eclApp:=Unassigned;
screen.Cursor :=crDefault;
Exit;
end;
end; //for i
First;
j:=2;
{数据写入}
While (not Eof) do
begin
for i:=0 to DBGrid.Columns.Count-1 do
begin
try
EclApp.Cells(j,i+1):=DBGrid.Fields[i].DisplayText;
except
screen.Cursor :=crDefault;
Application.MessageBox('数据写入Excel失败！',
'数据导出',MB_OK+MB_ICONError);
Workbook.Close;
EclApp.Quit; //退出Excel Application
{释放Variant变量}
eclApp:=Unassigned;
screen.Cursor :=crDefault;
Exit;
end;
end; //for i
next;
j:=j+1;
end; //while
end; //with DBGrid.
screen.Cursor :=crDefault;
sDlg :=TSaveDialog.Create(nil);
sDlg.DefaultExt :='xls';
sDlg.Filter :='Excel文件(*.xls)';
sDlg.Title :='保存Excel文件';
if sDlg.Execute then
begin
xlsFileName :=sDlg.FileName;
WorkBook.SaveAS(xlsFileName);
end;
WorkBook.Saved:=True; {已经保存:前面如没保存，则为放弃保存}
WorkBook.close;
EclApp.Quit; //退出Excel Application
{释放Variant变量}
eclApp:=Unassigned;
sDlg.Free;
screen.Cursor :=crDefault;
end;
end.