📄 xprocs.pas
字号:
{*******************************************************}
{ }
{ xTool - Component Collection }
{ }
{ Copyright (c) 1995 Stefan B鰐her }
{ stefc@fabula.com }
{*******************************************************}
{
Please look also for our xTools-Nails function toolkit.
You'll find more information at
http://ourworld.compuserve.com/homepages/stefc/xprocs.htm
Any comments and suggestions are welcome; please send to:
stefc@fabula.com.
21.02.96 added TMonth & TDay type Stefc
22.02.96 added strFileLoad & strFileSave Stefc
09.03.96 correct sysTempPath Stefc
09.03.96 added regXXXXX functions for access the registry Stefc
24.03.96 added IsWinNT constant Stefc
24.03.96 added SysMetric object Stefc
26.03.96 added dateQuicken for controling date input with keys Stefc
27.03.96 added TDesktopCanvas here Stefc
28.03.96 added LoadDIBitmap Stefc
01.04.96 added Question function here Stefc
09.04.96 added sysSaverRunning added Stefc
12.04.96 added timeZoneOffset Stefc
12.04.96 added timeToInt Stefc
17.04.96 added strCmdLine Stefc
17.04.96 added rectBounds Stefc
17.04.96 added TPersistentRect class Stefc
19.04.96 added strDebug method Stefc
21.04.96 changed TMonth added noneMonth km
21.04.96 added licence callback Stefc
21.04.96 added strNiceDateDefault km
21.04.96 added simple strEncrpyt & strDecrypt Stefc
24.04.96 backport to 16 bit Stefc
24.04.96 added Information method Stefc
24.04.96 use win messageBox with Win95 in Question & Information Stefc
09.05.96 new function ExtractName Stefc
10.05.96 Added TPersistentRegistry Stefc
12.05.96 fileExec Stefc
14.05.96 New function Confirmation Stefc
16.05.96 New function strChange Stefc
29.05.96 New functions comXXXXX Stefc
09.06.96 New function strSearchReplace km
09.06.96 ported assembler strHash to plain pascal Stefc
15.06.96 new variables xLanguage & xLangOfs Stefc
28.06.96 new method sysBeep Stefc
28.06.96 new method intPercent Stefc
10.07.96 make compatible with 16 Bit Delphi 1.0 Stefc
14.07.96 fileLongName & fileShortName defined Stefc
15.07.96 Correct sysTempPath method Stefc
21.07.96 New functions strContains & strContainsU Stefc
28.07.96 comIsCServe also check for xxx@compuServe.com Stefc
31.07.96 added strCapitalize after idea from Fred N. Read Stefc
04.08.96 strByteSize() now can also display Bytes Stefc
05.08.96 added regWriteShellExt() Stefc
06.08.96 added sysColorDepth() Stefc
07.08.96 added strSoundex() Stefc
09.08.96 fixe some bugs in fileShellXXXX Stefc
26.08.96 Added registry functions from David W. Yutzy Stefc
29.08.96 fileShellXXX now also aviable under 16 Bit Stefc
05.09.96 Added regDelValue Stefc
13.09.96 Added fltNegativ and fltPositiv Stefc
29.09.96 Added strTokenToStrings & strTokenFromStrings Stefc
09.10.96 Added variant function Stefc
29.10.96 intPrime now can be used for negative numbers Stefc
29.10.96 fltEqualZero now returns true with FLTZERO Stefc
29.10.96 fltCalc now use Float for greater precision Stefc
29.10.96 correct strTokenCount Stefc
19.11.96 better Windows NT detecting Stefc
28.11.96 correct above text (thanks to Clay Kollenborn-Shannon) Stefc
12.01.96 added fileCopy function Stefc
13.01.96 correct strProfile now it works also for 16-Bit Stefc
13.01.96 get English Quicken keys from George Boomer Stefc
14.01.96 make key in dateQuicken var to reset if on date change Stefc
17.01.96 New functions strPos and strChangeU Stefc
19.01.96 new function fileTypeName after idea of P.Aschenbacher Stefc
19.01.96 new function fileRedirectExec Stefc
}
unit xProcs;
{$D-}
interface
{.$DEFINE German}
{.$DEFINE English}
uses
{$IFDEF Win32} Windows, Registry, {$ELSE} WinTypes, WinProcs, {$ENDIF}
ShellAPI, Messages, Classes, Graphics;
type
Float = Extended; { our type for float arithmetic }
{$IFDEF Win32} { our type for integer functions, Int_ is ever 32 bit }
Int_ = Integer;
{$ELSE}
Int_ = Longint;
{$ENDIF}
const
XCOMPANY = 'Fabula Software';
const
{ several important ASCII codes }
NULL = #0;
BACKSPACE = #8;
TAB = #9;
LF = #10;
CR = #13;
EOF_ = #26; { 30.07.96 sb }
ESC = #27;
BLANK = #32;
SPACE = BLANK;
{ digits as chars }
ZERO = '0'; ONE = '1'; TWO = '2'; THREE = '3'; FOUR = '4';
FIVE = '5'; SIX = '6'; SEVEN = '7'; EIGHT = '8'; NINE = '9';
{ special codes }
SLASH = '\'; { used in filenames }
HEX_PREFIX = '$'; { prefix for hexnumbers }
CRLF : PChar = CR+LF;
{ common computer sizes }
KBYTE = Sizeof(Byte) shl 10;
MBYTE = KBYTE shl 10;
GBYTE = MBYTE shl 10;
{ Low floating point value }
FLTZERO : Float = 0.00000001;
DIGITS : set of Char = [ZERO..NINE];
{ important registry keys / items }
REG_CURRENT_VERSION = 'Software\Microsoft\Windows\CurrentVersion';
REG_CURRENT_USER = 'RegisteredOwner';
REG_CURRENT_COMPANY = 'RegisteredOrganization';
PRIME_16 = 65521;
PRIME_32 = 2147483647;
MINSHORTINT = -128; { 1.8.96 sb }
MAXSHORTINT = 127;
MINBYTE = 0;
MAXBYTE = 255;
MINWORD = 0;
MAXWORD = 65535;
type
TMonth = (NoneMonth,January,February,March,April,May,June,July,
August,September,October,November,December);
TDayOfWeek = (Sunday,Monday,Tuesday,Wednesday,Thursday,Friday,Saturday);
{ Online eMail Service Provider }
TMailProvider = (mpCServe, mpInternet, mpNone);
TLicCallback = function ( var Code: Integer): Integer;
TBit = 0..31;
{ Search and Replace options }
TSROption = (srWord,srCase,srAll);
TSROptions = set of TsrOption;
{ Data types }
TDataType = (dtInteger,dtBoolean,dtString,dtDate,dtTime,
dtFloat,dtCurrency);
var
IsWin95,
IsWinNT : Boolean;
IsFabula : TLicCallBack;
xLanguage : Integer;
xLangOfs : Integer;
{ bit manipulating }
function bitSet(const Value: Int_; const TheBit: TBit): Boolean;
function bitOn(const Value: Int_; const TheBit: TBit): Int_;
function bitOff(const Value: Int_; const TheBit: TBit): Int_;
function bitToggle(const Value: Int_; const TheBit: TBit): Int_;
{ String functions }
function strHash(const S: String; LastBucket: Integer): Integer;
function strCut(const S: String; Len: Integer): String;
function strTrim(const S: String): String;
function strTrimA(const S: String): String;
function strTrimChA(const S: String; C: Char): String;
function strTrimChL(const S: String; C: Char): String;
function strTrimChR(const S: String; C: Char): String;
function strLeft(const S: String; Len: Integer): String;
function strLower(const S: String): String;
function strMake(C: Char; Len: Integer): String;
function strPadChL(const S: String; C: Char; Len: Integer): String;
function strPadChR(const S: String; C: Char; Len: Integer): String;
function strPadChC(const S: String; C: Char; Len: Integer): String;
function strPadL(const S: String; Len: Integer): String;
function strPadR(const S: String; Len: Integer): String;
function strPadC(const S: String; Len: Integer): String;
function strPadZeroL(const S: String; Len: Integer): String;
function strPos(const aSubstr,S: String; aOfs: Integer): Integer;
procedure strChange(var S:String; const Src, Dest: String);
function strChangeU(const S,Source, Dest: String): String;
function strRight(const S: String; Len: Integer): String;
function strAddSlash(const S: String): String;
function strDelSlash(const S: String): String;
function strSpace(Len: Integer): String;
function strToken(var S: String; Seperator: Char): String;
function strTokenCount(S: String; Seperator: Char): Integer;
function strTokenAt(const S:String; Seperator: Char; At: Integer): String;
procedure strTokenToStrings(S: String; Seperator: Char; List: TStrings);
function strTokenFromStrings(Seperator: Char; List: TStrings): String;
function strUpper(const S: String): String;
function strOemAnsi(const S:String): String;
function strAnsiOem(const S:String): String;
function strEqual(const S1,S2: String): Boolean;
function strComp(const S1,S2: String): Boolean;
function strCompU(const S1,S2: String): Boolean;
function strContains(const S1,S2: String): Boolean;
function strContainsU(const S1,S2: String): Boolean;
function strNiceNum(const S: String): String;
function strNiceDateDefault(const S, Default: String): String;
function strNiceDate(const S: String): String;
function strNiceTime(const S: String): String;
function strNicePhone(const S: String): String;
function strReplace(const S: String; C: Char; const Replace: String): String;
function strCmdLine: String;
function strEncrypt(const S: String; Key: Word): String;
function strDecrypt(const S: String; Key: Word): String;
function strLastCh(const S: String): Char;
procedure strStripLast(var S: String);
function strByteSize(Value: Longint): String;
function strSoundex(S: String): String;
procedure strSearchReplace(var S:String; const Source, Dest: String; Options: TSRoptions);
function strProfile(const aFile, aSection, aEntry, aDefault: String): String;
function strCapitalize(const S: String): String; { 31.07.96 sb }
{$IFDEF Win32}
procedure strDebug(const S: String);
function strFileLoad(const aFile: String): String;
procedure strFileSave(const aFile,aString: String);
{$ENDIF}
{ Integer functions }
function intCenter(a,b: Int_): Int_;
function intMax(a,b: Int_): Int_;
function intMin(a,b: Int_): Int_;
function intPow(Base,Expo: Integer): Int_;
function intPow10(Exponent: Integer): Int_;
function intSign(a: Int_): Integer;
function intZero(a: Int_; Len: Integer): String;
function intPrime(Value: Integer): Boolean;
function intPercent(a, b: Int_): Int_;
{ Floatingpoint functions }
function fltAdd(P1,P2: Float; Decimals: Integer): Float;
function fltDiv(P1,P2: Float; Decimals: Integer): Float;
function fltEqual(P1,P2: Float; Decimals: Integer): Boolean;
function fltEqualZero(P: Float): Boolean;
function fltGreaterZero(P: Float): Boolean;
function fltLessZero(P: Float): Boolean;
function fltNeg(P: Float; Negate: Boolean): Float;
function fltMul(P1,P2: Float; Decimals: Integer): Float;
function fltRound(P: Float; Decimals: Integer): Float;
function fltSub(P1,P2: Float; Decimals: Integer): Float;
function fltUnEqualZero(P: Float): Boolean;
function fltCalc(const Expr: String): Float;
function fltPower(a,n: Float): Float;
function fltPositiv(Value: Float): Float;
function fltNegativ(Value: Float): Float;
{ Rectangle functions from Golden Software }
function rectHeight(const R: TRect): Integer;
function rectWidth(const R: TRect): Integer;
procedure rectGrow(var R: TRect; Delta: Integer);
procedure rectRelativeMove(var R: TRect; DX, DY: Integer);
procedure rectMoveTo(var R: TRect; X, Y: Integer);
function rectSet(Left, Top, Right, Bottom: Integer): TRect;
function rectInclude(const R1, R2: TRect): Boolean;
function rectPoint(const R: TRect; P: TPoint): Boolean;
function rectSetPoint(const TopLeft, BottomRight: TPoint): TRect;
function rectIntersection(const R1, R2: TRect): TRect;
function rectIsIntersection(const R1, R2: TRect): Boolean;
function rectIsValid(const R: TRect): Boolean;
function rectsAreValid(const Arr: array of TRect): Boolean;
function rectNull: TRect;
function rectIsNull(const R: TRect): Boolean;
function rectIsSquare(const R: TRect): Boolean;
function rectCentralPoint(const R: TRect): TPoint;
function rectBounds(aLeft,aTop,aWidth,aHeight: Integer): TRect;
{$IFDEF Win32}
{ Variant functions }
function varIIF( aTest: Boolean; TrueValue, FalseValue : Variant): Variant;
procedure varDebug(const V: Variant);
function varToStr(const V: Variant): String;
{$ENDIF}
{ date functions }
function dateYear(D: TDateTime): Integer;
function dateMonth(D: TDateTime): Integer;
function dateDay(D: TDateTime): Integer;
function dateBeginOfYear(D: TDateTime): TDateTime;
function dateEndOfYear(D: TDateTime): TDateTime;
function dateBeginOfMonth(D: TDateTime): TDateTime;
function dateEndOfMonth(D: TDateTime): TDateTime;
function dateWeekOfYear(D: TDateTime): Integer;
function dateDayOfYear(D: TDateTime): Integer;
function dateDayOfWeek(D: TDateTime): TDayOfWeek;
function dateLeapYear(D: TDateTime): Boolean;
function dateBeginOfQuarter(D: TDateTime): TDateTime;
function dateEndOfQuarter(D: TDateTime): TDateTime;
function dateBeginOfWeek(D: TDateTime;Weekday: Integer): TDateTime;
function dateDaysInMonth(D: TDateTime): Integer;
function dateQuicken(D: TDateTime; var Key: Char): TDateTime;
{function dateDiff(D1,D2: TDateTime): Integer;}
{ time functions }
function timeHour(T: TDateTime): Integer;
function timeMin(T: TDateTime): Integer;
function timeSec(T: TDateTime): Integer;
function timeToInt(T: TDateTime): Integer;
{$IFDEF Win32}
function timeZoneOffset: Integer;
{$ENDIF}
{ com Functions }
function comIsCis(const S: String): Boolean;
function comIsInt(const S: String): Boolean;
function comCisToInt(const S: String): String;
function comIntToCis(const S: String): String;
function comFaxToCis(const S: String): String;
function comNormFax(const Name,Fax: String): String;
function comNormPhone(const Phone: String): String;
function comNormInt(const Name,Int: String): String;
function comNormCis(const Name,Cis: String): String;
{ file functions }
procedure fileShredder(const Filename: String);
function fileSize(const Filename: String): Longint;
function fileWildcard(const Filename: String): Boolean;
function fileShellOpen(const aFile: String): Boolean;
function fileShellPrint(const aFile: String): Boolean;
function fileCopy(const SourceFile, TargetFile: String): Boolean;
{$IFDEF Win32}
function fileTemp(const aExt: String): String;
function fileExec(const aCmdLine: String; aHide, aWait: Boolean): Boolean;
function fileRedirectExec(const aCmdLine: String; Strings: TStrings): Boolean;
function fileLongName(const aFile: String): String;
function fileShortName(const aFile: String): String;
function fileTypeName(const aFile: String): String;
{$ENDIF}
function ExtractName(const Filename: String): String;
{ system functions }
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -