hutil32.pas

飞尔传奇世界的引擎代码可直接编译M2Engine 请使用Delphi编译

            intFlag := False;
            Dec(BufCount);
          end;
        end;
      end;
    end;
    Inc(Pos);
  end;
  if LocCount = TargLoc then begin
    buf[BufCount] := #0;
    if Sign then
      Result := '-' + StrPas(buf)
    else Result := StrPas(buf);
  end else Result := '';
end;

procedure GetDirList(path: string; fllist: TStringList);
var
  SearchRec: TSearchRec;
begin
  if FindFirst(path, faAnyFile, SearchRec) = 0 then begin
    fllist.AddObject(SearchRec.Name, TObject(SearchRec.Time));
    while True do begin
      if FindNext(SearchRec) = 0 then begin
        fllist.AddObject(SearchRec.Name, TObject(SearchRec.Time));
      end else begin
        SysUtils.FindClose(SearchRec);
        Break;
      end;
    end;
  end;
end;

function GetFileDate(FileName: string): Integer; //DOS format file date..
var
  SearchRec: TSearchRec;
begin
  Result := 0; //jacky
  if FindFirst(FileName, faAnyFile, SearchRec) = 0 then begin
    Result := SearchRec.Time;
    SysUtils.FindClose(SearchRec);
  end;
end;




procedure ShlStr(Source: PChar; Count: Integer);
var
  I, Len: Integer;
begin
  Len := StrLen(Source);
  while (Count > 0) do begin
    for I := 0 to Len - 2 do
      Source[I] := Source[I + 1];
    Source[Len - 1] := #0;

    Dec(Count);
  end;
end;

procedure ShrStr(Source: PChar; Count: Integer);
var
  I, Len: Integer;
begin
  Len := StrLen(Source);
  while (Count > 0) do begin
    for I := Len - 1 downto 0 do
      Source[I + 1] := Source[I];
    Source[Len + 1] := #0;

    Dec(Count);
  end;
end;

function LRect(l, T, r, B: LongInt): TLRect;
begin
  Result.Left := l;
  Result.Top := T;
  Result.Right := r;
  Result.Bottom := B;
end;

procedure MemPCopy(Dest: PChar; Src: string);
var I: Integer;
begin
  for I := 0 to Length(Src) - 1 do Dest[I] := Src[I + 1];
end;

procedure MemCpy(Dest, Src: PChar; Count: LongInt);
var
  I: LongInt;
begin
  for I := 0 to Count - 1 do begin
    PChar(LongInt(Dest) + I)^ := PChar(LongInt(Src) + I)^;
  end;
end;

procedure memcpy2(TargAddr, SrcAddr: LongInt; Count: Integer);
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    PChar(TargAddr + I)^ := PChar(SrcAddr + I)^;
end;

procedure memset(Buffer: PChar; FillChar: Char; Count: Integer);
var I: Integer;
begin
  for I := 0 to Count - 1 do
    Buffer[I] := FillChar;
end;

procedure Str256PCopy(Dest: PChar; const Src: string);
begin
  StrPLCopy(Dest, Src, 255);
end;

function _StrPas(Dest: PChar): string;
var
  I: Integer;
begin
  Result := '';
  for I := 0 to Length(Dest) - 1 do
    if Dest[I] <> Chr(0) then
      Result := Result + Dest[I]
    else
      Break;
end;

function Str_PCopy(Dest: PChar; Src: string): Integer;
var
  Len, I: Integer;
begin
  Len := Length(Src);
  for I := 1 to Len do Dest[I - 1] := Src[I];
  Dest[Len] := #0;
  Result := Len;
end;

function Str_PCopyEx(Dest: PChar; const Src: string; buflen: LongInt): Integer;
var
  Len, I: Integer;
begin
  Len := _MIN(Length(Src), buflen);
  for I := 1 to Len do Dest[I - 1] := Src[I];
  Dest[Len] := #0;
  Result := Len;
end;

function Str_Catch(Src, Dest: string; Len: Integer): string; //Result is rests..
begin

end;

function Trim_R(const Str: string): string;
var
  I, Len, tr: Integer;
begin
  tr := 0;
  Len := Length(Str);
  for I := Len downto 1 do
    if Str[I] = ' ' then Inc(tr)
    else Break;
  Result := Copy(Str, 1, Len - tr);
end;

function IsEqualFont(SrcFont, TarFont: TFont): Boolean;
begin
  Result := True;
  if SrcFont.Name <> TarFont.Name then Result := False;
  if SrcFont.Color <> TarFont.Color then Result := False;
  if SrcFont.Style <> TarFont.Style then Result := False;
  if SrcFont.Size <> TarFont.Size then Result := False;
end;


function CutHalfCode(Str: string): string;
var
  Pos, Len: Integer;
