-
Notifications
You must be signed in to change notification settings - Fork 2
/
View.Menu.pas
142 lines (121 loc) · 3.78 KB
/
View.Menu.pas
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
//---------------------------------------------------------------------------
// This software is Copyright (c) 2021 Embarcadero Technologies, Inc.
// You may only use this software if you are an authorized licensee
// of an Embarcadero developer tools product.
// This software is considered a Redistributable as defined under
// the software license agreement that comes with the Embarcadero Products
// and is subject to that software license agreement.
//---------------------------------------------------------------------------
unit View.Menu;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls,
View.Main, FMX.Layouts, FMX.Objects, FMX.Ani, FMX.Controls.Presentation,
Model.Utils, Model.Constants, Model.Types, FMX.Effects, FMX.DialogService.Async,
FMX.ListBox, System.Generics.Collections, FMX.ListView.Types,
FMX.ListView.Appearances, FMX.ListView.Adapters.Base, FMX.ListView;
type
TMenuFrame = class(TMainFrame, IUserInfo)
BgRect: TRectangle;
DataLayout: TGridPanelLayout;
UserInfoLayout: TGridPanelLayout;
UserImg: TImage;
VertScrollBox: TVertScrollBox;
ListBox: TListBox;
lblUsername: TLabel;
AccountSVG: TPath;
procedure HitBoxClick(Sender: TObject);
procedure MenuItemClick(Sender: TObject);
procedure lblUsernameApplyStyleLookup(Sender: TObject);
private
{ Private declarations }
public
function GetUserName: string;
procedure SetUserName(AValue: String);
function GetUserSettings: TUserSettings;
procedure SetUserImage(AUserImage: TBitmap);
function GetUserImage: TBitmap;
procedure CreateMenu;
constructor Create(AOwner: TComponent); override;
end;
implementation
{$R *.fmx}
uses
View.Menu.Item;
constructor TMenuFrame.Create(AOwner: TComponent);
begin
inherited;
CreateMenu;
end;
// Creating menu accordings registered Frames.
procedure TMenuFrame.CreateMenu;
begin
ListBox.Height := 0;
for var ActivityName: string in EnumRegisteredActivities(False) do
begin
if not sHiddenMenuActivities.Contains(ActivityName) then
begin
var MenuItemFrame := TMenuItemFrame.Create(NameToUserFriendlyName(ActivityName), MATERIAL_UI_GREY_200);
var MenuItem := TListBoxItem.Create(nil);
MenuItem.Name := ActivityName;
MenuItem.Text := EmptyStr;
MenuItem.OnClick := MenuItemClick;
MenuItem.Height := MenuItemFrame.Height;
MenuItem.AddObject(MenuItemFrame);
MenuItem.ClipParent := true;
ListBox.AddObject(MenuItem);
end;
end;
end;
function TMenuFrame.GetUserImage: TBitmap;
begin
Result := nil;
if Assigned(UserImg.Bitmap) then
Result := UserImg.Bitmap;
end;
function TMenuFrame.GetUserName: string;
begin
Result := lblUsername.Text;
end;
function TMenuFrame.GetUserSettings: TUserSettings;
begin
Result := nil;
end;
procedure TMenuFrame.HitBoxClick(Sender: TObject);
begin
GetMainForm.ShowActivity('Home', True)
end;
procedure TMenuFrame.lblUsernameApplyStyleLookup(Sender: TObject);
begin
inherited;
HamburgerImg.Fill.Color := lblUsername.GetStyledColor;
AccountSVG.Fill.Color := MATERIAL_UI_GREY_400;
HeaderRect.Stroke.Thickness := 0;
end;
procedure TMenuFrame.MenuItemClick(Sender: TObject);
begin
try
GetMainForm.ShowActivity(TControl(Sender).Name , True);
except
on E:Exception do
ShowMessage(E.Message);
end;
end;
procedure TMenuFrame.SetUserImage(AUserImage: TBitmap);
begin
UserImg.Bitmap.Assign(AUserImage);
UserImg.MakeCircleMask;
AccountSVG.Visible := False;
end;
procedure TMenuFrame.SetUserName(AValue: String);
begin
lblUsername.Text := AValue;
end;
initialization
// Register frame
RegisterClass(TMenuFrame);
finalization
// Unregister frame
UnRegisterClass(TMenuFrame);
end.