diff options
Diffstat (limited to 'gui')
| -rw-r--r-- | gui/form.inc | 3 | ||||
| -rw-r--r-- | gui/fpgui.pas | 3 | ||||
| -rw-r--r-- | gui/fpguipackage.lpk | 3 | ||||
| -rw-r--r-- | gui/menus.inc | 105 |
4 files changed, 111 insertions, 3 deletions
diff --git a/gui/form.inc b/gui/form.inc index 73f17129..3eb1ae0a 100644 --- a/gui/form.inc +++ b/gui/form.inc @@ -157,8 +157,11 @@ end; procedure TCustomForm.Close; begin + LAYOUTTRACE('TCustomForm.Close for %s:%s', [Name, ClassName]); + GFApplication.RemoveWindow(FWnd); FVisible := False; + FWnd.Free; FWnd := nil; end; diff --git a/gui/fpgui.pas b/gui/fpgui.pas index c6ccc8a7..2ec385c0 100644 --- a/gui/fpgui.pas +++ b/gui/fpgui.pas @@ -3,7 +3,7 @@ fpGUI master file - Copyright (C) 2000 - 2006 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -323,7 +323,6 @@ begin Result := IdentToInt(Ident, Orientation, Orientations); end; - function OrientationToIdent(Orientation: LongInt; var Ident: String): Boolean; begin Result := IntToIdent(Orientation, Ident, Orientations); diff --git a/gui/fpguipackage.lpk b/gui/fpguipackage.lpk index b130aabb..02b65985 100644 --- a/gui/fpguipackage.lpk +++ b/gui/fpguipackage.lpk @@ -17,7 +17,8 @@ <Generate Value="Faster"/> </CodeGeneration> <Other> - <CustomOptions Value="-dDEBUGx"/> + <CustomOptions Value="-dDEBUGx +"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> diff --git a/gui/menus.inc b/gui/menus.inc index bbe356c0..cad0f3c9 100644 --- a/gui/menus.inc +++ b/gui/menus.inc @@ -22,17 +22,26 @@ {$IFDEF read_interface} + TPopupMenu = class; + TMenuBar = class; + { TMenuItem } TMenuItem = class(TCustomPanel) private FHotKeyDef: string; FSeparator: boolean; + FSubMenu: TPopupMenu; + function GetSubMenu: TPopupMenu; + procedure InternalShowPopupMenu; protected procedure Paint(Canvas: TFCanvas); override; function ProcessEvent(Event: TEventObj): Boolean; override; + procedure Click; override; public constructor Create(const pText: string; pOwner: TComponent); overload; + destructor Destroy; override; + property SubMenu: TPopupMenu read GetSubMenu; published property Separator: boolean read FSeparator write FSeparator; property HotKeyDef: string read FHotKeyDef write FHotKeyDef; @@ -40,6 +49,19 @@ property Visible; property Enabled; end; + + + { TPopupMenu } + + TPopupMenu = class(TPopupWindow) + private + FMenu: TMenuBar; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + function AddMenu(const pTitle: string): TMenuItem; + function AddMenu(const pTitle: string; const pHotKeyDef: string; pHandlerProc: TNotifyEvent): TMenuItem; + end; { TMenuBar } @@ -62,6 +84,31 @@ { TMenuItem } +function TMenuItem.GetSubMenu: TPopupMenu; +begin + if not Assigned(FSubMenu) then + FSubMenu := TPopupMenu.Create(self); + Result := FSubMenu; +end; + +procedure TMenuItem.InternalShowPopupMenu; +begin + if Assigned(FSubMenu) and FSubMenu.Visible then + begin + FSubMenu.Close; + Exit; //==> + end; + + if not Assigned(FSubMenu) then + begin + FSubMenu := TPopupMenu.Create(Self); + end; + + FSubMenu.SetPosition(ClientToScreen(Point(0, Height))); + FSubMenu.Show; + FSubMenu.Wnd.SetMinMaxClientSize(MaxSize, MaxSize); +end; + procedure TMenuItem.Paint(Canvas: TFCanvas); begin if (wsClicked in WidgetState) or (wsMouseInside in WidgetState) then @@ -90,6 +137,11 @@ begin else if Event.InheritsFrom(TMouseLeaveEventObj) then begin Exclude(WidgetState, wsMouseInside); +// if Assigned(FSubMenu) and (FSubMenu.Visible) then +// begin +// writeln('1111111111111'); +// FSubMenu.Close; +// end; Redraw; result := True; end @@ -97,6 +149,16 @@ begin result := inherited ProcessEvent(Event); end; +procedure TMenuItem.Click; +begin + if (wsMouseInside in WidgetState) and Assigned(FSubMenu) then + begin + InternalShowPopupMenu; + end + else + inherited Click; +end; + constructor TMenuItem.Create(const pText: string; pOwner: TComponent); begin inherited Create(pText, pOwner); @@ -104,6 +166,49 @@ begin FBevelStyle := bsPlain; end; +destructor TMenuItem.Destroy; +begin + if Assigned(FSubMenu) then + FSubMenu.Free; + inherited Destroy; +end; + +{ TPopupMenu } + +constructor TPopupMenu.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + WidgetStyle := WidgetStyle + [wsCaptureMouse, wsClickable, wsOpaque]; + BorderWidth := 1; + Color := clBlack; + Name := '#MenuPopup'; + + FMenu := TMenuBar.Create(self); + FMenu.Name := '#VBoxMenu'; + FMenu.Orientation := Vertical; + FMenu.Spacing := 0; + InsertChild(FMenu); +end; + +destructor TPopupMenu.Destroy; +begin + FMenu.Free; + inherited Destroy; +end; + +function TPopupMenu.AddMenu(const pTitle: string): TMenuItem; +begin + Result := FMenu.AddMenu(pTitle); +end; + +function TPopupMenu.AddMenu(const pTitle: string; const pHotKeyDef: string; + pHandlerProc: TNotifyEvent): TMenuItem; +begin + Result := FMenu.AddMenu(pTitle, photKeyDef, pHandlerProc); +end; + +{ TMenuBar } + constructor TMenuBar.Create(AOwner: TComponent); begin inherited Create(AOwner); |