拼音简写、金额转换为大写、bmp图片转换成jpg图片、删除文件和目录(收藏)

  • A+
所属分类:[开发技巧]

//得到拼音简写
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;

  • 我的微信
  • 这是我的微信扫一扫
  • weinxin
  • 我的微信公众号
  • 我的微信公众号扫一扫
  • weinxin
广告也精彩
avatar
广告也精彩

发表评论

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen: