Commit b86cbd6d by Mac Stephens

Begin core-and-clients migration; complete WC foundation ahead of BFD integration

parent 13ffaf77
......@@ -28,3 +28,8 @@ emiMobileServer/Source/__recovery/
*.dll
webEMIMobile/config/__history/
emiMobileServer/Clients/*/Web/**/__history/
emiMobileServer/Clients/*/Web/**/__recovery/
emiMobileServer/Clients/*/Web/TMSWeb/
emiMobileServer/Clients/*/Web/Win32/
unit App.Types;
interface
uses
Bcl.Rtti.Common;
type
TProc = reference to procedure;
TSuccessProc = reference to procedure;
TLogoutProc = reference to procedure(AMessage: string = '');
TUnauthorizedAccessProc = reference to procedure(AMessage: string);
TVersionCheckCallback = reference to procedure(Success: Boolean; ErrorMessage: string);
TListProc = reference to procedure;
TSelectProc = reference to procedure(AParam: string);
TSelectProc2 = reference to procedure(AParam: string; BParam: string);
TSelectProc3 = reference to procedure(AParam: string; BParam: string; CParam: Boolean);
TSelectProc4 = reference to procedure(AParam: string; BParam: string; CParam: string; DParam: Boolean);
TSearchProc = reference to procedure(AParam: string; BParam: string; CParam: Integer; DParam: Boolean);
TReportProc = reference to procedure(AParam: string);
implementation
end.
unit Auth.Service;
interface
uses
SysUtils, Web, JS,
XData.Web.Client;
const
TOKEN_NAME = 'WEBEMIMOBILE_TOKEN';
type
TOnLoginSuccess = reference to procedure;
TOnLoginError = reference to procedure(AMsg: string);
TOnProfileSuccess = reference to procedure;
TOnProfileError = reference to procedure(AMsg: string);
TAuthService = class
private
FClient: TXDataWebClient;
procedure SetToken(AToken: string);
procedure DeleteToken;
public
constructor Create; reintroduce;
destructor Destroy; override;
procedure Login(AUser, APassword, AAgency: string; ASuccess: TOnLoginSuccess;
AError: TOnLoginError);
procedure Logout;
function GetToken: string;
function Authenticated: Boolean;
function TokenExpirationDate: TDateTime;
function TokenExpired: Boolean;
function TokenPayload: JS.TJSObject;
end;
TJwtHelper = class
private
class function HasExpirationDate(AToken: string): Boolean;
public
class function TokenExpirationDate(AToken: string): TJSDate;
class function TokenExpired(AToken: string): Boolean;
class function DecodePayload(AToken: string): string;
end;
function AuthService: TAuthService;
implementation
uses
ConnectionModule;
var
_AuthService: TAuthService;
function AuthService: TAuthService;
begin
if not Assigned(_AuthService) then
begin
_AuthService := TAuthService.Create;
end;
Result := _AuthService;
end;
{ TAuthService }
function TAuthService.Authenticated: Boolean;
begin
Result := not isNull(window.localStorage.getItem(TOKEN_NAME)) and
(window.localStorage.getItem(TOKEN_NAME) <> '');
end;
constructor TAuthService.Create;
begin
FClient := TXDataWebClient.Create(nil);
FClient.Connection := DMConnection.AuthConnection;
end;
procedure TAuthService.DeleteToken;
begin
window.localStorage.removeItem(TOKEN_NAME);
end;
destructor TAuthService.Destroy;
begin
FClient.Free;
inherited;
end;
function TAuthService.GetToken: string;
begin
Result := window.localStorage.getItem(TOKEN_NAME);
end;
procedure TAuthService.Login(AUser, APassword, AAgency: string; ASuccess: TOnLoginSuccess;
AError: TOnLoginError);
procedure OnLoad(Response: TXDataClientResponse);
var
Token: JS.TJSObject;
begin
Token := JS.TJSObject(Response.Result);
SetToken(JS.toString(Token.Properties['value']));
ASuccess;
end;
procedure OnError(Error: TXDataClientError);
begin
AError(Format('%s: %s', [Error.ErrorCode, Error.ErrorMessage]));
end;
begin
if (AUser = '') or (APassword = '') or (AAgency = '') then
begin
AError('Please enter a username, password, and agency');
Exit;
end;
FClient.RawInvoke(
'IAuthService.Login', [AUser, APassword, AAgency],
@OnLoad, @OnError
);
end;
procedure TAuthService.Logout;
begin
DeleteToken;
end;
procedure TAuthService.SetToken(AToken: string);
begin
window.localStorage.setItem(TOKEN_NAME, AToken);
end;
function TAuthService.TokenExpirationDate: TDateTime;
var
ExpirationDate: TJSDate;
begin
if not Authenticated then
Exit(Now);
ExpirationDate := TJwtHelper.TokenExpirationDate(GetToken);
Result := EncodeDate(
ExpirationDate.FullYear,
ExpirationDate.Month + 1,
ExpirationDate.Date
) +
EncodeTime(
ExpirationDate.Hours,
ExpirationDate.Minutes,
ExpirationDate.Seconds,
0
);
end;
function TAuthService.TokenExpired: Boolean;
begin
if not Authenticated then
Exit(False);
Result := TJwtHelper.TokenExpired(GetToken);
end;
function TAuthService.TokenPayload: JS.TJSObject;
begin
if not Authenticated then
Exit(nil);
Result := TJSObject(TJSJSON.parse(TJwtHelper.DecodePayload(GetToken)));
end;
{ TJwtHelper }
class function TJwtHelper.DecodePayload(AToken: string): string;
begin
if Trim(AToken) = '' then
Exit('');
Result := '';
asm
var Token = AToken.split('.');
if (Token.length = 3) {
Result = Token[1];
Result = atob(Result);
}
end;
end;
class function TJwtHelper.HasExpirationDate(AToken: string): Boolean;
var
Payload: string;
Obj: TJSObject;
begin
Payload := DecodePayload(AToken);
Obj := TJSObject(TJSJSON.parse(Payload));
Result := Obj.hasOwnProperty('exp');
end;
class function TJwtHelper.TokenExpirationDate(AToken: string): TJSDate;
var
Payload: string;
Obj: TJSObject;
Epoch: NativeInt;
begin
if not HasExpirationDate(AToken) then
raise Exception.Create('Token has no expiration date');
Payload := DecodePayload(AToken);
Obj := TJSObject(TJSJSON.parse(Payload));
Epoch := toInteger(Obj.Properties['exp']);
Result := TJSDate.New(Epoch * 1000);
end;
class function TJwtHelper.TokenExpired(AToken: string): Boolean;
begin
if not HasExpirationDate(AToken) then
Exit(False);
Result := TJSDate.now > toInteger(TokenExpirationDate(AToken).valueOf);
end;
end.
unit ConnectionModule;
interface
uses
System.SysUtils, System.Classes, WEBLib.Modules, XData.Web.Connection,
App.Types, App.Config, XData.Web.Client;
type
TDMConnection = class(TWebDataModule)
ApiConnection: TXDataWebConnection;
AuthConnection: TXDataWebConnection;
XDataWebClient1: TXDataWebClient;
procedure ApiConnectionError(Error: TXDataWebConnectionError);
procedure ApiConnectionRequest(Args: TXDataWebConnectionRequest);
procedure ApiConnectionResponse(Args: TXDataWebConnectionResponse);
procedure AuthConnectionError(Error: TXDataWebConnectionError);
private
FUnauthorizedAccessProc: TUnauthorizedAccessProc;
FWsUrl: string;
public
property WsUrl: string read FWsUrl;
const clientVersion = '9.4.0';
procedure InitApp(SuccessProc: TSuccessProc;
UnauthorizedAccessProc: TUnauthorizedAccessProc);
procedure SetClientConfig(Callback: TVersionCheckCallback);
end;
var
DMConnection: TDMConnection;
implementation
uses
JS, Web,
XData.Web.Request,
XData.Web.Response,
Auth.Service,
View.ErrorPage;
{%CLASSGROUP 'Vcl.Controls.TControl'}
{$R *.dfm}
procedure TDMConnection.ApiConnectionError(Error: TXDataWebConnectionError);
begin
TFViewErrorPage.DisplayConnectionError(Error);
end;
procedure TDMConnection.ApiConnectionRequest(Args: TXDataWebConnectionRequest);
begin
if AuthService.Authenticated then
Args.Request.Headers.SetValue('Authorization', 'Bearer ' + AuthService.GetToken);
end;
procedure TDMConnection.ApiConnectionResponse(
Args: TXDataWebConnectionResponse);
begin
if Args.Response.StatusCode = 401 then
FUnauthorizedAccessProc(Format('%d: %s',[Args.Response.StatusCode, Args.Response.ContentAsText]));
end;
procedure TDMConnection.AuthConnectionError(Error: TXDataWebConnectionError);
begin
TFViewErrorPage.DisplayConnectionError(Error);
end;
procedure TDMConnection.InitApp(SuccessProc: TSuccessProc;
UnauthorizedAccessProc: TUnauthorizedAccessProc);
procedure ConfigLoaded(Config: TAppConfig);
begin
if Config.AuthUrl <> '' then
AuthConnection.URL := Config.AuthUrl;
if Config.ApiUrl <> '' then
ApiConnection.URL := Config.ApiUrl;
if Config.WsUrl <> '' then
FWsUrl := Config.WsUrl;
AuthConnection.Open(SuccessProc);
end;
begin
FUnauthorizedAccessProc := UnauthorizedAccessProc;
LoadConfig(@ConfigLoaded);
end;
procedure TDMConnection.SetClientConfig(Callback: TVersionCheckCallback);
begin
XDataWebClient1.Connection := AuthConnection;
XDataWebClient1.RawInvoke('IAuthService.VerifyVersion', [clientVersion],
procedure(Response: TXDataClientResponse)
var
jsonResult: TJSObject;
error: string;
begin
jsonResult := TJSObject(Response.Result);
if jsonResult.HasOwnProperty('error') then
error := string(jsonResult['error'])
else
error := '';
if error <> '' then
Callback(False, error)
else
Callback(True, '');
end);
end;
end.
unit Module.Websocket;
interface
uses
System.SysUtils, System.Classes, WEBLib.WebSocketClient, Web, WEBLib.Controls, WEBLib.Modules,
Auth.Service, JS;
type
// Handler signature: receives the fully parsed JSON object for one push message.
TWsDataHandler = procedure(aData: TJSObject) of object;
TdmWebsocket = class(TWebDataModule)
procedure WebDataModuleCreate(Sender: TObject);
procedure WebDataModuleDestroy(Sender: TObject);
private
procedure EMiMobileWebSocketClientConnect(Sender: TObject);
procedure EMiMobileWebSocketClientDataReceived(Sender: TObject;
Origin: string; SocketData: TJSObjectRecord);
procedure EMiMobileWebSocketClientDisconnect(Sender: TObject);
procedure EMiMobileWebSocketClientMessageReceived(Sender: TObject;
AMessage: string);
procedure EMiMobileWebSocketClientBinaryDataReceived(Sender: TObject;
AData: TBytes);
procedure DispatchMessage(const AMessage: string);
FOnBadgeCounts: TWsDataHandler;
FOnUnitMap: TWsDataHandler;
FOnComplaintMap: TWsDataHandler;
FOnUnitList: TWsDataHandler;
FOnComplaintList: TWsDataHandler;
public
EMiMobileWebSocketClient: TWebSocketClient;
procedure Connect(const AWsUrl: string);
// Assign these before calling Connect so that pushes are routed immediately.
property OnBadgeCounts: TWsDataHandler read FOnBadgeCounts write FOnBadgeCounts;
property OnUnitMap: TWsDataHandler read FOnUnitMap write FOnUnitMap;
property OnComplaintMap: TWsDataHandler read FOnComplaintMap write FOnComplaintMap;
property OnUnitList: TWsDataHandler read FOnUnitList write FOnUnitList;
property OnComplaintList: TWsDataHandler read FOnComplaintList write FOnComplaintList;
end;
var
dmWebsocket: TdmWebsocket;
implementation
{%CLASSGROUP 'Vcl.Controls.TControl'}
{$R *.dfm}
procedure TdmWebsocket.Connect(const AWsUrl: string);
var
Rest, HostPort, Scheme, Path, Token: string;
ColonSlashSlash, SlashPos, ColonPos: Integer;
begin
if AWsUrl = '' then
Exit;
// Parse ws://host:port/path or wss://host:port/path
ColonSlashSlash := Pos('://', AWsUrl);
if ColonSlashSlash = 0 then
Exit;
Scheme := LowerCase(Copy(AWsUrl, 1, ColonSlashSlash - 1));
Rest := Copy(AWsUrl, ColonSlashSlash + 3, MaxInt);
SlashPos := Pos('/', Rest);
if SlashPos > 0 then
begin
HostPort := Copy(Rest, 1, SlashPos - 1);
Path := Copy(Rest, SlashPos, MaxInt);
end
else
begin
HostPort := Rest;
Path := '/';
end;
// Append JWT token as query param — browsers can't set Authorization headers on WebSocket.
Token := AuthService.GetToken;
if Token <> '' then
begin
if Pos('?', Path) > 0 then
Path := Path + '&token=' + Token
else
Path := Path + '?token=' + Token;
end;
EMiMobileWebSocketClient.PathName := Path;
ColonPos := Pos(':', HostPort);
if ColonPos > 0 then
begin
EMiMobileWebSocketClient.HostName := Copy(HostPort, 1, ColonPos - 1);
if Scheme = 'wss' then
EMiMobileWebSocketClient.Port := StrToIntDef(Copy(HostPort, ColonPos + 1, MaxInt), 443)
else
EMiMobileWebSocketClient.Port := StrToIntDef(Copy(HostPort, ColonPos + 1, MaxInt), 80);
end
else
begin
EMiMobileWebSocketClient.HostName := HostPort;
if Scheme = 'wss' then
EMiMobileWebSocketClient.Port := 443
else
EMiMobileWebSocketClient.Port := 80;
end;
console.log('WS: connecting to ' + AWsUrl);
EMiMobileWebSocketClient.UseSSL := (Scheme = 'wss');
EMiMobileWebSocketClient.Active := True;
console.log('WS: Active set to true');
end;
procedure TdmWebsocket.DispatchMessage(const AMessage: string);
var
obj: TJSObject;
requestId: string;
messageType: string;
messageText: string;
begin
if AMessage = '' then
Exit;
asm
{
try {
obj = JSON.parse(AMessage);
} catch(e) {
obj = null;
}
}
end;
if obj = nil then
begin
console.log('WS: could not parse message');
Exit;
end;
messageType := string(obj['message']);
if SameText(messageType, 'test_message') then
begin
messageText := string(obj['text']);
window.alert(messageText);
Exit;
end;
requestId := string(obj['RequestId']);
if requestId <> '' then
console.log('WS: received ' + requestId);
if SameText(requestId, 'BADGE_COUNTS') then
begin
if Assigned(FOnBadgeCounts) then FOnBadgeCounts(obj);
end
else if SameText(requestId, 'UNIT_MAP') then
begin
if Assigned(FOnUnitMap) then FOnUnitMap(obj);
end
else if SameText(requestId, 'COMPLAINT_MAP') then
begin
if Assigned(FOnComplaintMap) then FOnComplaintMap(obj);
end
else if SameText(requestId, 'UNIT_LIST') then
begin
if Assigned(FOnUnitList) then FOnUnitList(obj);
end
else if SameText(requestId, 'COMPLAINT_LIST') then
begin
if Assigned(FOnComplaintList) then FOnComplaintList(obj);
end
else
console.log('WS: unknown RequestId: ' + requestId);
end;
procedure TdmWebsocket.EMiMobileWebSocketClientBinaryDataReceived(
Sender: TObject; AData: TBytes);
begin
console.log('WS: binary data received (ignored)');
end;
procedure TdmWebsocket.EMiMobileWebSocketClientConnect(Sender: TObject);
var
msg: TJSObject;
begin
console.log('WS: connected');
msg := TJSObject.new;
msg['message'] := 'identify';
msg['userId'] := JS.toString(AuthService.TokenPayload.Properties['user_name']);
EMiMobileWebSocketClient.Send(TJSJSON.stringify(msg));
end;
procedure TdmWebsocket.EMiMobileWebSocketClientDataReceived(Sender: TObject;
Origin: string; SocketData: TJSObjectRecord);
begin
// Text messages arrive via EMiMobileWebSocketClientMessageReceived.
end;
procedure TdmWebsocket.EMiMobileWebSocketClientDisconnect(Sender: TObject);
begin
console.log('WS: disconnected');
end;
procedure TdmWebsocket.EMiMobileWebSocketClientMessageReceived(Sender: TObject;
AMessage: string);
begin
DispatchMessage(AMessage);
end;
procedure TdmWebsocket.WebDataModuleCreate(Sender: TObject);
begin
console.log('WS: datamodule created');
EMiMobileWebSocketClient.OnConnect := EMiMobileWebSocketClientConnect;
EMiMobileWebSocketClient.OnDisconnect := EMiMobileWebSocketClientDisconnect;
EMiMobileWebSocketClient.OnMessageReceived := EMiMobileWebSocketClientMessageReceived;
end;
procedure TdmWebsocket.WebDataModuleDestroy(Sender: TObject);
begin
end;
end.
object FViewComplaintArchive: TFViewComplaintArchive
Width = 640
Height = 480
object tblRemarksArc: TWebDBTableControl
Left = 102
Top = 128
Width = 191
Height = 147
ElementId = 'tbl_remarks_arc'
BorderColor = clSilver
ChildOrder = 8
ElementFont = efCSS
ElementHeaderClassName = 'table-light'
ElementTableClassName =
'table table-sm table-striped table-hover table-bordered mb-0 ali' +
'gn-middle'
Footer.ButtonActiveElementClassName = 'btn btn-primary'
Footer.ButtonElementClassName = 'btn btn-light'
Footer.DropDownElementClassName = 'form-control'
Footer.InputElementClassName = 'form-control'
Footer.LinkActiveElementClassName = 'link-primary'
Footer.LinkElementClassName = 'link-secondary'
Footer.ListElementClassName = 'pagination'
Footer.ListItemElementClassName = 'page-item'
Footer.ListLinkElementClassName = 'page-link'
Header.ButtonActiveElementClassName = 'btn btn-primary'
Header.ButtonElementClassName = 'btn btn-light'
Header.DropDownElementClassName = 'form-control'
Header.InputElementClassName = 'form-control'
Header.LinkActiveElementClassName = 'link-primary'
Header.LinkElementClassName = 'link-secondary'
Header.ListElementClassName = 'pagination'
Header.ListItemElementClassName = 'page-item'
Header.ListLinkElementClassName = 'page-link'
WordWrap = True
Columns = <
item
ElementClassName = 'd-none'
DataField = 'MemoType'
Title = 'Type'
TitleElementClassName = 'd-none'
end
item
DataField = 'Timestamp'
Title = 'Timestamp'
end
item
DataField = 'Remarks'
Title = 'Remarks'
end>
DataSource = wdsRemarksArc
end
object btnUntArc: TWebButton
Left = 378
Top = 85
Width = 96
Height = 25
Caption = 'UNT'
ChildOrder = 1
ElementID = 'btn_unt_arc'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
TabStop = False
WidthPercent = 100.000000000000000000
OnClick = btnUntArcClick
end
object btnREMArc: TWebButton
Left = 276
Top = 85
Width = 96
Height = 25
Caption = 'REM'
ChildOrder = 1
ElementID = 'btn_rem_arc'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
TabStop = False
WidthPercent = 100.000000000000000000
OnClick = btnREMArcClick
end
object btnE911Arc: TWebButton
Left = 166
Top = 85
Width = 96
Height = 25
Caption = 'E-911'
ChildOrder = 1
ElementID = 'btn_e911_arc'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
TabStop = False
WidthPercent = 100.000000000000000000
OnClick = btnE911ArcClick
end
object btnCmpArc: TWebButton
Left = 64
Top = 85
Width = 96
Height = 25
Caption = 'CMP'
ChildOrder = 1
ElementID = 'btn_cmp_arc'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
TabStop = False
WidthPercent = 100.000000000000000000
OnClick = btnCmpArcClick
end
object xdwcComplaintArchive: TXDataWebClient
Connection = DMConnection.ApiConnection
Left = 292
Top = 310
end
object xdwdsRemarksArc: TXDataWebDataSet
Left = 68
Top = 316
object xdwdsRemarksArcMemoId: TStringField
FieldName = 'MemoId'
end
object xdwdsRemarksArcCFSId: TStringField
FieldName = 'CFSId'
end
object xdwdsRemarksArcMemoType: TStringField
FieldName = 'MemoType'
end
object xdwdsRemarksArcTimestamp: TStringField
FieldName = 'Timestamp'
end
object xdwdsRemarksArcBadgeNumber: TStringField
FieldName = 'BadgeNumber'
end
object xdwdsRemarksArcRemarks: TStringField
FieldName = 'Remarks'
end
end
object wdsRemarksArc: TWebDataSource
DataSet = xdwdsRemarksArc
Left = 156
Top = 314
end
end
<div class="d-flex flex-column h-100 w-100 overflow-hidden">
<div class="flex-grow-1 d-flex flex-column overflow-auto bg-light p-2 p-md-3" style="min-height:0;">
<!-- Sticky block: Summary header + summary body -->
<div class="sticky-top bg-light" style="z-index:20;">
<!-- Summary header -->
<div class="card border-0 shadow-sm mb-2">
<div class="card-header bg-white py-2">
<button
class="btn btn-link text-decoration-none p-0 w-100 d-flex align-items-center justify-content-between summary-toggle"
type="button"
data-bs-toggle="collapse"
data-bs-target="#cdetails_summary_arc"
aria-expanded="true"
aria-controls="cdetails_summary_arc">
<span class="fw-semibold text-dark" id="lbl_summary_title_arc">Summary</span>
<span class="summary-chevron" aria-hidden="true">
<svg class="summary-chevron-icon" viewBox="0 0 16 16" focusable="false">
<path fill="currentColor" d="M7.646 5.354a.5.5 0 0 1 .708 0l5 5a.5.5 0 0 1-.708.708L8 6.414 3.354 11.06a.5.5 0 1 1-.708-.708l5-5z"/>
</svg>
</span>
</button>
</div>
</div>
<!-- Summary body -->
<div id="cdetails_summary_arc" class="collapse show">
<div class="card border-0 shadow-sm mb-2">
<div class="card-body py-2">
<table class="table table-sm mb-0 w-100">
<tbody>
<tr>
<th scope="row" class="fw-semibold text-nowrap pe-2 w-auto">Response:</th>
<td class="w-100" id="lbl_priority_arc"></td>
</tr>
<tr>
<th scope="row" class="fw-semibold text-nowrap pe-2 w-auto">Status:</th>
<td class="w-100" id="lbl_status_arc"></td>
</tr>
<tr>
<th scope="row" class="fw-semibold text-nowrap pe-2 w-auto">Dispatch Code:</th>
<td class="w-100" id="lbl_dispatch_code_arc"></td>
</tr>
<tr>
<th scope="row" class="fw-semibold text-nowrap pe-2 w-auto">Dispatch District:</th>
<td class="w-100" id="lbl_dispatch_district_arc"></td>
</tr>
<tr>
<th scope="row" class="fw-semibold text-nowrap pe-2 w-auto">Address:</th>
<td class="w-100" id="lbl_address_arc"></td>
</tr>
<tr id="row_business_arc" class="d-none">
<th scope="row" class="fw-semibold text-nowrap pe-2 w-auto">Business:</th>
<td class="w-100" id="lbl_business_arc"></td>
</tr>
</tbody>
</table>
</div>
</div>
<!-- Remarks toggle filters -->
<div class="pb-2">
<div class="d-flex flex-wrap gap-2 justify-content-center mt-2" id="row_remarks_toggles_arc">
<button type="button" class="btn btn-success btn-sm px-3 active" id="btn_cmp_arc" aria-pressed="true">CMP</button>
<button type="button" class="btn btn-success btn-sm px-3 active" id="btn_e911_arc" aria-pressed="true">E-911</button>
<button type="button" class="btn btn-success btn-sm px-3 active" id="btn_rem_arc" aria-pressed="true">REM</button>
<button type="button" class="btn btn-success btn-sm px-3 active" id="btn_unt_arc" aria-pressed="true">UNT</button>
</div>
</div>
</div>
</div>
<!-- Remarks table (scrolls with page) -->
<div class="card border-0 shadow-sm">
<div class="card-body p-0">
<div id="tbl_remarks_arc"></div>
</div>
</div>
</div>
</div>
unit View.ComplaintArchive;
interface
uses
System.SysUtils, System.Classes, JS, Web,
WEBLib.Graphics, WEBLib.Controls, WEBLib.Forms, WEBLib.Dialogs,
Vcl.Controls, Vcl.StdCtrls, Data.DB,
WEBLib.StdCtrls, WEBLib.Grids, WEBLib.DBCtrls, WEBLib.DB,
XData.Web.Client, XData.Web.JsonDataset, XData.Web.Dataset,
ConnectionModule;
type
TFViewComplaintArchive = class(TWebForm)
tblRemarksArc: TWebDBTableControl;
xdwcComplaintArchive: TXDataWebClient;
xdwdsRemarksArc: TXDataWebDataSet;
xdwdsRemarksArcMemoId: TStringField;
xdwdsRemarksArcCFSId: TStringField;
xdwdsRemarksArcMemoType: TStringField;
xdwdsRemarksArcTimestamp: TStringField;
xdwdsRemarksArcBadgeNumber: TStringField;
xdwdsRemarksArcRemarks: TStringField;
wdsRemarksArc: TWebDataSource;
btnUntArc: TWebButton;
btnREMArc: TWebButton;
btnE911Arc: TWebButton;
btnCmpArc: TWebButton;
procedure btnCmpArcClick(Sender: TObject);
procedure btnE911ArcClick(Sender: TObject);
procedure btnREMArcClick(Sender: TObject);
procedure btnUntArcClick(Sender: TObject);
private
FComplaintId: string;
FCfsId: string;
FAllMemos: TJSArray;
FShowCMP: Boolean;
FShowE911: Boolean;
FShowREM: Boolean;
FShowUNT: Boolean;
FInitialized: Boolean;
procedure WireUi;
procedure SetTextById(const Id, Value: string);
procedure SetHiddenById(const Id: string; Hidden: Boolean);
procedure SetButtonActive(aButton: TWebButton; Active: Boolean);
[async] procedure LoadArchiveAsync;
[async] procedure LoadMemosAsync;
procedure ApplyMemoFilters;
function GetMemoTypeCode(const MemoType: string): string;
function MemoTypeLabel(const MemoType: string): string;
function MemoTypeInList(const memoType: string; const list: array of string): Boolean;
procedure SetRemarksData(dataArr: TJSArray);
function DeriveStatusFromDates(const dateDispatched, dateArrived, dateCleared: string): string;
public
class function CreateForm(const AHostId, AComplaintId: string): TWebForm;
procedure InitializeForm;
end;
implementation
uses
View.Main;
{$R *.dfm}
class function TFViewComplaintArchive.CreateForm(const AHostId, AComplaintId: string): TWebForm;
procedure AfterCreate(AForm: TObject);
begin
with TFViewComplaintArchive(AForm) do
begin
FComplaintId := AComplaintId;
InitializeForm;
end;
end;
begin
Application.CreateForm(TFViewComplaintArchive, AHostId, Result, @AfterCreate);
end;
procedure TFViewComplaintArchive.InitializeForm;
begin
if FInitialized then
Exit;
FInitialized := True;
xdwcComplaintArchive.Connection := DMConnection.ApiConnection;
xdwdsRemarksArc.Connection := DMConnection.ApiConnection;
FAllMemos := nil;
FShowCMP := True;
FShowE911 := True;
FShowREM := True;
FShowUNT := True;
WireUi;
LoadArchiveAsync;
end;
procedure TFViewComplaintArchive.WireUi;
begin
// Nothing required here beyond component OnClick handlers;
// all element IDs are bound via the DFM.
end;
procedure TFViewComplaintArchive.SetTextById(const Id, Value: string);
var
el: TJSElement;
begin
el := Document.getElementById(Id);
if el <> nil then
el.innerHTML := Value;
end;
procedure TFViewComplaintArchive.SetHiddenById(const Id: string; Hidden: Boolean);
var
el: TJSHTMLElement;
begin
el := TJSHTMLElement(Document.getElementById(Id));
if el = nil then
Exit;
if Hidden then
el.classList.add('d-none')
else
el.classList.remove('d-none');
end;
procedure TFViewComplaintArchive.SetButtonActive(aButton: TWebButton; Active: Boolean);
var
el: TJSHTMLElement;
begin
if (aButton = nil) or (aButton.ElementHandle = nil) then
Exit;
el := TJSHTMLElement(aButton.ElementHandle);
if Active then
begin
el.classList.add('active');
el.setAttribute('aria-pressed', 'true');
end
else
begin
el.classList.remove('active');
el.setAttribute('aria-pressed', 'false');
end;
end;
[async] procedure TFViewComplaintArchive.LoadArchiveAsync;
var
resp: TXDataClientResponse;
rootObj: TJSObject;
dataObj: TJSObject;
business: string;
dateDispatchedText: string;
dateArrivedText: string;
dateClearedText: string;
statusText: string;
begin
resp := await(xdwcComplaintArchive.RawInvokeAsync('IApiService.GetComplaintArchiveDetails', [FComplaintId]));
rootObj := TJSObject(resp.Result);
dataObj := TJSObject(rootObj['data']);
SetTextById('lbl_summary_title_arc', 'Summary for Incident ' + string(dataObj['Complaint']));
SetTextById('lbl_priority_arc', string(dataObj['Priority']));
SetTextById('lbl_dispatch_code_arc', string(dataObj['DispatchCodeDesc']));
SetTextById('lbl_dispatch_district_arc', string(dataObj['DispatchDistrict']));
SetTextById('lbl_address_arc', string(dataObj['Address']));
business := '';
if dataObj.hasOwnProperty('Business') then
business := string(dataObj['Business']);
if Trim(business) <> '' then
begin
SetTextById('lbl_business_arc', business);
SetHiddenById('row_business_arc', False);
end
else
SetHiddenById('row_business_arc', True);
dateDispatchedText := '';
dateArrivedText := '';
dateClearedText := '';
if dataObj.hasOwnProperty('DateDispatched') then
dateDispatchedText := string(dataObj['DateDispatched']);
if dataObj.hasOwnProperty('DateArrived') then
dateArrivedText := string(dataObj['DateArrived']);
if dataObj.hasOwnProperty('DateCleared') then
dateClearedText := string(dataObj['DateCleared']);
statusText := '';
if dataObj.hasOwnProperty('Status') then
statusText := string(dataObj['Status']);
if Trim(statusText) = '' then
statusText := DeriveStatusFromDates(dateDispatchedText, dateArrivedText, dateClearedText);
SetTextById('lbl_status_arc', statusText);
FCfsId := '';
if dataObj.hasOwnProperty('CFSId') then
FCfsId := string(dataObj['CFSId']);
await(LoadMemosAsync);
end;
function TFViewComplaintArchive.MemoTypeLabel(const MemoType: string): string;
var
code: string;
begin
code := GetMemoTypeCode(MemoType);
if code = 'CMP' then
Exit('CMP');
if code = 'E911' then
Exit('E-911');
if code = 'REM' then
Exit('REM');
if code = 'UNT' then
Exit('UNT');
Result := MemoType;
end;
function TFViewComplaintArchive.GetMemoTypeCode(const MemoType: string): string;
var
memoTypeCode: string;
begin
memoTypeCode := Trim(MemoType);
if MemoTypeInList(memoTypeCode, ['30', '31', '32', '33', '34']) then
Exit('UNT');
if MemoTypeInList(memoTypeCode, ['3', '4']) then
Exit('CMP');
if MemoTypeInList(memoTypeCode, ['2']) then
Exit('E911');
if MemoTypeInList(memoTypeCode, ['1']) then
Exit('REM');
Result := memoTypeCode;
end;
[async] procedure TFViewComplaintArchive.LoadMemosAsync;
var
resp: TXDataClientResponse;
rootObj: TJSObject;
dataArr: TJSArray;
i: Integer;
memoObj: TJSObject;
memoType: string;
begin
// Reset dataset
xdwdsRemarksArc.Close;
if Trim(FCfsId) = '' then
Exit;
resp := await(xdwcComplaintArchive.RawInvokeAsync('IApiService.GetComplaintMemos', [FCfsId]));
rootObj := TJSObject(resp.Result);
dataArr := TJSArray(rootObj['data']);
// Save master array for filtering
FAllMemos := dataArr;
// Add/normalize memo type label/code (client-side)
for i := 0 to dataArr.length - 1 do
begin
memoObj := TJSObject(dataArr[i]);
memoType := string(memoObj['MemoType']);
memoObj['MemoTypeCode'] := GetMemoTypeCode(memoType);
memoObj['MemoType'] := MemoTypeLabel(memoType);
end;
ApplyMemoFilters;
end;
procedure TFViewComplaintArchive.ApplyMemoFilters;
var
filtered: TJSArray;
i: Integer;
memoObj: TJSObject;
code: string;
ok: Boolean;
begin
if FAllMemos = nil then
Exit;
filtered := TJSArray.new;
for i := 0 to FAllMemos.length - 1 do
begin
memoObj := TJSObject(FAllMemos[i]);
code := string(memoObj['MemoTypeCode']);
ok := False;
if (code = 'CMP') and FShowCMP then ok := True;
if (code = 'E911') and FShowE911 then ok := True;
if (code = 'REM') and FShowREM then ok := True;
if (code = 'UNT') and FShowUNT then ok := True;
if ok then
filtered.push(memoObj);
end;
SetRemarksData(filtered);
end;
procedure TFViewComplaintArchive.btnCmpArcClick(Sender: TObject);
begin
FShowCMP := not FShowCMP;
SetButtonActive(btnCmpArc, FShowCMP);
ApplyMemoFilters;
end;
procedure TFViewComplaintArchive.btnE911ArcClick(Sender: TObject);
begin
FShowE911 := not FShowE911;
SetButtonActive(btnE911Arc, FShowE911);
ApplyMemoFilters;
end;
procedure TFViewComplaintArchive.btnREMArcClick(Sender: TObject);
begin
FShowREM := not FShowREM;
SetButtonActive(btnREMArc, FShowREM);
ApplyMemoFilters;
end;
procedure TFViewComplaintArchive.btnUntArcClick(Sender: TObject);
begin
FShowUNT := not FShowUNT;
SetButtonActive(btnUntArc, FShowUNT);
ApplyMemoFilters;
end;
function TFViewComplaintArchive.MemoTypeInList(const memoType: string; const list: array of string): Boolean;
var
i: Integer;
begin
Result := False;
for i := Low(list) to High(list) do
begin
if memoType = list[i] then
Exit(True);
end;
end;
procedure TFViewComplaintArchive.SetRemarksData(dataArr: TJSArray);
begin
xdwdsRemarksArc.Close;
xdwdsRemarksArc.SetJsonData(dataArr);
xdwdsRemarksArc.Open;
end;
function TFViewComplaintArchive.DeriveStatusFromDates(const dateDispatched, dateArrived, dateCleared: string): string;
begin
if Trim(dateCleared) <> '' then
Exit('Cleared');
if Trim(dateArrived) <> '' then
Exit('On Scene');
if Trim(dateDispatched) <> '' then
Exit('Dispatched');
Result := 'Pending';
end;
end.
<div class="d-flex flex-column h-100 w-100 overflow-hidden">
<div class="flex-grow-1 d-flex flex-column overflow-auto bg-light p-2 p-md-3" style="min-height:0;">
<!-- Sticky block: Summary header + (expanded) summary body + buttons -->
<div class="sticky-top bg-light" style="z-index:20;">
<!-- Summary header -->
<div class="card border-0 shadow-sm mb-2">
<div class="card-header bg-white py-2">
<button
class="btn btn-link text-decoration-none p-0 w-100 d-flex align-items-center justify-content-between summary-toggle"
type="button"
data-bs-toggle="collapse"
data-bs-target="#cdetails_summary"
aria-expanded="true"
aria-controls="cdetails_summary">
<span class="fw-semibold text-dark" id="lbl_summary_title">Summary</span>
<span class="summary-chevron" aria-hidden="true">
<svg class="summary-chevron-icon" viewBox="0 0 16 16" focusable="false">
<path fill="currentColor" d="M7.646 5.354a.5.5 0 0 1 .708 0l5 5a.5.5 0 0 1-.708.708L8 6.414 3.354 11.06a.5.5 0 1 1-.708-.708l5-5z"/>
</svg>
</span>
</button>
</div>
</div>
<!-- Summary body (stays sticky because it's inside the sticky block) -->
<div id="cdetails_summary" class="collapse show">
<div class="card border-0 shadow-sm mb-2">
<div class="card-body py-2">
<table class="table table-sm mb-0 w-100">
<tbody>
<tr>
<th scope="row" class="fw-semibold text-nowrap pe-2 w-auto">Response:</th>
<td class="w-100" id="lbl_priority"></td>
</tr>
<tr>
<th scope="row" class="fw-semibold text-nowrap pe-2 w-auto">Status:</th>
<td class="w-100" id="lbl_status"></td>
</tr>
<tr>
<th scope="row" class="fw-semibold text-nowrap pe-2 w-auto">Dispatch Code:</th>
<td class="w-100" id="lbl_dispatch_code"></td>
</tr>
<tr>
<th scope="row" class="fw-semibold text-nowrap pe-2 w-auto">Dispatch District:</th>
<td class="w-100" id="lbl_dispatch_district"></td>
</tr>
<tr>
<th scope="row" class="fw-semibold text-nowrap pe-2 w-auto">Address:</th>
<td class="w-100" id="lbl_address"></td>
</tr>
<tr id="row_business" class="d-none">
<th scope="row" class="fw-semibold text-nowrap pe-2 w-auto">Business:</th>
<td class="w-100" id="lbl_business"></td>
</tr>
<tr>
<th scope="row" class="fw-semibold text-nowrap pe-2 w-auto">Date Reported:</th>
<td class="w-100" id="lbl_date_reported"></td>
</tr>
<tr>
<th scope="row" class="fw-semibold text-nowrap pe-2 w-auto">Date Received:</th>
<td class="w-100" id="lbl_date_received"></td>
</tr>
<tr>
<th scope="row" class="fw-semibold text-nowrap pe-2 w-auto">Date Dispatched:</th>
<td class="w-100" id="lbl_date_dispatched"></td>
</tr>
<tr>
<th scope="row" class="fw-semibold text-nowrap pe-2 w-auto">Date Responded:</th>
<td class="w-100" id="lbl_date_responded"></td>
</tr>
<tr>
<th scope="row" class="fw-semibold text-nowrap pe-2 w-auto">Date Arrived:</th>
<td class="w-100" id="lbl_date_arrived"></td>
</tr>
<tr>
<th scope="row" class="fw-semibold text-nowrap pe-2 w-auto">Date Cleared:</th>
<td class="w-100" id="lbl_date_cleared"></td>
</tr>
</tbody>
</table>
</div>
</div>
<!-- Buttons -->
<div class="pb-2">
<div class="d-flex flex-wrap gap-2 justify-content-center">
<button type="button" class="btn btn-success btn-sm px-3 active" id="btn_remarks" aria-pressed="true">Remarks</button>
<button type="button" class="btn btn-success btn-sm px-3" id="btn_history">History</button>
<button type="button" class="btn btn-success btn-sm px-3" id="btn_warnings">Warnings</button>
<button type="button" class="btn btn-success btn-sm px-3" id="btn_contacts">Contacts</button>
</div>
<!-- Remarks toggle filters (only visible on Remarks tab) -->
<div class="d-flex flex-wrap gap-2 justify-content-center mt-2" id="row_remarks_toggles">
<button type="button" class="btn btn-success btn-sm px-3 active" id="btn_cmp" aria-pressed="true">CMP</button>
<button type="button" class="btn btn-success btn-sm px-3 active" id="btn_e911" aria-pressed="true">E-911</button>
<button type="button" class="btn btn-success btn-sm px-3 active" id="btn_rem" aria-pressed="true">REM</button>
<button type="button" class="btn btn-success btn-sm px-3 active" id="btn_unt" aria-pressed="true">UNT</button>
</div>
<!-- History action row (only visible on History tab) -->
<div class="d-flex flex-wrap gap-2 justify-content-center mt-2 tab-hidden" id="row_history_actions">
<button type="button" class="btn btn-secondary btn-sm px-3 disabled" id="btn_archive" disabled>Archive</button>
</div>
</div>
</div>
<!-- Tables (scroll with page) -->
<div class="card border-0 shadow-sm">
<div class="card-body p-0">
<div id="tbl_remarks"></div>
<div id="tbl_history" class="tab-hidden"></div>
<div id="tbl_warnings" class="d-none d-md-block"></div>
<div id="lst_warnings" class="d-block d-md-none"></div>
<div id="tbl_contacts" class="tab-hidden"></div>
</div>
</div>
</div>
<button id="btn_complaint_view_on_map"
type="button"
class="btn btn-primary btn-sm shadow position-fixed"
style="right: 15px; bottom: 25px; z-index: 1040;">
Map
</button>
</div>
object FViewComplaints: TFViewComplaints
Width = 359
Height = 480
CSSLibrary = cssBootstrap
ElementFont = efCSS
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
Visible = True
OnCreate = WebFormCreate
OnDestroy = WebFormDestroy
object lblEntries: TWebLabel
Left = 44
Top = 88
Width = 43
Height = 13
Caption = 'lblEntries'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
Visible = False
WidthPercent = 100.000000000000000000
end
object dblComplaintsList: TWebDBListControl
Left = 36
Top = 148
Width = 263
Height = 237
ElementID = 'complaints_dbl_complaint_list'
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
ChildOrder = 3
DefaultItemClassName = 'list-group-item p-1 border-0'
DefaultItemLinkClassName = 'list-group-link'
ElementFont = efCSS
ElementListClassName = 'list-group list-group-flush border-0'
Items = <>
Style = lsListGroup
DataSource = wdsComplaints
ItemTemplate =
'<div class="list-section-header small fw-semibold bg-secondary t' +
'ext-white rounded-1 px-2 mb-1">District: (%DispatchDistrict%)</d' +
'iv><div class="card border shadow-sm"><div class="card-body py-2' +
' px-3 d-flex gap-2"><div class="flex-grow-1"><div class="fw-bold' +
' text-uppercase small">Incident: (%Complaint%)</div><div class="' +
'small">Response: (%Priority%) &middot; (%DispatchCodeDesc%)</div' +
'><div class="small">(%Address%)</div><div class="small d-none co' +
'mplaint-business" data-business="(%Business%)">(%Business%)</div' +
'><div class="small text-opacity-75">Status: (%Status%)</div><div' +
' class="small text-opacity-75">Reported: (%DateReported%)</div><' +
'/div><div class="d-flex flex-column justify-content-center gap-1' +
'"><button type="button" class="btn btn-primary btn-sm complaint-' +
'details-btn" data-id="(%ComplaintId%)">Details</button><button t' +
'ype="button" class="btn btn-primary btn-sm btn-complaint-map" da' +
'ta-id="(%ComplaintId%)">Map</button></div></div></div>'
ListSource = wdsComplaints
end
object xdwcComplaints: TXDataWebClient
Connection = DMConnection.ApiConnection
Left = 58
Top = 410
end
object xdwdsComplaints: TXDataWebDataSet
Connection = DMConnection.ApiConnection
Left = 260
Top = 412
object xdwdsComplaintsComplaintId: TStringField
FieldName = 'ComplaintId'
end
object xdwdsComplaintsComplaint: TStringField
FieldName = 'Complaint'
Size = 40
end
object xdwdsComplaintsAgency: TStringField
FieldName = 'Agency'
end
object xdwdsComplaintsPriority: TStringField
FieldName = 'Priority'
Size = 80
end
object xdwdsComplaintsDispatchCodeDesc: TStringField
FieldName = 'DispatchCodeDesc'
Size = 160
end
object xdwdsComplaintsAddress: TStringField
FieldName = 'Address'
Size = 160
end
object xdwdsComplaintsBusiness: TStringField
FieldName = 'Business'
Size = 160
end
object xdwdsComplaintsStatus: TStringField
FieldName = 'Status'
Size = 160
end
object xdwdsComplaintsDispatchDistrict: TStringField
FieldName = 'DispatchDistrict'
Size = 40
end
object xdwdsComplaintsDateReported: TStringField
FieldName = 'DateReported'
Size = 40
end
object xdwdsComplaintsStatusColor: TStringField
FieldName = 'StatusColor'
end
object xdwdsComplaintsPriorityColor: TStringField
FieldName = 'PriorityColor'
end
object xdwdsComplaintsPriorityTextColor: TStringField
FieldName = 'PriorityTextColor'
end
object xdwdsComplaintsStatusTextColor: TStringField
FieldName = 'StatusTextColor'
Size = 80
end
end
object wdsComplaints: TWebDataSource
AutoEdit = False
DataSet = xdwdsComplaints
Left = 156
Top = 410
end
end
unit View.Complaints;
interface
uses
System.SysUtils, System.Classes, Web, WEBLib.Graphics, WEBLib.Forms, WEBLib.Dialogs,
Vcl.Controls, Vcl.StdCtrls, WEBLib.StdCtrls, WEBLib.Controls, WEBLib.Grids, WebLib.Lists,
XData.Web.Client, WEBLib.ExtCtrls, XData.Web.JsonDataset,
XData.Web.Dataset, XData.Web.Connection, Vcl.Forms, DateUtils, WEBLib.DBCtrls, System.Generics.Collections,
WEBLib.Menus, WEBLib.JSON, Auth.Service, WebLib.Storage, ConnectionModule, App.Types,
WEBLib.DB, Data.DB, XData.Web.DatasetCommon, JS, XData.Model.Classes, Utils;
type
TFViewComplaints = class(TWebForm)
xdwcComplaints: TXDataWebClient;
xdwdsComplaints: TXDataWebDataSet;
dblComplaintsList: TWebDBListControl;
xdwdsComplaintsComplaint: TStringField;
xdwdsComplaintsAgency: TStringField;
xdwdsComplaintsPriority: TStringField;
xdwdsComplaintsDispatchCodeDesc: TStringField;
xdwdsComplaintsAddress: TStringField;
xdwdsComplaintsStatus: TStringField;
xdwdsComplaintsDispatchDistrict: TStringField;
xdwdsComplaintsDateReported: TStringField;
lblEntries: TWebLabel;
wdsComplaints: TWebDataSource;
xdwdsComplaintsComplaintId: TStringField;
xdwdsComplaintsStatusColor: TStringField;
xdwdsComplaintsPriorityColor: TStringField;
xdwdsComplaintsPriorityTextColor: TStringField;
xdwdsComplaintsBusiness: TStringField;
xdwdsComplaintsStatusTextColor: TStringField;
procedure WebFormCreate(Sender: TObject);
procedure WebFormDestroy(Sender: TObject);
private
FSelectProc: TSelectProc;
FLoading: Boolean;
FFirstLoad: Boolean;
[async] procedure GetComplaints;
procedure HandleListClick(e: TJSMouseEvent);
procedure ShowHideBusinessRows;
public
property OnShowDetails: TSelectProc read FSelectProc write FSelectProc;
procedure RefreshData;
procedure ApplyWsData(aRespObj: TJSObject);
end;
var
FViewComplaints: TFViewComplaints;
implementation
{$R *.dfm}
procedure TFViewComplaints.WebFormCreate(Sender: TObject);
begin
Document.addEventListener('click', @HandleListClick);
FFirstLoad := True;
GetComplaints;
asm
if (!window.showComplaintDetails) {
window.showComplaintDetails = function (id) {
pas['View.Main'].FViewMain.ShowComplaintDetails(id);
};
}
end;
end;
procedure TFViewComplaints.ShowHideBusinessRows;
var
nodes: TJSNodeList;
i: Integer;
el: TJSHTMLElement;
businessText: string;
begin
nodes := document.querySelectorAll('.complaint-business');
for i := 0 to nodes.length - 1 do
begin
el := TJSHTMLElement(nodes.item(i));
businessText := string(el.getAttribute('data-business'));
if Trim(businessText) <> '' then
el.classList.remove('d-none')
else
el.classList.add('d-none');
end;
end;
procedure TFViewComplaints.HandleListClick(e: TJSMouseEvent);
var
el: TJSElement;
btn: TJSElement;
complaintId: string;
begin
btn := nil;
el := TJSElement(e.target);
asm
btn = (el && el.closest) ? el.closest('.complaint-details-btn') : null;
end;
if (btn <> nil) and (btn is TJSHtmlElement) then
begin
complaintId := string(TJSHtmlElement(btn).getAttribute('data-id'));
e.preventDefault;
e.stopPropagation;
asm
if (window.showComplaintDetails) window.showComplaintDetails(complaintId);
end;
end
else
begin
btn := nil;
asm
btn = (el && el.closest) ? el.closest('.btn-complaint-map') : null;
end;
if (btn <> nil) and (btn is TJSHtmlElement) then
begin
complaintId := string(TJSHtmlElement(btn).getAttribute('data-id'));
e.preventDefault;
e.stopPropagation;
asm
pas['View.Main'].FViewMain.ShowMapFocusComplaint(complaintId);
end;
end;
end;
end;
procedure TFViewComplaints.WebFormDestroy(Sender: TObject);
begin
Document.removeEventListener('click', @HandleListClick);
end;
//Note: HTML for individual complaint cards can be found in the twebdblistcontrol HTMLString property
[async] procedure TFViewComplaints.GetComplaints;
var
xdcResponse: TXDataClientResponse;
respObj: TJSObject;
complaintsCount: Integer;
begin
if FLoading then
Exit;
FLoading := True;
if FFirstLoad then
ShowSpinner('spinner');
try
try
xdcResponse := await(xdwcComplaints.RawInvokeAsync('IApiService.GetComplaintList', []));
respObj := TJSObject(xdcResponse.Result);
xdwdsComplaints.Close;
xdwdsComplaints.SetJsonData(respObj['data']);
xdwdsComplaints.Open;
ShowHideBusinessRows;
complaintsCount := Integer(respObj['count']);
lblEntries.Caption := Format('%d active incidents', [complaintsCount]);
except
on E: EXDataClientRequestException do
Utils.ShowErrorModal(E.ErrorResult.ErrorMessage);
on E: Exception do
Utils.ShowErrorModal(E.Message);
end;
finally
FLoading := False;
if FFirstLoad then
begin
HideSpinner('spinner');
FFirstLoad := False;
end;
end;
end;
procedure TFViewComplaints.RefreshData;
begin
Console.Log('Complaints.RefreshData');
GetComplaints;
end;
procedure TFViewComplaints.ApplyWsData(aRespObj: TJSObject);
var
complaintsCount: Integer;
begin
if FLoading then
Exit;
xdwdsComplaints.Close;
xdwdsComplaints.SetJsonData(aRespObj['data']);
xdwdsComplaints.Open;
ShowHideBusinessRows;
complaintsCount := Integer(aRespObj['count']);
lblEntries.Caption := Format('%d active incidents', [complaintsCount]);
end;
end.
<div class="container">
<br />
<div class="panel panel-red">
<div id="view.errorpage.title" class="panel-heading">
Error Page
</div>
<div id="view.errorpage.message" class="panel-body">
Message
</div>
<div class="panel-footer">
<a href=".">Reload web application</a>
</div>
</div>
</div>
object FViewLogin: TFViewLogin
Width = 640
Height = 480
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
OnCreate = WebFormCreate
object WebLabel1: TWebLabel
Left = 240
Top = 112
Width = 67
Height = 13
Caption = 'Please Sign In'
ElementID = 'view.login.title'
HeightPercent = 100.000000000000000000
Transparent = False
WidthPercent = 100.000000000000000000
end
object edtUsername: TWebEdit
Left = 240
Top = 136
Width = 121
Height = 21
ElementID = 'view.login.edtusername'
HeightPercent = 100.000000000000000000
TextHint = 'Username'
WidthPercent = 100.000000000000000000
end
object edtPassword: TWebEdit
Left = 240
Top = 163
Width = 121
Height = 21
ElementID = 'view.login.edtpassword'
HeightPercent = 100.000000000000000000
PasswordChar = '*'
TabOrder = 1
TextHint = 'Password'
WidthPercent = 100.000000000000000000
end
object btnLogin: TWebButton
Left = 240
Top = 217
Width = 121
Height = 25
Caption = 'Login'
ElementID = 'view.login.btnlogin'
HeightPercent = 100.000000000000000000
TabOrder = 2
WidthPercent = 100.000000000000000000
OnClick = btnLoginClick
end
object pnlMessage: TWebPanel
Left = 240
Top = 65
Width = 121
Height = 33
ElementID = 'view.login.message'
TabOrder = 3
object lblMessage: TWebLabel
Left = 16
Top = 11
Width = 42
Height = 13
Caption = 'Message'
ElementID = 'view.login.message.label'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
object btnCloseNotification: TWebButton
Left = 96
Top = 3
Width = 22
Height = 25
ElementID = 'view.login.message.button'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
OnClick = btnCloseNotificationClick
end
end
object lucbAgency: TWebLookupComboBox
Left = 240
Top = 190
Width = 121
Height = 21
ElementID = 'view.login.edtagency'
HeightPercent = 100.000000000000000000
TextHint = 'Agency'
WidthPercent = 100.000000000000000000
ItemIndex = -1
LookupValues = <
item
Value = 'BUF'
DisplayText = 'BUF - Buffalo Police Department'
end>
end
object XDataWebClient: TXDataWebClient
Connection = DMConnection.AuthConnection
Left = 492
Top = 102
end
end
<div class="container">
<nav class="navbar navbar-light bg-light border rounded-bottom"
style="--bs-border-color: #d6d6d6; --bs-border-radius: 0.25rem;">
<div class="container-fluid">
<a id="view.login.apptitle"
class="navbar-brand text-secondary small"
href="index.html">
emiMobile
</a>
</div>
</nav>
<div class="row justify-content-center mt-4">
<div class="col-12 col-sm-10 col-md-8 col-lg-5 col-xl-4">
<div class="card shadow-sm">
<div class="card-header">
<h5 id="view.login.title" class="card-title mb-0 text-center">
Please Sign In
</h5>
</div>
<div class="card-body">
<div id="view.login.message"
class="alert alert-danger d-flex align-items-start d-none"
role="alert">
<span id="view.login.message.label" class="me-auto"></span>
<button id="view.login.message.button"
type="button"
class="btn-close ms-2"
aria-label="Close"></button>
</div>
<div class="mb-3">
<input id="view.login.edtusername"
class="form-control"
type="text"
placeholder="Username"
autofocus>
</div>
<div class="mb-3">
<input id="view.login.edtpassword"
class="form-control"
type="password"
placeholder="Password">
</div>
<div class="mb-3">
<select id="view.login.edtagency" class="form-select">
<!-- populated dynamically -->
</select>
</div>
<button id="view.login.btnlogin"
class="btn btn-primary w-100">
Login
</button>
</div>
<div class="card-footer text-muted small">
Please use your lems username &amp; password to login.
</div>
</div>
</div>
</div>
</div>
unit View.Login;
interface
uses
System.SysUtils, System.Classes, WEBLib.Graphics, WEBLib.Controls, WEBLib.Forms, WEBLib.Dialogs,
Vcl.Controls, Vcl.StdCtrls, WEBLib.StdCtrls, WEBLib.JSON,
JS, XData.Web.Connection, WEBLib.ExtCtrls,
App.Types, ConnectionModule, XData.Web.Client;
type
TFViewLogin = class(TWebForm)
WebLabel1: TWebLabel;
edtUsername: TWebEdit;
edtPassword: TWebEdit;
btnLogin: TWebButton;
pnlMessage: TWebPanel;
lblMessage: TWebLabel;
btnCloseNotification: TWebButton;
XDataWebClient: TXDataWebClient;
lucbAgency: TWebLookupComboBox;
procedure btnLoginClick(Sender: TObject);
procedure btnCloseNotificationClick(Sender: TObject);
procedure WebFormCreate(Sender: TObject);
private
FLoginProc: TSuccessProc;
FMessage: string;
procedure ShowNotification(Notification: string);
procedure HideNotification;
procedure GetAgencyConfigList;
public
class procedure Display(LoginProc: TSuccessProc); overload;
class procedure Display(LoginProc: TSuccessProc; AMsg: string); overload;
end;
var
FViewLogin: TFViewLogin;
implementation
uses
Auth.Service,
View.ErrorPage;
{$R *.dfm}
class procedure TFViewLogin.Display(LoginProc: TSuccessProc);
begin
TFViewLogin.Display(LoginProc, '');
end;
class procedure TFViewLogin.Display(LoginProc: TSuccessProc; AMsg: string);
procedure FormCreate(AForm: TObject);
begin
TFViewLogin(AForm).FMessage := AMsg;
end;
begin
if Assigned(FViewLogin) then
FViewLogin.Free;
FViewLogin := TFViewLogin.CreateNew(@FormCreate);
FViewLogin.FLoginProc := LoginProc;
end;
procedure TFViewLogin.WebFormCreate(Sender: TObject);
begin
// lblAppTitle.Caption := 'EM Systems - webCharms App ver 0.9.2.22';
GetAgencyConfigList();
if FMessage <> '' then
ShowNotification(FMessage)
else
HideNotification;
end;
procedure TFViewLogin.btnLoginClick(Sender: TObject);
procedure LoginSuccess;
begin
FLoginProc;
end;
procedure LoginError(AMsg: string);
begin
ShowNotification('Login Error: ' + AMsg);
end;
begin
AuthService.Login(
edtUsername.Text, edtPassword.Text, lucbAgency.Value,
@LoginSuccess,
@LoginError
);
end;
procedure TFViewLogin.GetAgencyConfigList;
procedure OnLoad(Response: TXDataClientResponse);
var
jsResponse: TJSObject;
count: Integer;
returned: Integer;
jsArray: TJSArray;
jsObject: TJSObject;
agency: string;
name: string;
i: Integer;
begin
jsResponse := TJSObject(Response.Result);
count := Integer(jsResponse['count']);
returned := Integer(jsResponse['returned']);
jsArray := TJSArray(TJSObject(Response.Result)['data']);
lucbAgency.LookupValues.Clear;
for i := 0 to jsArray.Length - 1 do
begin
jsObject := TJSObject( jsArray[i] );
agency := string( jsObject['agency'] );
name := string( jsObject['name'] );
lucbAgency.LookupValues.AddPair( agency, agency + ' - ' + name );
end;
end;
procedure OnError(Error: TXDataClientError);
begin
ShowNotification('GetAgencyConfigList: ' + Format('%s: %s', [Error.ErrorCode, Error.ErrorMessage]));
end;
begin
XDataWebClient.RawInvoke(
'IAuthService.GetAgencyConfigList', [],
@OnLoad, @OnError
);
end;
procedure TFViewLogin.ShowNotification(Notification: string);
begin
if Notification <> '' then
begin
lblMessage.Caption := Notification;
pnlMessage.ElementHandle.hidden := False;
end;
end;
procedure TFViewLogin.HideNotification;
begin
pnlMessage.ElementHandle.hidden := True;
end;
procedure TFViewLogin.btnCloseNotificationClick(Sender: TObject);
begin
HideNotification;
end;
end.
object FViewMain: TFViewMain
Width = 1208
Height = 810
CSSLibrary = cssBootstrap
ElementFont = efCSS
OnCreate = WebFormCreate
object lblUsername: TWebLabel
Left = 529
Top = 4
Width = 66
Height = 15
Caption = 'lblUsername'
ElementID = 'view.main.username'
HeightPercent = 100.000000000000000000
Transparent = False
Visible = False
WidthPercent = 100.000000000000000000
end
object lblAppTitle: TWebLabel
Left = 57
Top = 31
Width = 57
Height = 15
Caption = 'emiMobile'
ElementID = 'view.main.apptitle'
HeightPercent = 100.000000000000000000
Transparent = False
WidthPercent = 100.000000000000000000
end
object lblCallsList: TWebLinkLabel
Left = 564
Top = 58
Width = 25
Height = 15
ElementID = 'dropdown.menu.callslist'
ElementFont = efCSS
Visible = False
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
Caption = 'Calls'
end
object lblUsers: TWebLinkLabel
Left = 561
Top = 70
Width = 28
Height = 15
ElementID = 'dropdown.menu.users'
ElementFont = efCSS
Visible = False
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
Caption = 'Users'
end
object lblMainTitle: TWebLabel
Left = 131
Top = 31
Width = 3
Height = 15
ElementID = 'lbl_main_title'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
object pnlMain: TWebPanel
Left = 136
Top = 110
Width = 471
Height = 369
ElementID = 'pnl_main'
ChildOrder = 3
TabOrder = 0
end
object WebMessageDlg1: TWebMessageDlg
Left = 47
Top = 232
Width = 24
Height = 24
Buttons = []
CustomButtons = <>
Opacity = 0.200000000000000000
end
object WebMemo1: TWebMemo
Left = 136
Top = 469
Width = 471
Height = 83
ElementID = 'main.debugmemo'
HeightPercent = 100.000000000000000000
Lines.Strings = (
'WebMemo1')
SelLength = 0
SelStart = 0
Visible = False
WidthPercent = 100.000000000000000000
end
object btnMap: TWebButton
Left = 212
Top = 580
Width = 59
Height = 25
Caption = 'Map'
ChildOrder = 9
ElementID = 'view.main.btnmap'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
OnClick = btnMapClick
end
object btnComplaints: TWebButton
Left = 285
Top = 580
Width = 68
Height = 25
Caption = 'Incidents'
ChildOrder = 9
ElementID = 'view.main.btncomplaints'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
OnClick = btnComplaintsClick
end
object btnUnits: TWebButton
Left = 364
Top = 580
Width = 59
Height = 25
Caption = 'Units'
ChildOrder = 9
ElementID = 'view.main.btnunits'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
OnClick = btnUnitsClick
end
object pnlMap: TWebPanel
Left = 708
Top = 99
Width = 237
Height = 436
ElementID = 'pnl_map'
ChildOrder = 3
TabOrder = 6
end
object pnlUnits: TWebPanel
Left = 740
Top = 182
Width = 227
Height = 139
ElementID = 'pnl_units'
ChildOrder = 3
TabOrder = 7
end
object pnlComplaints: TWebPanel
Left = 740
Top = 346
Width = 227
Height = 145
ElementID = 'pnl_complaints'
ChildOrder = 3
TabOrder = 8
end
object pnlDetails: TWebPanel
Left = 992
Top = 275
Width = 163
Height = 114
ElementID = 'pnl_details'
ChildOrder = 15
ElementFont = efCSS
TabOrder = 9
object btnDetailsModalClose: TWebButton
Left = 127
Top = 8
Width = 28
Height = 23
ElementID = 'btn_details_modal_close'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
OnClick = btnDetailsModalCloseClick
end
end
object pnlArchive: TWebPanel
Left = 992
Top = 395
Width = 163
Height = 114
ElementID = 'pnl_archive'
ChildOrder = 15
ElementFont = efCSS
TabOrder = 10
object btnArchiveModalClose: TWebButton
Left = 127
Top = 8
Width = 28
Height = 23
ElementID = 'btn_archive_modal_close'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
OnClick = btnArchiveModalCloseClick
end
end
object btnLogout: TWebButton
Left = 438
Top = 66
Width = 96
Height = 25
Caption = 'Logout'
ChildOrder = 16
ElementID = 'btn_logout'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
OnClick = btnLogoutClick
end
object xdwcBadgeCounts: TXDataWebClient
Connection = DMConnection.ApiConnection
Left = 44
Top = 280
end
object tmrBadgeCounts: TWebTimer
Interval = 30000
OnTimer = tmrBadgeCountsTimer
Left = 42
Top = 360
end
object tmrGlobalRefresh: TWebTimer
Interval = 30000
OnTimer = tmrGlobalRefreshTimer
Left = 42
Top = 434
end
end
<div class="d-flex flex-column vh-100">
<!-- Top Nav -->
<nav class="navbar navbar-light bg-primary border-light text-light py-2 flex-shrink-0">
<div class="container-fluid">
<!-- App title + current view title -->
<div class="d-flex align-items-center ms-3">
<a id="view.main.apptitle" class="navbar-brand fw-bold text-light mb-0 me-1" href="index.html">emiMobile</a>
<span class="navbar-brand text-light mb-0 mx-0">-</span>
<span id="lbl_main_title" class="navbar-brand text-light mb-0 ms-1"></span>
</div>
<!-- Right: Connection / Logout -->
<div class="d-flex align-items-center gap-2 ms-auto">
<span id="view.main.lblconnection" class="navbar-text text-light small"></span>
<button id="btn_logout" type="button" class="btn btn-outline-light btn-sm">Logout</button>
</div>
</div>
</nav>
<!-- Main content: fills space between navbars -->
<div id="pnl_main" class="flex-grow-1 position-relative p-0 overflow-hidden d-none" style="min-height:0;"></div>
<div id="pnl_map" class="flex-grow-1 position-relative p-0 overflow-hidden" style="min-height:0;"></div>
<div id="pnl_units" class="flex-grow-1 position-relative p-0 overflow-hidden d-none" style="min-height:0;"></div>
<div id="pnl_complaints" class="flex-grow-1 position-relative p-0 overflow-hidden d-none" style="min-height:0;"></div>
<!-- Details modal (new panel pnl_details) -->
<div id="pnl_details"
class="position-fixed top-0 start-0 w-100 h-100 d-none d-flex justify-content-center align-items-center"
style="background: rgba(0,0,0,0.5); z-index:1060;">
<div class="card shadow-lg w-100 mx-2 d-flex flex-column" style="max-width: 98vw; height: 96%;">
<div class="card-header d-flex align-items-center justify-content-between">
<h5 class="card-title mb-0" id="lbl_details_title">Details</h5>
<button id="btn_details_modal_close" type="button" class="btn-close" aria-label="Close"></button>
</div>
<div class="card-body p-0 flex-grow-1 overflow-hidden" style="min-height:0;">
<div id="pnl_details_host" class="h-100"></div>
</div>
</div>
</div>
<!-- Archive details modal -->
<div id="pnl_archive"
class="position-fixed top-0 start-0 w-100 h-100 d-none d-flex justify-content-center align-items-center"
style="background: rgba(0,0,0,0.35); z-index:1070;">
<div class="card shadow-lg w-100 mx-2 d-flex flex-column" style="max-width: 96vw; height: 92%;">
<div class="card-header d-flex align-items-center justify-content-between">
<h5 class="card-title mb-0" id="lbl_archive_title">Archived Incident Details</h5>
<button id="btn_archive_modal_close" type="button" class="btn-close" aria-label="Close"></button>
</div>
<div class="card-body p-0 flex-grow-1 overflow-hidden" style="min-height:0;">
<div id="pnl_archive_host" class="h-100"></div>
</div>
</div>
</div>
<!-- Bottom Nav -->
<nav id="bottom_nav" class="navbar navbar-dark bg-primary py-2 flex-shrink-0">
<div class="container-fluid">
<div class="d-flex justify-content-center gap-3 w-100">
<button id="view.main.btnmap" type="button" class="btn btn-primary">
<i class="far fa-map me-1"></i>Map
</button>
<button id="view.main.btncomplaints" type="button" class="btn btn-primary position-relative">
<i class="fa fa-exclamation-circle me-1"></i>Incidents
<span id="view.main.badgecomplaints"
class="position-absolute top-0 start-100 translate-middle mt-1 badge rounded-pill bg-danger">0</span>
</button>
<button id="view.main.btnunits" type="button" class="btn btn-primary position-relative">
<i class="fa fa-users me-1"></i>Units
<span id="view.main.badgeunits"
class="position-absolute top-0 start-100 translate-middle mt-1 badge rounded-pill bg-danger">0</span>
</button>
</div>
</div>
</nav>
</div>
<!-- Spinner -->
<div id="spinner" class="position-absolute top-50 start-50 translate-middle d-none">
<div class="lds-roller">
<div></div><div></div><div></div><div></div>
<div></div><div></div><div></div><div></div>
</div>
</div>
<!-- Error modal -->
<div class="modal fade" id="main_errormodal" tabindex="-1" aria-labelledby="main_lblmodal" aria-hidden="true">
<div class="modal-dialog">
<div class="modal-content shadow-lg">
<div class="modal-header">
<h5 class="modal-title" id="main_lblmodal">Error</h5>
<button type="button" class="btn-close" data-bs-dismiss="modal" aria-label="Close"></button>
</div>
<div class="modal-body fs-6 fw-bold" id="main_lblmodal_body">
Please contact EMSystems to solve the issue.
</div>
<div class="modal-footer justify-content-center">
<button type="button" id="btn_modal_restart" class="btn btn-primary">Restart Application</button>
</div>
</div>
</div>
</div>
<!-- Confirmation modal -->
<div class="modal fade" id="main_confirmation_modal" tabindex="-1" aria-hidden="true">
<div class="modal-dialog">
<div class="modal-content shadow-lg">
<div class="modal-header">
<h5 class="modal-title">Confirm</h5>
<button type="button" class="btn-close" data-bs-dismiss="modal" aria-label="Close"></button>
</div>
<div class="modal-body fw-bold" id="main_modal_body">Placeholder text</div>
<div class="modal-footer justify-content-center">
<button type="button" class="btn btn-primary me-3" id="btn_confirm_left">Cancel</button>
<button type="button" class="btn btn-secondary" id="btn_confirm_right">Confirm</button>
</div>
</div>
</div>
</div>
object FViewMap: TFViewMap
Width = 475
Height = 802
ElementFont = efCSS
object pnlMap: TWebPanel
Left = 62
Top = 120
Width = 335
Height = 555
ElementID = 'map_pnlmap'
ChildOrder = 7
ElementPosition = epIgnore
TabOrder = 0
object lfMap: TTMSFNCLeaflet
Left = 0
Top = 0
Width = 335
Height = 555
AdaptToStyle = True
Align = alClient
ParentDoubleBuffered = False
DoubleBuffered = True
TabStop = False
TabOrder = 0
OnCustomizeCSS = lfMapCustomizeCSS
OnCustomizeMarker = lfMapCustomizeMarker
OnMapInitialized = lfMapMapInitialized
Polylines = <>
Polygons = <>
Circles = <>
Rectangles = <>
Markers = <>
Options.DefaultLatitude = 42.880230000000000000
Options.DefaultLongitude = -78.878738000000000000
Options.DefaultZoomLevel = 12.000000000000000000
Options.AttributionPrefix = '<a href='#39'https://www.leafletjs.com'#39' target='#39'_blank'#39'>Leaflet</a>'
Options.AttributionText =
'&copy; <a href='#39'https://www.openstreetmap.org/copyright'#39' target=' +
#39'_blank'#39'>OpenStreetMap</a>'
HeatMaps = <>
LocalFileAccess = True
TileLayers = <
item
URL = 'https://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png'
Opacity = 1.000000000000000000
end>
ElementContainers = <>
HeadLinks = <>
end
end
object btnFindLocation: TWebButton
Left = 90
Top = 74
Width = 61
Height = 25
Caption = 'Location'
ChildOrder = 1
ElementID = 'btn_find_location'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
OnClick = btnFindLocationClick
end
object xdwcMap: TXDataWebClient
Connection = DMConnection.ApiConnection
Left = 232
Top = 696
end
object tmrLocate: TWebTimer
Enabled = False
Interval = 100
OnTimer = tmrLocateTimer
Left = 222
Top = 52
end
object httpReqGeoJson: TWebHttpRequest
OnResponse = httpReqGeoJsonResponse
Left = 138
Top = 694
end
end
<div id="map.root" class="d-flex flex-column h-100 w-100">
<!-- New: offcavnvas is a bootstrap class that adds an easy slide in modal -->
<div class="offcanvas offcanvas-end"
tabindex="-1"
id="map_filters_offcanvas"
aria-labelledby="map_filters_offcanvas_label"
style="--bs-offcanvas-width: 280px;">
<div class="offcanvas-header">
<h5 class="offcanvas-title" id="map_filters_offcanvas_label">Map Filters</h5>
<button type="button" class="btn-close" data-bs-dismiss="offcanvas" aria-label="Close"></button>
</div>
<div class="offcanvas-body">
<div class="mb-3">
<div class="form-check">
<input class="form-check-input" type="checkbox" id="map_filter_units" checked>
<label class="form-check-label" for="map_filter_units">Show Units</label>
</div>
<div class="form-check">
<input class="form-check-input" type="checkbox" id="map_filter_complaints" checked>
<label class="form-check-label" for="map_filter_complaints">Show Incidents</label>
</div>
<div class="form-check">
<input class="form-check-input" type="checkbox" id="map_filter_location">
<label class="form-check-label" for="map_filter_location">Show My Location</label>
</div>
</div>
<div class="d-grid gap-2 mt-4">
<button type="button" class="btn btn-primary" id="map_filters_apply" data-bs-dismiss="offcanvas">
Apply
</button>
<button type="button" class="btn btn-outline-secondary" id="map_filters_reset">
Reset
</button>
</div>
<div class="mt-3 small text-muted">
<span class="fw-semibold">Active:</span>
<span id="map_filters_summary"></span>
</div>
</div>
</div>
<div class="flex-grow-1 position-relative" style="min-height:0;">
<div id="map_pnlmap" class="position-absolute w-100 h-100 top-0 start-0"></div>
<!-- Locate (bottom-right) -->
<button id="btn_find_location"
type="button"
class="btn btn-primary border shadow position-absolute bottom-0 end-0 me-2 mb-4"
style="z-index:1000;">
<i class="fa fa-crosshairs"></i>
</button>
<!-- Filters (top-right) -->
<button id="btn_map_filters"
type="button"
class="btn btn-primary position-absolute top-0 end-0 m-2 shadow"
style="z-index:1000;"
data-bs-toggle="offcanvas"
data-bs-target="#map_filters_offcanvas"
aria-controls="map_filters_offcanvas">
<i class="fa fa-sliders-h"></i>
<span class="d-none d-sm-inline">Filters</span>
</button>
</div>
</div>
object FViewUnitDetails: TFViewUnitDetails
Width = 640
Height = 480
CSSLibrary = cssBootstrap
ElementFont = efCSS
object tblLogs: TWebDBTableControl
Left = 166
Top = 116
Width = 300
Height = 200
ElementId = 'tbl_logs'
BorderColor = clSilver
ColHeader = False
ElementFont = efCSS
ElementHeaderClassName = 'table-light'
ElementTableClassName =
'table table-sm table-striped table-hover table-bordered mb-0 ali' +
'gn-middle'
Footer.ButtonActiveElementClassName = 'btn btn-primary'
Footer.ButtonElementClassName = 'btn btn-light'
Footer.DropDownElementClassName = 'form-control'
Footer.InputElementClassName = 'form-control'
Footer.LinkActiveElementClassName = 'link-primary'
Footer.LinkElementClassName = 'link-secondary'
Footer.ListElementClassName = 'pagination'
Footer.ListItemElementClassName = 'page-item'
Footer.ListLinkElementClassName = 'page-link'
Header.ButtonActiveElementClassName = 'btn btn-primary'
Header.ButtonElementClassName = 'btn btn-light'
Header.DropDownElementClassName = 'form-control'
Header.InputElementClassName = 'form-control'
Header.LinkActiveElementClassName = 'link-primary'
Header.LinkElementClassName = 'link-secondary'
Header.ListElementClassName = 'pagination'
Header.ListItemElementClassName = 'page-item'
Header.ListLinkElementClassName = 'page-link'
WordWrap = True
Columns = <
item
DataField = 'LogTime'
Title = 'Log Time'
TitleElementClassName = 'w-25'
end
item
ElementClassName = 'text-nowrap'
DataField = 'Complaint'
Title = 'Complaint'
end
item
DataField = 'Log'
Title = 'Log'
end>
DataSource = wdsUnitLogs
end
object btnUnitViewOnMap: TWebButton
Left = 370
Top = 326
Width = 96
Height = 25
Caption = 'Map'
ChildOrder = 1
ElementID = 'btn_unit_view_on_map'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
OnClick = btnUnitViewOnMapClick
end
object xdwcUnitDetails: TXDataWebClient
Connection = DMConnection.ApiConnection
Left = 150
Top = 394
end
object xdwdsUnitLogs: TXDataWebDataSet
Left = 278
Top = 394
object xdwdsUnitLogsLogTime: TStringField
FieldName = 'LogTime'
end
object xdwdsUnitLogsComplaint: TStringField
FieldName = 'Complaint'
end
object xdwdsUnitLogsLog: TStringField
FieldName = 'Log'
end
end
object wdsUnitLogs: TWebDataSource
DataSet = xdwdsUnitLogs
Left = 208
Top = 362
end
object xdwdsUnitDetails: TXDataWebDataSet
Left = 364
Top = 368
object xdwdsUnitDetailsUnitId: TStringField
FieldName = 'UnitId'
end
object xdwdsUnitDetailsUnitName: TStringField
FieldName = 'UnitName'
end
object xdwdsUnitDetailsUnitDesc: TStringField
FieldName = 'UnitDesc'
Size = 100
end
object xdwdsUnitDetailsMainStation: TStringField
FieldName = 'MainStation'
Size = 80
end
object xdwdsUnitDetailsCurrentStation: TStringField
FieldName = 'CurrentStation'
Size = 80
end
object xdwdsUnitDetailsMovingToStation: TStringField
FieldName = 'MovingToStation'
Size = 80
end
object xdwdsUnitDetailsStatus: TStringField
FieldName = 'Status'
Size = 160
end
object xdwdsUnitDetailsManpower: TStringField
FieldName = 'Manpower'
end
object xdwdsUnitDetailsUndermanned: TBooleanField
FieldName = 'Undermanned'
end
object xdwdsUnitDetailsUnavailableReason: TStringField
FieldName = 'UnavailableReason'
Size = 100
end
object xdwdsUnitDetailsComplaint: TStringField
FieldName = 'Complaint'
Size = 40
end
object xdwdsUnitDetailsCallType: TStringField
FieldName = 'CallType'
Size = 80
end
object xdwdsUnitDetailsLastStatusChange: TStringField
FieldName = 'LastStatusChange'
Size = 40
end
object xdwdsUnitDetailsUpdateTime: TStringField
FieldName = 'UpdateTime'
end
end
end
<div class="d-flex flex-column h-100 w-100 overflow-hidden">
<div class="flex-grow-1 d-flex flex-column overflow-auto bg-light p-2 p-md-3" style="min-height:0;">
<!-- Sticky block: Summary header + (expanded) summary body -->
<div class="sticky-top bg-light" style="z-index:20;">
<!-- Summary header -->
<div class="card border-0 shadow-sm mb-2">
<div class="card-header bg-white py-2">
<button
class="btn btn-link text-decoration-none p-0 w-100 d-flex align-items-center justify-content-between summary-toggle"
type="button"
data-bs-toggle="collapse"
data-bs-target="#udetails_summary"
aria-expanded="true"
aria-controls="udetails_summary">
<span class="fw-semibold text-dark" id="lbl_summary_title">Summary</span>
<span class="summary-chevron" aria-hidden="true">
<svg class="summary-chevron-icon" viewBox="0 0 16 16" focusable="false">
<path fill="currentColor" d="M7.646 5.354a.5.5 0 0 1 .708 0l5 5a.5.5 0 0 1-.708.708L8 6.414 3.354 11.06a.5.5 0 1 1-.708-.708l5-5z"/>
</svg>
</span>
</button>
</div>
</div>
<!-- Summary body -->
<div id="udetails_summary" class="collapse show">
<div class="card border-0 shadow-sm mb-2">
<div class="card-body py-2">
<table class="table table-sm mb-0 w-100">
<tbody>
<tr>
<th scope="row" class="fw-semibold text-nowrap pe-2 w-auto">Unit:</th>
<td class="w-100" id="lbl_unit"></td>
</tr>
<tr>
<th scope="row" class="fw-semibold text-nowrap pe-2 w-auto">Description:</th>
<td class="w-100" id="lbl_description"></td>
</tr>
<tr>
<th scope="row" class="fw-semibold text-nowrap pe-2 w-auto">Home Station:</th>
<td class="w-100" id="lbl_home_station"></td>
</tr>
<tr>
<th scope="row" class="fw-semibold text-nowrap pe-2 w-auto">Current Station:</th>
<td class="w-100" id="lbl_current_station"></td>
</tr>
<tr id="row_moving_to">
<th scope="row" class="fw-semibold text-nowrap pe-2 w-auto">Moving To:</th>
<td class="w-100" id="lbl_moving_to"></td>
</tr>
<tr>
<th scope="row" class="fw-semibold text-nowrap pe-2 w-auto">Status:</th>
<td class="w-100" id="lbl_status"></td>
</tr>
<tr>
<th scope="row" class="fw-semibold text-nowrap pe-2 w-auto">Manpower:</th>
<td class="w-100" id="lbl_manpower"></td>
</tr>
<tr>
<th scope="row" class="fw-semibold text-nowrap pe-2 w-auto">Undermanned:</th>
<td class="w-100" id="lbl_undermanned"></td>
</tr>
<tr id="row_unavailable_reason">
<th scope="row" class="fw-semibold text-nowrap pe-2 w-auto">Unavailable Reason:</th>
<td class="w-100 text-danger" id="lbl_unavailable_reason"></td>
</tr>
<tr id="row_complaint">
<th scope="row" class="fw-semibold text-nowrap pe-2 w-auto">Current Complaint:</th>
<td class="w-100" id="lbl_complaint"></td>
</tr>
<tr id="row_call_type">
<th scope="row" class="fw-semibold text-nowrap pe-2 w-auto">Call Type:</th>
<td class="w-100" id="lbl_call_type"></td>
</tr>
<tr id="row_last_status_change">
<th scope="row" class="fw-semibold text-nowrap pe-2 w-auto">Last Status Change:</th>
<td class="w-100" id="lbl_last_status_change"></td>
</tr>
<tr>
<th scope="row" class="fw-semibold text-nowrap pe-2 w-auto">Updated:</th>
<td class="w-100" id="lbl_updated"></td>
</tr>
</tbody>
</table>
</div>
</div>
</div>
<!-- Logs header row (stays sticky) -->
<div class="pb-2">
<div class="d-flex align-items-center justify-content-between">
<div class="fw-semibold text-muted">Logs</div>
<!-- Spinner shown while loading logs -->
<div class="spinner-border spinner-border-sm text-secondary d-none" role="status" id="spinner_logs">
<span class="visually-hidden">Loading...</span>
</div>
</div>
</div>
</div>
<!-- Logs table (scroll with page) -->
<div class="card border-0 shadow-sm">
<div class="card-body p-0">
<div id="tbl_logs"></div>
</div>
</div>
</div>
<button id="btn_unit_view_on_map"
type="button"
class="btn btn-primary btn-sm shadow position-fixed"
style="right: 15px; bottom: 25px; z-index: 1040;">
Map
</button>
</div>
unit View.UnitDetails;
interface
uses
System.SysUtils, System.Classes, JS, Web,
WEBLib.Forms, WEBLib.Dialogs, WEBLib.Graphics,
XData.Web.Client, XData.Web.JsonDataset, XData.Web.Dataset,
ConnectionModule,
Utils,
Data.DB, WEBLib.DB,
Vcl.Controls, WEBLib.Controls, WEBLib.Grids, WEBLib.DBCtrls, Vcl.StdCtrls,
WEBLib.StdCtrls;
type
TFViewUnitDetails = class(TWebForm)
xdwcUnitDetails: TXDataWebClient;
// Details (single-object) dataset
xdwdsUnitDetails: TXDataWebDataSet;
xdwdsUnitDetailsUnitId: TStringField;
xdwdsUnitDetailsUnitName: TStringField;
xdwdsUnitDetailsUnitDesc: TStringField;
xdwdsUnitDetailsMainStation: TStringField;
xdwdsUnitDetailsCurrentStation: TStringField;
xdwdsUnitDetailsMovingToStation: TStringField;
xdwdsUnitDetailsStatus: TStringField;
xdwdsUnitDetailsManpower: TStringField;
xdwdsUnitDetailsUndermanned: TBooleanField;
xdwdsUnitDetailsUnavailableReason: TStringField;
xdwdsUnitDetailsComplaint: TStringField;
xdwdsUnitDetailsCallType: TStringField;
xdwdsUnitDetailsLastStatusChange: TStringField;
xdwdsUnitDetailsUpdateTime: TStringField;
// Logs (array) dataset + table
xdwdsUnitLogs: TXDataWebDataSet;
wdsUnitLogs: TWebDataSource;
tblLogs: TWebDBTableControl;
xdwdsUnitLogsComplaint: TStringField;
xdwdsUnitLogsLog: TStringField;
xdwdsUnitLogsLogTime: TStringField;
btnUnitViewOnMap: TWebButton;
procedure btnUnitViewOnMapClick(Sender: TObject);
private
FUnitId: string;
FLoading: Boolean;
procedure InitializeForm;
procedure SetTextById(const elementId, value: string);
procedure SetHiddenById(const elementId: string; hidden: Boolean);
[async] procedure LoadUnitAsync;
[async] procedure LoadLogsAsync;
public
class function CreateForm(AElementID, UnitId: string): TWebForm;
end;
var
FViewUnitDetails: TFViewUnitDetails;
implementation
uses
View.Main,
View.Units;
{$R *.dfm}
procedure TFViewUnitDetails.btnUnitViewOnMapClick(Sender: TObject);
begin
if Assigned(FViewMain) then
FViewMain.ShowMapFocusUnit(FUnitId);
console.log('btnViewOnMapClick fired, FUnitId=' + FUnitId);
end;
class function TFViewUnitDetails.CreateForm(AElementID, UnitId: string): TWebForm;
procedure AfterCreate(AForm: TObject);
begin
with TFViewUnitDetails(AForm) do
begin
FUnitId := UnitId;
InitializeForm;
end;
end;
begin
Application.CreateForm(TFViewUnitDetails, AElementID, Result, @AfterCreate);
end;
procedure TFViewUnitDetails.InitializeForm;
begin
xdwcUnitDetails.Connection := DMConnection.ApiConnection;
xdwdsUnitDetails.Connection := DMConnection.ApiConnection;
xdwdsUnitLogs.Connection := DMConnection.ApiConnection;
FLoading := False;
LoadUnitAsync;
end;
procedure TFViewUnitDetails.SetTextById(const elementId, value: string);
var
el: TJSElement;
begin
el := Document.getElementById(elementId);
if el <> nil then
TJSHtmlElement(el).innerText := value;
end;
procedure TFViewUnitDetails.SetHiddenById(const elementId: string; hidden: Boolean);
var
el: TJSHTMLElement;
begin
el := TJSHTMLElement(Document.getElementById(elementId));
if el = nil then
Exit;
if hidden then
el.classList.add('d-none')
else
el.classList.remove('d-none');
end;
[async] procedure TFViewUnitDetails.LoadUnitAsync;
var
resp: TXDataClientResponse;
rootObj: TJSObject;
dataObj: TJSObject;
summaryTitle: string;
begin
if FLoading then
Exit;
FLoading := True;
Utils.ShowSpinner('spinner');
try
resp := await(xdwcUnitDetails.RawInvokeAsync('IApiService.GetUnitDetails', [FUnitId]));
rootObj := TJSObject(resp.Result);
dataObj := TJSObject(rootObj['data']);
xdwdsUnitDetails.Close;
xdwdsUnitDetails.SetJsonData(dataObj);
xdwdsUnitDetails.Open;
summaryTitle := xdwdsUnitDetailsUnitName.AsString;
if Trim(summaryTitle) <> '' then
SetTextById('lbl_summary_title', 'Summary for Unit ' + summaryTitle)
else
SetTextById('lbl_summary_title', 'Summary for Unit ' + xdwdsUnitDetailsUnitId.AsString);
SetTextById('lbl_unit', xdwdsUnitDetailsUnitName.AsString);
SetTextById('lbl_description', xdwdsUnitDetailsUnitDesc.AsString);
SetTextById('lbl_home_station', xdwdsUnitDetailsMainStation.AsString);
SetTextById('lbl_current_station', xdwdsUnitDetailsCurrentStation.AsString);
SetTextById('lbl_moving_to', xdwdsUnitDetailsMovingToStation.AsString);
SetTextById('lbl_status', xdwdsUnitDetailsStatus.AsString);
SetTextById('lbl_manpower', xdwdsUnitDetailsManpower.AsString);
if xdwdsUnitDetailsUndermanned.AsBoolean then
SetTextById('lbl_undermanned', 'Yes')
else
SetTextById('lbl_undermanned', 'No');
SetTextById('lbl_unavailable_reason', xdwdsUnitDetailsUnavailableReason.AsString);
SetTextById('lbl_complaint', xdwdsUnitDetailsComplaint.AsString);
SetTextById('lbl_call_type', xdwdsUnitDetailsCallType.AsString);
SetTextById('lbl_last_status_change', xdwdsUnitDetailsLastStatusChange.AsString);
SetTextById('lbl_updated', xdwdsUnitDetailsUpdateTime.AsString);
SetHiddenById('row_moving_to', Trim(xdwdsUnitDetailsMovingToStation.AsString) = '');
SetHiddenById('row_unavailable_reason', Trim(xdwdsUnitDetailsUnavailableReason.AsString) = '');
SetHiddenById('row_complaint', Trim(xdwdsUnitDetailsComplaint.AsString) = '');
SetHiddenById('row_call_type', Trim(xdwdsUnitDetailsCallType.AsString) = '');
SetHiddenById('row_last_status_change', Trim(xdwdsUnitDetailsLastStatusChange.AsString) = '');
await(LoadLogsAsync);
Utils.HideSpinner('spinner');
FLoading := False;
except
on E: EXDataClientRequestException do
begin
Utils.HideSpinner('spinner');
FLoading := False;
Utils.ShowErrorModal(E.ErrorResult.ErrorMessage);
end;
on E: Exception do
begin
Utils.HideSpinner('spinner');
FLoading := False;
Utils.ShowErrorModal(E.Message);
end;
end;
end;
[async] procedure TFViewUnitDetails.LoadLogsAsync;
var
resp: TXDataClientResponse;
rootObj: TJSObject;
dataArr: TJSArray;
begin
SetHiddenById('spinner_logs', False);
try
resp := await(xdwcUnitDetails.RawInvokeAsync('IApiService.GetUnitLogs', [FUnitId]));
rootObj := TJSObject(resp.Result);
dataArr := TJSArray(rootObj['data']);
console.log('LoadLogsAsync Units rootObj: ' + rootObj.tostring);
xdwdsUnitLogs.Close;
xdwdsUnitLogs.SetJsonData(dataArr);
xdwdsUnitLogs.Open;
SetHiddenById('spinner_logs', True);
except
on E: EXDataClientRequestException do
begin
SetHiddenById('spinner_logs', True);
Utils.ShowErrorModal(E.ErrorResult.ErrorMessage);
end;
on E: Exception do
begin
SetHiddenById('spinner_logs', True);
Utils.ShowErrorModal(E.Message);
end;
end;
end;
end.
object FViewUnits: TFViewUnits
Width = 359
Height = 480
ElementFont = efCSS
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
OnCreate = WebFormCreate
object lblEntries: TWebLabel
Left = 54
Top = 46
Width = 43
Height = 13
Caption = 'lblEntries'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
Visible = False
WidthPercent = 100.000000000000000000
end
object dblUnitsList: TWebDBListControl
Left = 50
Top = 146
Width = 263
Height = 237
ElementID = 'units_dbl_unit_list'
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
ChildOrder = 3
DefaultItemClassName = 'list-group-item p-1 border-0'
DefaultItemLinkClassName = 'list-group-link'
ElementFont = efCSS
ElementListClassName = 'list-group list-group-flush border-0'
Items = <>
Style = lsListGroup
DataSource = wdsUnits
ItemTemplate =
'<div class="list-section-header small fw-semibold bg-body-second' +
'ary text-dark rounded-1 px-2 mb-1">(%StationHeader%)</div><div c' +
'lass="card border shadow-sm"> <div class="card-body py-2 px-3 d' +
'-flex gap-2"> <div class="flex-grow-1"> <div class="fw-b' +
'old text-uppercase small">(%UnitName%)&nbsp;-&nbsp;(%Status%)</d' +
'iv> <div class="small text-body-secondary mb-1 (%UnitDescCl' +
'ass%)">(%UnitDesc%)</div> <div class="small">Station: (%Cur' +
'rentStation%)</div> <div class="small (%MovingToClass%)">Mo' +
'ving To: (%MovingToStation%)</div> <div class="small">Manpo' +
'wer: (%Manpower%)<span class="(%UndermannedClass%)"> - Undermann' +
'ed</span></div> <div class="small (%ComplaintClass%)">Compl' +
'aint: (%Complaint%)</div> <div class="small (%CallTypeClass' +
'%)">Call: (%CallType%)</div> <hr class="unit-divider my-1" ' +
'style="width: 80px; margin-left: 0" /> <div class="small te' +
'xt-danger (%UnavailableReasonClass%)">Unavailable: (%Unavailable' +
'Reason%)</div> <div class="small text-body-secondary (%Last' +
'StatusChangeClass%)">Status changed: (%LastStatusChange%)</div> ' +
' </div> <div class="d-flex flex-column justify-content-cent' +
'er gap-1"> <button type="button" class="btn btn-primary btn' +
'-sm btn-unit-details" data-unitid="(%UnitId%)">Details</button> ' +
' <button type="button" class="btn btn-sm btn-unit-map' +
' (%MapButtonClass%)" data-unitid="(%UnitId%)" data' +
'-canmap="(%CanShowMap%)" title="(%MapButtonTitle%)" ' +
' (%MapButtonDisabled%)> Map</button> </div> </div></div>'
ListSource = wdsUnits
end
object wdsUnits: TWebDataSource
AutoEdit = False
DataSet = xdwdsUnits
Left = 156
Top = 410
end
object xdwdsUnits: TXDataWebDataSet
Connection = DMConnection.ApiConnection
Left = 262
Top = 412
object xdwdsUnitsStationHeader: TStringField
FieldName = 'StationHeader'
end
object xdwdsUnitsUnitId: TStringField
FieldName = 'UnitId'
end
object xdwdsUnitsUnitName: TStringField
FieldName = 'UnitName'
end
object xdwdsUnitsUnitDesc: TStringField
FieldName = 'UnitDesc'
Size = 100
end
object xdwdsUnitsUnitDescClass: TStringField
FieldName = 'UnitDescClass'
end
object xdwdsUnitsCurrentStation: TStringField
FieldName = 'CurrentStation'
Size = 80
end
object xdwdsUnitsMovingToStation: TStringField
FieldName = 'MovingToStation'
Size = 80
end
object xdwdsUnitsStatus: TStringField
FieldName = 'Status'
Size = 160
end
object xdwdsUnitsManpower: TStringField
FieldName = 'Manpower'
end
object xdwdsUnitsUndermanned: TBooleanField
FieldName = 'Undermanned'
end
object xdwdsUnitsUndermannedClass: TStringField
FieldName = 'UndermannedClass'
end
object xdwdsUnitsMovingToClass: TStringField
FieldName = 'MovingToClass'
end
object xdwdsUnitsComplaintClass: TStringField
FieldName = 'ComplaintClass'
end
object xdwdsUnitsCallTypeClass: TStringField
FieldName = 'CallTypeClass'
end
object xdwdsUnitsUnavailableReason: TStringField
FieldName = 'UnavailableReason'
Size = 100
end
object xdwdsUnitsUnavailableReasonClass: TStringField
FieldName = 'UnavailableReasonClass'
end
object xdwdsUnitsLastStatusChange: TStringField
FieldName = 'LastStatusChange'
Size = 40
end
object xdwdsUnitsLastStatusChangeClass: TStringField
FieldName = 'LastStatusChangeClass'
end
object xdwdsUnitsComplaint: TStringField
FieldName = 'Complaint'
Size = 40
end
object xdwdsUnitsCallType: TStringField
FieldName = 'CallType'
end
object xdwdsUnitsCanShowMap: TStringField
FieldName = 'CanShowMap'
end
object xdwdsUnitsMapButtonClass: TStringField
FieldName = 'MapButtonClass'
end
object xdwdsUnitsMapButtonDisabled: TStringField
FieldName = 'MapButtonDisabled'
end
object xdwdsUnitsMapButtonTitle: TStringField
FieldName = 'MapButtonTitle'
end
end
object xdwcUnits: TXDataWebClient
Connection = DMConnection.ApiConnection
Left = 58
Top = 410
end
end
unit View.Units;
interface
uses
System.SysUtils, System.Classes, Web, WEBLib.Graphics, WEBLib.Forms, WEBLib.Dialogs,
Vcl.Controls, Vcl.StdCtrls, WEBLib.StdCtrls, WEBLib.Controls, WEBLib.Grids, WebLib.Lists,
XData.Web.Client, WEBLib.ExtCtrls, XData.Web.JsonDataset,
XData.Web.Dataset, XData.Web.Connection, Vcl.Forms, DateUtils, WEBLib.DBCtrls, System.Generics.Collections,
WEBLib.Menus, WEBLib.JSON, Auth.Service, WebLib.Storage, ConnectionModule, App.Types,
WEBLib.DB, Data.DB, XData.Web.DatasetCommon, JS, XData.Model.Classes, Utils;
type
TFViewUnits = class(TWebForm)
dblUnitsList: TWebDBListControl;
wdsUnits: TWebDataSource;
xdwdsUnits: TXDataWebDataSet;
xdwcUnits: TXDataWebClient;
lblEntries: TWebLabel;
xdwdsUnitsStationHeader: TStringField;
xdwdsUnitsUnitId: TStringField;
xdwdsUnitsUnitName: TStringField;
xdwdsUnitsUnitDesc: TStringField;
xdwdsUnitsUnitDescClass: TStringField;
xdwdsUnitsCurrentStation: TStringField;
xdwdsUnitsMovingToStation: TStringField;
xdwdsUnitsStatus: TStringField;
xdwdsUnitsManpower: TStringField;
xdwdsUnitsUndermanned: TBooleanField;
xdwdsUnitsUndermannedClass: TStringField;
xdwdsUnitsMovingToClass: TStringField;
xdwdsUnitsComplaintClass: TStringField;
xdwdsUnitsCallTypeClass: TStringField;
xdwdsUnitsUnavailableReason: TStringField;
xdwdsUnitsUnavailableReasonClass: TStringField;
xdwdsUnitsLastStatusChange: TStringField;
xdwdsUnitsLastStatusChangeClass: TStringField;
xdwdsUnitsComplaint: TStringField;
xdwdsUnitsCallType: TStringField;
xdwdsUnitsCanShowMap: TStringField;
xdwdsUnitsMapButtonClass: TStringField;
xdwdsUnitsMapButtonDisabled: TStringField;
xdwdsUnitsMapButtonTitle: TStringField;
procedure WebFormCreate(Sender: TObject);
private
FLoading: Boolean;
FFirstLoad: Boolean;
[async] procedure GetUnits;
procedure HandleListClick(e: TJSMouseEvent);
procedure PrepareUnitData(aRespObj: TJSObject);
public
procedure RefreshData;
procedure ApplyWsData(aRespObj: TJSObject);
end;
var
FViewUnits: TFViewUnits;
implementation
{$R *.dfm}
procedure TFViewUnits.WebFormCreate(Sender: TObject);
begin
DMConnection.ApiConnection.Connected := True;
Document.addEventListener('click', @HandleListClick);
FFirstLoad := True;
GetUnits;
asm
if (!window.showUnitDetails) {
window.showUnitDetails = function (id) {
pas['View.Main'].FViewMain.ShowUnitDetails(id);
};
}
end;
end;
procedure TFViewUnits.HandleListClick(e: TJSMouseEvent);
var
el: TJSElement;
btn: TJSElement;
unitId: string;
canShowMap: string;
begin
btn := nil;
el := TJSElement(e.target);
asm
btn = (el && el.closest) ? el.closest('.btn-unit-details') : null;
end;
if (btn <> nil) and (btn is TJSHtmlElement) then
begin
unitId := string(TJSHtmlElement(btn).getAttribute('data-unitid'));
e.preventDefault;
e.stopPropagation;
asm
if (window.showUnitDetails) window.showUnitDetails(unitId);
end;
end
else
begin
btn := nil;
asm
btn = (el && el.closest) ? el.closest('.btn-unit-map') : null;
end;
if (btn <> nil) and (btn is TJSHtmlElement) then
begin
canShowMap := string(TJSHtmlElement(btn).getAttribute('data-canmap'));
e.preventDefault;
e.stopPropagation;
if not SameText(canShowMap, 'true') then
Exit;
unitId := string(TJSHtmlElement(btn).getAttribute('data-unitid'));
asm
pas['View.Main'].FViewMain.ShowMapFocusUnit(unitId);
end;
end;
end;
end;
procedure TFViewUnits.PrepareUnitData(aRespObj: TJSObject);
var
data: TJSArray;
item: TJSObject;
i: Integer;
unitDesc: string;
stationHeader: string;
begin
if (aRespObj = nil) or not aRespObj.HasOwnProperty('data') then
Exit;
data := TJSArray(aRespObj['data']);
if data = nil then
Exit;
for i := 0 to data.Length - 1 do
begin
item := TJSObject(data[i]);
stationHeader := Trim(string(item['StationHeader']));
if (stationHeader <> '') and
not SameText(stationHeader, 'No Station') and
(Pos('station ', LowerCase(stationHeader)) <> 1) then
item['StationHeader'] := 'Station ' + stationHeader;
unitDesc := Trim(string(item['UnitDesc']));
if unitDesc = '' then
item['UnitDescClass'] := 'd-none'
else
item['UnitDescClass'] := '';
if Trim(string(item['MovingToStation'])) = '' then
item['MovingToClass'] := 'd-none'
else
item['MovingToClass'] := '';
if Trim(string(item['Complaint'])) = '' then
item['ComplaintClass'] := 'd-none'
else
item['ComplaintClass'] := '';
if Trim(string(item['CallType'])) = '' then
item['CallTypeClass'] := 'd-none'
else
item['CallTypeClass'] := '';
if Trim(string(item['UnavailableReason'])) = '' then
item['UnavailableReasonClass'] := 'd-none'
else
item['UnavailableReasonClass'] := '';
if Trim(string(item['LastStatusChange'])) = '' then
item['LastStatusChangeClass'] := 'd-none'
else
item['LastStatusChangeClass'] := '';
if JS.toBoolean(item['Undermanned']) then
item['UndermannedClass'] := ''
else
item['UndermannedClass'] := 'd-none';
end;
end;
[async] procedure TFViewUnits.GetUnits;
var
xdcResponse: TXDataClientResponse;
respObj: TJSObject;
unitCount: Integer;
begin
if FLoading then
Exit;
FLoading := True;
if FFirstLoad then
Utils.ShowSpinner('spinner');
try
try
xdcResponse := await(xdwcUnits.RawInvokeAsync('IApiService.GetUnitList', []));
respObj := TJSObject(xdcResponse.Result);
PrepareUnitData(respObj);
xdwdsUnits.Close;
xdwdsUnits.SetJsonData(respObj['data']);
xdwdsUnits.Open;
unitCount := Integer(respObj['count']);
lblEntries.Caption := Format('%d units', [unitCount]);
except
on E: EXDataClientRequestException do
Utils.ShowErrorModal(E.ErrorResult.ErrorMessage);
on E: Exception do
Utils.ShowErrorModal(E.Message);
end;
finally
if FFirstLoad then
Utils.HideSpinner('spinner');
FFirstLoad := False;
FLoading := False;
end;
end;
procedure TFViewUnits.RefreshData;
begin
Console.Log('Units.RefreshData');
GetUnits;
end;
procedure TFViewUnits.ApplyWsData(aRespObj: TJSObject);
var
unitCount: Integer;
begin
if FLoading then
Exit;
PrepareUnitData(aRespObj);
xdwdsUnits.Close;
xdwdsUnits.SetJsonData(aRespObj['data']);
xdwdsUnits.Open;
unitCount := Integer(aRespObj['count']);
lblEntries.Caption := Format('%d units', [unitCount]);
end;
end.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment