hutil32.pas

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

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 _Copy(str:String;Index,COunt:Integer):String;
var
  
  s:WideString;
Begin
  {len:=Length(Str);
  Result:=Copy(Str,index,count);
  if ByteType(Result,1)<>mbLeadByte then
       Delete(Result,1,1);
  len:=Length(Result);
 // if ByteType( then
  if ByteType(Result,Len)=mbLeadByte then
       Delete(Result,len,1);
  }
  s:=WideString(str);
  Result:=Copy(s,index,count);
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
  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 BoolToCStr(boo: Boolean): string;
begin
  if boo then
    Result := '是'
  else
    Result := '否';
end;

function IntToSex(INT: Integer): string;
begin
  case INT of                                               //
    0: Result := '男';
    1: Result := '女';
  else
    begin
      Result := '??';
    end;
  end;
end;

function IntToJob(INT: Integer): string;
begin
  case INT of                                               //
    0: Result := '武士';
    1: Result := '魔法师';
    2: Result := '道士';
  else
    begin
      Result := '??';
    end;
  end;
end;

function BoolToIntStr(boo: Boolean): string;
begin
  if boo then
    Result := '1'
  else
    Result := '0';
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;

function _MAX1(n1, n2: Integer): Integer;
begin
  if n1 > n2 then
    Result := n1
  else
    Result := n2;
  if Result > 65535 then
    Result := 65535;
end;
//取得二个日期之间相差天数

function GetDayCount(MaxDate, MinDate: TDateTime): Integer;
var
  YearMax, MonthMax, DayMax             : Word;
  YearMin, MonthMin, DayMin             : Word;
begin
  Result := 0;
  if MaxDate < MinDate then
    exit;
  DecodeDate(MaxDate, YearMax, MonthMax, DayMax);
  DecodeDate(MinDate, YearMin, MonthMin, DayMin);
  Dec(YearMax, YearMin);
  YearMin := 0;
  Result := (YearMax * 12 * 30 + MonthMax * 30 + DayMax) - (YearMin * 12 * 30 +
    MonthMin * 30 + DayMin);
end;

function GetCodeMsgSize(x: Double): Integer;
begin
  if INT(x) < x then
    Result := Trunc(x) + 1
  else
    Result := Trunc(x)
end;

end.