diff --git a/Addons/KOLBlockCipher.pas b/Addons/KOLBlockCipher.pas index 2d44fec..6067da1 100644 --- a/Addons/KOLBlockCipher.pas +++ b/Addons/KOLBlockCipher.pas @@ -4337,7 +4337,7 @@ var i: longword; userkey: array[0..31] of byte; begin -burn; + burn; Size:= Size div 8; diff --git a/Addons/addons_D2006.dpk b/Addons/addons_D2006.dpk index a66f55c..8040876 100644 --- a/Addons/addons_D2006.dpk +++ b/Addons/addons_D2006.dpk @@ -1,5 +1,6 @@ package addons_D2006; +{$R 'MCKMonthCalendar.res'} {$R 'addons.res'} {$R 'mckCCtrls.dcr'} {$R 'mckHTTPDownload.dcr'} @@ -88,6 +89,8 @@ contains mckDHTML in 'mckDHTML.pas', KolZLibBzip in 'KolZLibBzip.pas', KOLMHIPEdit in 'KOLMHIPEdit.pas', - MCKMHIPEdit in 'MCKMHIPEdit.pas'; + MCKMHIPEdit in 'MCKMHIPEdit.pas', + MCKMonthCalendar in 'MCKMonthCalendar.pas', + KOLMonthCalendar in 'KOLMonthCalendar.pas'; end. diff --git a/KOL.pas b/KOL.pas index 1530566..03dd95a 100644 --- a/KOL.pas +++ b/KOL.pas @@ -14,7 +14,7 @@ Key Objects Library (C) 2000 by Vladimir Kladov. **************************************************************** -* VERSION 3.16 +* VERSION 3.18 **************************************************************** K.O.L. - is a set of objects and functions to create small programs @@ -37,6 +37,14 @@ ****************************************************************} {$I KOLDEF.inc} + +{$IFDEF x64} + {$DEFINE PAS_ONLY} +{$ENDIF} +{$IFDEF PAS_ONLY} + {$DEFINE PAS_VERSION} +{$ENDIF} + {$IFDEF EXTERNAL_KOLDEFS} {$INCLUDE PROJECT_KOL_DEFS.INC} {$ENDIF} @@ -715,7 +723,8 @@ type {* } PPointerList = ^TPointerList; - TPointerList = array[0..MaxInt div SizeOf(Pointer) - 1] of Pointer; + TPointerList = array[0..{$IFDEF _DXE2orHigher} 65536 + {$ELSE} MaxInt div 4 - 1 {$ENDIF}] of Pointer; TObjectMethod = procedure of object; {* } @@ -983,10 +992,12 @@ function NewListInit( const AItems: array of Pointer ): PList; {$ENDIF} {$IFNDEF TLIST_FAST} +{$IFNDEF PAS_ONLY} procedure FastIncNum2Elements( List: TList; FromIdx, Count, Value: Integer ); {* Very fast adds Value to List elements from List[FromIdx] to List[FromIdx+Count-1]. Given elements must exist. Count must be > 0. } {$ENDIF} +{$ENDIF} procedure Free_And_Nil( var Obj ); {* Obj.Free and Obj := nil, where Obj *MUST* be TObj or its descendant @@ -1787,6 +1798,8 @@ type {* Swaps to strings with given indeces. } procedure Sort( CaseSensitive: Boolean ); {* Call it to sort string list. } + procedure SortEx(const CompareFun: TCompareEvent); + {* Call it to sort string list by CompareFun. } procedure AnsiSort( CaseSensitive: Boolean ); {* Call it to sort ANSI string list. } function LastObj: DWORD; @@ -1902,6 +1915,12 @@ type property LineValue[ Idx: Integer ]: KOLWideString read GetLineValue write SetLineValue; property NameDelimiter: WideChar read fNameDelim write fNameDelim; procedure OptimizeForRead; + protected // ++++++++++++++ by rdnks + procedure SetValue(const AName, Value: KOLWideString); + function GetValue(const AName: KOLWideString): KOLWideString; + public + function IndexOfName(AName: KOLWideString): Integer; + property Values[const AName: KOLWideString]: KOLWideString read GetValue write SetValue; end; PWStrListEx = ^TWStrListEx; @@ -11145,9 +11164,11 @@ procedure ShowMessage( const S: KOLString ); {* Like ShowMsg, but has only styles MB_OK and MB_SETFOREGROUND. } {$ENDIF GDI} {$IFDEF WIN} +{$IFNDEF PAS_ONLY} procedure SpeakerBeep( Freq: Word; Duration: DWORD ); {* On Windows NT, calls Windows.Beep. On Windows 9x, produces beep on speaker of desired frequency during given duration time (in milliseconds). } +{$ENDIF PAS_ONLY} {$ENDIF WIN} function SysErrorMessage(ErrorCode: Integer): KOLString; @@ -11177,6 +11198,7 @@ type function MakeInt64( Lo, Hi: DWORD ): I64; {* } +{$IFNDEF PAS_ONLY} function Int2Int64( X: Integer ): I64; {* } procedure IncInt64( var I64: I64; Delta: Integer ); @@ -11220,6 +11242,7 @@ function Str2Int64( const S: AnsiString ): I64; function Int64_2Double( const X: I64 ): Double; {* } function Double2Int64( D: Double ): I64; +{$ENDIF PAS_ONLY} {* @@ -11250,7 +11273,9 @@ function Extended2StrDigits( D: Double; n: Integer ): KOLString; following floating point. } function Double2StrEx( D: Double ): KOLString; {* experimental, do not use } +{$IFNDEF PAS_ONLY} function TruncD( D: Double ): Double; +{$ENDIF} {* Result := trunc( D ) as Double; |
@@ -11402,7 +11427,9 @@ function InsertSeparators( const s: KOLString; chars_between: Integer; Int2Ths function. } {$IFDEF WIN} {$IFNDEF _FPC} +//{$IFNDEF PAS_ONLY} function Format( const fmt: KOLString; params: array of const ): KOLString; +//{$ENDIF} {* Uses API call to wvsprintf, so does not understand extra formats, such as floating point, date/time, currency conversions. See list of available formats in win32.hlp (topic wsprintf). @@ -11414,6 +11441,11 @@ function Format( const fmt: KOLString; params: array of const ): KOLString; {$ENDIF WIN} function StrComp(const Str1, Str2: PAnsiChar): Integer; {* Compares two strings fast. -1: Str1Str2 } + +{$IFDEF PAS_ONLY} +function StrComp_NoCase(const Str1, Str2: PAnsiChar): Integer; +function StrLComp_NoCase(const Str1, Str2: PAnsiChar; MaxLen: Cardinal): Integer; +{$ELSE} {$IFDEF SMALLER_CODE} function StrComp_NoCase(const Str1, Str2: PAnsiChar): Integer; {* Compares two strings fast without case sensitivity. @@ -11431,6 +11463,7 @@ var StrComp_NoCase: function(const Str1, Str2: PAnsiChar): Integer = StrComp_NoC function StrLComp_NoCase1(const Str1, Str2: PAnsiChar; MaxLen: Cardinal): Integer; var StrLComp_NoCase: function(const Str1, Str2: PAnsiChar; MaxLen: Cardinal): Integer = StrLComp_NoCase1; {$ENDIF} +{$ENDIF} function StrLComp(const Str1, Str2: PAnsiChar; MaxLen: Cardinal): Integer; {* Compare two strings (fast). Terminating 0 is not considered, so if @@ -11451,7 +11484,7 @@ function StrScanLen(Str: PAnsiChar; Chr: AnsiChar; Len: Integer): PAnsiChar; function StrScan(Str: PAnsiChar; Chr: AnsiChar): PAnsiChar; {* Fast search of given character in a string. Pointer to found character (or nil) is returned. } -function StrRScan(const Str: PAnsiChar; Chr: AnsiChar): PAnsiChar; +function StrRScan(Str: PAnsiChar; Chr: AnsiChar): PAnsiChar; {* StrRScan returns a pointer to the last occurrence of Chr in Str. If Chr does not occur in Str, StrRScan returns NIL. The null terminator is considered to be part of the string. } @@ -11727,10 +11760,9 @@ const KOI8_Rus: array[ #$C0..#$FF ] of AnsiChar = ( ); function StrPCopy(Dest: PAnsiChar; const Source: Ansistring): PAnsiChar; -{* Copyes Pascal-style string into null-terminaed one. } +{* Copyes string into null-terminated. } function StrLCopy(Dest: PAnsiChar; const Source: PAnsiChar; MaxLen: Cardinal): PAnsiChar; -{* Copyes first MaxLen characters of Pascal-style string into - null-terminated one. } +{* Copyes first MaxLen characters of the Source string into null-terminated Dest. } function DelimiterLast( const Str, Delimiters: KOLString ): Integer; {* Returns index of the last of delimiters given by same named parameter @@ -11956,11 +11988,15 @@ function Str2DateTimeFmt( const sFmtStr, sS: KOLString ): TDateTime; E.g., 'D, yyyy/MM/dd h:mm:ss'. See also Str2DateTimeShort function. } +function Str2TimeFmt(const sFmtStr, sS: KOLString): TDateTime; +{* Same as above but for time only } function Str2DateTimeShort( const S: KOLString ): TDateTime; {* Restores date and time from string correspondently to current user locale. } function Str2DateTimeShortEx( const S: KOLString ): TDateTime; {* Like Str2DateTimeShort above, but uses locale defined date and time - separators to avoid recognizing time as a date in some cases. + separators to avoid recognizing time as a date in some cases.} +function Str2TimeShort(const S: KOLString): TDateTime; +{* Like Str2DateTimeShort but for time only. |
@@ -12298,7 +12334,9 @@ function DeleteFile2Recycle( const Filename : KOLString ) : Boolean; used or not fully qualified paths to files. } function CopyMoveFiles( const FromList, ToList: KOLString; Move: Boolean ): Boolean; {* } -function DiskFreeSpace( const Path: KOLString ): I64; +{$IFNDEF PAS_ONLY} +function DiskFreeSpace( const Path: KOLString ): I64; +{$ENDIF} {* Returns disk free space in bytes. Pass a path to root directory, e.g. 'C:\'. |
@@ -12539,8 +12577,10 @@ function NewDirListEx( const DirPath, Filters: KOLString; Attr: DWORD ): PDirLis const DefSortDirRules : array[ 0..3 ] of TSortDirRules = ( sdrFoldersFirst, sdrByName, sdrBySize, sdrByDateCreate ); {* Default rules to sort directory entries. } +{$IFNDEF PAS_ONLY} function DirectorySize( const Path: KOLString ): I64; {* Returns directory size in bytes as large 64 bit integer. } +{$ENDIF} {$IFDEF WIN_GDI} //vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv type @@ -13439,7 +13479,9 @@ function ParamCount: Integer; {$IFDEF WIN_GDI} //{$DEFINE CHK_BITBLT} +{$IFDEF CHK_BITBLT} procedure Chk_BitBlt; +{$ENDIF} {$IFDEF ASM_VERSION} {$DEFINE ASM_DC} {$ENDIF} @@ -14251,6 +14293,7 @@ type TOverrideScrollbarsProc = procedure(Sender: PControl); procedure DummyOverrideScrollbars(Sender: PControl); var OverrideScrollbars: TOverrideScrollbarsProc = DummyOverrideScrollbars; +{$IFNDEF PAS_ONLY} function CrackStack_MapInResource( const MapName: KOLString; Max_length: Integer; HandleSuspiciousAddresses: Boolean ): KOLString; {* Allows to list all procedures and functions called before current cracking @@ -14268,11 +14311,13 @@ function CrackStack_MapInFile( const MapFileName: KOLString; Max_length: Integer to show all suspicious addresses found in stack (this may help to find errors not shown even by Delphi debugger since stack frames in some cases give no enough data). } - +{$ENDIF} //......... these declarations are here to stop hints from Delphi5 while compiling MCK: function CallTControlCreateWindow( Ctl: PControl ): Boolean; function DumpWindowed( c: PControl ): PControl; +{$IFNDEF PAS_ONLY} function WndProcAppAsm( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; +{$ENDIF} //22{$IFDEF ASM_VERSION} const ButtonClass: array[ 0..6 ] of KOLChar = ( 'B','U','T','T','O','N',#0 ); //22{$ENDIF ASM_VERSION} @@ -14280,7 +14325,7 @@ const ButtonClass: array[ 0..6 ] of KOLChar = ( 'B','U','T','T','O','N',#0 ); function WndProcUnicodeChars( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; {$ENDIF} procedure SetMouseEvent( Self_: PControl ); -function CompareIntegers( const Sender : Pointer; const e1, e2 : DWORD ) : Integer; +function CompareIntegers( const Sender : Pointer; const e1, e2 : DWORD ) : Integer; function CompareDwords( const Sender : Pointer; const e1, e2 : DWORD ) : Integer; procedure SwapIntegers( const Sender : Pointer; const e1, e2 : DWORD ); function _GetDIBPixelsTrueColorAlpha( Bmp: PBitmap; X, Y: Integer ): TColor; @@ -14665,6 +14710,7 @@ function ChooseColor(var CC: TChooseColor): Bool; stdcall; external 'comdlg32.dll' name 'ChooseColorA'; {$IFDEF GDI} +{$IFDEF CHK_BITBLT} procedure Chk_BitBlt_ShowError; var Rslt: Integer; begin @@ -14687,6 +14733,7 @@ begin end; end; end; +{$ENDIF CHK_BITBLT} {$ENDIF GDI} {$ifdef _D2} @@ -14748,6 +14795,7 @@ end; {$endif} {$IFDEF _D2009orHigher} +{$IFNDEF PAS_ONLY} procedure _aLStrFromPCharLen(var Dest: AnsiString; Source: PAnsiChar; Length: Integer); asm push 0 @@ -14762,6 +14810,7 @@ asm pop ecx end; {$ENDIF} +{$ENDIF} procedure InitCommonControls; external cctrl name 'InitCommonControls'; @@ -14917,6 +14966,7 @@ function WndProcDateTimePickerNotify( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; forward; //////////////////////////////////////////////////////////////////////////////// +{$IFNDEF PAS_ONLY} var MapFile: PKOLStrList; LineNumbersFrom: Integer; MaxCrackStackLen: Integer; @@ -15196,6 +15246,7 @@ begin if MapFile = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>} Result := CrackStack( Max_length, HandleSuspiciousAddresses ); end; +{$ENDIF _no_PAS_ONLY} {$IFDEF GRAPHCTL_XPSTYLES} {$I visual_xp_styles.inc} @@ -15324,6 +15375,12 @@ end; {$ENDIF GDI} {$IFDEF WIN_GDI} +{$IFDEF PAS_ONLY} +procedure SpeakerBeep( Freq: Word; Duration: DWORD ); +begin + Windows.Beep( Freq, Duration ); +end; +{$ELSE} procedure SpeakerBeep( Freq: Word; Duration: DWORD ); begin if WinVer >= wvNT then @@ -15353,6 +15410,7 @@ begin end {$IFDEF F_P} [ 'EAX' ] {$ENDIF} ; end; end; +{$ENDIF} {$ENDIF WIN_GDI} function SysErrorMessage(ErrorCode: Integer): KOLString; @@ -16239,6 +16297,7 @@ begin end; {$ENDIF} +{$IFNDEF PAS_ONLY} procedure HelpFastIncNum2Els( DataArray: Pointer; Value, Count: Integer ); asm PUSH ESI @@ -16269,6 +16328,7 @@ begin HelpFastIncNum2Els( @List.fItems[ FromIdx ], Value, Count ); end; {$ENDIF} +{$ENDIF PAS_ONLY} {$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal destructor TList.Destroy; @@ -16739,7 +16799,7 @@ var I: Integer; {$ENDIF} begin Result := -1; - {$IFDEF DEBUG} + {$IFDEF DEBUG_ANY} TRY {$ENDIF} {$IFDEF TLIST_FAST} @@ -16772,7 +16832,7 @@ begin end; end; end; - {$IFDEF DEBUG} + {$IFDEF DEBUG_ANY} EXCEPT END; {$ENDIF} @@ -19380,6 +19440,8 @@ begin Result.Hi := Hi; end; +{$IFDEF PAS_ONLY} +{$ELSE} function Int2Int64( X: Integer ): I64; asm MOV [EDX], EAX @@ -19614,6 +19676,7 @@ asm FLD D FISTP qword ptr [EAX] end; +{$ENDIF PAS_ONLY} function IsNan(const AValue: Double): Boolean; {$IFDEF _D2orD3} @@ -19633,8 +19696,11 @@ begin (PI64(@AValue).Hi and $000FFFFF = $00000000); end; +{$IFDEF PAS_ONLY} {$DEFINE PAS_INTPOW} {$ENDIF} +{$IFDEF F_P} {$DEFINE PAS_INTPOW} {$ENDIF} + function IntPower(Base: Extended; Exponent: Integer): Extended; -{$IFDEF F_P} +{$IFDEF PAS_ONLY} begin Result := 1.0; if Exponent = 0 then exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>} @@ -19668,7 +19734,7 @@ asm fstp st { pop X from FPU stack } @@3: fwait end; -{$ENDIF F_P/DELPHI} +{$ENDIF PAS_ONLY} function NextPowerOf2( n: DWORD ): DWORD; begin @@ -19759,6 +19825,7 @@ begin Result := -Result; end; +{$IFNDEF PAS_ONLY} function TruncD( D: Double ): Double; asm FLD D @@ -19775,6 +19842,7 @@ asm POP ECX POP ECX end; +{$ENDIF} function IfThenElseBool( t, e: Boolean; Cond: Boolean ): Boolean; begin @@ -19885,11 +19953,16 @@ begin while TRUE do begin + {$IFDEF PAS_ONLY} + if TRUNC(Abs(E)) >= 10000000 then + break; + {$ELSE} asm FLD [E] FBSTP [Buf1] end; if Buf1[ 7 ] <> 0 then break; + {$ENDIF} E := E * I10; Dec( N ); end; @@ -20422,6 +20495,15 @@ begin end; {$ENDIF PAS_VERSION} +{$IFDEF PAS_ONLY} +function StrCopy( Dest, Source: PAnsiChar ): PAnsiChar; +var L: Integer; +begin + L := StrLen(Source); + Move(Source^, Dest^, L+1); + Result := Dest; +end; +{$ELSE} function StrCopy( Dest, Source: PAnsiChar ): PAnsiChar; assembler; asm {$IFDEF F_P} @@ -20448,6 +20530,7 @@ asm POP ESI POP EDI end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF}; +{$ENDIF PAS_ONLY} function StrCat( Dest, Source: PAnsiChar ): PAnsiChar; begin @@ -20455,6 +20538,17 @@ begin Result := Dest; end; +{$IFDEF PAS_ONLY} +function StrScan(Str: PAnsiChar; Chr: AnsiChar): PAnsiChar; +begin + while Str^ <> Chr do + begin + if Str^ = #0 then break; + inc(Str); + end; + Result := Str; +end; +{$ELSE} function StrScan(Str: PAnsiChar; Chr: AnsiChar): PAnsiChar; assembler; asm {$IFDEF F_P} @@ -20481,8 +20575,22 @@ asm @@1: DEC EAX end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF}; +{$ENDIF PAS_ONLY} -function StrRScan(const Str: PAnsiChar; Chr: AnsiChar): PAnsiChar; assembler; +{$IFDEF PAS_ONLY} +function StrRScan(Str: PAnsiChar; Chr: AnsiChar): PAnsiChar; +begin + Result := nil; + while Str^ <> #0 do + begin + if Str^ = Chr then Result := Str; + inc(Str); + end; + if Result = nil then + Result := Str; +end; +{$ELSE} +function StrRScan(Str: PAnsiChar; Chr: AnsiChar): PAnsiChar; assembler; asm {$IFDEF F_P} MOV EAX, [Str] @@ -20505,7 +20613,20 @@ asm @@1: CLD POP EDI end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF}; +{$ENDIF PAS_ONLY} +{$IFDEF PAS_ONLY} +function StrScanLen(Str: PAnsiChar; Chr: AnsiChar; Len: Integer): PAnsiChar; +begin + while (Str^ <> #0) and (Len > 0) do + begin + if Str^ = Chr then break; + inc(Str); + dec(Len); + end; + Result := Str; +end; +{$ELSE} function StrScanLen(Str: PAnsiChar; Chr: AnsiChar; Len: Integer): PAnsiChar; assembler; asm {$IFDEF F_P} @@ -20522,6 +20643,7 @@ asm { -> EAX => to next character after found or to the end of Str, ZF = 0 if character found. } end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF}; +{$ENDIF} {$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal function TrimLeft(const S: KOLString): KOLString; @@ -20561,6 +20683,17 @@ begin if S[ I ] <= ' ' then Delete( Result, I, 1 ); end; +{$IFDEF PAS_ONLY} +procedure Str2LowerCase( S: PAnsiChar ); +begin + while S^ <> #0 do + begin + if (S^ >= 'A') and (S^ <= 'Z') then + S^ := AnsiChar(Ord(S^)+32); + inc(S); + end; +end; +{$ELSE} procedure Str2LowerCase( S: PAnsiChar ); asm {$IFDEF F_P} @@ -20578,6 +20711,7 @@ asm JMP @@1 @@exit: end {$IFDEF F_P} [ 'EAX', 'ECX' ] {$ENDIF}; +{$ENDIF PAS_ONLY} {$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal function LowerCase(const S: Ansistring): Ansistring; @@ -21028,6 +21162,24 @@ begin end; end; +{$IFDEF PAS_ONLY} +function CompareMem(P1, P2: Pointer; Length: Integer): Boolean; +var PP1, PP2: PByte; +begin + Result := FALSE; + PP1 := P1; + PP2 := P2; + while (Length > 0) do + begin + if (PP1^ <> PP2^) then + Exit; //>>>>>>>>>>>>>>>>>>>>>>>> + inc(PP1); + inc(PP2); + dec(Length); + end; + Result := TRUE; +end; +{$ELSE} function CompareMem(P1, P2: Pointer; Length: Integer): Boolean; assembler; asm {$IFDEF F_P} @@ -21053,6 +21205,7 @@ asm @@2: POP EDI POP ESI end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF}; +{$ENDIF} {$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal function AllocMem( Size : Integer ) : Pointer; @@ -21187,6 +21340,18 @@ begin end; {$ENDIF} +{$IFDEF PAS_ONLY} +function _WStrLComp(S1, S2: PWideChar; Len: Integer): Integer; +begin + while (Len > 0) and (S1^ <> #0) and (S2^ <> #0) do + begin + Result := Ord(S1^) - Ord(S2^); + if Result <> 0 then Exit; // >>>>>>>>>>>>>>>>>>>> + dec(Len); + end; + Result := 0; +end; +{$ELSE} function _WStrLComp(S1, S2: PWideChar; Len: Integer): Integer; asm {$IFDEF F_P} @@ -21206,7 +21371,7 @@ asm POP ESI POP EDI end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF}; - +{$ENDIF} function WStrScan(Str: PWideChar; Chr: WideChar): PWideChar; begin @@ -21274,9 +21439,18 @@ begin end; procedure SwapAnsiRec( R: PSortAnsiRec; const e1, e2: Integer ); +{$IFDEF PAS_ONLY} +var a: PAnsiChar; +{$ENDIF} begin + {$IFDEF PAS_ONLY} + a := R.A[AnsiChar(e1)]; + R.A[AnsiChar(e1)] := R.A[AnsiChar(e2)]; + R.A[AnsiChar(e2)] := a; + {$ELSE} Swap( Integer( R.A[AnsiChar(e1)] ), Integer( R.A[AnsiChar(e2)] ) ); + {$ENDIF} end; {$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} @@ -21406,6 +21580,9 @@ var c: AnsiChar; R: TSortAnsiRec; Buf: array[ 0..767 ] of AnsiChar; P: PAnsiChar; + {$IFDEF PAS_ONLY} + a: PAnsiChar; + {$ENDIF} begin P := @Buf[0]; for c := Low(c) to High(c) do @@ -21427,7 +21604,13 @@ begin begin if _AnsiCompareStrA( R.A[Pred(c)], R.A[c] ) < 0 then begin + {$IFDEF PAS_ONLY} + a := R.A[Pred(c)]; + R.A[Pred(c)] := R.A[c]; + R.A[c] := a; + {$ELSE} Swap( Integer( R.A[Pred(c)] ), Integer( R.A[c] ) ); + {$ENDIF} end; end; // R.X[c] := R.X[Pred(c)]; @@ -21448,6 +21631,22 @@ begin Result := AnsiCompareStrNoCaseA( S1, S2 ); end; +{$IFDEF PAS_ONLY} +function StrLCopy(Dest: PAnsiChar; const Source: PAnsiChar; MaxLen: Cardinal): PAnsiChar; +var Src: PAnsiChar; +begin + Src := Source; + while MaxLen > 0 do + begin + Dest^ := Src^; + if Src^ = #0 then break; + inc(Dest); + inc(Src); + dec(MaxLen); + end; + Result := Dest; +end; +{$ELSE} function StrLCopy(Dest: PAnsiChar; const Source: PAnsiChar; MaxLen: Cardinal): PAnsiChar; assembler; asm {$IFDEF F_P} @@ -21483,6 +21682,7 @@ asm POP ESI POP EDI end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF}; +{$ENDIF} {$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal function StrPCopy(Dest: PAnsiChar; const Source: Ansistring): PAnsiChar; @@ -21670,7 +21870,7 @@ begin Move( W[ From ], Result[ 1 ], Count * Sizeof( WideChar ) ); end; -function posW( const S1, S2: AnsiString ): Integer; +function posW( const S1, S2: AnsiString ): Integer; // not used. When use, change AnsiString to WideString ? var I, L1: Integer; begin L1 := Length( S1 ); @@ -21851,6 +22051,22 @@ begin end; end; +{$IFDEF PAS_ONLY} +function StrComp(const Str1, Str2: PAnsiChar): Integer; +var S1, S2: PAnsiChar; +begin + S1 := Str1; + S2 := Str2; + while (S1^ <> #0) and (S2^ <> #0) do + begin + Result := Integer(Ord(S1^)) - Integer(Ord(S2^)); + if Result <> 0 then Exit; + inc(S1); + inc(S2); + end; + Result := 0; +end; +{$ELSE} function StrComp(const Str1, Str2: PAnsiChar): Integer; assembler; asm {$IFDEF F_P} @@ -21874,6 +22090,7 @@ asm POP ESI POP EDI end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF}; +{$ENDIF PAS_ONLY} var Upper: array[ AnsiChar ] of AnsiChar; Upper_initialized: Boolean; @@ -21893,6 +22110,72 @@ begin end; end; +{$IFDEF PAS_ONLY} +function StrLComp(const Str1, Str2: PAnsiChar; MaxLen: Cardinal): Integer; +var S1, S2: PAnsiChar; + c1, c2: AnsiChar; +begin + S1 := Str1; + S2 := Str2; + while (S1^ <> #0) and (S2^ <> #0) and (MaxLen > 0) do + begin + c1 := S1^; + c2 := S2^; + Result := Integer(c1) - Integer(c2); + if Result <> 0 then Exit; + inc(S1); + inc(S2); + dec(MaxLen); + end; + Result := 0; +end; + +function StrLComp_NoCase(const Str1, Str2: PAnsiChar; MaxLen: Cardinal): Integer; +var S1, S2: PAnsiChar; + c1, c2: AnsiChar; +begin + S1 := Str1; + S2 := Str2; + while (S1^ <> #0) and (S2^ <> #0) and (MaxLen > 0) do + begin + c1 := S1^; + if (c1 >= 'a') and (c1 <= 'z') then + c1 := AnsiChar(Ord(c1)-32); + c2 := S2^; + if (c2 >= 'a') and (c2 <= 'z') then + c2 := AnsiChar(Ord(c2)-32); + Result := Integer(c1) - Integer(c2); + if Result <> 0 then Exit; + inc(S1); + inc(S2); + dec(MaxLen); + end; + Result := 0; +end; + +function StrComp_NoCase(const Str1, Str2: PAnsiChar): Integer; +var S1, S2: PAnsiChar; + c1, c2: AnsiChar; +begin + S1 := Str1; + S2 := Str2; + while (S1^ <> #0) and (S2^ <> #0) do + begin + c1 := S1^; + if (c1 >= 'a') and (c1 <= 'z') then + c1 := AnsiChar(Ord(c1)-32); + c2 := S2^; + if (c2 >= 'a') and (c2 <= 'z') then + c2 := AnsiChar(Ord(c2)-32); + Result := Integer(c1) - Integer(c2); + if Result <> 0 then Exit; + inc(S1); + inc(S2); + end; + Result := 0; +end; +{$ELSE} + {$IFDEF SMALLER_CODE} function StrComp_NoCase(const Str1, Str2: PAnsiChar): Integer; asm @@ -22081,6 +22364,7 @@ asm POP ESI POP EDI end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF}; +{$ENDIF PAS_ONLY} function StrLen(const Str: PAnsiChar): Cardinal; assembler; asm @@ -22292,6 +22576,19 @@ begin end; {$ENDIF ASM_UNICODE} +{$IFDEF PAS_ONLY} +function StrIsStartingFromNoCase( Str, Pattern: PAnsiChar ): Boolean; +begin + Result := FALSE; + while (Str^ <> #0) and (Pattern^ <> #0) do + begin + if Str^ <> Pattern^ then Exit; + inc(Str^); + inc(Pattern^); + end; + Result := Pattern^ = #0; +end; +{$ELSE} function StrIsStartingFromNoCase( Str, Pattern: PAnsiChar ): Boolean; asm {$IFDEF F_P} @@ -22323,8 +22620,12 @@ asm TEST CL, CL SETZ AL end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF}; -{$IFDEF WIN} +{$ENDIF PAS_ONLY} + + {$IFNDEF _FPC} + +{$IFDEF WIN} {$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal function Format( const fmt: KOLString; params: Array of const ): KOLString; var Buffer: array[ 0..1023 ] of KOLChar; @@ -22374,6 +22675,12 @@ begin WideCharToMultiByte(0, 0, Source, Length, Pointer(Result), DestLen, nil, nil); end; +{$IFDEF PAS_ONLY} +function LStrFromPWChar(Source: PWideChar): AnsiString; +begin + Result := AnsiString(WideString(Source)); +end; +{$ELSE} function LStrFromPWChar(Source: PWideChar): AnsiString; {* from Delphi5 - because D2 does not contain it. } asm @@ -22402,7 +22709,9 @@ asm @@5: POP ECX JMP LStrFromPWCharLen end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF}; -{$ENDIF _FPC} +{$ENDIF PAS_ONLY} + +{$ENDIF not_FPC} function WCharIn( C: KOLChar; const Chars: array of KOLChar ): Boolean; var i: Integer; @@ -23127,6 +23436,7 @@ begin Result := Buffer; end; +{$IFNDEF PAS_ONLY} function DirectorySize( const Path: KOLString ): I64; var DirList: PDirList; I: Integer; @@ -23142,6 +23452,7 @@ begin end; DirList.Free; end; +{$ENDIF} {$IFDEF WIN} //vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv function GetFileList(const dir: KOLString): PKOLStrList; @@ -23577,6 +23888,7 @@ begin end; +{$IFNDEF PAS_ONLY} function DiskFreeSpace( const Path: KOLString ): I64; type TGetDFSEx = function( Path: PKOLChar; CallerFreeBytes, TotalBytes, FreeBytes: Pointer ) : Bool; stdcall; @@ -23617,6 +23929,7 @@ begin Result := Mul64i( MakeInt64( SpC * BpS, 0 ), NFC ); end; end; +{$ENDIF} function DoFileOp( const FromList, ToList: KOLString; FileOp: UINT; Flags: Word; Title: PKOLChar): Boolean; @@ -23952,9 +24265,9 @@ asm @@star_d_star: DB '*.*', 0 // PCHAR - + {$IFDEF _D2009orHigher} - DW 0, 1 + DW 0, 1 {$ENDIF} DD -1, 1 @@star: DB '*', 0 @@ -24268,6 +24581,16 @@ begin end; sdrBySize, sdrBySizeDescending: begin + {$IFDEF _D5orHigher} + sz1 := MakeInt64( Item1.nFileSizeLow, Item1.nFileSizeHigh ); + sz2 := MakeInt64( Item2.nFileSizeLow, Item2.nFileSizeHigh ); + if Int64(sz1) < Int64(sz2) then + Result := -1 + else if Int64(sz1) > Int64(sz2) then + Result := 1 + else + Result := 0; + {$ELSE} {$IFDEF _D4orHigher} sz1 := MakeInt64( Item1.nFileSizeLow, Item1.nFileSizeHigh ); sz2 := MakeInt64( Item2.nFileSizeLow, Item2.nFileSizeHigh ); @@ -24282,6 +24605,7 @@ begin else if Item1.nFileSizeLow > Item2.nFileSizeLow then Result := 1; {$ENDIF} + {$ENDIF} if Data.Rules[ I ] = sdrBySizeDescending then Result := -Result; end; @@ -24866,8 +25190,12 @@ end; but it is based on 31-Dec-0000 instead, allowing easy manipulating of dates at all Christian era, and all other historical era too. } +{$UNDEF PAS_LOCAL} +{$IFDEF F_P} {$DEFINE PAS_LOCAL} {$ENDIF} +{$IFDEF PAS_ONLY} {$DEFINE PAS_LOCAL} {$ENDIF} + procedure DivMod(Dividend: Integer; Divisor: Word; var Result, Remainder: Word); -{$IFDEF F_P} +{$IFDEF PAS_ONLY} begin Result := Dividend div Divisor; Remainder := Dividend mod Divisor; @@ -25599,6 +25927,11 @@ begin SystemTime2DateTime( ST, Result ); end; +function Str2TimeFmt(const sFmtStr, sS: KOLString): TDateTime; +begin + Result := Frac(Str2DateTimeFmt( 'y/M/d ' + sFmtStr, '2000/1/1 ' + sS )); +end; + var FmtBuf: PKOLChar; DateSeparator : KOLChar = #0; // + ECM @@ -25636,9 +25969,14 @@ begin Result := Str2DateTimeFmt( FmtStr + ' ' + FmtStr2, S ); end; +function Str2TimeShort(const S: KOLString): TDateTime; +begin + Result := Frac( Str2DateTimeShort( Date2StrFmt( '', Now ) + ' ' + S ) ); +end; + // + ECM function Str2DateTimeShortEx( const S: KOLString ): TDateTime; -var St: KOLString; +var Buff: Array[0..1] of KOLChar; begin if DateSeparator = #0 then @@ -25646,10 +25984,11 @@ begin if GetLocaleInfo(GetThreadLocale,LOCALE_SDATE,Buff,2) > 0 then DateSeparator := Buff[0]; end; - St := S; if Pos(DateSeparator,S) = 0 then - St := '0.0.0 '+S; - Result := Str2DateTimeShort(St); + //St := '0.0.0 '+S; + Result := Str2TimeShort(S) + else + Result := Str2DateTimeShort(S); end; /////////////////////////////////////////////////////////////////////// @@ -25891,7 +26230,7 @@ end; procedure TThread.SetPriorityCls(Value: Integer); begin - {$IFDEF DEBUG} + {$IFDEF DEBUG_ANY} if not SetPriorityClass(GetCurrentProcess, Value) then begin ShowMessage( SysErrorMessage( GetLastError ) ); @@ -25902,7 +26241,7 @@ begin {$ELSE} SetPriorityClass(GetCurrentProcess, Value); {$ENDIF} - {$ENDIF} + {$ENDIF DEBUG_ANY} end; procedure TThread.SetThrdPriority(Value: Integer); @@ -29786,6 +30125,7 @@ END; //===================== Applet button ========================// //22{$IFDEF ASM_VERSION} +{$IFNDEF PAS_ONLY} function WndProcAppAsm(Self_: PControl; var Msg: TMsg; var Rslt: Integer): Boolean; asm CMP word ptr [EDX].TMsg.message, WM_SETFOCUS @@ -29836,6 +30176,7 @@ END; XOR EAX, EAX @@exit: end; +{$ENDIF not PAS_ONLY} //22{$ENDIF} function WndProcAppPas(Self_: PControl; var Msg: TMsg; var Rslt: Integer): Boolean; @@ -35618,7 +35959,7 @@ begin /////fHint.Free; {$UNDEF destroy} {$ENDIF USE_MHTOOLTIP} - {$IFDEF DEBUG} + {$IFDEF DEBUG_ANY} F := nil; TRY F := ParentForm; // or Applet - for form ??? @@ -35629,7 +35970,7 @@ begin END; {$ELSE} F := ParentForm; // or Applet - for form ??? - {$ENDIF} + {$ENDIF DEBUG_ANY} if F <> nil then if F.DF.FCurrentControl = @Self then F.DF.FCurrentControl := nil; @@ -35703,6 +36044,7 @@ begin LogFileOutput( GetStartDir + 'es_debug.txt', 'DESTROYING HWND:' + Int2Str( I ) ); {$ENDIF} + (* -- moved to WM_NCDESTROY -- VK + Alexey Kirov, 23.02.2012 {$IFnDEF SMALLER_CODE} {$IFDEF USE_PROP} SetProp( I, ID_SELF, 0 ); @@ -35710,6 +36052,7 @@ begin SetWindowLong( I, GWL_USERDATA, 0 ); {$ENDIF} {$ENDIF} + *) DestroyWindow( I ); end; end; @@ -35867,7 +36210,7 @@ begin end; {$ENDIF DEBUG_CREATEWINDOW} -var LockedWindow: HWnd; +//var LockedWindow: HWnd; {$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal function TControl.CreateWindow: Boolean; @@ -36296,19 +36639,28 @@ end; {$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal function WndProcKeybd(Self_: PControl; var Msg: TMsg; var Rslt: Integer): Boolean; var C : KOLChar; + Key: Integer; begin Result := True; case Msg.message of WM_KEYDOWN, WM_SYSKEYDOWN: + begin {$IFDEF NIL_EVENTS} if assigned( Self_.EV.fOnKeyDown ) then {$ENDIF} - Self_.EV.fOnKeyDown( Self_, Msg.wParam, GetShiftState ); + Key := Msg.wParam; + Self_.EV.fOnKeyDown( Self_, Key, GetShiftState ); + Msg.wParam := Key; + end; WM_KEYUP, WM_SYSKEYUP: + begin {$IFDEF NIL_EVENTS} if assigned( Self_.EV.fOnKeyUp ) then {$ENDIF} - Self_.EV.fOnKeyUp( Self_, Msg.wParam, GetShiftState ); + Key := Msg.wParam; + Self_.EV.fOnKeyUp( Self_, Key, GetShiftState ); + Msg.wParam := Key; + end; WM_CHAR, WM_SYSCHAR: {$IFDEF NIL_EVENTS} if assigned( Self_.EV.fOnChar ) then @@ -36552,6 +36904,7 @@ begin end; Default; end; + (* {$IFDEF USE_PROP} WM_NCDESTROY: begin @@ -36559,23 +36912,33 @@ begin //RefDec; end; {$ENDIF} - WM_DESTROY: - begin - {$IFDEF USE_FLAGS} include( fFlagsG2, G2_BeginDestroying ); - {$ELSE} fBeginDestroying := TRUE; {$ENDIF} - {$IFDEF SAFE_CODE} - (*{$IFDEF USE_PROP} - PropInt[ ID_SELF ] := 0; - {$ELSE} - SetWindowLong( fHandle, GWL_USERDATA, 0 ); - {$ENDIF}*) + *) + WM_NCDESTROY: + {$IFnDEF SMALLER_CODE} + if fHandle = Msg.hwnd then + {$ENDIF} + begin + {$IFnDEF SMALLER_CODE} + {$IFDEF USE_PROP} + RemoveProp( fHandle, ID_SELF ); //********* Added By M.Gerasimov + {$ELSE} + SetWindowLong( fHandle, GWL_USERDATA, 0 ); // VK + Alexey Kirov, 23.02.2012 {$ENDIF} - Default; - {$IFDEF INPACKAGE} - LogOK; - {$ENDIF INPACKAGE} - Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>} - end; + {$ENDIF} //------------------------------------------- + Default; + Exit; + end; + WM_DESTROY: + {$IFnDEF SMALLER_CODE} + if fHandle = Msg.hwnd then + {$ENDIF} + begin + {$IFDEF USE_FLAGS} include( fFlagsG2, G2_BeginDestroying ); + {$ELSE} fBeginDestroying := TRUE; {$ENDIF} + Default; + {$IFDEF INPACKAGE} LogOK; {$ENDIF INPACKAGE} + Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>} + end; WM_SIZE: begin {$IFDEF INPACKAGE} Log( 'WM_SIZE >>> Default' ); @@ -38477,6 +38840,7 @@ end; {$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal function TControl.ProcessMessage: Boolean; var Msg: TMsg; + P: Windows.PMsg; begin Result := False; if PeekMessage( Msg, 0, 0, 0, PM_REMOVE ) then @@ -38490,12 +38854,13 @@ begin {$ENDIF PROVIDE_EXITCODE} end else - begin + begin if not( {$IFDEF NIL_EVENTS} Assigned( PP.fExMsgProc ) and {$ENDIF} PP.fExMsgProc( @Self, Msg )) then begin - TranslateMessage( Windows.TMsg( Msg ) ); + P := Pointer( @Msg ); + TranslateMessage( P^ ); DispatchMessage( Msg ); {$IFDEF PSEUDO_THREADS} if Assigned( MainThread ) then @@ -40551,7 +40916,7 @@ var wp: WPARAM; begin wp := Perform(BM_GETCHECK, 0, 0) and not 3; - wp := wp or ord(value); + wp := wp or byte(value); Perform(BM_SETCHECK, wp, 0); end; @@ -40683,18 +41048,19 @@ end; function TControl.GetItemsCount: Integer; begin Result := 0; - {$IFDEF DEBUG} + {$IFDEF DEBUG_ANY} try - {$ENDIF} if fCommandActions.aGetCount = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>} Result := Perform( fCommandActions.aGetCount, 0, 0 ); - {$IFDEF DEBUG} except asm int 3 end; end; - {$ENDIF} + {$ELSE} + if fCommandActions.aGetCount = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>} + Result := Perform( fCommandActions.aGetCount, 0, 0 ); + {$ENDIF DEBUG_ANY} end; {$ENDIF PAS_VERSION} @@ -43537,6 +43903,17 @@ end; {$ENDIF WIN_GDI} ////////////////////////////////// EXTENDED STRING LIST OBJECT //////////////// +{$IFDEF PAS_ONLY} +procedure WStrCopy( Dest, Src: PWideChar ); +begin + while Src^ <> #0 do + begin + Dest^ := Src^; + inc(Src); + inc(Dest); + end; +end; +{$ELSE} procedure WStrCopy( Dest, Src: PWideChar ); asm PUSH EDI @@ -43553,6 +43930,7 @@ asm POP ESI POP EDI end; +{$ENDIF} procedure WStrLCopy( Dest, Src: PWideChar; MaxLen: Integer ); begin @@ -43568,6 +43946,19 @@ begin end; end; +{$IFDEF PAS_ONLY} +function WStrCmp( W1, W2: PWideChar ): Integer; +begin + while (W1^ <> #0) and (w2^ <> #0) do + begin + Result := Integer(Ord(w1^)) - Integer(Ord(w2^)); + if Result <> 0 then Exit; + inc(w1); + inc(w2); + end; + Result := 0; +end; +{$ELSE} function WStrCmp( W1, W2: PWideChar ): Integer; asm PUSH ESI @@ -43587,6 +43978,7 @@ asm POP EDI POP ESI end; +{$ENDIF} {$IFDEF _D3orHigher} function WStrCmp_NoCase( W1, W2: PWideChar ): Integer; @@ -43668,6 +44060,11 @@ begin else SortData( @Self, fCount, @CompareStrListItems_NoCase, @SwapStrListExItems ); end; +procedure TStrListEx.SortEx(const CompareFun: TCompareEvent); +begin + SortData(@Self, Count, CompareFun, @TStrListEx.Swap); +end; + procedure TStrListEx.Move(CurIndex, NewIndex: integer); begin // move string @@ -44311,6 +44708,48 @@ begin {$ENDIF} end; +function TWStrList.IndexOfName(AName: KOLWideString): Integer; +var i: Integer; + L: Integer; + fCount: integer; +begin + Result:=-1; + L := Length( AName ); + if L > 0 then + begin + AName := WLowerCase( AName ) + fNameDelim; + Inc( L ); + fCount := GetCount - 1; + for i := 0 to fCount do + begin + if _WStrLComp( PWideChar( WLowerCase( ItemPtrs[ i ] ) ), PWideChar( AName ), L ) = 0 then + begin + Result:=i; exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>} + end; + end; + end; +end; + +procedure TWStrList.SetValue(const AName, Value: KOLWideString); +var + I: Integer; +begin + I := IndexOfName(AName); + if i=-1 + then Add( AName + fNameDelim + Value ) + else Items[i] := AName + fNameDelim + Value; +end; + +function TWStrList.GetValue(const AName: KOLWideString): KOLWideString; +var + i: Integer; +begin + I := IndexOfName(AName); + if I >= 0 + then Result := Copy(Items[i], Length(AName) + 2, Length(Items[i])-Length(AName)-1) + else Result := ''; +end; + { TWStrListEx } function TWStrListEx.AddObject(const S: KOLWideString; Obj: DWORD): Integer; @@ -46707,10 +47146,10 @@ begin Result := LoadBitmap( Instance, BmpRsrcName ); if Result = 0 then begin - {$IFDEF DEBUG} + {$IFDEF DEBUG_ANY} ShowMessage( AnsiString('Can not load bitmap ') + BmpRsrcName + ', error ' + Int2Str( GetLastError ) + ': ' + SysErrorMessage( GetLastError ) ); - {$ENDIF} + {$ENDIF DEBUG_ANY} Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>} end; DW := GetDesktopWindow; @@ -48884,7 +49323,7 @@ begin fDIBBits := nil; fHandle := CreateDIBSection( DC0, fDIBHeader^, DIB_RGB_COLORS, fDIBBits, 0, 0 ); - {$IFDEF DEBUG} + {$IFDEF DEBUG_ANY} if fHandle = 0 then ShowMessage( 'Can not create DIB section, error: ' + Int2Str( GetLastError ) + ', ' + SysErrorMessage( GetLastError ) ); @@ -48893,7 +49332,7 @@ begin ASSERT( fHandle <> 0, 'Can not create DIB section, error: ' + Int2Str( GetLastError ) + ', ' + SysErrorMessage( GetLastError ) ); {$ENDIF KOL_ASSERTIONS} - {$ENDIF} + {$ENDIF DEBUG_ANY} ReleaseDC( 0, DC0 ); if fHandle <> 0 then begin @@ -50089,8 +50528,10 @@ var BFH : TBitmapFileHeader; else Strm.WriteVal( 1, 1 ); // EOB inc(y); if ( Integer( P ) - Integer( PnextLine ) ) mod Width <> 0 then - asm - nop + begin {$IFNDEF PAS_ONLY} + asm + nop + end;{$ENDIF} end; end; Result := TRUE; @@ -54786,7 +55227,7 @@ begin Self_.Invalidate; end; CM_NCUPDATE: - if Msg.wParam = Self_.DF.fREUpdCount then + if DWORD(Msg.wParam) = DWORD(Self_.DF.fREUpdCount) then begin GetWindowRect( Self_.fHandle, R ); Windows.GetClientRect( Self_.fHandle, CR ); diff --git a/KOLDEF.inc b/KOLDEF.inc index 2633763..9a66b41 100644 --- a/KOLDEF.inc +++ b/KOLDEF.inc @@ -210,7 +210,7 @@ by Thaddy de Koning: FPC version 2.1.1 is very compatible with Delphi and kol now. You can simply use the $(DELPHI)\source\rtl\win\*.pas files from Delphi 4/5 instead of the prepared files that were needed for FPC1.X - + That is all to have full compatibility. ------------------------------------} {$DEFINE PAS_VERSION} diff --git a/KOLDirDlgEx.pas b/KOLDirDlgEx.pas index 084d46d..887f4a0 100644 --- a/KOLDirDlgEx.pas +++ b/KOLDirDlgEx.pas @@ -111,7 +111,9 @@ type procedure CreateDialogForm; property _FindFirstFileEx: TFindFirstFileEx read GetFindFirstFileEx; function _FindFirstFileExW: Boolean; +{$IFDEF DIRDLGEX_LINKSPANEL} procedure SelChanged( Sender: PObj ); +{$ENDIF} procedure DeleteNode( node: Integer ); procedure DestroyingForm( Sender: PObj ); public @@ -485,7 +487,9 @@ begin DirTree.OnMouseDblClk := DoubleClick; {$ENDIF} MsgPanel.OnMessage := DoMsg; +{$IFDEF DIRDLGEX_LINKSPANEL} DirTree.OnSelChange := SelChanged; +{$ENDIF} DlgClient := DTSubPanel; // !!! s := CancelCaption; if s = '' then s := 'Cancel'; BtCancel := NewButton( BtnPanel, s ); diff --git a/KOL_ASM.inc b/KOL_ASM.inc index 77a9999..ee2e1aa 100644 --- a/KOL_ASM.inc +++ b/KOL_ASM.inc @@ -1,6 +1,6 @@ //------------------------------------------------------------------------------ // KOL_ASM.inc (to inlude in KOL.pas) -// v 3.16 +// v 3.17 function MsgBox( const S: KOLString; Flags: DWORD ): DWORD; asm @@ -5570,6 +5570,7 @@ asm CALL IsWindow TEST EAX, EAX JZ @@destroy2 + (* -- moved to WM_NCDESTROY handler - VK + Alexey Kirov {$IFDEF USE_PROP} PUSH offset[ID_SELF] //* Remarked By M.Gerasimov PUSH [EBX].fHandle //* unremarked to prevent problems with progress bar @@ -5580,6 +5581,7 @@ asm PUSH [EBX].fHandle CALL SetWindowLong {$ENDIF} + *) {$IFDEF USE_fNCDestroyed} CMP [EBX].fNCDestroyed, 0 JNZ @@destroy2 @@ -5885,8 +5887,17 @@ asm //cmd //opd JMP @@calldef //********************************************************** Added By M.Gerasimov @@chk_WM_DESTROY: + {$IFnDEF SMALLER_CODE} + MOV EDX, [EDI].TMsg.hWnd + {$ENDIF SMALLER_CODE} CMP AX, WM_DESTROY JNE @@chk_WM_NCDESTROY + + {$IFnDEF SMALLER_CODE} + CMP EDX, [ESI].TControl.fHandle + JNE @@chk_WM_NCDESTROY + {$ENDIF SMALLER_CODE} + {$IFDEF USE_FLAGS} OR [ESI].TControl.fFlagsG2, (1 shl G2_BeginDestroying) {$ELSE} @@ -5895,10 +5906,14 @@ asm //cmd //opd JMP @@calldef //********************************************************** @@chk_WM_NCDESTROY: - //CMP word ptr [EDI].TMsg.message, WM_NCDESTROY CMP AX, WM_NCDESTROY JNE @@chk_WM_SIZE // @@chk_CM_RELEASE //********************************************************** Added By M.Gerasimov + {$IFnDEF SMALLER_CODE} + CMP EDX, [ESI].TControl.fHandle + JNE @@chk_WM_SIZE + {$ENDIF SMALLER_CODE} + {$IFDEF USE_PROP} PUSH offset[ID_SELF] PUSH [ESI].fHandle @@ -5909,8 +5924,8 @@ asm //cmd //opd PUSH [ESI].fHandle CALL SetWindowLong {$ENDIF} + JMP @@calldef //********************************************************** - @@return0: XOR EAX, EAX JMP @@exit // WM_NCDESTROY and CM_RELEASE @@ -5928,7 +5943,7 @@ asm //cmd //opd @@callonmes: {$IFDEF NIL_EVENTS} TEST EBX, EBX - JZ @@ret + JZ @@ret {$ENDIF} @@onmess1: PUSH 0 diff --git a/read1st.txt b/read1st.txt index a4915fd..3657c8d 100644 --- a/read1st.txt +++ b/read1st.txt @@ -1,9 +1,9 @@ -KEY OBJECTS LIBRARY for Delphi (and Free Pascal Compiler) - to make applications small and power. This library is freeware and open source. Delphi 2, 3, 4, 5, 6, 7, 8, BDS 2005, 2006, 2010, TurboDelphi and Free Pascal Compiler 1.0.5, 1.0.6, and higher (2.0.4) are supported. Partially compatible with Kylix (Linux/Qt platform, use special converting tool and provided files in Tools section on the site http://bonanzas.rinet.ru) +KEY OBJECTS LIBRARY for Delphi (and Free Pascal Compiler) - to make applications small and power. This library is freeware and open source. Delphi 2, 3, 4, 5, 6, 7, 8, BDS 2005, 2006, 2010, TurboDelphi, Delphi XE, Delphi XE2 and Free Pascal Compiler 1.0.5, 1.0.6, and higher (2.0.4) are supported. Partially compatible with Kylix (Linux/Qt platform, use special converting tool and provided files in Tools section on the site http://bonanzas.rinet.ru) Copyright (C) by Vladimir Kladov, 1999-2010. Some parts of code are Copyright (C) intellectual property by other people, see comments in code and on KOL site. Thanks to all for help with KOL and MCK! -v. 3.16 (26-Nov-2011) +v. 3.18 (23-Apr-2012) To get newer version, go to Web-page http://www.kolmck.net and get there updates. diff --git a/read1st_rus.txt b/read1st_rus.txt index 02fb1cf..60219b2 100644 --- a/read1st_rus.txt +++ b/read1st_rus.txt @@ -1,12 +1,12 @@ KEY OBJECTS LIBRARY для Delphi (и Free Pascal Compiler) - предназначен для того, чтобы сделать программы, изготовленные с использованием языка Паскаль, маленькими и очень маленькими. Copyright (C) by Vladimir Kladov, 1999-2007. Бесплатно, с исходными текстами. -версия 3.16 (26 ноября 2011 г.) +версия 3.18 (23 апреля 2012 г.) _________________ КРАТКОЕ ОПИСАНИЕ:    KOL - Key Objects Library - это библиотека объектов для программирования в среде Delphi. -   Поддерживаются версии Delphi2, Delph3, Delphi4, Delphi5, Delphi6, Delphi7, Delphi8, BDS2005, BDS2006, BDS2010, Turbo-Delphi а так же Free Pascal v1.0.5, v2.0.4 и выше. Имеется так же частичная совместимость с Kylix (требуется конвертер и набор файлов, см. в разделе "Инструменты разработчика" на сайте http://bonanzas.rinet.ru). Ведется работа над портированием на другие платформы (Linux, Win CE). +   Поддерживаются версии Delphi2, Delph3, Delphi4, Delphi5, Delphi6, Delphi7, Delphi8, BDS2005, BDS2006, BDS2010, Turbo-Delphi, Delphi XE, Delphi XE2, а так же Free Pascal v1.0.5, v2.0.4 и выше. Имеется так же частичная совместимость с Kylix (требуется конвертер и набор файлов, см. в разделе "Инструменты разработчика" на сайте http://bonanzas.rinet.ru). Ведется работа над портированием на другие платформы (Linux, Win CE). Библиотека KOL позволяет разрабатывать чрезвычайно компактные GUI-приложения (от 11К без сжатия - при условии использования предлагаемой замены системных модулей system, sysinit, см. на сайте раздел "Архивы"). Большая часть кода переведана на ассемблер.    К библиотеке прилагается программа - генератор справки (xHelpGen), формирующая подробную документацию по библиотеке в html-формате. Справка формируется на основе комментариев в исходных текстах, так что разработчики всегда имеют доступ к самой свежей и полной документации.    С использованием MCK (Mirror Classes Kit - набор зеркальных классов) все прелести визуальной разработки программ в полной мере доступны и для разработчиков, использующих KOL. Дополнительно с MCK имеется возможность еще более уменьшать приложения, автоматически генерируя П-код виртуальной машины вместо Паскаль-кода для инициализации форм (см. подроблее: Collapse).