hutil32.pas

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

          goto end_conv;
        end;
        Inc(Cnt);
      end;
      goto end_conv;
    end;
    if Cnt < prec then
    begin
      Buf[Dest] := fstr[i];
      Inc(Dest);
    end;
    Inc(Cnt);
  end;
  end_conv:
  Buf[Dest] := Char(0);
  Result := StrPas(Buf);
end;


function FileSize(const fname: string): LongInt;
var
  SearchRec                             : TSearchRec;
begin
  if FindFirst(ExpandFileName(fname), faAnyFile, SearchRec) = 0 then
    Result := SearchRec.Size
  else
    Result := -1;
end;





function GetDefColorByName(str: string): TColor;
var
  Cnt                                   : Integer;
  COmpStr                               : string;
begin
  COmpStr := UpperCase(str);
  for Cnt := 1 to MAXDEFCOLOR do
  begin
    if COmpStr = ColorNames[Cnt].Name then
    begin
      Result := TColor(ColorNames[Cnt].varl);
      exit;
    end;
  end;
  Result := $0;
end;

function GetULMarkerType(str: string): LongInt;
var
  Cnt                                   : Integer;
  COmpStr                               : string;
begin
  COmpStr := UpperCase(str);
  for Cnt := 1 to MAXLISTMARKER do
  begin
    if COmpStr = LiMarkerNames[Cnt].Name then
    begin
      Result := LiMarkerNames[Cnt].varl;
      exit;
    end;
  end;
  Result := 1;
end;

function GetDefines(str: string): LongInt;
var
  Cnt                                   : Integer;
  COmpStr                               : string;
begin
  COmpStr := UpperCase(str);
  for Cnt := 1 to MAXPREDEFINE do
  begin
    if COmpStr = PreDefineNames[Cnt].Name then
    begin
      Result := PreDefineNames[Cnt].varl;
      exit;
    end;
  end;
  Result := -1;
end;

procedure ClearWindow(aCanvas: TCanvas; aLeft, aTop, aRight, aBottom: LongInt;
  aColor: TColor);
begin
  with aCanvas do
  begin
    Brush.Color := aColor;
    Pen.Color := aColor;
    Rectangle(0, 0, aRight - aLeft, aBottom - aTop);
  end;
end;


procedure DrawTileImage(Canv: TCanvas; Rect: TRect; TileImage: TBitmap);
var
  i, j, ICnt, JCnt, BmWidth, BmHeight   : Integer;
