dephi用的人還多麼?希望對你有用

  一个函数集   
  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.