diff --git a/HPSDRNetwork.pas b/HPSDRNetwork.pas index 893ddc2..1a4d750 100644 --- a/HPSDRNetwork.pas +++ b/HPSDRNetwork.pas @@ -319,55 +319,6 @@ begin end; {$ENDIF} -// =========================================================================== -// Синхронизация через отдельные классы-посредники (без анонимных процедур) -// =========================================================================== - -type - { TStatusSync - передаёт HP Status в главный поток } - TStatusSync = class - private - FCallback: TOnHPStatus; - FStatus: THighPriorityStatus; - public - constructor Create(CB: TOnHPStatus; const St: THighPriorityStatus); - procedure Execute; - end; - - { TMicSync - передаёт Mic данные в главный поток } - TMicSync = class - private - FCallback: TOnMicPacket; - FPkt: TMicDataPacket; - public - constructor Create(CB: TOnMicPacket; const P: TMicDataPacket); - procedure Execute; - end; - -constructor TStatusSync.Create(CB: TOnHPStatus; const St: THighPriorityStatus); -begin - inherited Create; - FCallback := CB; - FStatus := St; -end; - -procedure TStatusSync.Execute; -begin - if Assigned(FCallback) then FCallback(FStatus); -end; - -constructor TMicSync.Create(CB: TOnMicPacket; const P: TMicDataPacket); -begin - inherited Create; - FCallback := CB; - FPkt := P; -end; - -procedure TMicSync.Execute; -begin - if Assigned(FCallback) then FCallback(FPkt); -end; - // =========================================================================== // Receive thread // =========================================================================== @@ -994,12 +945,22 @@ begin end; procedure THPSDRNetwork.StopThreads; + procedure WaitThreadDone(T: TThread); + begin + if T = nil then Exit; + if GetCurrentThreadId = MainThreadID then + begin + while not T.Finished do + CheckSynchronize(10); + end; + T.WaitFor; + end; begin if Assigned(FDUCIQThread) then begin FDUCIQThread.Terminate; RTLEventSetEvent(FDUCIQSem); - FDUCIQThread.WaitFor; + WaitThreadDone(FDUCIQThread); FreeAndNil(FDUCIQThread); end; @@ -1011,13 +972,13 @@ begin CloseSocket(FSocket); FSocket := SOCK_INVALID; end; - FReceiveThread.WaitFor; + WaitThreadDone(FReceiveThread); FreeAndNil(FReceiveThread); end; if Assigned(FKeepaliveThread) then begin FKeepaliveThread.Terminate; - FKeepaliveThread.WaitFor; + WaitThreadDone(FKeepaliveThread); FreeAndNil(FKeepaliveThread); end; ResetDUCIQQueue; @@ -1033,18 +994,10 @@ end; procedure THPSDRNetwork.HandleHPStatus(const Buf: array of Byte; Len: Integer); var St: THighPriorityStatus; - Sync: TStatusSync; - M: TThreadMethod; begin if not Assigned(FOnHPStatus) then Exit; Move(Buf[0], St, SizeOf(St)); - Sync := TStatusSync.Create(FOnHPStatus, St); - try - M := Sync.Execute; - TThread.Synchronize(nil, M); - finally - Sync.Free; - end; + FOnHPStatus(St); end; procedure THPSDRNetwork.HandleDDCIQ(const Buf: array of Byte; Len: Integer; diff --git a/MainForm.pas b/MainForm.pas index c3dfd31..311b5d6 100644 --- a/MainForm.pas +++ b/MainForm.pas @@ -492,6 +492,7 @@ type procedure RestoreBand(BandIdx: Integer); procedure SaveAllAndExit; procedure RestoreWindowBounds; + procedure SaveWindowBounds; function MakeGlobalSettings: TGlobalSettings; function MakeBandSettings: TBandSettings; procedure FreqDispBChanged(Sender: TObject; NewFreq: Int64); @@ -924,18 +925,64 @@ end; procedure TMainForm.RestoreWindowBounds; var - L, T, Wd, Ht: Integer; + L, T, Wd, Ht, SavedDPI, CurDPI: Integer; + R, WA: TRect; + Mon: TMonitor; begin - FSettings.LoadWindowBounds(L, T, Wd, Ht); + FSettings.LoadWindowBounds(L, T, Wd, Ht, SavedDPI); if (Wd > 400) and (Ht > 300) then begin - Left := L; - Top := T; - Width := Wd; - Height := Ht; + CurDPI := PixelsPerInch; + if CurDPI <= 0 then CurDPI := Screen.PixelsPerInch; + if CurDPI <= 0 then CurDPI := 96; + if SavedDPI <= 0 then SavedDPI := CurDPI; + + if SavedDPI <> CurDPI then + begin + L := MulDiv(L, CurDPI, SavedDPI); + T := MulDiv(T, CurDPI, SavedDPI); + Wd := MulDiv(Wd, CurDPI, SavedDPI); + Ht := MulDiv(Ht, CurDPI, SavedDPI); + end; + + Wd := Max(MulDiv(900, CurDPI, 96), Wd); + Ht := Max(MulDiv(560, CurDPI, 96), Ht); + R := Bounds(L, T, Wd, Ht); + Mon := Screen.MonitorFromRect(R); + if Mon <> nil then WA := Mon.WorkareaRect + else WA := Screen.PrimaryMonitor.WorkareaRect; + + if Wd > WA.Right - WA.Left then Wd := WA.Right - WA.Left; + if Ht > WA.Bottom - WA.Top then Ht := WA.Bottom - WA.Top; + L := EnsureRange(L, WA.Left, Max(WA.Left, WA.Right - Wd)); + T := EnsureRange(T, WA.Top, Max(WA.Top, WA.Bottom - Ht)); + + Position := poDesigned; + SetBounds(L, T, Wd, Ht); end; end; +procedure TMainForm.SaveWindowBounds; +var + L, T, Wd, Ht, DPI: Integer; +begin + if WindowState = wsNormal then + begin + L := Left; T := Top; Wd := Width; Ht := Height; + end + else + begin + L := RestoredLeft; T := RestoredTop; + Wd := RestoredWidth; Ht := RestoredHeight; + end; + + if (Wd <= 400) or (Ht <= 300) then Exit; + DPI := PixelsPerInch; + if DPI <= 0 then DPI := Screen.PixelsPerInch; + if DPI <= 0 then DPI := 96; + FSettings.SaveWindowBounds(L, T, Wd, Ht, DPI); +end; + function TMainForm.MakeBandSettings: TBandSettings; begin Result.VfoA := FVfoA; @@ -1447,7 +1494,7 @@ begin end; // Размер окна сохраняем всегда (не зависит от подключения) FSettings.SaveStartupPreview(FVfoA, FVfoB, FSampleRate); - FSettings.SaveWindowBounds(Left, Top, Width, Height); + SaveWindowBounds; FSettings.Save; FSettings.Free; FWebServer.Stop; diff --git a/Settings.pas b/Settings.pas index f472832..69f61c0 100644 --- a/Settings.pas +++ b/Settings.pas @@ -282,8 +282,8 @@ type class procedure DefaultGlobal(out G: TGlobalSettings); class procedure DefaultTX(out T: TTXSettings); // Размер окна — не привязан к MAC, хранится в корне JSON - procedure SaveWindowBounds(L, T, W, H: Integer); - procedure LoadWindowBounds(out L, T, W, H: Integer); + procedure SaveWindowBounds(L, T, W, H, DPI: Integer); + procedure LoadWindowBounds(out L, T, W, H, DPI: Integer); procedure SaveStartupPreview(VfoA, VfoB: Double; SampleRate: Integer); function LoadStartupPreview(out VfoA, VfoB: Double; out SampleRate: Integer): Boolean; procedure SaveAudioBufferSize(BufferSize: Integer); @@ -757,7 +757,7 @@ begin B.FMStepIdx := EnsureRange(JI(O,'fmstep_idx', B.FMStepIdx), 0, 3); end; -procedure TSettingsManager.SaveWindowBounds(L, T, W, H: Integer); +procedure TSettingsManager.SaveWindowBounds(L, T, W, H, DPI: Integer); var O: TJSONObject; begin O := EnsureObj(FRoot, 'window'); @@ -765,18 +765,20 @@ begin JW(O, 'top', T); JW(O, 'width', W); JW(O, 'height', H); + JW(O, 'dpi', DPI); end; -procedure TSettingsManager.LoadWindowBounds(out L, T, W, H: Integer); +procedure TSettingsManager.LoadWindowBounds(out L, T, W, H, DPI: Integer); var O: TJSONObject; begin - L := 80; T := 80; W := 1400; H := 900; + L := 80; T := 80; W := 1400; H := 900; DPI := 0; if FRoot.Find('window') = nil then Exit; O := EnsureObj(FRoot, 'window'); L := JI(O, 'left', 80); T := JI(O, 'top', 80); W := JI(O, 'width', 1400); H := JI(O, 'height', 900); + DPI := JI(O, 'dpi', 0); end; procedure TSettingsManager.SaveStartupPreview(VfoA, VfoB: Double; SampleRate: Integer);