Delphi 几个较实用的自定义函数

前言

之前用Delphi 开发的时候收集了一些常见的自定义函数，在D7下是可以正常用的，高版本需要对sting转一下。

一、获取汉字首字母

//-----------------------------取汉字首字母----------------------------------------------
function StrGetHypy(AHzStr: string):string;
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
  Result:='';
  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 TForm1.NumToChnStr(Value: Real; ClearZero: Boolean): String;
const
  ChnUnit: array[0..13] of string = ('分', '角', '元', '拾', '佰', '仟', '万', '拾', '佰', '仟', '亿', '拾', '佰', '仟');
  ChnNum : array[0..9]  of string = ('零', '壹','贰', '叁', '肆', '伍', '陆', '柒', '捌', '玖');
var
  I: Integer;
  StrValue, StrNum: String;
  ValueLen: Integer;
begin
  if Value 《= 0 then
  begin
    Result := '输入参数应大于零。';
    Exit;
  end;
  StrValue := IntToStr(Round(Value * 100));
  ValueLen := Length(StrValue);
  Result := '';
  for I := 1 to ValueLen do
  begin
    StrNum := StrValue[I];
    Result := Result + ChnNum[StrToInt(StrNum)] + ChnUnit[ValueLen - I];
  end;
  if ClearZero then
  begin
    Result := StringReplace(Result, '零分', '',   [rfReplaceAll]);
    Result := StringReplace(Result, '零角', '',   [rfReplaceAll]);
    Result := StringReplace(Result, '零元', '元', [rfReplaceAll]);
    Result := StringReplace(Result, '零拾', '',   [rfReplaceAll]);
    Result := StringReplace(Result, '零佰', '',   [rfReplaceAll]);
    Result := StringReplace(Result, '零仟', '',   [rfReplaceAll]);
    Result := StringReplace(Result, '零万', '万', [rfReplaceAll]);
  end;
end;

三、加密与解密

const   

  XorKey: array[0..7] of Byte = ($B2, $09, $BB, $55, $93, $6D, $44, $47); //字符串加密用    

function Enc(Str: string): string; //字符加密函數  這是用的一個異或加密    

 var

   i, j: Integer;

 begin

    Result := '';

    j := 0;

    for i := 1 to Length(Str) do

    begin

       Result := Result + IntToHex(Byte(Str[i]) xor XorKey[j], 2);

      j := (j + 1) mod 8;

    end;

 end;

 function Dec(Str: string): string; //字符解密函數

 var

   i, j: Integer;

 begin

    Result := '';

   j := 0;

    for i := 1 to Length(Str) div 2 do

   begin

      Result := Result + Char(StrToInt('$' + Copy(Str, i * 2 - 1, 2)) xor XorKey[j]);

       j := (j + 1) mod 8;

    end;
 end;

四、几种打开网址的方式

Delphi打开网址链接的四种方法
用默认浏览器打开,uses shellapi} 
procedure TForm1.Button2Click(Sender: TObject);
begin
ShellExecute(Application.Handle, nil, 'http://www.3464.com', nil, nil, SW_SHOWNORMAL);
end;

{以下三种用IE浏览器打开}

{uses shellapi}

procedure TForm1.Button1Click(Sender: TObject);
begin
ShellExecute(Application.Handle, 'open','Iexplore.exe','http://www.3464.com',nil,SW_SHOWNORMAL);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
ShellExecute(Application.Handle, nil, 'http://www.3464.com', nil, nil, SW_SHOWNORMAL);
end;

//uses SHDocVw;

procedure TForm1.Button4Click(Sender: TObject);
var 
IE : OleVariant;
begin
IE := CoInternetExplorer.Create;
IE.Visible := True;
IE.Navigate2('http://www.3464.com');
end;
 
 

五、获取网络图片

delphi 获取网络图片
代码文件:
--------------------------------------------------------------------------------

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP,
StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
IdHTTP1: TIdHTTP;
procedure Button1Click(Sender: TObject);
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

uses jpeg;

procedure TForm1.Button1Click(Sender: TObject);
const
url = 'http://ptlogin2.qq.com/getimage?aid=15000701&0.9129723031485226';
var
ms: TMemoryStream;
jpg: TJPEGImage;
begin
ms := TMemoryStream.Create;
jpg := TJPEGImage.Create;

IdHTTP1.Get(url, ms);
ms.Position := 0;

jpg.LoadFromStream(ms);
Canvas.Draw(10, 10, jpg);

jpg.Free;
ms.Free;
end;

end.
 

六、检测文件大小

const
//先定义文件的大小
ThisFileSize = 12429824 ;

function CheckThisFileSizeok:boolean;
var vv:ofstruct;
i,len1:integer;
begin
Result :=false;
i:=openfile(pchar(Application.exename),vv,0);
len1:=GetFileSize(i,nil);
_lclose(i);
if len1=ThisFileSize then
Result :=true;
end;

七、字符串中第一个汉字的位置

function PositionFirstGB(str: string): Integer;
var
i: integer;
begin
Result := 0;

for i := 1 to Length(str) -1 do
begin
//第一个汉字的第一个字节判断它的内码是否大于128大于则是汉字，小于则是英文
if ord(str) > $7F then
begin
Result := i;
Break;
end;
end;
end;