{$mode objfpc}{$H+} unit mainform; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Menus, ExtCtrls, StdCtrls, ComCtrls, TGClasses, Globe4, TGSysUtils, GlobeUtils, TGPresenters, TGObjects, ImgList, uHCTypeDefs, uHCDefines, uHCUtils, uHCGCI, uCICG4Presenters, uGroupTypes, uGroupIcon, uArrows, uRangeRings, uJamming, uZoneLabels, uTracks, uWaypointDrag, uUncertainty, uGroupSnapshot, uThreadComm, uMapSettings, uMapConfig, // CC 20260922 gMapSettings uFormationMath, uFormationOverlay, uFormationEditor // CC 20260924 formation edit (phase 1) ; const // CC 20260924 formation edit: how often edit mode checks for a paused game, and // how long without a new snapshot generation counts as paused (HC doesn't call // GameTime while paused, so captures simply stop) TIMER_PAUSE_CHECK = 2; PAUSE_CHECK_MS = 500; PAUSE_DETECT_MS = 1500; // CC 20260924 fraction of the smaller globe dimension the outermost ring's // diameter fills when edit mode zooms to the formation FORMATION_FIT_FRACTION = 0.8; type // CC 20260924 phase 3: a station the user dragged, in the ring sizes it was // placed against (rescaled if the rings change before Apply, as the GE does) TStagedStation = record UUID: string; HasMove: Boolean; // dragged to XOff/YOff (placed against Zones) XOff, YOff: LongInt; Zones: TFormationZones; HasArea: Boolean; // Shift+click area; else the position's own cell Rings, Sectors: UInt64; end; // CC 20260924 a formation patrol's staged area (Shift/Ctrl+click) TStagedPatrol = record EventUUID: string; Rings, Sectors: UInt64; end; // CC 20260924 phase 4: a patrol created in the editor, not yet applied TNewPatrol = record TempUUID: string; // 'new-...' until HC gives it a real event AssetUUID, OwnerUnitUUID: string; PlaneID, LoadID: Word; PatrolType: ShortInt; Number: Byte; Rings, Sectors: UInt64; end; TStationDragState = record Active: Boolean; Moved: Boolean; // CC 20260924 only a real drag moves the station StartX, StartY: Integer; UUID: string; HadEntry: Boolean; // restore on Esc Prev: TStagedStation; end; { TfrmMain } TfrmMain = class(TForm) PageControl1: TPageControl; pnlSelected: TPanel; tshTGlobe4: TTabSheet; pnlTG4Upper: TPanel; pnlTG4Lower: TPanel; AdvSplitter1: TSplitter; glbMap: TGlobe4; pnlPosition: TPanel; pnlDistance: TPanel; lblGameTime: TLabel; btnZoomIn: TButton; btnZoomOut: TButton; icons: TImageList; pnlVisibility: TPanel; rgVisibility: TRadioGroup; btnSettings: TButton; pmGlobe: TPopupMenu; miAddCoursepoint: TMenuItem; miInsertCoursepoint: TMenuItem; miDeleteCoursepoint: TMenuItem; miClearCourse: TMenuItem; miEditFormation: TMenuItem; // CC 20260924 procedure btnSettingsClick(Sender: TObject); procedure miEditFormationClick(Sender: TObject); // CC 20260924 procedure miAddCoursepointClick(Sender: TObject); procedure miInsertCoursepointClick(Sender: TObject); procedure miDeleteCoursepointClick(Sender: TObject); procedure miClearCourseClick(Sender: TObject); procedure glbMapMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure glbMapClick(Sender: TObject); procedure glbMapObjectSelectChange(Sender: TGlobe4; GlobeObject: TGlobeObject); procedure btnZoomInClick(Sender: TObject); procedure btnZoomOutClick(Sender: TObject); procedure ima(Sender: TObject); procedure glbMapMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); procedure glbMapMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); procedure rgVisibilityClick(Sender: TObject); // CC 20260922 procedure glbMapMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); // CC 20260313 procedure glbMapMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); // CC 20260313 procedure glbMapKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); // CC 20260313 private { Private declarations } procedure AppendCoursepoint(X, Y: Integer); // CC 20260314 procedure InsertCoursepoint(X, Y: Integer); // CC 20260316 procedure HitTestWaypointDot(X, Y: Integer); // CC 20260316 procedure WMApplySnapshot(var Msg: TMessage); message WM_APPLY_SNAPSHOT; // CC 20260323 procedure WMApplyChunk(var Msg: TMessage); message WM_APPLY_CHUNK; // CC 20260323 procedure WMScenLoad(var Msg: TMessage); message WM_SCEN_LOAD; // CC 20260323 procedure WMShowForm(var Msg: TMessage); message WM_SHOW_FORM; // CC 20260323 procedure WMTimer(var Msg: TMessage); message WM_TIMER; // CC 20260323 procedure StartBatch; // CC 20260922 kick off chunked apply of FPendingSnap procedure SyncControlsFromSettings; // CC 20260922 gMapSettings -> main-panel controls procedure MapSettingsChanged(Sender: TObject); // CC 20260922 settings dialog callback // CC 20260924 formation edit mode (phase 1, read-only) procedure EnterFormationEdit(const aUUID: string); procedure ExitFormationEdit(aReapply: Boolean); procedure ApplyFocusSnapshot(const snap: TGroupSnapshot); procedure FitFormationZoom(const snap: TGroupSnapshot); procedure UpdatePausedState; procedure FormationEditorClosed(Sender: TObject); procedure FormationStagedChanged(Sender: TObject); // CC 20260924 phase 2 procedure FormationRevert(Sender: TObject); // CC 20260924 phase 3 function FindStagedStation(const aUUID: string): Integer; function TargetZones(const snap: TGroupSnapshot): TFormationZones; procedure ClearStagedStations; procedure PruneStaged(const snap: TGroupSnapshot); // CC 20260924 review function StationDragMove(X, Y: Integer): Boolean; function EditSelectedArea(X, Y: Integer; aReset: Boolean): Boolean; // CC 20260924 Shift/Ctrl+click function AnyStaged: Boolean; procedure FormationAddPatrol(Sender: TObject; const aAssetUUID: string; aPatrolType: ShortInt; aCount: Integer); // CC 20260924 phase 4 procedure FormationCancelPatrol(Sender: TObject; const aPatrolUUID: string); function FindNewPatrol(const aUUID: string): Integer; function CancelStagedIdx(const aUUID: string): Integer; procedure FormationApply(Sender: TObject); function StagedFocusView(const snap: TGroupSnapshot): TGroupSnapshot; procedure FormationEditorSelect(Sender: TObject; aKind: TFormationItemKind; const aUUID: string); function CanEditFormation(pEntry: PGroupMapEntry): Boolean; public { Public declarations } FGroupMap: TStringList; // CC 20260311 UUID -> PGroupMapEntry, Sorted FPendingSnap: TGameTimeSnapshot; // CC 20260323 snapshot being processed in chunks FChunkGen: LongInt; // CC 20260323 generation of snapshot being chunked FBatchID: LongInt; // CC 20260323 batch counter — prevents stale chunk messages FBatchInProgress: Boolean; // CC 20260323 true while chunks are being processed FReapplyPending: Boolean; // CC 20260922 reapply requested mid-batch; run when batch ends FSyncingControls: Boolean; // CC 20260922 suppress click handlers while syncing controls FDragState: TWaypointDragState; // CC 20260313 waypoint drag state FAddingCoursepoint: Boolean; // CC 20260314 FInsertingCoursepoint: Boolean; // CC 20260316 FInsertWaypointIdx: Integer; // CC 20260323 waypoint chain index for insert/delete FInsertGroupUUID: string; // CC 20260323 group UUID for insert/delete FInsertIsLastWaypoint: Boolean; // CC 20260323 whether hit waypoint is last in chain ptLast, ptClick, ptPrevClick: TPointLL; // CC 20260924 formation edit mode state; FFocusUUID = '' when not editing FFocusUUID: string; // group being edited (also the capture focus) FOverlay: TFormationOverlay; // created lazily on first entry, freed in FormDestroy FFocusSeen: Boolean; // focus group applied in the current batch FFocusSnap: TGroupSnapshot; // last applied snapshot of the focus group FStagedStations: array of TStagedStation; // CC 20260924 phase 3 FStagedPatrols: array of TStagedPatrol; FNewPatrols: array of TNewPatrol; // CC 20260924 phase 4 FCancelPatrols: array of string; // patrol event UUIDs to cancel FStationDrag: TStationDragState; FFormSelKind: TFormationItemKind; // CC 20260924 selection in formation edit FFormSelUUID: string; FHaveFocusSnap: Boolean; FFocusZoomPending: Boolean; // re-fit once the first focus capture shows populated rings FFocusZoomNM: Integer; // outer ring radius the last fit used FPauseGen: LongInt; // last gSnapshotGeneration seen by the pause check FPauseTick: QWord; // when it last changed FGamePaused: Boolean; FMenuGroupUUID: string; // group icon the context menu was opened on procedure AddGroupFromSnapshot(const snap: TGroupSnapshot; const pShowing: uchar); procedure UpdateGroupFromSnapshot(pEntry: PGroupMapEntry; const snap: TGroupSnapshot; const pShowing: uchar); function RangeRingsEnabled(ringIdx: Integer; const ASide: uchar): Boolean; function FormationZonesVisible(const AUUID: string; const AActualSide: uchar): Boolean; // CC 20260924 function DrawnRingsMask(const snap: TGroupSnapshot): UInt64; // CC 20260924 function GetIcon(const ASide: uchar; const SSide, UType: string): string; procedure LoadIcons(); procedure ClearGroups(pLayer: TGlobeLayer); procedure RemoveGroupEntry(pEntry: PGroupMapEntry); procedure DropPointerModes; // CC 20260922 function FocusDispSide(const snap: TGroupSnapshot): uchar; // CC 20260924 procedure ZoomChanged(Sender: TObject); // CC 20260924 procedure ClearAllGroups; function GroupCourseVisible(pEntry: PGroupMapEntry): Boolean; // CC 20260323 no PHCGroup param procedure ReapplyLastSnapshot; // CC 20260922 re-render last snapshot after a settings change end; var frmMain: TfrmMain; layGroups: TGlobeLayer; layArrows: TGlobeLayer; // CC 20260311 Enabled=False so arrows render but are not hit-testable layRangeRings: TGlobeLayer; // CC 20260312 Enabled=False, weapon range circles layTracks: TGlobeLayer; // CC 20260313 Enabled=False, planned course polylines layUncertainty: TGlobeLayer; // CC 20260322 uncertainty diamond outlines layFormationZones: TGlobeLayer; // CC 20260921 Enabled=False, black formation zone circles layJamming: TGlobeLayer; // CC 20260921 Enabled=False, jamming lightning bolts layWorldOutline: TGlobeLayer; intObjects: integer; strUnitSel: string; intIDSel: integer; gSelectedGroupUUID: string; // CC 20260313 UUID of currently selected group icon implementation {$R *.lfm} // CC 20260924 phase 3: defined with the formation staging code below function CanDragStation(const snap: TGroupSnapshot; const u: TUnitSnapshot): Boolean; forward; {$IFDEF DEBUG} var gLogFile: TextFile; gLogOpen: Boolean = False; // CC 20260323 lightweight file-based metrics logging — no HC callback dependency procedure LogMetrics(const aMsg: string); begin if not gLogOpen then begin AssignFile(gLogFile, ExtractFilePath(gDLLPathFileName) + 'MapWindow_metrics.log'); Rewrite(gLogFile); gLogOpen := True; end; WriteLn(gLogFile, FormatDateTime('hh:nn:ss.zzz', Now) + ' ' + aMsg); Flush(gLogFile); end; {$ENDIF} // CC 20260402 return the range value (NM) for a given ring type index from snapshot function SnapRingRange(const snap: TGroupSnapshot; ringIdx: Integer): SmallInt; begin case ringIdx of RING_ASuW: Result := snap.BestWeaponsRange[0]; RING_AAW: Result := snap.BestWeaponsRange[1]; RING_SURF_RADAR: Result := snap.BestSensorRange[1]; // HC uses BestSensorRange[BEST_AAW_WEAPON] RING_AIR_RADAR: Result := snap.BestSensorRange[0]; // HC uses BestSensorRange[0] RING_AIR_RANGE: Result := snap.AirRangeNM; // CC 20260403 from HCGetAirborneEndurance RING_BINGO: Result := snap.BingoRangeNM; // CC 20260403 bingo-adjusted range else Result := 0; end; end; // CC 20260922 group display position: the uncertainty-diamond centre when the // group is only known approximately, otherwise its exact position function SnapCenterPos(const snap: TGroupSnapshot; const pShowing: uchar; out oIsUncertain: Boolean; out oRegion: URegion): TPointLL; var i: Integer; begin oIsUncertain := ((pShowing and ShowUncertain) <> 0) and ((pShowing and ShowExact) = 0) and snap.HasUncertainty; if oIsUncertain then begin for i := 0 to 3 do begin oRegion.sLon[i] := snap.UncertSLon[i]; oRegion.sLat[i] := snap.UncertSLat[i]; end; Result := UncertaintyCenter(@oRegion); end else Result := PointLLH( DecimalToGlobeUnits(HCLon2Deg(snap.sLon)), DecimalToGlobeUnits(HCLat2Deg(snap.sLat)), GlobeUnitsFrom(0.1, Mile)); end; function TfrmMain.RangeRingsEnabled(ringIdx: Integer; const ASide: uchar): Boolean; begin if (ringIdx >= 0) and (ringIdx < RING_COUNT) and (ASide <= 3) then Result := gMapSettings.RangeCircles[ringIdx, ASide] // CC 20260922 else Result := False; end; function TfrmMain.GetIcon(const ASide: uchar; const SSide, UType: string): string; begin if (UType = 'S') or (UType = 'C') or (UType = 'U') or (UType = 'A') or (UType = 'H') or (UType = 'M') or (UType = 'T') or (UType = 'N') or (UType = 'R') then result := UType else if (UType = 'p') or (UType = 'a') or (UType = 'c') or (UType = 's') or (UType = 'b') or (UType = 'm') or (UType = 'o') or (UType = 'r') then result := 'L' + UType; if ASide = BLUESIDE then result := result + 'B.bmp' else if ASide = REDSIDE then result := result + 'R.bmp' else if ASide = GREENSIDE then result := result + 'N.bmp' else if ASide = UNKNOWNSIDE then result := result + 'U.bmp' else result := 'BB61.bmp'; end; // CC 20260921 formation zones expose own-force disposition, so in Player mode // they are restricted to the player's own side the same way courses are function TfrmMain.FormationZonesVisible(const AUUID: string; const AActualSide: uchar): Boolean; begin // CC 20260924 the group being formation-edited always shows its rings (entry // already applied the Player/God side rule) if (FFocusUUID <> '') and (AUUID = FFocusUUID) then Exit(True); // CC 20260924 None / Selected Group / All Groups case gMapSettings.FormationZoneMode of ZONES_SELECTED: Result := AUUID = gSelectedGroupUUID; ZONES_ALL: Result := True; else Result := False; end; Result := Result and ((gMapSettings.VisibilityMode = VIS_GOD) or (AActualSide = gSide)); end; // CC 20260924 extended rings (decision 7): bit i set when ring i should be drawn, // i.e. it is enabled (part of the unbroken increasing run from Main Body) or // populated (a unit or patrol of the focus group has the ring bit; only known // when snap.IsFocus), and its radius is above zero function TfrmMain.DrawnRingsMask(const snap: TGroupSnapshot): UInt64; var i: Integer; lPopulated: UInt64; begin lPopulated := 0; if snap.IsFocus then begin for i := 0 to Length(snap.Units) - 1 do lPopulated := lPopulated or snap.Units[i].Rings; for i := 0 to Length(snap.Patrols) - 1 do lPopulated := lPopulated or snap.Patrols[i].Rings; end; Result := EnabledRingsMask(snap.Zones) or lPopulated; for i := 0 to MAX_FORMATION_ZONES - 1 do if snap.Zones[i] <= 0 then Result := Result and not (UInt64(1) shl i); end; // CC 20260402 open settings dialog (non-modal singleton) // CC 20260921 now a paged dialog: Range Rings + Overlays procedure TfrmMain.btnSettingsClick(Sender: TObject); begin if frmMapSettings = nil then frmMapSettings := TfrmMapSettings.Create(Self); frmMapSettings.OnSettingsChanged := @MapSettingsChanged; // CC 20260922 frmMapSettings.LoadFromGlobal; frmMapSettings.Show; frmMapSettings.BringToFront; end; procedure TfrmMain.btnZoomInClick(Sender: TObject); begin with glbMap.Projection do ScaleFactor := ScaleFactor * 1.2; ZoomChanged(Sender); // CC 20260924 end; procedure TfrmMain.btnZoomOutClick(Sender: TObject); begin with glbMap.Projection do ScaleFactor := ScaleFactor / 1.2; ZoomChanged(Sender); // CC 20260924 end; procedure TfrmMain.ClearGroups(pLayer: TGlobeLayer); var lC: NativeInt; begin // ALE 20220822 just clearing the layer doesn't free image resources // so we have to do it 'manually' for lC := pLayer.Presenters.Count - 1 downto 0 do begin TPointPresenter(pLayer.Presenters[lC]).Image.Free; end; pLayer.Clear; end; procedure TfrmMain.FormCreate(Sender: TObject); var lLayerID: Integer; begin //frmMain.Caption := frmMain.Caption + ' ' + GetVersion; glbMap.Projection.Altitude := 0; { Zoom out to globe extents } lLayerID := CreateFileLayer(glbMap, ExtractFilePath(gDLLPathFileName) + 'MapWindow\TGWorld.lyr' ); // CC 20260923 a missing TGWorld.lyr means no world outline, not a nil dereference // (the file lives in MapWindow\ next to the DLL, so a DLL deployed elsewhere lacks it) if lLayerID <> -1 then begin layWorldOutline := glbMap.Layers.LayerObjects[lLayerID]; //layWorldOutline.Visible := False; layWorldOutline.Enabled := False; // ALE 20220707 can't select layer end; //ShowMessage('Presenters: ' + IntToStr(layWorldOutline.Presenters.Count) + ' Objects: ' + IntToStr(layWorldOutline.Objects.Count)); // CC 20260313 GlobalPresenters[0]=TPointPresenter (no poly props), [1]=TPolyPresenter if glbMap.Layers.GlobalPresenters.Count > 1 then begin TPolyPresenter(glbMap.Layers.GlobalPresenters.Presenters[1]).PolyBrush.BrushColor := clWhite; TPolyPresenter(glbMap.Layers.GlobalPresenters.Presenters[1]).PolyBrush.BrushBkColor := clWhite; TPolyPresenter(glbMap.Layers.GlobalPresenters.Presenters[1]).PolyPen.PenColor := clWhite; end; layGroups := TGlobeLayer.Create(glbMap); layGroups.Name := 'Groups'; layArrows := TGlobeLayer.Create(glbMap); layArrows.Name := 'Arrows'; layArrows.Enabled := False; // CC 20260311 render-only; not hit-testable layRangeRings := TGlobeLayer.Create(glbMap); layRangeRings.Name := 'RangeRings'; layRangeRings.Enabled := False; // CC 20260312 render-only; not hit-testable layTracks := TGlobeLayer.Create(glbMap); layTracks.Name := 'Tracks'; layTracks.Enabled := False; // CC 20260313 render-only; not hit-testable layUncertainty := TGlobeLayer.Create(glbMap); layUncertainty.Name := 'Uncertainty'; layUncertainty.Enabled := False; // CC 20260322 render-only; not hit-testable layFormationZones := TGlobeLayer.Create(glbMap); layFormationZones.Name := 'FormationZones'; layFormationZones.Enabled := False; // CC 20260921 render-only; not hit-testable layJamming := TGlobeLayer.Create(glbMap); layJamming.Name := 'Jamming'; layJamming.Enabled := False; // CC 20260921 render-only; not hit-testable // CC 20260922 load persisted settings, then mirror them into the main-panel controls LoadMapSettings; SyncControlsFromSettings; // CC 20260311 group persistence map FGroupMap := TStringList.Create; FGroupMap.Sorted := True; // CC 20260313 init drag state FDragState.Active := False; FAddingCoursepoint := False; // CC 20260314 FInsertingCoursepoint := False; // CC 20260316 FInsertWaypointIdx := -1; // CC 20260323 FInsertGroupUUID := ''; // CC 20260323 FInsertIsLastWaypoint := False; // CC 20260323 // CC 20260924 formation edit mode off; the overlay is created on first entry // so its layer comes after (draws on top of) the layers above FFocusUUID := ''; FOverlay := nil; FMenuGroupUUID := ''; LoadIcons; // CC 20260924 zoom rectangle reports here; the zoom buttons call ZoomChanged directly glbMap.OnZoomed := @ZoomChanged; end; procedure TfrmMain.FormDestroy(Sender: TObject); var lC: Integer; begin SaveMapSettings; // CC 20260922 // CC 20260924 leave formation edit mode. The editor is freed first rather than // closed (no message loop is left to run a caFree Release), and the overlay // must be freed while the globe still exists if frmFormationEditor <> nil then begin frmFormationEditor.OnEditorClosed := nil; frmFormationEditor.OnSelectItem := nil; frmFormationEditor.Free; frmFormationEditor := nil; end; ExitFormationEdit(False); FreeAndNil(FOverlay); // CC 20260311 free all group map entries before freeing the list for lC := 0 to FGroupMap.Count - 1 do Dispose(PGroupMapEntry(FGroupMap.Objects[lC])); FGroupMap.Free; // CC 20260323 close metrics log {$IFDEF DEBUG} if gLogOpen then begin CloseFile(gLogFile); gLogOpen := False; end; {$ENDIF} end; procedure TfrmMain.glbMapClick(Sender: TObject); begin ptPrevClick := ptClick; ptClick := ptLast; if GlobeUnitsTo(EllipsoidDistanceLLToLL(ptPrevClick, ptClick, glbMap.Projection.Spheroid), NauticalMile) < 10 then begin if GlobeUnitsTo(EllipsoidDistanceLLToLL(ptPrevClick, ptClick, glbMap.Projection.Spheroid), Meter) < 10 then begin // centimeters pnlDistance.Caption := Format('%0.2f', [GlobeUnitsTo(EllipsoidDistanceLLToLL(ptPrevClick, ptClick, glbMap.Projection.Spheroid), Centimeter)]) + ' CM'; end else begin // meters pnlDistance.Caption := Format('%0.2f', [GlobeUnitsTo(EllipsoidDistanceLLToLL(ptPrevClick, ptClick, glbMap.Projection.Spheroid), Meter)]) + ' M'; end; end else begin // nautical miles pnlDistance.Caption := Format('%0.2f', [GlobeUnitsTo(EllipsoidDistanceLLToLL(ptPrevClick, ptClick, glbMap.Projection.Spheroid), NauticalMile)]) + ' NM'; end; end; procedure TfrmMain.glbMapMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var sTmp : string; pt : TPointLL; MouseObj : TGlobeObject; begin // CC 20260313 live drag of waypoint dot if FDragState.Active then begin WaypointDragMove(glbMap, layTracks, X, Y, FDragState); Exit; end; // CC 20260924 phase 3: live drag of a formation station if StationDragMove(X, Y) then Exit; with glbMap do begin Projection.DeviceXYToLL( X, Y, pt ); ptLast := pt; with pt do sTmp := GlobeUnitsToStr( iLongX, '%d.%m.%s.%t%E ' ) + GlobeUnitsToStr( iLatY, '%d.%m.%s.%t%N' ); MouseObj := Layers.ObjectAtXY( X, Y ); if MouseObj <> nil then sTmp := sTmp + ' ' + MouseObj.Title; pnlPosition.Caption := Format( ' Mouse Position: %s', [sTmp] ); end; end; procedure TfrmMain.glbMapMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); begin btnZoomOut.Click; end; procedure TfrmMain.glbMapMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); begin btnZoomIn.Click; end; procedure TfrmMain.glbMapObjectSelectChange(Sender: TGlobe4; GlobeObject: TGlobeObject); var lC: Integer; lEntry: PGroupMapEntry; lPrevUUID: string; begin lPrevUUID := gSelectedGroupUUID; // CC 20260924 // CC 20260924 TGlobe4 also raises this event for each object it DEselects, // passing that object, so clicking empty map arrives here with the old // group. The layer store's SelectedObject is set before those events fire, // so it is the real selection (nil after an empty click). GlobeObject := glbMap.Layers.SelectedObject; if GlobeObject <> nil then begin pnlSelected.Caption := GlobeObject.Title; // CC 20260313 find the group UUID for the selected icon object gSelectedGroupUUID := ''; for lC := 0 to FGroupMap.Count - 1 do begin lEntry := PGroupMapEntry(FGroupMap.Objects[lC]); if lEntry^.IconObjectID = GlobeObject.ID then begin gSelectedGroupUUID := lEntry^.UUID; Break; end; end; end else begin pnlSelected.Caption := ''; gSelectedGroupUUID := ''; // CC 20260313 end; // CC 20260924 selected-group course and formation zones are built during a // snapshot apply, so re-run it rather than waiting for the next tick if gSelectedGroupUUID <> lPrevUUID then ReapplyLastSnapshot; glbMap.Invalidate; // CC 20260313 redraw so course track updates immediately end; procedure TfrmMain.ima(Sender: TObject); var i, j: integer; Long, Lat : integer; Units : TGlobeUnitTypes; iLeft, iTop, iTA, iBkMode : integer; begin // Draw a scale onto the globe iLeft := glbMap.GlobeCanvas.CanvasWidth - 150; iTop := glbMap.GlobeCanvas.CanvasHeight - 25; with glbMap.GlobeCanvas do begin Font.Color := clRed; iBkMode := SetBkMode(Handle, TRANSPARENT); iTA := SetTextAlign(Handle, TA_CENTER); Units := NauticalMile; TextOut(iLeft, iTop, '0'); TextOut(iLeft + CanvasPixelsPerInch, iTop, Format('%d %s', [Round(GlobeUnitsTo(Projection.UnitsPerInch, Units)), UnitsToStr(Units)])); SetBkMode(Handle, iBkMode); SetTextAlign(Handle, iTA); MoveTo(iLeft, iTop + 16); LineTo(iLeft, iTop + 20); LineTo(iLeft + CanvasPixelsPerInch, iTop + 20); LineTo(iLeft + CanvasPixelsPerInch, iTop + 15); end; end; procedure TfrmMain.LoadIcons; const cSize: NativeInt = 16; var lIcons: TBitmap; lBmp: TBitmap; lRow, lCol, lRows, lCols: NativeInt; begin lIcons := TBitmap.Create; lIcons.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Graphics\GR_ICONS.BMP'); lRows := lIcons.Height div cSize; lCols := lIcons.Width div cSize; lBmp := TBitmap.Create; lBmp.Width := cSize; lBmp.Height := cSize; lCol := 0; while lCol < lCols - 1 do begin for lRow := 0 to lRows - 1 do begin lBmp.Canvas.CopyRect(Rect(0, 0, lBmp.Width, lBmp.Height), lIcons.Canvas, Rect(lCol * lBmp.Width, lRow * lBmp.Height, (lCol + 1) * cSize,(lRow + 1) * cSize)); // CC 20260311 use AddMasked so clBlack becomes the transparent colour in the image list icons.AddMasked(lBmp, clBlack); end; Inc(lCol, 2); end; lBmp.Free; lIcons.Free; end; // CC 20260323 add a new group entry from snapshot data (no live HC pointer) // CC 20260922 creation-only: allocate the entry, build the icon and track pair // that every group owns, then let UpdateGroupFromSnapshot create the optional // overlays and position/draw everything exactly as on later ticks procedure TfrmMain.AddGroupFromSnapshot(const snap: TGroupSnapshot; const pShowing: uchar); var lEntry: PGroupMapEntry; lCenterPos: TPointLL; lIsUncertain: Boolean; lUncertRegion: URegion; lPres: TCICG4PointPresenter; lDataObj: TGeoDataObject; i: Integer; begin lCenterPos := SnapCenterPos(snap, pShowing, lIsUncertain, lUncertRegion); New(lEntry); lEntry^.UUID := snap.UUID; lEntry^.Visited := True; lEntry^.UncertPresenterID := -1; lEntry^.UncertObjectID := -1; lEntry^.ArrowPresenterID := -1; lEntry^.ArrowObjectID := -1; for i := 0 to RING_COUNT - 1 do begin lEntry^.RangePresenterIDs[i] := -1; lEntry^.RangeObjectIDs[i] := -1; end; for i := 0 to MAX_FORMATION_ZONES - 1 do // CC 20260924 all 64 (extended rings) begin lEntry^.ZonePresenterIDs[i] := -1; lEntry^.ZoneObjectIDs[i] := -1; end; for i := 0 to MAX_FORMATION_ZONES - 1 do begin lEntry^.ZoneLabelPresenterIDs[i] := -1; // CC 20260924 lEntry^.ZoneLabelObjectIDs[i] := -1; end; lEntry^.SectorPresenterID := -1; // CC 20260924 lEntry^.SectorObjectID := -1; lEntry^.JamPresenterID := -1; lEntry^.JamObjectID := -1; // -- Icon presenter/object (CC 20260922 bitmap is drawn by UpdateGroupFromSnapshot) -- lPres := TCICG4PointPresenter.Create(glbMap, 0); layGroups.Presenters.Add(lPres); lPres.Name := snap.id; lPres.TitleFont.FontColor := clBlack; lPres.TitleFont.FontUnit := Pixel; lPres.TitleFont.FontSize := 12; lPres.PointType := ppImage; lPres.PointUnit := Pixel; lPres.Image := TPicture.Create; lPres.Image.Bitmap.Width := 16; lPres.Image.Bitmap.Height := 16; lPres.PointSize := lPres.Image.Bitmap.Width; lPres.MaxPointSize := lPres.Image.Bitmap.Width; lPres.TitleAlignment := taBottom; lEntry^.IconPresenterID := lPres.PresenterID; lDataObj := TGeoDataObject.Create(layGroups.Objects); lDataObj.Centroid := lCenterPos; lDataObj.Title := lPres.Name; lDataObj.PresenterID := lPres.PresenterID; lDataObj.ID := intObjects; lEntry^.IconObjectID := intObjects; Inc(intObjects); // -- Track pair (CC 20260922 chains are filled by UpdateGroupFromSnapshot) -- CreateTrackPair(glbMap, layTracks, lCenterPos, SideColor(DisplaySide(pShowing, snap.side)), intObjects, lEntry^.TrackLinePresenterID, lEntry^.TrackLineObjectID, lEntry^.TrackDotPresenterID, lEntry^.TrackDotObjectID); UpdateGroupFromSnapshot(lEntry, snap, pShowing); FGroupMap.AddObject(snap.UUID, TObject(lEntry)); end; // CC 20260323 unconditionally update all group properties in-place each tick from snapshot procedure TfrmMain.UpdateGroupFromSnapshot(pEntry: PGroupMapEntry; const snap: TGroupSnapshot; const pShowing: uchar); var lNewPos: TPointLL; lDispSide: uchar; lIsUncertain: Boolean; lUncertRegion: URegion; lLineObj, lDotObj: TGlobeObject; lRingRange: SmallInt; lSectorInner, lSectorOuter: Integer; // CC 20260924 lSmallestZone: Integer; // CC 20260924 lShowLabels: Boolean; // CC 20260924 lZonesVisible: Boolean; // CC 20260924 lDrawn, lBit: UInt64; // CC 20260924 rings to draw (DrawnRingsMask) i: Integer; begin lDispSide := DisplaySide(pShowing, snap.side); pEntry^.DispSide := lDispSide; pEntry^.ActualSide := snap.side; pEntry^.GType := snap.gtype; // CC 20260924 pEntry^.HasTrack := Length(snap.TrackNodes) > 0; pEntry^.GroupSLon := snap.sLon; pEntry^.GroupSLat := snap.sLat; pEntry^.SnapTrackNodes := Copy(snap.TrackNodes); lNewPos := SnapCenterPos(snap, pShowing, lIsUncertain, lUncertRegion); // CC 20260922 // -- Uncertainty diamond lifecycle -- if lIsUncertain then begin if pEntry^.UncertPresenterID < 0 then CreateUncertaintyZone(glbMap, layUncertainty, SideColor(lDispSide), intObjects, pEntry^.UncertPresenterID, pEntry^.UncertObjectID); UpdateUncertaintyZone(layUncertainty, pEntry^.UncertObjectID, pEntry^.UncertPresenterID, @lUncertRegion, SideColor(lDispSide), True); end else if pEntry^.UncertPresenterID >= 0 then begin RemoveUncertaintyZone(layUncertainty, pEntry^.UncertPresenterID, pEntry^.UncertObjectID); pEntry^.UncertPresenterID := -1; pEntry^.UncertObjectID := -1; end; // -- Update icon -- UpdateGroupIconPosition(layGroups, pEntry^.IconObjectID, lNewPos); // CC 20260924 the formation-edited group's position icon is faded so it // isn't mistaken for one of its units UpdateGroupIconBitmap(layGroups, pEntry^.IconPresenterID, icons, lDispSide, AnsiChar(snap.gtype), (FFocusUUID <> '') and (snap.UUID = FFocusUUID)); // -- Arrow lifecycle -- if snap.kts > 0 then begin if pEntry^.ArrowPresenterID < 0 then CreateArrow(glbMap, layArrows, lNewPos, snap.course, SideColor(lDispSide), intObjects, pEntry^.ArrowPresenterID, pEntry^.ArrowObjectID) else UpdateArrow(layArrows, pEntry^.ArrowPresenterID, pEntry^.ArrowObjectID, lNewPos, snap.course, SideColor(lDispSide)); end else if pEntry^.ArrowPresenterID >= 0 then begin RemoveArrow(layArrows, pEntry^.ArrowPresenterID, pEntry^.ArrowObjectID); pEntry^.ArrowPresenterID := -1; pEntry^.ArrowObjectID := -1; end; // -- Range ring lifecycle (weapon + sensor + air) -- for i := 0 to RING_COUNT - 1 do begin lRingRange := SnapRingRange(snap, i); if RangeRingsEnabled(i, lDispSide) and (lRingRange > 0) then begin if pEntry^.RangePresenterIDs[i] < 0 then CreateRangeRing(glbMap, layRangeRings, lNewPos, lRingRange, RANGE_RING_COLORS[i], intObjects, pEntry^.RangePresenterIDs[i], pEntry^.RangeObjectIDs[i]) else UpdateRangeRingPosition(layRangeRings, pEntry^.RangeObjectIDs[i], lNewPos, lRingRange); end else if pEntry^.RangePresenterIDs[i] >= 0 then begin RemoveRangeRing(layRangeRings, pEntry^.RangePresenterIDs[i], pEntry^.RangeObjectIDs[i]); pEntry^.RangePresenterIDs[i] := -1; pEntry^.RangeObjectIDs[i] := -1; end; end; // -- Formation zone lifecycle (CC 20260921) -- // CC 20260924 extended rings (decision 7): all 64 slots, drawn per DrawnRingsMask lZonesVisible := FormationZonesVisible(snap.UUID, snap.side); lDrawn := DrawnRingsMask(snap); for i := 0 to MAX_FORMATION_ZONES - 1 do begin lBit := UInt64(1) shl i; if lZonesVisible and ((lDrawn and lBit) <> 0) then begin if pEntry^.ZonePresenterIDs[i] < 0 then CreateRangeRing(glbMap, layFormationZones, lNewPos, snap.Zones[i], FORMATION_ZONE_COLOR, intObjects, pEntry^.ZonePresenterIDs[i], pEntry^.ZoneObjectIDs[i]) else UpdateRangeRingPosition(layFormationZones, pEntry^.ZoneObjectIDs[i], lNewPos, snap.Zones[i]); end else if pEntry^.ZonePresenterIDs[i] >= 0 then begin RemoveRangeRing(layFormationZones, pEntry^.ZonePresenterIDs[i], pEntry^.ZoneObjectIDs[i]); pEntry^.ZonePresenterIDs[i] := -1; pEntry^.ZoneObjectIDs[i] := -1; end; end; // -- Formation sector spokes (CC 20260924) -- // Main Body ring to the largest drawn ring; nothing to draw unless they differ lSectorInner := snap.Zones[MainBodyZone]; lSectorOuter := 0; for i := 0 to MAX_FORMATION_ZONES - 1 do if ((lDrawn and (UInt64(1) shl i)) <> 0) and (snap.Zones[i] > lSectorOuter) then lSectorOuter := snap.Zones[i]; if lZonesVisible and (lSectorOuter > lSectorInner) then begin if pEntry^.SectorPresenterID < 0 then CreateSectorLines(glbMap, layFormationZones, lNewPos, lSectorInner, lSectorOuter, FORMATION_ZONE_COLOR, intObjects, pEntry^.SectorPresenterID, pEntry^.SectorObjectID) else UpdateSectorLines(layFormationZones, pEntry^.SectorObjectID, lNewPos, lSectorInner, lSectorOuter); end else if pEntry^.SectorPresenterID >= 0 then begin RemoveRangeRing(layFormationZones, pEntry^.SectorPresenterID, pEntry^.SectorObjectID); pEntry^.SectorPresenterID := -1; pEntry^.SectorObjectID := -1; end; // -- Formation zone range labels (CC 20260924) -- // One per drawn ring, each on its own spoke (ring mod 8, see uZoneLabels); // only once the smallest drawn ring is big enough on screen to keep them legible lSmallestZone := 0; for i := 0 to MAX_FORMATION_ZONES - 1 do if ((lDrawn and (UInt64(1) shl i)) <> 0) and ((lSmallestZone = 0) or (snap.Zones[i] < lSmallestZone)) then lSmallestZone := snap.Zones[i]; lShowLabels := lZonesVisible and (lSmallestZone > 0) and (ZoneRadiusPixels(glbMap, lNewPos, lSmallestZone) >= ZONE_LABEL_MIN_PX); for i := 0 to MAX_FORMATION_ZONES - 1 do begin if lShowLabels and ((lDrawn and (UInt64(1) shl i)) <> 0) then begin if pEntry^.ZoneLabelPresenterIDs[i] < 0 then CreateZoneLabel(glbMap, layFormationZones, lNewPos, i, snap.Zones[i], intObjects, pEntry^.ZoneLabelPresenterIDs[i], pEntry^.ZoneLabelObjectIDs[i]) else UpdateZoneLabel(layFormationZones, pEntry^.ZoneLabelObjectIDs[i], lNewPos, i, snap.Zones[i]); end else if pEntry^.ZoneLabelPresenterIDs[i] >= 0 then begin RemoveZoneLabel(layFormationZones, pEntry^.ZoneLabelPresenterIDs[i], pEntry^.ZoneLabelObjectIDs[i]); pEntry^.ZoneLabelPresenterIDs[i] := -1; pEntry^.ZoneLabelObjectIDs[i] := -1; end; end; // -- Jamming bolt lifecycle (CC 20260921) -- if snap.Jammed <> 0 then begin if pEntry^.JamPresenterID < 0 then CreateJamBolt(glbMap, layJamming, lNewPos, intObjects, pEntry^.JamPresenterID, pEntry^.JamObjectID) else UpdateJamBoltPosition(layJamming, pEntry^.JamObjectID, lNewPos); end else if pEntry^.JamPresenterID >= 0 then begin RemoveJamBolt(layJamming, pEntry^.JamPresenterID, pEntry^.JamObjectID); pEntry^.JamPresenterID := -1; pEntry^.JamObjectID := -1; end; // -- Track chains -- UpdateTrackColor(layTracks, pEntry^.TrackLinePresenterID, pEntry^.TrackDotPresenterID, SideColor(lDispSide)); if GroupCourseVisible(pEntry) and (Length(snap.TrackNodes) > 0) then begin lLineObj := layTracks.ObjectByID(pEntry^.TrackLineObjectID); lDotObj := layTracks.ObjectByID(pEntry^.TrackDotObjectID); if (lLineObj <> nil) and (lDotObj <> nil) then begin BuildTrackChainFromSnapshot(snap.sLon, snap.sLat, snap.TrackNodes, Length(snap.TrackNodes), TGeoDataObject(lLineObj).Chains[0], TGeoDataObject(lDotObj).Chains[0]); TGeoDataObject(lLineObj).RedrawObject; end; end else begin lLineObj := layTracks.ObjectByID(pEntry^.TrackLineObjectID); if lLineObj <> nil then TGeoDataObject(lLineObj).Chains[0].Count := 0; lDotObj := layTracks.ObjectByID(pEntry^.TrackDotObjectID); if lDotObj <> nil then begin TGeoDataObject(lDotObj).Chains[0].Count := 0; TGeoDataObject(lDotObj).Centroid := lNewPos; end; end; end; // CC 20260311 remove one group's globe objects; caller must Dispose(pEntry) procedure TfrmMain.RemoveGroupEntry(pEntry: PGroupMapEntry); var i: Integer; begin // Remove arrow if pEntry^.ArrowPresenterID >= 0 then RemoveArrow(layArrows, pEntry^.ArrowPresenterID, pEntry^.ArrowObjectID); // Remove range rings for i := 0 to RING_COUNT - 1 do if pEntry^.RangeObjectIDs[i] >= 0 then RemoveRangeRing(layRangeRings, pEntry^.RangePresenterIDs[i], pEntry^.RangeObjectIDs[i]); // Remove formation zones (CC 20260921; CC 20260924 all 64 slots) for i := 0 to MAX_FORMATION_ZONES - 1 do if pEntry^.ZoneObjectIDs[i] >= 0 then RemoveRangeRing(layFormationZones, pEntry^.ZonePresenterIDs[i], pEntry^.ZoneObjectIDs[i]); // Remove formation zone range labels (CC 20260924) for i := 0 to MAX_FORMATION_ZONES - 1 do if pEntry^.ZoneLabelPresenterIDs[i] >= 0 then RemoveZoneLabel(layFormationZones, pEntry^.ZoneLabelPresenterIDs[i], pEntry^.ZoneLabelObjectIDs[i]); // Remove formation sector spokes (CC 20260924) if pEntry^.SectorPresenterID >= 0 then RemoveRangeRing(layFormationZones, pEntry^.SectorPresenterID, pEntry^.SectorObjectID); // Remove jamming bolt (CC 20260921) if pEntry^.JamPresenterID >= 0 then RemoveJamBolt(layJamming, pEntry^.JamPresenterID, pEntry^.JamObjectID); // Remove tracks RemoveTrackPair(layTracks, pEntry^.TrackLinePresenterID, pEntry^.TrackLineObjectID, pEntry^.TrackDotPresenterID, pEntry^.TrackDotObjectID); // Remove uncertainty diamond if pEntry^.UncertPresenterID >= 0 then RemoveUncertaintyZone(layUncertainty, pEntry^.UncertPresenterID, pEntry^.UncertObjectID); // Remove icon RemoveGroupIcon(layGroups, pEntry^.IconPresenterID, pEntry^.IconObjectID); end; // CC 20260323 returns True if this group's course should be drawn right now function TfrmMain.GroupCourseVisible(pEntry: PGroupMapEntry): Boolean; begin // CC 20260922 reads gMapSettings, not the controls case gMapSettings.CourseMode of COURSE_SELECTED: Result := (pEntry^.UUID = gSelectedGroupUUID) and ((gMapSettings.VisibilityMode = VIS_GOD) or (pEntry^.ActualSide = gSide)); // CC 20260323 Player mode: own-side only COURSE_ALL: Result := (pEntry^.DispSide < SIDE_COUNT) and gMapSettings.CourseSides[pEntry^.DispSide] and ((gMapSettings.VisibilityMode = VIS_GOD) or (pEntry^.ActualSide = gSide)); else Result := False; end; end; // CC 20260313 hit-test waypoint dots and begin drag procedure TfrmMain.glbMapMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var lKind: TFormationItemKind; // CC 20260924 lUUID: string; lC, lC2: Integer; // CC 20260924 phase 3 begin // CC 20260314 right-click exits placement mode if Button = mbRight then begin if FAddingCoursepoint then begin FAddingCoursepoint := False; glbMap.Cursor := crDefault; glbMap.MouseZoomButton := mzbRight; // CC 20260314 restore zoom rect glbMap.MouseRotateButton := mzbLeft; // CC 20260314 restore rotation end else if FInsertingCoursepoint then // CC 20260316 begin FInsertingCoursepoint := False; glbMap.Cursor := crDefault; glbMap.MouseZoomButton := mzbRight; glbMap.MouseRotateButton := mzbLeft; end; Exit; end; if Button <> mbLeft then Exit; // CC 20260314 placement mode — append coursepoint on left-click if FAddingCoursepoint then begin AppendCoursepoint(X, Y); Exit; end; // CC 20260316 insert placement mode — insert coursepoint on left-click if FInsertingCoursepoint then begin InsertCoursepoint(X, Y); Exit; end; if FDragState.Active then Exit; // CC 20260924 phase 3: Shift+click extends the selected unit/patrol's area, // Ctrl+click sets it to the clicked cell if (ssShift in Shift) and EditSelectedArea(X, Y, False) then Exit; if (ssCtrl in Shift) and EditSelectedArea(X, Y, True) then Exit; // CC 20260924 formation edit: a click on a station/aircraft marker selects it // here and in the editor, ahead of the waypoint hit test if (FFocusUUID <> '') and (FOverlay <> nil) and FOverlay.HitTest(X, Y, lKind, lUUID) then begin FFormSelKind := lKind; FFormSelUUID := lUUID; FOverlay.SetSelection(lKind, lUUID); if frmFormationEditor <> nil then frmFormationEditor.SelectItem(lKind, lUUID); // CC 20260924 phase 3: pressing on a unit's station starts dragging it if (lKind = fikUnit) and FHaveFocusSnap and FFocusSnap.IsFocus then for lC := 0 to Length(FFocusSnap.Units) - 1 do if (FFocusSnap.Units[lC].UUID = lUUID) and CanDragStation(FFocusSnap, FFocusSnap.Units[lC]) then begin FStationDrag.Active := True; FStationDrag.Moved := False; FStationDrag.StartX := X; FStationDrag.StartY := Y; FStationDrag.UUID := lUUID; lC2 := FindStagedStation(lUUID); FStationDrag.HadEntry := lC2 >= 0; if FStationDrag.HadEntry then FStationDrag.Prev := FStagedStations[lC2]; glbMap.MouseRotateButton := mzbNone; // no globe panning while dragging Break; end; Exit; end; WaypointDragBegin(glbMap, layTracks, FGroupMap, X, Y, FDragState, @GroupCourseVisible); end; // CC 20260313 commit dragged waypoint to HC path record // CC 20260314 right-click MouseUp shows context menu (after TGlobe4 clears FbZooming) procedure TfrmMain.glbMapMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var lIdx, lC: Integer; lEntry: PGroupMapEntry; lObj: TGlobeObject; lHitDot, lHitGroup, lHasTrack: Boolean; lHitEntry: PGroupMapEntry; // CC 20260924 the group icon that was right-clicked begin // CC 20260924 phase 3: drop a dragged formation station (staged until Apply) if FStationDrag.Active and (Button = mbLeft) then begin StationDragMove(X, Y); FStationDrag.Active := False; glbMap.MouseRotateButton := mzbLeft; if FStationDrag.Moved then begin if frmFormationEditor <> nil then frmFormationEditor.SetStationsStaged(AnyStaged); ReapplyLastSnapshot; end; Exit; end; // CC 20260314 show popup on right-button up — by this point TGlobe4 has // already cleared its internal FbZooming state, so no zoom rect persists if (Button = mbRight) and (not FAddingCoursepoint) and (not FInsertingCoursepoint) and (gSelectedGroupUUID <> '') then begin HitTestWaypointDot(X, Y); // CC 20260323 check if right-click hit a waypoint dot // CC 20260319 determine context: right-clicked a group icon or a course dot? lHitDot := (FInsertWaypointIdx >= 0); lHitGroup := False; lHitEntry := nil; if not lHitDot then begin lObj := glbMap.Layers.ObjectAtXY(X, Y); if lObj <> nil then for lC := 0 to FGroupMap.Count - 1 do begin lEntry := PGroupMapEntry(FGroupMap.Objects[lC]); if lEntry^.IconObjectID = lObj.ID then begin lHitGroup := True; lHitEntry := lEntry; // CC 20260924 Break; end; end; end; if not lHitDot and not lHitGroup then Exit; // CC 20260319 no popup on empty space // Look up selected group entry for track checks lHasTrack := False; if FGroupMap.Find(gSelectedGroupUUID, lIdx) then begin lEntry := PGroupMapEntry(FGroupMap.Objects[lIdx]); lHasTrack := lEntry^.HasTrack; end; // CC 20260319 Append: group icon when no course, or last course dot miAddCoursepoint.Visible := (lHitGroup and (not lHasTrack)) or (lHitDot and (FInsertWaypointIdx >= 0) and FInsertIsLastWaypoint); // Insert/Delete: only on course dot miInsertCoursepoint.Visible := lHitDot; miDeleteCoursepoint.Visible := lHitDot; // Clear Course: only on group icon when course exists miClearCourse.Visible := lHitGroup and lHasTrack; // CC 20260924 Edit Formation: on a group icon whose group has a formation // (see CanEditFormation) miEditFormation.Visible := lHitGroup and (lHitEntry <> nil) and CanEditFormation(lHitEntry); if miEditFormation.Visible then FMenuGroupUUID := lHitEntry^.UUID else FMenuGroupUUID := ''; pmGlobe.PopUp(Mouse.CursorPos.X, Mouse.CursorPos.Y); Exit; end; if not FDragState.Active then Exit; WaypointDragCommit(glbMap, X, Y, FDragState); end; // CC 20260313 ESC cancels an in-progress waypoint drag procedure TfrmMain.glbMapKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); var lC: Integer; // CC 20260924 phase 3 begin if Key = VK_ESCAPE then begin // CC 20260924 phase 3: Esc puts a dragged station back where it was if FStationDrag.Active then begin lC := FindStagedStation(FStationDrag.UUID); if FStationDrag.HadEntry then begin if lC >= 0 then FStagedStations[lC] := FStationDrag.Prev; end else if lC >= 0 then begin FStagedStations[lC] := FStagedStations[Length(FStagedStations) - 1]; SetLength(FStagedStations, Length(FStagedStations) - 1); end; FStationDrag.Active := False; glbMap.MouseRotateButton := mzbLeft; if frmFormationEditor <> nil then frmFormationEditor.SetStationsStaged(AnyStaged); ReapplyLastSnapshot; Exit; end; // CC 20260314 ESC exits coursepoint placement mode if FAddingCoursepoint then begin FAddingCoursepoint := False; glbMap.Cursor := crDefault; glbMap.MouseZoomButton := mzbRight; // CC 20260314 restore zoom rect glbMap.MouseRotateButton := mzbLeft; // CC 20260314 restore rotation Exit; end; // CC 20260316 ESC exits insert placement mode if FInsertingCoursepoint then begin FInsertingCoursepoint := False; glbMap.Cursor := crDefault; glbMap.MouseZoomButton := mzbRight; glbMap.MouseRotateButton := mzbLeft; Exit; end; if FDragState.Active then WaypointDragCancel(glbMap, layTracks, FDragState); end; end; // CC 20260922 visibility radio changed procedure TfrmMain.rgVisibilityClick(Sender: TObject); begin if FSyncingControls then Exit; if (rgVisibility.ItemIndex < VIS_PLAYER) or (rgVisibility.ItemIndex > VIS_GOD) then Exit; gMapSettings.VisibilityMode := rgVisibility.ItemIndex; SaveMapSettings; ReapplyLastSnapshot; end; // CC 20260922 mirror gMapSettings into the main-panel controls without firing their handlers procedure TfrmMain.SyncControlsFromSettings; begin FSyncingControls := True; try rgVisibility.ItemIndex := gMapSettings.VisibilityMode; finally FSyncingControls := False; end; end; // CC 20260922 settings dialog committed (OK/close) - it already saved; just re-render procedure TfrmMain.MapSettingsChanged(Sender: TObject); begin ReapplyLastSnapshot; end; // CC 20260314 enter coursepoint placement mode procedure TfrmMain.miAddCoursepointClick(Sender: TObject); begin FAddingCoursepoint := True; glbMap.Cursor := crCross; glbMap.MouseZoomButton := mzbNone; // CC 20260314 suppress zoom rect during placement glbMap.MouseRotateButton := mzbNone; // CC 20260314 suppress globe rotation during placement end; // CC 20260316 enter insert coursepoint placement mode procedure TfrmMain.miInsertCoursepointClick(Sender: TObject); begin FInsertingCoursepoint := True; glbMap.Cursor := crCross; glbMap.MouseZoomButton := mzbNone; glbMap.MouseRotateButton := mzbNone; end; // CC 20260323 delete the right-clicked waypoint dot via callback queue procedure TfrmMain.miDeleteCoursepointClick(Sender: TObject); var lReq: THCCallbackRequest; begin if FInsertWaypointIdx < 0 then Exit; if FInsertGroupUUID = '' then Exit; lReq.Kind := cbkDeleteCoursepoint; lReq.GroupUUID := FInsertGroupUUID; lReq.DestLon := 0; lReq.DestLat := 0; lReq.WaypointIdx := FInsertWaypointIdx; QueueHCCallback(lReq); FInsertWaypointIdx := -1; FInsertGroupUUID := ''; glbMap.Invalidate; end; // CC 20260323 delete all waypoints from the selected group's course via callback queue procedure TfrmMain.miClearCourseClick(Sender: TObject); var lReq: THCCallbackRequest; begin if gSelectedGroupUUID = '' then Exit; lReq.Kind := cbkClearCourse; lReq.GroupUUID := gSelectedGroupUUID; lReq.DestLon := 0; lReq.DestLat := 0; lReq.WaypointIdx := 0; QueueHCCallback(lReq); FInsertWaypointIdx := -1; FInsertGroupUUID := ''; glbMap.Invalidate; end; // CC 20260323 hit-test waypoint dots — stores chain index and group UUID procedure TfrmMain.HitTestWaypointDot(X, Y: Integer); const HIT_PX = 8; var lC, idx: Integer; lEntry: PGroupMapEntry; lDotObj: TGlobeObject; lChain: TPointStore; ptXY: TPoint; begin FInsertWaypointIdx := -1; FInsertGroupUUID := ''; FInsertIsLastWaypoint := False; for lC := 0 to FGroupMap.Count - 1 do begin lEntry := PGroupMapEntry(FGroupMap.Objects[lC]); if lEntry^.TrackDotObjectID < 0 then Continue; if not GroupCourseVisible(lEntry) then Continue; lDotObj := layTracks.ObjectByID(lEntry^.TrackDotObjectID); if lDotObj = nil then Continue; lChain := TGeoDataObject(lDotObj).Chains[0]; for idx := 0 to lChain.Count - 1 do begin if glbMap.Projection.LLToDeviceXY(lChain.AsLL[idx].iLongX, lChain.AsLL[idx].iLatY, ptXY) then if (Sqr(X - ptXY.X) + Sqr(Y - ptXY.Y)) <= Sqr(HIT_PX) then begin FInsertWaypointIdx := idx; FInsertGroupUUID := lEntry^.UUID; FInsertIsLastWaypoint := (idx = lChain.Count - 1); Exit; end; end; end; end; // CC 20260323 insert a new waypoint before FInsertWaypointIdx via callback queue procedure TfrmMain.InsertCoursepoint(X, Y: Integer); var ptLL: TPointLL; lReq: THCCallbackRequest; begin if FInsertWaypointIdx < 0 then Exit; if FInsertGroupUUID = '' then Exit; glbMap.Projection.DeviceXYToLL(X, Y, ptLL); lReq.Kind := cbkInsertCoursepoint; lReq.GroupUUID := FInsertGroupUUID; lReq.DestLon := HCDegSliverLonF(GlobeUnitsToDecimal(ptLL.iLongX)); lReq.DestLat := HCDegSliverLatF(GlobeUnitsToDecimal(ptLL.iLatY)); lReq.WaypointIdx := FInsertWaypointIdx; QueueHCCallback(lReq); glbMap.Invalidate; end; // CC 20260323 append a new waypoint to the selected group's course via callback queue procedure TfrmMain.AppendCoursepoint(X, Y: Integer); var ptLL: TPointLL; lReq: THCCallbackRequest; begin if gSelectedGroupUUID = '' then Exit; glbMap.Projection.DeviceXYToLL(X, Y, ptLL); lReq.Kind := cbkAppendCoursepoint; lReq.GroupUUID := gSelectedGroupUUID; lReq.DestLon := HCDegSliverLonF(GlobeUnitsToDecimal(ptLL.iLongX)); lReq.DestLat := HCDegSliverLatF(GlobeUnitsToDecimal(ptLL.iLatY)); lReq.WaypointIdx := 0; QueueHCCallback(lReq); glbMap.Invalidate; end; // CC 20260323 apply snapshot — copy + mark, then kick off chunked walk procedure TfrmMain.WMApplySnapshot(var Msg: TMessage); var lGen: LongInt; lSnap: TGameTimeSnapshot; // CC 20260922 begin // CC 20260323 clear pending flag so HC can post again when next snapshot is ready InterlockedExchange(gSnapshotPending, 0); // CC 20260323 don't restart mid-batch — let current batch finish first if FBatchInProgress then Exit; // Copy snapshot under lock (lock held only for assignment, not capture) // CC 20260922 into a local, so FPendingSnap always holds the last applied snapshot EnterCriticalSection(gSnapshotCS); lGen := gSnapshotGeneration; lSnap := gSharedSnapshot; LeaveCriticalSection(gSnapshotCS); if not lSnap.Ready then Exit; if lGen = gLastAppliedGeneration then Exit; gLastAppliedGeneration := lGen; FPendingSnap := lSnap; FChunkGen := lGen; FReapplyPending := False; // CC 20260922 this batch renders with current settings anyway StartBatch; end; // CC 20260922 re-run the last applied snapshot through the chunked path so a // settings change shows immediately, even while HC is paused procedure TfrmMain.ReapplyLastSnapshot; begin if FBatchInProgress then begin FReapplyPending := True; // picked up when the current batch completes Exit; end; FReapplyPending := False; if not FPendingSnap.Ready then Exit; // nothing applied yet StartBatch; end; // CC 20260922 split out of WMApplySnapshot - starts a chunked batch over FPendingSnap procedure TfrmMain.StartBatch; var i: Integer; begin Inc(FBatchID); FBatchInProgress := True; lblGameTime.Caption := 'GameTime: ' + Format('%8.8d', [FPendingSnap.GameTime]); // Phase 1: Mark all entries unvisited for i := 0 to FGroupMap.Count - 1 do PGroupMapEntry(FGroupMap.Objects[i])^.Visited := False; FFocusSeen := False; // CC 20260924 set when the formation-edit group is applied // Kick off first chunk — lParam carries batch ID PostMessage(Handle, WM_APPLY_CHUNK, 0, FBatchID); end; // CC 20260323 process one chunk of groups; wParam = start index, lParam = batch ID procedure TfrmMain.WMApplyChunk(var Msg: TMessage); var lView: TGroupSnapshot; // CC 20260924 lStart, lEnd, i, lIdx: Integer; lEntry: PGroupMapEntry; lVisibility: uchar; {$IFDEF DEBUG}tStart, tDone: DWORD;{$ENDIF} begin // CC 20260323 discard stale chunk from a previous batch if LongInt(Msg.LParam) <> FBatchID then Exit; lStart := Integer(Msg.WParam); lEnd := lStart + CHUNK_SIZE - 1; if lEnd >= FPendingSnap.Count then lEnd := FPendingSnap.Count - 1; {$IFDEF DEBUG}tStart := GetTickCount;{$ENDIF} // Phase 2 (partial): walk this chunk for i := lStart to lEnd do begin if gMapSettings.VisibilityMode = VIS_GOD then // CC 20260922 lVisibility := ShowExact or SideKnown else lVisibility := FPendingSnap.Groups[i].showing; if lVisibility = NotShowing then Continue; // CC 20260924 the formation-edited group is drawn with its staged ring sizes if (FFocusUUID <> '') and (FPendingSnap.Groups[i].UUID = FFocusUUID) then lView := StagedFocusView(FPendingSnap.Groups[i]) else lView := FPendingSnap.Groups[i]; if FGroupMap.Find(lView.UUID, lIdx) then begin lEntry := PGroupMapEntry(FGroupMap.Objects[lIdx]); lEntry^.Visited := True; UpdateGroupFromSnapshot(lEntry, lView, lVisibility); end else AddGroupFromSnapshot(lView, lVisibility); // CC 20260924 formation edit: feed the overlay and editor, while the group // may still be edited under the current view (decision 1) if (FFocusUUID <> '') and (FPendingSnap.Groups[i].UUID = FFocusUUID) and FGroupMap.Find(FFocusUUID, lIdx) and CanEditFormation(PGroupMapEntry(FGroupMap.Objects[lIdx])) then ApplyFocusSnapshot(FPendingSnap.Groups[i]); end; {$IFDEF DEBUG} tDone := GetTickCount; // CC 20260323 log every chunk, not just the last LogMetrics(Format('gen=%d batch=%d tc=%d chunk=%d-%d/%d %dms', [FChunkGen, FBatchID, gTimeFactor, lStart, lEnd, FPendingSnap.Count, tDone - tStart])); {$ENDIF} if lEnd < FPendingSnap.Count - 1 then begin // More chunks to process — post next chunk with same batch ID PostMessage(Handle, WM_APPLY_CHUNK, lEnd + 1, FBatchID); end else begin // Phase 3: Sweep — all chunks done for i := FGroupMap.Count - 1 downto 0 do begin lEntry := PGroupMapEntry(FGroupMap.Objects[i]); if not lEntry^.Visited then begin // CC 20260922 an active drag holds a raw pointer to this entry if FDragState.Active and (FDragState.Entry = lEntry) then DropPointerModes; RemoveGroupEntry(lEntry); FGroupMap.Delete(i); Dispose(lEntry); // CC 20260922 RemoveGroupEntry leaves disposal to the caller end; end; // CC 20260323 batch complete — cooldown before next batch to let paint breathe FBatchInProgress := False; // CC 20260924 the formation-edit group vanished (or can no longer be edited // in this view): leave edit mode and redraw without its forced rings if (FFocusUUID <> '') and not FFocusSeen then begin ExitFormationEdit(False); FReapplyPending := True; end; if FReapplyPending then ReapplyLastSnapshot // CC 20260922 settings changed mid-batch; its end picks up any new tick else if gSnapshotGeneration <> gLastAppliedGeneration then SetTimer(Handle, TIMER_NEXT_BATCH, BATCH_COOLDOWN_MS, nil); end; end; procedure TfrmMain.WMScenLoad(var Msg: TMessage); begin // CC 20260922 orphan any in-flight batch: chunks already posted carry the old // batch ID and are discarded by WMApplyChunk instead of re-adding old groups Inc(FBatchID); FBatchInProgress := False; FReapplyPending := False; KillTimer(Handle, TIMER_NEXT_BATCH); FPendingSnap.Ready := False; // CC 20260922 a reapply must not resurrect the old scenario's groups DropPointerModes; gSelectedGroupUUID := ''; ExitFormationEdit(False); // CC 20260924 before ClearAllGroups; nothing to reapply ClearAllGroups; end; // CC 20260924 zone labels show or hide with on-screen ring size, so a zoom // re-applies the last snapshot; nothing to do when zones aren't displayed procedure TfrmMain.ZoomChanged(Sender: TObject); begin // CC 20260924 edit mode forces the focus group's zones on regardless of the setting if (gMapSettings.FormationZoneMode <> ZONES_NONE) or (FFocusUUID <> '') then ReapplyLastSnapshot; end; // CC 20260922 leave placement/drag modes without touching the drag entry, // which may be about to be freed procedure TfrmMain.DropPointerModes; begin FAddingCoursepoint := False; FInsertingCoursepoint := False; FInsertGroupUUID := ''; FDragState.Active := False; FDragState.Entry := nil; FStationDrag.Active := False; // CC 20260924 phase 3 glbMap.Cursor := crDefault; glbMap.MouseZoomButton := mzbRight; glbMap.MouseRotateButton := mzbLeft; end; procedure TfrmMain.WMShowForm(var Msg: TMessage); begin Show; end; // CC 20260323 cooldown timer fired — start next batch procedure TfrmMain.WMTimer(var Msg: TMessage); begin if Msg.WParam = TIMER_NEXT_BATCH then begin KillTimer(Handle, TIMER_NEXT_BATCH); PostMessage(Handle, WM_APPLY_SNAPSHOT, 0, 0); end else if Msg.WParam = TIMER_PAUSE_CHECK then // CC 20260924 formation edit mode only UpdatePausedState; end; // CC 20260311 bulk reset for scenario transitions procedure TfrmMain.ClearAllGroups; var lC: Integer; begin // Efficiently wipe all layer objects and presenters ClearGroups(layGroups); layArrows.Clear; layArrows.Enabled := False; // CC 20260311 TGlobeLayer.Clear resets Enabled; re-apply layRangeRings.Clear; layRangeRings.Enabled := False; // CC 20260312 TGlobeLayer.Clear resets Enabled; re-apply layTracks.Clear; layTracks.Enabled := False; // CC 20260313 TGlobeLayer.Clear resets Enabled; re-apply layUncertainty.Clear; layUncertainty.Enabled := False; // CC 20260322 layFormationZones.Clear; layFormationZones.Enabled := False; // CC 20260921 // CC 20260921 jam bolt presenters own a TPicture, so free images like layGroups ClearGroups(layJamming); layJamming.Enabled := False; // Dispose all entry records for lC := 0 to FGroupMap.Count - 1 do Dispose(PGroupMapEntry(FGroupMap.Objects[lC])); FGroupMap.Clear; end; // --------------------------------------------------------------------------- // CC 20260924 formation edit mode (phase 1, read-only). // See plans/Plan-FormationEdit-20260924.md. Entry is the Edit Formation... // context menu item; the mode lasts until the editor is closed, the group // vanishes from the snapshots (or may no longer be edited in this view), a // scenario loads or the form is destroyed. // --------------------------------------------------------------------------- // CC 20260924 groups that have a formation, as in the GE's right-click menu // (Command.c: SUB, SHIP, CARRIER and the port/airfield/base/SAM/convoy/armored // bases get "Formation editor"; AC, HELO, MISSILE, TORP, CITY, NUKEAREA, REF // don't), and per decision 1 Player view edits own-side groups only, God view any function TfrmMain.CanEditFormation(pEntry: PGroupMapEntry): Boolean; begin // CC 20260924 aircraft/helicopter groups too: the GE's menu doesn't offer them, // but its runtime moves their air units to formation stations like ships Result := (pEntry <> nil) and (HCMTIsVessel(pEntry^.GType) or HCMTIsAir(pEntry^.GType) or (HCMTIsBase(pEntry^.GType) and (pEntry^.GType <> MT_CITY))) and ((gMapSettings.VisibilityMode = VIS_GOD) or (pEntry^.ActualSide = gSide)); end; procedure TfrmMain.miEditFormationClick(Sender: TObject); begin if FMenuGroupUUID <> '' then EnterFormationEdit(FMenuGroupUUID); FMenuGroupUUID := ''; end; procedure TfrmMain.EnterFormationEdit(const aUUID: string); var i: Integer; begin if aUUID = '' then Exit; // switching groups keeps the editor open; the selection belongs to the old group if aUUID <> FFocusUUID then begin FFocusUUID := aUUID; FHaveFocusSnap := False; ClearStagedStations; // CC 20260924 phase 3: they belonged to the old group FFormSelKind := fikNone; FFormSelUUID := ''; if frmFormationEditor <> nil then frmFormationEditor.DiscardStaging; SetFocusGroupUUID(aUUID); // the next captures fill Units/Assets/Patrols if FOverlay <> nil then begin FOverlay.SetSelection(fikNone, ''); FOverlay.Hide; end; if frmFormationEditor <> nil then frmFormationEditor.SelectItem(fikNone, ''); end; // overlay created lazily, after every mainform layer, so it draws on top if FOverlay = nil then FOverlay := TFormationOverlay.Create(glbMap, icons); if frmFormationEditor = nil then frmFormationEditor := TfrmFormationEditor.Create(Self); frmFormationEditor.OnSelectItem := @FormationEditorSelect; frmFormationEditor.OnStagedChanged := @FormationStagedChanged; // CC 20260924 frmFormationEditor.OnApply := @FormationApply; frmFormationEditor.OnRevert := @FormationRevert; // CC 20260924 phase 3 frmFormationEditor.OnAddPatrol := @FormationAddPatrol; // CC 20260924 phase 4 frmFormationEditor.OnCancelPatrol := @FormationCancelPatrol; frmFormationEditor.OnEditorClosed := @FormationEditorClosed; frmFormationEditor.SetIcons(icons); // CC 20260924 unit icons in the list frmFormationEditor.Show; frmFormationEditor.BringToFront; // a batch already under way may have passed this group before it became the // focus; don't let its sweep read that as the group having vanished FFocusSeen := True; // paused detection starts from "running" FPauseGen := gSnapshotGeneration; FPauseTick := GetTickCount64; FGamePaused := False; SetTimer(Handle, TIMER_PAUSE_CHECK, PAUSE_CHECK_MS, nil); // zoom to the formation from the last applied snapshot; once the first focus // capture arrives the fit is redone if populated rings reach further out FFocusZoomNM := 0; FFocusZoomPending := True; if FPendingSnap.Ready then for i := 0 to FPendingSnap.Count - 1 do if FPendingSnap.Groups[i].UUID = aUUID then begin FitFormationZoom(FPendingSnap.Groups[i]); Break; end; ReapplyLastSnapshot; end; procedure TfrmMain.ExitFormationEdit(aReapply: Boolean); begin if FFocusUUID = '' then Exit; FFocusUUID := ''; FHaveFocusSnap := False; FFocusZoomPending := False; SetLength(FStagedStations, 0); // CC 20260924 phase 3 SetLength(FStagedPatrols, 0); SetLength(FNewPatrols, 0); SetLength(FCancelPatrols, 0); FFormSelKind := fikNone; FFormSelUUID := ''; if FStationDrag.Active then begin FStationDrag.Active := False; glbMap.MouseRotateButton := mzbLeft; end; SetFocusGroupUUID(''); if HandleAllocated then KillTimer(Handle, TIMER_PAUSE_CHECK); if FOverlay <> nil then begin FOverlay.SetSelection(fikNone, ''); FOverlay.Hide; end; if frmFormationEditor <> nil then begin // FormClose nils frmFormationEditor and frees it (caFree); unhook first so // it doesn't call back into FormationEditorClosed frmFormationEditor.OnEditorClosed := nil; frmFormationEditor.OnSelectItem := nil; frmFormationEditor.Close; if frmFormationEditor <> nil then begin frmFormationEditor.Release; frmFormationEditor := nil; end; end; if aReapply then ReapplyLastSnapshot; end; // CC 20260924 side colour the focus group is drawn in (its map entry's display // side, which follows Player/God visibility); its unit icons use the same function TfrmMain.FocusDispSide(const snap: TGroupSnapshot): uchar; var lIdx: Integer; begin if FGroupMap.Find(snap.UUID, lIdx) then Result := PGroupMapEntry(FGroupMap.Objects[lIdx])^.DispSide else Result := snap.side; end; // CC 20260924 which units' stations can move (with a ring resize or a drag). As // in the GE, aircraft on an attack are left alone. Air units of an // aircraft/helicopter group move too since phase 3: WatchAirReform (HC thread) // re-slaves them on arrival, which HC itself doesn't. Patrol aircraft over a // surface group move with a ring resize but aren't dragged (their patrol area is // phase 4). function StationMovesWithRings(const snap: TGroupSnapshot; const u: TUnitSnapshot): Boolean; begin Result := not (u.IsAir and (u.CombatFlag <> 0)); end; function CanDragStation(const snap: TGroupSnapshot; const u: TUnitSnapshot): Boolean; begin Result := StationMovesWithRings(snap, u) and (not u.IsAir or HCMTIsAir(snap.gtype)); end; // CC 20260924 phase 2: the focus group as it will look once the staged ring // sizes are applied - staged zones, and every station scaled with its ring band // (ScaleStationForZones, the GE's ResetFormationPositions). Drawing and the // overlay use this; the editor list and Apply keep HC's real snapshot. function TfrmMain.StagedFocusView(const snap: TGroupSnapshot): TGroupSnapshot; var lStaged: TFormationZones; i, k: Integer; x, y: LongInt; begin Result := snap; if ((frmFormationEditor = nil) or not frmFormationEditor.HasStaging) and not AnyStaged then Exit; // CC 20260924 staged patrol areas, cancels and new patrols if (Length(FStagedPatrols) > 0) or (Length(FCancelPatrols) > 0) or (Length(FNewPatrols) > 0) then begin Result.Patrols := Copy(snap.Patrols); for i := 0 to Length(Result.Patrols) - 1 do begin for k := 0 to Length(FStagedPatrols) - 1 do if FStagedPatrols[k].EventUUID = Result.Patrols[i].EventUUID then begin Result.Patrols[i].Rings := FStagedPatrols[k].Rings; Result.Patrols[i].Sectors := FStagedPatrols[k].Sectors; end; Result.Patrols[i].CancelStaged := CancelStagedIdx(Result.Patrols[i].EventUUID) >= 0; end; for k := 0 to Length(FNewPatrols) - 1 do begin i := Length(Result.Patrols); SetLength(Result.Patrols, i + 1); Result.Patrols[i] := Default(TPatrolSnapshot); Result.Patrols[i].EventUUID := FNewPatrols[k].TempUUID; Result.Patrols[i].PlaneID := FNewPatrols[k].PlaneID; Result.Patrols[i].PatrolType := FNewPatrols[k].PatrolType; Result.Patrols[i].Number := FNewPatrols[k].Number; Result.Patrols[i].Status := PATROL_START; Result.Patrols[i].Rings := FNewPatrols[k].Rings; Result.Patrols[i].Sectors := FNewPatrols[k].Sectors; Result.Patrols[i].IsNew := True; end; end; // CC 20260924 aircraft assigned to new patrols leave their deck count if Length(FNewPatrols) > 0 then begin Result.Assets := Copy(snap.Assets); for i := 0 to Length(Result.Assets) - 1 do for k := 0 to Length(FNewPatrols) - 1 do if FNewPatrols[k].AssetUUID = Result.Assets[i].UUID then if Result.Assets[i].PlatNow > FNewPatrols[k].Number then Dec(Result.Assets[i].PlatNow, FNewPatrols[k].Number) else Result.Assets[i].PlatNow := 0; end; lStaged := TargetZones(snap); Result.Zones := lStaged; // dynamic arrays are shared, not copy-on-write: copy before changing units Result.Units := Copy(snap.Units); for i := 0 to Length(Result.Units) - 1 do begin k := FindStagedStation(snap.Units[i].UUID); if (k >= 0) and FStagedStations[k].HasMove then begin // CC 20260924 phase 3: a dragged station, rescaled if the rings changed // since; its ring/sector follow its new position (GE MoveAndSetPosition) ScaleStationForZones(FStagedStations[k].XOff, FStagedStations[k].YOff, FStagedStations[k].Zones, lStaged, x, y); Result.Units[i].xOff := x; Result.Units[i].yOff := y; FindRingSector(x, y, lStaged, Result.Units[i].Rings, Result.Units[i].Sectors); end else if StationMovesWithRings(snap, snap.Units[i]) then begin ScaleStationForZones(snap.Units[i].xOff, snap.Units[i].yOff, snap.Zones, lStaged, x, y); Result.Units[i].xOff := x; Result.Units[i].yOff := y; end; // CC 20260924 a Shift+click area replaces the ring/sector if (k >= 0) and FStagedStations[k].HasArea then begin Result.Units[i].Rings := FStagedStations[k].Rings; Result.Units[i].Sectors := FStagedStations[k].Sectors; end; end; end; // CC 20260924 phase 3: the ring sizes stations are staged against - the editor's // staged sizes while it has any, else HC's function TfrmMain.TargetZones(const snap: TGroupSnapshot): TFormationZones; begin if (frmFormationEditor <> nil) and frmFormationEditor.HasStaging then Result := frmFormationEditor.StagedZones else Result := snap.Zones; end; function TfrmMain.FindStagedStation(const aUUID: string): Integer; begin Result := Length(FStagedStations) - 1; while (Result >= 0) and (FStagedStations[Result].UUID <> aUUID) do Dec(Result); end; procedure TfrmMain.ClearStagedStations; begin SetLength(FStagedStations, 0); SetLength(FStagedPatrols, 0); // CC 20260924 SetLength(FNewPatrols, 0); SetLength(FCancelPatrols, 0); if FStationDrag.Active then // CC 20260924 review: give the globe its panning back begin FStationDrag.Active := False; glbMap.MouseRotateButton := mzbLeft; end; if frmFormationEditor <> nil then frmFormationEditor.SetStationsStaged(False); end; // CC 20260924 review: drop staged changes for units and patrols that are gone // from the focus group (destroyed, landed, a patrol ended), so the editor // doesn't show changes that Apply would do nothing with procedure TfrmMain.PruneStaged(const snap: TGroupSnapshot); var i, k: Integer; lFound, lChanged: Boolean; begin if not snap.IsFocus then Exit; lChanged := False; i := Length(FStagedStations) - 1; while i >= 0 do begin lFound := False; for k := 0 to Length(snap.Units) - 1 do if snap.Units[k].UUID = FStagedStations[i].UUID then lFound := True; if not lFound then begin if FStationDrag.Active and (FStationDrag.UUID = FStagedStations[i].UUID) then begin FStationDrag.Active := False; glbMap.MouseRotateButton := mzbLeft; end; FStagedStations[i] := FStagedStations[Length(FStagedStations) - 1]; SetLength(FStagedStations, Length(FStagedStations) - 1); lChanged := True; end; Dec(i); end; i := Length(FStagedPatrols) - 1; while i >= 0 do begin lFound := False; for k := 0 to Length(snap.Patrols) - 1 do if snap.Patrols[k].EventUUID = FStagedPatrols[i].EventUUID then lFound := True; if not lFound then begin FStagedPatrols[i] := FStagedPatrols[Length(FStagedPatrols) - 1]; SetLength(FStagedPatrols, Length(FStagedPatrols) - 1); lChanged := True; end; Dec(i); end; i := Length(FCancelPatrols) - 1; while i >= 0 do begin lFound := False; for k := 0 to Length(snap.Patrols) - 1 do if snap.Patrols[k].EventUUID = FCancelPatrols[i] then lFound := True; if not lFound then begin FCancelPatrols[i] := FCancelPatrols[Length(FCancelPatrols) - 1]; SetLength(FCancelPatrols, Length(FCancelPatrols) - 1); lChanged := True; end; Dec(i); end; if lChanged and (frmFormationEditor <> nil) then frmFormationEditor.SetStationsStaged(AnyStaged); end; // CC 20260924 phase 3: with a unit or patrol selected, Shift+click inside the // formation adds that ring/sector cell to its area (GE MoveAndSetPosition with // Shift) and Ctrl+click makes the area just that cell. Neither moves a station. // Staged like a move; sent on Apply. function TfrmMain.EditSelectedArea(X, Y: Integer; aReset: Boolean): Boolean; var lView: TGroupSnapshot; pt: TPointLL; lLat, lLon, x2, y2: LongInt; lClickRings, lClickSectors, lRings, lSectors: UInt64; i, k: Integer; begin Result := False; if (FFocusUUID = '') or not FHaveFocusSnap or not FFocusSnap.IsFocus then Exit; if FFormSelUUID = '' then Exit; lView := StagedFocusView(FFocusSnap); // the selected thing's current (possibly staged) area i := -1; case FFormSelKind of fikUnit: begin i := Length(lView.Units) - 1; while (i >= 0) and (lView.Units[i].UUID <> FFormSelUUID) do Dec(i); if (i < 0) or not CanDragStation(FFocusSnap, FFocusSnap.Units[i]) then Exit; lRings := lView.Units[i].Rings; lSectors := lView.Units[i].Sectors; end; fikPatrol: begin i := Length(lView.Patrols) - 1; while (i >= 0) and (lView.Patrols[i].EventUUID <> FFormSelUUID) do Dec(i); if i < 0 then Exit; lRings := lView.Patrols[i].Rings; lSectors := lView.Patrols[i].Sectors; end; else Exit; end; Result := True; // a Shift/Ctrl+click in edit mode with something selected is ours glbMap.Projection.DeviceXYToLL(X, Y, pt); lLon := HCDegSliverLonF(GlobeUnitsToDecimal(pt.iLongX)); lLat := HCDegSliverLatF(GlobeUnitsToDecimal(pt.iLatY)); LatLonToFormationOffset(FFocusSnap.sLat, FFocusSnap.sLon, lLat, lLon, x2, y2); FindRingSector(x2, y2, lView.Zones, lClickRings, lClickSectors); if (lClickRings and EnabledRingsMask(lView.Zones)) = 0 then Exit; // outside the rings if aReset then begin lRings := lClickRings; lSectors := lClickSectors; end else ExtendPatrolArea(lRings, lSectors, lClickRings, lClickSectors); if FFormSelKind = fikUnit then begin if (lRings = lView.Units[i].Rings) and (lSectors = lView.Units[i].Sectors) then Exit; k := FindStagedStation(FFormSelUUID); if k < 0 then begin k := Length(FStagedStations); SetLength(FStagedStations, k + 1); FStagedStations[k] := Default(TStagedStation); FStagedStations[k].UUID := FFormSelUUID; end; FStagedStations[k].HasArea := True; FStagedStations[k].Rings := lRings; FStagedStations[k].Sectors := lSectors; end else begin if (lRings = lView.Patrols[i].Rings) and (lSectors = lView.Patrols[i].Sectors) then Exit; k := FindNewPatrol(FFormSelUUID); // CC 20260924 phase 4 if k >= 0 then begin FNewPatrols[k].Rings := lRings; FNewPatrols[k].Sectors := lSectors; if frmFormationEditor <> nil then frmFormationEditor.SetStationsStaged(True); ReapplyLastSnapshot; Exit; end; k := Length(FStagedPatrols) - 1; while (k >= 0) and (FStagedPatrols[k].EventUUID <> FFormSelUUID) do Dec(k); if k < 0 then begin k := Length(FStagedPatrols); SetLength(FStagedPatrols, k + 1); FStagedPatrols[k].EventUUID := FFormSelUUID; end; FStagedPatrols[k].Rings := lRings; FStagedPatrols[k].Sectors := lSectors; end; if frmFormationEditor <> nil then frmFormationEditor.SetStationsStaged(True); ReapplyLastSnapshot; end; function TfrmMain.AnyStaged: Boolean; begin Result := (Length(FStagedStations) > 0) or (Length(FStagedPatrols) > 0) or (Length(FNewPatrols) > 0) or (Length(FCancelPatrols) > 0); end; function TfrmMain.FindNewPatrol(const aUUID: string): Integer; begin Result := Length(FNewPatrols) - 1; while (Result >= 0) and (FNewPatrols[Result].TempUUID <> aUUID) do Dec(Result); end; function TfrmMain.CancelStagedIdx(const aUUID: string): Integer; begin Result := Length(FCancelPatrols) - 1; while (Result >= 0) and (FCancelPatrols[Result] <> aUUID) do Dec(Result); end; // CC 20260924 phase 4: stage a new patrol from a deck asset. It starts over // Main Body (the GE's CreateAirPatrol default) and is selected, so Shift/Ctrl+ // click sets its area straight away. procedure TfrmMain.FormationAddPatrol(Sender: TObject; const aAssetUUID: string; aPatrolType: ShortInt; aCount: Integer); var lView: TGroupSnapshot; i, k: Integer; begin if not FHaveFocusSnap or not FFocusSnap.IsFocus then Exit; lView := StagedFocusView(FFocusSnap); i := Length(lView.Assets) - 1; while (i >= 0) and (lView.Assets[i].UUID <> aAssetUUID) do Dec(i); if i < 0 then Exit; if aCount > lView.Assets[i].PlatNow then aCount := lView.Assets[i].PlatNow; if aCount <= 0 then Exit; k := Length(FNewPatrols); SetLength(FNewPatrols, k + 1); FNewPatrols[k].TempUUID := 'new-' + GenerateUUID; FNewPatrols[k].AssetUUID := aAssetUUID; FNewPatrols[k].OwnerUnitUUID := lView.Assets[i].OwnerUnitUUID; FNewPatrols[k].PlaneID := lView.Assets[i].PlaneID; FNewPatrols[k].LoadID := lView.Assets[i].LoadID; FNewPatrols[k].PatrolType := aPatrolType; FNewPatrols[k].Number := aCount; FNewPatrols[k].Rings := MainBodyFlag; FNewPatrols[k].Sectors := 1; FFormSelKind := fikPatrol; FFormSelUUID := FNewPatrols[k].TempUUID; if FOverlay <> nil then FOverlay.SetSelection(fikPatrol, FFormSelUUID); if frmFormationEditor <> nil then begin frmFormationEditor.SetStationsStaged(True); frmFormationEditor.SelectItem(fikPatrol, FFormSelUUID); // applied once its row exists end; ReapplyLastSnapshot; end; // CC 20260924 phase 4: a new patrol is simply removed; an existing one toggles // between cancel-on-Apply and keep procedure TfrmMain.FormationCancelPatrol(Sender: TObject; const aPatrolUUID: string); var k: Integer; begin k := FindNewPatrol(aPatrolUUID); if k >= 0 then begin FNewPatrols[k] := FNewPatrols[Length(FNewPatrols) - 1]; SetLength(FNewPatrols, Length(FNewPatrols) - 1); end else begin k := CancelStagedIdx(aPatrolUUID); if k >= 0 then begin FCancelPatrols[k] := FCancelPatrols[Length(FCancelPatrols) - 1]; SetLength(FCancelPatrols, Length(FCancelPatrols) - 1); end else begin k := Length(FCancelPatrols); SetLength(FCancelPatrols, k + 1); FCancelPatrols[k] := aPatrolUUID; end; end; if frmFormationEditor <> nil then frmFormationEditor.SetStationsStaged(AnyStaged); ReapplyLastSnapshot; end; procedure TfrmMain.FormationRevert(Sender: TObject); begin ClearStagedStations; // the editor's OnStagedChanged that follows redraws end; // CC 20260924 phase 3: the station follows the mouse; only the overlay is // redrawn while dragging (the rings don't change) function TfrmMain.StationDragMove(X, Y: Integer): Boolean; var pt: TPointLL; lLat, lLon, x2, y2: LongInt; k: Integer; begin Result := FStationDrag.Active and FHaveFocusSnap and FFocusSnap.IsFocus; if not Result then Exit; // CC 20260924 a press-and-release on a marker only selects it if not FStationDrag.Moved then begin if Sqr(X - FStationDrag.StartX) + Sqr(Y - FStationDrag.StartY) < Sqr(4) then Exit; FStationDrag.Moved := True; end; glbMap.Projection.DeviceXYToLL(X, Y, pt); lLon := HCDegSliverLonF(GlobeUnitsToDecimal(pt.iLongX)); lLat := HCDegSliverLatF(GlobeUnitsToDecimal(pt.iLatY)); LatLonToFormationOffset(FFocusSnap.sLat, FFocusSnap.sLon, lLat, lLon, x2, y2); k := FindStagedStation(FStationDrag.UUID); if k < 0 then begin k := Length(FStagedStations); SetLength(FStagedStations, k + 1); FStagedStations[k] := Default(TStagedStation); FStagedStations[k].UUID := FStationDrag.UUID; end; FStagedStations[k].HasMove := True; FStagedStations[k].XOff := x2; FStagedStations[k].YOff := y2; FStagedStations[k].Zones := TargetZones(FFocusSnap); FStagedStations[k].HasArea := False; // a move resets the area to its own cell if FOverlay <> nil then FOverlay.Show(StagedFocusView(FFocusSnap), FocusDispSide(FFocusSnap)); end; procedure TfrmMain.FormationStagedChanged(Sender: TObject); begin ReapplyLastSnapshot; // redraw the preview end; // CC 20260924 phase 2 Apply, as the GE editor's OK: ring sizes, then (if the // box is ticked and any ship moves) the reform slowdown, then one station order // per unit whose scaled station differs from HC's. One batch, so HC's thread // never sees half of it. procedure TfrmMain.FormationApply(Sender: TObject); var lReqs: array of THCCallbackRequest; lStations: array of THCCallbackRequest; lReq: THCCallbackRequest; lStaged: TFormationZones; lView: TGroupSnapshot; lPatrolReqs: array of THCCallbackRequest; lZonesSent: Boolean; // CC 20260924 review i, k, n: Integer; x, y: LongInt; begin if (frmFormationEditor = nil) or not FHaveFocusSnap or not FFocusSnap.IsFocus then Exit; // CC 20260924 phase 3: the staged view already holds every unit's new station // (scaled with its ring, or dragged) and ring/sector lView := StagedFocusView(FFocusSnap); lStaged := lView.Zones; lStations := nil; for i := 0 to Length(FFocusSnap.Units) - 1 do begin x := lView.Units[i].xOff; y := lView.Units[i].yOff; if (x = FFocusSnap.Units[i].xOff) and (y = FFocusSnap.Units[i].yOff) and (lView.Units[i].Rings = FFocusSnap.Units[i].Rings) and (lView.Units[i].Sectors = FFocusSnap.Units[i].Sectors) then Continue; lReq := Default(THCCallbackRequest); lReq.Kind := cbkSetUnitStation; lReq.GroupUUID := FFocusSnap.UUID; lReq.UnitUUID := FFocusSnap.Units[i].UUID; lReq.XOff := x; lReq.YOff := y; lReq.Rings := lView.Units[i].Rings; lReq.Sectors := lView.Units[i].Sectors; n := Length(lStations); SetLength(lStations, n + 1); lStations[n] := lReq; end; // CC 20260924 patrol areas; an airborne patrol aircraft is sent to a random // point in its new area, as HC's own patrol cycle would pick one lPatrolReqs := nil; for i := 0 to Length(FFocusSnap.Patrols) - 1 do begin if lView.Patrols[i].CancelStaged then begin // CC 20260924 phase 4: cancelling beats any area change lReq := Default(THCCallbackRequest); lReq.Kind := cbkCancelPatrol; lReq.GroupUUID := FFocusSnap.UUID; lReq.PatrolUUID := FFocusSnap.Patrols[i].EventUUID; n := Length(lPatrolReqs); SetLength(lPatrolReqs, n + 1); lPatrolReqs[n] := lReq; Continue; end; if (lView.Patrols[i].Rings = FFocusSnap.Patrols[i].Rings) and (lView.Patrols[i].Sectors = FFocusSnap.Patrols[i].Sectors) then Continue; lReq := Default(THCCallbackRequest); lReq.Kind := cbkSetPatrolArea; lReq.GroupUUID := FFocusSnap.UUID; lReq.PatrolUUID := FFocusSnap.Patrols[i].EventUUID; lReq.Rings := lView.Patrols[i].Rings; lReq.Sectors := lView.Patrols[i].Sectors; n := Length(lPatrolReqs); SetLength(lPatrolReqs, n + 1); lPatrolReqs[n] := lReq; if FFocusSnap.Patrols[i].AircraftUnitUUID <> '' then for k := 0 to Length(FFocusSnap.Units) - 1 do if (FFocusSnap.Units[k].UUID = FFocusSnap.Patrols[i].AircraftUnitUUID) and (FFocusSnap.Units[k].CombatFlag = 0) and RandomPointInArea(lReq.Rings, lReq.Sectors, lView.Zones, x, y) then begin lReq.Kind := cbkSetUnitStation; lReq.UnitUUID := FFocusSnap.Units[k].UUID; lReq.XOff := x; lReq.YOff := y; n := Length(lPatrolReqs); SetLength(lPatrolReqs, n + 1); lPatrolReqs[n] := lReq; Break; end; end; // CC 20260924 phase 4: new patrols, 5 s apart as the GE posts them for i := 0 to Length(FNewPatrols) - 1 do begin lReq := Default(THCCallbackRequest); lReq.Kind := cbkCreatePatrol; lReq.GroupUUID := FFocusSnap.UUID; lReq.PlaneID := FNewPatrols[i].PlaneID; lReq.LoadID := FNewPatrols[i].LoadID; lReq.PatrolType := FNewPatrols[i].PatrolType; lReq.PatrolNumber := FNewPatrols[i].Number; lReq.Rings := FNewPatrols[i].Rings; lReq.Sectors := FNewPatrols[i].Sectors; lReq.DelaySec := 5 * i; n := Length(lPatrolReqs); SetLength(lPatrolReqs, n + 1); lPatrolReqs[n] := lReq; end; // CC 20260924 review: ring sizes only when edited, so an Apply of stations // alone doesn't write back a stale copy of HC's sizes lReqs := nil; lZonesSent := frmFormationEditor.ZonesDirty; if lZonesSent then begin lReq := Default(THCCallbackRequest); lReq.Kind := cbkSetFormationZones; lReq.GroupUUID := FFocusSnap.UUID; lReq.Zones := lStaged; lReq.RingCount := frmFormationEditor.StagedRingCount; SetLength(lReqs, 1); lReqs[0] := lReq; end; if (Length(lStations) > 0) and frmFormationEditor.SlowForReform then begin lReq := Default(THCCallbackRequest); lReq.Kind := cbkSlowGroupForReform; lReq.GroupUUID := FFocusSnap.UUID; n := Length(lReqs); SetLength(lReqs, n + 1); lReqs[n] := lReq; end; n := Length(lReqs); SetLength(lReqs, n + Length(lStations)); for i := 0 to Length(lStations) - 1 do lReqs[n + i] := lStations[i]; n := Length(lReqs); SetLength(lReqs, n + Length(lPatrolReqs)); for i := 0 to Length(lPatrolReqs) - 1 do lReqs[n + i] := lPatrolReqs[i]; QueueHCCallbacks(lReqs); SetLength(FStagedStations, 0); // now HC orders SetLength(FStagedPatrols, 0); SetLength(FNewPatrols, 0); SetLength(FCancelPatrols, 0); frmFormationEditor.MarkApplied(lZonesSent); ReapplyLastSnapshot; end; // CC 20260924 the focus group's snapshot was just applied (tick or reapply) procedure TfrmMain.ApplyFocusSnapshot(const snap: TGroupSnapshot); begin FFocusSeen := True; FFocusSnap := snap; FHaveFocusSnap := True; PruneStaged(snap); // CC 20260924 review // IsFocus is False until HC has captured with the new focus (e.g. while paused) if FOverlay <> nil then begin if snap.IsFocus then FOverlay.Show(StagedFocusView(snap), FocusDispSide(snap)) // CC 20260924 else FOverlay.Hide; end; if FFocusZoomPending and snap.IsFocus then begin FFocusZoomPending := False; FitFormationZoom(snap); // only re-zooms when the rings reach further out end; UpdatePausedState; if frmFormationEditor <> nil then frmFormationEditor.UpdateFromSnapshot(snap, StagedFocusView(snap), FGamePaused, FocusDispSide(snap)); end; // CC 20260924 centre on the group and zoom so its outermost drawn ring fits. // A later call (first focus capture) only zooms again when it must zoom out. procedure TfrmMain.FitFormationZoom(const snap: TGroupSnapshot); var i, lOuterNM, lMinPx: Integer; lDrawn: UInt64; lPos: TPointLL; begin lDrawn := DrawnRingsMask(snap); lOuterNM := 0; for i := 0 to MAX_FORMATION_ZONES - 1 do if ((lDrawn and (UInt64(1) shl i)) <> 0) and (snap.Zones[i] > lOuterNM) then lOuterNM := snap.Zones[i]; if (lOuterNM <= 0) or (lOuterNM <= FFocusZoomNM) then Exit; FFocusZoomNM := lOuterNM; lMinPx := glbMap.ClientWidth; if glbMap.ClientHeight < lMinPx then lMinPx := glbMap.ClientHeight; if lMinPx <= 0 then Exit; lPos := PointLLH(DecimalToGlobeUnits(HCLon2Deg(snap.sLon)), DecimalToGlobeUnits(HCLat2Deg(snap.sLat)), 0); glbMap.LocateToLL(lPos.iLongX, lPos.iLatY); // ScaleFactor is device pixels per globe unit glbMap.Projection.ScaleFactor := FORMATION_FIT_FRACTION * lMinPx / (2.0 * GlobeUnitsFrom(lOuterNM, NauticalMile)); end; // CC 20260924 "paused" = no new snapshot generation for PAUSE_DETECT_MS. HC does // not call GameTime while paused, so captures stop; there is no direct pause // flag. Polled every PAUSE_CHECK_MS while in edit mode; a change refreshes the // editor's status line from the last focus snapshot. procedure TfrmMain.UpdatePausedState; var lGen: LongInt; lPaused: Boolean; begin if FFocusUUID = '' then Exit; lGen := gSnapshotGeneration; if lGen <> FPauseGen then begin FPauseGen := lGen; FPauseTick := GetTickCount64; end; lPaused := (GetTickCount64 - FPauseTick) > PAUSE_DETECT_MS; if lPaused = FGamePaused then Exit; FGamePaused := lPaused; if (frmFormationEditor <> nil) and FHaveFocusSnap then frmFormationEditor.UpdateFromSnapshot(FFocusSnap, StagedFocusView(FFocusSnap), FGamePaused, FocusDispSide(FFocusSnap)); end; // CC 20260924 editor closed by the user (its FormClose already nil'd the var) procedure TfrmMain.FormationEditorClosed(Sender: TObject); begin ExitFormationEdit(True); end; // CC 20260924 editor row picked -> highlight it on the globe procedure TfrmMain.FormationEditorSelect(Sender: TObject; aKind: TFormationItemKind; const aUUID: string); begin FFormSelKind := aKind; // CC 20260924 FFormSelUUID := aUUID; if FOverlay <> nil then FOverlay.SetSelection(aKind, aUUID); end; end.