mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-11-05 01:39:33 +01:00
MG: fixed menu streaming
git-svn-id: trunk@3537 -
This commit is contained in:
parent
87ac95ce37
commit
cc0fe8109e
@ -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;
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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)
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user