unit MainForm; {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, ComCtrls, Spin, ExtCtrls, uHCTypeDefs, uHCAnnexDefs, uHCAnnexHelpers, uLazGUIGlobals ,CheckLst, XMLPropStorage, Menus, EditBtn, uHCUtils; type { TfrmMain } TfrmMain = class(TForm) AddLeg: TButton; AirSplit: TButton; ASWbtn: TButton; AFPbtnList: TButton; AFPbtnFinish: TButton; EWbtn: TButton; CAPbtn: TButton; AEWbtn: TButton; InsertLeg: TButton; AFPlbxAirPatList: TListBox; AFPlblRng: TLabel; AFPlblSct: TLabel; AFPmemRngDesc: TMemo; AFPmemSctDesc: TMemo; PressKeyList: TListBox; Messages: TMemo; PlotDepths: TButton; SGButtonDepthChk: TButton; Direct: TLabeledEdit; SetCourse: TButton; SGbtnCover: TButton; SGlblEUnits: TLabel; SGlbxEUnits: TListBox; SGlblEGroup: TLabel; SGlbxEGroup: TListBox; SGButtonResume: TButton; SGButtonRefresh: TButton; SGListBoxUnitInfo: TListBox; SGlblGroups: TLabel; SGlblUnits: TLabel; SGlbxGroups: TListBox; SGlbxUnits: TListBox; SGpnl1: TPanel; SGlblDesc: TLabel; LegDistance: TSpinEdit; PatRad: TSpinEdit; AFPspnedRng: TSpinEdit; AFPspnedSct: TSpinEdit; tshAirFormPat: TTabSheet; tshStartGroup: TTabSheet; PageControl1: TPageControl; // procedure DUbtnUpdateClick(Sender: TObject); procedure AddLegClick(Sender: TObject); procedure AddLegKeyPress(Sender: TObject; var Key: char); procedure AEWbtnClick(Sender: TObject); procedure AFPbtnFinishClick(Sender: TObject); procedure AFPbtnListClick(Sender: TObject); procedure AFPlbxAirPatListKeyPress(Sender: TObject; var Key: char); procedure AFPlbxAirPatListSelectionChange(Sender: TObject; User: boolean); procedure AFPspnedRngEditingDone(Sender: TObject); procedure AFPspnedSctEditingDone(Sender: TObject); procedure AFPspnedSctKeyPress(Sender: TObject; var Key: char); procedure AirSplitKeyPress(Sender: TObject; var Key: char); procedure ASWbtnClick(Sender: TObject); procedure CAPbtnClick(Sender: TObject); procedure DirectChange(Sender: TObject); procedure EWbtnClick(Sender: TObject); procedure FormShow(Sender: TObject); procedure InsertLegClick(Sender: TObject); procedure InsertLegKeyPress(Sender: TObject; var Key: char); procedure MessagesKeyPress(Sender: TObject; var Key: char); procedure PlotDepthsClick(Sender: TObject); procedure SetCourseClick(Sender: TObject); procedure SetCourseKeyPress(Sender: TObject; var Key: char); procedure SGbtnCoverKeyPress(Sender: TObject; var Key: char); procedure SGButtonDepthChkClick(Sender: TObject); procedure SGlblUnitKtsFill(); procedure SGButtonRefreshClick(Sender: TObject); procedure SGButtonResumeClick(Sender: TObject); procedure SGlbxEGroupKeyPress(Sender: TObject; var Key: char); procedure SGlbxEGroupSelectionChange(Sender: TObject; User: boolean); procedure SGlbxEUnitsEnter(Sender: TObject); procedure SGlbxEUnitsKeyPress(Sender: TObject; var Key: char); procedure SGlbxEUnitsSelectionChange(Sender: TObject; User: boolean); procedure SGlbxGroupsDblClick(Sender: TObject); procedure SGlbxGroupsKeyPress(Sender: TObject; var Key: char); procedure SGlbxGroupsSelectionChange(Sender: TObject; User: boolean); // procedure SGCurntSpdSpnEdEditingDone(Sender: TObject); // procedure SGesmSpnEdChange(Sender: TObject); // procedure SGlblSpnEdAIChanceClick(Sender: TObject); procedure SGlbxUnitsUpdate(Sender: TObject); //; User: boolean); //250611 detached procedure SGlbxUnitsDblClick(Sender: TObject); procedure SGlbxUnitsKeyPress(Sender: TObject; var Key: char); procedure SGlbxUnitsSelectionChange(); // 240613 (Sender: TObject; User: boolean); procedure SGListBoxUnitInfoKeyPress(Sender: TObject; var Key: char); procedure UNbtnResumeClick(Sender: TObject); procedure DelPath(SGroup:PHCGroup); procedure AtkBtnCoverClick(Sender: TObject); procedure SetGroupSpeedAlt(ThisGroup: PHCGroup; intThrottle: integer; intAltBand: uchar); procedure PostMessage(strMessageEvent: String; PThisGroup: PHCGroup); procedure AirSplitClick(Sender: TObject); procedure SqPatrl(SGroup:PHCGroup;PatType:Integer); // 250618 function HCMT2String(const ValHCMT: HCMT): string; function Side2String(const ThisSide: uchar): string; function Showing2String(const intShow: integer): String; function DetQuality2String(const intQual: integer): String; function GetLastleg(SGroup:PHCGroup): PHCPathRec; function LatFctGrp(SGroup:PHCGroup):double; function getLoiterKts(ThisGroup: PHCGroup): short; private { private declarations } public { public declarations } // ALE 20130812 Big bad pointers that hold most of the game data PStartGroup, PSelectedGroup, PSelectedEGroup, PHCSGThis, PMessGrp: PHCGroup; PHCEventHead, PEvent: PHCHarpoonEvent; PAirPatrolEvent: PHCAirPatrolEvent; PFormationEvent: PHCFormationEvent; PSonobuoyRegionHead: PHCSonobuoyRegion; PAllDeadUnitsPtr: PHCDeadListItem; PWeatherGroups, gPActGroup: PHCGroup; PVCList: PHCVictoryConditions; // ALE 20130812 transient pointers PSelectedUnit, PEventUnit, gPHCtopUnit: PHCUnit; // ALE 20130812 misc globals //blnInvestigatingStructs: Boolean; // ALE 20130908 pointers to functions exported by the GE HCQueueHarpoonEvent: THCQueueHarpoonEvent; NewPtr: THCNewPtr; DisposPtr: THCDisposPtr; del_HarpoonEvent_list: THCdel_HarpoonEvent_list; HCdllCheckLatLonDepth: THCdllCheckLatLonDepth; HCannex_id_to_disk_id: THCannex_id_to_disk_id; HCdisk_id_to_annex_id: THCdisk_id_to_annex_id; HCChangeActGroupPtr: THCChangeActGroupPtr; HCChangeActUnitPtr: THCChangeActUnitPtr; intPSide, intESide: uchar; strSide, strOSide, gStrEventType: string; HCfree_Unit: THCfree_Unit; HCfree_Group: THCfree_Group; intGTNow, gTicker: LongInt; end; var frmMain: TfrmMain; dblLatFact: Double; implementation uses uHCDefines, uHCEventHelpers; {$R *.lfm} { TfrmMain } function TfrmMain.Side2String(const ThisSide: uchar): string; begin case ThisSide of 0: result:= 'Blue'; 1: result:= 'Red'; 2: result:= 'Green'; else result:= 'Unknown'; end; end; function TfrmMain.GetLastleg(SGroup:PHCGroup): PHCPathRec; var PPathLeg, PPathLegPrev: PHCPathRec; begin // lets hooe that SGroup <> nil PPathLeg := SGroup^.track; if ((PPathLeg <> nil) AND (PPathLeg^.next <> nil)) then begin while (PPathLeg^.next <> nil) do begin PPathLeg := PPathLeg^.next; end; result:= PPathLeg; end else // single group track result:= SGroup^.track; end; procedure TfrmMain.DelPath(SGroup:PHCGroup); var PPathLeg, PPathLegPrev: PHCPathRec; begin // ALE 20130411 Delete the existing path leg by leg. PPathLeg := SGroup^.track; if ((PPathLeg <> nil) AND (PPathLeg^.next <> nil)) then begin PPathLegPrev := nil; // huh? while (PPathLeg^.next <> nil) do begin PPathLegPrev := PPathLeg; PPathLeg := PPathLeg^.next; end; end; // ALE 20130411 PPathLeg should now point to the last // leg of the group's path, work backwards freeing them. if (PPathLeg <> nil) then begin while (PPathLeg <> SGroup^.track) do begin PPathLegPrev := PPathLeg^.prev; del_HarpoonEvent_list(PPathLeg^.pathEvents); DisposPtr(PPathLeg); PPathLeg := PPathLegPrev; end; PPathleg^.next:= nil; end; end; procedure TfrmMain.PostMessage(strMessageEvent: String; PThisGroup: PHCGroup); var intX: Integer; begin intX:= 15; while Messages.Lines.Count > intX do begin Messages.Lines.Delete(1); end; // 250621 if PThisGroup <> nil then begin Messages.Lines.Add(format('Group %3.3s: %s',[PThisGroup^.id, strMessageEvent])); PMessGrp := PThisGroup; end else begin Messages.Lines.Add(strMessageEvent); PMessGrp:= nil; end; // Messages.SetFocus; end; procedure TfrmMain.SetGroupSpeedAlt(ThisGroup: PHCGroup; intThrottle: integer; intAltBand: uchar); var PThisUnit: PHCUnit; GroupKts: short; // note, very low and very high alts aren't implimented startAltBand: uchar; PThisPlaneDisk: PHCAnnexB1_disk; begin if (ThisGroup^.Units^.Air <> nil) then //only for airgroups use group*type might be better? begin startAltBand:= intAltBand; PThisUnit:= ThisGroup^.Units; // ddt we must first check all units can operate at requested alt repeat PThisPlaneDisk:= HCAnnexHelper.HCGetAnnexB1(PthisUnit^.Annex); if (PThisPlaneDisk^.MaxAlt < intAltBand) then intAltBand := PThisPlaneDisk^.MaxAlt; // 240528 test if altband is vlow is unit noe capaable or helo if (intAltBand = 11) then if ((PThisPlaneDisk^.UnitFlags AND UF_B1_NOE) <= 0) and not(PThisUnit^.utype = MT_HELO) then intAltBand := 12; // ? PThisUnit:= PThisUnit^.next; until (PThisUnit = nil); // gone thru all units and have altitude val // if altBand has been restricted then modify throttle value if (startAltBand <> intAltBand) and (intThrottle > 0) then intThrottle:= intThrottle - (startAltBand - intAltBand); // if requested throttle = burner then must test if available all units if intThrottle > 6 then begin PThisUnit:= ThisGroup^.Units; repeat PThisPlaneDisk:= HCAnnexHelper.HCGetAnnexB1(PthisUnit^.Annex); if (PThisPlaneDisk^.SpeedLevels[intThrottle]) = 0 then begin intThrottle := intThrottle - 3; // max altitudes are already tested break; end; PThisUnit:= PThisUnit^.next; until PThisUnit = nil; end; // // then set kts to min speed of respective units for requested throttle PThisUnit:= ThisGroup^.Units; PThisPlaneDisk:= HCAnnexHelper.HCGetAnnexB1(PThisUnit^.Annex); // start with 1st unit nowcheck if any slower units GroupKts:= PThisPlaneDisk^.SpeedLevels[intThrottle]; while (PThisUnit^.next <> nil) do begin PThisUnit:= PThisUnit^.next; PThisPlaneDisk:= HCAnnexHelper.HCGetAnnexB1(PThisUnit^.Annex); if PThisPlaneDisk^.SpeedLevels[intThrottle] < GroupKts then GroupKts:= PThisPlaneDisk^.SpeedLevels[intThrottle]; end; // should have desired data, now apply to group // but first need to test for loiter and helos hover if intThrottle = 0 then begin PThisUnit:= ThisGroup^.Units; repeat PThisUnit^.Air^.Throttle:= 0; PThisUnit^.AltBand:= intAltBand; PThisPlaneDisk:= HCAnnexHelper.HCGetAnnexB1(PThisUnit^.Annex); if PThisPlaneDisk^.AType = 'H' then begin PThisUnit^.kts:= 0; GroupKts:= 0; end else PThisUnit^.kts:= PThisPlaneDisk^.SpeedLevels[0]; PThisUnit:= PThisUnit^.next; until (PThisUnit = nil); end else begin // start sub procedure for non loiter situation PThisUnit:= ThisGroup^.Units; repeat PThisUnit^.Air^.Throttle:= intThrottle; // could insert steps to test if a reduced throttle will meet group*kts PThisUnit^.AltBand:= intAltBand; // no idea what GE would think of that? PThisUnit^.kts:= GroupKts; PThisUnit:= PThisUnit^.next; until (PThisUnit = nil); end; // end sub procedure for non loiter situation ThisGroup^.kts:= GroupKts; end // finished, unless group wasn't air group else PostMessage('Sir,a request was made to set altitude/throttle of a non airgroup' , ThisGroup); end; procedure TfrmMain.AtkBtnCoverClick(Sender: TObject); var PNewPathLeg: PHCPathRec; PPathEvent1: PHCHarpoonEvent; PEndMessage: PHCMessageEvent; TargetLat, TargetLon: integer; lMessText: String; begin if (PSelectedGroup <> nil) and (PSelectedUnit <> nil) then if (HCIsValidUnit(PSelectedUnit, gPHCtopUnit) = CTRUE) then // 240809 add check if valid unit i don't think we need test if PSelectedGroup^.side = intPSide then begin if (PSelectedUnit^.showing[0] <> 0) then begin if PSelectedUnit^.UncertaintyRegion[0] = nil then begin TargetLat := PSelectedUnit^.sLat; TargetLon := PSelectedUnit^.sLon; end else // no exact fix begin TargetLat := (PSelectedUnit^.UncertaintyRegion[0]^.sLat[0] + PSelectedUnit^.UncertaintyRegion[0]^.sLat[2]) div 2; TargetLon := (PSelectedUnit^.UncertaintyRegion[0]^.sLon[0] + PSelectedUnit^.UncertaintyRegion[0]^.sLon[2]) div 2; end; if PSelectedgroup^.track = nil then begin PNewPathLeg := NewPtr(SizeOf(THCPathRec)); PSelectedGroup^.track:= PNewPathLeg; PSelectedGroup^.track^.next:= nil; PSelectedGroup^.track^.prev:= nil; end else DelPath(PSelectedGroup); PSelectedGroup^.track^.DestLat:= TargetLat; PSelectedGroup^.track^.DestLon:= TargetLon; lMessText:= Format('%3.3s reports in position and requests orders', [PSelectedGroup^.id]); PEndMessage:= NewPtr(SizeOf(THCMessageEvent)); PEndMessage^.Message:= lMessText; PEndMessage^.Side := ANYSIDE; // ddt 20230402 upgrade structure PEndMessage^.MessageFormat := Ord(THCTextTypes.ASCII); PPathEvent1:= NewPtr(SizeOf(THCHarpoonEvent)); PPathEvent1^.uuid := GenerateUUID; PPathEvent1^.DataPtr:= PEndMessage; PPathEvent1^.event_type := MESSAGE_EVENT; // or TimeDelta; PPathEvent1^.time_type:= TimeDelta; PPathEvent1^.in_scroll_flag:= 001; PPathEvent1^.ourGroup:= PSelectedGroup; PPathEvent1^.Time:= 0; PPathEvent1^.unit_uuid:= PSelectedGroup^.Units^.UUID; PPathEvent1^.next:= nil; PSelectedGroup^.track^.pathEvents:= PPathEvent1; if PSelectedGroup^.Units^.Air <> nil then //if air group check for loiter/hover begin if PSelectedGroup^.Units^.Air^.Throttle = 0 then // 250608 begin SetGroupSpeedAlt(PSelectedGroup, 1, 12); // cruise low altitude end; end; lMessText:= Format('%3.3s is proceeding to designated unit location', [PSelectedGroup^.id]); PostMessage(lMessText, PSelectedGroup); Messages.SetFocus; end else PostMessage('Sir we can not locate the lost contact', PSelectedGroup); end else PostMessage('You need to firstly select a unit to cover and then the player group to proceed there', PSelectedGroup); end; function TfrmMain.HCMT2String(const ValHCMT: HCMT): string; var strHCMT: string; begin case ValHCMT of MT_AC: result := 'Plane'; MT_HELO: result := 'Helo'; MT_CARRIER: result := 'Carrier'; MT_SHIP: result := 'Surface Vessel'; MT_SUB: result := 'Submarine'; MT_AIRFIELD: result := 'Airfield'; MT_PORT: result := 'Port'; MT_BASE: result := 'Port & Airfield'; MT_CITY: result := 'City'; MT_MISSILE: result := 'Missile'; MT_TORP: result := 'Torpedo'; MT_SAMFIXED: result := 'AD Fixed'; MT_SAMMOBILE: result := 'AD Mobile'; MT_CONVOY: result := 'Convoy'; MT_ARMORED: result := 'Armored'; else result := 'Unkn ' + IntToStr(ValHCMT); end; end; procedure TfrmMain.SGlbxUnitsUpdate(Sender: TObject); //; User: boolean); 250611 var strSel: String; PHCUThis: PHCUnit; lIntIndx, intDepthAlt: Integer; RLat, RLon: Double; begin if PSelectedGroup <> nil then if HCIsValidGroup(PSelectedGroup, PStartGroup) = CTRUE then // 250701 begin // 250611 split with group update // PSelectedUnit:= nil; // 250523 don't reset as might want to keep it for 'cover' function // maybe insert code to update the grouplist item PHCSGThis:= PSelectedGroup; SGlbxUnits.Items.Clear; SGlbxUnits.Sorted := False; if (PHCSGThis^.EnemyRange < 50) then SGlbxUnits.Items.Add(Format('Enemy Range %d nm',[PHCSGThis^.EnemyRange])); PHCUThis := PHCSGThis^.Units; // list units while (PHCUThis <> nil) do begin if PHCUThis^.Missile = nil // 240907 add missile test and platNo then begin if PHCUThis^.Air = nil then // no airunits SGlbxUnits.Items.Add(Format('%0.3d %s Y/X %d / %d', [PHCUThis^.id, PHCUThis^.name, round(PHCUThis^.yOff/UHCDefines.NM1), round(PHCUThis^.xOff/UHCDefines.NM1)])) else // has air units SGlbxUnits.Items.Add(Format('%0.3d %d %s Y/X %d / %d', [PHCUThis^.id, PHCUThis^.Air^.PlatNow, PHCUThis^.name, round(PHCUThis^.yOff/UHCDefines.NM1), round(PHCUThis^.xOff/UHCDefines.NM1)])); end // unit not missile //begin //SGlbxUnits.Items.Add(Format('%0.3d %s Y/X %d / %d', // [PHCUThis^.id, PHCUThis^.name, round(PHCUThis^.yOff/UHCDefines.NM1), // round(PHCUThis^.xOff/UHCDefines.NM1)])); //end // unit not missile else // unit is missile SGlbxUnits.Items.Add(Format('%0.3d %d %s, %d secs to Target', [PHCUThis^.id, PHCUThis^.Missile^.PlatNow, PHCUThis^.name, PHCUThis^.Missile^.tTime])); PHCUThis := PHCUThis^.next; end; if PHCSGThis^.Units^.Missile <> nil then begin if PHCSGThis^.Units^.Missile^.targetUnit <> nil then strSel:= Format('%2.2s',[PHCGroup(PHCUnit(PHCSGThis^.Units^.Missile^.targetUnit)^.Group)^.id]) else strSel:= 'Nil'; end; end else SGlbxUnits.Items.Add('Selected Group no longer valid'); // test for valid group end; procedure TfrmMain.SGlbxUnitsDblClick(Sender: TObject); begin if PSelectedUnit <> nil then HCChangeActUnitPtr(PSelectedUnit); end; procedure TfrmMain.SGlbxUnitsKeyPress(Sender: TObject; var Key: char); begin case Key of 's', 'S': if PSelectedUnit <> nil then HCChangeActUnitPtr(PSelectedUnit); 'u', 'U': SGListBoxUnitInfo.SetFocus; 'n', 'N': AirSplit.Click; // 250615 AirSplit.SetFocus; 'd', 'D': PlotDepths.Click; //250610 'g', 'G': SGlbxGroups.SetFocus; // 250619 'k', 'K': PressKeyList.SetFocus; end; end; procedure TfrmMain.UNbtnResumeClick(Sender: TObject); begin Byte(PDLLBusy^) := CFALSE; end; // 250529 intro auto select with change of game select for player procedure TfrmMain.SGButtonRefreshClick(Sender: TObject); var PTGroup: PHCGroup; lStrLine: String; begin SGlbxGroups.Items.Clear; /// SGlbxGroups.Items.Insert(0, 'Player Groups'); // 250623 SGlbxEGroup.Items.Clear; // SGlbxEGroup.Items.Insert(0, 'Other Groups'); // 250623 SGlbxUnits.Items.Clear; SGlbxEUnits.Items.Clear; SGListBoxUnitInfo.Clear; // clear all boxs until a unit is selected 20230503 PTGroup := PStartGroup; while (PTGroup <> nil) do begin if intPSide = PTGroup^.side then begin lStrLine:= Format('%3.3s %d kts @ %3.3d Lat/Lon %2.1n/ %2.1n', [PTGroup^.id, PTGroup^.kts, PTGroup^.course, 90-(PTGroup^.sLat)/sliver1, (PTGroup^.sLon)/sliver1]); SGlbxGroups.Items.Add(lStrLine); if gPActGroup = PTGroup then SGlbxGroups.ItemIndex:= SGlbxGroups.Items.IndexOf(lStrLine); end else // enemy or neutral begin if PTGroup^.showing > 0 then // EGroup is showing to player 250608 added auto select from actgroup begin lStrLine:= Format('%3.3s %d kts @ %3.3d Lat/Lon %2.1n/ %2.1n', [PTGroup^.id, PTGroup^.kts, PTGroup^.course, 90-(PTGroup^.sLat)/sliver1, (PTGroup^.sLon)/sliver1]); SGlbxEGroup.Items.Add(lStrLine); if gPActGroup = PTGroup then SGlbxEGroup.ItemIndex:= SGlbxEGroup.Items.IndexOf(lStrLine); end; end; PTGroup := PTGroup^.toSouth; end; if gPActGroup <> nil // 250612 then if gPActGroup^.side = intPSide then begin; if SGlbxGroups.ItemIndex > -1 then SGlbxGroups.MakeCurrentVisible; // SGlbxGroups.SetFocus; // 250612 end else begin if SGlbxEGroup.ItemIndex > -1 then SGlbxEGroup.MakeCurrentVisible; // SGlbxEGroup.SetFocus; //250612 end; end; procedure TfrmMain.SGButtonResumeClick(Sender: TObject); begin if (SGButtonResume.Caption = 'RESUME') then begin Byte(PDLLBusy^) := CFALSE; SGButtonResume.Caption:= 'PAUSE'; end else begin Byte(PDLLBusy^) := CTRUE; SGButtonResume.Caption:= 'RESUME'; end; end; procedure TfrmMain.SGlbxEGroupKeyPress(Sender: TObject; var Key: char); begin case Key of 's', 'S': if PSelectedEGroup <> nil then begin HCChangeActGroupPtr(PSelectedEGroup); // changed from PHCGThis 250525 PostMessage(format('EGroup %3.3s selected active in game', [PSelectedEGroup^.id]),PSelectedEGroup); Messages.SetFocus; end; 'p', 'P': SGButtonResume.Click; 'g', 'G': SGlbxGroups.SetFocus; 'k', 'K': PressKeyList.SetFocus; end; end; function TfrmMain.LatFctGrp(SGroup:PHCGroup):double; begin result:= Cos((90-(SGroup^.sLat/sliver1))/57.2957); end; function TfrmMain.getLoiterKts(ThisGroup: PHCGroup): short; // 250618 var PThisUnit: PHCUnit; ltrKts: short; PThisPlaneDisk: PHCAnnexB1_disk; begin PThisUnit:= ThisGroup^.Units; PThisPlaneDisk:= HCAnnexHelper.HCGetAnnexB1(PThisUnit^.Annex); // start with 1st unit nowcheck if any slower units ltrKts:= PThisPlaneDisk^.SpeedLevels[0]; while (PThisUnit^.next <> nil) do begin PThisUnit:= PThisUnit^.next; PThisPlaneDisk:= HCAnnexHelper.HCGetAnnexB1(PThisUnit^.Annex); if PThisPlaneDisk^.AType = 'H' then ltrKts:= 0 // + should break else if ltrKts > PThisPlaneDisk^.SpeedLevels[0] then ltrKts := PThisPlaneDisk^.SpeedLevels[0]; end; Result:= ltrKts; end; procedure TfrmMain.SqPatrl(SGroup:PHCGroup;PatType:Integer); // 250618 var PPathLeg, PPathLegNext: PHCPathRec; fctr, intLegCnt, PatAltBand: integer; cLat, cLon: LongInt; LatFactor: double; PPathEvent1, PPathEvent2, PPathEvent3: PHCHarpoonEvent; PSpeedAltEventLoiter, PSpeedAltEventReset: PHCSpeedAltEvent; PEndMessage: PHCMessageEvent; PRadarSet: PHCIntermittentSensorsEvent; intSortieKts: short; SortieThrottle: uchar; begin if (SGroup^.Units^.Air = nil) then ShowMessage('Air Groups Only') else begin PostMessage('Setting AirGroup to Cruise at Patrol altitude', SGroup); case PatType of 0: begin PatAltBand:= 11; // 240528 set to vlow if allowed (tested in SetGroupSpeedAlt sortieThrottle:=1; end; 1: begin PatAltBand:= 15; sortieThrottle:= 3; end; 2: begin PatAltBand:= 13; sortieThrottle:= 2; end; 3: begin PatAltBand:= 15; sortieThrottle:= 3; end; end; SetGroupSpeedAlt(SGroup, sortieThrottle, PatAltBand); // group,throttle,altband // end; ddt 20180429 now setting cruise to patrol area for all situations // else ddt 1711?? called setgroupspeedalt so don't need to stop intSortieKts:= SGroup^.kts; //used to reset speed altband and throttle SortieThrottle:= SGroup^.Units^.Air^.Throttle; PatAltBand:= SGroup^.Units^.AltBand; // test for 0 size pattern and if so process existing path ELSE process hexPatrol if PatRad.Value = 0 then begin if SGroup^.track <> nil then begin PPathLeg:=SGroup^.track; while (PPathLeg^.next <> nil) do // if only one leg then should warn need two leg minimum begin // ................. PPathEvent1:= NewPtr(SizeOf(THCHarpoonEvent)); PPathEvent1^.uuid := GenerateUUID; PPathEvent2:= NewPtr(SizeOf(THCHarpoonEvent)); PPathEvent2^.uuid := GenerateUUID; PSpeedAltEventReset:= NewPtr(SizeOf(THCSpeedAltEvent)); PSpeedAltEventReset^.newAltBand:= PatAltBand; PSpeedAltEventReset^.newSpeed:= intSortieKts; PSpeedAltEventReset^.newThrottle:= SortieThrottle; PSpeedAltEventLoiter:= NewPtr(SizeOf(THCSpeedAltEvent)); PSpeedAltEventLoiter^.newAltBand:= PatAltBand; PSpeedAltEventLoiter^.newThrottle:= 0; PSpeedAltEventLoiter^.newSpeed:= getLoiterKts(SGroup); Case PatType of // set radar, no radar asw // 0: begin // end; 1: begin PRadarSet:= NewPtr(SizeOf(THCIntermittentSensorsEvent)); PRadarSet^.Duration:=60; PRadarSet^.gtype:=000; PRadarSet^.Zones[0]:=1; //set AS on main zone PRadarSet^.Zones[1]:=1; //set SS on main zone PRadarSet^.Interval:=10; PRadarSet^.Variance:=0; PRadarSet^.Toggle:=000; //start on end; 2: begin PRadarSet:= NewPtr(SizeOf(THCIntermittentSensorsEvent)); PRadarSet^.Duration:=60; PRadarSet^.gtype:=000; PRadarSet^.Zones[0]:=1; //set AS on main zone PRadarSet^.Zones[1]:=1; //set SS on main zone PRadarSet^.Interval:=5; PRadarSet^.Variance:=0; PRadarSet^.Toggle:=000; //start on end; 3: begin // EW PatType PRadarSet:= NewPtr(SizeOf(THCIntermittentSensorsEvent)); PRadarSet^.Duration:=150; PRadarSet^.gtype:=000; PRadarSet^.Zones[0]:=1; //set AS on main zone PRadarSet^.Zones[1]:=1; //set SS on main zone PRadarSet^.Interval:=3; PRadarSet^.Variance:=0; PRadarSet^.Toggle:=001; //start on end; end; // end case Pat Type to set radar if (patType <> 0) then begin PPathEvent3:= NewPtr(SizeOf(THCHarpoonEvent)); PPathEvent3^.uuid := GenerateUUID; PPathEvent3^.DataPtr:=PRadarSet; PPathEvent3^.event_type := INTERMITTENT_EVENT; // or TimeDelta; PPathEvent3^.time_type:= TimeNow; PPathEvent3^.Time:= 0; PPathEvent3^.in_scroll_flag:= 001; PPathEvent3^.ourGroup:= SGroup; PPathEvent3^.next:= nil; PPathEvent2^.next:= PPathEvent3; end else PPathEvent2^.next:= nil; // asw patType = no radar PPathEvent2^.ourGroup:= SGroup; PPathEvent2^.unit_uuid:= ''; // Will this work? PPathEvent2^.Time:= 120; // 2 mins at loiter hover PPathEvent2^.event_type := ALT_SPEED_EVENT; // or TimeDelta; PPathEvent2^.time_type:= TimeDelta; PPathEvent2^.in_scroll_flag:= 001; PPathEvent2^.DataPtr:=PSpeedAltEventReset; // have set up leg event 2 same for every pat type //case patType of //0: begin PPathEvent1^.DataPtr:= PSpeedAltEventLoiter; PPathEvent1^.event_type := ALT_SPEED_EVENT; // or TimeDelta; PPathEvent1^.time_type:= TimeNow; // end; //1: begin //PPathEvent1^.DataPtr:=PRadarSet; //PPathEvent1^.event_type := INTERMITTENT_EVENT; // or TimeDelta; // PPathEvent1^.time_type:= TimeDelta; // end; //2: begin //PPathEvent1^.DataPtr:=PRadarSet; //PPathEvent1^.event_type := INTERMITTENT_EVENT; // or TimeDelta; // PPathEvent1^.time_type:= TimeDelta; // end; // end; // end case setting up leg event 1 for respective pat type PPathEvent1^.unit_uuid:= ''; PPathEvent1^.in_scroll_flag:= 001; PPathEvent1^.ourGroup:= SGroup; PPathEvent1^.Time:= 0; PPathEvent1^.next:= PPathEvent2; PPathLeg^.pathEvents:= PPathEvent1; //................ PPathLeg:= PPathLeg^.next; end; // end going down legs end; // end there was a track else should warn need a track or a pattern size end // end pat size zero else begin // start guts DelPath(SGroup); //strips pointers & events out of any multi point path and delete path fctr:=PatRad.Value div 2; //approx NM scaling of box size first loop LatFactor:= LatFctGrp(SGroup); // corrects sLon for 'high' latitudes PPathLeg:= NewPtr(SizeOf(THCPathRec)); if (SGroup^.track <> nil) then begin cLat:= SGroup^.track^.DestLat; cLon:= SGroup^.track^.DestLon; //add patrol legs around end of current path leg end else begin cLat:= SGroup^.sLat; cLon:= SGroup^.sLon; end; // now setup first patrol leg PPathLeg^.DestLat:=cLat; // - (NM1*fctr) ddt 171116 mod pattern to spiral out from centre PPathLeg^.DestLon:=cLon; PPathEvent1:= NewPtr(SizeOf(THCHarpoonEvent)); PPathEvent1^.uuid := GenerateUUID; PPathEvent2:= NewPtr(SizeOf(THCHarpoonEvent)); PPathEvent2^.uuid := GenerateUUID; PSpeedAltEventReset:= NewPtr(SizeOf(THCSpeedAltEvent)); PSpeedAltEventReset^.newAltBand:= PatAltBand; PSpeedAltEventReset^.newSpeed:= intSortieKts; PSpeedAltEventReset^.newThrottle:= SortieThrottle; Case PatType of 0: begin PSpeedAltEventLoiter:= NewPtr(SizeOf(THCSpeedAltEvent)); PSpeedAltEventLoiter^.newAltBand:= PatAltBand; PSpeedAltEventLoiter^.newThrottle:= 0; PSpeedAltEventLoiter^.newSpeed:= getLoiterKts(SGroup); end; 1: begin PRadarSet:= NewPtr(SizeOf(THCIntermittentSensorsEvent)); PRadarSet^.Duration:=60; PRadarSet^.gtype:=000; PRadarSet^.Zones[0]:=1; //set AS on main zone PRadarSet^.Zones[1]:=1; //set SS on main zone PRadarSet^.Interval:=10; PRadarSet^.Variance:=0; PRadarSet^.Toggle:=000; //start on end; 2: begin PRadarSet:= NewPtr(SizeOf(THCIntermittentSensorsEvent)); PRadarSet^.Duration:=60; PRadarSet^.gtype:=000; PRadarSet^.Zones[0]:=1; //set AS on main zone PRadarSet^.Zones[1]:=1; //set SS on main zone PRadarSet^.Interval:=5; PRadarSet^.Variance:=0; PRadarSet^.Toggle:=000; //start on end; 3: begin PRadarSet:= NewPtr(SizeOf(THCIntermittentSensorsEvent)); PRadarSet^.Duration:=150; PRadarSet^.gtype:=000; PRadarSet^.Zones[0]:=1; //set AS on main zone PRadarSet^.Zones[1]:=1; //set SS on main zone PRadarSet^.Interval:=3; PRadarSet^.Variance:=0; PRadarSet^.Toggle:=000; //start on end; end; PPathEvent2^.next:= nil; PPathEvent2^.ourGroup:= SGroup; PPathEvent2^.unit_uuid:= ''; // Will this work? PPathEvent2^.Time:= 150; // 2 1/2 mins at loiter hover PPathEvent2^.event_type := ALT_SPEED_EVENT; // or TimeDelta; PPathEvent2^.time_type:= TimeDelta; PPathEvent2^.in_scroll_flag:= 001; PPathEvent2^.DataPtr:=PSpeedAltEventReset; case patType of 0: begin PPathEvent1^.DataPtr:= PSpeedAltEventLoiter; PPathEvent1^.event_type := ALT_SPEED_EVENT; // or TimeDelta; PPathEvent1^.time_type:= TimeDelta; end; 1: begin PPathEvent1^.DataPtr:=PRadarSet; PPathEvent1^.event_type := INTERMITTENT_EVENT; // or TimeDelta; PPathEvent1^.time_type:= TimeDelta; end; 2: begin PPathEvent1^.DataPtr:=PRadarSet; PPathEvent1^.event_type := INTERMITTENT_EVENT; // or TimeDelta; PPathEvent1^.time_type:= TimeDelta; end; 3: begin PPathEvent1^.DataPtr:=PRadarSet; PPathEvent1^.event_type := INTERMITTENT_EVENT; // or TimeDelta; PPathEvent1^.time_type:= TimeDelta; end; end; PPathEvent1^.unit_uuid:= ''; PPathEvent1^.in_scroll_flag:= 001; PPathEvent1^.ourGroup:= SGroup; PPathEvent1^.Time:= 0; PPathEvent1^.next:= PPathEvent2; PPathLeg^.pathEvents:= PPathEvent1; SGroup^.track:=PPathLeg; //now do remaining patrol legs for intLegCnt := 1 to 16 do // add to pattern by increasing intLegCnt and adding begin PPathLegNext:= NewPtr(SizeOf(THCPathRec)); // appropriate 'case' items PPathLeg^.next:= PPathLegNext; PPathLegNext^.prev:= PPathLeg; PPathLeg:= PPathLegNext; case intLegCnt of 1,9: begin PPathLeg^.DestLat:=cLat - Round(NM1*fctr*0.6); PPathLeg^.DestLon:=cLon + Round(NM1*fctr*0.6 / LatFactor); end; 2,10: begin PPathLeg^.DestLat:=cLat; PPathLeg^.DestLon:=cLon + Round(NM1*fctr / LatFactor); end; 3,11: begin PPathLeg^.DestLat:=cLat + Round(NM1*fctr*0.7); PPathLeg^.DestLon:=cLon + Round(NM1*fctr*0.7 / LatFactor); end; 4,12: begin PPathLeg^.DestLat:=cLat + (NM1*fctr); PPathLeg^.DestLon:=cLon; end; 5,13: begin PPathLeg^.DestLat:=cLat + Round(NM1*fctr*0.7); PPathLeg^.DestLon:=cLon - Round(NM1*fctr*0.7 / LatFactor); end; 6,14: begin PPathLeg^.DestLat:=cLat; PPathLeg^.DestLon:=cLon - Round(NM1*fctr / LatFactor); end; 7,15: begin PPathLeg^.DestLat:=cLat - Round(NM1*fctr*0.7); PPathLeg^.DestLon:=cLon - Round(NM1*fctr*0.7 / LatFactor); end; 8: begin fctr:= 2 * fctr; // div 3 ddt 171116 modify pattern to spiral out from centre PPathLeg^.DestLat:=cLat - (NM1*fctr); PPathLeg^.DestLon:=cLon; end; 16: begin // returns to pattern centre PPathLeg^.DestLat:= cLat; PPathLeg^.DestLon:= clon; end; end; PPathEvent1:= NewPtr(SizeOf(THCHarpoonEvent)); PPathEvent1^.uuid := GenerateUUID; PPathEvent2:= NewPtr(SizeOf(THCHarpoonEvent)); PPathEvent2^.uuid := GenerateUUID; PSpeedAltEventLoiter:= NewPtr(SizeOf(THCSpeedAltEvent)); PSpeedAltEventReset:= NewPtr(SizeOf(THCSpeedAltEvent)); PSpeedAltEventReset^.newAltBand:= SGroup^.Units^.AltBand; PSpeedAltEventReset^.newSpeed:= intSortieKts; PSpeedAltEventReset^.newThrottle:= SortieThrottle; PSpeedAltEventLoiter^.newAltBand:= PatAltBand; PSpeedAltEventLoiter^.newThrottle:= 0; PSpeedAltEventLoiter^.newSpeed:= getLoiterKts(SGroup); // set to speed from platform annex PPathEvent2^.next:= nil; PPathEvent2^.ourGroup:= SGroup; PPathEvent2^.unit_uuid:= ''; PPathEvent2^.Time:= 120; // 2 mins at loiter/hover PPathEvent2^.event_type := ALT_SPEED_EVENT; // or TimeDelta; PPathEvent2^.time_type:= TimeDelta; PPathEvent2^.in_scroll_flag:= 001; PPathEvent2^.DataPtr:=PSpeedAltEventReset; PPathEvent1^.DataPtr:= PSpeedAltEventLoiter; PPathEvent1^.event_type := ALT_SPEED_EVENT; // or TimeDelta; PPathEvent1^.time_type:= TimeDelta; PPathEvent1^.in_scroll_flag:= 001; PPathEvent1^.ourGroup:= SGroup; PPathEvent1^.Time:= 0; PPathEvent1^.unit_uuid:= ''; PPathEvent1^.next:= PPathEvent2; PPathLeg^.pathEvents:= PPathEvent1; end; PPathLeg^.next:=nil; PEndMessage:= NewPtr(SizeOf(THCMessageEvent)); PEndMessage^.Message:= 'Patrol complete, require orders'; PEndMessage^.Side := ANYSIDE; // ddt 20230402 upgrade structure PEndMessage^.MessageFormat := Ord(THCTextTypes.ASCII); PPathEvent2^.DataPtr:= PEndMessage; PPathEvent2^.event_type := MESSAGE_EVENT; // or TimeDelta; PPathEvent2^.time_type:= TimeDelta; PPathEvent2^.in_scroll_flag:= 001; PPathEvent2^.ourGroup:= SGroup; PPathEvent2^.Time:= 0; PPathEvent2^.unit_uuid:= SGroup^.Units^.UUID; end; // end 'guts' hexPatrol end; // was air group and finishsed end; procedure TfrmMain.SGlbxEGroupSelectionChange(Sender: TObject; User: boolean); var strSel: String; begin strSel := Copy(SGlbxEGroup.Items[SGlbxEGroup.ItemIndex],1,3); PHCSGThis := PStartGroup; while (PHCSGThis <> nil) do begin if (strSel = PHCSGThis^.id) then break; PHCSGThis := PHCSGThis^.toSouth; end; if PHCSGThis <> nil then begin PSelectedEGroup:= PHCSGThis; SGlbxEUnits.Items.Clear; // 250623 // PSelectedUnit:= nil; don't reset in case want to keep SGListBoxUnitInfo.Items.Clear; SGListBoxUnitInfo.Items.Insert(0, Format('%s %s', [Side2String(PHCSGThis^.side), HCMT2String(PHCSGThis^.gtype)])); SGListBoxUnitInfo.Items.Insert(1, Format('Grp Speed: %d/%d kts, course: %d degs', [PHCSGThis^.kts, PHCSGThis^.maxspeed, PHCSGThis^.course])); end else SGlbxEGroup.DeleteSelected; // 250621 end; procedure TfrmMain.SGlbxEUnitsEnter(Sender: TObject); var ThisUnitName: String; lIntDP: Integer; PHCUThis: PHCUnit; begin /// now produce list of e units SGlbxEUnits.Items.Clear; // PHCSGThis should have been just set from EGroup if PSelectedEGroup <> nil then begin // 250619 PSelectedGroup:= PHCSGThis; SGlbxEUnits.Sorted := False; // 250529 maybe put in 'close enemy distance' PHCUThis := PSelectedEGroup^.Units; // list units while (PHCUThis <> nil) do begin if (PHCUThis^.showing[0] <> 0) then begin if PHCUThis^.Data[0] >= cCLASS // section 250621 then ThisUnitName:= PHCUThis^.name else if PHCUThis^.Data[0] >=cTYPE then ThisUnitName:= HCMT2String(PHCUThis^.utype) else ThisUnitName:= 'Unknown Contact'; // section end if PHCUThis^.UncertaintyRegion[0] = nil then ThisUnitName:= '#-' + ThisUnitName; if PHCUThis^.Missile = nil // 240907 add missile test and platNo then // unit is not a missile begin if PHCUThis^.CurrDp > 0 then // unit is damaged begin lIntDP:= round(100*(PHCUThis^.CurrDp / PHCUThis^.OrigDp)); SGlbxEUnits.Items.Add(Format('%0.3d %s Y/X %d / %d, %0.2d %% Damage', [PHCUThis^.id, ThisUnitName, round(PHCUThis^.yOff/UHCDefines.NM1), round(PHCUThis^.xOff/UHCDefines.NM1), lIntDP])); end else // no unit damage begin if PHCUThis^.Air = nil then // no airunits SGlbxEUnits.Items.Add(Format('%0.3d %s Y/X %d / %d', [PHCUThis^.id, ThisUnitName, round(PHCUThis^.yOff/UHCDefines.NM1), round(PHCUThis^.xOff/UHCDefines.NM1)])) else // has air units SGlbxEUnits.Items.Add(Format('%0.3d %d %s Y/X %d / %d', [PHCUThis^.id, PHCUThis^.Air^.PlatNow, ThisUnitName, round(PHCUThis^.yOff/UHCDefines.NM1), round(PHCUThis^.xOff/UHCDefines.NM1)])); end; end // unit not missile else // unit is a missile SGlbxEUnits.Items.Add(Format('%2.2s%0.3d %d %s', [PSelectedEGroup^.id, PHCUThis^.id, PHCUThis^.Missile^.PlatNow, ThisUnitName])); end; PHCUThis := PHCUThis^.next; end; /// end end; procedure TfrmMain.SGlbxEUnitsKeyPress(Sender: TObject; var Key: char); begin case key of 'G', 'g': SGlbxGroups.SetFocus; 'U', 'u': SGListBoxUnitInfo.SetFocus; 'k', 'K': PressKeyList.SetFocus; end; end; procedure TfrmMain.SGlbxEUnitsSelectionChange(Sender: TObject; User: boolean); var PHCUThis: PHCUnit; strSel: String; begin strSel := Copy(SGlbxEUnits.Items[SGlbxEUnits.ItemIndex],1,3); // need a check for selected unit/group? no longer valid if HCIsValidGroup(PSelectedEGroup, PStartGroup) = CTRUE then // check group still valid begin PHCUThis := PSelectedEGroup^.Units; while (PHCUThis <> nil) do begin if (Format('%3.3d',[PHCUThis^.id]) = strSel) then break; PHCUThis := PHCUThis^.next; end; // ddt add unit information if (PHCUThis <> nil) then // test for valid unit begin PSelectedUnit:= PHCUThis; end; // now fill some extra info in detail box SGListBoxUnitInfo.Clear; SGListBoxUnitInfo.Items.Add(Format('Best AAW/ ASUW/ ASW: %2.1f/ %2.1f/ %2.1f', [PSelectedUnit^.BestAAWRange/10, PSelectedUnit^.BestASuWRange/10, PSelectedUnit^.BestASWRange/10])); end // end a valid EUnit selected else begin SGlbxEUnits.Clear; SGlbxEUnits.Items.Add('An invalid Enemy Unit was selected'); end; end; procedure TfrmMain.SGlbxGroupsDblClick(Sender: TObject); begin if PHCSGThis <> nil then HCChangeActGroupPtr(PHCSGThis); end; procedure TfrmMain.SGlbxGroupsKeyPress(Sender: TObject; var Key: char); begin case Key of 'f', 'F': SGButtonRefresh.Click; 's', 'S': if PHCSGThis <> nil then begin HCChangeActGroupPtr(PHCSGThis); PostMessage(Format('Group %3.3s made game active group',[PHCSGThis^.id]),PHCSGThis); Messages.SetFocus; end; 'k', 'K': PressKeyList.SetFocus; 'p', 'P': SGButtonResume.Click; // 250608 'd', 'D': LegDistance.SetFocus; 'c', 'C': SGbtnCover.Click; 'm', 'M': Messages.SetFocus; 'r', 'R': PatRad.SetFocus; 'g', 'G': SGlbxGroups.SetFocus; 'e', 'E': SGlbxEGroup.SetFocus; 'u', 'U': if SGListBoxUnitInfo.Focused = True then SGlbxUnits.SetFocus else SGListBoxUnitInfo.SetFocus; end; end; procedure TfrmMain.SGlbxGroupsSelectionChange(Sender: TObject; User: boolean); var strSel: String; begin SGlbxUnits.Clear; strSel := Copy(SGlbxGroups.Items[SGlbxGroups.ItemIndex],1,3); PHCSGThis := PStartGroup; while (PHCSGThis <> nil) do begin if (strSel = PHCSGThis^.id) then break; PHCSGThis := PHCSGThis^.toSouth; end; if PHCSGThis <> nil then begin PSelectedGroup:= PHCSGThis; SGListBoxUnitInfo.Items.Clear; // 20230603 add group info to the unit detail section SGListBoxUnitInfo.Items.Insert(0, Format('%s %s', [Side2String(PHCSGThis^.side), HCMT2String(PHCSGThis^.gtype)])); SGListBoxUnitInfo.Items.Insert(1, Format('Grp Speed: %d/%d kts, course: %d degs', [PHCSGThis^.kts, PHCSGThis^.maxspeed, PHCSGThis^.course])); end else SGButtonRefresh.Click; // 250618 ShowMessage('OOps'); end; function TfrmMain.DetQuality2String(const intQual: integer): String; var lStrQual: String; begin lStrQual:= ' has no location'; if ((intQual and cHEIGHT) > 0) then lStrQual := ' has fix including AltBand' else if ((intQual and cEXACT) > 0) then lStrQual:= ' has exact fix' else if ((intQual and cAREA) > 0 ) then lStrQual := ' has approx location' else if ((intQual and cBEARING) > 0) then lStrQual:= ' has bearing only'; if intQual >= cTYPE then lStrQual := lStrQual + ' - knows broad type'; if intQual >= cSIZE then lStrQual := lStrQual + ', size'; if intQual >= cCLASS then lStrQual := lStrQual + ', Class'; if intQual >= cNAME then lStrQual:= lStrQual + ', Name'; result := lStrQual; end; function TfrmMain.Showing2String(const intShow: integer): String; begin case intShow of 0: result:= ' has no detection'; 1: result:= ' knows side, not location'; 2: result:= ' has exact fix, not side'; 3: result:= ' has exact fix and side'; 4: result:= ' has approx position, not side'; 5: result:= ' has approx position and knows side'; else result:= ' detection status = ' + IntToStr(intShow); end; end; procedure TfrmMain.SGlblUnitKtsFill(); begin if SGlbxUnits.ItemIndex <> -1 then begin if (PSelectedUnit^.utype = MT_SHIP) or (PSelectedUnit^.utype = MT_SUB) then // 240616 SGListBoxUnitInfo.Items.Insert(2, format('%d kts, Noise: %d', [PSelectedUnit^.kts, PSelectedUnit^.SourceLevel])) else if (PSelectedUnit^.utype = MT_MISSILE) then SGListBoxUnitInfo.Items.Insert(2, format('%d kts, Target Time %d secs', [PSelectedUnit^.kts, PSelectedUnit^.Missile^.tTime])); // 240907 end; end; procedure TfrmMain.SetCourseClick(Sender: TObject); var PNewPathLeg: PHCPathRec; PPathEvent1: PHCHarpoonEvent; // PEndMessage: PHCMessageEvent; 250609 TargetLat, TargetLon: integer; dblLatFact: Double; RepStr: String; begin if (PSelectedGroup <> nil) then if PSelectedGroup^.side = intPSide then begin TargetLat:= PSelectedGroup^.sLat; TargetLon:= PSelectedGroup^.sLon; dblLatFact:= Cos((90-(PSelectedGroup^.sLat/sliver1))/57.2957); case Direct.Caption of 'N', 'n': TargetLat := TargetLat - (NM1*LegDistance.Value); 'S', 's': TargetLat := TargetLat + (NM1*LegDistance.Value); 'E', 'e': TargetLon:= TargetLon + (NM1*(LegDistance.Value)); 'W', 'w': TargetLon:= TargetLon - (NM1*(LegDistance.Value)); 'NE', 'ne': begin TargetLon:= TargetLon + Round(NM1*(LegDistance.Value)/1.4); TargetLat:= TargetLat - Round(NM1*(LegDistance.Value)/1.4); end; 'NW', 'nw': begin TargetLon:= TargetLon - Round(NM1*(LegDistance.Value)/1.4); TargetLat:= TargetLat - Round(NM1*(LegDistance.Value)/1.4); end; 'SE', 'se': begin TargetLon:= TargetLon + Round(NM1*(LegDistance.Value)/1.4); TargetLat:= TargetLat + Round(NM1*(LegDistance.Value)/1.4); end; 'SW', 'sw': begin TargetLon:= TargetLon - Round(NM1*(LegDistance.Value)/1.4); TargetLat:= TargetLat + Round(NM1*(LegDistance.Value)/1.4); end; end; // now have target destination if PSelectedGroup^.track = nil then begin PNewPathLeg := NewPtr(SizeOf(THCPathRec)); PSelectedGroup^.track:= PNewPathLeg; PSelectedGroup^.track^.next:= nil; PSelectedGroup^.track^.prev:= nil; end else DelPath(PSelectedGroup); // now have an empty one leg course PSelectedGroup^.track^.DestLat:= TargetLat; PSelectedGroup^.track^.DestLon:= TargetLon; // PEndMessage:= NewPtr(SizeOf(THCMessageEvent)); // PEndMessage^.Message:= 'Obtained position, require orders'; // PEndMessage^.Side := ANYSIDE; // ddt 20230402 upgrade structure //PEndMessage^.MessageFormat := Ord(THCTextTypes.ASCII); // PPathEvent1:= NewPtr(SizeOf(THCHarpoonEvent)); // PPathEvent1^.uuid := GenerateUUID; // PPathEvent1^.DataPtr:= PEndMessage; // PPathEvent1^.event_type := MESSAGE_EVENT; // or TimeDelta; // PPathEvent1^.time_type:= TimeDelta; // PPathEvent1^.in_scroll_flag:= 001; // PPathEvent1^.ourGroup:= PSelectedGroup; // PPathEvent1^.Time:= 0; // PPathEvent1^.unit_uuid:= PSelectedGroup^.Units^.UUID; // PPathEvent1^.next:= nil; PSelectedGroup^.track^.pathEvents:= nil; //PPathEvent1; // 250530 for add leg copy to here, rearrange so as to create events then look at tracks // and add events to group.track or last leg as appropriate if PSelectedGroup^.Units^.Air <> nil then //if air group check for loiter/hover begin if PSelectedGroup^.Units^.Air^.Throttle = 0 then begin SetGroupSpeedAlt(PSelectedGroup, 1, 12); // cruise low altitude end; end; // end it was an air group RepStr:= Format('Group %3.3s is proceeding %s for %d nm', [PSelectedGroup^.id, Direct.Caption, LegDistance.Value]); PostMessage(RepStr, PSelectedGroup); Messages.SetFocus; end; // group was player end; procedure TfrmMain.SetCourseKeyPress(Sender: TObject; var Key: char); begin case key of 'g', 'G': SGlbxGroups.SetFocus; end; end; procedure TfrmMain.SGbtnCoverKeyPress(Sender: TObject; var Key: char); begin case key of 'g', 'G': SGlbxGroups.SetFocus; 'k', 'K': PressKeyList.SetFocus; end; end; // procedure TfrmMain.AirSplitClick(Sender: TObject); // 250609 var PSplitUnitEvent: PHCSplitGroupEvent; PThisHCEvent: PHCHarpoonEvent; begin if SGlbxUnits.ItemIndex <> -1 then if HCIsValidUnit(PSelectedUnit, gPHCTopUnit) = CTRUE then if PSelectedUnit^.Missile = nil then begin SGlbxGroups.SetFocus; // 250615 PThisHCEvent:= NewPtr(SizeOf(THCHarpoonEvent)); PThisHCEvent^.uuid := GenerateUUID; PThisHCEvent^:= THCHarpoonEvent(PHCEventHead^); //PHCThisHCEvent content 'old' event-head content PHCEventHead^.next:= PThisHCEvent; //now put new event data into event-head content PHCEventHead^.DataPtr:= NewPtr(SizeOf(THCSplitGroupEvent) + SizeOf(uchar)); uchar(PHCEventHead^.DataPtr^):= 1; // only splitting one unit PSplitUnitEvent:= PHCEventHead^.DataPtr + SizeOf(uchar); PSplitUnitEvent^.UnitID[0][0]:= PSelectedUnit^.id; if PSelectedUnit^.Air = nil then PSplitUnitEvent^.UnitID[0][1]:= 1 else PSplitUnitEvent^.UnitID[0][1]:= PSelectedUnit^.Air^.PlatNow; PHCEventHead^.event_type:= SPLIT_EVENT; PHCEventHead^.time_type := TimeNow; PHCEventHead^.ourGroup:= PSelectedGroup; PHCEventHead^.unit_uuid:= PSelectedUnit^.UUID; PHCEventHead^.in_scroll_flag:= 000; PHCEventHead^.Time:= 000; // is this needed? end else ShowMessage('No Valid Unit Selected'); end; // procedure TfrmMain.SGButtonDepthChkClick(Sender: TObject); var RLat, RLon: Double; intDepthAlt: Integer; lPHCUThis: PHCUnit; lPHCGThis: PHCGroup; begin lPHCGThis:= PStartGroup; while (lPHCGThis <> nil) do begin if lPHCGThis^.side = intPSide then begin lPHCUThis:= lPHCGThis^.Units; while lPHCUThis <> nil do begin if HCMTIsVessel(lPHCUThis^.utype) then begin RLat:= 90-(lPHCUThis^.sLat/sliver1); // have to convert game slat/slon to real lat/lon RLon:= lPHCUThis^.sLon/sliver1; intDepthAlt:= HCdllCheckLatLonDepth(RLat, RLon); if intDepthAlt > 5 then // shallow water depth begin PostMessage(Format('Sir, vessel %2.2s%0.3d is in shallow water', [PHCGroup(lPHCUThis^.Group)^.id, lPHCUThis^.id]), lPHCGThis); Messages.SetFocus; end; end; lPHCUThis:= lPHCUThis^.next; end; end; // end looking at group inits lPHCGThis:= lPHCGThis^.toSouth; end; end; procedure TfrmMain.DirectChange(Sender: TObject); begin case Direct.Caption of 'n': Direct.Caption:= 'N'; 'e': Direct.Caption:= 'E'; 's': Direct.Caption:= 'S'; 'w': Direct.Caption:= 'W'; 'ne': Direct.Caption:= 'NE'; 'se': Direct.Caption:= 'SE'; 'sw': Direct.Caption:= 'SW'; 'nw': Direct.Caption:= 'NW'; end; end; procedure TfrmMain.EWbtnClick(Sender: TObject); begin if PSelectedGroup <> nil then SqPatrl(PSelectedGroup,3); end; procedure TfrmMain.FormShow(Sender: TObject); // 250610 begin SGlbxGroups.SetFocus; end; procedure TfrmMain.AddLegClick(Sender: TObject); var PNewPathLeg, lLastLeg: PHCPathRec; PPathEvent1: PHCHarpoonEvent; PEndMessage: PHCMessageEvent; TargetLat, TargetLon: integer; dblLatFact: Double; RepStr: String; begin if (PSelectedGroup <> nil) then if PSelectedGroup^.side = intPSide then begin dblLatFact:= Cos((90-(PSelectedGroup^.sLat/sliver1))/57.2957); PNewPathLeg := NewPtr(SizeOf(THCPathRec)); PNewPathLeg^.pathEvents:= nil; PNewPathLeg^.next:= nil; // got blank new leg if PSelectedGroup^.track = nil then begin TargetLat:= PSelectedGroup^.sLat; // temp target lat and lon TargetLon:= PSelectedGroup^.sLon; // updated later PNewPathLeg^.prev:= nil; PSelectedGroup^.track:= PNewPathLeg; end else begin lLastLeg:= GetLastLeg(PSelectedGroup); TargetLat:= lLastLeg^.DestLat; TargetLon:= lLastLeg^.DestLon; // ditto to be updated lLastLeg^.next := PNewPathLeg; end; // now to work out actual target lat and lon case Direct.Caption of 'N', 'n': TargetLat := TargetLat - (NM1*LegDistance.Value); 'S', 's': TargetLat := TargetLat + (NM1*LegDistance.Value); 'E', 'e': TargetLon:= TargetLon + (NM1*(LegDistance.Value)); 'W', 'w': TargetLon:= TargetLon - (NM1*(LegDistance.Value)); 'NE', 'ne': begin TargetLon:= TargetLon + Round(NM1*(LegDistance.Value)/1.4); TargetLat:= TargetLat - Round(NM1*(LegDistance.Value)/1.4); end; 'NW', 'nw': begin TargetLon:= TargetLon - Round(NM1*(LegDistance.Value)/1.4); TargetLat:= TargetLat - Round(NM1*(LegDistance.Value)/1.4); end; 'SE', 'se': begin TargetLon:= TargetLon + Round(NM1*(LegDistance.Value)/1.4); TargetLat:= TargetLat + Round(NM1*(LegDistance.Value)/1.4); end; 'SW', 'sw': begin TargetLon:= TargetLon - Round(NM1*(LegDistance.Value)/1.4); TargetLat:= TargetLat + Round(NM1*(LegDistance.Value)/1.4); end; end; // target lat lon now set // PNewPathLeg^.DestLat:= TargetLat; PNewPathLeg^.DestLon:= TargetLon; PostMessage(PSelectedGroup^.id + ' has new course final leg', PSelectedGroup); // 250608 end; end; procedure TfrmMain.AddLegKeyPress(Sender: TObject; var Key: char); begin case key of 'g', 'G': SGlbxGroups.SetFocus; 'k', 'K': PressKeyList.SetFocus; end; end; procedure TfrmMain.AEWbtnClick(Sender: TObject); begin if PSelectedGroup <> nil then SqPatrl(PSelectedGroup,1); end; procedure TfrmMain.AFPbtnFinishClick(Sender: TObject); begin AFPspnedRng.Clear; AFPspnedSct.Clear; AFPlbxAirPatList.Clear; Byte(PDLLBusy^) := CFALSE; AFPbtnList.Enabled:= TRUE; AFPbtnFinish.Enabled:= FALSE; end; procedure TfrmMain.AFPbtnListClick(Sender: TObject); var pThisEvent: PHCHarpoonEvent; lpThisAC: PHCAnnexB1_Disk; pThisEventGroup: PHCGroup; pThisEventUnit: PHCUnit; strGroupID, strEType: String; intRng, intSct: Integer; begin if PHCEventHead <> nil then begin Byte(PDLLBusy^) := CTRUE; AFPbtnList.Enabled:= FALSE; AFPbtnFinish.Enabled:= TRUE; pThisEvent := PHCEventHead; AFPlbxAirPatList.Clear; AFPspnedRng.Clear; AFPspnedSct.Clear; while (pThisEvent <> nil) do begin if pThisEvent^.ourGroup <> nil then begin // EventType := pThisEvent^.event_type; strGroupID := ''; if (PHCGroup(pThisEvent^.ourGroup)^.side = intPSide) then begin if pThisEvent^.event_type = AIR_PATROL_EVENT then // we have a player air patrol event begin pThisEventGroup:= pThisEvent^.ourGroup; strGroupID := pThisEventGroup^.id; PAirPatrolEvent:= pThisEvent^.DataPtr; lpThisAC:= HCAnnexHelper.HCGetAnnexB1(PAirPatrolEvent^.PlaneID); // 250625 case PAirPatrolEvent^.PatrolType of 1: strEType:= 'ASUW'; 2: strEType:= 'ASW'; 3: strEType:= 'AAW'; 4: strEType:= 'AEW/radar/ESM'; 5: strEType:= 'EW'; end; intRng:= PAirPatrolEvent^.Rings; intSct:= PAirPatrolEvent^.Sectors; AFPlbxAirPatList.Items.Add(Format('%s Hd: %3.3d %s %s Air Patrol, ring %d, sector %d, ref: %s', [strGroupID, pThisEventGroup^.course, lpThisAC^.ClassName, strEType, intRng, intSct, pThisEvent^.uuid])); end else // its not air patrol event if pThisEvent^.event_type = FORMATION_EVENT then begin pThisEventGroup:= pThisEvent^.ourGroup; strGroupID := pThisEventGroup^.id; PFormationEvent:= pThisEvent^.DataPtr; intRng:= PFormationEvent^.rings; intSct:= PFormationEvent^.sectors; if pThisEvent^.unit_uuid <> '' then // 250625 begin pThisEventUnit:= (HCuuid2UnitPtr(pThisEvent^.unit_uuid, pStartGroup, pThisEventGroup)); AFPlbxAirPatList.Items.Add(Format('%s Hd: %3.3d %s Unit:%3.3d positioned ring %d, sector %d, ref: %s', [strGroupID, pThisEventGroup^.course, pThisEventUnit^.name, pThisEventUnit^.id, intRng, intSct, pThisEvent^.uuid])); end; end; end; // event was player end; // the event had a group pThisEvent := pThisEvent^.next; end; // end looking at events AFPlbxAirPatList.SetFocus; end else showmessage('no eventhead'); end; procedure TfrmMain.AFPlbxAirPatListKeyPress(Sender: TObject; var Key: char); begin case key of 'V', 'v': AFPmemRngDesc.SetFocus; 'F', 'f': AFPbtnFinish.Click; 'k', 'K': PressKeyList.SetFocus; end; end; procedure TfrmMain.AFPlbxAirPatListSelectionChange(Sender: TObject; User: boolean); var intIndx: Integer; strSel: String; begin intIndx:= Pos('ref:', AFPlbxAirPatList.Items[AFPlbxAirPatList.ItemIndex]); strSel:= Copy(AFPlbxAirPatList.Items[AFPlbxAirPatList.ItemIndex], intIndx + 5, HCUUID_LEN -1); PEvent:= PHCEventHead; while (PEvent<>nil) do begin if (Trim(strSel) = PEvent^.uuid) then break; PEvent:= PEvent^.next end; if PEvent= nil then showmessage('oops') else begin if PEvent^.event_type = AIR_PATROL_EVENT then begin PAirPatrolEvent:= PEvent^.DataPtr; if (PAirPatrolEvent <> nil) then begin AFPspnedRng.Value:= PAirPatrolEvent^.Rings; AFPspnedSct.Value:= PAirPatrolEvent^.Sectors; gStrEventType:='AirPat'; end; end else // it should be a formation event 250625 begin PFormationEvent:= PEvent^.DataPtr; AFPspnedRng.Value:= PFormationEvent^.Rings; AFPspnedSct.Value:= PFormationEvent^.Sectors; gStrEventType:= 'Formation'; end; end; end; procedure TfrmMain.AFPspnedRngEditingDone(Sender: TObject); begin if gStrEventType = 'AirPat' then begin PAirPatrolEvent^.Rings:= AFPspnedRng.Value; end else if gStrEventType = 'Formation' then begin PFormationEvent^.Rings:= AFPspnedRng.Value; end; end; procedure TfrmMain.AFPspnedSctEditingDone(Sender: TObject); begin if gStrEventType = 'AirPat' then begin PAirPatrolEvent^.Sectors:= AFPspnedSct.Value; end // 250625 else if gStrEventType = 'Formation' then begin PFormationEvent^.sectors:= AFPspnedSct.Value; end; end; procedure TfrmMain.AFPspnedSctKeyPress(Sender: TObject; var Key: char); begin case key of 'L', 'l': AFPlbxAirPatList.SetFocus; end; end; procedure TfrmMain.AirSplitKeyPress(Sender: TObject; var Key: char); // 250609 begin case key of 'g', 'G': SGlbxGroups.SetFocus; 'k', 'K': PressKeyList.SetFocus; 'u', 'U': SGlbxUnits.SetFocus; end; end; procedure TfrmMain.ASWbtnClick(Sender: TObject); // 250618 begin if PSelectedGroup <> nil then SqPatrl(PSelectedGroup,0); end; procedure TfrmMain.CAPbtnClick(Sender: TObject); begin if PSelectedGroup <> nil then SqPatrl(PSelectedGroup,2); end; procedure TfrmMain.InsertLegClick(Sender: TObject); var PNewPathLeg: PHCPathRec; PPathEvent1: PHCHarpoonEvent; PEndMessage: PHCMessageEvent; TargetLat, TargetLon: integer; dblLatFact: Double; RepStr: String; begin if (PSelectedGroup <> nil) then if PSelectedGroup^.side = intPSide then begin TargetLat:= PSelectedGroup^.sLat; TargetLon:= PSelectedGroup^.sLon; dblLatFact:= Cos((90-(PSelectedGroup^.sLat/sliver1))/57.2957); case Direct.Caption of 'N', 'n': TargetLat := TargetLat - (NM1*LegDistance.Value); 'S', 's': TargetLat := TargetLat + (NM1*LegDistance.Value); 'E', 'e': TargetLon:= TargetLon + (NM1*(LegDistance.Value)); 'W', 'w': TargetLon:= TargetLon - (NM1*(LegDistance.Value)); 'NE', 'ne': begin TargetLon:= TargetLon + Round(NM1*(LegDistance.Value)/1.4); TargetLat:= TargetLat - Round(NM1*(LegDistance.Value)/1.4); end; 'NW', 'nw': begin TargetLon:= TargetLon - Round(NM1*(LegDistance.Value)/1.4); TargetLat:= TargetLat - Round(NM1*(LegDistance.Value)/1.4); end; 'SE', 'se': begin TargetLon:= TargetLon + Round(NM1*(LegDistance.Value)/1.4); TargetLat:= TargetLat + Round(NM1*(LegDistance.Value)/1.4); end; 'SW', 'sw': begin TargetLon:= TargetLon - Round(NM1*(LegDistance.Value)/1.4); TargetLat:= TargetLat + Round(NM1*(LegDistance.Value)/1.4); end; end; // target lat lon now set PNewPathLeg := NewPtr(SizeOf(THCPathRec)); PNewPathLeg^.DestLat:= TargetLat; PNewPathLeg^.DestLon:= TargetLon; PNewPathLeg^.pathEvents:= nil; PNewPathLeg^.prev:= nil; if PSelectedGroup^.track = nil then PNewPathLeg^.next:= nil else begin PNewPathLeg^.next:= PSelectedGroup^.track; end; PSelectedGroup^.track:= PNewPathLeg; PostMessage(PSelectedGroup^.id + ' has new first leg course', PSelectedGroup); // 250608 end; end; procedure TfrmMain.InsertLegKeyPress(Sender: TObject; var Key: char); begin case key of 'g', 'G': SGlbxGroups.SetFocus; 'k', 'K': PressKeyList.SetFocus; end; end; procedure TfrmMain.MessagesKeyPress(Sender: TObject; var Key: char); begin case key of 'G', 'g': SGlbxGroups.SetFocus; 'k', 'K': PressKeyList.SetFocus; 'E', 'e': SGlbxEGroup.SetFocus; 'T', 't': if PMessGrp <> nil then HCChangeActGroupPtr(PMessGrp); //'R', 'r': if SGButtonResume.Caption = 'RESUME' // 250620 // then // begin // Byte(PDLLBusy^) := CFALSE; // SGButtonResume.Caption:= 'PAUSE'; // 250621 end; end; // Messages.Lines.Delete(Messages.Lines.Count); // 250703 end; procedure TfrmMain.PlotDepthsClick(Sender: TObject); var lChkSLon, lChkSLat: LongInt; lChkRLat, lChkRLon: Double; lPnt: String; lIntWDepth: Integer; begin if PSelectedUnit <> nil then if HCIsValidUnit(PSelectedUnit, gPHCTopUnit) = CTRUE then // 250623 if PHCGroup(PSelectedUnit^.Group)^.side = intPSide then begin SGListBoxUnitInfo.Clear; SGListBoxUnitInfo.Items.Add('Direction, Depth at 5 mile'); // SLat = nm1*distance(miles) lPnt:= 'N'; lChkSLat:= PSelectedUnit^.sLat - NM1*5; lChkRLat:= 90 - (lChkSLat/sliver1); lChkRLon:= PSelectedUnit^.sLon/Sliver1; lIntWDepth:= 7 - (HCdllCheckLatLonDepth(lChkRLat, lChkRLon)); SGListBoxUnitInfo.Items.Add(lPnt + ', ' + IntToStr(lIntWDepth)); // lPnt:= 'S'; lChkSLat:= PSelectedUnit^.sLat + NM1*5; lChkRLat:= 90 - (lChkSLat/sliver1); lIntWDepth:= 7 - (HCdllCheckLatLonDepth(lChkRLat, lChkRLon)); SGListBoxUnitInfo.Items.Add(lPnt + ', ' + IntToStr(lIntWDepth)); // lPnt:= 'E'; lChkRLat:= 90 - (PSelectedUnit^.sLat/sliver1); lChkSLon:= PSelectedUnit^.sLon + NM1*5; lChkRLon:= lChkSLon/Sliver1; lIntWDepth:= 7 - (HCdllCheckLatLonDepth(lChkRLat, lChkRLon)); SGListBoxUnitInfo.Items.Add(lPnt + ', ' + IntToStr(lIntWDepth)); // lPnt:= 'W'; lChkRLat:= 90 - (PSelectedUnit^.sLat/sliver1); lChkSLon:= PSelectedUnit^.sLon - NM1*5; lChkRLon:= lChkSLon/Sliver1; lIntWDepth:= 7 - (HCdllCheckLatLonDepth(lChkRLat, lChkRLon)); SGListBoxUnitInfo.Items.Add(lPnt + ', ' + IntToStr(lIntWDepth)); SGListBoxUnitInfo.SetFocus; //250612 end else ShowMessage('oops, no valid player unit selected'); end; procedure TfrmMain.SGlbxUnitsSelectionChange(); // 240613 - (Sender: TObject; User: boolean); var strSel, strDepthAlt, strShow, strWepName, strPlaneLoadout, strName, strMGPhase, strStatus, strUType: String; // strSide, strOSide, moved to updateshowing PHCUThis: PHCUnit; PThisMnt: PHCMntRec; PThisMag: PHCMagRec; PmyPlanes: PHCPlaneRec; RLat, RLon: Double; intDepthAlt, intShow, intC: integer; isTanker, isSub, isAir: Boolean; // , isShip, isBase 240319 not using now strID: uchar; ThisWepID: ID; PThisLoadout: PHCAnnexY1_disk; PThisMount: PHCAnnexZ1_disk; PThisMulti: PHCAnnexZ2_disk; PHCAnnexA1: PHCAnnexA1_disk; // surface ship PHCAnnexA2: PHCAnnexA2_disk; // subs PHCAnnexB1: PHCAnnexB1_disk; // aircraft PHCAnnexP1: PHCAnnexP1_disk; // installations/bases PHCAnnexC1: PHCAnnexC1_disk; // guns PHCAnnexD1: PHCAnnexD1_disk; // missiles PHCAnnexE1: PHCAnnexE1_disk; // asw dc mortar etc PHCAnnexF1: PHCAnnexF1_disk; // torpedos PHCAnnexG1: PHCAnnexG1_disk; // ATOG PHCAnnexG2: PHCAnnexG2_disk; // ECM PHCAnnexM1: PHCAnnexM1_disk; // Sonar begin // ALE 20130317 User selected a unit, pull up unit info. isTanker:= False; //until proven True strSel := Copy(SGlbxUnits.Items[SGlbxUnits.ItemIndex],1,3); // need a check for selected unit/group? no longer valid if HCIsValidGroup(PSelectedGroup, PStartGroup) = CTRUE then // check group still valid begin PHCUThis := PSelectedGroup^.Units; while (PHCUThis <> nil) do begin if (Format('%3.3d',[PHCUThis^.id]) = strSel) then break; PHCUThis := PHCUThis^.next; end; // ddt add unit information if (PHCUThis <> nil) then // test for valid unit begin isSub:= False; isAir:= False; // isShip:= False; // isBase:= False; PSelectedUnit := PHCUThis; // set PSelectedUnit to unit selected in list dblLatFact:= Cos((90-(PSelectedUnit^.sLat/sliver1))/57.2957); SGListBoxUnitInfo.Items.Clear; SGListBoxUnitInfo.Items.Add(Format('%d Kts Crse %d, Y/X offset %d/ %d', [PSelectedUnit^.kts, PSelectedUnit^.course, (round(PSelectedUnit^.yOff/UHCDefines.NM1)), (round(PSelectedUnit^.xOff/UHCDefines.NM1))])); // test xoff yoff UHCDefines.NM1 + LatFact strUType:= ''; // now add class name using annex case (HCAnnexHelper.HCAnnexShift(PSelectedUnit^.Annex)) of SHIP_FLAG: begin // isShip:= True; PHCAnnexA1 := HCAnnexHelper.HCGetAnnexA1(PSelectedUnit^.Annex); SGListBoxUnitInfo.Items.Insert(1, 'Ship Class Name: ' + PHCAnnexA1^.ClassName); // 240309 stopped testing detection size strUType:= AnnexData^.PBSStrings^.ShipType[PHCAnnexA1^.Subtype]; end; SUB_FLAG: begin PHCAnnexA2 := HCAnnexHelper.HCGetAnnexA2(PSelectedUnit^.Annex); SGListBoxUnitInfo.Items.Insert(1, 'Submarine Class Name: ' + PHCAnnexA2^.ClassName); strUType:= AnnexData^.PBSStrings^.ShipType[PHCAnnexA2^.Subtype]; isSub:= True; intDepthAlt:= PSelectedUnit^.AltBand; case intDepthAlt of 0: strDepthAlt := 'TooDeep'; 1: strDepthAlt := 'Vdeep'; 2: strDepthAlt := 'Deep'; 3: strDepthAlt := 'Intermed'; 4: strDepthAlt := 'Shallow'; 5: strDepthAlt := 'Snorkel'; 6: strDepthAlt := 'SeaLevel'; 7: strDepthAlt := 'ScopeAlt'; end; end; PLANE_FLAG: begin isAir:= True; PHCAnnexB1 := HCAnnexHelper.HCGetAnnexB1(PSelectedUnit^.Annex); SGListBoxUnitInfo.Items.Insert(0, 'Aircraft Class Name: ' + PHCAnnexB1^.ClassName); // 240607 strUType:= AnnexData^.PBSStrings^.ACType[PHCAnnexB1^.Subtype]; end; BASE_FLAG: begin // isBase:= True; // 240319 PHCAnnexP1 := HCAnnexHelper.HCGetAnnexP1(PSelectedUnit^.Annex); SGListBoxUnitInfo.Items.Insert(0, 'Base Name: ' + PHCAnnexP1^.Name); end; MISSILE_FLAG: begin isAir:= True; PHCAnnexD1:= HCAnnexHelper.HCGetAnnexD1(PSelectedUnit^.Annex); SGListBoxUnitInfo.Items.Insert(0, 'Missile Class: ' + PHCAnnexD1^.ClassName); // 240606 back edit end; TORP_FLAG: begin PHCAnnexF1:= HCAnnexHelper.HCGetAnnexF1(PSelectedUnit^.Annex); SGListBoxUnitInfo.Items.Insert(0, 'Torpedo Class: ' + PHCAnnexF1^.ClassName); // 240607 back edit end; ASW_FLAG: begin PHCAnnexE1:= HCAnnexHelper.HCGetAnnexE1(PSelectedUnit^.Annex); SGListBoxUnitInfo.Items.Insert(0, 'Class: ' + PHCAnnexE1^.ClassName); // 240607 added ASW end; else SGListBoxUnitInfo.Items.Insert(0, 'No Class Name'); end; // finished getting class name from annex SGListBoxUnitInfo.Items.Insert(1, Format('%2.2s%0.3d %s %s', [PSelectedGroup^.id, PSelectedUnit^.id, strUType, PSelectedUnit^.name])); // 240412 add strUType SGListBoxUnitInfo.Items.Insert(2,Format('course: %3.3d, kts: %d, MaxKts: %d', [PSelectedUnit^.course, PSelectedUnit^.kts, PSelectedUnit^.maxspeed])); SGListBoxUnitInfo.Items.Insert(3,Format('best weapon range: AAW- %0.1n, ASUW- %0.1n, ASW- %0.1n', [PSelectedUnit^.BestAAWRange / 10, PSelectedUnit^.BestASuWRange / 10 , PSelectedUnit^.BestASWRange / 10])); // 240617 >> if (PSelectedUnit^.utype = MT_SHIP) or (PSelectedUnit^.utype = MT_SUB) then SGListBoxUnitInfo.Items.Add(Format('SelfNoise: %d; TotHydroNoise: %d; BaseHydroNoise(at Creep): %d', [PSelectedUnit^.SelfNoise, PSelectedUnit^.SourceLevel, PSelectedUnit^.BaseSourceLevel])); // 240610 SGListBoxUnitInfo.Items.Add(Format('RCS: %d, VCS: %d', [PSelectedUnit^.RCS, PSelectedUnit^.VCS])); SGListBoxUnitInfo.Items.Add(format('Enemy Detection - SonarPD: %d HydPD: %d SurfRadarPD: %d, AirRadarPD %d', [PSelectedUnit^.son_pd, PSelectedUnit^.hyd_pd, PSelectedUnit^.srad_pd, PSelectedUnit^.arad_pd])); if isSub then SGListBoxUnitInfo.Items.Add('Depth: ' + strDepthAlt + ' - MaxDepth: ' + HCAltBand2String(PHCAnnexA2^.MaxDepth)); // 240607 if isAir = False then SGListBoxUnitInfo.Items.Add(format('Damage Points Now/Orig: %d/ %d', [PSelectedUnit^.CurrDp, PSelectedUnit^.OrigDp])); // 240908 don't want if ac or missile // test for air or missile units PROB need to do loadouts and mounts here and delete unit^.air from general mounts and mags if (PSelectedUnit^.Air <> nil) then begin strDepthAlt:= HCAltBand2String(PSelectedUnit^.AltBand); SGListBoxUnitInfo.Items.Insert(0, 'Aircraft Unit'); SGListBoxUnitInfo.Items.Insert(1,'Altitude: ' + strDepthAlt + ' - MaxAlt: ' + HCAltBand2String(PHCAnnexB1^.MaxAlt)); //240607 SGListBoxUnitInfo.Items.Add(format('Aircraft number orig/now: %2.2d/ %2.2d', [PSelectedUnit^.Air^.PlatStart, PSelectedUnit^.Air^.PlatNow])); SGListBoxUnitInfo.Items.Add(format('base: %2.2s-%3.3d, %s', [PHCGroup(PHCUnit(PSelectedUnit^.Air^.HomeUnit)^.Group)^.id, PHCUnit(PSelectedUnit^.Air^.HomeUnit)^.id, PHCUnit(PSelectedUnit^.Air^.HomeUnit)^.name])); if ((PHCAnnexB1^.UnitFlags AND UF_B1_NOE) > 0) then SGListBoxUnitInfo.Items.Add('NapeOfEarth - YES') else SGListBoxUnitInfo.Items.Add('NapOfEarth - NO'); if ((PHCAnnexB1^.UnitFlags AND UF_B1_refuelcapable) > 0) then SGListBoxUnitInfo.Items.Add('InFlightRefuel - YES') else SGListBoxUnitInfo.Items.Add('InFlightRefuel - NO'); //have annex, get more info SGListBoxUnitInfo.Items.Add('Det.Size: ' + IntToStr(PHCAnnexB1^.Size) + '; RCS: ' + IntToStr(PHCAnnexB1^.RCS)); // 240607 SGListBoxUnitInfo.Items.Add('Max alt band: ' + HCAltBand2String(PHCAnnexB1^.MaxAlt)); // 240607 if PSelectedUnit^.Air^.FuelToOffload > 0 then SGListBoxUnitInfo.Items.Add(format('tanker fuel remaining: %d per tanker',[PSelectedUnit^.Air^.FuelToOffload])); // now add loadout info then add mount info separate If PSelectedUnit^.Mnts <> nil // this is in airunit so is loadout then begin PThisMnt:= PselectedUnit^.Mnts; if (HCAnnexShift(PThisMnt^.MntId) = LOADOUT_FLAG) then SGListBoxUnitInfo.Items.Add('WEAPONS:'); // 240617 is this correct place? while (PThisMnt <> nil) do begin if (HCAnnexShift(PThisMnt^.MntId) = LOADOUT_FLAG) then //find mission type begin PThisLoadout:= HCAnnexHelper.HCGetAnnexY1(PThisMnt^.MntId); // 240616 deletd loadout from print strPlaneLoadout:= format('Air Unit, Mission #%d: ',[PThisLoadout^.MissionID]); // 240616 added loadout # case HCMissionMap[PThisLoadout^.MissionID] of Ord(THCMissionType.MISSION_TANKER): SGListBoxUnitInfo.Items.Strings[0]:= strPlaneLoadout + 'Tanker'; Ord(THCMissionType.MISSION_FERRY): SGListBoxUnitInfo.Items.Strings[0]:= strPlaneLoadout + 'Ferry'; Ord(THCMissionType.MISSION_ASSAULT): SGListBoxUnitInfo.Items.Strings[0]:= strPlaneLoadout + 'Assault'; Ord(THCMissionType.MISSION_PATROL): SGListBoxUnitInfo.Items.Strings[0]:= strPlaneLoadout + 'Patrol'; Ord(THCMissionType.MISSION_NUCLEAR): SGListBoxUnitInfo.Items.Strings[0]:= strPlaneLoadout + 'Nuclear'; Ord(THCMissionType.MISSION_STANDOFF): SGListBoxUnitInfo.Items.Strings[0]:= strPlaneLoadout + 'Standoff'; Ord(THCMissionType.MISSION_SEAD): SGListBoxUnitInfo.Items.Strings[0]:= strPlaneLoadout + 'Sead'; Ord(THCMissionType.MISSION_GUIDED): SGListBoxUnitInfo.Items.Strings[0]:= strPlaneLoadout + 'Guided'; Ord(THCMissionType.MISSION_UNGUIDED): SGListBoxUnitInfo.Items.Strings[0]:= strPlaneLoadout + 'Unguided'; Ord(THCMissionType.MISSION_ANTIRUN): SGListBoxUnitInfo.Items.Strings[0]:= strPlaneLoadout + 'Anti Runway'; Ord(THCMissionType.MISSION_ATA): SGListBoxUnitInfo.Items.Strings[0]:= strPlaneLoadout + 'Intercept'; Ord(THCMissionType.MISSION_ASW): SGListBoxUnitInfo.Items.Strings[0]:= strPlaneLoadout + 'ASW'; Ord(THCMissionType.MISSION_AARMR): SGListBoxUnitInfo.Items.Strings[0]:= strPlaneLoadout + 'Anti Armour'; Ord(THCMissionType.MISSION_DECOY): SGListBoxUnitInfo.Items.Strings[0]:= strPlaneLoadout + 'Decoy'; end; //end case of mission type COULD add loadout weapon count data to print as per landed planes end; // end getting ID mission type // LOADOUT WEAPONS if PThisMnt^.WepId <> Invalid_ID // PThisMnt: PHCMntRec then begin ThisWepID:= PThisMnt^.WepId; begin case (HCAnnexShift(ThisWepId)) of GUN_FLAG: begin PHCAnnexC1:= HCAnnexHelper.HCGetAnnexC1(ThisWepId); strWepName:= Format('%s; ARange: %d NM, SRange: %d NM', [PHCAnnexC1^.ClassName, (PHCAnnexC1^.AirRange div 10), (PHCAnnexC1^.SurfRange div 10)]); end; MISSILE_FLAG: begin PHCAnnexD1:= HCAnnexHelper.HCGetAnnexD1(ThisWepId); strWepName:= Format('%s; ARange: %d NM, SRange: %d NM, MinRange: %d NM', [PHCAnnexD1^.ClassName, (PHCAnnexD1^.AirRange div 10), (PHCAnnexD1^.SurfRange div 10), (PHCAnnexD1^.MinRange div 10)]); end; ASW_FLAG: begin PHCAnnexE1:= HCAnnexHelper.HCGetAnnexE1(ThisWepId); strWepName:= Format('%s: MaxRange: %d MinRange: %d', [PHCAnnexE1^.ClassName, (PHCAnnexE1^.MaxRange div 10), (PHCAnnexE1^.MinRange div 10)]); end; TORP_FLAG: begin PHCAnnexF1:= HCAnnexHelper.HCGetAnnexF1(ThisWepId); strWepName:= Format('%s; MaxRange: %d/%d MaxDepth %s', [PHCAnnexF1^.ClassName, (PHCAnnexF1^.MaxRange[0] div 10), (PHCAnnexF1^.MaxRange[1] div 10), HCAltBand2String(PHCAnnexF1^.MaxDepth)]); end; ATOG_FLAG: begin PHCAnnexG1:= HCAnnexHelper.HCGetAnnexG1(ThisWepId); strWepName:= 'weptype ' + intToStr(PHCAnnexG1^.WType) + '/' + PHCAnnexG1^.ClassName; end; ECM_FLAG: begin PHCAnnexG2:= HCAnnexHelper.HCGetAnnexG2(ThisWepId); strWepName:= PHCAnnexG2^.ClassName; end; SONAR_FLAG: begin PHCAnnexM1:= HCAnnexHelper.HCGetAnnexM1(ThisWepId); strWepName:= PHCAnnexM1^.ClassName; end; else strWepName:= format('misc - WepID %d',[ThisWepId]); end; // end look at mount SGListBoxUnitInfo.Items.Add(' ' + IntToStr(PThisMnt^.Ammo_c[0]) + ' - ' + strWepName); // 240307 strWepName:= ''; end; // end this weapon of loadout end; // valid weaponID PThisMnt:= PThisMnt^.next; end; // end this loadout - should only be one end; // look at air unit loadouts // listing altband - speed table 240617 moved from before wep list WHY did I do it like this?? SGListBoxUnitInfo.Items.Add('AltBand/Throttle/Speed Table:'); SGListBoxUnitInfo.Items.Add(format('speed level 0=%d',[PHCAnnexB1^.SpeedLevels[0]])); for intC := 1 to (PLANE_SPEED_LEVELS - 1) do SGListBoxUnitInfo.Items.Append(format('speed level %d=%d',[intC, PHCAnnexB1^.SpeedLevels[intC]])); // finished altband - speed table end // end look at air units else // MISSILE UNITS !!! INcludes torpedo and asroc but separate annex if (PSelectedUnit^.Missile <> nil) then begin strDepthAlt:= HCAltBand2String(PSelectedUnit^.AltBand); SGListBoxUnitInfo.Items.Insert(0, 'Missile Unit - Altitude: ' + strDepthAlt); SGListBoxUnitInfo.Items.Add(format('Number Now/Original: %d/ %d', [PSelectedUnit^.Missile^.PlatNow, PSelectedUnit^.Missile^.PlatStart])); SGListBoxUnitInfo.Items.Add(format('Shooter %2.2s:%3.3d - %s', [PHCGroup(PHCUnit(PSelectedUnit^.Missile^.sourceUnit)^.Group)^.id, PHCUnit(PSelectedUnit^.Missile^.sourceUnit)^.id, PHCUnit(PSelectedUnit^.Missile^.sourceUnit)^.name])); if PSelectedUnit^.Missile^.targetUnit <> nil then SGListBoxUnitInfo.Items.Add(format('Target: %2.2s-%3.3d - %s', [PHCGroup(PHCUnit(PSelectedUnit^.Missile^.targetUnit)^.Group)^.id, PHCUnit(PSelectedUnit^.Missile^.targetUnit)^.id, PHCUnit(PSelectedUnit^.Missile^.targetUnit)^.name])); SGListBoxUnitInfo.Items.Insert(1, format('%d kts, Target Time %d secs', [PSelectedUnit^.kts, PSelectedUnit^.Missile^.tTime])); //240613 & 240907 case (HCAnnexHelper.HCAnnexShift(PSelectedUnit^.Annex)) of MISSILE_FLAG: begin SGListBoxUnitInfo.Items.Add(format('AirPh/SurfPh: %d/ %d; DP: %d', [PHCAnnexD1^.AirPh, PHCAnnexD1^.SurfPh, PHCAnnexD1^.Dp])); // 240607 SGListBoxUnitInfo.Items.Add(format('Operational: %S - %s', [HCAltBand2String(PHCAnnexD1^.MinAlt), HCAltBand2String(PHCAnnexD1^.MaxAlt)])); end; ASW_FLAG: begin if PHCAnnexE1^.Dp < 101 then SGListBoxUnitInfo.Items.Add(format('Ph: %d; DP: %d', [PHCAnnexE1^.Ph, PHCAnnexE1^.Dp])) else SGListBoxUnitInfo.Items.Add('ASROC'); SGListBoxUnitInfo.Items.Add(format('Operational: %d - %d', [((PHCAnnexE1^.MinRange) div 10), ((PHCAnnexE1^.MaxRange) div 10)])); // 240607 end; TORP_FLAG: begin SGListBoxUnitInfo.Items.Add(format('Ph: %d; DP Surf/Sub: %d/ %d', [PHCAnnexF1^.Ph, PHCAnnexF1^.SurfDp, PHCAnnexF1^.SubDp])); SGListBoxUnitInfo.Items.Add(format('MaxDepth: %s', [HCAltBand2String(PHCAnnexF1^.MaxDepth)])); // 240607 end; end; case PSelectedUnit^.Missile^.guid_phase of 1: strMGPhase:= 'Inertial'; 2: strMGPhase:= 'Terminal'; 4: strMGPhase:= 'SemiActive'; 8: strMGPhase:= 'ARM'; 16: strMGPhase:= 'IR/Laser homing'; 32: strMGPhase:= 'Radar Homing'; 64: strMGPhase:= 'Mid Course Guidance'; 128: strMGPhase:= 'Command Guidance'; else strMGPhase:= 'unknown'; end; SGListBoxUnitInfo.Items.Add(format('Current Guidance Phase: %d: %s', [PSelectedUnit^.Missile^.guid_phase, strMGPhase])); end; // end air missile unit test // test for landed air units if (PSelectedUnit^.myPlanes <> nil) then begin PmyPlanes:= PSelectedUnit^.myPlanes; SGListBoxUnitInfo.Items.Add('* Aircraft Landed *'); while (PmyPlanes <> nil) do begin if PmyPlanes^.Time > 0 then intC:= (PmyPlanes^.Time - intGTNow) div 60 else intC:= 0; // testing status case PmyPlanes^.Status of PS_READYING: strStatus := 'Readying'; PS_READY: strStatus := 'Ready'; PS_LAUNCHING: strStatus := 'Launching'; PS_LANDING: strStatus := 'Landing'; else strStatus := 'Unknown'; end; // SGListBoxUnitInfo.Items.Add(format('%d-%s; Status %s, ReadyTime: %d', [PmyPlanes^.PlatNow, PmyPlanes^.name, strStatus, intC])); // 20231114 PmyPlanes^.Status if PmyPlanes^.LoadID <> INVALID_ID then begin PThisLoadout:= HCAnnexHelper.HCGetAnnexY1(PmyPlanes^.LoadID); // 20231115 moved line 240616 ad loadID SGListBoxUnitInfo.Items.Add(format('LoadID: %d; Range %d nm',[PThisLoadout^.MissionID, PThisLoadout^.Range])); // 20231115 moved "range" intC := 0 ; while PThisLoadout^.WepQty[intC] > 0 do begin //find weapon type then name case (HCAnnexShift(PThisLoadout^.WepId[intC])) of GUN_FLAG: begin PHCAnnexC1:= HCAnnexHelper.HCGetAnnexC1(PThisLoadout^.WepId[intC]); strWepName:= PHCAnnexC1^.ClassName; end; MISSILE_FLAG: begin PHCAnnexD1:= HCAnnexHelper.HCGetAnnexD1(PThisLoadout^.WepId[intC]); strWepName:= PHCAnnexD1^.ClassName; end; ASW_FLAG: begin PHCAnnexE1:= HCAnnexHelper.HCGetAnnexE1(PThisLoadout^.WepId[intC]); strWepName:= PHCAnnexE1^.ClassName; end; TORP_FLAG: begin PHCAnnexF1:= HCAnnexHelper.HCGetAnnexF1(PThisLoadout^.WepId[intC]); strWepName:= PHCAnnexF1^.ClassName; end; ATOG_FLAG: begin PHCAnnexG1:= HCAnnexHelper.HCGetAnnexG1(PThisLoadout^.WepId[intC]); strWepName:= PHCAnnexG1^.ClassName; end; ECM_FLAG: begin PHCAnnexG2:= HCAnnexHelper.HCGetAnnexG2(PThisLoadout^.WepId[intC]); strWepName:= PHCAnnexG2^.ClassName; end; else strWepName:= 'misc'; end; //case now have weapon name SGListBoxUnitInfo.Items.Add(format(' %d %s',[PThisLoadout^.WepQty[intC], strWepName])); intC:= intC +1; end; // now have weapon No/names listed for this plane end else SGListBoxUnitInfo.Items.Add('INVALID Loadout ID'); // testtonight 231117 PmyPlanes:= PmyPlanes^.next; end; end; // end test for landed air units // SURFACE UNIT MOUNTS if (PselectedUnit^.Mnts <> nil) and (PSelectedUnit^.Air = nil) then // 240307 re introduce NOT AIR begin SGListBoxUnitInfo.Items.Add('* Mounts *'); PThisMnt:= PselectedUnit^.Mnts; while (PThisMnt <> nil) do begin // PThisMnt = ships mount, PThisMount = Mount annex if (HCAnnexShift(PThisMnt^.MntId) = MOUNT_FLAG) then begin // Name Mount PThisMount:= HCAnnexHelper.HCGetAnnexZ1(PThisMnt^.MntId); SGListBoxUnitInfo.Items.Add(format('%s: %d mounts; %d tubes, %d targets, Damage: %d', [PThisMount^.ClassName, PThisMount^.NumMounts, PThisMount^.NumTubes, PThisMount^.NumTargets, PThisMnt^.Damage])); // if PThisMount^.WepId <> Invalid_ID then ThisWepID:= PThisMount^.WepId; 240304 moved test end; // case (HCAnnexShift(ThisWepId)) of // 20231117 sepatated multi an single mounts if PThisMnt^.WepId <> Invalid_ID then // have moved valid wepID test and removed weap print if invalid 240304 begin ThisWepID:= PThisMnt^.WepId; if (HCAnnexShift(ThisWepId)) = MULTI_FLAG then // Multi Mounts begin PThisMulti:= HCAnnexHelper.HCGetAnnexZ2(ThisWepId); intC:= 0; while (PThisMulti^.WepQty[intC] > 0) do begin // case (HCAnnexShift(PThisMulti^.WepId[intC])) of GUN_FLAG: begin PHCAnnexC1:= HCAnnexHelper.HCGetAnnexC1(PThisMulti^.WepId[intC]); strWepName:= Format('%s; ARange: %d NM, SRange: %d NM', [PHCAnnexC1^.ClassName, (PHCAnnexC1^.AirRange div 10), (PHCAnnexC1^.SurfRange div 10)]); end; // 240405 more detail MISSILE_FLAG: begin PHCAnnexD1:= HCAnnexHelper.HCGetAnnexD1(PThisMulti^.WepId[intC]); strWepName:= Format('%s; ARange: %d NM, SRange: %d NM, MinRange: %d NM',[PHCAnnexD1^.ClassName, (PHCAnnexD1^.AirRange div 10), (PHCAnnexD1^.SurfRange div 10), (PHCAnnexD1^.MinRange div 10)]); // insertnmin range 220230513 22021117 end; ASW_FLAG: begin PHCAnnexE1:= HCAnnexHelper.HCGetAnnexE1(PThisMulti^.WepId[intC]); strWepName:= Format('%s: MaxRange: %d MinRange: %d', [PHCAnnexE1^.ClassName, (PHCAnnexE1^.MaxRange div 10), (PHCAnnexE1^.MinRange div 10)]); end; TORP_FLAG: begin PHCAnnexF1:= HCAnnexHelper.HCGetAnnexF1(PThisMulti^.WepId[intC]); strWepName:= Format('%s; MaxRange: %d/%d MaxDepth %s', [PHCAnnexF1^.ClassName, (PHCAnnexF1^.MaxRange[0] div 10), (PHCAnnexF1^.MaxRange[1] div 10), HCAltBand2String(PHCAnnexF1^.MaxDepth)]); end; ATOG_FLAG: begin PHCAnnexG1:= HCAnnexHelper.HCGetAnnexG1(PThisMulti^.WepId[intC]); strWepName:= PHCAnnexG1^.ClassName; end; ECM_FLAG: begin PHCAnnexG2:= HCAnnexHelper.HCGetAnnexG2(PThisMulti^.WepId[intC]); strWepName:= PHCAnnexG2^.ClassName; end; else strWepName:= format('misc - WepID %d',[ThisWepId]); end; // now print out data for multi mount this weapon SGListBoxUnitInfo.Items.Add(format(' %d from %d of %s', [PThisMnt^.Ammo_c[intC], PThisMulti^.WepQty[intC], strWepName])); // 20230503 include current load and range could add thiswepid number here intC:= intC + 1; end; // end one weapon of multi mount strWepName:= ''; // needs to be reset to nil so as not to list at end of multi mount end //; // end case of multi mount else // must be a single mount PThisMount = annex PThisMnt = ship mount // need to separate air units and not look up annex-NumRoundsMnt begin case (HCAnnexShift(ThisWepId)) of GUN_FLAG: begin PHCAnnexC1:= HCAnnexHelper.HCGetAnnexC1(ThisWepId); strWepName:= Format('%d of %s: ARange: %d NM, SRange %d NM', [(PThisMount^.NumRoundsMnt * PThisMount^.NumMounts), PHCAnnexC1^.ClassName, (PHCAnnexC1^.AirRange div 10), (PHCAnnexC1^.SurfRange div 10)]); // PThisMnt^.Ammo_c[0] 240303 end; MISSILE_FLAG: begin PHCAnnexD1:= HCAnnexHelper.HCGetAnnexD1(ThisWepId); strWepName:= Format('%d of %s; ARange: %d NM, SRange: %d NM, MinRange: %d NM',[PThisMount^.NumRoundsMnt * PThisMount^.NumMounts, PHCAnnexD1^.ClassName, (PHCAnnexD1^.AirRange div 10), (PHCAnnexD1^.SurfRange div 10), (PHCAnnexD1^.MinRange div 10)]); // insertnmin range 220230513 insert ARange n SRange 20231117 240306 add intitial mount rounds (and below) end; ASW_FLAG: begin PHCAnnexE1:= HCAnnexHelper.HCGetAnnexE1(ThisWepId); strWepName:= Format('%d of %s: MaxRange: %d',[(PThisMount^.NumRoundsMnt * PThisMount^.NumMounts * PThisMount^.NumTubes), PHCAnnexE1^.ClassName, (PHCAnnexE1^.MaxRange div 10)]); end; TORP_FLAG: begin PHCAnnexF1:= HCAnnexHelper.HCGetAnnexF1(ThisWepId); strWepName:= Format('%d of %s: MaxRange: %d/%d, maxDepth: %s', [(PThisMount^.NumRoundsMnt * PThisMount^.NumMounts), PHCAnnexF1^.ClassName, (PHCAnnexF1^.MaxRange[0] div 10), (PHCAnnexF1^.MaxRange[1] div 10), HCAltBand2String(PHCAnnexF1^.MaxDepth)]); // 240405 more detail end; ATOG_FLAG: begin PHCAnnexG1:= HCAnnexHelper.HCGetAnnexG1(ThisWepId); strWepName:= 'weptype ' + intToStr(PHCAnnexG1^.WType) + '/' + PHCAnnexG1^.ClassName; end; ECM_FLAG: begin PHCAnnexG2:= HCAnnexHelper.HCGetAnnexG2(ThisWepId); strWepName:= PHCAnnexG2^.ClassName; end; else strWepName:= format('misc - WepID %d',[ThisWepId]); end; // end look at non multi mount 20231117 // now print out non multi mount data (already printed multi wep data?) SGListBoxUnitInfo.Items.Add(' ' + IntToStr(PThisMnt^.Ammo_c[0]) + ' from ' + strWepName); // 20231117 add space formatting could add thiswepid number here strWepName:= ''; end; // end mount end; // valid weaponID 240404 moved valid weap id test // 20231117 moved printout code from here PThisMnt:= PThisMnt^.next; end; // end each mount end; // end if mounts // if (PSelectedUnit^.Mags <> nil) then begin SGListBoxUnitInfo.Items.Add('* Magazines *'); //if (isShip = True) // 240319 listing mag info //then SGListBoxUnitInfo.Items.Add(format('1stmag @ %d, NoOfMags # %d',[PHCAnnexA1^.MagStart, PHCAnnexA1^.MagCount])); PThisMag:= PSelectedUnit^.Mags; while (PThisMag <> nil) do begin // get annex info case (HCAnnexShift(PThisMag^.WepId)) of GUN_FLAG: begin PHCAnnexC1:= HCAnnexHelper.HCGetAnnexC1(PThismag^.WepId); strWepName:= PHCAnnexC1^.ClassName; end; MISSILE_FLAG: begin PHCAnnexD1:= HCAnnexHelper.HCGetAnnexD1(PThismag^.WepId); strWepName:= PHCAnnexD1^.ClassName; end; ASW_FLAG: begin PHCAnnexE1:= HCAnnexHelper.HCGetAnnexE1(PThismag^.WepId); strWepName:= PHCAnnexE1^.ClassName; end; TORP_FLAG: begin PHCAnnexF1:= HCAnnexHelper.HCGetAnnexF1(PThismag^.WepId); strWepName:= PHCAnnexF1^.ClassName; end; // moreweapons? else strWepName:= 'unknown weapon ID: ' + IntToStr(PThisMag^.WepId) end; SGListBoxUnitInfo.Items.Add(format(' %s: Count: %d, ReloadTime: %d',[strWepName, PThisMag^.Count, PThisMag^.ReloadTime])); // we could amend magazine data here PThisMag:= PThisMag^.next; end; end; //end mags // SGListBoxUnitInfo.Items.Add('* General *'); // SGListBoxUnitInfo.Items.Add(' .......... '); RLat:= 90-(PSelectedUnit^.sLat/sliver1); // have to convert game slat/slon to real lat/lon RLon:= PSelectedUnit^.sLon/sliver1; SGListBoxUnitInfo.Items.Insert(4,format('lat: %3.2f; lon: %3.2f',[RLat, RLon])); intDepthAlt:= HCdllCheckLatLonDepth(RLat, RLon); // water depth/land altitude at geographic point of unit case intDepthAlt of 0: strDepthAlt := 'TooDeep'; 1: strDepthAlt := 'Vdeep'; 2: strDepthAlt := 'Deep'; 3: strDepthAlt := 'Intermed'; 4: strDepthAlt := 'Shallow'; 5: strDepthAlt := 'Snorkel'; 6: strDepthAlt := 'SeaLevel'; 7: strDepthAlt := 'ScopeAlt'; 8: strDepthAlt := 'SmallShip'; 9: strDepthAlt := 'MedShip'; 10: strDepthAlt := 'LrgShip'; 11: strDepthAlt := 'Land'; // normally vlow 12: strDepthAlt := 'Low'; 13: strDepthAlt := 'Medium'; 14: strDepthAlt := 'High'; 15: strDepthAlt := 'Vhigh'; 16: strDepthAlt := 'SubOrbit'; end; // SGListBoxUnitInfo.Items.Insert(5,'water depth: ' + strDepthAlt); //240617 end else begin SGListBoxUnitInfo.Items.Clear; SGListBoxUnitInfo.Items.Add('bad unit selection?'); // something strange went on end; end // end that the group was valid else begin SGlbxGroups.Items.Clear; SGlbxGroups.Items.Add('Selected Unit from Invalid Group'); SGlbxUnits.Items.Clear; SGListBoxUnitInfo.Clear; // clear all boxs until a unit is selected 20230503 end; // was invalid group end; procedure TfrmMain.SGListBoxUnitInfoKeyPress(Sender: TObject; var Key: char); begin case key of 'g', 'G': SGlbxGroups.SetFocus; 'u', 'U': SGlbxUnits.SetFocus; 'E', 'e' : SGlbxEUnits.SetFocus; end; end; end.