转贴：拼音简写、金额转换为大写、bmp图片转换成jpg图片、删除文件和目录
作者：bgtlv
关键字：
时间：2005-7-8 9:00:03
KeyLife富翁笔记
作者: japhe
标题: 得到拼音简写
关键字: 拼音 简写
分类: 开发技巧
密级: 公开
(评分: , 回复: 0, 阅读: 6) »»
//得到拼音简写
function GetHzPy(const AHzStr: string): string; stdcall;
const
ChinaCode: array[0..25, 0..1] of Integer = ((1601, 1636), (1637, 1832), (1833, 2077),
(2078, 2273), (2274, 2301), (2302, 2432), (2433, 2593), (2594, 2786), (9999, 0000),
(2787, 3105), (3106, 3211), (3212, 3471), (3472, 3634), (3635, 3722), (3723, 3729),
(3730, 3857), (3858, 4026), (4027, 4085), (4086, 4389), (4390, 4557), (9999, 0000),
(9999, 0000), (4558, 4683), (4684, 4924), (4925, 5248), (5249, 5589));
var
i, j, HzOrd: integer;
begin
i := 1;
while i <= Length(AHzStr) do
begin
if (AHzStr[i] >= #160) and (AHzStr[i + 1] >= #160) then
begin
HzOrd := (Ord(AHzStr[i]) - 160) * 100 + Ord(AHzStr[i + 1]) - 160;
for j := 0 to 25 do
begin
if (HzOrd >= ChinaCode[j][0]) and (HzOrd <= ChinaCode[j][1]) then
begin
Result := Result + char(byte('A') + j);
break;
end;
end;
Inc(i);
end else Result := Result + AHzStr[i];
Inc(i);
end;
end;
//本函数用于将小于十万亿元的小写金额转换为大写
Function gfun_NtoC( n0 :real) :String; stdcall;
Function IIF( b :boolean; s1,s2 :string) :string;
begin if b then IIF:= s1 else IIF:=s2;
end; //本函数的功能一目了然: 当b为真时返回s1,否则返回s2
Const c= '零壹贰叁肆伍陆柒捌玖◇分角元拾佰仟万拾佰仟亿拾佰仟万';
var L,i,n, code :integer; Z :boolean; s,s1,s2 :string;
begin
try
s:= FormatFloat( '0.00', n0);
L:= Length( s);
Z:= n0<1;
For i:= 1 To L-3 do
begin
Val( Copy( s, L-i-2, 1), n, code);
s1:=IIf( (n=0) And (Z Or (i=9) Or (i=5) Or (i=1)), '', Copy( c, n*2+1, 2))
+ IIf( (n=0) And ((i<>9) And (i<>5) And (i<>1) Or Z And (i=1)), '', Copy( c, (i+13)*2-1, 2))
+ s1;
Z:= (n=0);
end;
Z:= False;
For i:= 1 To 2 do
begin
Val( Copy( s, L-i+1, 1), n, code);
s2:= IIf( (n=0) And ((i=1) Or (i=2) And (Z Or (n0<1))), '', Copy( c, n*2+1, 2))
+ IIf( (n>0), Copy( c,(i+11)*2-1, 2), IIf( (i=2) Or Z, '', '整'))
+ s2;
Z:= (n=0);
end;
For i:= 1 To Length( s1) do If Copy(s1, i, 4) = '亿万' Then Delete(s1,i+2,2);
gfun_NtoC:= IIf(n0=0, '零', s1+s2);
except
end;
End;
//写入日志
procedure WriteToLog(AText: String; AFileName: String); stdcall;
begin
with TStringList.Create do
try
if FileExists(AFileName) then
LoadFromFile(AFileName);
Add(FormatDateTime('YYYY_MM_DD hh:mm:ss ', Now) + AText);
SaveToFile(AFileName);
finally
free;
end;
end;
//bmp图片转换成jpg图片
function fun_BmpToJpg(temp, path: String; ACQ: Integer): Boolean; stdcall;
var
MyJpeg: TJpegImage;
Bmp: TBitmap;
begin
result := false;
if FileExists(temp) then
begin
Bmp:= TBitmap.Create;
MyJpeg:= TJpegImage.Create;
Bmp.LoadFromFile(temp);
MyJpeg.Assign(Bmp);
MyJpeg.CompressionQuality := ACQ;
MyJpeg.Compress;
MyJpeg.SaveToFile(Path);
MyJpeg.free;
Bmp.free;
if FileExists(path) then
result := True;
end;
end;
//删除文件和目录
function Delpath(AFilePath: String): Boolean; stdcall;
var
i: integer;
fpath: String;
PathList: TStringList;
procedure DelFile(AFilePath: String);
var
fpath: String;
srec: TSearchRec;
begin
if Not DirectoryExists(AFilePath) then
Exit;
PathList.Add(AFilePath);
fpath := AFilePath + '\*.*';
if 0 = FindFirst(fpath, faAnyFile, srec) then
begin
if (srec.Name<>'.')and(srec.Name<>'..') then
begin
if (srec.Attr and faDirectory)=faDirectory then
begin
DelFile(AFilePath + '\' + srec.Name);
end
else
DeleteFile(AFilePath + '\' + srec.Name);
end;
while FindNext(srec)=0 do
begin
if (srec.Name<>'.')and(srec.Name<>'..') then
if (srec.Attr and faDirectory)=faDirectory then
DelFile(AFilePath + '\' + srec.Name)
else
DeleteFile(AFilePath + '\' + srec.Name);
end;
end;
FindClose(srec);
end;
begin
Result := False;
if Not DirectoryExists(AFilePath) then
begin
Result := True;
Exit;
end;
PathList := TStringList.Create;
fpath := AFilePath;
if fpath[length(fpath)] = '\' then
fpath := Copy(fpath, 1, length(fpath)-1);
DelFile(fpath);
if PathList.Count > 0 then
for i:=PathList.Count-1 downto 0 do
RmDir(pathlist.Strings[i]);
if Not DirectoryExists(AFilePath) then
Result := True;
end;
|
