hutil32.pas

传奇2...飘飘M2的源码.曾经是传奇"龙"版用得最好的M2程序.完整M2源码

    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
  if Pointer(Obj) <> nil then begin
    Temp := Pointer(Obj);
    Pointer(Obj) := nil;
    DisPose(Temp);
  end;
end;

end.