hutil32.pas

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

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;


procedure CenterDialog(hParentWnd, hWnd: HWnd);
var
  rcMainWnd, rcDlg: TRect;
begin
	GetWindowRect(hParentWnd, rcMainWnd);
	GetWindowRect(hWnd, rcDlg);
	
	MoveWindow(hWnd, rcMainWnd.left + (((rcMainWnd.right - rcMainWnd.left) - (rcDlg.right - rcDlg.left)) div 2),
				rcMainWnd.top + (((rcMainWnd.bottom - rcMainWnd.top) - (rcDlg.bottom - rcDlg.top)) div 2), 
				(rcDlg.right - rcDlg.left), (rcDlg.bottom - rcDlg.top), FALSE);
end;


function IsIPaddr(IP: string):boolean;
var
  Node:array [0..3] of integer;
  tIP:String;
  tNode:String;
  tPos:Integer;
  tLen:Integer;
begin
 Result:=False;
 tIP:=IP;
 tLen:=Length(tIP);
 tPos:=Pos('.',tIP);
 tNode:=MidStr(tIP,1,tPos -1);
 tIP:=MidStr(tIP,tPos +1 ,tLen - tPos);
 if not TryStrToInt(tNode,Node[0]) then exit;

 tLen:=Length(tIP);
 tPos:=Pos('.',tIP);
 tNode:=MidStr(tIP,1,tPos -1);
 tIP:=MidStr(tIP,tPos +1 ,tLen - tPos);
 if not TryStrToInt(tNode,Node[1]) then exit;

 tLen:=Length(tIP);
 tPos:=Pos('.',tIP);
 tNode:=MidStr(tIP,1,tPos -1);
 tIP:=MidStr(tIP,tPos +1 ,tLen - tPos);
 if not TryStrToInt(tNode,Node[2]) then exit;

 if not TryStrToInt(tIP,Node[3]) then exit;
 for tLen:=Low(Node) to High(Node) do begin
   if(Node[tLen] < 0) or (Node[tLen] > 255) then exit;
 end;
 Result:=True;
end;

function BoolToCStr(b:Boolean):String;
begin
  if b then result:='是' else result:='否';
end;

function BoolToIntStr(b:Boolean):string;
begin
  if b then result:='1' else result:='0';
end;


function CalcFileCRC(FileName:String):Integer;
var
  I: Integer;
  nFileHandle:Integer;
  nFileSize,nBuffSize:Integer;
  Buffer:PChar;
  Int:^Integer;
  nCrc:Integer;
begin
  Result:=0;
  if not FileExists(FileName) then begin
    exit;
  end;
  nFileHandle:=FileOpen(FileName,fmOpenRead or fmShareDenyNone);
  if nFileHandle = 0 then exit;
  nFileSize:=FileSeek(nFileHandle,0,2);
  nBuffSize:=(nFileSize div 4) * 4;
  GetMem(Buffer,nBuffSize);
  FillChar(Buffer^,nBuffSize,0);
  FileSeek(nFileHandle,0,0);
  FileRead(nFileHandle,Buffer^,nBuffSize);
  FileClose(nFileHandle);
  Int:=Pointer(Buffer);
  nCrc:=0;
    Exception.Create(IntToStr(SizeOf(Integer)));  
  for I := 0 to nBuffSize div 4 - 1 do begin
    nCrc:=nCrc xor Int^;
    Int:=Pointer(Integer(Int) + 4);
  end;
  FreeMem(Buffer);
  Result:=nCrc;
end;

function CalcBufferCRC(Buffer:PChar;nSize:Integer):Integer;
var
  I:Integer;
  Int:^Integer;
  nCrc:Integer;
begin
  Int:=Pointer(Buffer);
  nCrc:=0;
  for I := 0 to nSize div 4 - 1 do begin
    nCrc:=nCrc xor Int^;
    Int:=Pointer(Integer(Int) + 4);
  end;
  Result:=nCrc;
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;

function UpInt(i:double):integer;
begin
  result:=Ceil(i);
end;



end.