unit HUtil32;

//============================================
// Latest Update date : 1998 1
// Add/Update Function and procedure :
// 		CaptureString
//       Str_PCopy          	(4/29)
//			Str_PCopyEx			 	(5/2)
//			memset					(6/3)
//       SpliteBitmap         (9/3)
//       ArrestString         (10/27)  {name changed}
//       IsStringNumber       (98'1/1)
//			GetDirList				(98'12/9)
//       GetFileDate          (98'12/9)
//       CatchString          (99'2/4)
//       DivString            (99'2/4)
//       DivTailString        (99'2/4)
//       SPos                 (99'2/9)
//============================================


interface

uses
	Classes, SysUtils, WinTypes, WinProcs, Graphics, Messages, Dialogs;

type
	Str4096 = array [0..4096] of char;
   Str256 = array [0..256] of char;
   TyNameTable = record
   	Name: string;
      varl:	Longint;
   end;

   TLRect = record
   	Left, Top, Right, Bottom: Longint;
   end;

const
	MAXDEFCOLOR			= 16;
	ColorNames: array [1..MAXDEFCOLOR] of TyNameTable = (
   	(Name: 'BLACK'; 		varl: clBlack),
      (Name: 'BROWN';		varl: clMaroon),
      (Name: 'MARGENTA';	varl: clFuchsia),
      (Name: 'GREEN';		varl: clGreen),
      (Name: 'LTGREEN';		varl: clOlive),
      (Name: 'BLUE';			varl: clNavy),
      (Name: 'LTBLUE';		varl: clBlue),
      (Name: 'PURPLE';		varl: clPurple),
      (Name: 'CYAN';			varl: clTeal),
      (Name: 'LTCYAN';		varl: clAqua),
      (Name: 'GRAY';			varl: clGray),
      (Name: 'LTGRAY';		varl: clsilver),
      (Name: 'YELLOW';		varl: clYellow),
      (Name: 'LIME';			varl: clLime),
      (Name: 'WHITE';		varl: clWhite),
      (Name: 'RED';			varl: clRed)
   );

   MAXLISTMARKER    = 3;
   LiMarkerNames: array [1..MAXLISTMARKER] of TyNameTable = (
   	(Name: 'DISC';			varl: 0),
      (Name: 'CIRCLE';		varl: 1),
      (Name: 'SQUARE';		varl: 2)
   );

   MAXPREDEFINE    = 3;
   PreDefineNames: array [1..MAXPREDEFINE] of TyNameTable = (
   	(Name: 'LEFT';			varl: 0),
      (Name: 'RIGHT';		varl: 1),
      (Name: 'CENTER';		varl: 2)
   );




function CountGarbage (paper: TCanvas; Src: PChar; TargWidth: Longint): integer; {garbage}
{[ArrestString]
      Result = Remain string,
      RsltStr = captured string
}
function  ArrestString (Source, SearchAfter, ArrestBefore: string;
					  const DropTags: array of string; var RsltStr: string): string;
{*}
function  ArrestStringEx (Source, SearchAfter, ArrestBefore: string; var ArrestStr: string): string;
function  CaptureString (source: string; var rdstr: string): string;
procedure ClearWindow (aCanvas: TCanvas; aLeft, aTop, aRight, aBottom:Longint; aColor: TColor);
function  CombineDirFile (SrcDir, TargName: string): string;
{*}
function  CompareLStr (src, targ: string; compn: integer): Boolean;
function  CompareBackLStr (src, targ: string; compn: integer): Boolean;
function  CompareBuffer (p1, p2: PByte; len: integer): Boolean;
function  CreateMask (Src: PChar; TargPos: Integer): string;
procedure DrawTileImage (Canv: TCanvas; Rect: TRect; TileImage: TBitmap);
procedure DrawingGhost (Rc: TRect);
function  ExtractFileNameOnly (const fname: string): string;
function  FloatToString (F: Real): string;
function  FloatToStrFixFmt (fVal: Double; prec, digit: Integer): string;
function  FileSize (const FName: string): Longint;
{*}
function  FileCopy(source,dest: String): Boolean;
function  FileCopyEx(source,dest: String): Boolean;
function  GetSpaceCount (Str: string): Longint;
function  RemoveSpace (str: string): string;
function  GetFirstWord (Str: string; var sWord: string; var FrontSpace: Longint): string;
function  GetDefColorByName (Str: string): TColor;
function  GetULMarkerType (Str: string): Longint;
{*}
function  GetValidStr3 (Str: string; var Dest: string; const Divider: array of Char): string;
function  GetValidStr4 (Str: string; var Dest: string; const Divider: array of Char): string;
function  GetValidStrVal (Str: string; var Dest: string; const Divider: array of Char): string;
function  GetValidStrCap (Str: string; var Dest: string; const Divider: array of Char): string;
function  GetStrToCoords (Str: string): TRect;
function  GetDefines (Str: string): Longint;
function  GetValueFromMask (Src: PChar; Mask: string): string;
procedure GetDirList (path: string; fllist: TStringList);
function  GetFileDate (filename: string): integer; //DOS format file date..
function  HexToIntEx (shap_str: string): Longint;
function  HexToInt( str: string ): LongInt;
function  IntToStrFill (num, len: integer; fill: char): string;
function  IsInB (Src: string; Pos: integer; Targ: string): Boolean;
function  IsInRect (X, Y: integer; Rect: TRect): Boolean;
function  IsEnglish (Ch: Char): Boolean;
function  IsEngNumeric (Ch: Char): Boolean;
function  IsFloatNumeric (str: string): Boolean;
function  IsUniformStr (src: string; ch: char): Boolean;
function  IsStringNumber (str: string): boolean;
function  KillFirstSpace (var Str: string): Longint;
procedure KillGabageSpace (var Str: string);
function  LRect (l, t, r, b: Longint): TLRect;
procedure MemPCopy (Dest: PChar; Src: string);
procedure MemCpy (Dest, Src: PChar; Count: Longint);                {PChar type}
procedure memcpy2 (TargAddr, SrcAddr: Longint; count: integer);     {Longint type}
procedure memset (buffer: PChar; fillchar: char; count: integer);
procedure PCharSet (P: PChar; n: integer; ch: char);
function  ReplaceChar (src: string; srcchr, repchr: char): string;
function  Str_ToDate (str: string): TDateTime;
function  Str_ToTime (str: string): TDateTime;
function  Str_ToInt (Str: string; def: Longint): Longint;
function  Str_ToFloat (str: string): Real;
function  SkipStr (Src: string; const Skips: array of char): string;
procedure ShlStr (Source: PChar; count: integer);
procedure ShrStr (Source: PChar; count: integer);
procedure Str256PCopy (Dest: PChar; const Src: string);
function  _StrPas (dest: PChar): string;
function  Str_PCopy (dest: PChar; src: string): integer;
function  Str_PCopyEx (dest: PChar; const src: string; buflen: longint): integer;
procedure SpliteBitmap (DC: HDC; X, Y: integer; bitmap: TBitmap; transcolor: TColor);
procedure TiledImage (Canv: TCanvas; Rect: TLRect; TileImage: TBitmap);
function  Trim_R (const str: string): string;
function  IsEqualFont (SrcFont, TarFont: TFont): Boolean;
function  CutHalfCode (Str: string): string;
function  ConvertToShortName(Canvas : TCanvas; Source : string; WantWidth : integer) : string;
{*}
function  CatchString (source: string; cap: char; var catched: string): string;
function  DivString (source: string; cap: char; var sel: string): string;
function  DivTailString (source: string; cap: char; var sel: string): string;
function  SPos (substr, str: string): integer;
function  NumCopy (str: string): integer;
function  GetMonDay: string;
function  BoolToStr(boo: Boolean): string;


function _MIN (n1, n2: integer): integer;
function _MAX (n1, n2: integer): integer;

implementation

//var
//	CSUtilLock: TRTLCriticalSection;

{ capture "double quote streams" }
function  CaptureString (source: string; var rdstr: string): string;
var
	st, et, c, len, i: integer;
begin
   if source = '' then begin
   	rdstr := ''; Result := '';
      exit;
   end;
	c := 1;
   //et := 0;
   len := Length (source);
	while source[c] = ' ' do
      if c < len then Inc (c)
      else break;

   if (source[c] = '"') and (c < len) then begin

      st := c+1;
      et := len;
    	for i:=c+1 to len do
      	if source[i] = '"' then begin
            et := i-1;
         	break;
         end;

   end else begin
   	st := c;
      et := len;
      for i:=c to len do
      	if source[i] = ' ' then begin
         	et := i-1;
            break;
         end;

   end;

   rdstr := Copy (source, st, (et-st+1));
   if len >= (et+2) then
   	Result := Copy (source, et+2, len-(et+1)) else
      Result := '';

end;


function CountUglyWhiteChar (sPtr: PChar): Longint;
var
   Cnt, Killw: Longint;
begin
   Killw := 0;
   for Cnt := (StrLen(sPtr)-1) downto 0 do begin
      if sPtr[Cnt] = ' ' then begin
         Inc (KillW);
         {sPtr[Cnt] := #0;}
      end else break;
   end;
   Result := Killw;
end;


function CountGarbage (paper: TCanvas; Src: PChar; TargWidth: Longint): integer; {garbage}
var
	gab, destWidth: integer;
begin

   gab := CountUglyWhiteChar (Src);
   destWidth := paper.TextWidth(StrPas (Src)) - gab;
   Result := TargWidth - DestWidth + (gab * paper.TextWidth(' '));

end;


function GetSpaceCount (Str: string): Longint;
var
	Cnt, Len, SpaceCount: Longint;
begin
	SpaceCount := 0;
	Len := Length (Str);
   for Cnt := 1 to Len do
     	if Str[Cnt] = ' ' then SpaceCount := SpaceCount + 1;
   Result := SpaceCount;
end;

function  RemoveSpace (str: string): string;
var
   i: integer;
begin
   Result := '';
   for i:=1 to Length(str) do
      if str[i] <> ' ' then
         Result := Result + str[i];
end;

function KillFirstSpace (var Str: string): Longint;
var
	Cnt, Len: Longint;
begin
   Result := 0;
   Len := Length (Str);
	for Cnt := 1 to Len do
   	if Str[Cnt] <> ' ' then begin
         Str := Copy (Str, Cnt, Len-Cnt+1);
         Result := Cnt-1;
         break;
      end;
end;

procedure KillGabageSpace (var Str: string);
var
	Cnt, Len: Longint;
begin
   Len := Length (Str);
	for Cnt := Len downto 1 do
   	if Str[Cnt] <> ' ' then begin
         Str := Copy (Str, 1, Cnt);
         KillFirstSpace (Str);
         break;
      end;
end;

function GetFirstWord (Str: string; var sWord: string; var FrontSpace: Longint): string;
var
   Cnt, Len, N: Longint;
   DestBuf: Str4096;
begin
   Len := Length (Str);
   if Len <= 0 then
   	Result := ''
   else begin
   	FrontSpace := 0;
      for Cnt := 1 to Len do begin
         if Str[Cnt] = ' ' then Inc (FrontSpace)
         else break;
      end;
      N := 0;
      for Cnt := Cnt to Len do begin
         if Str[Cnt] <> ' ' then
            DestBuf[N] := Str[Cnt]
         else begin
            DestBuf[N] := #0;
            sWord := StrPas (DestBuf);
            Result := Copy (Str, Cnt, Len-Cnt+1);
            exit;
         end;
         Inc (N);
      end;
      DestBuf[N] := #0;
      sWord := StrPas (DestBuf);
      Result := '';
   end;
end;

function HexToIntEx (shap_str: string): Longint;
begin
   Result := HexToInt (Copy (Shap_str, 2, Length(Shap_str)-1));
end;

function HexToInt( str: string ): LongInt;
var
   digit: Char;
   count, i: Integer;
   Cur, Val: LongInt;
begin
   Val := 0;
   count := Length(str);
   for i := 1 to count do begin
      digit := str[i];
           if (digit >= '0') and (digit <= '9') then Cur := Ord(digit) - Ord('0')
      else if (digit >= 'A') and (digit <= 'F') then Cur := Ord(digit) - Ord('A') + 10
      else if (digit >= 'a') and (digit <= 'f') then Cur := Ord(digit) - Ord('a') + 10
      else Cur := 0;
      Val := Val + (Cur shl (4*(count-i)));
   end;
   Result := Val;
//   Result := (Val and $0000FF00) or ((Val shl 16) and $00FF0000) or ((Val shr 16) and $000000FF);
end;

function Str_ToInt (Str: string; def: Longint): Longint;
begin
   Result := def;
   if Str <> '' then begin
      if ((word(Str[1]) >= word('0')) and (word(str[1]) <= word('9'))) or
         (str[1] = '+') or (str[1] = '-') then
         try
            Result := StrToInt64 (Str);
         except
         end;
   end;
end;

function Str_ToDate (Str: string): TDateTime;
begin
   if Trim(Str) = '' then Result := Date
   else
      Result := StrToDate (str);
end;

function Str_ToTime (Str: string): TDateTime;
begin
   if Trim(Str) = '' then Result := Time
   else
      Result := StrToTime (str);
end;

function Str_ToFloat (str: string): Real;
begin
   if str <> '' then
      try
         Result := StrToFloat (str);
         exit;
      except
      end;
	Result := 0;
end;

procedure DrawingGhost (Rc: TRect);
var
	DC: HDC;
begin
   DC := GetDC (0);
   DrawFocusRect (DC, Rc);
   ReleaseDC (0, DC);
end;

function  ExtractFileNameOnly (const fname: string): string;
var
   extpos: integer;
   ext, fn: string;
begin
   ext := ExtractFileExt (fname);
   fn := ExtractFileName (fname);
   if ext <> '' then begin
      extpos := pos (ext, fn);
      Result := Copy (fn, 1, extpos-1);
   end else
      Result := fn;
end;

function FloatToString (F: Real): string;
begin
	Result := FloatToStrFixFmt (F, 5, 2);
end;

function FloatToStrFixFmt (fVal: Double; prec, digit: Integer): string;
var
   cnt, dest, Len, I, j: Integer;
   fstr: string;
   Buf: array[0..255] of char;
label end_conv;
begin
   cnt := 0;  dest := 0;
   fstr := FloatToStrF ( fVal, ffGeneral, 15, 3 );
   Len  := Length (fstr);
   for i:=1 to Len do begin
      if fstr[i]='.' then begin
         Buf[dest] := '.'; Inc(dest);
         cnt := 0;
         for j:=i+1 to Len do begin
            if cnt < digit then begin
               Buf[dest] := fstr[j]; Inc(dest);
            end
            else begin
               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 FileCopy(source,dest: String): Boolean;
var
  fSrc,fDst,len: Integer;
  size: Longint;
  buffer: packed array [0..2047] of Byte;
begin
  Result := False; { Assume that it WONT work }
  if source <> dest then begin
    fSrc := FileOpen(source,fmOpenRead);
    if fSrc >= 0 then begin
      size := FileSeek(fSrc,0,2);
      FileSeek(fSrc,0,0);
      fDst := FileCreate(dest);
      if fDst >= 0 then begin
        while size > 0 do begin
          len := FileRead(fSrc,buffer,sizeof(buffer));
          FileWrite(fDst,buffer,len);
          size := size - len;
        end;
        FileSetDate(fDst,FileGetDate(fSrc));
        FileClose(fDst);
        FileSetAttr(dest,FileGetAttr(source));
        Result := True;
      end;
      FileClose(fSrc);
    end;
  end;
end;

function FileCopyEX(source,dest: String): Boolean;
var
  fSrc,fDst,len: Integer;
  size: Longint;
  buffer: array [0..512000] of Byte;
begin
  Result := False; { Assume that it WONT work }
  if source <> dest then begin
    fSrc := FileOpen(source,fmOpenRead or fmShareDenyNone);
    if fSrc >= 0 then begin
      size := FileSeek(fSrc,0,2);
      FileSeek(fSrc,0,0);
      fDst := FileCreate(dest);
      if fDst >= 0 then begin
        while size > 0 do begin
          len := FileRead(fSrc,buffer,sizeof(buffer));
          FileWrite(fDst,buffer,len);
          size := size - len;
        end;
        FileSetDate(fDst,FileGetDate(fSrc));
        FileClose(fDst);
        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
   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
	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
	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  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;
         RsltStr := string (Buf);
      end;

      Result := Copy (Source, SrcCount+1, SrcLen-SrcCount); {result is remain string}
	finally
   	//LeaveCriticalSection (CSUtilLock);
	end;
end;


function ArrestStringEx (Source, SearchAfter, ArrestBefore: string; var ArrestStr: string): string;
var
   BufCount, SrcCount, SrcLen: integer;
   GoodData, Fin: Boolean;
   i, n: integer;
begin
   ArrestStr := ''; {result string}
   if Source = '' then begin
      Result := '';
      exit;
   end;

   try
      SrcLen := Length (Source);
      GoodData := FALSE;
      if SrcLen >= 2 then
         if Source[1] = SearchAfter then begin
            Source := Copy (Source, 2, SrcLen-1);
            SrcLen := Length (Source);
            GoodData := TRUE;
         end else begin
            n := Pos (SearchAfter, Source);
            if n > 0 then begin
               Source := Copy (Source, n+1, SrcLen-(n));
               SrcLen := Length(Source);
               GoodData := TRUE;
            end;
         end;
      Fin := FALSE;
      if GoodData then begin
         n := Pos (ArrestBefore, Source);
         if n > 0 then begin
            ArrestStr := Copy (Source, 1, n-1);
            Result := Copy (Source, n+1, SrcLen-n);
         end else begin
            Result := SearchAfter + Source;
         end;
      end else begin
         for i:=1 to SrcLen do begin
            if Source[i] = SearchAfter then begin
               Result := Copy (Source, i, SrcLen-i+1);
               break;
            end;
         end;
      end;
   except
      ArrestStr := '';
      Result := '';
   end;
end;

function SkipStr (Src: string; const Skips: array of char): string;
var
	I, Len, C: integer;
   NowSkip: Boolean;
begin
	Len := Length (Src);
//   Count := sizeof(Skips) div sizeof (Char);

   for I:=1 to Len do begin
   	NowSkip := FALSE;
     	for C:=Low(Skips) to High(Skips) do
      	if Src[I] = Skips[C] then begin
         	NowSkip := TRUE;
            break;
         end;
      if not NowSkip then break;
   end;

   Result := Copy (Src, I, Len-I+1);

end;


function GetStrToCoords (Str: string): TRect;
var
	Temp: string;
begin

   Str := GetValidStr3 (Str, Temp, [',', ' ']); Result.Left   := Str_ToInt (Temp, 0);
   Str := GetValidStr3 (Str, Temp, [',', ' ']); Result.Top    := Str_ToInt (Temp, 0);
   Str := GetValidStr3 (Str, Temp, [',', ' ']); Result.Right  := Str_ToInt (Temp, 0);
          GetValidStr3 (Str, Temp, [',', ' ']); Result.Bottom := Str_ToInt (Temp, 0);

end;

function CombineDirFile (SrcDir, TargName: string): string;
begin
	if (SrcDir = '') or (TargName = '') then begin
   	Result := SrcDir + TargName;
      exit;
   end;
   if SrcDir [Length(SrcDir)] = '\' then
   	Result := SrcDir + TargName
   else Result := SrcDir + '\' + TargName;
end;

function  CompareLStr (src, targ: string; compn: integer): Boolean;
var
   i: integer;
begin
   Result := FALSE;
   if compn <= 0 then exit;
   if Length(src) < compn then exit;
   if Length(targ) < compn then exit;
   Result := TRUE;
   for i:=1 to compn do
      if UpCase(src[i]) <> UpCase(targ[i]) then begin
         Result := FALSE;
         break;
      end;
end;

function  CompareBuffer (p1, p2: PByte; len: integer): Boolean;
var
   i: integer;
begin
   Result := TRUE;
   for i:=0 to len-1 do
      if PByte(integer(p1)+i)^ <> PByte(integer(p2)+i)^ then begin
         Result := FALSE;
         break;
      end;
end;

function  CompareBackLStr (src, targ: string; compn: integer): Boolean;
var
   i, slen, tlen: integer;
begin
   Result := FALSE;
   if compn <= 0 then exit;
   if Length(src) < compn then exit;
   if Length(targ) < compn then exit;
   slen := Length(src);
   tlen := Length(targ);
   Result := TRUE;
   for i:=0 to compn-1 do
      if UpCase(src[slen-i]) <> UpCase(targ[tlen-i]) then begin
         Result := FALSE;
         break;
      end;
end;


function IsEnglish (Ch: Char): Boolean;
begin
	Result := FALSE;
	if ((Ch >= 'A') and (Ch <= 'Z')) or ((Ch >= 'a') and (Ch <= 'z')) then
   	Result := TRUE;
end;

function IsEngNumeric (Ch: Char): Boolean;
begin
	Result := FALSE;
	if IsEnglish (Ch) or ((Ch >= '0') and (Ch <= '9')) then
    	Result := TRUE;
end;

function  IsFloatNumeric (str: string): Boolean;
begin
   if Trim(str) = '' then begin
   	Result := FALSE;
      exit;
   end;
   try
      StrToFloat (str);
      Result := TRUE;
   except
      Result := FALSE;
   end;
end;

procedure PCharSet (P: PChar; n: integer; ch: char);
var
	I: integer;
begin
	for I:=0 to n-1 do
   	(P + I)^ := ch;
end;

function ReplaceChar (src: string; srcchr, repchr: char): string;
var
	i, len: integer;
begin
	if src <> '' then begin
      len := Length (src);
      for i:=0 to len-1 do
      	if src[i] = srcchr then src[i] := repchr;
   end;
   Result := src;
end;


function IsUniformStr (src: string; ch: char): Boolean;
var
	i, len: integer;
begin
   Result := TRUE;
	if src <> '' then begin
      len := Length (src);
      for i:=0 to len-1 do
      	if src[i] = ch then begin
         	Result := FALSE;
            break;
         end;
   end;
end;


function CreateMask (Src: PChar; TargPos: Integer): string;
	function IsNumber (chr: Char): Boolean;
   begin
    	if (Chr >= '0') AND (Chr <= '9') then
      	Result := TRUE
      else Result := FALSE;
   end;
var
	intFlag, Loop: Boolean;
   Cnt, IntCnt, SrcLen: Integer;
   Ch, Ch2: Char;
begin
   intFlag 	:= FALSE;
   Loop 		:= TRUE;
   Cnt := 0;
   IntCnt := 0;
   SrcLen := StrLen (Src);

   while Loop do begin
      Ch := PChar(Longint(Src) + Cnt)^;
      Case Ch of
         #0: begin
            Result := '';
         	break;
         end;
         ' ': begin
         end;
         else begin

            if not intFlag then begin { Now Reading char }
               if IsNumber (Ch) then begin
                  intFlag := TRUE;
                  Inc (IntCnt);
               end;
            end else begin { If, now reading integer }
               if not IsNumber (Ch) then begin  { XXE+3 }
                  case UpCase(Ch) of
                     'E':
                        begin
                           if (Cnt >= 1) AND (Cnt+2 < SrcLen) then begin
                              Ch := PChar(Longint(Src) + Cnt - 1)^;
                              if IsNumber (Ch) then begin
                                 Ch  := PChar(Longint(Src) + Cnt + 1)^;
                                 Ch2 := PChar(Longint(Src) + Cnt + 2)^;
                                 if not ((Ch = '+') AND (IsNumber (Ch2))) then begin
                                    intFlag := FALSE;
                                 end;
                              end;
                           end;
                        end;
                     '+':
                        begin
                           if (Cnt >= 1) AND (Cnt+1 < SrcLen) then begin
                              Ch  := PChar(Longint(Src) + Cnt - 1)^;
                              Ch2 := PChar(Longint(Src) + Cnt + 1)^;
                              if not ((UpCase(Ch) = 'E') AND (IsNumber (Ch2))) then begin
                                 intFlag := FALSE;
                              end;
                           end;
                        end;
                     '.':
                        begin
                           if (Cnt >= 1) AND (Cnt+1 < SrcLen) then begin
                              Ch  := PChar(Longint(Src) + Cnt - 1)^;
                              Ch2 := PChar(Longint(Src) + Cnt + 1)^;
                              if not ((IsNumber(Ch)) AND (IsNumber (Ch2))) then begin
                                 intFlag := FALSE;
                              end;
                           end;
                        end;

                     else
                        intFlag := FALSE;
                  end;
               end;
         end; {end of case else}
      end; {end of Case}
      end;
    	if (IntFlag) and (Cnt >= TargPos) then begin
        	Result := '%' + Format ('%d', [IntCnt]);
         exit;
      end;
      Inc (Cnt);
   end;
end;

function GetValueFromMask (Src: PChar; Mask: string): string;
	function Positon (str: string): Integer;
   var
   	str2: string;
	begin
   	str2 := Copy (str, 2, Length(str)-1);
		Result := StrToIntDef (str2, 0);
		if Result <= 0 then Result := 1;
	end;
	function IsNumber (ch: char): Boolean;
	begin
		case ch of
			'0'..'9': Result := TRUE;
			else Result := FALSE;
		end;
	end;
var
	IntFlag, Loop, Sign: Boolean;
	Buf: Str256;
	BufCount, Pos, LocCount, TargLoc, SrcLen: Integer;
	Ch, Ch2: Char;
begin
	SrcLen := StrLen (Src);
	LocCount := 0;
   BufCount := 0;
	Pos := 0;
	IntFlag := FALSE;
	Loop := TRUE;
	Sign := FALSE;

   if Mask = '' then Mask := '%1';
	TargLoc := Positon (Mask);

	while Loop do begin
		if Pos >= SrcLen then break;
		Ch := PChar (Src + Pos)^;
		if not IntFlag then begin {now reading chars}
			if LocCount < TargLoc then begin
				if IsNumber (Ch) then begin
					IntFlag := TRUE;
					BufCount := 0;
					Inc (LocCount);
				end else begin
					if not Sign then begin {default '+'}
						if Ch = '-' then Sign := TRUE;
					end else begin
						if Ch <> ' ' then Sign := FALSE;
					end;
				end;
			end else begin
				break;
			end;
		end;
		if IntFlag then begin {now reading numbers}
			Buf[BufCount] := Ch;
			Inc (BufCount);
			if not IsNumber (Ch) then begin
				case Ch of
					'E','e':
						begin
							if (Pos >= 1) AND (Pos+2 < SrcLen) then begin
								Ch := PChar(Src + Pos - 1)^;
								if IsNumber (Ch) then begin
									Ch  := PChar(Src + Pos + 1)^;
									Ch2 := PChar(Src + Pos + 2)^;
									if not ((Ch = '+') or (Ch = '-') AND (IsNumber (Ch2))) then begin
										Dec (BufCount);
										IntFlag := FALSE;
									end;
								end;
							end;
						end;
					'+','-':
						begin
							if (Pos >= 1) AND (Pos+1 < SrcLen) then begin
								Ch  := PChar(Src + Pos - 1)^;
								Ch2 := PChar(Src + Pos + 1)^;
								if not ((UpCase(Ch) = 'E') AND (IsNumber (Ch2))) then begin
									Dec (BufCount);
									IntFlag := FALSE;
								end;
							end;
						end;
					'.':
						begin
							if (Pos >= 1) AND (Pos+1 < SrcLen) then begin
								Ch  := PChar(Src + Pos - 1)^;
								Ch2 := PChar(Src + Pos + 1)^;
								if not ((IsNumber(Ch)) AND (IsNumber (Ch2))) then begin
									Dec (BufCount);
									IntFlag := FALSE;
								end;
							end;
						end;
					else
						begin
							IntFlag := FALSE;
							Dec (BufCount);
						end;
				end;
			end;
		end;
		Inc (Pos);
	end;
	if LocCount = TargLoc then begin
		Buf[BufCount] := #0;
		if Sign then
			Result := '-' + StrPas (Buf)
		else Result := StrPas (Buf);
	end else Result := '';
end;

procedure GetDirList (path: string; fllist: TStringList);
var
	SearchRec: TSearchRec;
begin
	if FindFirst (path, faAnyFile, SearchRec) = 0 then begin
      fllist.AddObject (SearchRec.Name, TObject(SearchRec.Time));
    	while TRUE do begin
      	if FindNext (SearchRec) = 0 then begin
            fllist.AddObject (SearchRec.Name, TObject(SearchRec.Time));
         end else begin
            SysUtils.FindClose (SearchRec);
            break;
         end;
		end;
   end;
end;

function  GetFileDate (filename: string): integer; //DOS format file date..
var
	SearchRec: TSearchRec;
begin
	if FindFirst (filename, faAnyFile, SearchRec) = 0 then begin
   	Result := SearchRec.Time;
      SysUtils.FindClose (SearchRec); 
   end;
end;




procedure ShlStr (Source: PChar; count: integer);
var
	I, Len: integer;
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 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;



end.
