Skip to content

E
emiMobile
Commit 1d985813 by Mac Stephens
Options

big map update, added markers, also added timers to the complaints and units list for auto refresh.

parent 731ef776
Showing with 868 additions and 335 deletions
emiMobileServer/Source/Api.Database.dfm
......@@ -29,7 +29,7 @@ object ApiDatabaseModule: TApiDatabaseModule
Left = 374
Top = 222
end
object uqUnitsCurrent: TUniQuery
object uqMapUnits: TUniQuery
Connection = ucENTCAD
SQL.Strings = (
'SELECT'
......@@ -41,30 +41,30 @@ object ApiDatabaseModule: TApiDatabaseModule
' uc.GPS_LONGITUDE'
'FROM UNITS_CURRENT@AVL_LINK uc')
ReadOnly = True
Left = 462
Top = 324
object uqUnitsCurrentENTRYID: TFloatField
Left = 366
Top = 306
object uqMapUnitsENTRYID: TFloatField
FieldName = 'ENTRYID'
end
object uqUnitsCurrentUNITID: TFloatField
object uqMapUnitsUNITID: TFloatField
FieldName = 'UNITID'
end
object uqUnitsCurrentUNITNAME: TStringField
object uqMapUnitsUNITNAME: TStringField
FieldName = 'UNITNAME'
ReadOnly = True
end
object uqUnitsCurrentUNIT_DISTRICT: TStringField
object uqMapUnitsUNIT_DISTRICT: TStringField
FieldName = 'UNIT_DISTRICT'
Size = 8
end
object uqUnitsCurrentGPS_LATITUDE: TFloatField
object uqMapUnitsGPS_LATITUDE: TFloatField
FieldName = 'GPS_LATITUDE'
end
object uqUnitsCurrentGPS_LONGITUDE: TFloatField
object uqMapUnitsGPS_LONGITUDE: TFloatField
FieldName = 'GPS_LONGITUDE'
end
end
object uqDISUnitsActive: TUniQuery
object uqUnitList: TUniQuery
Connection = ucENTCAD
SQL.Strings = (
'SELECT dua.UNITID, dua.UNITNAME,'
......@@ -83,10 +83,11 @@ object ApiDatabaseModule: TApiDatabaseModule
' ca.COMPLAINT,'
' ca.UNITSTATUS,'
' cus.CODE_DESC AS UNIT_STATUS_DESC,'
' cdc.CODE_DESC AS CALL_TYPE,'
' uc.ENTRYID,'
' uc.GPS_LATITUDE,'
' uc.GPS_LONGITUDE'
'FROM DIS_UNITS_ACTIVE dua'
'FROM DIS_UNIT_ACTIVE dua'
'LEFT JOIN CD_UNIT_NUMBER cun ON cun.AGENCYCODE = dua.CAR' +
'NUMBER'
......@@ -109,106 +110,122 @@ object ApiDatabaseModule: TApiDatabaseModule
'LEFT JOIN CD_UNITSTATUS cus ON ca.UNITSTATUS = cus.COD' +
'E'
'LEFT JOIN COMPLAINT_ACTIVE cap ON cap.COMPLAINTID = ca.COM' +
'PLAINTID'
'LEFT JOIN CD_DISPATCHCODES cdc ON cdc.CODE = cap.DI' +
'SPATCHCODE'
'LEFT JOIN UNITS_CURRENT@AVL_LINK uc ON dua.UNITID = uc.UNIT' +
'ID'
'FETCH FIRST 100 ROWS ONLY')
'ORDER BY'
' CASE WHEN LENGTH(cd.CODE_DESC) = 1 THEN 0 ELSE 1 END,'
' cd.CODE_DESC,'
' dua.UNITNAME'
''
'')
ReadOnly = True
Left = 462
Top = 374
object uqDISUnitsActiveUNITID: TFloatField
Left = 446
Top = 394
object uqUnitListUNITID: TFloatField
FieldName = 'UNITID'
end
object uqDISUnitsActiveUNITNAME: TStringField
object uqUnitListUNITNAME: TStringField
FieldName = 'UNITNAME'
Size = 10
end
object uqDISUnitsActiveCARNUMBER_DESC: TStringField
object uqUnitListCARNUMBER_DESC: TStringField
FieldName = 'CARNUMBER_DESC'
ReadOnly = True
Size = 120
end
object uqDISUnitsActiveDISTRICT_DESC: TStringField
object uqUnitListDISTRICT_DESC: TStringField
FieldName = 'DISTRICT_DESC'
ReadOnly = True
Size = 120
end
object uqDISUnitsActiveSECTOR_DESC: TStringField
object uqUnitListSECTOR_DESC: TStringField
FieldName = 'SECTOR_DESC'
ReadOnly = True
Size = 120
end
object uqDISUnitsActiveOFFICER1_EMPNUM: TStringField
object uqUnitListOFFICER1_EMPNUM: TStringField
FieldName = 'OFFICER1_EMPNUM'
ReadOnly = True
Size = 10
end
object uqDISUnitsActiveOFFICER1_LAST_NAME: TStringField
object uqUnitListOFFICER1_LAST_NAME: TStringField
FieldName = 'OFFICER1_LAST_NAME'
ReadOnly = True
Size = 45
end
object uqDISUnitsActiveOFFICER1_FIRST_NAME: TStringField
object uqUnitListOFFICER1_FIRST_NAME: TStringField
FieldName = 'OFFICER1_FIRST_NAME'
ReadOnly = True
Size = 30
end
object uqDISUnitsActiveOFFICER1_MI: TStringField
object uqUnitListOFFICER1_MI: TStringField
FieldName = 'OFFICER1_MI'
ReadOnly = True
Size = 1
end
object uqDISUnitsActiveOFFICER2_EMPNUM: TStringField
object uqUnitListOFFICER2_EMPNUM: TStringField
FieldName = 'OFFICER2_EMPNUM'
ReadOnly = True
Size = 10
end
object uqDISUnitsActiveOFFICER2_LAST_NAME: TStringField
object uqUnitListOFFICER2_LAST_NAME: TStringField
FieldName = 'OFFICER2_LAST_NAME'
ReadOnly = True
Size = 45
end
object uqDISUnitsActiveOFFICER2_FIRST_NAME: TStringField
object uqUnitListOFFICER2_FIRST_NAME: TStringField
FieldName = 'OFFICER2_FIRST_NAME'
ReadOnly = True
Size = 30
end
object uqDISUnitsActiveOFFICER2_MI: TStringField
object uqUnitListOFFICER2_MI: TStringField
FieldName = 'OFFICER2_MI'
ReadOnly = True
Size = 1
end
object uqDISUnitsActiveLOCATION: TStringField
object uqUnitListLOCATION: TStringField
FieldName = 'LOCATION'
ReadOnly = True
Size = 30
end
object uqDISUnitsActiveCOMPLAINT: TStringField
object uqUnitListCOMPLAINT: TStringField
FieldName = 'COMPLAINT'
ReadOnly = True
Size = 10
end
object uqDISUnitsActiveENTRYID: TFloatField
object uqUnitListUNITSTATUS: TFloatField
FieldName = 'UNITSTATUS'
ReadOnly = True
end
object uqUnitListUNIT_STATUS_DESC: TStringField
FieldName = 'UNIT_STATUS_DESC'
ReadOnly = True
end
object uqUnitListENTRYID: TFloatField
FieldName = 'ENTRYID'
ReadOnly = True
end
object uqDISUnitsActiveGPS_LATITUDE: TFloatField
object uqUnitListGPS_LATITUDE: TFloatField
FieldName = 'GPS_LATITUDE'
ReadOnly = True
end
object uqDISUnitsActiveGPS_LONGITUDE: TFloatField
object uqUnitListGPS_LONGITUDE: TFloatField
FieldName = 'GPS_LONGITUDE'
ReadOnly = True
end
object uqDISUnitsActiveUNITSTATUS: TFloatField
FieldName = 'UNITSTATUS'
ReadOnly = True
end
object uqDISUnitsActiveUNIT_STATUS_DESC: TStringField
FieldName = 'UNIT_STATUS_DESC'
object uqUnitListCALL_TYPE: TStringField
FieldName = 'CALL_TYPE'
ReadOnly = True
Size = 60
end
end
object uqCFSActive: TUniQuery
object uqComplaintUnits: TUniQuery
Connection = ucENTCAD
SQL.Strings = (
'SELECT'
......@@ -224,37 +241,37 @@ object ApiDatabaseModule: TApiDatabaseModule
'WHERE ca.COMPLAINTID = :COMPLAINTID'
'ORDER BY ca.DATEDISPATCHED')
ReadOnly = True
Left = 278
Top = 318
Left = 256
Top = 308
ParamData = <
item
DataType = ftUnknown
Name = 'COMPLAINTID'
Value = Null
end>
object uqCFSActiveCOMPLAINTID: TFloatField
object uqComplaintUnitsCOMPLAINTID: TFloatField
FieldName = 'COMPLAINTID'
end
object uqCFSActiveUNITID: TFloatField
object uqComplaintUnitsUNITID: TFloatField
FieldName = 'UNITID'
end
object uqCFSActiveUNITNAME: TStringField
object uqComplaintUnitsUNITNAME: TStringField
FieldName = 'UNITNAME'
Size = 10
end
object uqCFSActiveDATEDISPATCHED: TDateTimeField
object uqComplaintUnitsDATEDISPATCHED: TDateTimeField
FieldName = 'DATEDISPATCHED'
end
object uqCFSActiveDATERESPONDED: TDateTimeField
object uqComplaintUnitsDATERESPONDED: TDateTimeField
FieldName = 'DATERESPONDED'
end
object uqCFSActiveDATEARRIVED: TDateTimeField
object uqComplaintUnitsDATEARRIVED: TDateTimeField
FieldName = 'DATEARRIVED'
end
object uqCFSActiveDATECLEARED: TDateTimeField
object uqComplaintUnitsDATECLEARED: TDateTimeField
FieldName = 'DATECLEARED'
end
object uqCFSActiveLOCATION: TStringField
object uqComplaintUnitsLOCATION: TStringField
FieldName = 'LOCATION'
Size = 30
end
......@@ -273,8 +290,8 @@ object ApiDatabaseModule: TApiDatabaseModule
'WHERE cm.CFSID = :CFSID'
'ORDER BY cm.TIMESTAMP ASC')
ReadOnly = True
Left = 282
Top = 376
Left = 284
Top = 388
ParamData = <
item
DataType = ftUnknown
......@@ -335,7 +352,7 @@ object ApiDatabaseModule: TApiDatabaseModule
' ct.DATERESPONDED,'
' ct.DATEARRIVED,'
' ct.DATECLEARED,'
' cp.COLOR AS PRIORITY_COLOR,'
' cp.MOBILE_COLOR AS PRIORITY_COLOR,'
' cd.CODE_DESC AS DISTRICT_DESC,'
' cs.CODE_DESC AS SECTOR_DESC'
'FROM COMPLAINT_ACTIVE ca'
......@@ -355,7 +372,7 @@ object ApiDatabaseModule: TApiDatabaseModule
'ORDER BY ca.DISPATCHDISTRICT, ct.DATEREPORTED DESC, ca.PRIORITY ' +
'DESC'
'FETCH FIRST 10 ROWS ONLY')
'')
ReadOnly = True
OnCalcFields = uqComplaintListCalcFields
Left = 76
......@@ -651,10 +668,92 @@ object ApiDatabaseModule: TApiDatabaseModule
Port = 1521
Username = 'ENTCAD'
Server = 'BUFENTCAD'
Connected = True
LoginPrompt = False
Left = 76
Top = 244
EncryptedPassword = 'BAFFB1FFABFFBCFFBEFFBBFF'
end
object uqMapComplaints: TUniQuery
Connection = ucENTCAD
SQL.Strings = (
'SELECT'
' ca.COMPLAINTID,'
' ca.DISPATCHDISTRICT,'
' ca.PRIORITY AS PRIORITY,'
' cdc.MOBILE_MAP_CATEGORY AS DISPATCHCODECATEGORY,'
''
' CASE '
' WHEN ca.XCOORD IS NOT NULL AND ca.YCOORD IS NOT NULL THEN'
' SDO_CS.TRANSFORM('
' SDO_GEOMETRY(2001, 2262, SDO_POINT_TYPE(ca.XCOORD, ca.YC' +
'OORD, NULL), NULL, NULL),'
' 4326'
' ).sdo_point.x'
' END AS LNG,'
''
' CASE '
' WHEN ca.XCOORD IS NOT NULL AND ca.YCOORD IS NOT NULL THEN'
' SDO_CS.TRANSFORM('
' SDO_GEOMETRY(2001, 2262, SDO_POINT_TYPE(ca.XCOORD, ca.YC' +
'OORD, NULL), NULL, NULL),'
' 4326'
' ).sdo_point.y'
' END AS LAT,'
''
' cdc.CODE_DESC AS DISPATCH_CODE_DESC'
'FROM COMPLAINT_ACTIVE ca'
'JOIN COMPLAINT_TIMES ct'
' ON ct.COMPLAINTID = ca.COMPLAINTID'
'LEFT JOIN CD_DISPATCHCODES cdc'
' ON cdc.CODE = ca.DISPATCHCODE'
'WHERE ca.COMPLAINT IS NOT NULL '
' AND ca.XCOORD IS NOT NULL '
' AND ca.YCOORD IS NOT NULL;'
''
'')
ReadOnly = True
OnCalcFields = uqMapComplaintsCalcFields
Left = 476
Top = 308
object uqMapComplaintsCOMPLAINTID: TFloatField
FieldName = 'COMPLAINTID'
Required = True
end
object uqMapComplaintsDISPATCHDISTRICT: TStringField
FieldName = 'DISPATCHDISTRICT'
Size = 6
end
object uqMapComplaintsLNG: TFloatField
FieldName = 'LNG'
end
object uqMapComplaintsLAT: TFloatField
FieldName = 'LAT'
end
object uqMapComplaintsDISPATCH_CODE_DESC: TStringField
FieldName = 'DISPATCH_CODE_DESC'
ReadOnly = True
Size = 60
end
object uqMapComplaintsPRIORITY: TStringField
FieldName = 'PRIORITY'
Size = 6
end
object uqMapComplaintsDISPATCHCODECATEGORY: TStringField
FieldName = 'DISPATCHCODECATEGORY'
ReadOnly = True
Size = 50
end
object uqMapComplaintspriorityKey: TStringField
FieldKind = fkCalculated
FieldName = 'priorityKey'
Calculated = True
end
object uqMapComplaintspngName: TStringField
FieldKind = fkCalculated
FieldName = 'pngName'
Calculated = True
end
end
end
emiMobileServer/Source/Api.Database.pas
......@@ -5,7 +5,7 @@ interface
uses
System.SysUtils, System.Classes, Data.DB, MemDS, DBAccess, Uni, UniProvider,
PostgreSQLUniProvider, System.Variants, System.Generics.Collections, System.IniFiles,
Common.Logging, Vcl.Forms, OracleUniProvider;
Common.Logging, Vcl.Forms, OracleUniProvider, System.Character;
type
TApiDatabaseModule = class(TDataModule)
......@@ -14,9 +14,9 @@ type
UniQuery1: TUniQuery;
OracleUniProvider1: TOracleUniProvider;
uqBooking: TUniQuery;
uqUnitsCurrent: TUniQuery;
uqDISUnitsActive: TUniQuery;
uqCFSActive: TUniQuery;
uqMapUnits: TUniQuery;
uqUnitList: TUniQuery;
uqComplaintUnits: TUniQuery;
uqCFSMemos: TUniQuery;
uqComplaintList: TUniQuery;
uqComplaintDetails: TUniQuery;
......@@ -78,56 +78,69 @@ type
uqComplaintDetailsDATERESPONDED: TDateTimeField;
uqComplaintDetailsDATEARRIVED: TDateTimeField;
uqComplaintDetailsDATECLEARED: TDateTimeField;
uqCFSActiveCOMPLAINTID: TFloatField;
uqCFSActiveUNITID: TFloatField;
uqCFSActiveUNITNAME: TStringField;
uqCFSActiveDATEDISPATCHED: TDateTimeField;
uqCFSActiveDATERESPONDED: TDateTimeField;
uqCFSActiveDATEARRIVED: TDateTimeField;
uqCFSActiveDATECLEARED: TDateTimeField;
uqCFSActiveLOCATION: TStringField;
uqComplaintUnitsCOMPLAINTID: TFloatField;
uqComplaintUnitsUNITID: TFloatField;
uqComplaintUnitsUNITNAME: TStringField;
uqComplaintUnitsDATEDISPATCHED: TDateTimeField;
uqComplaintUnitsDATERESPONDED: TDateTimeField;
uqComplaintUnitsDATEARRIVED: TDateTimeField;
uqComplaintUnitsDATECLEARED: TDateTimeField;
uqComplaintUnitsLOCATION: TStringField;
uqCFSMemosMEMO_ID: TFloatField;
uqCFSMemosCFSID: TFloatField;
uqCFSMemosMEMO_TYPE: TFloatField;
uqCFSMemosTIMESTAMP: TDateTimeField;
uqCFSMemosBADGE_NUMBER: TStringField;
uqCFSMemosREMARKS: TStringField;
uqUnitsCurrentENTRYID: TFloatField;
uqUnitsCurrentUNITID: TFloatField;
uqUnitsCurrentUNITNAME: TStringField;
uqUnitsCurrentUNIT_DISTRICT: TStringField;
uqUnitsCurrentGPS_LATITUDE: TFloatField;
uqUnitsCurrentGPS_LONGITUDE: TFloatField;
uqDISUnitsActiveUNITID: TFloatField;
uqDISUnitsActiveUNITNAME: TStringField;
uqDISUnitsActiveCARNUMBER_DESC: TStringField;
uqDISUnitsActiveDISTRICT_DESC: TStringField;
uqDISUnitsActiveSECTOR_DESC: TStringField;
uqDISUnitsActiveOFFICER1_EMPNUM: TStringField;
uqDISUnitsActiveOFFICER1_LAST_NAME: TStringField;
uqDISUnitsActiveOFFICER1_FIRST_NAME: TStringField;
uqDISUnitsActiveOFFICER1_MI: TStringField;
uqDISUnitsActiveOFFICER2_EMPNUM: TStringField;
uqDISUnitsActiveOFFICER2_LAST_NAME: TStringField;
uqDISUnitsActiveOFFICER2_FIRST_NAME: TStringField;
uqDISUnitsActiveOFFICER2_MI: TStringField;
uqDISUnitsActiveLOCATION: TStringField;
uqDISUnitsActiveCOMPLAINT: TStringField;
uqDISUnitsActiveENTRYID: TFloatField;
uqDISUnitsActiveGPS_LATITUDE: TFloatField;
uqDISUnitsActiveGPS_LONGITUDE: TFloatField;
uqMapUnitsENTRYID: TFloatField;
uqMapUnitsUNITID: TFloatField;
uqMapUnitsUNITNAME: TStringField;
uqMapUnitsUNIT_DISTRICT: TStringField;
uqMapUnitsGPS_LATITUDE: TFloatField;
uqMapUnitsGPS_LONGITUDE: TFloatField;
uqComplaintListcomplaintNumber: TStringField;
uqComplaintListPRIORITY_COLOR: TFloatField;
uqComplaintListDISTRICT_DESC: TStringField;
uqComplaintListSECTOR_DESC: TStringField;
uqDISUnitsActiveUNITSTATUS: TFloatField;
uqDISUnitsActiveUNIT_STATUS_DESC: TStringField;
uqUnitListUNITID: TFloatField;
uqUnitListUNITNAME: TStringField;
uqUnitListCARNUMBER_DESC: TStringField;
uqUnitListDISTRICT_DESC: TStringField;
uqUnitListSECTOR_DESC: TStringField;
uqUnitListOFFICER1_EMPNUM: TStringField;
uqUnitListOFFICER1_LAST_NAME: TStringField;
uqUnitListOFFICER1_FIRST_NAME: TStringField;
uqUnitListOFFICER1_MI: TStringField;
uqUnitListOFFICER2_EMPNUM: TStringField;
uqUnitListOFFICER2_LAST_NAME: TStringField;
uqUnitListOFFICER2_FIRST_NAME: TStringField;
uqUnitListOFFICER2_MI: TStringField;
uqUnitListLOCATION: TStringField;
uqUnitListCOMPLAINT: TStringField;
uqUnitListUNITSTATUS: TFloatField;
uqUnitListUNIT_STATUS_DESC: TStringField;
uqUnitListENTRYID: TFloatField;
uqUnitListGPS_LATITUDE: TFloatField;
uqUnitListGPS_LONGITUDE: TFloatField;
uqUnitListCALL_TYPE: TStringField;
uqMapComplaints: TUniQuery;
uqMapComplaintsCOMPLAINTID: TFloatField;
uqMapComplaintsDISPATCHDISTRICT: TStringField;
uqMapComplaintsLNG: TFloatField;
uqMapComplaintsLAT: TFloatField;
uqMapComplaintsDISPATCH_CODE_DESC: TStringField;
uqMapComplaintsPRIORITY: TStringField;
uqMapComplaintsDISPATCHCODECATEGORY: TStringField;
uqMapComplaintspriorityKey: TStringField;
uqMapComplaintspngName: TStringField;
procedure DataModuleCreate(Sender: TObject);
procedure uqComplaintListCalcFields(DataSet: TDataSet);
procedure uqMapComplaintsCalcFields(DataSet: TDataSet);
private
{ Private declarations }
public
{ Public declarations }
function DerivePriorityKeyFromPriorityString(const priorityString: string): string;
function HandleUniqueFilenames(const category: string): string;
class procedure ExecSQL(const SQL: string);
end;
......@@ -214,4 +227,59 @@ begin
end;
procedure TApiDatabaseModule.uqMapComplaintsCalcFields(DataSet: TDataSet);
var
rawCategory: string;
rawPriority: string;
derivedPriorityKey: string;
computedPngName: string;
begin
rawCategory := DataSet.FieldByName('DISPATCHCODECATEGORY').AsString;
rawPriority := DataSet.FieldByName('PRIORITY').AsString;
derivedPriorityKey := DerivePriorityKeyFromPriorityString(rawPriority);
DataSet.FieldByName('priorityKey').AsString := derivedPriorityKey;
if Trim(rawCategory) = '' then
computedPngName := 'default.png'
else
computedPngName := Format('%s_%s.png', [HandleUniqueFilenames(rawCategory), derivedPriorityKey]);
DataSet.FieldByName('pngName').AsString := computedPngName;
end;
function TApiDatabaseModule.HandleUniqueFilenames(const category: string): string;
var
i: Integer;
ch: Char;
lowered, resultBuilder: string;
begin
lowered := Trim(LowerCase(category));
resultBuilder := '';
for i := 1 to Length(lowered) do
begin
ch := lowered[i];
if ch.IsLetterOrDigit then
resultBuilder := resultBuilder + ch
else
resultBuilder := resultBuilder + '_';
end;
Result := resultBuilder;
end;
function TApiDatabaseModule.DerivePriorityKeyFromPriorityString(const priorityString: string): string;
var
firstChar: Char;
begin
if priorityString <> '' then
begin
firstChar := priorityString[1]; // handles "3J", "3P", etc.
if (firstChar >= '1') and (firstChar <= '4') then
Exit(string(firstChar));
if (firstChar >= '5') and (firstChar <= '9') then
Exit('5-9');
end;
Result := '5-9';
end;
end.
emiMobileServer/Source/Api.Service.pas
......@@ -18,6 +18,8 @@ type
['{4FCB7FAF-44E5-49D6-9C0F-EE44BFB33313}']
[HttpGet] function GetComplaintList: TJSONObject;
[HttpGet] function GetUnitList: TJSONObject;
[HttpGet] function GetComplaintMap: TJSONObject;
[HttpGet] function GetUnitMap: TJSONObject;
end;
implementation
......
emiMobileServer/Source/Api.ServiceImpl.pas
......@@ -19,6 +19,8 @@ type
public
function GetComplaintList: TJSONObject;
function GetUnitList: TJSONObject;
function GetComplaintMap: TJSONObject;
function GetUnitMap: TJSONObject;
end;
implementation
......@@ -40,6 +42,111 @@ begin
Logger.Log(3, 'ApiDatabaseModule destroyed');
end;
function TApiService.GetComplaintMap: TJSONObject;
var
data: TJSONArray;
emitted: Integer;
item: TJSONObject;
begin
Logger.Log(3, '---TApiService.GetComplaintMap initiated');
Result := TJSONObject.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result);
data := TJSONArray.Create;
try
emitted := 0;
with ApiDB.uqMapComplaints do
begin
Open;
First;
while not Eof do
begin
if ApiDB.uqMapComplaintsLAT.IsNull or ApiDB.uqMapComplaintsLNG.IsNull then
begin
Next;
Continue;
end;
item := TJSONObject.Create;
item.AddPair('ComplaintId', ApiDB.uqMapComplaintsCOMPLAINTID.AsString);
item.AddPair('DispatchDistrict', ApiDB.uqMapComplaintsDISPATCHDISTRICT.AsString);
item.AddPair('DispatchCodeDesc', ApiDB.uqMapComplaintsDISPATCH_CODE_DESC.AsString);
item.AddPair('DispatchCodeCategory', ApiDB.uqMapComplaintsDISPATCHCODECATEGORY.AsString);
item.AddPair('Priority', ApiDB.uqMapComplaintsPRIORITY.AsString);
item.AddPair('priorityKey', ApiDB.uqMapComplaints.FieldByName('priorityKey').AsString);
item.AddPair('pngName', ApiDB.uqMapComplaints.FieldByName('pngName').AsString);
item.AddPair('Lat', TJSONNumber.Create(ApiDB.uqMapComplaintsLAT.AsFloat));
item.AddPair('Lng', TJSONNumber.Create(ApiDB.uqMapComplaintsLNG.AsFloat));
data.AddElement(item);
Inc(emitted);
Next;
end;
end;
Result.AddPair('count', TJSONNumber.Create(data.Count));
Result.AddPair('returned', TJSONNumber.Create(emitted));
Result.AddPair('data', data);
except
data.Free;
Logger.Log(3, '---TApiService.GetComplaintMap End (error)');
raise EXDataHttpException.Create(500, 'Failed to load complaint map');
end;
Logger.Log(3, '---TApiService.GetComplaintMap End');
end;
function TApiService.GetUnitMap: TJSONObject;
var
data: TJSONArray;
begin
Logger.Log(3, '---TApiService.GetUnitMap initiated');
Result := TJSONObject.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result);
data := TJSONArray.Create;
try
with ApiDB.uqMapUnits do
begin
Open;
First;
while not Eof do
begin
// skip rows without coordinates
if (not FieldByName('GPS_LATITUDE').IsNull) and (not FieldByName('GPS_LONGITUDE').IsNull) then
begin
var item := TJSONObject.Create;
item.AddPair('UnitId', ApiDB.uqMapUnitsUNITID.AsString);
item.AddPair('UnitName', ApiDB.uqMapUnitsUNITNAME.AsString);
item.AddPair('District', ApiDB.uqMapUnitsUNIT_DISTRICT.AsString);
item.AddPair('Lat', TJSONNumber.Create(ApiDB.uqMapUnitsGPS_LATITUDE.AsFloat));
item.AddPair('Lng', TJSONNumber.Create(ApiDB.uqMapUnitsGPS_LONGITUDE.AsFloat));
data.AddElement(item);
end;
Next;
end;
end;
Result.AddPair('count', TJSONNumber.Create(data.Count));
Result.AddPair('returned', TJSONNumber.Create(data.Count));
Result.AddPair('data', data);
except
data.Free;
Logger.Log(3, '---TApiService.GetUnitMap End (error)');
raise EXDataHttpException.Create(500, 'Failed to load unit map');
end;
Logger.Log(3, '---TApiService.GetUnitMap End');
end;
function TApiService.GetComplaintList: TJSONObject;
var
data: TJSONArray;
......@@ -56,6 +163,7 @@ begin
with ApiDB.uqComplaintList do
begin
Open;
(FieldByName('DATEREPORTED') as TDateTimeField).DisplayFormat := 'yyyy-mm-dd hh:nn:ss';
First;
while not Eof do
begin
......@@ -132,7 +240,7 @@ begin
data := TJSONArray.Create;
try
lastDistrict := '';
with ApiDB.uqDISUnitsActive do
with ApiDB.uqUnitList do
begin
Open;
First;
......@@ -140,33 +248,38 @@ begin
begin
var item := TJSONObject.Create;
// Group header: show once when district changes (e.g., "1", "A")
var curDistrict := ApiDB.uqDISUnitsActiveDISTRICT_DESC.AsString;
if not SameText(curDistrict, lastDistrict) then
item.AddPair('DistrictHeader', curDistrict);
lastDistrict := curDistrict;
// Group header: show once when district changes
var curDistrict := ApiDB.uqUnitListDISTRICT_DESC.AsString;
var header := IfThen(curDistrict <> '', curDistrict + ' District', '');
if (header <> '') and not SameText(header, lastDistrict) then
item.AddPair('DistrictHeader', header);
lastDistrict := header;
// Core unit identity
item.AddPair('UnitId', ApiDB.uqDISUnitsActiveUNITID.AsString);
item.AddPair('UnitName', ApiDB.uqDISUnitsActiveUNITNAME.AsString);
item.AddPair('CarNumberDesc', ApiDB.uqDISUnitsActiveCARNUMBER_DESC.AsString);
item.AddPair('UnitId', ApiDB.uqUnitListUNITID.AsString);
item.AddPair('UnitName', ApiDB.uqUnitListUNITNAME.AsString);
item.AddPair('CarNumberDesc', ApiDB.uqUnitListCARNUMBER_DESC.AsString);
item.AddPair('District', curDistrict);
item.AddPair('Sector', ApiDB.uqDISUnitsActiveSECTOR_DESC.AsString);
item.AddPair('Sector', ApiDB.uqUnitListSECTOR_DESC.AsString);
item.AddPair('CallType', ApiDB.uqUnitListCALL_TYPE.AsString);
// Current assignment (if any)
item.AddPair('Location', ApiDB.uqDISUnitsActiveLOCATION.AsString);
item.AddPair('Complaint', ApiDB.uqDISUnitsActiveCOMPLAINT.AsString);
item.AddPair('Location', ApiDB.uqUnitListLOCATION.AsString);
item.AddPair('Complaint', ApiDB.uqUnitListCOMPLAINT.AsString);
// Status: default to "Available" when no active CFS row
var statusDesc := ApiDB.uqDISUnitsActiveUNIT_STATUS_DESC.AsString;
var statusDesc := ApiDB.uqUnitListUNIT_STATUS_DESC.AsString;
if statusDesc = '' then
statusDesc := 'Available';
item.AddPair('Status', statusDesc);
// Officers (LAST, FIRST [MI])
var o1 := Trim(ApiDB.uqDISUnitsActiveOFFICER1_LAST_NAME.AsString);
var f1 := Trim(ApiDB.uqDISUnitsActiveOFFICER1_FIRST_NAME.AsString);
var m1 := Trim(ApiDB.uqDISUnitsActiveOFFICER1_MI.AsString);
var o1 := Trim(ApiDB.uqUnitListOFFICER1_LAST_NAME.AsString);
var f1 := Trim(ApiDB.uqUnitListOFFICER1_FIRST_NAME.AsString);
var m1 := Trim(ApiDB.uqUnitListOFFICER1_MI.AsString);
if o1 <> '' then
begin
if f1 <> '' then o1 := o1 + ', ' + f1;
......@@ -174,9 +287,9 @@ begin
item.AddPair('Officer1', o1);
end;
var o2 := Trim(ApiDB.uqDISUnitsActiveOFFICER2_LAST_NAME.AsString);
var f2 := Trim(ApiDB.uqDISUnitsActiveOFFICER2_FIRST_NAME.AsString);
var m2 := Trim(ApiDB.uqDISUnitsActiveOFFICER2_MI.AsString);
var o2 := Trim(ApiDB.uqUnitListOFFICER2_LAST_NAME.AsString);
var f2 := Trim(ApiDB.uqUnitListOFFICER2_FIRST_NAME.AsString);
var m2 := Trim(ApiDB.uqUnitListOFFICER2_MI.AsString);
if o2 <> '' then
begin
if f2 <> '' then o2 := o2 + ', ' + f2;
......
emiMobileServer/Source/Main.dfm
......@@ -70,11 +70,4 @@ object FMain: TFMain
Left = 256
Top = 402
end
object tmrTwilio: TTimer
Enabled = False
Interval = 30000
OnTimer = tmrTwilioTimer
Left = 146
Top = 416
end
end
emiMobileServer/Source/Main.pas
......@@ -18,11 +18,9 @@ type
initTimer: TTimer;
btnAuthSwaggerUI: TButton;
ExeInfo1: TExeInfo;
tmrTwilio: TTimer;
procedure btnApiSwaggerUIClick(Sender: TObject);
procedure btnDataClick(Sender: TObject);
procedure btnExitClick(Sender: TObject);
procedure tmrTwilioTimer(Sender: TObject);
procedure ContactFormData(AText: String);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure initTimerTimer(Sender: TObject);
......@@ -130,12 +128,6 @@ begin
Logger.Log(1, LogValue('--Database->Password', IniEntries.DatabasePassword, IniEntries.DatabasePasswordFromIni));
Logger.Log(1, '');
Logger.Log(1, '--- Twilio ---');
Logger.Log(1, LogValue('--Twilio->AccountSID', IniEntries.TwilioSID, IniEntries.TwilioSIDFromIni));
Logger.Log(1, LogValue('--Twilio->AuthHeader', IniEntries.TwilioAuthHeader, IniEntries.TwilioAuthHeaderFromIni));
Logger.Log(1, '');
try
AuthServerModule := TAuthServerModule.Create(Self);
AuthServerModule.StartAuthServer(ServerConfig.url, AUTH_MODEL);
......@@ -145,19 +137,6 @@ begin
AppServerModule := TAppServerModule.Create(Self);
AppServerModule.StartAppServer(ServerConfig.url);
if IniEntries.TwilioUpdateTime > 0 then
begin
TwilioDataModule := TTwilioDataModule.Create(Self);
tmrTwilio.Interval := IniEntries.TwilioUpdateTime * 60000;
tmrTwilio.Enabled := True;
Logger.Log(1, Format('Twilio polling enabled every %d minutes.', [IniEntries.TwilioUpdateTime]));
end
else
begin
tmrTwilio.Enabled := False;
Logger.Log(1, 'Twilio polling disabled (TwilioUpdateTime = 0)');
end;
except
on E: Exception do
Logger.Log(2, 'Failed to start server modules: ' + E.Message);
......@@ -165,16 +144,5 @@ begin
end;
procedure TFMain.tmrTwilioTimer(Sender: TObject);
begin
tmrTwilio.Enabled := False;
Logger.Log(4, 'tmrTwilioTimer ---start');
TwilioDataModule := TTwilioDataModule.Create(Self);
TwilioDataModule.UpdateDB;
TwilioDataModule.Free;
Logger.Log(4, 'tmrTwilioTimer ---end (interval: ' + tmrTwilio.Interval.ToString + ' ms)');
tmrTwilio.Enabled := True;
end;
end.
emiMobileServer/emiMobileServer.ini
[Settings]
LogFileNum=451
LogFileNum=484
webClientVersion=0.1.0
TwilioUpdateTime=0
[Database]
Server=192.168.102.130
--Server=192.168.198.129
--Server=192.168.75.133
Database=envoy_db
Username=postgres
Password=postgreSQL
......
webEMIMobile/Markers.pas 0 → 100644
unit Markers;
interface
function SvgPinDataURL(const Hex: string): string; // complaint: square badge + notch, fill = Hex
function SvgCarDataURL(const Hex: string): string; // unit: badge + notch with car pictogram, fill = Hex
implementation
uses
SysUtils;
function URLEncodeSVG(const S: string): string;
var
R: string;
begin
R := S;
R := StringReplace(R, '%', '%25', [rfReplaceAll]);
R := StringReplace(R, '#', '%23', [rfReplaceAll]);
R := StringReplace(R, '<', '%3C', [rfReplaceAll]);
R := StringReplace(R, '>', '%3E', [rfReplaceAll]);
R := StringReplace(R, '"', '%22', [rfReplaceAll]);
R := StringReplace(R, '''', '%27', [rfReplaceAll]);
R := StringReplace(R, ' ', '%20', [rfReplaceAll]);
Result := 'data:image/svg+xml;charset=utf-8,' + R;
end;
function NormalizeHex(const Hex: string; const Fallback: string): string;
var
c: string;
begin
c := Trim(Hex);
if (Length(c) = 7) and (c[1] = '#') then
Result := c
else
Result := Fallback;
end;
function ForegroundForFill(const Hex: string): string;
var
c: string;
r, g, b: Integer;
lum: Double;
begin
c := UpperCase(Hex);
if (Length(c) = 7) and (c[1] = '#') then
begin
r := StrToIntDef('$' + Copy(c, 2, 2), 0);
g := StrToIntDef('$' + Copy(c, 4, 2), 0);
b := StrToIntDef('$' + Copy(c, 6, 2), 0);
lum := 0.2126 * r + 0.7152 * g + 0.0722 * b; // 0..255
if lum > 170 then
Result := '#111111'
else
Result := '#FFFFFF';
end
else
Result := '#FFFFFF';
end;
function SvgPinDataURL(const Hex: string): string;
var
fill, svg: string;
begin
fill := NormalizeHex(Hex, '#2563EB');
svg :=
'<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 30 38">' +
'<rect x="1" y="1" rx="6" ry="6" width="28" height="28" fill="' + fill + '"/>' +
'<path d="M15,34 l6,-8 h-12 z" fill="' + fill + '"/>' +
'</svg>';
Result := URLEncodeSVG(svg);
end;
function SvgCarDataURL(const Hex: string): string;
var
fill, fg, svg: string;
begin
fill := NormalizeHex(Hex, '#2563EB');
fg := ForegroundForFill(fill);
svg :=
'<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 30 38">' +
'<rect x="1" y="1" rx="6" ry="6" width="28" height="28" fill="' + fill + '"/>' +
'<path d="M15,34 l6,-8 h-12 z" fill="' + fill + '"/>' +
// minimalist car pictogram (fits 28x28 body)
'<path fill="' + fg + '" d="M7 20h16l-2-6a3 3 0 0 0-2.8-2H11.8A3 3 0 0 0 9 14l-2 6zm-1 1h-1a1 1 0 0 0 0 2h1v2a1 1 0 0 0 1 1h2a1 1 0 0 0 1-1v-2h8v2a1 1 0 0 0 1 1h2a1 1 0 0 0 1-1v-2h1a1 1 0 0 0 0-2h-1zm4-7h10l1 3H9l1-3zM10 22a2 2 0 1 0 0 4 2 2 0 0 0 0-4zm10 0a2 2 0 1 0 0 4 2 2 0 0 0 0-4z"/>' +
'</svg>';
Result := URLEncodeSVG(svg);
end;
end.
webEMIMobile/Utils.pas
......@@ -61,37 +61,78 @@ begin
end;
// ...uses JS, Web...
var
GIsBusy: Boolean = False;
procedure ShowSpinner(SpinnerID: string);
var
SpinnerElement: TJSHTMLElement;
SpinnerElement, Overlay: TJSHTMLElement;
begin
SpinnerElement := TJSHTMLElement(document.getElementById(SpinnerID));
if Assigned(SpinnerElement) then
Overlay := TJSHTMLElement(document.getElementById('screenlock'));
// ensure overlay exists
if Overlay = nil then
begin
// Move spinner to the <body> if it's not already there
asm
if (SpinnerElement.parentNode !== document.body) {
document.body.appendChild(SpinnerElement);
}
Overlay := TJSHTMLElement(document.createElement('div'));
Overlay.id := 'screenlock';
document.body.appendChild(Overlay);
end;
// move both to <body> and show
if Assigned(Overlay) then
begin
asm if (Overlay.parentNode !== document.body) { document.body.appendChild(Overlay); } end;
Overlay.classList.remove('d-none');
Overlay.classList.add('d-block','position-fixed','top-0','start-0','w-100','h-100');
Overlay.style.setProperty('z-index','1060');
Overlay.style.setProperty('background','rgba(0,0,0,.15)');
Overlay.style.setProperty('pointer-events','auto');
end;
if Assigned(SpinnerElement) then
begin
asm if (SpinnerElement.parentNode !== document.body) { document.body.appendChild(SpinnerElement); } end;
SpinnerElement.classList.remove('d-none');
SpinnerElement.classList.add('d-block');
SpinnerElement.classList.add('d-block','position-fixed','top-50','start-50','translate-middle');
SpinnerElement.style.setProperty('z-index','1065');
end;
document.body.setAttribute('aria-busy','true');
GIsBusy := True;
end;
procedure HideSpinner(SpinnerID: string);
var
SpinnerElement: TJSHTMLElement;
SpinnerElement, Overlay: TJSHTMLElement;
begin
SpinnerElement := TJSHTMLElement(document.getElementById(SpinnerID));
Overlay := TJSHTMLElement(document.getElementById('screenlock'));
if Assigned(SpinnerElement) then
begin
SpinnerElement.classList.remove('d-block');
SpinnerElement.classList.add('d-none');
end;
if Assigned(Overlay) then
begin
Overlay.classList.remove('d-block');
Overlay.classList.add('d-none');
end;
document.body.removeAttribute('aria-busy');
GIsBusy := False;
end;
function IsBusy: Boolean;
begin
Result := GIsBusy;
end;
procedure ShowErrorModal(msg: string);
begin
......
webEMIMobile/View.Complaints.dfm
......@@ -84,16 +84,15 @@ object FViewComplaints: TFViewComplaints
Style = lsListGroup
DataSource = wdsComplaints
ItemTemplate =
'<div class="list-section-header small fw-semibold bg-body-second' +
'ary text-dark rounded-1 px-2 mb-1"> (%DistrictHeader%)</div><di' +
'v class="card border shadow-sm" style="--bs-card-bg:(%Priori' +
'tyColor%); --bs-card-color:(%PriorityTextColor%);"> <div class=' +
'"card-body py-2 px-3"> <div class="fw-bold text-uppercase sma' +
'll">(%Priority%): (%DispatchCodeDesc%)</div> <div class="smal' +
'l">(%Address%)</div> <div class="small text-opacity-75">(%Com' +
'plaint%): (%Status%)&nbsp;&nbsp;(%DistrictSector%)</div> <div' +
' class="small text-opacity-75">(%DateReported%)</div> </div></d' +
'iv>'
'<div class="list-section-header small fw-semibold bg-secondary t' +
'ext-white rounded-1 px-2 mb-1"> (%DistrictHeader%)</div><div cl' +
'ass="card border shadow-sm" style="--bs-card-bg:(%PriorityCo' +
'lor%); --bs-card-color:(%PriorityTextColor%);"> <div class="car' +
'd-body py-2 px-3"> <div class="fw-bold text-uppercase small">' +
'(%Priority%): (%DispatchCodeDesc%)</div> <div class="small">(' +
'%Address%)</div> <div class="small text-opacity-75">(%Complai' +
'nt%): (%Status%)&nbsp;&nbsp;(%DistrictSector%)</div> <div cla' +
'ss="small text-opacity-75">(%DateReported%)</div> </div></div>'
ListSource = wdsComplaints
end
object xdwcComplaints: TXDataWebClient
......@@ -154,4 +153,10 @@ object FViewComplaints: TFViewComplaints
Left = 156
Top = 410
end
object tmrRefresh: TWebTimer
Interval = 30000
OnTimer = tmrRefreshTimer
Left = 164
Top = 44
end
end
webEMIMobile/View.Complaints.html
......@@ -60,4 +60,3 @@
</div>
</div>
webEMIMobile/View.Complaints.pas
......@@ -34,9 +34,12 @@ type
xdwdsComplaintsPriorityColor: TStringField;
xdwdsComplaintsPriorityTextColor: TStringField;
xdwdsComplaintsDistrictSector: TStringField;
tmrRefresh: TWebTimer;
procedure WebFormCreate(Sender: TObject);
procedure btnRefreshClick(Sender: TObject);
procedure tmrRefreshTimer(Sender: TObject);
private
FLoading: Boolean;
[async] procedure GetComplaints;
public
end;
......@@ -53,7 +56,10 @@ begin
console.log('WebFormCreate: Starting setup...');
DMConnection.ApiConnection.Connected := True;
console.log('API connection active:', DMConnection.ApiConnection.Connected);
ShowSpinner('spinner');
tmrRefresh.Enabled := False;
GetComplaints;
tmrRefresh.Enabled := True;
end;
......@@ -69,8 +75,11 @@ var
respObj: TJSObject;
complaintsCount: Integer;
begin
if FLoading then Exit;
FLoading := True;
console.log('GetComplaints: Invoking API...');
Utils.ShowSpinner('spinner');
try
try
......@@ -107,11 +116,18 @@ begin
end;
end;
finally
Utils.HideSpinner('spinner');
console.log('GetComplaints complete');
end;
HideSpinner('spinner');
end;
procedure TFViewComplaints.tmrRefreshTimer(Sender: TObject);
begin
GetComplaints;
console.log('tmrRefreshTimer fired');
end;
end.
webEMIMobile/View.Map.dfm
......@@ -82,11 +82,14 @@ object FViewMap: TFViewMap
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 = <>
......@@ -102,16 +105,30 @@ object FViewMap: TFViewMap
#39'_blank'#39'>OpenStreetMap</a>'
HeatMaps = <>
LocalFileAccess = True
TileLayers = <>
TileLayers = <
item
URL = 'https://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png'
Opacity = 1.000000000000000000
end>
ElementContainers = <>
HeadLinks = <>
end
end
object httpReqGeoJson: TWebHttpRequest
ResponseType = rtText
URL = 'assets/bpddistricts.geojson'
URL = 'assets/bpddistricts-updated.geojson'
OnResponse = httpReqGeoJsonResponse
Left = 114
Top = 696
end
object xdwcMap: TXDataWebClient
Connection = DMConnection.ApiConnection
Left = 232
Top = 696
end
object tmrRefresh: TWebTimer
Interval = 30000
Left = 358
Top = 696
end
end
webEMIMobile/View.Map.pas
......@@ -5,10 +5,10 @@ interface
uses
System.SysUtils, System.Classes, WEBLib.Graphics, WEBLib.Forms, WEBLib.Dialogs,
Vcl.Controls, Vcl.StdCtrls, WEBLib.StdCtrls, WEBLib.Controls, WEBLib.Grids,
WEBLib.ExtCtrls, DB, WEBLib.WebCtrls, WEBLib.REST,
VCL.TMSFNCTypes, VCL.TMSFNCUtils, VCL.TMSFNCGraphics, VCL.TMSFNCGraphicsTypes,
VCL.TMSFNCCustomControl, VCL.TMSFNCWebBrowser, VCL.TMSFNCMaps, VCL.TMSFNCLeaflet,
VCL.TMSFNCMapsCommonTypes;
WEBLib.ExtCtrls, DB, WEBLib.WebCtrls, WEBLib.REST, VCL.TMSFNCTypes, VCL.TMSFNCUtils,
VCL.TMSFNCGraphics, VCL.TMSFNCGraphicsTypes, VCL.TMSFNCCustomControl, VCL.TMSFNCWebBrowser,
VCL.TMSFNCMaps, VCL.TMSFNCLeaflet, VCL.TMSFNCMapsCommonTypes, System.StrUtils, XData.Web.Client,
XData.Web.Connection, ConnectionModule, Utils;
type
TFViewMap = class(TWebForm)
......@@ -21,15 +21,21 @@ type
pnlMap: TWebPanel;
lfMap: TTMSFNCLeaflet;
httpReqGeoJson: TWebHttpRequest;
xdwcMap: TXDataWebClient;
tmrRefresh: TWebTimer;
procedure lfMapMapInitialized(Sender: TObject);
procedure httpReqGeoJsonResponse(Sender: TObject; AResponse: string);
procedure httpReqGeoJsonError(Sender: TObject; AError: string);
[async] procedure httpReqGeoJsonResponse(Sender: TObject; AResponse: string);
procedure lfMapPolyElementMouseEnter(Sender: TObject; AElement: TTMSFNCMapsPolyElement);
procedure lfMapPolyElementMouseLeave(Sender: TObject; AElement: TTMSFNCMapsPolyElement);
procedure lfMapCustomizeMarker(Sender: TObject;
var ACustomizeMarker: string);
procedure lfMapCustomizeCSS(Sender: TObject; var ACustomizeCSS: string);
private
procedure StyleDistrictsAndFit;
procedure AssignDistrictNamesFromGeoJSON(const AJson: string);
FUnitsLoaded: Boolean;
FComplaintsLoaded: Boolean;
[async] procedure LoadPointsAsync;
function CarIconForDistrict(const DistrictCode: string): string;
public
end;
......@@ -45,175 +51,235 @@ uses
procedure TFViewMap.lfMapMapInitialized(Sender: TObject);
begin
httpReqGeoJson.Execute; // GET assets/bpddistricts.geojson as text
ShowSpinner('spinner');
FUnitsLoaded := False;
FComplaintsLoaded := False;
httpReqGeoJson.Execute;
end;
procedure TFViewMap.httpReqGeoJsonResponse(Sender: TObject; AResponse: string);
begin
lfMap.LoadGeoJSONFromText(AResponse, True, False);
AssignDistrictNamesFromGeoJSON(AResponse);
StyleDistrictsAndFit;
end;
procedure TFViewMap.httpReqGeoJsonError(Sender: TObject; AError: string);
begin
Console.Log('Failed to load bpddistricts.geojson: ' + AError);
end;
procedure TFViewMap.AssignDistrictNamesFromGeoJSON(const AJson: string);
[async] procedure TFViewMap.httpReqGeoJsonResponse(Sender: TObject; AResponse: string);
var
Root, Feature, Props, Geom: JS.TJSObject;
Features, Coords: JS.TJSArray;
f, count, i, polyIndex: Integer;
name, gtype: string;
i: Integer;
P: TTMSFNCMapsPolygon;
nm: string;
begin
Root := JS.TJSObject(JS.TJSJSON.parse(AJson));
Features := JS.TJSArray(Root['features']);
if Features = nil then Exit;
polyIndex := 0;
lfMap.BeginUpdate;
try
lfMap.Polygons.Clear;
for f := 0 to Features.Length - 1 do
begin
Feature := JS.TJSObject(Features[f]);
Props := JS.TJSObject(Feature['properties']);
Geom := JS.TJSObject(Feature['geometry']);
if (Props <> nil) and Props.hasOwnProperty('NAME') then
name := string(Props['NAME'])
else
name := '';
if Geom <> nil then
gtype := string(Geom['type'])
else
gtype := 'Polygon';
Console.Log('GeoJSON len=' + AResponse.Length.ToString);
lfMap.LoadGeoJSONFromText(AResponse, True, False);
Console.Log('Loaded polygons count=' + lfMap.Polygons.Count.ToString);
if SameText(gtype, 'Polygon') then
count := 1
else if SameText(gtype, 'MultiPolygon') then
for i := 0 to lfMap.Polygons.Count - 1 do
begin
Coords := JS.TJSArray(Geom['coordinates']); // array of polygons
if Coords <> nil then
count := Coords.Length
else
count := 1;
end
else
count := 1;
P := lfMap.Polygons[i];
// tag each created polygon with the district name
for i := 0 to count - 1 do
begin
if polyIndex < lfMap.Polygons.Count then
begin
lfMap.Polygons[polyIndex].DisplayName := name;
Inc(polyIndex);
case i of
0: begin
P.DisplayName := 'District A';
P.FillColor := HTMLToColor('#d3ffbe'); // light green
P.StrokeColor := HTMLToColor('#6ea85c'); // darker green
end;
1: begin
P.DisplayName := 'District B';
P.FillColor := HTMLToColor('#ffbebe'); // light red
P.StrokeColor := HTMLToColor('#b34a4a'); // darker red
end;
2: begin
P.DisplayName := 'District C';
P.FillColor := HTMLToColor('#ffd37f'); // light orange
P.StrokeColor := HTMLToColor('#b36e00'); // darker orange
end;
end;
procedure TFViewMap.StyleDistrictsAndFit;
function DistrictLetter(const S: string): Char;
var U: string; k: Integer;
begin
U := UpperCase(Trim(S));
// find last A..Z; works even if theres extra text/spacing
Result := #0;
for k := Length(U) downto 1 do
if (U[k] >= 'A') and (U[k] <= 'Z') then
begin
Result := U[k];
Break;
3: begin
P.DisplayName := 'District D';
P.FillColor := HTMLToColor('#bed2ff'); // light blue
P.StrokeColor := HTMLToColor('#3c5ca8'); // darker blue
end;
end;
procedure ApplyHardCodedColors(const P: TTMSFNCMapsPolygon);
var L: Char;
begin
L := DistrictLetter(P.DisplayName);
case L of
'A': begin P.FillColor := $FF60A5FA; P.StrokeColor := $FF1D4ED8; end; // blue
'B': begin P.FillColor := $FF34D399; P.StrokeColor := $FF047857; end; // emerald
'C': begin P.FillColor := $FFF59E0B; P.StrokeColor := $FFB45309; end; // amber
'D': begin P.FillColor := $FFF87171; P.StrokeColor := $FFB91C1C; end; // red
'E': begin P.FillColor := $FFA78BFA; P.StrokeColor := $FF6D28D9; end; // purple (north)
else
// fallback cycle if a name didnt come through
case (P.Index mod 5) of
0: begin P.FillColor := $FF60A5FA; P.StrokeColor := $FF1D4ED8; end;
1: begin P.FillColor := $FF34D399; P.StrokeColor := $FF047857; end;
2: begin P.FillColor := $FFF59E0B; P.StrokeColor := $FFB45309; end;
3: begin P.FillColor := $FFF87171; P.StrokeColor := $FFB91C1C; end;
else begin P.FillColor := $FFA78BFA; P.StrokeColor := $FF6D28D9; end;
4: begin
P.DisplayName := 'District E';
P.FillColor := HTMLToColor('#ffffbe'); // light yellow
P.StrokeColor := HTMLToColor('#a8a85c'); // darker yellow/olive
end;
end;
P.FillOpacity := 0.42; // bolder than before
P.FillOpacity := 0.60;
P.StrokeOpacity := 1.0;
P.StrokeWidth := 2;
end;
if lfMap.Polygons.Count > 0 then
lfMap.ZoomToBounds(lfMap.Polygons.ToCoordinateArray);
finally
lfMap.EndUpdate;
end;
await(LoadPointsAsync);
end;
function TFViewMap.CarIconForDistrict(const DistrictCode: string): string;
var
I, J: Integer;
P: TTMSFNCMapsPolygon;
C: TTMSFNCMapsCoordinates;
minLat, minLng, maxLat, maxLng, lat, lng: Double;
hasAny: Boolean;
B: TTMSFNCMapsBoundsRec;
U: string;
L: Char;
begin
if lfMap.Polygons.Count = 0 then Exit;
U := UpperCase(Trim(DistrictCode));
if U = '' then
Exit('assets/markers/car_X.png');
// Apply hard-coded district colors
for I := 0 to lfMap.Polygons.Count - 1 do
begin
P := lfMap.Polygons[I];
ApplyHardCodedColors(P);
L := U[1];
case L of
'A','B','C','D','E','X':
Result := 'assets/markers/car_' + L + '.png';
else
Result := 'assets/markers/default.png';
end;
end;
// Build bounds and zoom to fit
hasAny := False;
minLat := 90; minLng := 180;
maxLat := -90; maxLng := -180;
for I := 0 to lfMap.Polygons.Count - 1 do
[async] procedure TFViewMap.LoadPointsAsync;
var
resp: TXDataClientResponse;
root, item: TJSObject;
data: TJSArray;
i: Integer;
m: TTMSFNCMapsMarker;
lat, lng: Double;
uname, dist: string;
complaintId, codeDesc, dispatchDist: string;
pngName, iconUrl: string;
begin
ShowSpinner('spinner');
FUnitsLoaded := False;
FComplaintsLoaded := False;
try
resp := await(xdwcMap.RawInvokeAsync('IApiService.GetUnitMap', []));
root := TJSObject(resp.Result);
data := TJSArray(root['data']);
if data <> nil then
begin
P := lfMap.Polygons[I];
C := P.Coordinates;
if (C <> nil) and (C.Count > 0) then
for J := 0 to C.Count - 1 do
lfMap.BeginUpdate;
try
for i := 0 to data.Length - 1 do
begin
lat := C.Items[J].Latitude;
lng := C.Items[J].Longitude;
item := TJSObject(data[i]);
lat := Double(item['Lat']);
lng := Double(item['Lng']);
uname := string(item['UnitName']);
dist := string(item['District']);
m := lfMap.Markers.Add;
m.Latitude := lat;
m.Longitude := lng;
m.Title := uname + IfThen(dist <> '', ' / ' + dist, '');
m.DataString := 'unit';
m.IconURL := CarIconForDistrict(dist);
if not hasAny then
begin
minLat := lat; maxLat := lat;
minLng := lng; maxLng := lng;
hasAny := True;
end
else
begin
if lat < minLat then minLat := lat;
if lat > maxLat then maxLat := lat;
if lng < minLng then minLng := lng;
if lng > maxLng then maxLng := lng;
end;
finally
lfMap.EndUpdate;
end;
end;
FUnitsLoaded := True;
except
on E: EXDataClientRequestException do
Console.Log('Units XData error: ' + E.ErrorResult.ErrorMessage);
end;
if hasAny then
try
resp := await(xdwcMap.RawInvokeAsync('IApiService.GetComplaintMap', []));
root := TJSObject(resp.Result);
data := TJSArray(root['data']);
if data <> nil then
begin
lfMap.BeginUpdate;
try
for i := 0 to data.Length - 1 do
begin
B.SouthWest.Latitude := minLat;
B.SouthWest.Longitude := minLng;
B.NorthEast.Latitude := maxLat;
B.NorthEast.Longitude := maxLng;
lfMap.ZoomToBounds(B);
item := TJSObject(data[i]);
complaintId := string(item['ComplaintId']);
codeDesc := string(item['DispatchCodeDesc']);
dispatchDist := string(item['DispatchDistrict']);
lat := Double(item['Lat']);
lng := Double(item['Lng']);
if ((lat = 0) and (lng = 0)) or (Abs(lat) > 90) or (Abs(lng) > 180) then
Continue;
pngName := string(item['pngName']);
if Trim(pngName) <> '' then
iconUrl := 'assets/markers/' + pngName
else
iconUrl := 'assets/markers/default.png';
m := lfMap.Markers.Add;
m.Latitude := lat;
m.Longitude := lng;
m.Title := Format('%s %s (%s)', [complaintId, codeDesc, dispatchDist]);
m.DataString := 'complaint|' + complaintId;
m.IconURL := iconUrl;
end;
finally
lfMap.EndUpdate;
end;
end;
FComplaintsLoaded := True;
except
on E: EXDataClientRequestException do
Console.Log('Complaints XData error: ' + E.ErrorResult.ErrorMessage);
end;
// if FUnitsLoaded and FComplaintsLoaded then
// FitBoundsPolysAndMarkers;
HideSpinner('spinner');
end;
procedure TFViewMap.lfMapCustomizeMarker(Sender: TObject; var ACustomizeMarker: string);
begin
ACustomizeMarker :=
'var m=' + MARKERVAR + ', o=m.options||{};' + #13#10 +
'if (o.icon && o.icon.options && o.icon.options.iconUrl) {' + #13#10 +
' var u = o.icon.options.iconUrl;' + #13#10 +
' m.setIcon(L.icon({' + #13#10 +
' iconUrl: u,' + #13#10 +
' iconSize: [32,32],' + #13#10 +
' iconAnchor: [16,32],' + #13#10 +
' popupAnchor: [0,-20]' + #13#10 +
' }));' + #13#10 +
'}' + #13#10 +
'var t = (o && o.title) ? o.title : "";' + #13#10 +
'try { m.unbindTooltip(); } catch(e) {}' + #13#10 +
'm.bindTooltip(t, {' + #13#10 +
' className: "emi-tip",' + #13#10 +
' direction: "top",' + #13#10 +
' offset: [0,-28],' + #13#10 +
' sticky: true' + #13#10 +
'});';
end;
procedure TFViewMap.lfMapCustomizeCSS(Sender: TObject; var ACustomizeCSS: string);
begin
ACustomizeCSS :=
'.leaflet-tooltip.emi-tip {' + #13#10 +
' background: #111;' + #13#10 +
' color: #fff;' + #13#10 +
' border-radius: 6px;' + #13#10 +
' padding: 6px 8px;' + #13#10 +
' border: 1px solid rgba(255,255,255,.15);' + #13#10 +
' box-shadow: 0 4px 14px rgba(0,0,0,.35);' + #13#10 +
' font: 500 12px/1.2 system-ui, Segoe UI, Roboto, sans-serif;' + #13#10 +
'}' + #13#10 +
'.leaflet-tooltip-top.emi-tip:before { border-top-color: #111; }' + #13#10 +
'.leaflet-tooltip-bottom.emi-tip:before { border-bottom-color: #111; }' + #13#10 +
'.leaflet-tooltip-left.emi-tip:before { border-left-color: #111; }' + #13#10 +
'.leaflet-tooltip-right.emi-tip:before { border-right-color: #111; }';
end;
procedure TFViewMap.lfMapPolyElementMouseEnter(Sender: TObject; AElement: TTMSFNCMapsPolyElement);
begin
if AElement is TTMSFNCMapsPolygon then
......@@ -223,6 +289,7 @@ begin
end;
end;
procedure TFViewMap.lfMapPolyElementMouseLeave(Sender: TObject; AElement: TTMSFNCMapsPolyElement);
begin
if AElement is TTMSFNCMapsPolygon then
......
webEMIMobile/View.Units.dfm
object FViewUnits: TFViewUnits
Width = 359
Height = 480
ElementFont = efCSS
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
......@@ -38,15 +39,23 @@ object FViewUnits: TFViewUnits
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"> (%DistrictHeader%)</div><di' +
'v class="card border shadow-sm"> <div class="card-body py-2 px-' +
'3"> <div class="d-flex justify-content-between align-items-ba' +
'seline"> <div class="fw-bold fs-6">(%UnitName%)</div> ' +
'<div class="small text-end text-body-secondary ms-3 text-truncat' +
'e">(%Location%)</div> </div> <div class="small">(%Status%)' +
'</div> <div class="small">(%Officer1%)</div> <div class="s' +
'mall">(%Officer2%)</div> </div></div>'
'<div class="list-section-header small fw-semibold bg-body-secon' +
'dary text-dark rounded-1 px-2 mb-1"> (%DistrictHeader%)</div><d' +
'iv class="card border shadow-sm position-relative"> <div class=' +
'"card-body py-2 px-3"> <!-- Unit + Status --> <div class="' +
'fw-bold text-uppercase small"> (%UnitName%)&nbsp;-&nbsp;(%S' +
'tatus%) </div> <!-- Location --> <div class="small text' +
'-body-secondary mb-1"> (%Location%) </div> <!-- Call ' +
'type --> <div class="small">(%CallType%)</div> <!-- Divide' +
'r line (we'#39'll auto-hide if no officers) --> <hr class="unit-d' +
'ivider my-1" style="width: 80px; margin-left: 0;"> <!-- Offic' +
'ers --> <div class="small officer1">(%Officer1%)</div> <di' +
'v class="small officer2">(%Officer2%)</div> </div> <!-- Floati' +
'ng details button (solid, info icon) --> <div class="position-a' +
'bsolute top-50 end-0 translate-middle-y pe-2"> <button class=' +
'"btn btn-secondary btn-sm btn-unit-details" data-unit' +
'id="(%UnitId%)"> <i class="fa fa-info"></i> </button> <' +
'/div></div>'
ListSource = wdsUnits
end
object btnRefresh: TWebButton
......@@ -123,10 +132,19 @@ object FViewUnits: TFViewUnits
object xdwdsUnitsOfficer2: TStringField
FieldName = 'Officer2'
end
object xdwdsUnitsCallType: TStringField
FieldName = 'CallType'
end
end
object xdwcUnits: TXDataWebClient
Connection = DMConnection.ApiConnection
Left = 58
Top = 410
end
object tmrRefresh: TWebTimer
Interval = 30000
OnTimer = tmrRefreshTimer
Left = 172
Top = 22
end
end
webEMIMobile/View.Units.pas
......@@ -27,9 +27,13 @@ type
xdwdsUnitsStatus: TStringField;
xdwdsUnitsOfficer1: TStringField;
xdwdsUnitsOfficer2: TStringField;
xdwdsUnitsCallType: TStringField;
tmrRefresh: TWebTimer;
procedure WebFormCreate(Sender: TObject);
procedure btnRefreshClick(Sender: TObject);
procedure tmrRefreshTimer(Sender: TObject);
private
FLoading: Boolean;
[async] procedure GetUnits;
public
......@@ -43,14 +47,36 @@ implementation
{$R *.dfm}
procedure TFViewUnits.WebFormCreate(Sender: TObject);
begin
console.log('Units.WebFormCreate: Starting setup...');
DMConnection.ApiConnection.Connected := True;
console.log('API connection active:', DMConnection.ApiConnection.Connected);
tmrRefresh.Enabled := False;
GetUnits;
tmrRefresh.Enabled := True;
{$IFNDEF WIN32}
asm
var root = pas.TFViewUnits(Self).dblUnitsList.ElementHandle;
if (root && !root.__emiDelegated) {
root.__emiDelegated = true;
root.addEventListener('click', function (e) {
// Look for a click on, or inside, the details button
var btn = e.target && e.target.closest('.btn-unit-details');
if (!btn || !root.contains(btn)) return;
e.preventDefault();
e.stopPropagation();
var unitId = btn.getAttribute('data-unitid') || '';
pas.TFViewUnits(Self).OpenUnitDetails(unitId);
}, { passive: true });
}
end;
{$ENDIF}
end;
procedure TFViewUnits.btnRefreshClick(Sender: TObject);
......@@ -64,6 +90,9 @@ var
respObj: TJSObject;
unitCount: Integer;
begin
if FLoading then Exit;
FLoading := True;
console.log('GetUnits: Invoking API...');
Utils.ShowSpinner('spinner');
try
......@@ -98,5 +127,10 @@ begin
end;
end;
procedure TFViewUnits.tmrRefreshTimer(Sender: TObject);
begin
GetUnits;
end;
end.
webEMIMobile/css/app.css
......@@ -158,3 +158,4 @@ span.card {
webEMIMobile/index.html
......@@ -6,7 +6,7 @@
<noscript>Your browser does not support JavaScript!</noscript>
<link href="data:;base64,=" rel="icon"/>
<title>emiMobile</title>
<link href="css/spinner.css" rel="stylesheet" type="text/css"/>
<!-- jQuery -->
<script crossorigin="anonymous" integrity="sha256-9/aliU8dGd2tb6OSsuzixeV4y/faTqgFtohetphbbj0=" src="https://code.jquery.com/jquery-3.5.1.min.js" type="text/javascript"></script>
......@@ -19,17 +19,13 @@
<script src="https://cdn.jsdelivr.net/npm/bootstrap@5.3.7/dist/js/bootstrap.bundle.min.js" type="text/javascript"></script>
<link crossorigin="anonymous" href="https://cdn.jsdelivr.net/npm/bootstrap@5.3.7/dist/css/bootstrap.min.css" rel="stylesheet"/>
<!-- Leaflet -->
<script src="https://unpkg.com/leaflet@1.7.1/dist/leaflet.js" type="text/javascript"></script>
<link href="https://unpkg.com/leaflet@1.7.1/dist/leaflet.css" rel="stylesheet"/>
<!-- App bundle -->
<!-- App -->
<script src="$(ProjectName).js" type="text/javascript"></script>
<!-- App styles -->
<style></style>
<link href="css/app.css" rel="stylesheet"/>
<link href="css/spinner.css" rel="stylesheet" type="text/css"/>
</head>
<body>
<script type="text/javascript">rtl.run();</script>
......
webEMIMobile/webEmiMobile.dproj
......@@ -97,6 +97,7 @@
<TMSWebSingleInstance>1</TMSWebSingleInstance>
<TMSUseJSDebugger>2</TMSUseJSDebugger>
<VerInfo_Release>3</VerInfo_Release>
<TMSWebBrowser>3</TMSWebBrowser>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
......
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