paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-04 13:29:26 +01:00
Code Issues Packages Projects Releases Wiki Activity

MG: fixed menu streaming

Browse Source 
git-svn-id: trunk@3537 -
This commit is contained in:
lazarus 2002-10-22 18:54:56 +00:00
parent 87ac95ce37
commit cc0fe8109e
3 changed files with 39 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
lcl/forms.pp
View File

@ -255,6 +255,7 @@ type
function CloseQuery : boolean; virtual;
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
procedure Loaded; override;
procedure Deactivate;dynamic;
procedure DoClose(var Action: TCloseAction); dynamic;
procedure DoHide; dynamic;

33
lcl/include/customform.inc
View File

@ -18,6 +18,9 @@
*****************************************************************************
}
const
sDuplicateMenus = 'TCustomForm.SetMenu Duplicate menus';
{ $DEFINE CHECK_POSITION}
{------------------------------------------------------------------------------}
@ -645,12 +648,29 @@ end;
{ TCustomForm SetMenu }
{------------------------------------------------------------------------------}
Procedure TCustomForm.SetMenu(Value : TMainMenu);
Begin
var
I: Integer;
begin
//TODO: Finish SETMenu
if FMenu=Value then exit;
if Value <> nil then
for I := 0 to Screen.FormCount - 1 do
if (Screen.Forms[I].Menu = Value) and (Screen.Forms[I] <> Self) then
raise EInvalidOperation.CreateFmt(sDuplicateMenus, [Value.Name]);
if FMenu<>nil then FMenu.Parent:=nil;
if (csDestroying in ComponentState) or
((Value <> nil) and (csDestroying in Value.ComponentState))
then
Value := nil;
FMenu := Value;
if FMenu<>nil then FMenu.Parent:=Self;
if FMenu<>nil then begin
FMenu.Parent:=Self;
if HandleAllocated and (not (csLoading in ComponentState)) then
FMenu.HandleNeeded;
end;
end;
{------------------------------------------------------------------------------}
@ -1003,6 +1023,12 @@ begin
//writeln('TCustomForm.CreateWnd END ',ClassName);
end;
procedure TCustomForm.Loaded;
begin
inherited Loaded;
if FMenu<>nil then FMenu.HandleNeeded;
end;
{------------------------------------------------------------------------------
Method: TCustomForm.UpdateShowing
Params: None
@ -1137,6 +1163,9 @@ end;
{ =============================================================================
$Log$
Revision 1.63 2002/10/22 18:54:56 lazarus
MG: fixed menu streaming
Revision 1.62 2002/10/22 13:01:20 lazarus
MG: fixed setting modalresult on hide

17
lcl/include/menuitem.inc
View File

@ -86,15 +86,6 @@ begin
if ShortCut <> 0 then ShortCutChanged(0, Shortcut);
end;
end;
{
if (FItems <> nil) and ((Parent = nil) or Parent.HandleAllocated)
then begin
for n := 0 to FItems.Count - 1 do
begin
InterfaceObject.IntSendMessage3(LM_ATTACHMENU, TObject(FItems[n]), nil);
end;
end;
}
//writeln('TMenuItem.CreateHandle END ',Name,':',ClassName);
end;
@ -825,7 +816,7 @@ end;
------------------------------------------------------------------------------}
procedure TMenuItem.SetVisible(AValue: Boolean);
begin
// HandleNeeded;
// ToDo tell interface
FVisible := AValue;
end;
@ -926,6 +917,9 @@ end;
{ =============================================================================
$Log$
Revision 1.28 2002/10/22 18:54:56 lazarus
MG: fixed menu streaming
Revision 1.27 2002/10/08 22:32:27 lazarus
MG: fixed cool little bug (menu double attaching bug)
@ -1035,6 +1029,9 @@ end;
$Log$
Revision 1.28 2002/10/22 18:54:56 lazarus
MG: fixed menu streaming
Revision 1.27 2002/10/08 22:32:27 lazarus
MG: fixed cool little bug (menu double attaching bug)