Codeunit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, OleServer, ExcelXP, comobj, Spin;
type
TForm1 = class(TForm)
OpenDialog1: TOpenDialog;
Edit1: TEdit;
Label1: TLabel;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
SpinEdit1: TSpinEdit;
SpinEdit2: TSpinEdit;
SpinEdit3: TSpinEdit;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
myexcel,myworkbook,mysheet:variant;
glb,t1 :integer;
implementation
{$R *.dfm}
//------------------------
//将阿拉伯数字转成英文字串
//------------------------
function num2ceng(strArabic:string):string;//不带小数点英文转换中文
const
sw:array[2..9]of string=('twenty','thirty','forty','fifty','sixty','seventy','eighty','ninety');
gw:array[1..19] of string=('one','two','three','four','five','six','seven','eight','nine','ten','eleven','twelve','thirteen','fourteen','fifteen','sixteen','seventeen','eighteen','nineteen');
exp:array[1..4] of string=('','thousand','million','billion');
var
t,j:integer;
ts:string;
function readu1000(ss:string):string;
var
t,code:integer;
begin
result := '';
while ss[1]='0' do
begin
delete(ss,1,1);
if length(ss)=0 then exit;//控制全是0情况
end;
if length(ss)=3 then
begin
appendstr(result,gw[ord(ss[1])-ord('0')]);
appendstr(result,' hundred ');
delete(ss,1,1);
end;
while ss[1]='0' do
begin
delete(ss,1,1);
if length(ss)=0 then exit;
end;
if length(ss)<>0 then
if result <> '' then appendstr(result,'and ');
if (glb = 1) and (t1<>1) then //超过百位时候处理最后3位
if result='' then appendstr(result,'and ');
begin
val(ss,t,code);
if t<20 then result :=result+gw[t]
else if t mod 10=0 then result:=result+sw[t div 10]
else result := result+sw[trunc(t/10)]+'-'+gw[t mod 10];
end;
end;
begin
result :='Say ';
t := pos('.',strArabic);
if t=0 then t:=length(strArabic)+1;
while (t mod 3<>1)do
begin
t:=t+1;
strArabic:='0'+ strArabic;
end;
t1:=(t-1) div 3;
for glb:=t1 downto 1 do
begin
ts:='';
for j:=1 to 3 do
begin
ts:=ts+ strArabic[1];
delete(strArabic,1,1);
end;
result := result + readu1000(ts);
if ts<>'000' then result := result+' '+exp[glb]+' ';
end;
if length(strArabic)<>0 then
begin
delete(strArabic,1,1);
appendstr(result,'and ');
result :=result + readu1000(strArabic);
end;
end;
function num2cengnum(strArabic:string):string;
const
gw:array[1..10] of string =('0','one','two','three','four','five','six','seven','eight','nine');
var
p,i,j,x:integer;
s:string;
begin
result := '';
s := strarabic;
p := pos('.',strarabic);
if p = 0 then
begin
result := num2ceng(strarabic)+'Only';
exit;
end
else
begin
i := length(s)-p;//计算小数点后面有几位
delete(strarabic,p,i+1);//删除小数点后面数字
result := num2ceng(strarabic)+'Point';
end;
for x:=1 to i do //转换小数点后面数字
begin
j:= strtoint(copy(s,p+x,1));
case j of
0: result := result +' '+gw[1];
1: result := result +' '+gw[2];
2: result := result +' '+gw[3];
3: result := result +' '+gw[4];
4: result := result +' '+gw[5];
5: result := result +' '+gw[6];
6: result := result +' '+gw[7];
7: result := result +' '+gw[8];
8: result := result +' '+gw[9];
9: result := result +' '+gw[10];
end;
end;
end;
//-----------------------------------------
// Num2CNum 将阿拉伯数字转成中文数字字串
//------------------------------------------
function Num2CNum(dblArabic: double): string;
const
_ChineseNumeric = '零壹贰叁肆伍陆柒捌玖';
var
sArabic: string;
sIntArabic: string;
iPosOfDecimalPoint: integer;
i: integer;
iDigit: integer;
iSection: integer;
sSectionArabic: string;
sSection: string;
bInZero: boolean;
bMinus: boolean;
(* 将字串反向, 例如: 传入 '1234', 传回 '4321' *)
function ConvertStr(const sBeConvert: string): string;
var
x: integer;
begin
Result := '';
for x := Length(sBeConvert) downto 1 do
AppendStr(Result, sBeConvert[x]);
end; { of ConvertStr }
begin
Result := '';
bInZero := True;
sArabic := FloatToStr(dblArabic); (* 将数字转成阿拉伯数字字串 *)
{$IFDEF __Debug}
ShowMessage('FloatToStr(dblArabic): ' + sArabic);
{$ENDIF}
if sArabic[1] = '-' then
begin
bMinus := True;
sArabic := Copy(sArabic, 2, 254);
end
else
bMinus := False;
iPosOfDecimalPoint := Pos('.', sArabic); (* 取得小数点的位置 *)
{$IFDEF __Debug}
ShowMessage('Pos(''.'', sArabic) ' + IntToStr(iPosOfDecimalPoint));
{$ENDIF}
(* 先处理整数的部分 *)
if iPosOfDecimalPoint = 0 then
sIntArabic := ConvertStr(sArabic)
else
sIntArabic := ConvertStr(Copy(sArabic, 1, iPosOfDecimalPoint - 1));
(* 从个位数起以每四位数为一小节 *)
for iSection := 0 to ((Length(sIntArabic) - 1) div 4) do
begin
sSectionArabic := Copy(sIntArabic, iSection * 4 + 1, 4);
sSection := '';
(* 以下的 i 控制: 个十百千位四个位数 *)
for i := 1 to Length(sSectionArabic) do
begin
iDigit := Ord(sSectionArabic[i]) - 48;
if iDigit = 0 then
begin
(* 1. 避免 '零' 的重覆出现 *)
(* 2. 个位数的 0 不必转成 '零' *)
if (not bInZero) and (i <> 1) then sSection := '零' + sSection;
bInZero := True;
end
else
begin
case i of
2: sSection := '拾' + sSection;
3: sSection := '佰' + sSection;
4: sSection := '仟' + sSection;
end;
sSection := Copy(_ChineseNumeric, 2 * iDigit + 1, 2) +
sSection;
bInZero := False;
end;
end;
(* 加上该小节的位数 *)
if Length(sSection) = 0 then
begin
if (Length(Result) > 0) and (Copy(Result, 1, 2) <> '零') then
Result := '零' + Result;
end
else
begin
case iSection of
0: Result := sSection;
1: Result := sSection + '万' + Result;
2: Result := sSection + '亿' + Result;
3: Result := sSection + '兆' + Result;
end;
end;
{$IFDEF __Debug}
ShowMessage('sSection: ' + sSection);
ShowMessage('Result: ' + Result);
{$ENDIF}
end;
(* 处理小数点右边的部分 *)
if iPosOfDecimalPoint > 0 then
begin
AppendStr(Result, '元');
{for i := iPosOfDecimalPoint + 1 to Length(sArabic) do
begin
iDigit := Ord(sArabic[i]) - 48;
AppendStr(Result, Copy(_ChineseNumeric, 2 * iDigit + 1, 2));
end;---没有限制小数点后面位置}
i := iPosOfDecimalPoint + 1;
iDigit := Ord(sArabic[i]) - 48;
if Copy(_ChineseNumeric, 2 * iDigit + 1, 2) <> '零' then
begin
AppendStr(Result, Copy(_ChineseNumeric, 2 * iDigit + 1, 2));
Result := Result+'角';
end
else
begin
AppendStr(Result, Copy(_ChineseNumeric, 2 * iDigit + 1, 2));
end;
i := i+1;
iDigit := Ord(sArabic[i]) - 48;
AppendStr(Result, Copy(_ChineseNumeric, 2 * iDigit + 1, 2));
Result := Result+'分'
end;
{$IFDEF __Debug}
ShowMessage('Result before 其他例外处理: ' + Result);
{$ENDIF}
(* 其他例外状况的处理 *)
if Length(Result) = 0 then Result := '零';
if Copy(Result, 1, 4) = '一十' then Result := Copy(Result, 3, 254);
if Copy(Result, 1, 2) = '点' then Result := '零' + Result;
if iposofdecimalpoint = 0 then result := result + '元整';
(* 是否为负数 *)
if bMinus then Result := '负' + Result;
{$IFDEF __Debug}
ShowMessage('Result before Exit: ' + Result);
{$ENDIF}
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
opendialog1.Execute;
edit1.Text := opendialog1.FileName;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
introw,intnum,i,col1,col2,col3:integer;
filename :string;
begin
try
if application.MessageBox('你确定要转换么？','信息提示：',mb_yesno+mb_defbutton1+mb_iconinformation)= idyes then
begin
if fileexists(edit1.Text) = false then
begin
showmessage('文件不存在，请重新选择文件');
exit;
end;
myexcel:= CreateOleObject('Excel.Application');
myworkbook := myexcel.workbooks.open(edit1.text);
myexcel.Visible := false;
mysheet := myexcel.worksheets[1];
introw := mysheet.UsedRange.Rows.Count;//计算多少行
col1 := spinedit1.Value;
col2 := spinedit2.Value;
col3 := spinedit3.Value;
for i:=1 to introw do
begin
myexcel.cells[i,col2].value := Num2CNum(strtofloat(myexcel.cells[i,col1].value));
myexcel.cells[i,col3].value := num2cengnum(myexcel.cells[i,col1].value);
end;
intnum :=length(extractfilename(edit1.Text))-4;
filename :=extractfilepath(edit1.Text)+copy(extractfilename(edit1.text),1,intnum)+'1'+extractfileext(edit1.Text);
if fileexists(filename) then
showmessage('已经存在转换完成文件,不能重复转换!')
else
begin
mysheet.saveas(filename);
showmessage('恭喜,转换完成为'+filename);
end;
myexcel.quit;
end;
except
showmessage('意外错误，查看是否选择正确文件和是否安装Excel');
//myexcel.quit;
myexcel := unassigned;
exit;
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
opendialog1.Execute;
myexcel := createoleobject('excel.application');
myexcel.visible := true;
myexcel.workbooks.open(opendialog1.FileName);
end;
end.