begin

  BmWidth := TileImage.Width;
  BmHeight := TileImage.Height;
  ICnt := ((Rect.Right - Rect.Left) + BmWidth - 1) div BmWidth;
  JCnt := ((Rect.Bottom - Rect.Top) + BmHeight - 1) div BmHeight;

  UnrealizeObject(Canv.Handle);
  SelectPalette(Canv.Handle, TileImage.Palette, False);
  RealizePalette(Canv.Handle);

  for j := 0 to JCnt do
  begin
    for i := 0 to ICnt do
    begin

      { if (I * BmWidth) < (Rect.Right-Rect.Left) then
         BmWidth := TileImage.Width else
          BmWidth := (Rect.Right - Rect.Left) - ((I-1) * BmWidth);

       if (
       BmWidth := TileImage.Width;
       BmHeight := TileImage.Height;  }

      BitBlt(Canv.Handle,
        Rect.Left + i * BmWidth,
        Rect.Top + (j * BmHeight),
        BmWidth,
        BmHeight,
        TileImage.Canvas.Handle,
        0,
        0,
        SRCCOPY);

    end;
  end;

end;


procedure TiledImage(Canv: TCanvas; Rect: TLRect; TileImage: TBitmap);
var
  i, j, ICnt, JCnt, BmWidth, BmHeight   : Integer;
  Rleft, RTop, RWidth, RHeight, BLeft, BTop: LongInt;
begin

  if assigned(TileImage) then
    if TileImage.Handle <> 0 then
    begin

      BmWidth := TileImage.Width;
      BmHeight := TileImage.Height;
      ICnt := (Rect.Right + BmWidth - 1) div BmWidth - (Rect.Left div BmWidth);
      JCnt := (Rect.Bottom + BmHeight - 1) div BmHeight - (Rect.Top div
        BmHeight);

      UnrealizeObject(Canv.Handle);
      SelectPalette(Canv.Handle, TileImage.Palette, False);
      RealizePalette(Canv.Handle);

      for j := 0 to JCnt do
      begin
        for i := 0 to ICnt do
        begin

          if i = 0 then
          begin
            BLeft := Rect.Left - ((Rect.Left div BmWidth) * BmWidth);
            Rleft := Rect.Left;
            RWidth := BmWidth;
          end
          else
          begin
            if i = ICnt then
              RWidth := Rect.Right - ((Rect.Right div BmWidth) * BmWidth)
            else
              RWidth := BmWidth;
            BLeft := 0;
            Rleft := (Rect.Left div BmWidth) + (i * BmWidth);
          end;


          if j = 0 then
          begin
            BTop := Rect.Top - ((Rect.Top div BmHeight) * BmHeight);
            RTop := Rect.Top;
            RHeight := BmHeight;
          end
          else
          begin
            if j = JCnt then
              RHeight := Rect.Bottom - ((Rect.Bottom div BmHeight) * BmHeight)
            else
              RHeight := BmHeight;
            BTop := 0;
            RTop := (Rect.Top div BmHeight) + (j * BmHeight);
          end;

          BitBlt(Canv.Handle,
            Rleft,
            RTop,
            RWidth,
            RHeight,
            TileImage.Canvas.Handle,
            BLeft,
            BTop,
            SRCCOPY);

        end;
      end;

    end;
end;

function GetStr(Str:string;const Divider:array of Char):String;
var
  i,j:integer;
  ArrCount  : LongInt;
  Find:Boolean;
begin
   Result:='';
   ArrCount := SizeOf(Divider) div SizeOf(Char);
   for i:=1 to Length(Str) do
   begin
      find:=False;
      for j:= 0 to ArrCount - 1 do
      begin
         if Divider[j]=Str[i] then
         begin
            Find:=True;
            Break;
         end;
      End;
      if find then Continue;
      Result:=Result+Str[i];


   End;
End;
function GetValidStr3(str: string; var Dest: string; const Divider: array of
  Char): string;
const
  BUF_SIZE                              = 20480;            //$7FFF;
var
  Buf                                   : array[0..BUF_SIZE] of Char;
  BufCount, Count, srclen, i, ArrCount  : LongInt;
  ch                                    : Char;
label
  CATCH_DIV;
begin
  ch := #0;                                                 //Jacky
  try
    srclen := length(str);
    BufCount := 0;
    Count := 1;

    if srclen >= BUF_SIZE - 1 then
    begin
      Result := '';
      Dest := '';
      exit;
    end;

    if str = '' then
    begin
      Dest := '';
      Result := str;
      exit;
    end;
    ArrCount := SizeOf(Divider) div SizeOf(Char);

    while True do
    begin
      if Count <= srclen then
      begin
        ch := str[Count];
        for i := 0 to ArrCount - 1 do
          if ch = Divider[i] then
            goto CATCH_DIV;
      end;
      if (Count > srclen) then
      begin
        CATCH_DIV:
        if (BufCount > 0) then
        begin
          if BufCount < BUF_SIZE - 1 then
          begin
            Buf[BufCount] := #0;
            Dest := string(Buf);
            Result := Copy(str, Count + 1, srclen - Count);
          end;
          break;
        end
        else
        begin
          if (Count > srclen) then
          begin
            Dest := '';
            Result := Copy(str, Count + 2, srclen - 1);
            break;
          end;
        end;
      end
      else
      begin
        if BufCount < BUF_SIZE - 1 then
        begin
          Buf[BufCount] := ch;
          Inc(BufCount);
        end;                                                // else
        //ShowMessage ('BUF_SIZE overflow !');
      end;
      Inc(Count);
    end;
  except
    Dest := '';
    Result := '';
  end;
end;


// 备盒巩磊啊 唱赣瘤(Result)俊 器窃 等促.

function GetValidStr4(str: string; var Dest: string; const Divider: array of
  Char): string;
const
  BUF_SIZE                              = 18200;            //$7FFF;
var
  Buf                                   : array[0..BUF_SIZE] of Char;
  BufCount, Count, srclen, i, ArrCount  : LongInt;
  ch                                    : Char;
label
  CATCH_DIV;
begin
  ch := #0;                                                 //Jacky
  try
    //EnterCriticalSection (CSUtilLock);
    srclen := length(str);
    BufCount := 0;
    Count := 1;

    if str = '' then
    begin
      Dest := '';
      Result := str;
      exit;
    end;
    ArrCount := SizeOf(Divider) div SizeOf(Char);

    while True do
    begin
      if Count <= srclen then
      begin
        ch := str[Count];
        for i := 0 to ArrCount - 1 do
          if ch = Divider[i] then
            goto CATCH_DIV;
      end;
      if (Count > srclen) then
      begin
        CATCH_DIV:
        if (BufCount > 0) or (ch <> ' ') then
        begin
          if BufCount <= 0 then
          begin
            Buf[0] := ch;
            Buf[1] := #0;
            ch := ' ';
          end
          else
            Buf[BufCount] := #0;
          Dest := string(Buf);
          if ch <> ' ' then
            Result := Copy(str, Count, srclen - Count + 1)
              //remain divider in rest-string,
          else
            Result := Copy(str, Count + 1, srclen - Count); //exclude whitespace
          break;
        end
        else
        begin
          if (Count > srclen) then
          begin
            Dest := '';
            Result := Copy(str, Count + 2, srclen - 1);
            break;
          end;
        end;
      end
      else
      begin
        if BufCount < BUF_SIZE - 1 then
        begin
          Buf[BufCount] := ch;
          Inc(BufCount);
        end
        else
          ShowMessage('BUF_SIZE overflow !');
      end;
      Inc(Count);
    end;
  finally
    //LeaveCriticalSection (CSUtilLock);
  end;
end;


function GetValidStrVal(str: string; var Dest: string; const Divider: array of
  Char): string;
//箭磊甫 盒府秦晨 ex) 12.30mV
const
  BUF_SIZE                              = 15600;
var
  Buf                                   : array[0..BUF_SIZE] of Char;
  BufCount, Count, srclen, i, ArrCount  : LongInt;
  ch                                    : Char;
  currentNumeric                        : Boolean;
  hexmode                               : Boolean;
label
  CATCH_DIV;
begin
  ch := #0;                                                 //Jacky
  try
    //EnterCriticalSection (CSUtilLock);
    hexmode := False;
    srclen := length(str);
    BufCount := 0;
    Count := 1;
    currentNumeric := False;

    if str = '' then
    begin
      Dest := '';
      Result := str;
      exit;
    end;
    ArrCount := SizeOf(Divider) div SizeOf(Char);

    while True do
    begin
      if Count <= srclen then
      begin
        ch := str[Count];
        for i := 0 to ArrCount - 1 do
          if ch = Divider[i] then
            goto CATCH_DIV;
      end;
      if not currentNumeric then
      begin
        if (Count + 1) < srclen then
        begin
          if (str[Count] = '0') and (UpCase(str[Count + 1]) = 'X') then
          begin
            Buf[BufCount] := str[Count];
            Buf[BufCount + 1] := str[Count + 1];
            Inc(BufCount, 2);
            Inc(Count, 2);
            hexmode := True;
            currentNumeric := True;
            Continue;
          end;
          if (ch = '-') and (str[Count + 1] >= '0') and (str[Count + 1] <= '9')
            then
          begin
            currentNumeric := True;
          end;
        end;
        if (ch >= '0') and (ch <= '9') then
        begin
          currentNumeric := True;
        end;
      end
      else
      begin
        if hexmode then
        begin
          if not (((ch >= '0') and (ch <= '9')) or
            ((ch >= 'A') and (ch <= 'F')) or
            ((ch >= 'a') and (ch <= 'f'))) then
          begin
            Dec(Count);
            goto CATCH_DIV;
          end;
        end
        else if ((ch < '0') or (ch > '9')) and (ch <> '.') then
        begin
          Dec(Count);
          goto CATCH_DIV;
        end;
      end;
      if (Count > srclen) then
      begin
        CATCH_DIV:
        if (BufCount > 0) then
        begin
          Buf[BufCount] := #0;
          Dest := string(Buf);
          Result := Copy(str, Count + 1, srclen - Count);
          break;
        end
        else
        begin
          if (Count > srclen) then
          begin
            Dest := '';
            Result := Copy(str, Count + 2, srclen - 1);
            break;
          end;
        end;
      end
      else
      begin
        if BufCount < BUF_SIZE - 1 then
        begin
          Buf[BufCount] := ch;
          Inc(BufCount);
        end
        else
          ShowMessage('BUF_SIZE overflow !');
      end;
      Inc(Count);
    end;
  finally
    //LeaveCriticalSection (CSUtilLock);
  end;
end;

{" " capture => CaptureString (source: string; var rdstr: string): string;
 ** 贸澜俊 " 绰 亲惑 盖 贸澜俊 乐促绊 啊沥
}

function GetValidStrCap(str: string; var Dest: string; const Divider: array of
  Char): string;
begin
  str := TrimLeft(str);
  if str <> '' then
  begin
    if (str[1] = '"') or (str[1] = '(') then
      Result := CaptureString(str, Dest)
    else
    begin
      Result := GetValidStr3(str, Dest, Divider);
    end;
  end
  else
  begin
    Result := '';
    Dest := '';
  end;
end;


function IntToStrFill(num, Len: Integer; fill: Char): string;
var
  i                                     : Integer;
  str                                   : string;
begin
  Result := '';
  str := IntToStr(num);
  for i := 1 to Len - length(str) do
    Result := Result + fill;
  Result := Result + str;
end;

function IntToStr2(INT: Integer): string;
begin
  if INT < 10 then
  begin
    Result := '0' + IntToStr(INT);
  end
  else
  begin
    Result := IntToStr(INT);
  end;
end;

function IsInB(Src: string; Pos: Integer; targ: string): Boolean;
var
  tLen, i                               : Integer;
begin
  Result := False;
  tLen := length(targ);
  if length(Src) < Pos + tLen then
    exit;
  for i := 0 to tLen - 1 do
    if UpCase(Src[Pos + i]) <> UpCase(targ[i + 1]) then
      exit;

  Result := True;
end;

function IsInRect(x, y: Integer; Rect: TRect): Boolean;
begin
  if (x >= Rect.Left) and (x <= Rect.Right) and (y >= Rect.Top) and (y <=
    Rect.Bottom) then
    Result := True
  else
    Result := False;
end;

function IsStringNumber(str: string): Boolean;
var
  i                                     : Integer;
begin
  Result := True;
  for i := 1 to length(str) do
    if (Byte(str[i]) < Byte('0')) or (Byte(str[i]) > Byte('9')) then
    begin
      Result := False;
      break;
    end;
end;


{Return : remain string}

function ArrestString(Source, SearchAfter, ArrestBefore: string;