个人收集及编写的一个通用函数集.pas

个人收集及编写的一个通用函数集

        S := '';
        B := mDisplay[I] = '''';
      end;
      '$', '0'..'9', 'a'..'f', 'A'..'F': S := S + mDisplay[I];
    end;
  if (not B) and (S <> '') then Result := Result + Chr(StrToIntDef(S, 0));
end; { DisplayToString }

function GetFileVersionInfomation(mFileName: TFileName;
  var nFileVersionInfomation: TFileVersionInfomation;
  mDefineName: string = ''): Boolean;
var
  vHandle: Cardinal;
  vInfoSize: Cardinal;
  vVersionInfo: Pointer;
  vTranslation: Pointer;
  vVersionValue: string;
  vInfoPointer: Pointer;
begin
  Result := False;
  vInfoSize := GetFileVersionInfoSize(PChar(mFileName), vHandle); //取得文件版本信息空间及资源句柄
  FillChar(nFileVersionInfomation, SizeOf(nFileVersionInfomation), 0); //初始化返回信息
  if vInfoSize <= 0 then Exit; //安全检查

  GetMem(vVersionInfo, vInfoSize); //分配资源
  with nFileVersionInfomation do try
    if not GetFileVersionInfo(PChar(mFileName),
      vHandle, vInfoSize, vVersionInfo) then Exit;
    VerQueryValue(vVersionInfo, '\VarFileInfo\Translation',
      vTranslation, vInfoSize);
    vVersionValue := Format('\StringFileInfo\%.4x%.4x\',
      [LOWORD(Longint(vTranslation^)), HIWORD(Longint(vTranslation^))]);
    VerQueryValue(vVersionInfo, PChar(vVersionValue + 'CompanyName'),
      vInfoPointer, vInfoSize);
    rCommpanyName := PChar(vInfoPointer);
    VerQueryValue(vVersionInfo, PChar(vVersionValue + 'FileDescription'),
      vInfoPointer, vInfoSize);
    rFileDescription := PChar(vInfoPointer);
    VerQueryValue(vVersionInfo, PChar(vVersionValue + 'FileVersion'),
      vInfoPointer, vInfoSize);
    rFileVersion := PChar(vInfoPointer);
    VerQueryValue(vVersionInfo, PChar(vVersionValue + 'InternalName'),
      vInfoPointer, vInfoSize);
    rInternalName := PChar(vInfoPointer);
    VerQueryValue(vVersionInfo, PChar(vVersionValue + 'LegalCopyright'),
      vInfoPointer, vInfoSize);
    rLegalCopyright := PChar(vInfoPointer);
    VerQueryValue(vVersionInfo, PChar(vVersionValue + 'LegalTrademarks'),
      vInfoPointer, vInfoSize);
    rLegalTrademarks := PChar(vInfoPointer);
    VerQueryValue(vVersionInfo, PChar(vVersionValue + 'OriginalFileName'),
      vInfoPointer, vInfoSize);
    rOriginalFileName := PChar(vInfoPointer);
    VerQueryValue(vVersionInfo, PChar(vVersionValue + 'ProductName'),
      vInfoPointer, vInfoSize);
    rProductName := PChar(vInfoPointer);
    VerQueryValue(vVersionInfo, PChar(vVersionValue + 'ProductVersion'),
      vInfoPointer, vInfoSize);
    rProductVersion := PChar(vInfoPointer);
    VerQueryValue(vVersionInfo, PChar(vVersionValue + 'Comments'),
      vInfoPointer, vInfoSize);
    rComments := PChar(vInfoPointer);
    VerQueryValue(vVersionInfo, '\', vInfoPointer, vInfoSize);
    rVsFixedFileInfo := TVSFixedFileInfo(vInfoPointer^);
    if mDefineName <> '' then begin
      VerQueryValue(vVersionInfo, PChar(vVersionValue + mDefineName),
        vInfoPointer, vInfoSize);
      rDefineValue := PChar(vInfoPointer);
    end else rDefineValue := '';
  finally
    FreeMem(vVersionInfo, vInfoSize);
  end;
  Result := True;
end; { GetFileVersionInfomation }
//=======Begin 位图翻转函数
function Turnbmp(mSource: TBitmap; Rotate: integer): Boolean;
begin
  Result := false;
  case Rotate of
    1: if BitmapRotate90(mSource) then Result := true;
//    2: if BitmapRotate180(mSource) then Result := true;
    3: if BitmapRotate270(mSource) then Result := true;
  end;
end;

function Turnbmp1(mSource: TBitmap; Rotate: integer): Boolean;
begin
  Result := false;
  case Rotate of
    1: if BitmapRotate90(mSource) then Result := true;
    2: if BitmapRotate180(mSource) then Result := true;
    3: if BitmapRotate270(mSource) then Result := true;
  end;
end;

function BitmapRotate90(mSource: TBitmap): Boolean;
var
  I, J,  BITS, SIZE: Integer;
  A: PByteArray;
  ms :TMemoryStream;
begin
  Result := False;
  if not Assigned(mSource) then Exit;
  case mSource.PixelFormat of
    pf8bit : BITS := 1;
    pf16bit: BITS := 2;
    pf24bit: BITS := 3;
    pf32bit: BITS := 4;
    else Exit;
  end;
  SIZE := mSource.Width;
  ms := TMemoryStream.Create;
  try
    for I := 0 to mSource.Height - 1 do
    begin
       A  := mSource.ScanLine[I];
       ms.WriteBuffer(A^,SIZE * BITS);
    end;
    ms.Position := 0;
    mSource.Width := mSource.Height;
    mSource.Height := SIZE;
    for J := (mSource.Width - 1) downto 0 do
    for I := 0 to mSource.Height - 1 do
    begin
      A := mSource.ScanLine[I];
      ms.ReadBuffer(A[J * BITS], BITS);
    end;
  finally
    ms.Free;
  end;
  Result := True;
end; { BitmapRotate90 }

function BitmapRotate180(mSource: TBitmap): Boolean;
var
  I, J, BITS, SIZE: Integer;
  A: PByteArray;
  ms :TMemoryStream;
begin
  Result := False;
  if not Assigned(mSource)  then Exit;
  case mSource.PixelFormat of
    pf8bit : BITS := 1;
    pf16bit: BITS := 2;
    pf24bit: BITS := 3;
    pf32bit: BITS := 4;
    else Exit;
  end;
  SIZE := mSource.Width;
  ms := TMemoryStream.Create;
  try
    for I := 0 to mSource.Height - 1 do
    begin
       A  := mSource.ScanLine[I];
       ms.WriteBuffer(A^,SIZE * BITS);
    end;
    ms.Position := 0;
    for I := (mSource.Height - 1) downto 0 do
    begin
       A := mSource.ScanLine[I];
       for J := (mSource.Width - 1) downto 0 do
         ms.ReadBuffer(A[J * BITS], BITS);
    end;
  finally
    ms.free;
  end;
  Result := True;
end; { BitmapRotate180 }

function BitmapRotate270(mSource: TBitmap): Boolean;
var
  I, J, BITS, SIZE: Integer;
  A: PByteArray;
  ms :TMemoryStream;
begin
  Result := False;
  if not Assigned(mSource) then Exit;
  case mSource.PixelFormat of
    pf8bit : BITS := 1;
    pf16bit: BITS := 2;
    pf24bit: BITS := 3;
    pf32bit: BITS := 4;
    else Exit;
  end;
  SIZE := mSource.Width;
  ms := TMemoryStream.Create;
  try
    for I := 0 to mSource.Height - 1 do
    begin
       A  := mSource.ScanLine[I];
       ms.WriteBuffer(A^,SIZE * BITS);
    end;
    ms.Position := 0;
    mSource.Width := mSource.Height;
    mSource.Height := SIZE;
    for J := 0 to mSource.Width - 1 do
    for I := (mSource.Height - 1) downto 0 do
    begin
      A := mSource.ScanLine[I];
      ms.ReadBuffer(A[J * BITS], BITS);
    end;
  finally
    ms.Free;
  end;
  Result := True;
end; { BitmapRotate270 }
//=======End 位图翻转函数
function StrBinToStr(strbin: string): string; //二进制转为字串
var
  c: byte;
  i,bindex: integer;
  str : string;
begin
  str := '';
  c := $0;
  i := Length(strbin) mod 8;
  if i <> 0 then
  for bindex := 1 to 8-i do strbin := strbin + '0';
  bindex := 1;
  for i := 1 to Length(strbin) do
  begin
    if bindex > 8 then begin
      str := str + Char(c);
      c := $0;
      bindex := 1;
    end;
    c := byte(c shl 1);
    if strbin[i] = '1' then c:= c or $1;
    Inc(bindex);
  end;
  if bindex <> 1 then str := str + Char(c);
  Result := str;
end;
function StrToStrBin(str: string): string; //字串转为二进制
var
  i, j: integer;
  binstr: string;
  c : Byte;
begin
  binstr := '';
  for i := 1 to Length(str) do
  begin
    c:= Byte(str[i]);
    for j := 1 to 8 do begin
      if (c and $80) <> $00 then
        binstr:= binstr + '1'
      else
        binstr := binstr + '0';
      c := Byte(c shl 1);
    end
  end;
  Result := binstr;
end;

procedure RGBtoHSL(R,G,B:Integer;var H,S,L:Integer);
var
 Delta : Double;
 CMax,CMin : Double;
 Red,Green,Blue,Hue,Sat,Lum : Double;
begin
 Red := R/255;
 Green := G/255;
 Blue := B/255;
 CMax := Max(Red,Max(Green,Blue));
 CMin := Min(Red,Min(Green,Blue));
 Lum := (CMax+CMin)/2;
 if CMax = CMin then begin
   Sat := 0;
   Hue := 0;
 end
 else begin
   if Lum < 0.5 then Sat := (CMax-CMin)/(CMax+CMin)
   else Sat := (cmax-cmin)/(2-cmax-cmin);
   delta := CMax-CMin;
   If Red = CMax then Hue := (Green-Blue)/Delta
   else if Green = CMax then Hue := 2+(Blue-Red)/Delta
   else Hue := 4.0+(Red-Green)/Delta;
   Hue := Hue / 6;
   If Hue < 0 then Hue := Hue + 1;
 end;
 H := Round(Hue*360);
 S := Round(Sat*100);
 L := Round(Lum*100);
end;

procedure HSLtoRGB(H,S,L:Integer;var R,G,B:Integer);
var
 Sat,Lum : Double;
begin
 R := 0;
 G := 0;
 B := 0;
 if (H < 360) and (H >= 0) and (S <= 100) and (S >= 0) and (L <= 100) and (L >= 0) then begin
   if H <=60 then begin
     R := 255;
     G := Round((255/60)*H);
     B := 0;
   end
   else if H <=120 then begin
     R := Round(255-(255/60)*(H-60));
     G := 255;
     B := 0;
   end
   else if H <=180 then begin
     R := 0;
     G := 255;
     B := Round((255/60)*(H-120));
   end
   else if H <=240 then begin
     R := 0;
     G := Round(255-(255/60)*(H-180));
     B := 255;
   end
   else if H <=300 then begin
     R := Round((255/60)*(H-240));
     G := 0;
     B := 255;
   end
   else if H <360 then begin
     R := 255;
     G := 0;
     B := Round(255-(255/60)*(H-300));
   end;

   Sat := Abs((S-100)/100);
   R := Round(R-((R-128)*Sat));
   G := Round(G-((G-128)*Sat));
   B := Round(B-((B-128)*Sat));

   Lum := (L-50)/50;
   if Lum > 0 then begin
     R := Round(R+((255-R)*Lum));
     G := Round(G+((255-G)*Lum));
     B := Round(B+((255-B)*Lum));
   end
   else if Lum < 0 then begin
     R := Round(R+(R*Lum));
     G := Round(G+(G*Lum));
     B := Round(B+(B*Lum));
   end;
 end;
end;


function GetSubStr(Str : string; index : integer):string;
var
  substr : string;
  i,j: integer;
begin
   if index <0 then begin
    Result := '';
    exit;
   end;
   i := 0;
   substr := str;
   while i<=index do
   begin
      j := Pos(',',substr);
      if j = 0 then begin
        if i <>index then substr := '';
        break
      end else begin
         if i = index then substr := copy(substr,1,j-1)
         else delete(substr,1,j); //删除
         Inc(i);
      end;
   end;
   Result := substr;
end;


function mMove(i : integer):string;
begin
   SetLength(Result,sizeof(i));
   Move(i, Result[1], sizeof(i));
end;

function mMove(i : int64):string;
begin
   SetLength(Result,sizeof(i));
   Move(i, Result[1], sizeof(i));
end;

function mMove(i : boolean):string;
begin
   SetLength(Result,sizeof(i));
   Move(i, Result[1], sizeof(i));
end;
function mMove(i : Word):string;
begin
   SetLength(Result,sizeof(i));
   Move(i, Result[1], sizeof(i));
end;

function mMove(i : Byte):string;
begin
   SetLength(Result,sizeof(i));
   Move(i, Result[1], sizeof(i));
end;

function mMove(p : Pchar; Size: integer): string;
begin
   SetLength(Result,size);
   Move(p[0], Result[1], size);
end;
procedure mMove(var i : integer;var Source: string);
begin
  Move(Source[1],i,sizeof(i));
  delete(Source,1,sizeof(i));
end;

procedure mMove(var i : int64; var Source: string);
begin
  Move(Source[1],i,sizeof(i));
  delete(Source,1,sizeof(i));
end;

procedure mMove(var i : boolean; var Source: string);
begin
  Move(Source[1],i,sizeof(i));
  delete(Source,1,sizeof(i));
end;

procedure mMove(var i : Word; var Source: string);
begin
  Move(Source[1],i,sizeof(i));
  delete(Source,1,sizeof(i));
end;

procedure mMove(var i : Byte; var Source: string);
begin
  Move(Source[1],i,sizeof(i));
  delete(Source,1,sizeof(i));
end;

procedure StrToIntStr(var Data: string); //字串转整数