hutil32.pas

尚未完成的传奇3资源编辑器,需要就下吧

        FileSetAttr(dest,FileGetAttr(source));
        Result := True;
      end;
      FileClose(fSrc);
    end;
  end;
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 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;
      //Divider包含的项目数
      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] = '"' then
         Result := CaptureString (str, dest)
      else begin
         Result := GetValidStr3 (str, dest, divider);
      end;
   end else begin
      Result := '';
      Dest := '';
   end;
end;
function IntToStr2(n: integer): string;
begin
  if n < 10 then Result := '0' + IntToStr(n)
  else Result := IntToStr(n);
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 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;
					  const DropTags: array of string; var RsltStr: string): string;
const
   BUF_SIZE = $7FFF;
var
	Buf: array [0..BUF_SIZE] of char;
   BufCount, SrcCount, SrcLen, {AfterLen, BeforeLen,} DropCount, I: integer;
   ArrestNow: Boolean;
begin
	try
      //EnterCriticalSection (CSUtilLock);
      RsltStr := ''; {result string}
      SrcLen := Length (Source);

      if SrcLen > BUF_SIZE then begin
         Result := '';
      	exit;
  		end;

      BufCount := 0;
      SrcCount := 1;
      ArrestNow := FALSE;
      DropCount := sizeof(DropTags) div sizeof(string);

      if (SearchAfter = '') then ArrestNow := TRUE;

      //GetMem (Buf, BUF_SIZE);

      while TRUE do begin
         if SrcCount > SrcLen then break;

         if not ArrestNow then begin
            if IsInB (Source, SrcCount, SearchAfter) then ArrestNow := TRUE;
         end else begin
            Buf [BufCount] := Source[SrcCount];
            if IsInB (Source, SrcCount, ArrestBefore) or (BufCount >= BUF_SIZE-2) then begin
               BufCount := BufCount - Length (ArrestBefore);
               Buf[BufCount+1] := #0;
               RsltStr := string (Buf);
               BufCount := 0;
               break;
            end;

            for I:=0 to DropCount-1 do begin
               if IsInB (Source, SrcCount, DropTags[I]) then begin
                  BufCount := BufCount - Length(DropTags[I]);
                  break;
               end;
            end;

            Inc (BufCount);
         end;
         Inc (SrcCount);
      end;

      if (ArrestNow) and (BufCount <> 0) then begin
         Buf [BufCount] := #0;