File: menudesignerbase.pas

package info (click to toggle)
lazarus 2.0.0%2Bdfsg-2
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 214,460 kB
  • sloc: pascal: 1,862,622; xml: 265,709; cpp: 56,595; sh: 3,008; java: 609; makefile: 535; perl: 297; sql: 222; ansic: 137
file content (320 lines) | stat: -rw-r--r-- 8,268 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
unit MenuDesignerBase;

{$mode objfpc}{$H+}

interface

uses
  // FCL + LCL
  Classes, SysUtils, fgl,
  Controls, Forms, Menus, Graphics, LCLProc,
  // IdeIntf
  FormEditingIntf, ComponentEditors,
  // IDE
  MenuShortcuts, MenuTemplates;

type

  TShadowItemDisplayState = (dsNormal, dsSelected, dsDisabled);
  TByteArray = Array of Byte;

  { TShadowItemBase }

  TShadowItemBase = class(TCustomControl)
  private
  protected
    FRealItem: TMenuItem;
    FState: TShadowItemDisplayState;
  public
    constructor Create(AOwner: TComponent; aRealItem: TMenuItem); reintroduce;
    destructor Destroy; override;
    function GetHeight: integer;
    function GetWidth: integer; virtual; abstract;
    procedure ShowDisabled;
    procedure ShowNormal;
    procedure ShowSelected;
  public
    property RealItem: TMenuItem read FRealItem write FRealItem;
  end;

  TShadowItemList = specialize TFPGList<TShadowItemBase>;

  { TShadowBoxBase }

  TShadowBoxBase = class(TCustomControl)
  private
    function GetRadioGroupValues: TByteArray;
  protected
    FLevel: integer;
    FLastRIValue: boolean;
    FParentBox: TShadowBoxBase;
    FParentMenuItem: TMenuItem;
    FShadowList: TShadowItemList;
    function GetIsMainMenu: boolean; virtual; abstract;
    function GetIsMenuBar: boolean; virtual; abstract;
  public
    constructor Create(AOwner: TComponent; aParentItem: TMenuItem); reintroduce;
    destructor Destroy; override;
  public
    function GetInnerDims: TPoint;
    property IsMainMenu: boolean read GetIsMainMenu;
    property IsMenuBar: boolean read GetIsMenuBar;
    property Level: integer read FLevel;
    property LastRIValue: boolean read FLastRIValue write FLastRIValue;
    property ParentMenuItem: TMenuItem read FParentMenuItem;
    property ParentBox: TShadowBoxBase read FParentBox;
    property ShadowList: TShadowItemList read FShadowList;
    property RadioGroupValues: TByteArray read GetRadioGroupValues;
  end;

  TShadowBoxList = specialize TFPGList<TShadowBoxBase>;

  { TShadowMenuBase }

  TShadowMenuBase = class(TScrollBox)
  private
  protected
    FEditorDesigner: TComponentEditorDesigner;
    FLookupRoot: TComponent;
    FMainCanvas: TCanvas;
    FMenu: TMenu;
    FSelectedMenuItem: TMenuItem;
    FBoxList: TShadowBoxList;
    function GetStringWidth(const aText: string; isBold: boolean): integer;
  public
    constructor Create(AOwner: TComponent; aMenu: TMenu); reintroduce;
    destructor Destroy; override;
    procedure RefreshFakes; virtual; abstract;
    procedure SetSelectedMenuItem(aMI: TMenuItem;
      viaDesigner, prevWasDeleted: boolean); virtual; abstract;
    procedure UpdateBoxLocationsAndSizes; virtual; abstract;
    function GetParentBoxForMenuItem(aMI: TMenuItem): TShadowBoxBase;
    function GetShadowForMenuItem(aMI: TMenuItem): TShadowItemBase;
    function IsMainMenu: boolean;
  public
    property EditorDesigner: TComponentEditorDesigner read FEditorDesigner;
    property LookupRoot: TComponent read FLookupRoot;
    property SelectedMenuItem: TMenuItem read FSelectedMenuItem write FSelectedMenuItem;
    property BoxList: TShadowBoxList read FBoxList;
  end;

  { TMenuDesignerBase }

  TMenuDesignerBase = class
  private
  protected
    FShadowMenu: TShadowMenuBase;
    FShortcuts: TMenuShortcuts;
    FTemplatesSaved: boolean;
    FSavedTemplatesCount: integer;
    FTotalMenuItemsCount: integer;
    FVariableGlyphsInMenuBar: boolean;
  public
    constructor Create;
    destructor Destroy; override;
    procedure CreateShadowMenu(aMenu: TMenu; aSelect: TMenuItem;
      aWidth, aHeight: integer); virtual; abstract;
    procedure FreeShadowMenu;
    procedure UpdateTemplatesCount;
  public
    property ShadowMenu: TShadowMenuBase read FShadowMenu write FShadowMenu;
    property Shortcuts: TMenuShortcuts read FShortcuts;
    property TemplatesSaved: boolean read FTemplatesSaved;
    property TotalMenuItemsCount: integer read FTotalMenuItemsCount
                                         write FTotalMenuItemsCount;
    property VariableGlyphsInMenuBar: boolean read FVariableGlyphsInMenuBar
                                             write FVariableGlyphsInMenuBar;
    property SavedTemplatesCount: integer read FSavedTemplatesCount;
  end;


