?? hutil32.pas
字號:
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, Math, SysUtils, StrUtils, 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 TagCount(source: string; tag: char): integer;
{*}
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 IntToStr2(n: integer): string;
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 IsEnglishStr (sEngStr:String): 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 GetDayCount(MaxDate,MinDate:TDateTime):Integer;
function BoolToStr(boo: Boolean): string;
function BoolToIntStr(b:Boolean):string;
function BoolToCStr(b:Boolean):String;
function _MIN (n1, n2: integer): integer;
function _MAX (n1, n2: integer): integer;
procedure CenterDialog(hParentWnd, hWnd: HWnd);
function IsIPaddr(IP: string):boolean;
function CalcFileCRC(FileName:String):Integer;
function CalcBufferCRC(Buffer:PChar;nSize:Integer):Integer;
//Damian - These 2 functions are same, so use either
function GetCodeMsgSize(X: Double):Integer;
function UpInt(i:double):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);
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -