hutil32.pas

乐都SQL版传奇全套代码,绝对可编译

    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 _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.