implementation

{ TShadowItemBase }

constructor TShadowItemBase.Create(AOwner: TComponent; aRealItem: TMenuItem);
begin
  inherited Create(AOwner);
  FRealItem:=aRealItem;
end;

destructor TShadowItemBase.Destroy;
begin
  inherited Destroy;
end;

function TShadowItemBase.GetHeight: integer;
begin
  if FRealItem.IsInMenuBar then
    Result:=MenuBar_Height
  else if FRealItem.IsLine then
    Result:=Separator_Height
  else
    Result:=DropDown_Height;
end;

procedure TShadowItemBase.ShowDisabled;
begin
  if (FState <> dsDisabled) then begin
    FState:=dsDisabled;
    Invalidate;
  end;
end;

procedure TShadowItemBase.ShowNormal;
begin
  if (FState <> dsNormal) then begin
    FState:=dsNormal;
    Invalidate;
  end;
end;

procedure TShadowItemBase.ShowSelected;
begin
  if (FState <> dsSelected) then begin
    FState:=dsSelected;
    Invalidate;
  end;
end;

{ TShadowBoxBase }

constructor TShadowBoxBase.Create(AOwner: TComponent; aParentItem: TMenuItem);
begin
  inherited Create(AOwner);
  Assert(aParentItem<>nil,'TShadowBox.CreateWithParentBox: aParentItem parameter is nil');
  FParentMenuItem:=aParentItem;
  FShadowList:=TShadowItemList.Create;
end;

destructor TShadowBoxBase.Destroy;
begin
  FreeAndNil(FShadowList);
  inherited Destroy;
end;

function TShadowBoxBase.GetRadioGroupValues: TByteArray;
var
  rgSet: set of byte = [];
  g: byte;
  si: TShadowItemBase;
  mi: TMenuItem;
begin
  SetLength(Result, 0);
  for si in FShadowList do
  begin
    mi:=si.RealItem;
    if mi.RadioItem then begin
      g:=mi.GroupIndex;
      if not (g in rgSet) then begin
        Include(rgSet, g);
        SetLength(Result, Length(Result)+1);
        Result[Length(Result)-1] := g;
      end;
    end;
  end;
end;

function TShadowBoxBase.GetInnerDims: TPoint;
var
  si: TShadowItemBase;
  w: integer;
begin
  FillChar(Result{%H-}, SizeOf(Result), 0);
  for si in FShadowList do begin
    Inc(Result.y, si.GetHeight);
    w:=si.GetWidth;
    if (Result.x < w) then
      Result.x:=w;
  end;
end;

{ TShadowMenuBase }

constructor TShadowMenuBase.Create(AOwner: TComponent; aMenu: TMenu);
begin
  inherited Create(AOwner);
  FMenu := aMenu;
  FEditorDesigner := FindRootDesigner(FMenu) as TComponentEditorDesigner;
  FLookupRoot := FEditorDesigner.LookupRoot;
  FBoxList := TShadowBoxList.Create;
end;

destructor TShadowMenuBase.Destroy;
begin
  FEditorDesigner:=nil;
  FreeAndNil(FBoxList);
  inherited Destroy;
end;

function TShadowMenuBase.GetStringWidth(const aText: string; isBold: boolean): integer;
begin
  if isBold then
    FMainCanvas.Font.Style:=[fsBold]
  else
    FMainCanvas.Font.Style:=[];
  Result:=FMainCanvas.TextWidth(aText);
end;

function TShadowMenuBase.GetParentBoxForMenuItem(aMI: TMenuItem): TShadowBoxBase;
var
  sb: TShadowBoxBase;
  si: TShadowItemBase;
begin
  for sb in FBoxList do
    for si in sb.ShadowList do
      if si.RealItem = aMI then
        Exit(sb);
  Result:=nil;
end;

function TShadowMenuBase.GetShadowForMenuItem(aMI: TMenuItem): TShadowItemBase;
var
  sb: TShadowBoxBase;
  si: TShadowItemBase;
begin
  for sb in FBoxList do
    for si in sb.ShadowList do
      if si.RealItem = aMI then
        Exit(si);
  Result:=nil;
end;

function TShadowMenuBase.IsMainMenu: boolean;
begin
  Result := FMenu is TMainMenu;
end;

{ TMenuDesignerBase }

constructor TMenuDesignerBase.Create;
begin
  FShortcuts:=TMenuShortcuts.Create;
  FShortcuts.Initialize;
  FTemplatesSaved:=SavedTemplatesExist;
end;

destructor TMenuDesignerBase.Destroy;
begin
  FreeShadowMenu;
  FreeAndNil(FShortcuts);
  inherited Destroy;
end;

procedure TMenuDesignerBase.FreeShadowMenu;
begin
  if FShadowMenu=nil then exit;
  FShadowMenu.Parent:=nil;
  Application.ReleaseComponent(FShadowMenu);
  FShadowMenu:=nil;
end;

procedure TMenuDesignerBase.UpdateTemplatesCount;
begin
  FTemplatesSaved:=SavedTemplatesExist;
  DebugLn('Hint: (lazarus) [TMenuDesignerBase.UpdateTemplatesCount] SavedTemplatesExist is %s',[booltostr(FTemplatesSaved)]);
  FSavedTemplatesCount:=GetSavedTemplatesCount;
end;

end.