1 {
2 *****************************************************************************
3 * CustomDrawnWSMenus.pp *
4 * ------------ *
5 * *
6 * *
7 *****************************************************************************
8
9 *****************************************************************************
10 This file is part of the Lazarus Component Library (LCL)
11
12 See the file COPYING.modifiedLGPL.txt, included in this distribution,
13 for details about the license.
14 *****************************************************************************
15 }
16 unit CustomDrawnWSMenus;
17
18 {$mode objfpc}{$H+}
19
20 interface
21
22 {$I customdrawndefines.inc}
23
24 uses
25 // Platform specific
26 {$ifdef CD_Windows}Windows, customdrawn_WinProc,{$endif}
27 {$ifdef CD_Cocoa}MacOSAll, CocoaAll, customdrawn_cocoaproc, CocoaGDIObjects, CocoaUtils,{$endif}
28 // LCL
29 SysUtils, Classes, Types, Math,
30 LCLType, LCLProc, Graphics, Controls, Forms, Menus,
31 // Widgetset
32 WSMenus, WSLCLClasses;
33
34 type
35
36 { TCDWSMenuItem }
37
38 TCDWSMenuItem = class(TWSMenuItem)
39 published
40 class procedure AttachMenu(const AMenuItem: TMenuItem); override;
CreateHandlenull41 class function CreateHandle(const AMenuItem: TMenuItem): HMENU; override;
42 class procedure DestroyHandle(const AMenuItem: TMenuItem); override;
43 class procedure SetCaption(const AMenuItem: TMenuItem; const ACaption: string); override;
44 class procedure SetShortCut(const AMenuItem: TMenuItem; const ShortCutK1, ShortCutK2: TShortCut); override;
45 class procedure SetVisible(const AMenuItem: TMenuItem; const Visible: boolean); override;
SetChecknull46 class function SetCheck(const AMenuItem: TMenuItem; const Checked: boolean): boolean; override;
SetEnablenull47 class function SetEnable(const AMenuItem: TMenuItem; const Enabled: boolean): boolean; override;
SetRadioItemnull48 class function SetRadioItem(const AMenuItem: TMenuItem; const RadioItem: boolean): boolean; override;
SetRightJustifynull49 class function SetRightJustify(const AMenuItem: TMenuItem; const Justified: boolean): boolean; override;
50 class procedure UpdateMenuIcon(const AMenuItem: TMenuItem; const HasIcon: Boolean; const AIcon: TBitmap); override;
51 end;
52
53 { TCDWSMenu }
54
55 TCDWSMenu = class(TWSMenu)
56 published
CreateHandlenull57 class function CreateHandle(const AMenu: TMenu): HMENU; override;
58 { class procedure SetBiDiMode(const AMenu: TMenu; UseRightToLeftAlign, UseRightToLeftReading : Boolean); override;}
59 end;
60
61 { TCDWSMainMenu }
62
63 TCDWSMainMenu = class(TWSMainMenu)
64 published
65 end;
66
67 { TCDWSPopupMenu }
68
69 TCDWSPopupMenu = class(TWSPopupMenu)
70 published
71 class procedure Popup(const APopupMenu: TPopupMenu; const X, Y: integer); override;
72 end;
73
74
75 implementation
76
77 {$ifdef CD_Cocoa}
78 {$include customdrawnwsmenus_cocoa.inc}
79 {$define CD_HasNativeWSMenusINC}
80 {$endif}
81 {$ifndef CD_HasNativeWSMenusINC}
82
83 uses
84 StdCtrls, LCLIntf;
85
86 type
87 TCDPopUpMenuForm = class(TForm)
88 public
89 Items: array of TStaticText;
90 LCLMenu: TPopUpMenu;
91 procedure HandleItemClick(ASender: TObject);
92 end;
93
94 procedure TCDPopUpMenuForm.HandleItemClick(ASender: TObject);
95 var
96 lSelectedItem: PtrInt;
97 begin
98 Self.Close;
99 lSelectedItem := TStaticText(ASender).Tag;
100 if LCLIntf.OnShowSelectItemDialogResult <> nil then
101 LCLIntf.OnShowSelectItemDialogResult(lSelectedItem);
102 end;
103
104 var
105 CDPopUpMenus: TFPList; // of TCDPopUpMenuForm
106
107 { TCDWSMenuItem }
108
109 class procedure TCDWSMenuItem.AttachMenu(const AMenuItem: TMenuItem);
110 begin
111 inherited AttachMenu(AMenuItem);
112 end;
113
TCDWSMenuItem.CreateHandlenull114 class function TCDWSMenuItem.CreateHandle(const AMenuItem: TMenuItem): HMENU;
115 begin
116 // Fill a dummy value to get a positive result for HandleAllocated
117 Result := $FFFFFF;
118 end;
119
120 class procedure TCDWSMenuItem.DestroyHandle(const AMenuItem: TMenuItem);
121 begin
122
123 end;
124
125 class procedure TCDWSMenuItem.SetCaption(const AMenuItem: TMenuItem;
126 const ACaption: string);
127 begin
128 inherited SetCaption(AMenuItem, ACaption);
129 end;
130
131 class procedure TCDWSMenuItem.SetShortCut(const AMenuItem: TMenuItem;
132 const ShortCutK1, ShortCutK2: TShortCut);
133 begin
134 inherited SetShortCut(AMenuItem, ShortCutK1, ShortCutK2);
135 end;
136
137 class procedure TCDWSMenuItem.SetVisible(const AMenuItem: TMenuItem;
138 const Visible: boolean);
139 begin
140 inherited SetVisible(AMenuItem, Visible);
141 end;
142
TCDWSMenuItem.SetChecknull143 class function TCDWSMenuItem.SetCheck(const AMenuItem: TMenuItem;
144 const Checked: boolean): boolean;
145 begin
146 Result:=inherited SetCheck(AMenuItem, Checked);
147 end;
148
TCDWSMenuItem.SetEnablenull149 class function TCDWSMenuItem.SetEnable(const AMenuItem: TMenuItem;
150 const Enabled: boolean): boolean;
151 begin
152 Result:=inherited SetEnable(AMenuItem, Enabled);
153 end;
154
TCDWSMenuItem.SetRadioItemnull155 class function TCDWSMenuItem.SetRadioItem(const AMenuItem: TMenuItem;
156 const RadioItem: boolean): boolean;
157 begin
158 Result:=inherited SetRadioItem(AMenuItem, RadioItem);
159 end;
160
TCDWSMenuItem.SetRightJustifynull161 class function TCDWSMenuItem.SetRightJustify(const AMenuItem: TMenuItem;
162 const Justified: boolean): boolean;
163 begin
164 Result:=inherited SetRightJustify(AMenuItem, Justified);
165 end;
166
167 class procedure TCDWSMenuItem.UpdateMenuIcon(const AMenuItem: TMenuItem;
168 const HasIcon: Boolean; const AIcon: TBitmap);
169 begin
170 inherited UpdateMenuIcon(AMenuItem, HasIcon, AIcon);
171 end;
172
173 { TCDWSMenu }
174
TCDWSMenu.CreateHandlenull175 class function TCDWSMenu.CreateHandle(const AMenu: TMenu): HMENU;
176 begin
177 // Fill a dummy value to get a positive result for HandleAllocated
178 Result := $FFFFFF;
179 end;
180
181 { TCDWSPopupMenu }
182
183 class procedure TCDWSPopupMenu.Popup(const APopupMenu: TPopupMenu; const X, Y: integer);
184 var
185 i, CurY, MaxWidth, CurWidth, ItemHeight: Integer;
186 CurItem: TStaticText;
187 CurCDPopUpMenu: TCDPopUpMenuForm;
188 begin
189 if APopUpMenu.Items.Count = 0 then Exit;
190
191 CurCDPopUpMenu := TCDPopUpMenuForm.CreateNew(nil);
192 CDPopUpMenus.Add(CurCDPopUpMenu);
193 CurCDPopUpMenu.Left := X;
194 CurCDPopUpMenu.Top := Y;
195 ItemHeight := CurCDPopUpMenu.Canvas.TextHeight('Áç') + 5;
196 CurCDPopUpMenu.Height := ItemHeight * APopUpMenu.Items.Count;
197 CurY := 0;
198 MaxWidth := 0;
199
200 SetLength(CurCDPopUpMenu.Items, APopUpMenu.Items.Count);
201 for i := 0 to APopUpMenu.Items.Count-1 do
202 begin
203 CurItem := TStaticText.Create(CurCDPopUpMenu);
204 CurCDPopUpMenu.Items[i] := CurItem;
205 CurItem.Top := CurY;
206 Inc(CurY, ItemHeight);
207 CurItem.Left := 0;
208 CurItem.AutoSize := True;
209 CurItem.Parent := CurCDPopUpMenu;
210 CurItem.Caption := APopUpMenu.Items[i].Caption;
211 CurItem.Tag := i;
212 CurItem.OnClick := @CurCDPopUpMenu.HandleItemClick;
213 CurWidth := CurCDPopUpMenu.Canvas.TextWidth(CurItem.Caption);
214 MaxWidth := Max(MaxWidth, CurWidth);
215 end;
216
217 CurCDPopUpMenu.Width := MaxWidth;
218
219 CurCDPopUpMenu.Show;
220 end;
221
222 initialization
223
224 CDPopUpMenus := TFPList.Create;
225
226 {$endif}
227
228 end.
229