?? xprocs.pas
字號:
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 }
function sysTempPath:String;
procedure sysDelay(aMs: Longint);
procedure sysBeep;
function sysColorDepth: Integer; { 06.08.96 sb }
{$IFDEF Win32}
procedure sysSaverRunning(Active: Boolean);
{$ENDIF}
{ registry functions }
{$IFDEF Win32}
function regReadString(aKey: hKey; const Path: String): String;
procedure regWriteString(aKey: hKey; const Path,Value: String);
procedure regDelValue(aKey: hKey; const Path: String);
function regInfoString(const Value: String): String;
function regCurrentUser: String;
function regCurrentCompany: String;
procedure regWriteShellExt(const aExt,aCmd,aMenu,aExec: String);
{ The following five functions came from David W. Yutzy / Celeste Software Services
Thanks for submitting us the methods !!
}
procedure regKeyList(aKey: HKEY; const Path:String; var aValue: TStringList);
function regValueExist(aKey: HKEY; const Path:String):Boolean;
function regWriteValue(aKey: HKEY; const Path: String; Value: Variant; Typ: TDataType): Boolean;
function regReadValue(aKey:HKEY; const Path:String; Typ: TDataType): Variant;
procedure regValueList(aKey: HKEY; const Path:String; var aValue: TStringList);
{$ENDIF}
{ several functions }
{function Question(const Msg: String):Boolean;
procedure Information(const Msg: String);
function Confirmation(const Msg: String): Word;
}
type
{ TRect that can be used persistent as property for components }
TUnitConvertEvent = function (Sender: TObject;
Value: Integer; Get: Boolean): Integer of object;
TPersistentRect = class(TPersistent)
private
FRect : TRect;
FOnConvert : TUnitConvertEvent;
procedure SetLeft(Value: Integer);
procedure SetTop(Value: Integer);
procedure SetHeight(Value: Integer);
procedure SetWidth(Value: Integer);
function GetLeft: Integer;
function GetTop: Integer;
function GetHeight: Integer;
function GetWidth: Integer;
public
constructor Create;
procedure Assign(Source: TPersistent); override;
property Rect: TRect read FRect;
property OnConvert: TUnitConvertEvent read FOnConvert write FOnConvert;
published
property Left : Integer read GetLeft write SetLeft;
property Top : Integer read GetTop write SetTop;
property Height: Integer read GetHeight write SetHeight;
property Width : Integer read GetWidth write SetWidth;
end;
{$IFDEF Win32}
{ Persistent access of components from the registry }
TPersistentRegistry = class(TRegistry)
public
function ReadComponent(const Name: String; Owner, Parent: TComponent): TComponent;
procedure WriteComponent(const Name: String; Component: TComponent);
end;
{$ENDIF
{ easy access of the system metrics }
TSystemMetric = class
private
FColorDepth,
FMenuHeight,
FCaptionHeight : Integer;
FBorder,
FFrame,
FDlgFrame,
FBitmap,
FHScroll,
FVScroll,
FThumb,
FFullScreen,
FMin,
FMinTrack,
FCursor,
FIcon,
FDoubleClick,
FIconSpacing : TPoint;
protected
constructor Create;
procedure Update;
public
property MenuHeight: Integer read FMenuHeight;
property CaptionHeight: Integer read FCaptionHeight;
property Border: TPoint read FBorder;
property Frame: TPoint read FFrame;
property DlgFrame: TPoint read FDlgFrame;
property Bitmap: TPoint read FBitmap;
property HScroll: TPoint read FHScroll;
property VScroll: TPoint read FVScroll;
property Thumb: TPoint read FThumb;
property FullScreen: TPoint read FFullScreen;
property Min: TPoint read FMin;
property MinTrack: TPoint read FMinTrack;
property Cursor: TPoint read FCursor;
property Icon: TPoint read FIcon;
property DoubleClick: TPoint read FDoubleClick;
property IconSpacing: TPoint read FIconSpacing;
property ColorDepth: Integer read FColorDepth;
end;
var
SysMetric: TSystemMetric;
type
TDesktopCanvas = class(TCanvas)
private
DC : hDC;
public
constructor Create;
destructor Destroy; override;
end;
implementation
uses
SysUtils, Controls, Forms, Consts, Dialogs;
{ bit manipulating }
function bitSet(const Value: Int_; const TheBit: TBit): Boolean;
begin
Result:= (Value and (1 shl TheBit)) <> 0;
end;
function bitOn(const Value: Int_; const TheBit: TBit): Int_;
begin
Result := Value or (1 shl TheBit);
end;
function bitOff(const Value: Int_; const TheBit: TBit): Int_;
begin
Result := Value and ((1 shl TheBit) xor $FFFFFFFF);
end;
function bitToggle(const Value: Int_; const TheBit: TBit): Int_;
begin
result := Value xor (1 shl TheBit);
end;
{ string methods }
function strHash(const S: String; LastBucket: Integer): Integer;
var
i: Integer;
begin
Result:=0;
for i := 1 to Length(S) do
Result := ((Result shl 3) xor Ord(S[i])) mod LastBucket;
end;
function strTrim(const S: String): String;
begin
Result:=StrTrimChR(StrTrimChL(S,BLANK),BLANK);
end;
function strTrimA(const S: String): String;
begin
Result:=StrTrimChA(S,BLANK);
end;
function strTrimChA(const S: String; C: Char): String;
var
I : Word;
begin
Result:=S;
for I:=Length(Result) downto 1 do
if Result[I]=C then Delete(Result,I,1);
end;
function strTrimChL(const S: String; C: Char): String;
begin
Result:=S;
while (Length(Result)>0) and (Result[1]=C) do Delete(Result,1,1);
end;
function strTrimChR(const S: String; C: Char): String;
begin
Result:=S;
while (Length(Result)> 0) and (Result[Length(Result)]=C) do
Delete(Result,Length(Result),1);
end;
function strLeft(const S: String; Len: Integer): String;
begin
Result:=Copy(S,1,Len);
end;
function strLower(const S: String): String;
begin
Result:=AnsiLowerCase(S);
end;
function strMake(C: Char; Len: Integer): String;
begin
Result:=strPadChL('',C,Len);
end;
function strPadChL(const S: String; C: Char; Len: Integer): String;
begin
Result:=S;
while Length(Result)<Len do Result:=C+Result;
end;
function strPadChR(const S: String; C: Char; Len: Integer): String;
begin
Result:=S;
while Length(Result)<Len do Result:=Result+C;
end;
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -