pascal/kolmck
1
0
Fork 0
Code Issues Releases Activity

2.89

Browse Source 
git-svn-id: https://svn.code.sf.net/p/kolmck/code@53 91bb2d04-0c0c-4d2d-88a5-bbb6f4c1fa07
This commit is contained in:
dkolmck
2010-03-24 10:14:37 +00:00
parent 6c878d4297
commit bb8bb405eb
8 changed files with 578 additions and 266 deletions
Download Patch File Download Diff File Expand all files Collapse all files

441
KOL.pas
View File

@ -15,7 +15,7 @@
//[VERSION]
****************************************************************
* VERSION 2.88
* VERSION 2.89
****************************************************************
//[END OF VERSION]
@ -945,7 +945,7 @@ type
TThreadMethod = procedure of object;
TThreadMethodEx = procedure( Sender: PThread; Param: Pointer ) of object;
TOnThreadExecute = function(Sender:PThread): Integer of object;
TOnThreadExecute = function(Sender: PThread): Integer of object;
{* Event to be called when Execute method is called for TThread }
{ ---------------------------------------------------------------------
@ -1022,6 +1022,7 @@ type
{* Waits (infinitively) until thead will be finished. }
function WaitForTime( T: DWORD ): Integer;
{* Waits (T milliseconds) until thead will be finished. }
property Handle: THandle read FHandle;
{* Thread handle. It is created immediately when object is created
(using NewThread). }
@ -1040,6 +1041,7 @@ type
THREAD_PRIORITY_LOWEST, THREAD_PRIORITY_NORMAL, THREAD_PRIORITY_TIME_CRITICAL. }
property Data : Pointer read FData write FData;
{* Custom data pointer. Use it for Youe own purpose. }
property OnExecute: TOnThreadExecute read FOnExecute write FOnExecute;
{* Is called, when Execute is starting. }
property OnSuspend: TObjectMethod read FOnSuspend write FOnSuspend;
@ -1493,6 +1495,8 @@ RT_VERSION Version resource
//[TStrList]
type
TCompareStrListFun = function( const S1, S2: PAnsiChar ): Integer;
{++}(*TStrList = class;*){--}
PStrList = {-}^{+}TStrList;
{ ---------------------------------------------------------------------
@ -1514,8 +1518,10 @@ type
fList: PList;
fCount: Integer;
fCaseSensitiveSort: Boolean;
fAnsiSort: Boolean;
fTextBuf: PAnsiChar;
fTextSiz: DWORD;
fCompareStrListFun: TCompareStrListFun;
function GetPChars(Idx: Integer): PAnsiChar;
//procedure AddTextBuf( Src: PAnsiChar; Len: DWORD );
protected
@ -1550,7 +1556,7 @@ type
{* Deletes string with given index (it *must* exist). }
procedure DeleteLast;
{* Deletes the last string (it *must* exist). }
function IndexOf(const S: Ansistring): integer;
function IndexOf(const S: AnsiString): integer;
{* Returns index of first string, equal to given one. }
function IndexOf_NoCase(const S: Ansistring): integer;
{* Returns index of first string, equal to given one (while comparing it
@ -1559,10 +1565,15 @@ type
{* Returns index of first string, equal to given one (while comparing it
without case sensitivity). }
function Find(const S: AnsiString; var Index: Integer): Boolean;
{* Returns Index of the first string, equal or greater to given pattern, but
{* Returns Index of the string, equal or greater to given pattern, but
works only for sorted TStrList object. Returns TRUE if exact string found,
otherwise nearest (greater then a pattern) string index is returned,
and the result is FALSE. }
function FindFirst(const S: AnsiString; var Index: Integer): Boolean;
{* Like above but always returns Index of the first string, equal or greater
to given pattern. Also works only for sorted TStrList object. Returns TRUE
if exact string found, otherwise nearest (greater then a pattern) string
index is returned, and the result is FALSE. }
procedure Insert(Idx: integer; const S: Ansistring);
{* Inserts string before one with given index. }
procedure Move(CurIndex, NewIndex: integer);
@ -2312,6 +2323,8 @@ type
function Color2RGB( Color: TColor ): TColor;
{* Function to get RGB color from system color. Parameter can be also RGB
color, in that case result is just equal to a parameter. }
function RGB2BGR( Color: TColor ): TColor;
{* Converts RGB color to BGR }
{$IFDEF GTK}
function Color2GDKColor( Color: TColor ): TGdkColor;
{$ENDIF GTK}
@ -2531,6 +2544,10 @@ type
{* Brush of Canvas object. Do not change its Brush.OnChange event value. }
property Font : PGraphicTool read GetFont;
{* Font of Canvas object. Do not change its Font.OnChange event value. }
procedure OffsetAndRotate( Xoff, Yoff: Integer; Angle: Double );
{* Transforms world coordinates so that Xoff and Yoff become the
coordinates of the origin (0,0) and all further drawing is done
rotated around that point by the Angle (which is given in radians) }
{$IFNDEF NOT_USE_KOLMATH} // if using KOLmath disabled, Arc becomes unavailable
procedure Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); stdcall;
{* Draws arc. For more info, see Delphi TCanvas help. }
@ -8706,6 +8723,7 @@ type
// to use the same naming rule for all of You. Name your fields, properies, etc.
// using a form idx_SomeName, where idx is a prefix, containing several
// (at least one) letters and digits. E.g. ZK65_OnSomething.
protected
fParentCoordX: Integer;
fParentCoordY: Integer;
@ -10338,6 +10356,9 @@ function Double2Str( D: Double ): AnsiString;
{* }
function Extended2Str( E: Extended ): AnsiString;
{* }
function Extended2StrDigits( D: Double; n: Integer ): AnsiString;
{* Converts floating point number to string, leaving exactly n digits
following floating point. }
function Double2StrEx( D: Double ): AnsiString;
{* experimental, do not use }
@ -10630,6 +10651,8 @@ function WStrRScan(const Str: PWideChar; Chr: WideChar): PWideChar;
considered to be part of the string. }
{$ENDIF _FPC}
{$ENDIF _D2}
//--- set of functions to work either with AnsiString or with WideString
// depending on UNICODE_CTRLS symbol ----------------------------------------
function AnsiCompareStr(const S1, S2: KOLString): Integer;
{* AnsiCompareStr compares S1 to S2, with case-sensitivity. The compare
operation is controlled by the current Windows locale. The return value
@ -10642,7 +10665,28 @@ function AnsiCompareStrNoCase(const S1, S2: KOLString): Integer;
is the same as for CompareStr. }
function _AnsiCompareStrNoCase(S1, S2: PKOLChar): Integer;
{* The same, but for PChar ANSI strings }
function AnsiCompareText( const S1, S2: AnsiString ): Integer;
function AnsiCompareText( const S1, S2: KOLString ): Integer;
{* }
function AnsiEq( const S1, S2 : KOLString ) : Boolean;
{* Returns True, if AnsiLowerCase(S1) = AnsiLowerCase(S2). I.e., if ANSI
stringsare equal to each other without caring of characters case
sensitivity. }
//--- set of functions to work always with AnsiString
// even if UNICODE_CTRLS symbol is defined ----------------------------------
function AnsiCompareStrA(const S1, S2: AnsiString): Integer;
{* AnsiCompareStr compares S1 to S2, with case-sensitivity. The compare
operation is controlled by the current Windows locale. The return value
is the same as for CompareStr. }
function _AnsiCompareStrA(S1, S2: PAnsiChar): Integer;
{* The same, but for PChar ANSI strings }
function AnsiCompareStrNoCaseA(const S1, S2: AnsiString): Integer;
{* AnsiCompareStr compares S1 to S2, with case-sensitivity. The compare
operation is controlled by the current Windows locale. The return value
is the same as for CompareStr. }
function _AnsiCompareStrNoCaseA(S1, S2: PAnsiChar): Integer;
{* The same, but for PChar ANSI strings }
function AnsiCompareTextA( const S1, S2: AnsiString ): Integer;
{* }
{$IFDEF WIN}
@ -10715,10 +10759,6 @@ function StrEq( const S1, S2 : AnsiString ) : Boolean;
{* Returns True, if LowerCase(S1) = LowerCase(S2). I.e., if strings
are equal to each other without caring of characters case sensitivity
(ASCII only). }
function AnsiEq( const S1, S2 : AnsiString ) : Boolean;
{* Returns True, if AnsiLowerCase(S1) = AnsiLowerCase(S2). I.e., if ANSI
stringsare equal to each other without caring of characters case
sensitivity. }
{$IFNDEF _D2}
{$IFNDEF _FPC}
function WAnsiEq( const S1, S2 : WideString ) : Boolean;
@ -11889,6 +11929,8 @@ type
{* Reads or writes integer data value. }
function ValueString( const Key: KOLString; const Value: KOLString ): KOLString;
{* Reads or writes string data value. }
function ValueDouble( const Key: KOLString; const Value: Double ): Double;
{* Reads or writes Double data value. }
function ValueBoolean( const Key: KOLString; Value: Boolean ): Boolean;
{* Reads or writes Boolean data value. }
function ValueData( const Key: KOLString; Value: Pointer; Count: Integer ): Boolean;
@ -13764,7 +13806,9 @@ function WndProcJustOneNotify( Control: PControl; var Msg: TMsg; var Rslt: Integ
function WndProcJustOne( Control: PControl; var Msg: TMsg; var Rslt: Integer ) : Boolean; forward;
function WndProcTreeView( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; forward;
function CompareAnsiStrListItems( const Sender : Pointer; const e1, e2 : DWORD ) : Integer; forward;
function CompareStrListItems( const Sender : Pointer; const e1, e2 : DWORD ) : Integer; forward;
function CompareAnsiStrListItems_Case( const Sender : Pointer; const e1, e2 : DWORD ) : Integer; forward;
function CompareStrListItems_NoCase( const Sender : Pointer; const e1, e2 : DWORD ) : Integer; forward;
function CompareStrListItems_Case( const Sender : Pointer; const e1, e2 : DWORD ) : Integer; forward;
function CompareIntegers( const Sender : Pointer; const e1, e2 : DWORD ) : Integer; forward;
procedure SwapIntegers( const Sender : Pointer; const e1, e2 : DWORD ); forward;
function CompareDwords( const Sender : Pointer; const e1, e2 : DWORD ) : Integer; forward;
@ -14091,6 +14135,7 @@ end;
{$I visual_xp_styles.inc}
{$ENDIF}
{$IFDEF SNAPMOUSE2DFLTBTN}
var FoundMsgBoxWnd: HWnd;
function EnumProcSnapMouse2DfltBtn( W: HWnd; lParam: Integer ): BOOL; stdcall;
@ -14136,6 +14181,7 @@ begin
end;
Result := FALSE;
end;
{$ENDIF SNAPMOUSE2DFLTBTN}
{$IFDEF GDI}
//[function MsgBox]
@ -15715,10 +15761,10 @@ var I: Integer;
CountBefore, CountCurrent: Integer;
{$ENDIF}
begin
Result := -1;
{$IFDEF DEBUG}
TRY
{$ENDIF}
Result := -1;
{$IFDEF TLIST_FAST}
if fUseBlocks and Assigned( fBlockList ) then
begin
@ -15951,7 +15997,7 @@ end;
{$IFDEF WIN_GDI}
{ -- Window procedure -- }
(*
function CallCtlWndProc_1( Ctl: PControl; var Msg: TMsg ): Integer;
begin
Result := Ctl.WndProc( Msg );
@ -16047,6 +16093,7 @@ asm
MOV ESP, EBP
end;
*)
{$UNDEF ASM_LOCAL}
{$IFDEF ASM_noVERSION}
@ -16397,6 +16444,7 @@ end;
{$ENDIF ASM_VERSION}
//[PROCEDURE CallTControlCreateWindow]
{$IFDEF ASM_VERSION}
function CallTControlCreateWindow( Ctl: PControl ): Boolean;
begin
{$IFDEF SAFE_CODE}
@ -16413,6 +16461,7 @@ begin
Result := Ctl.CreateWindow;
{$ENDIF}
end;
{$ENDIF}
//[END CallTControlCreateWindow]
{$ENDIF GDI}
{$ENDIF WIN_GDI}
@ -16527,7 +16576,9 @@ end;
{$ENDIF GDI}
//[WndProcXXX FORWARD DECLARATIONS]
{$IFDEF ASM_VERSION}
function WndProcAppAsm( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; forward;
{$ENDIF}
function WndProcAppPas( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; forward;
function WndProcForm( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; forward;
function WndProcPaint( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; forward;
@ -17623,6 +17674,22 @@ begin
RequiredState( HandleValid );
Windows.SetPixel(FHandle, X, Y, Color2RGB( Value ));
end;
procedure TCanvas.OffsetAndRotate(Xoff, Yoff: Integer; Angle: Double);
var F: tagXForm;
begin
SetGraphicsMode( fHandle, GM_ADVANCED );
F.eM11 := cos( Angle );
F.eM12 := sin( Angle );
F.eM21 := -F.eM12;
F.eM22 := F.eM11;
F.eDx := Xoff;
F.eDy := Yoff;
SetWorldTransform( fHandle, F );
if (Angle = 0) and (Xoff = 0) and (Yoff = 0) then
SetGraphicsMode( fHandle, GM_COMPATIBLE );
end;
{$ENDIF WIN_GDI}
{$IFDEF _X_}
@ -19239,6 +19306,57 @@ begin
if S then Result := '-' + Result;
end;
function Extended2StrDigits( D: Double; n: Integer ): AnsiString;
var i, m: Integer;
label start;
begin
start:
Result := Extended2Str( D );
i := pos( '.', Result );
if n <= 0 then
begin
if i <= 0 then Exit;
delete( Result, i, MaxInt );
end
else
begin
if i <= 0 then
begin
i := Length( Result ) + 1;
Result := Result + '.';
end;
if Length( Result ) - i < n then
Result := Result + StrRepeat( '0', n + i - Length( Result ) )
else
begin
m := i + n;
if Length( Result ) <= m then Exit;
if (Result[m+1] > '5')
or (Length( Result ) > m+1)
and (Result[m+2] > '0') then
begin
//D := D + 1/IntPower( 10, n-1 );
//goto start;
n := m;
inc( Result[n] );
while Result[n] > '9' do
begin
Result[n] := '0';
dec( n );
if n = 0 then
begin
Result := '1' + Result;
break;
end;
if Result[n] = '.' then dec(n);
inc( Result[n] );
end;
end;
delete( Result, m+1, MaxInt );
end;
end;
end;
//[function Double2Str]
function Double2Str( D: Double ): AnsiString;
begin
@ -20531,6 +20649,14 @@ begin
end;
{$ENDIF WIN}
//[function AnsiCompareStrA]
{$IFDEF WIN}
function AnsiCompareStrA(const S1, S2: AnsiString): Integer;
begin
Result := CompareStringA(LOCALE_USER_DEFAULT, 0, PAnsiChar(S1), -1, PAnsiChar(S2), -1 ) - 2;
end;
{$ENDIF WIN}
//[function _AnsiCompareStr]
{$IFDEF WIN}
function _AnsiCompareStr(S1, S2: PKOLChar): Integer;
@ -20540,6 +20666,15 @@ begin
end;
{$ENDIF WIN}
//[function _AnsiCompareStrA]
{$IFDEF WIN}
function _AnsiCompareStrA(S1, S2: PAnsiChar): Integer;
begin
Result := CompareStringA( LOCALE_USER_DEFAULT, 0, S1, -1,
S2, -1) - 2;
end;
{$ENDIF WIN}
//[function AnsiCompareStrNoCase]
{$IFDEF WIN}
function AnsiCompareStrNoCase(const S1, S2: KOLString): Integer;
@ -20549,6 +20684,15 @@ begin
end;
{$ENDIF WIN}
//[function AnsiCompareStrNoCaseA]
{$IFDEF WIN}
function AnsiCompareStrNoCaseA(const S1, S2: AnsiString): Integer;
begin
Result := CompareStringA(LOCALE_USER_DEFAULT, NORM_IGNORECASE, PAnsiChar(S1), -1,
PAnsiChar(S2), -1 ) - 2;
end;
{$ENDIF WIN}
//[function _AnsiCompareStrNoCase]
{$IFDEF WIN}
function _AnsiCompareStrNoCase(S1, S2: PKOLChar): Integer;
@ -20558,12 +20702,27 @@ begin
end;
{$ENDIF WIN}
//[function _AnsiCompareStrNoCaseA]
{$IFDEF WIN}
function _AnsiCompareStrNoCaseA(S1, S2: PAnsiChar): Integer;
begin
Result := CompareStringA( LOCALE_USER_DEFAULT, NORM_IGNORECASE, S1, -1,
S2, -1) - 2;
end;
{$ENDIF WIN}
//[function AnsiCompareText]
function AnsiCompareText( const S1, S2: AnsiString ): Integer;
function AnsiCompareText( const S1, S2: KOLString ): Integer;
begin
Result := AnsiCompareStrNoCase( S1, S2 );
end;
//[function AnsiCompareTextA]
function AnsiCompareTextA( const S1, S2: AnsiString ): Integer;
begin
Result := AnsiCompareStrNoCaseA( S1, S2 );
end;
//[function StrLCopy]
function StrLCopy(Dest: PAnsiChar; const Source: PAnsiChar; MaxLen: Cardinal): PAnsiChar; assembler;
asm
@ -20625,7 +20784,7 @@ end;
//[FUNCTION AnsiEq]
{$IFDEF ASM_VERSION}
{$ELSE ASM_VERSION} //Pascal
function AnsiEq( const S1, S2 : AnsiString ) : Boolean;
function AnsiEq( const S1, S2 : KOLString ) : Boolean;
begin
Result := AnsiCompareStrNoCase( S1, S2 ) = 0;
end;
@ -20883,9 +21042,12 @@ var I, J, N: Integer;
begin
if S <> '' then
begin
if S[ 1 ] = #10 then
S[ 1 ] := #0;
N := 0;
if S[ 1 ] = #10 then
begin
S[ 1 ] := #0;
inc( N );
end;
for I := Length(S) downto 2 do
begin
if (S[I]=#10) and (S[I-1]<>#13) then
@ -23323,16 +23485,18 @@ var FindData : TFindFileData;
begin
Clear;
FPath := DirPath;
if (FPath = '') then Exit;
if FPath = '' then Exit;
FPath := IncludeTrailingPathDelimiter( FPath );
if not Assigned(fFilters) then begin
if not Assigned(fFilters) then
begin
fFilters := {$IFDEF UNICODE_CTRLS} NewWStrList {$ELSE} NewStrList {$ENDIF};
if Filter = '*.*' then
fFilters.Add( '*' )
else
fFilters.Add( Filter );
end;
if Find_First( PKOLChar( FPath + FindFilter( Filter ) ), FindData ) then begin // D[u]fa. fix mem leaks (FList, fFilters)
if Find_First( PKOLChar( FPath + FindFilter( Filter ) ), FindData ) then
begin // D[u]fa. fix mem leaks (FList, fFilters)
FList := NewList;
while True do
begin
@ -24044,8 +24208,7 @@ end;
at all Christian era, and all other historical era too. }
//[procedure DivMod]
procedure DivMod(Dividend: Integer; Divisor: Word;
var Result, Remainder: Word);
procedure DivMod(Dividend: Integer; Divisor: Word; var Result, Remainder: Word);
{$IFDEF F_P}
begin
Result := Dividend div Divisor;
@ -26442,6 +26605,11 @@ begin
end;
end;
function TIniFile.ValueDouble(const Key: KOLString; const Value: Double): Double;
begin
Result := Str2Double( ValueString( Key, Double2Str( Value ) ) );
end;
//[function OpenIniFile]
function OpenIniFile( const FileName: KOLString ): PIniFile;
begin
@ -27872,6 +28040,7 @@ begin
SM := M.Items[ MIS.itemID ];
if SM <> nil then
begin
//MIS.itemWidth := 100; // VK: agree, this is not necessary
Sender.CallDefWndProc( Msg );
I := M.IndexOf( SM );
if Assigned( SM.OnMeasureItem ) then
@ -27988,6 +28157,7 @@ begin
Result.FParentMenu := @ Self;
Result.FMenuItems := NewList;
Result.FIsSeparator := moSeparator in Options;
Result.FIsCheckItem := moCheckMark in Options; //+ by shilou, 12/2009
if FHandle = 0 then
SetSubMenu( CreatePopupMenu );
M := nil;
@ -28122,15 +28292,15 @@ end;
//[function TMenu.RemoveSubMenu]
function TMenu.RemoveSubMenu( ItemToRemove: Integer ): PMenu;
{$IFDEF DEBUG_MENU}var OK: Boolean; {$ENDIF}
var M: PMenu;
begin
Result := Items[ ItemToRemove ];
if Result = nil then Exit;
if Result.FParentMenu <> nil then
M := Result.FParentMenu;
if M = nil then M := @Self;
{$IFDEF DEBUG_MENU} OK := {$ENDIF}
RemoveMenu( Result.FParentMenu.FHandle, Result.FId, MF_BYCOMMAND )
else
{$IFDEF DEBUG_MENU} OK := {$ENDIF}
RemoveMenu( FHandle, Result.FId, MF_BYCOMMAND );
RemoveMenu( M.FHandle, Result.FId, MF_BYCOMMAND );
M.FMenuItems.Remove( Result );
{$IFDEF DEBUG_MENU}
if not OK then
ShowMessage( 'Error removing menu: ' + Int2Str( GetLastError ) + ' - ' +
@ -28453,6 +28623,7 @@ end;
//===================== Applet button ========================//
//[FUNCTION WndProcApp]
{$IFDEF ASM_VERSION}
function WndProcAppAsm(Self_: PControl; var Msg: TMsg; var Rslt: Integer): Boolean;
asm
CMP word ptr [EDX].TMsg.message, WM_SETFOCUS
@ -28503,6 +28674,7 @@ end;
XOR EAX, EAX
@@exit:
end;
{$ENDIF}
function WndProcAppPas(Self_: PControl; var Msg: TMsg; var Rslt: Integer): Boolean;
begin
@ -29772,7 +29944,7 @@ end;
//[END WndProcBitBtn]
//[FUNCTION NewBitBtn]
{$IFDEF ASM_VERSION}
{$IFDEF ASM_noVERSION} // todo: first correct asm version, then remove <no>
{$ELSE ASM_VERSION} //Pascal
function NewBitBtn( AParent: PControl; const Caption: KOLString;
Options: TBitBtnOptions; Layout: TGlyphLayout; GlyphBitmap: HBitmap;
@ -31499,6 +31671,24 @@ begin
end;
{$ENDIF}
end;
{$IFDEF KEY_PREVIEW}
if not Form.KeyPreviewing then
begin
if Form.KeyPreview then
begin
Form.KeyPreviewing := TRUE;
inc( Form.FKeyPreviewCount );
//Form.Perform(Msg, wParam, lParam);
Form.fWndProcKeybd( Form, MsgStruct, Result );
dec( Form.FKeyPreviewCount );
if MsgStruct.wParam = 0 then
begin
Result := 0;
Exit;
end;
end;
end;
{$ENDIF}
Combo.fWndProcKeybd( Combo, MsgStruct, Result );
end
else
@ -31768,7 +31958,9 @@ begin
{$ELSE}
Child := Pointer( GetWindowLong( NMhdr.hwndFrom, GWL_USERDATA ) );
{$ENDIF}
if Child <> nil then
if (Child <> nil)
and (Child <> Self_) //+ by Galkov, Jun-2009
then
begin
Msg.hwnd := Child.fHandle;
Result := EnumDynHandlers( Child, Msg, Rslt );
@ -32391,10 +32583,10 @@ begin
if Assigned( Self_.fOnResize ) then
Self_.fOnResize( Self_ );
{$IFNDEF TOOLBAR_FORCE_CHILDALIGN}
//if WinVer >= wvNT then
Result := TRUE; // this prevents Align working for child controls of Toolbar !
// but removing this line makes impossible correct Align for
// neighbour controls on form!!!
if WinVer >= wvNT then // todo: check it.
Result := TRUE; // this provides (prevents?) the Align working for child controls of Toolbar !
// but removing this line makes it impossible to correct the Align property for
// the neighbour controls on form!!!
{$ENDIF}
Rslt := 0;
end
@ -33112,6 +33304,7 @@ begin
{$UNDEF destroy}
{$ENDIF USE_MHTOOLTIP}
{$IFDEF DEBUG}
F := nil;
TRY
F := ParentForm; // or Applet - for form ???
EXCEPT
@ -35806,16 +35999,14 @@ end;
//*
//[function TControl.ControlAtPos]
function TControl.ControlAtPos( X, Y: Integer;
IgnoreDisabled: Boolean ): PControl;
function TControl.ControlAtPos( X, Y: Integer; IgnoreDisabled: Boolean ): PControl;
var I: Integer;
C: PControl;
CR, VR: TRect;
begin
Result := nil;
CR := ControlRect;
if Windowed then
CR := MakeRect( 0, 0, 0, 0 );
CR := ControlRect; // îòíîñèòåëüíûå êîîðäèíàòû â ñèñòåìå ÐÎÄÈÒÅËÜÑÊÎÃÎ ÊÎÍÒÐÎËÀ
if Windowed then CR := MakeRect( 0, 0, 0, 0 );
X := X + CR.Left; // - R.Left;
Y := Y + CR.Top; // - R.Top;
for I := ChildCount { + MembersCount } - 1 downto 0 do
@ -36867,7 +37058,9 @@ begin
Result := TRUE;
//if Sender.fTransparent and (not Sender.fParentRequirePaint) then
if Assigned(Sender.fParent) and (not Sender.isForm) // fix Galkov
{if (Sender.fTransparent or
Sender.fDoubleBuffered) and (Sender.FParent <> nil)} // áûëî
if Assigned(Sender.fParent) and (not Sender.isForm) // ñòàëî
and Sender.FParent.fDoubleBuffered
and (not Sender.fParentRequirePaint) then
begin
@ -40137,19 +40330,39 @@ end;
//[function TStrList.IndexOf]
{$IFDEF ASM_TLIST}
{$ELSE ASM_VERSION} //Pascal
function TStrList.IndexOf(const S: Ansistring): integer;
function TStrList.IndexOf(const S: AnsiString): integer;
var Word1: Word;
begin
if S = '' then
begin
for Result := 0 to fCount - 1 do
if (S = PAnsiChar( fList.Items[Result] )) then Exit;
if PAnsiChar(fList.Items[Result])^ = #0 then Exit;
end
else
begin
Word1 := PWord(PAnsiChar( S ))^;
for Result := 0 to fCount - 1 do
if (PWord(fList.Items[Result])^ = Word1)
and (StrComp( fList.Items[Result], PAnsiChar( S ) ) = 0) then Exit;
end;
Result := -1;
end;
{$ENDIF ASM_VERSION}
//[function TStrList.IndexOf]
function TStrList.IndexOf_NoCase(const S: Ansistring): integer;
function TStrList.IndexOf_NoCase(const S: AnsiString): integer;
begin
if S = '' then
begin
for Result := 0 to fCount - 1 do
if AnsiCompareStrNoCase( S, Items[Result] ) = 0 then Exit;
if PAnsiChar( fList.Items[Result] )^ = #0 then Exit;
end
else
begin
for Result := 0 to fCount - 1 do
if (PWord( PAnsiChar(S) )^ = PWord( PAnsiChar( fList.Items[Result] ) )^)
and (_AnsiCompareStrNoCaseA( PAnsiChar( S ), fList.Items[Result] ) = 0) then Exit;
end;
Result := -1;
end;
@ -40165,6 +40378,15 @@ begin
Result := -1;
end;
function CompareAnsiCase( const S1, S2: PAnsiChar ): Integer;
begin
Result := _AnsiCompareStrA( S1, S2 );
end;
function CompareAnsiNoCase( const S1, S2: PAnsiChar ): Integer;
begin
Result := _AnsiCompareStrNoCaseA( S1, S2 );
end;
//[function TStrList.Find]
function TStrList.Find(const S: AnsiString; var Index: Integer): Boolean;
var
@ -40173,10 +40395,25 @@ begin
Result := FALSE;
L := 0;
H := FCount - 1;
if fAnsiSort then
begin
if fCaseSensitiveSort then
fCompareStrListFun := CompareAnsiCase
else
fCompareStrListFun := CompareAnsiNoCase;
end
else
begin
if fCaseSensitiveSort then
fCompareStrListFun := StrComp
else
fCompareStrListFun := StrComp_NoCase;
end;
while L <= H do
begin
I := (L + H) shr 1;
C := AnsiCompareStr( AnsiString(PAnsiChar( fList.Items[ I ] )), S ); // TODO: _PureAnsiCompareStr
C := fCompareStrListFun( PAnsiChar( fList.Items[ I ] ),
PAnsiChar( S ) );
if C < 0 then L := I + 1 else
begin
H := I - 1;
@ -40184,10 +40421,27 @@ begin
begin
Result := TRUE;
L := I;
break;
end;
end;
end;
Index := L;
if not Result then
Result := fCompareStrListFun( PAnsiChar( fList.Items[ L ] ),
PAnsiChar( S ) ) = 0;
end;
//[function TStrList.FindFirst]
function TStrList.FindFirst(const S: AnsiString; var Index: Integer): Boolean;
begin
Result := Find( S, Index );
if Result then
begin
while (Index > 0)
and (fCompareStrListFun( PAnsiChar( fList.Items[ Index-1 ] ),
PAnsiChar( S )) = 0) do
dec( Index );
end;
end;
//[procedure TStrList.Insert]
@ -40321,18 +40575,28 @@ begin
SetText( Value, False );
end;
//[FUNCTION CompareStrListItems]
//[FUNCTION CompareStrListItems_NoCase]
{$IFDEF ASM_TLIST}
{$ELSE ASM_VERSION} //Pascal
function CompareStrListItems( const Sender : Pointer; const e1, e2 : DWORD ) : Integer;
function CompareStrListItems_NoCase( const Sender : Pointer; const e1, e2 : DWORD ) : Integer;
var S1, S2 : PAnsiChar;
begin
S1 := PStrList( Sender ).fList.Items[ e1 ];
S2 := PStrList( Sender ).fList.Items[ e2 ];
if PStrList( Sender ).fCaseSensitiveSort then
Result := StrComp( S1, S2 )
else
Result := StrComp( PAnsiChar( LowerCase( S1 ) ), PAnsiChar( LowerCase( S2 ) ) );
Result := StrComp_NoCase( S1, S2 );
end;
{$ENDIF ASM_VERSION}
//[END CompareStrListItems]
//[FUNCTION CompareStrListItems]
{$IFDEF ASM_TLIST}
{$ELSE ASM_VERSION} //Pascal
function CompareStrListItems_Case( const Sender : Pointer; const e1, e2 : DWORD ) : Integer;
var S1, S2 : PAnsiChar;
begin
S1 := PStrList( Sender ).fList.Items[ e1 ];
S2 := PStrList( Sender ).fList.Items[ e2 ];
Result := StrComp( S1, S2 );
end;
{$ENDIF ASM_VERSION}
//[END CompareStrListItems]
@ -40341,14 +40605,24 @@ end;
{$IFDEF ASM_TLIST}
{$ELSE ASM_VERSION} //Pascal
function CompareAnsiStrListItems( const Sender : Pointer; const e1, e2 : DWORD ) : Integer;
var S1, S2 : PKOLChar;
var S1, S2 : PAnsiChar;
begin
S1 := PStrList( Sender ).fList.Items[ e1 ];
S2 := PStrList( Sender ).fList.Items[ e2 ];
if PStrList( Sender ).fCaseSensitiveSort then
Result := _AnsiCompareStr( S1, S2 )
else
Result := _AnsiCompareStrNoCase( S1, S2 );
Result := _AnsiCompareStrNoCaseA( S1, S2 );
end;
{$ENDIF ASM_VERSION}
//[END CompareAnsiStrListItems]
//[FUNCTION CompareAnsiStrListItems_Case]
{$IFDEF ASM_TLIST}
{$ELSE ASM_VERSION} //Pascal
function CompareAnsiStrListItems_Case( const Sender : Pointer; const e1, e2 : DWORD ) : Integer;
var S1, S2 : PAnsiChar;
begin
S1 := PStrList( Sender ).fList.Items[ e1 ];
S2 := PStrList( Sender ).fList.Items[ e2 ];
Result := _AnsiCompareStrA( S1, S2 )
end;
{$ENDIF ASM_VERSION}
//[END CompareAnsiStrListItems]
@ -40367,7 +40641,11 @@ end;
procedure TStrList.Sort(CaseSensitive: Boolean);
begin
fCaseSensitiveSort := CaseSensitive;
SortData( @Self, fCount, @CompareStrListItems, @SwapStrListItems );
fAnsiSort := FALSE;
if CaseSensitive then
SortData( @Self, fCount, @CompareStrListItems_Case, @SwapStrListItems )
else
SortData( @Self, fCount, @CompareStrListItems_NoCase, @SwapStrListItems )
end;
{$ENDIF ASM_VERSION}
@ -40377,6 +40655,10 @@ end;
procedure TStrList.AnsiSort(CaseSensitive: Boolean);
begin
fCaseSensitiveSort := CaseSensitive;
fAnsiSort := TRUE;
if CaseSensitive then
SortData( @Self, fCount, @CompareAnsiStrListItems_Case, @SwapStrListItems )
else
SortData( @Self, fCount, @CompareAnsiStrListItems, @SwapStrListItems );
end;
{$ENDIF ASM_VERSION}
@ -40723,14 +41005,22 @@ end;
procedure TStrListEx.AnsiSort(CaseSensitive: Boolean);
begin
fCaseSensitiveSort := CaseSensitive;
SortData( @Self, fCount, @CompareAnsiStrListItems, @SwapStrListExItems );
fAnsiSort := TRUE;
if CaseSensitive then
SortData( @Self, fCount, @CompareAnsiStrListItems_Case, @SwapStrListExItems )
else
SortData( @Self, fCount, @CompareAnsiStrListItems, @SwapStrListExItems )
end;
//[procedure TStrListEx.Sort]
procedure TStrListEx.Sort(CaseSensitive: Boolean);
begin
fCaseSensitiveSort := CaseSensitive;
SortData( @Self, fCount, @CompareStrListItems, @SwapStrListExItems );
fAnsiSort := FALSE;
if CaseSensitive then
SortData( @Self, fCount, @CompareStrListItems_Case, @SwapStrListExItems )
else
SortData( @Self, fCount, @CompareStrListItems_NoCase, @SwapStrListExItems );
end;
//[procedure TStrListEx.Move]
@ -41235,14 +41525,16 @@ end;
//[function CompareWStrListItems_UpperCase]
function CompareWStrListItems_UpperCase( const Sender: Pointer; const Idx1, Idx2: DWORD ): Integer;
var WL: PWStrList;
L1, L2: Integer;
L1, L2, tL1, tL2: Integer;
begin
WL := Sender;
L1 := WStrLen( WL.fList.Items[ Idx1 ] );
L2 := WStrLen( WL.fList.Items[ Idx2 ] );
if Length( WL.fTmp1 ) < L1 then
tL1 := Length( WL.fTmp1 );
if tL1 <= L1 then
SetLength( WL.fTmp1, L1 + 1 );
if Length( WL.fTmp2 ) < L2 then
tL2 := Length( WL.fTmp2 );
if tL2 <= L2 then
SetLength( WL.fTmp2, L2 + 1 );
if L1 > 0 then
Move( WL.fList.Items[ Idx1 ]^, WL.fTmp1[ 1 ], (L1 + 1) * 2 )
@ -41288,6 +41580,21 @@ function TWStrList.IndexOf( const s: WideString ): Integer;
var i: Integer;
p: PWideChar;
begin
if s = '' then
begin
for i := 0 to fList.fCount-1 do
begin
p := ItemPtrs[ i ];
if (p = nil) or
(p^ = #0) then
begin
Result := i;
Exit;
end;
end;
end
else
begin
for i := 0 to Count-1 do
begin
p := ItemPtrs[ i ];
@ -41298,6 +41605,7 @@ begin
Exit;
end;
end;
end;
Result := -1;
end;
@ -47344,6 +47652,7 @@ begin
fWidth := SrcBmp.fWidth;
fHeight := SrcBmp.fHeight;
fHandleType := SrcBmp.fHandleType;
fNewPixelFormat := SrcBmp.PixelFormat;
if SrcBmp.fHandleType = bmDDB then
begin
fHandle := CopyImage( SrcBmp.fHandle, IMAGE_BITMAP, 0, 0, 0 {LR_COPYRETURNORG} );
@ -48865,8 +49174,8 @@ var DesiredSize : Integer;
else
if BIH.biBitCount = 16 then
begin
if (BIH.biCompression = BI_BITFIELDS) then // mdw
Stream2Stream(Mem, Strm, 12)
if BIH.biCompression = BI_BITFIELDS then // + by mdw - fix for
Stream2Stream(Mem, Strm, 12) // 16 bit per pixels
else
for I := 0 to 2 do
begin
@ -48900,6 +49209,7 @@ var DesiredSize : Integer;
BIH.biBitCount := 1;
BIH.biPlanes := 1;
BIH.biClrUsed := 0;
BIH.biCompression := 0;
Mem.Seek( 0, spBegin );
BIH.biSizeImage := ((BIH.biWidth + 31) div 32) * 4 * BIH.biHeight;
Mem.Write( BIH, Sizeof( BIH ) );
@ -52509,6 +52819,7 @@ begin
TVIns.item.mask := TVIF_TEXT;
TVIns.item.pszText := PKOLChar( Txt );
Result := Perform( TVM_INSERTITEM, 0, Integer( @TVIns ) );
if fUpdateCount <= 0 then
Invalidate;
end;
@ -53686,7 +53997,7 @@ end;
var SaveWinVer: Byte = $FF;
//[function WinVer]
{$IFDEF ASM_VERSION}
{$IFDEF nonononoASM_VERSION} // todo: fix asm version first
{$ELSE ASM_VERSION}
function WinVer : TWindowsVersion;
var MajorVersion, MinorVersion: Byte;
@ -54109,7 +54420,7 @@ begin
ItemState := ItemState + [ odsMarked ];
end;
Sender.Canvas;
//Sender.Canvas; //????????????????????????????
Rslt := Sender.FOnLVCustomDraw( Sender, {Sender.fPaintDC} NMCustDraw.nmcd.hdc,
NMCustDraw.nmcd.dwDrawStage, ItemIdx, SubItemIdx, NMCustDraw.nmcd.rc,
@ -54222,7 +54533,7 @@ end;
//[function CompareLVColumns]
function CompareLVColumns( Idx1, Idx2: Integer; Sender: PControl ): Integer; stdcall;
var S1, S2: AnsiString;
var S1, S2: KOLString;
begin
//--- changed by Mike Gerasimov:
S1 := Sender.LVItems[ Idx1, Sender.fColumn ];

4
KOLDirDlgEx.pas
View File

@ -291,7 +291,7 @@ begin
begin
if WinVer >= wvNT then
begin
// _FindFirstFileEx;
_FindFirstFileEx;
F := FFindFirstFileEx( PChar( DirTree.TVItemPath( node, '\' ) + '\*.*' ),
FindExInfoStandard, @ Find32, FindExSearchLimitToDirectories, nil, 0 );
if F <> INVALID_HANDLE_VALUE then
@ -986,7 +986,7 @@ begin
else
if WinVer >= wvNT then // ������������ ����� ������� ������� - ��� NT/2K/XP
begin
// _FindFirstFileEx;
_FindFirstFileEx;
F := FFindFirstFileEx( PChar( p + '*.*' ), FindExInfoStandard, @ Find32,
FindExSearchLimitToDirectories, nil, 0 );
if F <> INVALID_HANDLE_VALUE then

2
KOLMCK_D2006.dpk
View File

@ -1,6 +1,6 @@
package KOLMCK_D2006;
{$R *.res}
{$R KOLMCK.res}
{$ALIGN 4}
{$ASSERTIONS ON}
{$BOOLEVAL OFF}

112
KOL_ASM.inc
View File

@ -166,19 +166,16 @@ function TObj.RefDec: Integer;
asm
TEST EAX, EAX
JZ @@exit
{$IFDEF OLD_REFCOUNT}
SUB [EAX].fRefCount, 2
JGE @@exit
{$IFDEF OLD_REFCOUNT}
TEST [EAX].fRefCount, 1
JZ @@exit
MOV EDX, [EAX]
PUSH dword ptr [EDX+4]
{$ELSE}
SUB [EAX].fRefCount, 2
JGE @@exit
{$ENDIF}
MOV EDX, [EAX]
PUSH dword ptr [EDX+4]
{$ENDIF}
@@exit:
end;
@ -1754,7 +1751,7 @@ asm
CLD
PUSH EDX //Canvas.fHandle
CALL Arc
CALL Windows.Arc
POP ESI
end;
@ -3311,7 +3308,7 @@ asm
SETZ AL
end;
function AnsiEq( const S1, S2 : AnsiString ) : Boolean;
function AnsiEq( const S1, S2 : KOLString ) : Boolean;
asm
CALL AnsiCompareStrNoCase
TEST EAX, EAX
@ -5135,6 +5132,7 @@ asm //cmd //opd
XOR EAX, EAX
end;
{$IFDEF BITBTN_ASM}
function NewBitBtn( AParent: PControl; const Caption: KOLString;
Options: TBitBtnOptions; Layout: TGlyphLayout; GlyphBitmap: HBitmap; GlyphCount: Integer ): PControl;
const szBitmapInfo = sizeof(TBitmapInfo);
@ -5314,6 +5312,7 @@ asm
POP EDX
{$ENDIF}
end;
{$ENDIF BITBTN_ASM}
function NewCheckbox( AParent: PControl; const Caption: KOLString ): PControl;
asm
@ -6370,6 +6369,7 @@ asm
OR [EAX].TControl.fStyle, EDX
end;
// by Galkov, Jun-2009
function WndProcNotify( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
asm
CMP word ptr [EDX].TMsg.message, WM_NOTIFY
@ -11757,8 +11757,6 @@ asm
end;
{procedure TControl.SetCurIndex(const Value: Integer);
var
idx: Integer;
asm
MOVZX ECX, [EAX].fCommandActions.aSetCurrent
JECXZ @@set_item_sel
@ -11768,14 +11766,9 @@ asm
PUSH ECX
PUSH EAX
CALL Perform
mov idx, eax
POPAD
CMP CX, TCM_SETCURSEL
JNE @@exit
push ecx
mov ecx, idx
mov [EAX].fCurIndex, ecx
pop ecx
PUSH TCN_SELCHANGE
PUSH EAX // idfrom doesn't matter
PUSH [EAX].fHandle
@ -11787,12 +11780,11 @@ asm
POP ECX
POP ECX
POP ECX
jmp @@exit
@@exit:
RET
@@set_item_sel:
INC ECX
CALL SetItemSelected
@@exit:
// RET
end;}
procedure TControl.SetCurIndex(const Value: Integer); // fix av
@ -12586,16 +12578,20 @@ end;
{$IFDEF ASM_TLIST}
function TStrList.IndexOf(const S: Ansistring): integer;
asm
PUSH EBX
PUSH EDI
PUSH ESI
OR EBX, -1
PUSH EBX
OR EDI, -1
MOV ECX, [EAX].fCount
JECXZ @@exit
MOV ESI, [EAX].fList
MOV ESI, [ESI].TList.fItems
CALL EDX2PChar
MOVZX EBX, BYTE[EDX]
@@loo: LODSD
INC EBX
INC EDI
CMP BL, BYTE[EAX]
JNE @@1
PUSH EDX
PUSH ECX
CALL StrComp
@ -12603,10 +12599,11 @@ asm
POP EDX
JE @@exit
@@1: LOOP @@loo
OR EBX, -1
@@exit: XCHG EAX, EBX
POP ESI
OR EDI, -1
@@exit: XCHG EAX, EDI
POP EBX
POP ESI
POP EDI
end;
{$ENDIF}
@ -12817,48 +12814,43 @@ asm
end;
{$IFDEF ASM_TLIST}
function CompareStrListItems( const Sender : Pointer; const e1, e2 : DWORD ) : Integer;
function CompareStrListItems_Case( const Sender : Pointer; const e1, e2 : DWORD ) : Integer;
asm
CMP [EAX].TStrList.fCaseSensitiveSort, 0
MOV EAX, [EAX].TStrList.fList
MOV EAX, [EAX].TList.fItems
MOV EDX, [EAX+EDX*4]
MOV EAX, [EAX+ECX*4]
XCHG EAX, EDX
JNZ StrComp
PUSH EBX
JMP StrComp
end;
XCHG EBX, EAX
CALL LowerCaseStrFromPCharEDX
MOV EDX, EBX
CALL LowerCaseStrFromPCharEDX
POP EAX
POP EDX
PUSH EDX
PUSH EAX
CALL EAX2PChar
CALL EDX2PChar
CALL StrComp
XCHG EBX, EAX
CALL RemoveStr
CALL RemoveStr
XCHG EAX, EBX
POP EBX
function CompareStrListItems_NoCase( const Sender : Pointer; const e1, e2 : DWORD ) : Integer;
asm
MOV EAX, [EAX].TStrList.fList
MOV EAX, [EAX].TList.fItems
MOV EDX, [EAX+EDX*4]
MOV EAX, [EAX+ECX*4]
XCHG EAX, EDX
JMP StrComp_NoCase
end;
function CompareAnsiStrListItems( const Sender : Pointer; const e1, e2 : DWORD ) : Integer;
asm
CMP byte ptr [EAX].TStrList.fCaseSensitiveSort, 0
MOV EAX, [EAX].TStrList.fList
MOV EAX, [EAX].TList.fItems
MOV EDX, [EAX+EDX*4]
MOV EAX, [EAX+ECX*4]
XCHG EAX, EDX
JZ _AnsiCompareStrNoCase
JMP _AnsiCompareStrNoCase
end;
function CompareAnsiStrListItems_Case( const Sender : Pointer; const e1, e2 : DWORD ) : Integer;
asm
MOV EAX, [EAX].TStrList.fList
MOV EAX, [EAX].TList.fItems
MOV EDX, [EAX+EDX*4]
MOV EAX, [EAX+ECX*4]
XCHG EAX, EDX
JMP _AnsiCompareStr
end;
{$ENDIF}
@ -12866,18 +12858,26 @@ end;
procedure TStrList.Sort(CaseSensitive: Boolean);
asm
MOV [EAX].fCaseSensitiveSort, DL
MOV [EAX].fAnsiSort, 0
PUSH Offset[TStrList.Swap]
MOV ECX, Offset[CompareStrListItems]
MOV EDX, [EAX].fCount
MOV ECX, Offset[CompareStrListItems_Case]
CMP DL, 0
JNZ @1
MOV ECX, Offset[CompareStrListItems_NoCase]
@1: MOV EDX, [EAX].fCount
CALL SortData
end;
procedure TStrList.AnsiSort(CaseSensitive: Boolean);
asm
MOV [EAX].fCaseSensitiveSort, DL
MOV [EAX].fAnsiSort, 1
PUSH Offset[TStrList.Swap]
MOV ECX, Offset[CompareAnsiStrListItems]
MOV EDX, [EAX].fCount
CMP DL, 0
JZ @1
MOV ECX, Offset[CompareAnsiStrListItems_Case]
@1: MOV EDX, [EAX].fCount
CALL SortData
end;
@ -17898,7 +17898,7 @@ asm //cmd //opd
//@@exit: XCHG EAX, ECX
end;
function WinVer : TWindowsVersion;
{function WinVer : TWindowsVersion;
asm
MOVSX EAX, byte ptr [SaveWinVer]
INC AH // ���� <> 0 ����� ����������, �� AL �������� ����������� ������
@ -17908,7 +17908,6 @@ asm
XOR EAX, EAX
TEST EDX, EDX
XCHG DL, DH // DH=MajorVersion; DL=MinorVersion
JL @@platform_9x
MOV AL, wvNT
CMP DX, $0400
@ -17946,8 +17945,7 @@ asm
@@save_exit:
MOV byte ptr [SaveWinVer], AL
@@exit:
end;
end;}
//======================================== THE END OF FILE KOL_ASM.inc

12
KOLadd.pas
View File

@ -222,9 +222,9 @@ type
function AddAnsiObject( const S: AnsiString; Obj: DWORD ): Integer;
{* Adds Ansi AnsiString and correspondent object to a list. }
function Add(S: PAnsiChar): integer;
{* Adds a AnsiString to list. }
{* Adds an AnsiString to list. }
function AddLen(S: PAnsiChar; Len: Integer): integer;
{* Adds a AnsiString to list. The AnsiString can contain #0 characters. }
{* Adds an AnsiString to list. The AnsiString can contain #0 characters. }
public
FastClear: Boolean;
{* }
@ -238,7 +238,7 @@ type
{* Returns index of first AnsiString, equal to given one (while comparing it
without case sensitivity). }
function IndexOfStrL_NoCase( Str: PAnsiChar; L: Integer ): integer;
{* Returns index of first AnsiString, equal to given one (while comparing it
{* Returns index of the first AnsiString, equal to given one (while comparing it
without case sensitivity). }
function Find(const S: AnsiString; var Index: Integer): Boolean;
{* Returns Index of the first AnsiString, equal or greater to given pattern, but
@ -827,7 +827,7 @@ function ShowQuestion( const S: KOLString; Answers: KOLString ): Integer;
application. Also, this function *must* be used in MDI applications
in place of any dialog functions, based on MessageBox.
|<br>
The second parameter should be empty AnsiString or several possible
The the second parameter should be empty AnsiString or several possible
answers separated by '/', e.g.: 'Yes/No/Cancel'. Result is
a number answered, starting from 1. For example, if 'Cancel'
was pressed, 3 will be returned.
@ -2341,7 +2341,7 @@ asm
MOV ECX, [EBX].FMonitor
JECXZ @@no_monitor
XCHG EAX, ECX
CALL TObj.Destroy
CALL TObj.Destroy // TObj.Free //
@@no_monitor:
MOV ECX, [EBX].FHandle
JECXZ @@exit
@ -3308,6 +3308,7 @@ begin
end;
//[END KeyClick]
{$IFDEF SNAPMOUSE2DFLTBTN}
function WndProcDlg( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var F, B: PControl;
R: TRect;
@ -3328,6 +3329,7 @@ begin
end;
end;
end;
{$ENDIF}
//[function ShowQuestionEx]
function ShowQuestionEx( S: KOLString; Answers: KOLString; CallBack: TOnEvent ): Integer;

7
mirror.pas
View File

@ -19,7 +19,7 @@ mmmmm mmmmm mmmmm cccccccccccc kkkkk kkkkk
Key Objects Library (C) 1999 by Kladov Vladimir.
KOL Mirror Classes Kit (C) 2000 by Kladov Vladimir.
********************************************************
* VERSION 2.87
* VERSION 2.89
********************************************************
}
unit mirror;
@ -21447,7 +21447,7 @@ begin
if S <> '' then
//SL.Add( S + ';' );
{P}SL.Add( S );
(*) ... for a frame, this is not applicable ...
(* ... for a frame, this is not applicable ...
if MinimizeNormalAnimated then
//SL.Add( Prefix + AName + '.MinimizeNormalAnimated;' );
begin
@ -21457,7 +21457,7 @@ begin
begin
SL.Add( ' DUP TControl.RestoreNormalMaximized<1>' )
end;
(*)
*)
if Assigned( FpopupMenu ) then
//SL.Add( Prefix + AName + '.SetAutoPopupMenu( Result.' + FpopupMenu.Name +
// ' );' );
@ -21835,6 +21835,7 @@ var N: Integer;
if MI.itemindex >= 0 then
begin
if not MI.separator or generateSeparatorConstants then
//SL.Add( 'const ' + MI.Name + ': Integer = ' + IntToStr( MI.itemindex ) + ';' );
SL.Add( 'const ' + MI.Name + ' = ' + IntToStr( MI.itemindex ) + ';' );
Inc( N );
end;

8
read1st.txt
View File

@ -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, TurboDelphi5 and Free Pascal Compiler 1.0.5, 1.0.6, and higher (2.0.4 and above) 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 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-2007.
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. 2.88 (27-Sep-2008 �.)
v. 2.89 (30-Mar-2010)
To get newer version, go to Web-page http://www.kolmck.net and get there updates.
@ -16,7 +16,7 @@ BRIEF DESCRIPTION:
A lot of additions are available for KOL, which allow to work with data bases, Active-X components, print reports, different image and compression formats, etc.
--------------------------------------------
This archive contains Key Objects Library main part: KOL.PAS and several test samples. At the KOL Web page (http://kolmck.net), you can download also additional components:
This archive contains Key Objects Library main part: KOL.PAS and several test samples. At the KOL Web page (http://bonanzas.rinet.ru), you can download also additional components:
MCK - Mirror Classes Kit - visual programming environment for KOL
xHelpGen - utility to generate html-documentation from comments within the source code;

4
read1st_rus.txt
View File

@ -1,12 +1,12 @@
KEY OBJECTS LIBRARY ��� Delphi (� Free Pascal Compiler) - ������������ ��� ����, ����� ������� ���������, ������������� � �������������� ����� �������, ���������� � ����� ����������.
Copyright (C) by Vladimir Kladov, 1999-2007. ���������, � ��������� ��������.
������ 2.88 (27 �������� 2008 �.)
������ 2.89 (30 ����� 2010 �.)
_________________
������� ��������:
�� KOL - Key Objects Library - ��� ���������� �������� ��� ���������������� � ����� Delphi.
�� �������������� ������ Delphi2, Delph3, Delphi4, Delphi5, Delphi6, Delphi7, Delphi8, BDS2005, BDS2006, Turbo-Delphi � ��� �� Free Pascal v1.0.5, v2.0.4 � ����. ������� ��� �� ��������� ������������� � Kylix (��������� ��������� � ����� ������, ��. � ������� "����������� ������������" �� ����� http://kolmck.net). ������� ������ ��� ������������� �� ������ ��������� (Linux, Win CE).
�� �������������� ������ 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).
���������� KOL ��������� ������������� ����������� ���������� GUI-���������� (�� 11� ��� ������ - ��� ������� ������������� ������������ ������ ��������� ������� system, sysinit, ��. �� ����� ������ "������"). ������� ����� ���� ���������� �� ���������.
�� � ���������� ����������� ��������� - ��������� ������� (xHelpGen), ����������� ��������� ������������ �� ���������� � html-�������. ������� ����������� �� ������ ������������ � �������� �������, ��� ��� ������������ ������ ����� ������ � ����� ������ � ������ ������������.
�� � �������������� MCK (Mirror Classes Kit - ����� ���������� �������) ��� �������� ���������� ���������� �������� � ������ ���� �������� � ��� �������������, ������������ KOL. ������������� � MCK ������� ����������� ��� ����� ��������� ����������, ������������� ��������� �-��� ����������� ������ ������ �������-���� ��� ������������� ���� (��. ���������: Collapse).