func.~pas

用Delphi编写的户籍管理系统

unit Func;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, DBCtrls, ComCtrls, ToolWin, Menus, ImgList, StdActns,
  DB, DBTables, ADODB, Excel2000;

function RMB1(i:Real):string; //  小写金额转大写 (简单）
function RMB(NN:real):string; //  小写金额转大写 (完整）
function GetPY(HZString: string): string;  //获取指定汉字串的第一个拼音字母串
function GetPYChar(hzchar: string): char;  //获取单汉字的第一个拼音字母
Function GetCDate(dDate:TdateTime):string; //返回中国式日期
procedure WriteToExcel(AdsData: TADODataSet; sName, Title: string);//导出数据到EXCEL

implementation

Function GetCDate(dDate:TDateTime):string;
var
  Year, Month, Day: Word;
begin
  DecodeDate(dDate,year,month,day);
  Result:=IntToStr(year)+'年'+IntToStr(MONTH)+'月'+IntToStr(DAY)+'日';
End;

function RMB(NN:real):string;
var
  HZ,NS,NW,NA,N1,N2:string;
  LA,X,Nk:integer;
begin
 if NN>9999999999999.99 then
 begin
  MessageDlg('金额溢出.',mtError,[mbOk], 0);
  HZ:='';
  Result:=HZ;
  exit;
 end;
 if NN=0 then
 begin
  HZ:='零元';
  result:=HZ;
  exit;
 end;
 NS:='零壹贰叁肆伍陆柒捌玖';
 NW:='分角元拾佰仟万拾佰仟亿拾佰仟万';
 NA:=FloatToStr(NN*100);
 LA:=length(NA);
 X:=1;
 HZ:='';
 while X<=LA do
 begin
 NK:=Ord(NA[x])-Ord('0');
 N1:=Copy(NS,NK*2+1,2);
 N2:=Copy(NW,LA*2+1-X*2,2);
 if (NK=0) AND ((N2='亿') OR( N2='万') OR( N2='元'))then
 begin
  if copy(HZ,Length(HZ)-1,2)='零' then
   HZ:=copy(HZ,1,length(HZ)-2);
  if copy(HZ,Length(HZ)-1,2)='亿' then
   if N2='元' then
   begin
    N1:=N2;
    N2:='零';
   end
   else
    N2:=''
  else
  begin
   N1:=N2;
   N2:='零';
  end
 end
 else if NK=0 then
      begin
       if copy(HZ,length(HZ)-1,2)='零' then
        N1:='';
       if N2='分' then
       begin
        if copy(HZ,length(HZ)-1,2)='零' then
         HZ:=copy(HZ,1,length(HZ)-2)+'整'
        else
         HZ:=HZ+'整'; 
        N1:='';
       end;
       N2:='';
      end;
  HZ:=HZ+N1+N2;
  X:=X+1
 end;
 Result:=HZ;
end;


function RMB1(i:Real):string;    //小写金额转大写 (简单）
const 
  d='零壹贰叁肆伍陆柒捌玖分角元拾佰仟万拾佰仟亿'; 
var 
  m,k:string;
  j:integer;
begin 
  k:=''; 
  m:=floattostr(int(i*100));
  for j:=length(m) downto 1 do 
    k:=k+d[(strtoint(m[Length(m)-j+1])+1)*2-1]+ 
      d[(strtoint(m[Length(m)-j+1])+1)*2]+d[(10+j)*2-1]+d[(10+j)*2]; 
  result:=k;
end;
{
调用：
procedure TForm1.Button1Click(Sender: TObject); 
var
  Sum:real;
begin
  sum:=12.34;
  showmessage('人民币大写:'+RMB(Sum));
}

//从字符串中删除指定字符串
Function RemoveInvalid(what, where: string): string;

  var
  tstr: string;

begin
  tstr:=where;
  while pos(what, tstr)>0 do
    tstr:=copy(tstr,1,pos(what,tstr)-1) +
       copy(tstr,pos(what,tstr)+length(what),length(tstr));
  Result:=tstr;
end;

// 获取字串的拼音串
Function GetPY(HZString: string): string;
 var I,L:integer;
begin
 HZString:=RemoveInvalid(' ',HZString); //删除空格
 L:=length(HZString)-length(widestring(HZString));  //汉字个数
 For I:=1 to L do
  result:=result+ GetPYChar(copy(HZString,2*i-1,2));

end;

//单汉字首拼音字母
Function GetPYChar(hzchar: string): char;
begin
    case Word(hzchar[1]) shl 8 + Word(hzchar[2]) of
      $B0A1..$B0C4: result := 'A';
      $B0C5..$B2C0: result := 'B';
      $B2C1..$B4ED: result := 'C';
      $B4EE..$B6E9: result := 'D';
      $B6EA..$B7A1: result := 'E';
      $B7A2..$B8C0: result := 'F';
      $B8C1..$B9FD: result := 'G';
      $B9FE..$BBF6: result := 'H';
      $BBF7..$BFA5: result := 'J';
      $BFA6..$C0AB: result := 'K';
      $C0AC..$C2E7: result := 'L';
      $C2E8..$C4C2: result := 'M';
      $C4C3..$C5B5: result := 'N';
      $C5B6..$C5BD: result := 'O';
      $C5BE..$C6D9: result := 'P';
      $C6DA..$C8BA: result := 'Q';
      $C8BB..$C8F5: result := 'R';
      $C8F6..$CBF9: result := 'S';
      $CBFA..$CDD9: result := 'T';
      $CDDA..$CEF3: result := 'W';
      $CEF4..$D188: result := 'X';
      $D1B9..$D4D0: result := 'Y';
      $D4D1..$D7F9: result := 'Z';
    else
      result := char(0);
    end;
end;

//将dataset导出EXCEL的function
procedure WriteToExcel(AdsData: TADODataSet; sName, Title: string);
var
  ExcelApplication1: TExcelApplication;
  ExcelWorksheet1: TExcelWorksheet;
  ExcelWorkbook1: TExcelWorkbook;
  i, j: integer;
  filename: string;
begin
  filename := concat(extractfilepath(application.exename), sName, '.xls');
  try
    ExcelApplication1 := TExcelApplication.Create(Application);
    ExcelWorksheet1 := TExcelWorksheet.Create(Application);
    ExcelWorkbook1 := TExcelWorkbook.Create(Application);
    ExcelApplication1.Connect;
  except
    Application.Messagebox('Excel 没有安装!','Hello', MB_ICONERROR + mb_Ok);
    Abort;
  end;
  try
    ExcelApplication1.Workbooks.Add(EmptyParam, 0);
    ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks[1]);
    ExcelWorksheet1.ConnectTo(ExcelWorkbook1.Worksheets[1] as _worksheet);
    AdsData.First;
    for j := 0 to AdsData.Fields.Count - 1 do
      begin
        ExcelWorksheet1.Cells.item[3, j + 1] := AdsData.Fields[j].DisplayLabel;
        ExcelWorksheet1.Cells.item[3, j + 1].font.size :='10';
      end;
    for i := 4 to AdsData.RecordCount + 3 do
      begin
        for j := 0 to AdsData.Fields.Count - 1 do
          begin
            ExcelWorksheet1.Cells.item[i, j + 1] :=
                AdsData.Fields[j].Asstring;
            ExcelWorksheet1.Cells.item[i, j + 1].font.size :='10';
          end;
        AdsData.Next;
      end;
    ExcelWorksheet1.Columns.AutoFit;
    ExcelWorksheet1.Cells.item[1, 2] := Title;
    ExcelWorksheet1.Cells.Item[1, 2].font.size :='14';
    ExcelWorksheet1.SaveAs(filename);
    Application.Messagebox(pchar('数据成功导出' + filename), 'Hello',
      mb_Ok);
  finally
    ExcelApplication1.Disconnect;
    ExcelApplication1.Quit;
    ExcelApplication1.Free;
    ExcelWorksheet1.Free;
    ExcelWorkbook1.Free;
  end;
end; 








end.