begin

  Result := '';
  Pos := 1;
  Len := Length(Str);

  while True do begin

    if Pos > Len then Break;

    if (Str[Pos] > #127) then begin

      if ((Pos + 1) <= Len) and (Str[Pos + 1] > #127) then begin
        Result := Result + Str[Pos] + Str[Pos + 1];
        Inc(Pos);
      end;

    end else
      Result := Result + Str[Pos];

    Inc(Pos);

  end;
end;


function ConvertToShortName(Canvas: TCanvas; Source: string; WantWidth: Integer): string;
var
  I, Len: Integer;
  Str: string;
begin
  if Length(Source) > 3 then
    if Canvas.TextWidth(Source) > WantWidth then begin

      Len := Length(Source);
      for I := 1 to Len do begin

        Str := Copy(Source, 1, (Len - I));
        Str := Str + '..';

        if Canvas.TextWidth(Str) < (WantWidth - 4) then begin
          Result := CutHalfCode(Str);
          Exit;
        end;

      end;

      Result := CutHalfCode(Copy(Source, 1, 2)) + '..';
      Exit;

    end;

  Result := Source;

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

  {UnrealizeObject (DC);}
(*   SelectPalette (DC, bitmap.Palette, FALSE);
  RealizePalette (DC);
 *)

  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 TagCount(Source: string; Tag: Char): Integer;
var
  I, tCount: Integer;
begin
  tCount := 0;
  for I := 1 to Length(Source) do
    if Source[I] = Tag then Inc(tCount);
  Result := tCount;
end;

{ "xxxxxx" => xxxxxx }
function TakeOffTag(Src: string; Tag: Char; var rstr: string): string;
var
  I, n2: Integer;
begin
  n2 := Pos(Tag, Copy(Src, 2, Length(Src)));
  rstr := Copy(Src, 2, n2 - 1);
  Result := Copy(Src, n2 + 2, Length(Src) - n2);
end;

function CatchString(Source: string; cap: Char; var catched: string): string;
var
  N: Integer;
begin
  Result := '';
  catched := '';
  if Source = '' then Exit;
  if Length(Source) < 2 then begin
    Result := Source;
    Exit;
  end;
  if Source[1] = cap then begin
    if Source[2] = cap then //##abc#
      Source := Copy(Source, 2, Length(Source));
    if TagCount(Source, cap) >= 2 then begin
      Result := TakeOffTag(Source, cap, catched);
    end else
      Result := Source;
  end else begin
    if TagCount(Source, cap) >= 2 then begin
      N := Pos(cap, Source);
      Source := Copy(Source, N, Length(Source));
      Result := TakeOffTag(Source, cap, catched);
    end else
      Result := Source;
  end;
end;

{ GetValidStr3客 崔府 侥喊磊啊 楷加栏肺 唱棵版快 贸府 救凳 }
{ 侥喊磊啊 绝阑 版快, nil 府畔.. }
function DivString(Source: string; cap: Char; var sel: string): string;
var
  N: Integer;
begin
  if Source = '' then begin
    sel := '';
    Result := '';
    Exit;
  end;
  N := Pos(cap, Source);
  if N > 0 then begin
    sel := Copy(Source, 1, N - 1);
    Result := Copy(Source, N + 1, Length(Source));
  end else begin
    sel := Source;
    Result := '';
  end;
end;

function DivTailString(Source: string; cap: Char; var sel: string): string;
var
  I, N: Integer;
begin
  if Source = '' then begin
    sel := '';
    Result := '';
    Exit;
  end;
  N := 0;
  for I := Length(Source) downto 1 do
    if Source[I] = cap then begin
      N := I;
      Break;
    end;
  if N > 0 then begin
    sel := Copy(Source, N + 1, Length(Source));
    Result := Copy(Source, 1, N - 1);
  end else begin
    sel := '';
    Result := Source;
  end;
end;


function SPos(substr, Str: string): Integer;
var
  I, j, Len, slen: Integer;
  flag: Boolean;
begin
  Result := -1;
  Len := Length(Str);
  slen := Length(substr);
  for I := 0 to Len - slen do begin
    flag := True;
    for j := 1 to slen do begin
      if Byte(Str[I + j]) >= $B0 then begin
        if (j < slen) and (I + j < Len) then begin
          if substr[j] <> Str[I + j] then begin
            flag := False;
            Break;
          end;
          if substr[j + 1] <> Str[I + j + 1] then begin
            flag := False;
            Break;
          end;
        end else
          flag := False;
      end else
        if substr[j] <> Str[I + j] then begin
        flag := False;
        Break;
      end;
    end;
    if flag then begin
      Result := I + 1;
      Break;
    end;
  end;
end;

function NumCopy(Str: string): Integer;
var
  I: Integer;
  Data: string;
begin
  Data := '';
  for I := 1 to Length(Str) do begin
    if (Word('0') <= Word(Str[I])) and (Word('9') >= Word(Str[I])) then begin
      Data := Data + Str[I];
    end else
      Break;
  end;
  Result := Str_ToInt(Data, 0);
end;

function GetMonDay: string;
var
  Year, mon, Day: Word;
  Str: string;
begin
  DecodeDate(Date, Year, mon, Day);
  Str := IntToStr(Year);
  if mon < 10 then Str := Str + '0' + IntToStr(mon)
  else Str := IntToStr(mon);
  if Day < 10 then Str := Str + '0' + IntToStr(Day)
  else Str := IntToStr(Day);
  Result := Str;
end;

function BoolToStr(boo: Boolean): string;
begin
  if boo then Result := 'TRUE'
  else Result := 'FALSE';
end;

function BooleanToStr(boo: Boolean): string;
begin
  if boo then Result := '是'
  else Result := '否';
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;

procedure DisPoseAndNil(var Obj);
var
  temp: Pointer;
begin
  temp := Pointer(Obj);
  Pointer(Obj) := nil;
  Dispose(temp);
end;

end.