hutil32.pas

MirGame完整组件 开发传奇不可缺少的组件之一

unit HUtil32;

//提供大量的辅助函数

interface

uses
   Classes, SysUtils, WinTypes, WinProcs, Graphics, Messages, Dialogs;

type
   Str4096 = array [0..4096] of char;
   Str256 = array [0..256] of char;
   //名称、值对照表
   TyNameTable = record
     Name: string;
     varl: Longint;
   end;

   TLRect = record
      Left, Top, Right, Bottom: Longint;
   end;

const
   MAXDEFCOLOR = 16;
   //颜色名称、值对照
   ColorNames: array [1..MAXDEFCOLOR] of TyNameTable = (
      (Name: 'BLACK'; 		varl: clBlack),
      (Name: 'BROWN';		varl: clMaroon),
      (Name: 'MARGENTA';	varl: clFuchsia),
      (Name: 'GREEN';		varl: clGreen),
      (Name: 'LTGREEN';		varl: clOlive),
      (Name: 'BLUE';		varl: clNavy),
      (Name: 'LTBLUE';		varl: clBlue),
      (Name: 'PURPLE';		varl: clPurple),
      (Name: 'CYAN';		varl: clTeal),
      (Name: 'LTCYAN';		varl: clAqua),
      (Name: 'GRAY';		varl: clGray),
      (Name: 'LTGRAY';		varl: clsilver),
      (Name: 'YELLOW';		varl: clYellow),
      (Name: 'LIME';		varl: clLime),
      (Name: 'WHITE';		varl: clWhite),
      (Name: 'RED';		varl: clRed)
   );

   //标记、值对照
   MAXLISTMARKER    = 3;
   LiMarkerNames: array [1..MAXLISTMARKER] of TyNameTable = (
      (Name: 'DISC';		varl: 0),
      (Name: 'CIRCLE';		varl: 1),
      (Name: 'SQUARE';		varl: 2)
   );

   //
   MAXPREDEFINE    = 3;
   PreDefineNames: array [1..MAXPREDEFINE] of TyNameTable = (
      (Name: 'LEFT';		varl: 0),
      (Name: 'RIGHT';		varl: 1),
      (Name: 'CENTER';		varl: 2)
   );


function  ArrestStringEx (Source, SearchAfter, ArrestBefore: string; var ArrestStr: string): string;
function  ExtractFileNameOnly (const fname: string): string;
function  FloatToStrFixFmt (fVal: Double; prec, digit: Integer): string;
function  FileSize (const FName: string): Longint;
function  FileCopy(source,dest: String): Boolean;
function  GetValidStr3 (Str: string; var Dest: string; const Divider: array of Char): string;
function  GetValidStrVal (Str: string; var Dest: string; const Divider: array of Char): string;
function  Str_ToInt (Str: string; def: Longint): Longint;
procedure SpliteBitmap (DC: HDC; X, Y: integer; bitmap: TBitmap; transcolor: TColor);
function _MIN (n1, n2: integer): integer;
function _MAX (n1, n2: integer): integer;

implementation

//返回文件名（不包括路径和扩展名）
function  ExtractFileNameOnly (const fname: string): string;
var
   extpos: integer;
   ext, fn: string;
begin
   ext := ExtractFileExt (fname);
   fn := ExtractFileName (fname);
   if ext <> '' then begin
      extpos := pos (ext, fn);
      Result := Copy (fn, 1, extpos-1);
   end else
      Result := fn;
end;

function ArrestStringEx (Source, SearchAfter, ArrestBefore: string; var ArrestStr: string): string;
var
   BufCount, SrcCount, SrcLen: integer;
   GoodData, Fin: Boolean;
   i, n: integer;
