Skip to content

Commit 0baea57

Browse files
Cesar4DCesar4D
committed
bk/2025-05-08-2248
1 parent ed52797 commit 0baea57

4 files changed

Lines changed: 246 additions & 1 deletion

File tree

‎WebClient/Src/ClientMainView.dfm‎

Lines changed: 80 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,80 @@
1+
object ClientMain: TClientMain
2+
Width = 640
3+
Height = 480
4+
Font.Charset = DEFAULT_CHARSET
5+
Font.Color = clWindowText
6+
Font.Height = -13
7+
Font.Name = 'Tahoma'
8+
Font.Style = []
9+
FormContainer = 'appcontent'
10+
ParentFont = False
11+
OnCreate = WebFormCreate
12+
OnExit = WebFormExit
13+
object WebLabel1: TWebLabel
14+
Left = 8
15+
Top = 11
16+
Width = 43
17+
Height = 16
18+
Caption = 'UserID:'
19+
HeightPercent = 100.000000000000000000
20+
WidthPercent = 100.000000000000000000
21+
end
22+
object WebLabel3: TWebLabel
23+
Left = 312
24+
Top = 33
25+
Width = 130
26+
Height = 16
27+
Caption = 'Push Notification demo'
28+
ElementID = 'title'
29+
HeightPercent = 100.000000000000000000
30+
WidthPercent = 100.000000000000000000
31+
end
32+
object WebLabel4: TWebLabel
33+
Left = 312
34+
Top = 65
35+
Width = 184
36+
Height = 16
37+
Caption = 'Usage of TWebPushNotifications'
38+
ElementID = 'description'
39+
HeightPercent = 100.000000000000000000
40+
WidthPercent = 100.000000000000000000
41+
end
42+
object WebEdit1: TWebEdit
43+
Left = 57
44+
Top = 8
45+
Width = 216
46+
Height = 19
47+
HeightPercent = 100.000000000000000000
48+
WidthPercent = 100.000000000000000000
49+
OnChange = WebEdit1Change
50+
end
51+
object WebButton1: TWebButton
52+
Left = 8
53+
Top = 33
54+
Width = 265
55+
Height = 25
56+
Caption = 'Subscribe for push notifications'
57+
ChildOrder = 1
58+
HeightPercent = 100.000000000000000000
59+
WidthPercent = 100.000000000000000000
60+
OnClick = WebButton1Click
61+
end
62+
object WebButton2: TWebButton
63+
Left = 8
64+
Top = 64
65+
Width = 265
66+
Height = 25
67+
Caption = 'Unsubscribe from push notifications'
68+
ChildOrder = 2
69+
HeightPercent = 100.000000000000000000
70+
WidthPercent = 100.000000000000000000
71+
OnClick = WebButton2Click
72+
end
73+
object WebPushNotifications1: TWebPushNotifications
74+
RegisterSubscriptionURL = 'http://localhost:8081/registerSubscription'
75+
UnregisterSubscriptionURL = 'http://localhost:8081/unregisterSubscription'
76+
VapidPublickeyURL = 'http://localhost:8081/vapidPublicKey'
77+
Left = 168
78+
Top = 120
79+
end
80+
end

‎WebClient/Src/ClientMainView.html‎

Lines changed: 36 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,36 @@
1+
<html>
2+
<head>
3+
<meta http-equiv="Content-type" content="text/html; charset=utf-8" />
4+
<title>TMS Web Project</title>
5+
</head>
6+
<body>
7+
<header>
8+
<img src="https://www.tmssoftware.com/site/img/logos/loper.svg" class="background-image">
9+
<div class="top-title top-title-small">
10+
<a href="https://www.tmssoftware.com/" target="_blank" title="Visit tmssoftware">
11+
<img class="large" src="https://www.tmssoftware.com/site/img/logo_tms_software.png">
12+
<img class="small" src="https://www.tmssoftware.com/site/img/logo_tms_software_small.png">
13+
</a>
14+
</div>
15+
<div class="top-title top-title-small">
16+
<a href="http://web.tmssoftware.com/" target="_blank" title="Visit TMS Web Core page">
17+
<div class="tms-panel-thumb">WEB</div>
18+
<div class="tms-thumb-text">TMS WEB Core</div>
19+
</a>
20+
</div>
21+
<div class="bg-webgreen top-title top-title-detail" id="title">Title</div>
22+
<div class="bg-webgreen top-title top-title-description">
23+
<table>
24+
<tr><td class="icon">
25+
<i class="icon material-icons">info</i>
26+
</td><td>
27+
<span id="description">Description</span>
28+
</td></tr>
29+
</table>
30+
</div>
31+
</header>
32+
<div id="appcontent" class="appcontent">
33+
</div>
34+
</body>
35+
</html>
36+

‎WebClient/Src/ClientMainView.pas‎

