hutil32.pas

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

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