1{
2 *****************************************************************************
3 *                               MuiWSMenus.pp                                *
4 *                               ------------                                *
5 *                                                                           *
6 *                                                                           *
7 *****************************************************************************
8
9 *****************************************************************************
10 *                                                                           *
11 *  This file is part of the Lazarus Component Library (LCL)                 *
12 *                                                                           *
13 *  See the file COPYING.modifiedLGPL.txt, included in this distribution,    *
14 *  for details about the copyright.                                         *
15 *                                                                           *
16 *  This program is distributed in the hope that it will be useful,          *
17 *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
18 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
19 *                                                                           *
20 *****************************************************************************
21}
22unit MuiWSMenus;
23
24{$mode objfpc}{$H+}
25
26interface
27
28uses
29  // Bindings
30  Mui, utility, MuiFormsUnit, tagsparamshelper,
31  // LCL
32  SysUtils, Classes, Types, LCLType, LCLProc, Graphics, Controls, Forms, Menus,
33  // Widgetset
34  WSMenus, WSLCLClasses;
35
36type
37
38  { TQtWSMenuItem }
39
40  TMuiWSMenuItem = class(TWSMenuItem)
41  protected
42    //class function CreateMenuFromMenuItem(const AMenuItem: TMenuItem): TMuiMenu;
43  published
44    class procedure AttachMenu(const AMenuItem: TMenuItem); override;
45    class function CreateHandle(const AMenuItem: TMenuItem): HMENU; override;
46    class procedure DestroyHandle(const AMenuItem: TMenuItem); override;
47    class procedure SetCaption(const AMenuItem: TMenuItem; const ACaption: string);
48      override;
49    class procedure SetShortCut(const AMenuItem: TMenuItem;
50      const ShortCutK1, ShortCutK2: TShortCut); override;
51    class procedure SetVisible(const AMenuItem: TMenuItem; const Visible: boolean);
52      override;
53    class function SetCheck(const AMenuItem: TMenuItem; const Checked: boolean): boolean;
54      override;
55    class function SetEnable(const AMenuItem: TMenuItem;
56      const Enabled: boolean): boolean; override;
57    class function SetRadioItem(const AMenuItem: TMenuItem;
58      const RadioItem: boolean): boolean; override;
59    class function SetRightJustify(const AMenuItem: TMenuItem;
60      const Justified: boolean): boolean; override;
61    class procedure UpdateMenuIcon(const AMenuItem: TMenuItem;
62      const HasIcon: boolean; const AIcon: TBitmap); override;
63  end;
64
65  { TMuiWSMenu }
66
67  TMuiWSMenu = class(TWSMenu)
68  published
69    class function CreateHandle(const AMenu: TMenu): HMENU; override;
70    class procedure SetBiDiMode(const AMenu: TMenu;
71      UseRightToLeftAlign, UseRightToLeftReading: boolean); override;
72  end;
73
74  { TMuiWSMainMenu }
75
76  TMuiWSMainMenu = class(TWSMainMenu)
77  published
78    class function CreateHandle(const AMenu: TMenu): HMENU; override;
79  end;
80
81  { TMuiWSPopupMenu }
82
83  TMuiWSPopupMenu = class(TWSPopupMenu)
84  published
85    class function CreateHandle(const AMenu: TMenu): HMENU; override;
86    class procedure Popup(const APopupMenu: TPopupMenu; const X, Y: integer); override;
87  end;
88
89
90implementation
91
92{ TMuiWSMainMenu }
93
94class function TMuiWSMainMenu.CreateHandle(const AMenu: TMenu): HMENU;
95var
96  Menu: Pointer;
97begin
98  //writeln('--> createHandle MAINMENU');
99  Menu := NIL;
100  If (AMenu.Parent <> nil) and (AMenu.Parent is TCustomForm) then
101  begin
102    Menu := TMuiWindow(TCustomForm(AMenu.Parent).Handle).MainMenu;
103    TMuiWindow(TCustomForm(AMenu.Parent).Handle).HasMenu := True;
104  end;
105  Result := HMENU(Menu);
106end;
107
108
109{ TMuiWSMenuItem }
110
111{------------------------------------------------------------------------------
112  Function: TMuiWSMenuItem.AttachMenu
113  Params:  None
114  Returns: Nothing
115 ------------------------------------------------------------------------------}
116class procedure TMuiWSMenuItem.AttachMenu(const AMenuItem: TMenuItem);
117
118begin
119  //writeln('TMuiWidgetSet.AttachMenu START ',AMenuItem.Name,':',AMenuItem.ClassName,' Parent=',AMenuItem.Parent.Name,':',AMenuItem.Parent.ClassName);
120  //writeln('--> attachmenu ', HexStr(Pointer(AMenuItem.Handle)));
121  if (AMenuItem.Handle <= 1) or (AMenuItem.Parent.Handle <= 1) then
122    Exit;
123  TMuiFamily(AMenuItem.Parent.Handle).AddTail(TMuiFamily(AMenuItem.Handle));
124  TMuiFamily(AMenuItem.Handle).Par := TMuiFamily(AMenuItem.Parent.Handle);
125end;
126
127{------------------------------------------------------------------------------
128  Function: TMuiWSMenuItem.CreateHandle
129  Params:  None
130  Returns: Nothing
131
132  Creates a Menu Item
133 ------------------------------------------------------------------------------}
134class function TMuiWSMenuItem.CreateHandle(const AMenuItem: TMenuItem): HMENU;
135var
136  Menu: TMuiMenuItem;
137  Menu1: TMuiMenu;
138  Tags: TATagList;
139begin
140  //write('->Create MenuItem..', AMenuItem.MenuIndex,' ', AMenuItem.Caption, ' ', AMenuItem.Count);
141  case AMenuItem.MenuIndex of
142    -1:begin
143      Result := HMENU(AMenuItem.GetParentMenu.Handle);
144    end;
145    else
146    begin
147      if AMenuItem.Count > 0 then
148      begin
149        //write('..as menu');
150        Tags.Clear;
151        Menu1 := TMuiMenu.Create(Tags);
152        Menu1.Title := AMenuItem.Caption;
153        Menu1.PasObject := TControl(TObject(AMenuItem));
154        Result := HMENU(Menu1);
155      end else
156      begin
157        //write('..as menuitem');
158        Tags.Clear;
159        Menu := TMuiMenuItem.Create(Tags);
160        Menu.Title := AMenuItem.Caption;
161        Menu.CheckIt := AMenuItem.ShowAlwaysCheckable or AMenuItem.RadioItem;
162        Menu.Checked := AMenuItem.Checked;
163        Menu.Enabled := AMenuItem.Enabled;
164        Menu.PasObject := TControl(TObject(AMenuItem));
165        Result := HMENU(Menu);
166      end;
167    end;
168  end;
169  //writeln('..done');
170end;
171
172{------------------------------------------------------------------------------
173  Function: TMuiWSMenuItem.DestroyHandle
174  Params:  None
175  Returns: Nothing
176
177  Dealocates a Menu Item
178 ------------------------------------------------------------------------------}
179class procedure TMuiWSMenuItem.DestroyHandle(const AMenuItem: TMenuItem);
180var
181  MuiMenu: TMuiFamily;
182begin
183  MuiMenu:= TMuiFamily(AMenuItem.Handle);
184  if AMenuItem.HasParent then
185  begin
186    if (AMenuItem.Handle <= 1) or (AMenuItem.Parent.Handle <= 1) then
187      Exit;
188    TMuiFamily(AMenuItem.Parent.Handle).Remove(MuiMenu);
189    MuiMenu.Free;
190  end;
191end;
192
193{------------------------------------------------------------------------------
194  Function: TMuiWSMenuItem.SetCaption
195  Params:  None
196  Returns: Nothing
197 ------------------------------------------------------------------------------}
198class procedure TMuiWSMenuItem.SetCaption(const AMenuItem: TMenuItem;
199  const ACaption: string);
200var
201  MuiMenu: TMuiFamily;
202begin
203  //WriteLn('[TMuiWSMenuItem.SetCaption] Caption: ' + AMenuItem.Caption +
204  //  ' NewCaption: ', ACaption);
205
206  MuiMenu := TMuiFamily(AMenuItem.Handle);
207  if MuiMenu is TMuiMenuItem then
208  begin
209    TMuiMenuItem(MuiMenu).Title := ACaption;
210  end;
211  if MuiMenu is TMuiMenu then
212  begin
213    TMuiMenu(MuiMenu).Title := ACaption;
214  end;
215end;
216
217{------------------------------------------------------------------------------
218  Function: TMuiWSMenuItem.SetShortCut
219  Params:  None
220  Returns: Nothing
221 ------------------------------------------------------------------------------}
222class procedure TMuiWSMenuItem.SetShortCut(const AMenuItem: TMenuItem;
223  const ShortCutK1, ShortCutK2: TShortCut);
224var
225  s: string;
226  MuiMenu: TMuiFamily;
227begin
228  s := ShortCutToText(ShortCutK1);
229  //writeln('shortcut: ', s);
230  MuiMenu := TMuiFamily(AMenuItem.Handle);
231  if MuiMenu is TMuiMenuItem then
232  begin
233    TMuiMenuItem(MuiMenu).ShortCut := s;
234  end;
235end;
236
237{------------------------------------------------------------------------------
238  Function: TMuiWSMenuItem.SetVisible
239  Params:  None
240  Returns: Nothing
241 ------------------------------------------------------------------------------}
242class procedure TMuiWSMenuItem.SetVisible(const AMenuItem: TMenuItem;
243  const Visible: boolean);
244var
245  MuiMenu: TMuiFamily;
246begin
247  //WriteLn('[TMuiWSMenuItem.SetVisible] SetVisible: ' + AMenuItem.Caption +
248  //  ' Visible: ', Visible);
249  MuiMenu := TMuiFamily(AMenuItem.Handle);
250  if MuiMenu is TMuiMenuItem then
251    TMuiMenuItem(MuiMenu).Visible := Visible;
252  if MuiMenu is TMuiMenu then
253    TMuiMenu(MuiMenu).Visible := Visible;
254end;
255
256{------------------------------------------------------------------------------
257  Function: TMuiWSMenuItem.SetCheck
258  Params:  None
259  Returns: Nothing
260 ------------------------------------------------------------------------------}
261class function TMuiWSMenuItem.SetCheck(const AMenuItem: TMenuItem;
262  const Checked: boolean): boolean;
263var
264  MuiMenu: TMuiFamily;
265begin
266  //WriteLn('[TMuiWSMenuItem.SetCheck] ' + AMenuItem.Caption +
267  //  ' Checked: ', Checked);
268  MuiMenu := TMuiFamily(AMenuItem.Handle);
269  if MuiMenu is TMuiMenuItem then
270  begin
271    TMuiMenuItem(MuiMenu).Checkit := True;
272    TMuiMenuItem(MuiMenu).Checked := Checked;
273  end;
274  Result := True;
275end;
276
277{------------------------------------------------------------------------------
278  Function: TMuiWSMenuItem.SetEnable
279  Params:  None
280  Returns: Nothing
281 ------------------------------------------------------------------------------}
282class function TMuiWSMenuItem.SetEnable(const AMenuItem: TMenuItem;
283  const Enabled: boolean): boolean;
284var
285  MuiMenu: TMuiFamily;
286begin
287  //WriteLn('[TMuiWSMenuItem.SetEnabled] ' + AMenuItem.Caption +
288  //  ' Enabled: ', Enabled);
289  MuiMenu := TMuiFamily(AMenuItem.Handle);
290  if MuiMenu is TMuiMenuItem then
291    TMuiMenuItem(MuiMenu).Enabled := Enabled;
292  if MuiMenu is TMuiMenu then
293    TMuiMenu(MuiMenu).Enabled := Enabled;
294  Result := True;
295end;
296
297{------------------------------------------------------------------------------
298  Function: TMuiWSMenuItem.SetRadioItem
299  Params:  None
300  Returns: Nothing
301 ------------------------------------------------------------------------------}
302class function TMuiWSMenuItem.SetRadioItem(const AMenuItem: TMenuItem;
303  const RadioItem: boolean): boolean;
304var
305  MuiMenu: TMuiFamily;
306begin
307  //WriteLn('[TMuiWSMenuItem.SetRadio] ' + AMenuItem.Caption +
308  //  ' Radio: ', RadioItem);
309  MuiMenu := TMuiFamily(AMenuItem.Handle);
310  if MuiMenu is TMuiMenuItem then
311    TMuiMenuItem(MuiMenu).CheckIt := RadioItem;
312  Result := True;
313end;
314
315{------------------------------------------------------------------------------
316  Function: TMuiWSMenuItem.SetRightJustify
317  Params:  None
318  Returns: Nothing
319 ------------------------------------------------------------------------------}
320class function TMuiWSMenuItem.SetRightJustify(const AMenuItem: TMenuItem;
321  const Justified: boolean): boolean;
322begin
323  Result := True;
324end;
325
326class procedure TMuiWSMenuItem.UpdateMenuIcon(const AMenuItem: TMenuItem;
327  const HasIcon: boolean; const AIcon: TBitmap);
328begin
329
330end;
331
332{ TMuiWSMenu }
333
334{------------------------------------------------------------------------------
335  Function: TMuiWSMenu.CreateHandle
336  Params:  None
337  Returns: Nothing
338
339  Creates a Menu
340 ------------------------------------------------------------------------------}
341class function TMuiWSMenu.CreateHandle(const AMenu: TMenu): HMENU;
342begin
343  //writeln('_____>>>>Create Menu');
344  REsult := HMENU(1);
345end;
346
347class procedure TMuiWSMenu.SetBiDiMode(const AMenu: TMenu;
348  UseRightToLeftAlign, UseRightToLeftReading: boolean);
349begin
350end;
351
352
353{ TMuiWSPopupMenu }
354
355class function TMUIWSPopupMenu.CreateHandle(const AMenu: TMenu): HMENU;
356begin
357  //writeln('create Popupmenu ', HexStr(Amenu.Parent));
358  Result := 1;
359end;
360
361{------------------------------------------------------------------------------
362  Function: TMuiWSPopupMenu.Popup
363  Params:  None
364  Returns: Nothing
365
366  Creates a PopUp menu
367 ------------------------------------------------------------------------------}
368class procedure TMuiWSPopupMenu.Popup(const APopupMenu: TPopupMenu; const X, Y: integer);
369begin
370  //writeln(' open PopupMenu');
371  //
372end;
373
374end.
375
376