Lines changed: 130 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,130 @@
1+
unit ClientMainView;
2+
3+
interface
4+
5+
uses
6+
System.SysUtils, System.Classes, JS, Web, WEBLib.Graphics, WEBLib.Controls,
7+
WEBLib.StdCtrls, WEBLib.Forms, WEBLib.Dialogs, WEBLib.PushNotifications,
8+
WEBLib.Storage, Vcl.StdCtrls, Vcl.Controls;
9+
10+
type
11+
TClientMain = class(TWebForm)
12+
WebEdit1: TWebEdit;
13+
WebButton1: TWebButton;
14+
WebButton2: TWebButton;
15+
WebLabel1: TWebLabel;
16+
WebPushNotifications1: TWebPushNotifications;
17+
WebLabel3: TWebLabel;
18+
WebLabel4: TWebLabel;
19+
procedure WebButton1Click(Sender: TObject);
20+
procedure WebButton2Click(Sender: TObject);
21+
procedure WebEdit1Change(Sender: TObject);
22+
procedure WebFormCreate(Sender: TObject);
23+
procedure WebFormExit(Sender: TObject);
24+
private
25+
ls: TLocalStorage;
26+
procedure DoAddToLocalStorage;
27+
procedure DoRemoveFromLocalStorage;
28+
procedure SetButtonState;
29+
function ValidUserID: Boolean;
30+
end;
31+
32+
var
33+
ClientMain: TClientMain;
34+
35+
implementation
36+
37+
{$R *.dfm}
38+
39+
procedure TClientMain.DoAddToLocalStorage;
40+
begin
41+
TWebLocalStorage.SetValue('pushUserID', WebEdit1.Text);
42+
SetButtonState;
43+
end;
44+
45+
procedure TClientMain.DoRemoveFromLocalStorage;
46+
begin
47+
TWebLocalStorage.RemoveKey('pushUserID');
48+
SetButtonState;
49+
end;
50+
51+
procedure TClientMain.SetButtonState;
52+
begin
53+
if WebEdit1.Text = '' then
54+
begin
55+
WebButton1.Enabled := False;
56+
WebButton2.Enabled := False;
57+
Exit;
58+
end;
59+
60+
if TLocalStorage.GetValue('pushUserID') = WebEdit1.Text then
61+
begin
62+
WebButton1.Enabled := False;
63+
WebButton2.Enabled := True;
64+
end
65+
else if TLocalStorage.GetValue('pushUserID') <> '' then
66+
begin
67+
WebButton1.Enabled := False;
68+
WebButton2.Enabled := False;
69+
end
70+
else
71+
begin
72+
WebButton1.Enabled := True;
73+
WebButton2.Enabled := False;
74+
end;
75+
end;
76+
77+
function TClientMain.ValidUserID: Boolean;
78+
begin
79+
Result := True;
80+
if WebEdit1.Text = '' then
81+
begin
82+
Result := False;
83+
ShowMessage('UserID cannot be empty!');
84+
end;
85+
end;
86+
87+
procedure TClientMain.WebButton1Click(Sender: TObject);
88+
begin
89+
if ValidUserID then
90+
begin
91+
WebPushNotifications1.RegistrationUserID := WebEdit1.Text;
92+
WebPushNotifications1.RegisterServiceWorker;
93+
94+
DoAddToLocalStorage;
95+
end;
96+
end;
97+
98+
procedure TClientMain.WebButton2Click(Sender: TObject);
99+
begin
100+
if ValidUserID then
101+
begin
102+
WebPushNotifications1.RegistrationUserID := WebEdit1.Text;
103+
WebPushNotifications1.Unsubscribe;
104+
105+
DoRemoveFromLocalStorage;
106+
end;
107+
end;
108+
109+
procedure TClientMain.WebEdit1Change(Sender: TObject);
110+
begin
111+
SetButtonState;
112+
end;
113+
114+
procedure TClientMain.WebFormCreate(Sender: TObject);
115+
begin
116+
ls := TLocalStorage.Create(Self);
117+
if ls.Count > 0 then
118+
begin
119+
WebEdit1.Text := TLocalStorage.GetValue('pushUserID');
120+
end;
121+
122+
SetButtonState;
123+
end;
124+
125+
procedure TClientMain.WebFormExit(Sender: TObject);
126+
begin
127+
ls.Free;
128+
end;
129+
130+
end.

‎WebClient/WebPushClient.dproj‎

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -94,7 +94,6 @@
9494
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
9595
<DCC_RemoteDebug>false</DCC_RemoteDebug>
9696
<AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode>
97-
<TMSWebBrowser>4</TMSWebBrowser>
9897
</PropertyGroup>
9998
<PropertyGroup Condition="'$(Cfg_2)'!=''">
10099
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>

0 commit comments

Comments
 (0)