diff --git a/Addons/ActiveKOL.pas b/Addons/ActiveKOL.pas index ff66588..6f62f0c 100644 --- a/Addons/ActiveKOL.pas +++ b/Addons/ActiveKOL.pas @@ -180,7 +180,7 @@ type function SetStatusText(pszStatusText: POleStr): HResult; stdcall; function EnableModeless(fEnable: BOOL): HResult; stdcall; function IOleInPlaceFrame.TranslateAccelerator = OleInPlaceFrame_TranslateAccelerator; - function OleInPlaceFrame_TranslateAccelerator(var msg: TMsg; + function OleInPlaceFrame_TranslateAccelerator(var msg: Windows.TMsg; wID: Word): HResult; stdcall; { IDispatch } function GetTypeInfoCount(out Count: Integer): HResult; stdcall; @@ -2383,7 +2383,7 @@ begin Result := S_OK; end; -function TOleCtlIntf.OleInPlaceFrame_TranslateAccelerator(var msg: TMsg; +function TOleCtlIntf.OleInPlaceFrame_TranslateAccelerator(var msg: Windows.TMsg; wID: Word): HResult; begin Result := S_FALSE; diff --git a/Addons/err.pas b/Addons/err.pas index b6d2720..daeba01 100644 --- a/Addons/err.pas +++ b/Addons/err.pas @@ -21,10 +21,11 @@ Key Objects Library (C) 2000 by Kladov Vladimir. - mailto: vk@kolmck.net - Home: http://kolmck.net + mailto: bonanzas@xcl.cjb.net + Home: http://kol.nm.ru + http://xcl.cjb.net + http://xcl.nm.ru - This version is compatible with KOL 3.00+ =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-} { This code is grabbed mainly from standard SysUtils.pas unit, diff --git a/KOL.pas b/KOL.pas index 704de8d..fb81484 100644 --- a/KOL.pas +++ b/KOL.pas @@ -14,7 +14,7 @@ Key Objects Library (C) 2000 by Kladov Vladimir. **************************************************************** -* VERSION 3.03 +* VERSION 3.04 **************************************************************** K.O.L. - is a set of objects to create small programs @@ -2547,7 +2547,7 @@ type fFont : PGraphicTool; // order is important for ASM version {$IFDEF GDI} fCopyMode : TCopyMode; - fOnChange: TOnEvent; + fOnChangeCanvas: TOnEvent; {$ENDIF GDI} fOnGetHandle: TOnGetHandle; {$IFDEF _X_} @@ -2719,7 +2719,7 @@ type {* Current copy mode. Is used in CopyRect method. } procedure CopyRect( const DstRect : TRect; SrcCanvas : PCanvas; const SrcRect : TRect ); {* Copyes a rectangle from source to destination, using StretchBlt. } - property OnChange: TOnEvent read fOnChange write fOnChange; + property OnChange: TOnEvent read fOnChangeCanvas write fOnChangeCanvas; {* } function Assign( SrcCanvas : PCanvas ) : Boolean; {* } @@ -2783,6 +2783,8 @@ type TImageList - images container ----------------------------------------------------------------------- } TImageList = object( TObj ) + private + fOverlayIdx: Integer; {* ImageList incapsulation. } protected FHandle: THandle; @@ -2895,6 +2897,8 @@ type other images from the image list). These overalay images can be used in listview and treeview as overlaying images (up to four masks at the same time). } + property OverlayIdx: Integer read fOverlayIdx write fOverlayIdx; + {* Set this value to 1..15 to draw images overlayed (using Draw or DrawEx). } {$IFDEF USE_CONSTRUCTORS} constructor CreateImageList( POwner: Pointer ); {$ENDIF USE_CONSTRUCTORS} @@ -3738,7 +3742,7 @@ const idx_fOnDeadChar = 15; idx_fOnKeyUp = 16; idx_fOnKeyDown = 17; - idx_fOnChange = 18; + idx_fOnChangeCtl = 18; idx_fOnEnter = 19; idx_fOnLeave = 20; idx_fLeave = 21; @@ -4515,7 +4519,7 @@ type fOnKeyUp: TOnKey; fOnKeyDown: TOnKey; - fOnChange: TOnEvent; + fOnChangeCtl: TOnEvent; fOnEnter: TOnEvent; fOnLeave: TOnEvent; fLeave: TOnEvent; @@ -7095,9 +7099,9 @@ type read {$IFDEF EVENTS_DYNAMIC} Get_TOnEvent {$ELSE} EV.fOnLeave {$ENDIF} write {$IFDEF EVENTS_DYNAMIC} Set_TOnEvent {$ELSE} EV.fOnLeave{$ENDIF}; {* Called when control looses focus. } - property OnChange: TOnEvent index idx_fOnChange - read {$IFDEF EVENTS_DYNAMIC} Get_TOnEvent {$ELSE} EV.fOnChange {$ENDIF} - write {$IFDEF EVENTS_DYNAMIC} Set_TOnEvent {$ELSE} EV.fOnChange {$ENDIF}; + property OnChange: TOnEvent index idx_fOnChangeCtl + read {$IFDEF EVENTS_DYNAMIC} Get_TOnEvent {$ELSE} EV.fOnChangeCtl {$ENDIF} + write {$IFDEF EVENTS_DYNAMIC} Set_TOnEvent {$ELSE} EV.fOnChangeCtl {$ENDIF}; {* |<#edit> |<#memo> |<#listbox> @@ -8390,6 +8394,10 @@ type This also can be index of separator button. -1 is returned if there are no buttons found at the position. } + function TBBtnEvent( Idx: Integer ): TOnToolbarButtonClick; + {* Returns toolbar event handler assigned to a toolbar button + (by its index). } + function TBMoveBtn( FromIdx, ToIdx: Integer ): Boolean; {* |<#toolbar> By TR"]F. Moves button from one position to another. } @@ -8409,6 +8417,9 @@ type is useful both for static and dynamic toolbars (meaning "dynamic" - toolbars with buttons, deleted and inserted at run-time). } + function TBBtnTooltip( BtnID: Integer ): KOLString; + {* |<#toolbar> Returns tooltip assigned to a toolbar button. } + property TBAutoSizeButtons: Boolean read GetTBAutoSizeButtons write SetTBAutoSizeButtons; property OnTBDropDown: TOnEvent index idx_FOnDropDown @@ -8541,6 +8552,8 @@ type function CenterOnParent: PControl; {* Centers control on parent, or if applied to a form, centers form on screen. } + function CenterOnForm( Form1: PControl ): PControl; + {* Centers form on another form. If Form1 not present, centers on screen. } function Shift( dX, dY : Integer ): PControl; {* Moves control respectively to current position (Left := Left + dX, @@ -11739,7 +11752,7 @@ type etc.). } PDayTable = ^TDayTable; - TDayTable = array[1..12] of Word; + TDayTable = array[1..12] of Byte; TDateFormat = ( dfShortDate, dfLongDate ); {* Date formats available to use in formatting date/time to string. } @@ -12855,7 +12868,7 @@ type function GetTopParent: PMenu; function GetState( const Index: Integer ): Boolean; procedure SetState( const Index: Integer; Value: Boolean ); - procedure SetVisible( Value: Boolean ); + procedure SetMenuVisible( Value: Boolean ); procedure SetData( Value: Pointer ); procedure SetMenuItemCaption( const Value: KOLString ); function FillMenuItems(AHandle: HMenu; StartIdx: Integer; @@ -12985,7 +12998,7 @@ type Visible property, then setting it again. } property Highlight: Boolean index MFS_HILITE read GetState write SetState; {* Highlight state of the item. } - property Visible: Boolean read FVisible write SetVisible; + property Visible: Boolean read FVisible write SetMenuVisible; {* Visibility of menu item. } property Data: Pointer read FData write SetData; {* Data pointer, associated with the menu item. } @@ -15748,7 +15761,7 @@ const InitEventsTable: array[ 0..idx_LastEvent ] of Byte = ( idummy4_TRUE, //idx_fOnDeadChar = 15; idummy4_TRUE, //idx_fOnKeyUp = 16; idummy4_TRUE, //idx_fOnKeyDown = 17; - idummy123, //idx_fOnChange = 18; + idummy123, //idx_fOnChangeCtl = 18; idummy123, //idx_fOnEnter = 19; idummy123, //idx_fOnLeave = 20; idummy123, //idx_fLeave = 21; @@ -17812,9 +17825,9 @@ begin fPangoFontDesc := nil; END; ///////////////////////////////// - IF Assigned( fOnChange ) THEN + IF Assigned( fOnGTChange ) THEN ///////////////////////////////// - fOnChange( @Self ); + fOnGTChange( @Self ); {$ENDIF GTK} end; {$ENDIF ASM_VERSION} @@ -18718,9 +18731,9 @@ end; procedure TCanvas.Changing; begin ////////////////////////////// - if Assigned( fOnChange ) then + if Assigned( fOnChangeCanvas ) then ////////////////////////////// - fOnChange( @Self ); + fOnChangeCanvas( @Self ); end; {$ENDIF ASM_VERSION} @@ -25063,15 +25076,18 @@ const Dot: AnsiString = '.'; var I: Integer; F: PKOLChar; HasOnlyNegFilters: Boolean; + dots: Boolean; begin Result := (((FileAttr and FindAttr) = FindAttr) or LongBool(FindAttr and FILE_ATTRIBUTE_NORMAL)); if not Result then Exit; - if (KOLString(FileName) <> {$IFDEF UNICODE_CTRLS} KOLWideString( '.' ) - {$ELSE} {$IFDEF F_P}Dot{$ELSE}'.'{$ENDIF} - {$ENDIF UNICODE_CTRLS} ) and - (FileName <> '..') then + dots := (FileName^ = {$IFDEF F_P}Dot{$ELSE}'.'{$ENDIF}) + and ( (FileName[1] = {$IFDEF F_P}Dot{$ELSE}'.'{$ENDIF}) + and (FileName[2] = #0) + or (FileName[1] = #0) ); + + if not dots then if LongBool( FindAttr and FILE_ATTRIBUTE_NORMAL ) and (FindAttr <> FILE_ATTRIBUTE_NORMAL) then if LongBool( FindAttr and FILE_ATTRIBUTE_DIRECTORY ) and @@ -25080,22 +25096,12 @@ begin HasOnlyNegFilters := TRUE; for I := 0 to fFilters.Count - 1 do begin - F := PKOLChar(fFilters.fList.Items[ I ]); - if F = '' then continue; - - if (KOLString(F) = {$IFDEF UNICODE_CTRLS} KOLWideString( '.' ) {$ELSE} - {$IFDEF F_P}Dot{$ELSE}'.'{$ENDIF} - {$ENDIF UNICODE_CTRLS} ) or (F = '..') then - begin - if FileName = F then + F := fFilters.ItemPtrs[ I ]; + if F = '' then continue; + if FileName = F then Exit; - end - else - if (KOLString(Filename) = {$IFDEF UNICODE_CTRLS} KOLWideString( '.' ) {$ELSE} - {$IFDEF F_P}Dot{$ELSE}'.'{$ENDIF} - {$ENDIF UNICODE_CTRLS} ) or (FileName = '..') then - continue; - + if dots then + continue; if F[ 0 ] = '^' then begin if StrSatisfy( FileName, PKOLChar(@F[ 1 ]) ) then @@ -25109,16 +25115,13 @@ begin HasOnlyNegFilters := FALSE; if StrSatisfy( FileName, F ) then begin - Result := True; + //Result := True; Exit; end; end; end; - Result := HasOnlyNegFilters and - (KOLString(FileName) <> {$IFDEF UNICODE_CTRLS} KOLWideString( '.' ) {$ELSE} - {$IFDEF F_P}Dot{$ELSE}'.'{$ENDIF} - {$ENDIF UNICODE_CTRLS} ) and (FileName <> '..'); + Result := HasOnlyNegFilters and not dots; end; {$ENDIF ASM_VERSION} @@ -25275,7 +25278,6 @@ end; procedure TDirList.ScanDirectory(const DirPath, Filter: KOLString; Attr: DWord); var FindData : TFindFileData; - //E : PFindFileData; Action: TDirItemAction; {$IFDEF FORCE_ALTERNATEFILENAME} IsUnicode: KOLString; @@ -25466,7 +25468,7 @@ var I : Integer; W1, W2: KOLWideString; {$ENDIF} IsDir1, IsDir2 : Boolean; - Date1, Date2 : PFileTime; + sz1, sz2: I64; begin Item1 := Data.Dir.Get( e1 ); // fList.Items[ e1 ]; Item2 := Data.Dir.Get( e2 ); // fList.Items[ e2 ]; @@ -25545,6 +25547,11 @@ begin end; sdrBySize, sdrBySizeDescending: begin + {$IFDEF _D4orHigher} + sz1 := MakeInt64( Item1.nFileSizeLow, Item1.nFileSizeHigh ); + sz2 := MakeInt64( Item2.nFileSizeLow, Item2.nFileSizeHigh ); + Result := Cmp64(sz1, sz2); + {$ELSE} if Item1.nFileSizeHigh < Item2.nFileSizeHigh then Result := -1 else @@ -25556,27 +25563,16 @@ begin else if Item1.nFileSizeLow > Item2.nFileSizeLow then Result := 1; + {$ENDIF} if Data.Rules[ I ] = sdrBySizeDescending then Result := -Result; end; sdrByDateCreate: - begin - Date1 := @Item1.ftCreationTime; - Date2 := @Item2.ftCreationTime; - Result := CompareFileTime( Date1^, Date2^ ); - end; + Result := CompareFileTime( Item1.ftCreationTime, Item2.ftCreationTime ); sdrByDateChanged: - begin - Date1 := @Item1.ftLastWriteTime; - Date2 := @Item2.ftLastWriteTime; - Result := CompareFileTime( Date1^, Date2^ ); - end; + Result := CompareFileTime( Item1.ftLastWriteTime, Item2.ftLastWriteTime ); sdrByDateAccessed: - begin - Date1 := @Item1.ftLastAccessTime; - Date2 := @Item2.ftLastAccessTime; - Result := CompareFileTime( Date1^, Date2^ ); - end; + Result := CompareFileTime( Item1.ftLastAccessTime, Item2.ftLastAccessTime ); sdrNone: break; end; {case} if Result <> 0 then break; @@ -26229,8 +26225,11 @@ begin {(wMonth >= 1) and !otherwise can not convert time only!} (wMonth <= 12) and {(wDay >= 1) and !otherwise can not convert time only!} - (wDay <= DayTable^[wMonth]) and // - (wHour < 24) and (wMinute < 60) and (wSecond < 60) and (wMilliSeconds < 1000) then // + (wDay <= DayTable^[wMonth]) + {$IFDEF SAFEST_CODE} + and (wHour < 24) and (wMinute < 60) + and (wSecond < 60) and (wMilliSeconds < 1000) + {$ENDIF} then // begin _Day := wDay; for I := 1 to wMonth - 1 do @@ -26240,7 +26239,8 @@ begin if I<0 then i := 0; // //--------------------------------------++ DateTime := I * 365 + I div 4 - I div 100 + I div 400 + _Day - + (wHour * 3600000 + wMinute * 60000 + wSecond * 1000 + wMilliSeconds) / MSecsPerDay; + + (((wHour * 60 + wMinute) * 60 + wSecond) * 1000 + wMilliSeconds) + / MSecsPerDay; Result := True; end; end; @@ -29887,7 +29887,7 @@ begin end; end; -procedure TMenu.SetVisible( Value: Boolean ); +procedure TMenu.SetMenuVisible( Value: Boolean ); var I, J: Integer; M: PMenu; Before: Integer; @@ -31129,7 +31129,7 @@ BEGIN Result.Add2AutoFree( Result.fFont ); {$ENDIF USE_AUTOFREE4CONTROLS} Result.fFont.fParentGDITool := AParent.fFont; - Result.fFont.fOnChange := Result.FontChanged; + Result.fFont.fOnGTChange := Result.FontChanged; Result.FontChanged( Result.fFont ); END; {$ENDIF WIN_GDI} @@ -31143,7 +31143,7 @@ BEGIN Result.Add2AutoFree( Result.fBrush ); {$ENDIF USE_AUTOFREE4CONTROLS} Result.fBrush.fParentGDITool := AParent.fBrush; - Result.fBrush.fOnChange := Result.BrushChanged; + Result.fBrush.fOnGTChange := Result.BrushChanged; Result.BrushChanged( Result.fBrush ); END; {$ENDIF WIN_GDI} @@ -32558,11 +32558,11 @@ asm {$ELSE} XOR [EBX].TControl.fChecked, 1 {$ENDIF} - MOV ECX, [EBX].TControl.fOnChange.TMethod.Code + MOV ECX, [EBX].TControl.fOnChangeCtl.TMethod.Code {$IFDEF NIL_EVENTS} JECXZ @@not_fixed {$ENDIF} - MOV EAX, [EBX].TControl.fOnChange.TMethod.Data + MOV EAX, [EBX].TControl.fOnChangeCtl.TMethod.Data MOV EDX, EBX JMP ECX @@pushed: @@ -32839,9 +32839,9 @@ begin else include( Self_.fFlagsG4, G4_Checked ); {$ELSE} Self_.fChecked := not Self_.fChecked; {$ENDIF} {$IFDEF NIL_EVENTS} - if Assigned( Self_.EV.fOnChange ) then + if Assigned( Self_.EV.fOnChangeCtl ) then {$ENDIF} - Self_.EV.fOnChange( Self_ ); + Self_.EV.fOnChangeCtl( Self_ ); end; if Self_.DF.fRepeatInterval > 0 then begin @@ -32871,9 +32871,9 @@ begin else include( Self_.fFlagsG4, G4_Checked ); {$ELSE} Self_.fChecked := not Self_.fChecked; {$ENDIF} {$IFDEF NIL_EVENTS} - if Assigned( Self_.EV.fOnChange ) then + if Assigned( Self_.EV.fOnChangeCtl ) then {$ENDIF} - Self_.EV.fOnChange( Self_ ); + Self_.EV.fOnChangeCtl( Self_ ); end; Self_.DoClick; SetTimer( Self_.fHandle, 1, Self_.DF.fRepeatInterval, nil ); @@ -33449,6 +33449,7 @@ begin Right := Left + W; Bottom := Top + H; end; + Result.CurIndex := ImgIdx; end; //===================== Scrollbar ========================// @@ -36925,9 +36926,9 @@ begin Self_.EV.fOnCloseUp( Self_ ); DTN_DATETIMECHANGE: {$IFDEF NIL_EVENTS} - if Assigned( Self_.EV.fOnChange ) then + if Assigned( Self_.EV.fOnChangeCtl ) then {$ENDIF} - Self_.EV.fOnChange( Self_ ); + Self_.EV.fOnChangeCtl( Self_ ); DTN_USERSTRING: {$IFDEF NIL_EVENTS} if Assigned( Self_.EV.fOnDTPUserString ) then @@ -37867,7 +37868,7 @@ begin {$ENDIF} {$IFDEF USE_MHTOOLTIP} {$DEFINE destroy} - fHint.Free; + /////fHint.Free; {$UNDEF destroy} {$ENDIF USE_MHTOOLTIP} {$IFDEF DEBUG} @@ -41169,7 +41170,7 @@ begin {$IFDEF NIL_EVENTS} Assigned( PP.fExMsgProc ) and {$ENDIF} PP.fExMsgProc( @Self, Msg )) then begin - TranslateMessage( Msg ); + TranslateMessage( Windows.TMsg( Msg ) ); DispatchMessage( Msg ); {$IFDEF PSEUDO_THREADS} if Assigned( MainThread ) then @@ -41416,7 +41417,7 @@ begin end else if Integer(Cmd) = fCommandActions.aChange then begin - if Assigned( EV.fOnChange ) then EV.fOnChange( Self_ ); + if Assigned( EV.fOnChangeCtl ) then EV.fOnChangeCtl( Self_ ); end else if Integer(Cmd) = fCommandActions.aSelChange then begin @@ -42881,6 +42882,30 @@ begin end; {$ENDIF ASM_VERSION} +function TControl.CenterOnForm( Form1: PControl ): PControl; +var PCR, DR: TRect; +begin + Result := @Self; + if (Form1 = nil) then + PCR := MakeRect( 0, 0, GetSystemMetrics( SM_CXSCREEN ), GetSystemMetrics( SM_CYSCREEN ) ) + else + PCR := Form1.BoundsRect; + GetWindowHandle; + Left := PCR.Left + (PCR.Right - PCR.Left - Width) div 2; + Top := PCR.Top + (PCR.Bottom - PCR.Top - Height) div 2; + PCR := BoundsRect; + DR := GetDesktopRect; + if PCR.Right > DR.Right then + OffsetRect( PCR, DR.Right - PCR.Right, 0 ); + if PCR.Bottom > DR.Bottom then + OffsetRect( PCR, 0, DR.Bottom - PCR.Bottom ); + if PCR.Left < DR.Left then + OffsetRect( PCR, DR.Left - PCR.Left, 0 ); + if PCR.Top < DR.Top then + OffsetRect( PCR, 0, DR.Top - PCR.Top ); + BoundsRect := PCR; +end; + {$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.GetHasBorder: Boolean; begin @@ -48790,6 +48815,7 @@ begin Result := Result or ILD_MASK {else Result := Result or ILD_NORMAL}; // ILD_NORMAL = 0 + Result := Result or WORD(FOverlayIdx shl 8); end; {$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal @@ -51038,6 +51064,19 @@ begin end; end; +function TControl.TBBtnEvent( Idx: Integer ): TOnToolbarButtonClick; +var EventRec: PTBButtonEvent; +begin + Result := nil; + if DF.fTBevents = nil then Exit; + if Idx < DF.fTBevents.Count then + begin + EventRec := DF.fTBevents.{$IFDEF TLIST_FAST} Items {$ELSE} fItems {$ENDIF} + [ Idx ]; + Result := EventRec.Event; + end; +end; + procedure TControl.TBResetImgIdx( BtnID, BtnCount: Integer ); begin while BtnCount > 0 do @@ -51198,6 +51237,16 @@ begin end; {$ENDIF ASM_VERSION} +function TControl.TBBtnTooltip( BtnID: Integer ): KOLString; +var J: Integer; +begin + Result := ''; + if DF.fTBttCmd = nil then Exit; + J := DF.fTBttCmd.IndexOf( Pointer( BtnID ) ); + if J < 0 then Exit; + Result := DF.fTBttTxt.Items[ J ]; +end; + procedure ToolbarSetTooltips( Toolbar: PControl; BtnID1st: Integer; const Tooltips: array of PKOLChar ); begin @@ -58667,9 +58716,9 @@ begin EV.fOnSelChange( @Self ) else {$IFDEF NIL_EVENTS} - if Assigned( EV.fOnChange ) then + if Assigned( EV.fOnChangeCtl ) then {$ENDIF} - EV.fOnChange( @Self ); + EV.fOnChangeCtl( @Self ); end; {$IFNDEF NOT_USE_RICHEDIT} @@ -61609,7 +61658,38 @@ end; function TControl.DefaultBtnProc(var Msg: TMsg; var Rslt: Integer): Boolean; var Btn: PControl; - F, dfltBtn, cnclBtn: PControl; + F: PControl; + //dfltBtn, cnclBtn: PControl; + + procedure FindBtn( key: Word; s: PKOLChar; for_dflt: Boolean ); + var Ctl: PControl; + begin + Ctl := Pointer( F.PropInt[ s ] ); + if (Msg.wParam = key) and + (Ctl <> nil) and + Ctl.ToBeVisible and + Ctl.Enabled and + ( not for_dflt or + for_dflt and + ( (F.DF.fCurrentControl=nil) or + ({$IFDEF USE_FLAGS} not(G6_CancelBtn in F.DF.fCurrentControl.fFlagsG6) + {$ELSE} not F.DF.fCurrentControl.fCancelBtn {$ENDIF} and + {$IFDEF USE_FLAGS} not(G5_IgnoreDefault in F.DF.fCurrentControl.fFlagsG5) + {$ELSE} not F.DF.fCurrentControl.fIgnoreDefault {$ENDIF}) + or (F.DF.fCurrentControl = Ctl) + ) ) then + Btn := Ctl + else + if for_dflt + AND (Msg.wParam = VK_RETURN) and + (F.DF.fAllBtnReturnClick or DF.fAllBtnReturnClick) + and (F.ActiveControl <> nil) and + (F.ActiveControl.ToBeVisible) and + {$IFDEF USE_FLAGS} (G5_IsButton in F.ActiveControl.fFlagsG5) + {$ELSE} (F.ActiveControl.IsButton) {$ENDIF} + and (F.ActiveControl.Count = 0) then + Btn := F.ActiveControl; + end; begin {$IFDEF NIL_EVENTS} if Assigned( EV.fOldOnMessage ) then @@ -61629,6 +61709,9 @@ begin if ((Msg.message = WM_KEYDOWN) or (Msg.message = WM_KEYUP)) and ((Msg.wParam = VK_RETURN) or (Msg.wParam = VK_ESCAPE)) then begin + FindBtn( VK_RETURN, @DFLT_BTN, TRUE ); + FindBtn( VK_ESCAPE, @CNCL_BTN, FALSE ); + (* dfltBtn := Pointer( F.PropInt[ @DFLT_BTN ] ); // .DF.fDefaultBtnCtl; cnclBtn := Pointer( F.PropInt[ @CNCL_BTN ] ); //.DF.fCancelBtnCtl; if (Msg.wParam = VK_RETURN) and @@ -61658,6 +61741,7 @@ begin {$ELSE} (F.ActiveControl.IsButton) {$ENDIF} and (F.ActiveControl.Count = 0) then Btn := F.ActiveControl; + *) if Btn <> nil then begin if Msg.message = WM_KEYDOWN then @@ -62244,14 +62328,14 @@ begin fFont := fFont.Assign( AParent.fFont ); // if fFont <> nil then // begin // - fFont.fOnChange := FontChanged; // + fFont.fOnGTChange := FontChanged; // FontChanged( fFont ); // end; // fColor := AParent.fColor; // fBrush := fBrush.Assign( AParent.fBrush ); // if fBrush <> nil then // begin // - fBrush.fOnChange := BrushChanged; // + fBrush.fOnGTChange := BrushChanged; // BrushChanged( fBrush ); // end; // end; // @@ -63577,7 +63661,7 @@ begin new( Result, Create ); Result.fFont := Result.fFont.Assign( AParent.fFont ); if Result.fFont <> nil then begin Result.fFont.fParentGDITool := AParent.fFont; - Result.fFont.fOnChange := Result.FontChanged; + Result.fFont.fOnGTChange := Result.FontChanged; Result.FontChanged( Result.fFont ); end; end; diff --git a/KOL_ASM.inc b/KOL_ASM.inc index ed66f97..b2e2305 100644 --- a/KOL_ASM.inc +++ b/KOL_ASM.inc @@ -1,6 +1,6 @@ //------------------------------------------------------------------------------ // KOL_ASM.inc ()to be inlude in KOL.pas) -// v 3.03 +// v 3.03a function MsgBox( const S: KOLString; Flags: DWORD ): DWORD; asm @@ -1733,10 +1733,10 @@ end; procedure TCanvas.Changing; asm PUSHAD - MOV ECX, [EAX].fOnChange.TMethod.Code + MOV ECX, [EAX].fOnChangeCanvas.TMethod.Code JECXZ @@exit XCHG EDX, EAX - MOV EAX, [EDX].fOnChange.TMethod.Data + MOV EAX, [EDX].fOnChangeCanvas.TMethod.Data CALL ECX @@exit: POPAD @@ -2242,8 +2242,8 @@ asm MOV [EDX].fBrush, EAX - MOV [EAX].TGraphicTool.fOnChange.TMethod.Code, Offset[TCanvas.ObjectChanged] - MOV [EAX].TGraphicTool.fOnChange.TMethod.Data, EDX + MOV [EAX].TGraphicTool.fOnGTChange.TMethod.Code, Offset[TCanvas.ObjectChanged] + MOV [EAX].TGraphicTool.fOnGTChange.TMethod.Data, EDX MOV ECX, [EDX].fOwnerControl JECXZ @@1 @@ -2273,8 +2273,8 @@ asm PUSH EAX MOV [EDX].TCanvas.fFont, EAX - MOV [EAX].TGraphicTool.fOnChange.TMethod.Code, Offset[TCanvas.ObjectChanged] - MOV [EAX].TGraphicTool.fOnChange.TMethod.Data, EDX + MOV [EAX].TGraphicTool.fOnGTChange.TMethod.Code, Offset[TCanvas.ObjectChanged] + MOV [EAX].TGraphicTool.fOnGTChange.TMethod.Data, EDX MOV ECX, [EDX].fOwnerControl JECXZ @@1 @@ -7395,7 +7395,7 @@ asm //cmd //opd CMP CX, [EBX].TControl.fCommandActions.aLeave {$ENDIF} JE @@goEvent - //LEA EAX, [EBX].TControl.EV.fOnChange + //LEA EAX, [EBX].TControl.EV.fOnChangeCtl SUB EAX, 16 {$IFDEF COMMANDACTIONS_OBJ} CMP CX, [ESI].TCommandActionsObj.aChange @@ -11374,8 +11374,8 @@ asm CALL CreateCompatibleDC CALL NewCanvas MOV [EBX].fCanvas, EAX - MOV [EAX].TCanvas.fOnChange.TMethod.Code, offset[CanvasChanged] - MOV [EAX].TCanvas.fOnChange.TMethod.Data, EBX + MOV [EAX].TCanvas.fOnChangeCanvas.TMethod.Code, offset[CanvasChanged] + MOV [EAX].TCanvas.fOnChangeCanvas.TMethod.Data, EBX CALL TCanvas.GetBrush XOR EDX, EDX MOV ECX, [EBX].fBkColor diff --git a/KOLadd.pas b/KOLadd.pas index c25144c..69718c6 100644 --- a/KOLadd.pas +++ b/KOLadd.pas @@ -3338,6 +3338,7 @@ begin {$IFNDEF NO_CHECK_STAYONTOP} DoStayOnTop := FALSE; {$ENDIF NO_CHECK_STAYONTOP} + CurForm := nil; if Applet <> nil then begin Title := Applet.Caption; @@ -3356,8 +3357,8 @@ begin {$ENDIF} Dialog := NewForm( Applet, KOLString(Title) ).SetSize( 300, 40 ); {$IFNDEF NO_CHECK_STAYONTOP} - if DoStayOnTop then - Dialog.StayOnTop := TRUE; + if DoStayOnTop then + Dialog.StayOnTop := TRUE; {$ENDIF NO_CHECK_STAYONTOP} Dialog.Style := Dialog.Style and not (WS_MINIMIZEBOX or WS_MAXIMIZEBOX); Dialog.OnClose := TOnEventAccept( MakeMethod( Dialog, @CloseMsg ) ); @@ -3526,7 +3527,7 @@ begin Bmp.Free; {$ENDIF USE_GRUSH} - Dialog.CenterOnParent.Tabulate.CanResize := FALSE; + Dialog.CenterOnForm( CurForm ).Tabulate.CanResize := FALSE; if Assigned( CallBack ) then CallBack( Dialog ); diff --git a/delphicommctrl.inc b/delphicommctrl.inc index fb5b6bc..f063225 100644 --- a/delphicommctrl.inc +++ b/delphicommctrl.inc @@ -1,8 +1,27 @@ {******************************************************************************* - delpjicommctrl.inc + delpicommctrl.inc -- included in KOL.pas -- *******************************************************************************} +{$I MsgDecode.pas} +type + TMsg = packed record + CASE Integer OF + 0: ( + hwnd: HWND; + message: UINT; + wParam: WPARAM; + lParam: LPARAM; + time: DWORD; + pt: TPoint; + ); + //1: ( Bmsg: Windows.TMsg; ); + 2: ( Cmsg: TMsgDecoded; ); + end; + + tagMSG = TMsg; + + //////////////////////////////////////////////////////////////////////////// // this part of unit contains definitions moved here from CommCtrl.pas // (using of CommCtrl.pas in Delphi3 leads to increase size of executable diff --git a/mirror.pas b/mirror.pas index bf0d714..11c308e 100644 --- a/mirror.pas +++ b/mirror.pas @@ -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 3.03 +* VERSION 3.04 ******************************************************** } unit mirror; @@ -950,6 +950,7 @@ type function BestEventName: String; override; protected fCreating: Boolean; + fOrderControl: Integer; ResStrings: TStringList; procedure MakeResourceString( const ResourceConstName, Value: String ); public @@ -2096,6 +2097,7 @@ type FIgnoreDefault: Boolean; FResetTabStopByStyle: Boolean; FWordWrap: Boolean; + fOrderChild: Integer; procedure SetWordWrap(const Value: Boolean); procedure SetVerticalAlign(const Value: TVerticalAlign); virtual; @@ -2183,8 +2185,9 @@ type procedure P_SetupName( SL: TStringList ); procedure DoGenerateConstants( SL: TStringList ); virtual; - procedure SetupTabOrder( SL: TStringList; const AName: String ); virtual; - procedure P_SetupTabOrder( SL: TStringList; const AName: String ); virtual; + procedure SetupTabStop( SL: TStringList; const AName: String ); virtual; + procedure SetupTabOrder( SL: TStringList; const AName: String ); + procedure P_SetupTabStop( SL: TStringList; const AName: String ); virtual; function DefaultColor: TColor; virtual; {* by default, clBtnFace. Override it for controls, having another Color as default. Usually these are controls, which main purpose is @@ -2223,6 +2226,7 @@ type public ControlInStack: Boolean; protected + fCreationOrder: Integer; // Is called after generating of constructors of all child controls and // objects - to generate final initialization of object (if necessary). // @@ -4727,7 +4731,7 @@ begin 'OnKeyChar:^TControl.SetOnChar', 'OnKeyDeadChar:^TControl.SetOnDeadChar', - 'OnChange: TControl.Set_TOnEvent,' + IntToStr(idx_fOnChange), + 'OnChange: TControl.Set_TOnEvent,' + IntToStr(idx_fOnChangeCtl), 'OnSelChange: TControl.Set_TOnEvent,' + IntToStr(idx_fOnSelChange), 'OnPaint:^TControl.SetOnPaint', 'OnEraseBkgnd:^TControl.SetOnEraseBkgnd', @@ -7930,6 +7934,7 @@ begin Log( '->TKOLCustomControl.SetupFirst' ); try + fOrderChild := 0; SetupConstruct( SL, AName, AParent, Prefix ); SetupName( SL, AName, AParent, Prefix ); @@ -7972,7 +7977,7 @@ begin //ShowMessage( AName + '.HasBorder := ' + BoolVals[ FHasBorder ] ); end; - SetupTabOrder( SL, AName ); + SetupTabStop( SL, AName ); SetupFont( SL, AName ); SetupTextAlign( SL, AName ); if (csAcceptsControls in ControlStyle) or BorderNeeded then @@ -8200,7 +8205,7 @@ begin try KF := ParentKOLForm; - Rpt( 'Setuplast for form entered', WHITE ); + Rpt( 'Setuplast for ' + AName + ' entered', WHITE ); if not SetupColorFirst then SetupColor( SL, AName ); @@ -8271,6 +8276,8 @@ begin SL.Add( Prefix + '{$ENDIF OVERRIDE_SCROLLBARS}' ); end; end; + + SetupTabOrder( SL, AName ); Rpt( 'Setuplast for form finished', WHITE ); //LogOK; @@ -8316,7 +8323,7 @@ begin Result := AParent; end; -procedure TKOLCustomControl.SetupTabOrder(SL: TStringList; const AName: String); +procedure TKOLCustomControl.SetupTabStop(SL: TStringList; const AName: String); {var K, C: TComponent; I, N: Integer; kC: TKOLCustomControl;} @@ -8334,10 +8341,10 @@ begin asm jmp @@e_signature DB '#$signature$#', 0 - DB 'TKOLCustomControl.SetupTabOrder', 0 + DB 'TKOLCustomControl.SetupTabStop', 0 @@e_signature: end; - Log( '->TKOLCustomControl.SetupTabOrder' ); + Log( '->TKOLCustomControl.SetupTabStop' ); KF := ParentKOLForm; @@ -8360,7 +8367,7 @@ begin end; LogOK; finally - Log( '<-TKOLCustomControl.SetupTabOrder' ); + Log( '<-TKOLCustomControl.SetupTabStop' ); end; end; @@ -9589,7 +9596,7 @@ begin {P}SL.Add( ' L(' + IntToStr( Integer( FHasBorder ) ) + ')' ); {P}SL.Add( ' C1 TControl_.SetHasBorder<2>' ); end; - P_SetupTabOrder( SL, AName ); + P_SetupTabStop( SL, AName ); P_SetupFont( SL, AName ); P_SetupTextAlign( SL, AName ); //SetupColor( SL, AName ); @@ -9758,7 +9765,7 @@ begin end; end; -procedure TKOLCustomControl.P_SetupTabOrder(SL: TStringList; +procedure TKOLCustomControl.P_SetupTabStop(SL: TStringList; const AName: String); begin asm @@ -10423,6 +10430,19 @@ begin end; end; +procedure TKOLCustomControl.SetupTabOrder(SL: TStringList; + const AName: String); +begin + Rpt( 'SetupLast for ' + AName + ', TabStop = ' + IntToStr( Integer( TabStop ) ), + YELLOW ); + if not TabStop then Exit; + Rpt( 'TabOrder = ' + IntToStr( FTabOrder ) + + ', Creation order = ' + IntToStr( Integer( fCreationOrder ) ), + YELLOW ); + if TabOrder <> fCreationOrder then + SL.Add( ' ' + AName + '.TabOrder := ' + IntToStr( TabOrder ) + ';' ); +end; + { TKOLApplet } procedure TKOLApplet.AssignEvents(SL: TStringList; const AName: String); @@ -12052,7 +12072,18 @@ begin end; end; end; + if OfParent is TKOLCustomControl then + KC.fCreationOrder := (OfParent as TKOLCustomControl).fOrderChild + else + KC.fCreationOrder := fOrderControl; KC.SetupFirst( SL, KC.RefName, OfParentName, Prefix ); + if KC.TabStop then + begin + if OfParent is TKOLCustomControl then + inc( (OfParent as TKOLCustomControl).fOrderChild ) + else + inc( fOrderControl ); + end; KC.SetupName( SL, KC.RefName, OfParentName, Prefix ); // на случай, если // SetupFirst переопределена, и SetupName не вызвана if FormCompact then @@ -12920,6 +12951,7 @@ begin // +++ by Alexander Shakhaylo: if not fileexists(Path + '.pas') or FLocked then begin + Rpt( 'File not exists: ' + Path + '.pas', YELLOW ); LogOK; exit; end; // --- @@ -12948,21 +12980,51 @@ begin RptDetailed( 'uses.inc prepared', CYAN ); end; + RptDetailed( 'Loading source for ' + Path + '.pas', BLUE ); LoadSource( Source, Path + '.pas' ); RptDetailed( 'Source loaded for ' + Name, CYAN ); for I := 0 to Source.Count- 1 do - if RemoveSpaces( Source[ I ] ) = RemoveSpaces( Signature ) then - begin - Result := True; - if (I < Source.Count - 1) and (Source[ I + 1 ] <> DefString) and - (KOLProject <> nil) and KOLProject.IsKOLProject then + begin + if RemoveSpaces( Source[ I ] ) = RemoveSpaces( Signature ) then begin - chg_src := TRUE; - Source.Insert( I + 1, DefString ); - //SaveStrings( Source, Path + '.pas', Updated ); + Result := True; + if (I < Source.Count - 1) and (Source[ I + 1 ] <> DefString) and + (KOLProject <> nil) and KOLProject.IsKOLProject then + begin + chg_src := TRUE; + Source.Insert( I + 1, DefString ); + //SaveStrings( Source, Path + '.pas', Updated ); + end; + break; end; - break; - end; + end; + {$IFnDEF NOT_CONVERT_TMSG} + Rpt( 'Convering tagmsg', RED ); + for I := 0 to Source.Count- 1 do + begin + //--------------- from KOL/MCK 3.04, convert tagMSG -> TMsg: + S := Source[I]; + if pos( 'tagmsg', LowerCase( S ) ) > 0 then + begin + RptDetailed( 'tagmsg found in line ' + Int2Str(I+1), CYAN ); + for J := Length(S)-5 downto 1 do + begin + if StrLComp_NoCase( PChar(@S[J]), 'tagmsg', 6 ) = 0 then + begin + if ( (J = 1) or not(S[J-1] in ['A'..'Z','a'..'z','_']) ) + and ( (J = Length(S)-5) or not(S[J+6] in + ['0'..'9','A'..'Z','a'..'z','_']) ) then + begin + RptDetailed( 'tagmsg replaced with TMsg in line ' + Int2Str(I+1), CYAN ); + S := Copy( S, 1, J-1 ) + 'TMsg' + Copy( S, J+6, MaxInt ); + Source[I] := S; + chg_src := TRUE; + end; + end; + end; + end; + end; + {$ENDIF} if Result then begin @@ -25782,8 +25844,8 @@ begin RptDetailed( 'EvntName = ' + EvntName, BLUE ); if FD.MethodExists( EvntName ) then begin - RptDetailed( 'Method ' + EvntName + - ' exists: generate AssignEvents', RED ); + //RptDetailed( 'Method ' + EvntName + + // ' exists: generate AssignEvents', RED ); FOnMenuMethodName := EvntName; Result := TRUE; end