begin
   ArrestStr := ''; {result string}
   if Source = '' then begin
      Result := '';
      exit;
   end;

   try
      SrcLen := Length (Source);
      GoodData := FALSE;
      if SrcLen >= 2 then
         if Source[1] = SearchAfter then begin
            Source := Copy (Source, 2, SrcLen-1);
            SrcLen := Length (Source);
            GoodData := TRUE;
         end else begin
            n := Pos (SearchAfter, Source);
            if n > 0 then begin
               Source := Copy (Source, n+1, SrcLen-(n));
               SrcLen := Length(Source);
               GoodData := TRUE;
            end;
         end;
      Fin := FALSE;
      if GoodData then begin
         n := Pos (ArrestBefore, Source);
         if n > 0 then begin
            ArrestStr := Copy (Source, 1, n-1);
            Result := Copy (Source, n+1, SrcLen-n);
         end else begin
            Result := SearchAfter + Source;
         end;
      end else begin
         for i:=1 to SrcLen do begin
            if Source[i] = SearchAfter then begin
               Result := Copy (Source, i, SrcLen-i+1);
               break;
            end;
         end;
      end;
   except
      ArrestStr := '';
      Result := '';
   end;
end;

//
function FloatToStrFixFmt (fVal: Double; prec, digit: Integer): string;
var
   cnt, dest, Len, I, j: Integer;
   fstr: string;
   Buf: array[0..255] of char;
label end_conv;
begin
   cnt := 0;  dest := 0;
   fstr := FloatToStrF ( fVal, ffGeneral, 15, 3 );
   Len  := Length (fstr);
   for i:=1 to Len do begin
      if fstr[i]='.' then begin
         Buf[dest] := '.'; Inc(dest);
         cnt := 0;
         for j:=i+1 to Len do begin
            if cnt < digit then begin
               Buf[dest] := fstr[j]; Inc(dest);
            end
            else begin
               goto end_conv;
            end;
            Inc(cnt);
         end;
         goto end_conv;
      end;
      if cnt < prec then begin
         Buf[dest] := fstr[i]; Inc(dest);
      end;
      Inc(cnt);
   end;
   end_conv:
   Buf[dest] := char(0);
   Result := strPas(Buf);
end;

//文件大小
function  FileSize (const FName: string): Longint;
var
  SearchRec: TSearchRec;
begin
  if FindFirst(ExpandFileName(FName), faAnyFile, SearchRec) = 0 then
    Result := SearchRec.Size
  else Result := -1;
end;

//文件拷贝
function FileCopy(source,dest: String): Boolean;
var
  fSrc,fDst,len: Integer;
  size: Longint;
  buffer: packed array [0..2047] of Byte;
begin
  Result := False; { Assume that it WONT work }
  if source <> dest then begin
    fSrc := FileOpen(source,fmOpenRead);
    if fSrc >= 0 then begin
      size := FileSeek(fSrc,0,2);
      FileSeek(fSrc,0,0);
      fDst := FileCreate(dest);
      if fDst >= 0 then begin
        while size > 0 do begin
          len := FileRead(fSrc,buffer,sizeof(buffer));
          FileWrite(fDst,buffer,len);
          size := size - len;
        end;
        FileSetDate(fDst,FileGetDate(fSrc));
        FileClose(fDst);
        FileSetAttr(dest,FileGetAttr(source));
        Result := True;
      end;
      FileClose(fSrc);
    end;
  end;
end;

//获取指定字符串中以指定分割符结尾的子串
function GetValidStr3 (Str: string; var Dest: string; const Divider: array of Char): string;
const
   BUF_SIZE = 20480; //$7FFF;
var
   Buf: array[0..BUF_SIZE] of char;
   BufCount, Count, SrcLen, I, ArrCount: Longint;
   Ch: char;
label
	CATCH_DIV;
begin
   try
      SrcLen := Length(Str);
      BufCount := 0;
      Count := 1;

      if SrcLen >= BUF_SIZE-1 then begin
         Result := '';
         Dest := '';
         exit;
      end;

      if Str = '' then begin
         Dest := '';
         Result := Str;
         exit;
      end;
      ArrCount := sizeof(Divider) div sizeof(char);

      while TRUE do begin
         if Count <= SrcLen then begin
            Ch := Str[Count];
            for I:=0 to ArrCount- 1 do
               if Ch = Divider[I] then
                  goto CATCH_DIV;
         end;
         if (Count > SrcLen) then begin
            CATCH_DIV:
            if (BufCount > 0) then begin
               if BufCount < BUF_SIZE-1 then begin
                  Buf[BufCount] := #0;
                  Dest := string (Buf);
                  Result := Copy (Str, Count+1, SrcLen-Count);
               end;
               break;
            end else begin
               if (Count > SrcLen) then begin
                  Dest := '';
                  Result := Copy (Str, Count+2, SrcLen-1);
                  break;
               end;
            end;
         end else begin
            if BufCount < BUF_SIZE-1 then begin
               Buf[BufCount] := Ch;
               Inc (BufCount);
            end;// else
               //ShowMessage ('BUF_SIZE overflow !');
         end;
         Inc (Count);
      end;
   except
      Dest := '';
      Result := '';
   end;
end;

function GetValidStrVal (Str: string; var Dest: string; const Divider: array of Char): string;
//箭磊甫 盒府秦晨 ex) 12.30mV
const
	BUF_SIZE = 15600;
var
	Buf: array[0..BUF_SIZE] of char;
   BufCount, Count, SrcLen, I, ArrCount: Longint;
   Ch: char;
   currentNumeric: Boolean;
   hexmode: Boolean;
label
	CATCH_DIV;
begin
	try
   	//EnterCriticalSection (CSUtilLock);
      hexmode := FALSE;
      SrcLen := Length(Str);
      BufCount := 0;
      Count := 1;
      currentNumeric := FALSE;

      if Str = '' then begin
         Dest := '';
         Result := Str;
         exit;
      end;
      ArrCount := sizeof(Divider) div sizeof(char);

      while TRUE do begin
         if Count <= SrcLen then begin
            Ch := Str[Count];
            for I:=0 to ArrCount- 1 do
               if Ch = Divider[I] then
                  goto CATCH_DIV;
         end;
         if not currentNumeric then begin
            if (Count+1) < SrcLen then begin
               if (Str[Count] = '0') and (UpCase(Str[Count+1]) = 'X') then begin
                  Buf[BufCount] := Str[Count];
                  Buf[BufCount+1] := Str[Count+1];
                  Inc (BufCount, 2);
                  Inc (Count, 2);
                  hexmode := TRUE;
                  currentNumeric := TRUE;
                  continue;
               end;
               if (Ch = '-') and (Str[Count+1] >= '0') and (Str[Count+1] <= '9') then begin
                  currentNumeric := TRUE;
               end;
            end;
            if (Ch >= '0') and (Ch <= '9') then begin
               currentNumeric := TRUE;
            end;
         end else begin
            if hexmode then begin
               if not (((Ch >= '0') and (Ch <= '9')) or
                       ((Ch >= 'A') and (Ch <= 'F')) or
                       ((Ch >= 'a') and (Ch <= 'f'))) then begin
                     Dec (Count);
                     goto CATCH_DIV;
               end;
            end else
               if ((Ch < '0') or (Ch > '9')) and (Ch <> '.') then begin
                  Dec (Count);
                  goto CATCH_DIV;
               end;
         end;
         if (Count > SrcLen) then begin
            CATCH_DIV:
            if (BufCount > 0) then begin
               Buf[BufCount] := #0;
               Dest := string (Buf);
               Result := Copy (Str, Count+1, SrcLen-Count);
               break;
            end else begin
               if (Count > SrcLen) then begin
                  Dest := '';
                  Result := Copy (Str, Count+2, SrcLen-1);
                  break;
               end;
            end;
         end else begin
            if BufCount < BUF_SIZE-1 then begin
               Buf[BufCount] := Ch;
               Inc (BufCount);
            end else
               ShowMessage ('BUF_SIZE overflow !');
         end;
         Inc (Count);
      end;
	finally
   	//LeaveCriticalSection (CSUtilLock);
	end;
end;

//等价于StrtoIntDef()
function Str_ToInt (Str: string; def: Longint): Longint;
begin
   Result := def;
   if Str <> '' then begin
      if ((word(Str[1]) >= word('0')) and (word(str[1]) <= word('9'))) or
         (str[1] = '+') or (str[1] = '-') then
         try
            Result := StrToInt64 (Str);
         except
         end;
   end;
end;

function DuplicateBitmap (bitmap: TBitmap): HBitmap;
var
	hbmpOldSrc, hbmpOldDest, hbmpNew : HBitmap;
   hdcSrc, hdcDest						: HDC;

begin
   hdcSrc := CreateCompatibleDC (0);
   hdcDest := CreateCompatibleDC (hdcSrc);

   hbmpOldSrc := SelectObject(hdcSrc, bitmap.Handle);

   hbmpNew := CreateCompatibleBitmap(hdcSrc, bitmap.Width, bitmap.Height);

   hbmpOldDest := SelectObject(hdcDest, hbmpNew);

   BitBlt(hdcDest, 0, 0, bitmap.Width, bitmap.Height, hdcSrc, 0, 0,
     SRCCOPY);

   SelectObject(hdcDest, hbmpOldDest);
   SelectObject(hdcSrc, hbmpOldSrc);

   DeleteDC(hdcDest);
   DeleteDC(hdcSrc);

   Result := hbmpNew;
end;

procedure SpliteBitmap (DC: HDC; X, Y: integer; bitmap: TBitmap; transcolor: TColor);
var
   hdcMixBuffer, hdcBackMask, hdcForeMask, hdcCopy 	 : HDC;
   hOld, hbmCopy, hbmMixBuffer, hbmBackMask, hbmForeMask : HBitmap;
   oldColor: TColor;
begin
   hbmCopy := DuplicateBitmap (bitmap);
   hdcCopy := CreateCompatibleDC (DC);
   hOld := SelectObject (hdcCopy, hbmCopy);

   hdcBackMask := CreateCompatibleDC (DC);
   hdcForeMask := CreateCompatibleDC (DC);
   hdcMixBuffer:= CreateCompatibleDC (DC);
   hbmBackMask := CreateBitmap (bitmap.Width, bitmap.Height, 1, 1, nil);
   hbmForeMask := CreateBitmap (bitmap.Width, bitmap.Height, 1, 1, nil);
   hbmMixBuffer:= CreateCompatibleBitmap (DC, bitmap.Width, bitmap.Height);

   SelectObject (hdcBackMask, hbmBackMask);
   SelectObject (hdcForeMask, hbmForeMask);
   SelectObject (hdcMixBuffer, hbmMixBuffer);
   oldColor := SetBkColor (hdcCopy, transcolor); //clWhite);

   BitBlt (hdcForeMask, 0, 0, bitmap.Width, bitmap.Height, hdcCopy, 0, 0, SRCCOPY);
   SetBkColor (hdcCopy, oldColor);
   BitBlt( hdcBackMask, 0, 0, bitmap.Width, bitmap.Height, hdcForeMask, 0, 0, NOTSRCCOPY );

   BitBlt( hdcMixBuffer, 0, 0, bitmap.Width, bitmap.Height, DC, X, Y, SRCCOPY );
   BitBlt( hdcMixBuffer, 0, 0, bitmap.Width, bitmap.Height, hdcForeMask, 0, 0, SRCAND );
   BitBlt( hdcCopy, 0, 0, bitmap.Width, bitmap.Height, hdcBackMask, 0, 0, SRCAND );
   BitBlt( hdcMixBuffer, 0, 0, bitmap.Width, bitmap.Height, hdcCopy, 0, 0, SRCPAINT );
   BitBlt( DC, X, Y, bitmap.Width, bitmap.Height, hdcMixBuffer, 0, 0, SRCCOPY );

   {DeleteObject (hbmCopy);}
   DeleteObject( SelectObject( hdcCopy, hOld ) );
   DeleteObject( SelectObject( hdcForeMask, hOld ) );
   DeleteObject( SelectObject( hdcBackMask, hOld ) );
   DeleteObject( SelectObject( hdcMixBuffer, hOld ) );
   DeleteDC( hdcCopy );
   DeleteDC( hdcForeMask );
   DeleteDC( hdcBackMask );
   DeleteDC( hdcMixBuffer );
end;

//取两个整数中的最小值
function _MIN (n1, n2: integer): integer;
begin
	if n1 < n2 then Result := n1
   else Result := n2;
end;
//取两个整数中的最大值
function _MAX (n1, n2: integer): integer;
begin
   if n1 > n2 then Result := n1
   else Result := n2;
end;


end.