diff --git a/FlatDropDown.pas b/FlatDropDown.pas new file mode 100644 index 0000000..92055b2 --- /dev/null +++ b/FlatDropDown.pas @@ -0,0 +1,175 @@ +unit FlatDropDown; + +{ Выпадающий список на основе TFlatButton. + Управляет попап-панелью с кнопками-элементами. + + Использование: + FDrop := TFlatDropDown.Create(SelectorBtn, PopupParent, Cols, BtnH); + FDrop.SetItems(ItemNames); + FDrop.SetItemIndex(DefaultIdx); + FDrop.OnSelect := @MySelectHandler; + // В обработчике кнопки-якоря: + FDrop.Toggle; + // При смене темы: + FDrop.ApplyStyle(@StyleButton, T.Panel); } + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Controls, Graphics, ExtCtrls, FlatButton; + +type + TButtonStyleProc = procedure(B: TFlatButton; Active: Boolean) of object; + TDropDownSelectEvent = procedure(Sender: TObject; Idx: Integer) of object; + + TFlatDropDown = class + private + FAnchor: TFlatButton; + FPopupParent: TWinControl; + FPopup: TPanel; + FItemBtns: array of TFlatButton; + FItemIndex: Integer; + FColumns: Integer; + FItemBtnH: Integer; + FIsOpen: Boolean; + FOnSelect: TDropDownSelectEvent; + procedure ItemClick(Sender: TObject); + procedure PositionPopup; + public + constructor Create(AAnchor: TFlatButton; APopupParent: TWinControl; + ACols, ABtnH: Integer); + destructor Destroy; override; + procedure SetItems(const ANames: array of string); + procedure SetItemIndex(Idx: Integer); + property ItemIndex: Integer read FItemIndex; + property IsOpen: Boolean read FIsOpen; + procedure Toggle; + procedure ClosePopup; + procedure ApplyStyle(AStyleProc: TButtonStyleProc; APanelColor: TColor); + property OnSelect: TDropDownSelectEvent read FOnSelect write FOnSelect; + end; + +implementation + +constructor TFlatDropDown.Create(AAnchor: TFlatButton; APopupParent: TWinControl; + ACols, ABtnH: Integer); +begin + inherited Create; + FAnchor := AAnchor; + FPopupParent := APopupParent; + FColumns := ACols; + FItemBtnH := ABtnH; + FItemIndex := 0; + FIsOpen := False; + FPopup := TPanel.Create(nil); + FPopup.Parent := APopupParent; + FPopup.BevelOuter := bvNone; + FPopup.Color := TColor($00181818); + FPopup.Visible := False; +end; + +destructor TFlatDropDown.Destroy; +begin + FPopup.Free; + inherited; +end; + +procedure TFlatDropDown.SetItems(const ANames: array of string); +var + I, Count, BtnW, PopW: Integer; + B: TFlatButton; +begin + while FPopup.ControlCount > 0 do + FPopup.Controls[0].Free; + Count := Length(ANames); + SetLength(FItemBtns, Count); + PopW := FPopupParent.ClientWidth; + BtnW := (PopW - 4) div FColumns; + FPopup.SetBounds(0, 0, PopW, + ((Count + FColumns - 1) div FColumns) * FItemBtnH); + for I := 0 to Count - 1 do + begin + B := MakeFlatBtn(FPopup, ANames[I], + 2 + (I mod FColumns) * BtnW, + (I div FColumns) * FItemBtnH, + BtnW - 2, FItemBtnH, @ItemClick); + B.Tag := I; + B.Active := (I = FItemIndex); + FItemBtns[I] := B; + end; +end; + +procedure TFlatDropDown.SetItemIndex(Idx: Integer); +begin + if (Idx < 0) or (Idx >= Length(FItemBtns)) then Exit; + if (FItemIndex <> Idx) and (FItemIndex >= 0) and + (FItemIndex < Length(FItemBtns)) and (FItemBtns[FItemIndex] <> nil) then + FItemBtns[FItemIndex].Active := False; + FItemIndex := Idx; + if FItemBtns[Idx] <> nil then + FItemBtns[Idx].Active := True; + if FAnchor <> nil then + begin + FAnchor.Caption := FItemBtns[Idx].Caption; + FAnchor.Invalidate; + end; +end; + +procedure TFlatDropDown.ItemClick(Sender: TObject); +var + Idx: Integer; +begin + Idx := (Sender as TFlatButton).Tag; + ClosePopup; + SetItemIndex(Idx); + if Assigned(FOnSelect) then FOnSelect(Self, Idx); +end; + +procedure TFlatDropDown.PositionPopup; +var + P: TPoint; + Y0: Integer; +begin + P := FAnchor.ClientToScreen(Point(0, FAnchor.Height)); + P := FPopupParent.ScreenToClient(P); + Y0 := P.Y + 2; + if Y0 + FPopup.Height > FPopupParent.ClientHeight then + Y0 := P.Y - FAnchor.Height - FPopup.Height - 2; + if Y0 < 0 then Y0 := 0; + FPopup.Top := Y0; + FPopup.Left := 0; +end; + +procedure TFlatDropDown.Toggle; +begin + if FIsOpen then + begin + ClosePopup; + Exit; + end; + PositionPopup; + FPopup.BringToFront; + FPopup.Visible := True; + FIsOpen := True; +end; + +procedure TFlatDropDown.ClosePopup; +begin + if not FIsOpen then Exit; + FPopup.Visible := False; + FIsOpen := False; +end; + +procedure TFlatDropDown.ApplyStyle(AStyleProc: TButtonStyleProc; APanelColor: TColor); +var + I: Integer; +begin + FPopup.Color := APanelColor; + for I := 0 to High(FItemBtns) do + if FItemBtns[I] <> nil then + AStyleProc(FItemBtns[I], FItemBtns[I].Active); +end; + +end. diff --git a/MainForm.pas b/MainForm.pas index aba0a55..e89e5c6 100644 --- a/MainForm.pas +++ b/MainForm.pas @@ -22,7 +22,7 @@ unit MainForm; interface uses - Classes, SysUtils, StrUtils, FreqDisplay, DeviceForm, VfoOverlay, FlatButton, FlatSlider, AppTheme, Forms, Controls, Graphics, Dialogs, + Classes, SysUtils, StrUtils, FreqDisplay, DeviceForm, VfoOverlay, FlatButton, FlatSlider, FlatDropDown, AppTheme, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls, ComCtrls, Buttons, Menus, Math, Types, LCLIntf, LCLType, GraphType, HPSDRProtocol, HPSDRNetwork, @@ -391,13 +391,11 @@ type PanelFMCTCSS: TPanel; BtnFMCTCSS: TFlatButton; BtnFMCTCSSTone: TFlatButton; - PanelFMCTCSSPop: TPanel; - FBtnCTCSSTones: array[0..CTCSS_COUNT - 1] of TFlatButton; + FCTCSSDropDown: TFlatDropDown; PanelFMStep: TPanel; BtnFMStep: TFlatButton; BtnFMStepSel: TFlatButton; - PanelFMStepPop: TPanel; - FBtnFMSteps: array[0..FM_STEP_COUNT - 1] of TFlatButton; + FStepDropDown: TFlatDropDown; PanelRX: TPanel; BtnAGCMode: array[0..4] of TFlatButton; // FAST MED SLOW LONG OFF @@ -517,14 +515,14 @@ type procedure ApplyFMSquelch; procedure BtnFMCTCSSClick(Sender: TObject); procedure BtnFMCTCSSToneClick(Sender: TObject); - procedure BtnFMToneSelectClick(Sender: TObject); procedure SetFMCTCSSTone(Idx: Integer); procedure CloseCTCSSPopup; procedure SetFMStep(Idx: Integer); procedure CloseFMStepPopup; procedure BtnFMStepClick(Sender: TObject); procedure BtnFMStepSelClick(Sender: TObject); - procedure BtnFMStepSelectClick(Sender: TObject); + procedure OnCTCSSDropDownSelect(Sender: TObject; Idx: Integer); + procedure OnStepDropDownSelect(Sender: TObject; Idx: Integer); procedure PbSpectrumMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure PbSpectrumMouseMove(Sender: TObject; Shift: TShiftState; @@ -1845,24 +1843,10 @@ begin BtnFMCTCSSTone := MakeBtn(PanelFMCTCSS, CTCSS_NAMES[0], W + 4, 20, LEFT_W - W - 8, BTN_H, BtnFMCTCSSToneClick); StyleButton(BtnFMCTCSSTone, False); - // Tone picker popup (child of PanelLeft, hidden until BtnFMCTCSSTone is clicked) - PanelFMCTCSSPop := TPanel.Create(Self); - PanelFMCTCSSPop.Parent := PanelLeft; - PanelFMCTCSSPop.BevelOuter := bvNone; - PanelFMCTCSSPop.Color := CLR_PANEL; - PanelFMCTCSSPop.Visible := False; - W := (LEFT_W - 4) div 4; - PanelFMCTCSSPop.SetBounds(0, 0, LEFT_W, ((CTCSS_COUNT + 3) div 4) * BTN_SM); - for i := 0 to CTCSS_COUNT - 1 do - begin - B := MakeBtn(PanelFMCTCSSPop, CTCSS_NAMES[i], - 2 + (i mod 4) * W, - (i div 4) * BTN_SM, - W - 2, BTN_SM, BtnFMToneSelectClick); - B.Tag := i; - StyleButton(B, i = FFMCTCSSToneIdx); - FBtnCTCSSTones[i] := B; - end; + FCTCSSDropDown := TFlatDropDown.Create(BtnFMCTCSSTone, PanelLeft, 4, BTN_SM); + FCTCSSDropDown.SetItems(CTCSS_NAMES); + FCTCSSDropDown.SetItemIndex(FFMCTCSSToneIdx); + FCTCSSDropDown.OnSelect := OnCTCSSDropDownSelect; // FM Step panel (visible only in FM mode, between Filter and SQL) PanelFMStep := TPanel.Create(Self); @@ -1878,22 +1862,10 @@ begin W + 4, 20, LEFT_W - W - 8, BTN_H, BtnFMStepSelClick); StyleButton(BtnFMStepSel, False); - // Step picker popup (child of PanelLeft) - PanelFMStepPop := TPanel.Create(Self); - PanelFMStepPop.Parent := PanelLeft; - PanelFMStepPop.BevelOuter := bvNone; - PanelFMStepPop.Color := CLR_PANEL; - PanelFMStepPop.Visible := False; - W := (LEFT_W - 4) div FM_STEP_COUNT; - PanelFMStepPop.SetBounds(0, 0, LEFT_W, BTN_SM); - for i := 0 to FM_STEP_COUNT - 1 do - begin - B := MakeBtn(PanelFMStepPop, FM_STEP_NAMES[i], - 2 + i * W, 0, W - 2, BTN_SM, BtnFMStepSelectClick); - B.Tag := i; - StyleButton(B, i = FFMStepIdx); - FBtnFMSteps[i] := B; - end; + FStepDropDown := TFlatDropDown.Create(BtnFMStepSel, PanelLeft, FM_STEP_COUNT, BTN_SM); + FStepDropDown.SetItems(FM_STEP_NAMES); + FStepDropDown.SetItemIndex(FFMStepIdx); + FStepDropDown.OnSelect := OnStepDropDownSelect; // CTUN / DUP buttons (display-related) BtnCTun := MakeBtn(PanelLeft, 'CTUN', 2, Y, LEFT_W div 3 - 2, BTN_H, BtnCTunClick); @@ -2495,9 +2467,7 @@ begin DP(PanelBands); DP(PanelMode); DP(PanelFilter); if PanelFMSQ <> nil then DP(PanelFMSQ); if PanelFMCTCSS <> nil then DP(PanelFMCTCSS); - if PanelFMCTCSSPop <> nil then DP(PanelFMCTCSSPop); if PanelFMStep <> nil then DP(PanelFMStep); - if PanelFMStepPop <> nil then DP(PanelFMStepPop); DP(PanelRX); DP(PanelTX); DP(PanelRight); DP(PanelSpanButtons); @@ -2536,8 +2506,8 @@ begin if TrkFMSQ <> nil then DS(TrkFMSQ); if BtnFMCTCSS <> nil then StyleButton(BtnFMCTCSS, BtnFMCTCSS.Active); if BtnFMCTCSSTone <> nil then StyleButton(BtnFMCTCSSTone, False); - for i := 0 to CTCSS_COUNT-1 do - if FBtnCTCSSTones[i] <> nil then StyleButton(FBtnCTCSSTones[i], FBtnCTCSSTones[i].Active); + if FCTCSSDropDown <> nil then FCTCSSDropDown.ApplyStyle(StyleButton, T.Panel); + if FStepDropDown <> nil then FStepDropDown.ApplyStyle(StyleButton, T.Panel); StyleButton(BtnNR, BtnNR.Active); StyleButton(BtnNB, BtnNB.Active); StyleButton(BtnSNB, BtnSNB.Active); @@ -4399,7 +4369,7 @@ begin if PanelFMStep <> nil then begin StyleButton(BtnFMStep, FFMStepOn); - BtnFMStepSel.Caption := FM_STEP_NAMES[FFMStepIdx]; + if FStepDropDown <> nil then FStepDropDown.SetItemIndex(FFMStepIdx); PanelFMStep.Visible := True; end; RelayoutBelowBands; @@ -5035,31 +5005,19 @@ end; procedure TMainForm.CloseCTCSSPopup; begin - if (PanelFMCTCSSPop <> nil) and PanelFMCTCSSPop.Visible then - PanelFMCTCSSPop.Visible := False; + if FCTCSSDropDown <> nil then FCTCSSDropDown.ClosePopup; CloseFMStepPopup; end; procedure TMainForm.CloseFMStepPopup; begin - if (PanelFMStepPop <> nil) and PanelFMStepPop.Visible then - PanelFMStepPop.Visible := False; + if FStepDropDown <> nil then FStepDropDown.ClosePopup; end; procedure TMainForm.SetFMStep(Idx: Integer); -var OldIdx: Integer; begin - OldIdx := FFMStepIdx; FFMStepIdx := Idx; - if BtnFMStepSel <> nil then - begin - BtnFMStepSel.Caption := FM_STEP_NAMES[Idx]; - BtnFMStepSel.Invalidate; - end; - if (OldIdx <> Idx) and (FBtnFMSteps[OldIdx] <> nil) then - FBtnFMSteps[OldIdx].Active := False; - if FBtnFMSteps[Idx] <> nil then - FBtnFMSteps[Idx].Active := True; + if FStepDropDown <> nil then FStepDropDown.SetItemIndex(Idx); if FWebServer <> nil then FWebServer.FMStepIdx := Idx; if (FMode = MODE_FM) and (FSpecView <> nil) then FSpecView.FMGridStepHz := FM_STEP_HZ[Idx]; @@ -5074,47 +5032,21 @@ begin end; procedure TMainForm.BtnFMStepSelClick(Sender: TObject); -var Y0: Integer; begin - if PanelFMStepPop.Visible then - begin - CloseFMStepPopup; - Exit; - end; - CloseCTCSSPopup; - Y0 := PanelFMStep.Top + PanelFMStep.Height + 2; - if Y0 + PanelFMStepPop.Height > PanelLeft.ClientHeight then - Y0 := PanelFMStep.Top - PanelFMStepPop.Height - 2; - if Y0 < 0 then Y0 := 0; - PanelFMStepPop.Top := Y0; - PanelFMStepPop.Left := 0; - PanelFMStepPop.BringToFront; - PanelFMStepPop.Visible := True; + FCTCSSDropDown.ClosePopup; + FStepDropDown.Toggle; end; -procedure TMainForm.BtnFMStepSelectClick(Sender: TObject); +procedure TMainForm.OnStepDropDownSelect(Sender: TObject; Idx: Integer); begin - CloseFMStepPopup; - SetFMStep((Sender as TFlatButton).Tag); + SetFMStep(Idx); SaveCurrentBand; end; procedure TMainForm.SetFMCTCSSTone(Idx: Integer); -var - OldIdx: Integer; begin - OldIdx := FFMCTCSSToneIdx; FFMCTCSSToneIdx := Idx; - if BtnFMCTCSSTone <> nil then - begin - BtnFMCTCSSTone.Caption := CTCSS_NAMES[Idx]; - BtnFMCTCSSTone.Invalidate; - end; - // Only flip Active on the two affected buttons — avoids 38× StyleButton/font overhead - if (OldIdx <> Idx) and (FBtnCTCSSTones[OldIdx] <> nil) then - FBtnCTCSSTones[OldIdx].Active := False; - if FBtnCTCSSTones[Idx] <> nil then - FBtnCTCSSTones[Idx].Active := True; + if FCTCSSDropDown <> nil then FCTCSSDropDown.SetItemIndex(Idx); if FWDSPReady then FDSPEngine.SetTXCTCSS(FFMCTCSSOn, CTCSS_TONES[Idx]); end; @@ -5129,30 +5061,14 @@ begin end; procedure TMainForm.BtnFMCTCSSToneClick(Sender: TObject); -var - Y0: Integer; begin - // Toggle the dropdown - if PanelFMCTCSSPop.Visible then - begin - CloseCTCSSPopup; - Exit; - end; - // Position below the CTCSS panel, or above if no room - Y0 := PanelFMCTCSS.Top + PanelFMCTCSS.Height + 2; - if Y0 + PanelFMCTCSSPop.Height > PanelLeft.ClientHeight then - Y0 := PanelFMCTCSS.Top - PanelFMCTCSSPop.Height - 2; - if Y0 < 0 then Y0 := 0; - PanelFMCTCSSPop.Top := Y0; - PanelFMCTCSSPop.Left := 0; - PanelFMCTCSSPop.BringToFront; - PanelFMCTCSSPop.Visible := True; + FStepDropDown.ClosePopup; + FCTCSSDropDown.Toggle; end; -procedure TMainForm.BtnFMToneSelectClick(Sender: TObject); +procedure TMainForm.OnCTCSSDropDownSelect(Sender: TObject; Idx: Integer); begin - CloseCTCSSPopup; - SetFMCTCSSTone((Sender as TFlatButton).Tag); + SetFMCTCSSTone(Idx); end; procedure TMainForm.BtnVfoSwapClick(Sender: TObject); diff --git a/ewsdr.lpi b/ewsdr.lpi index 752b758..0e76185 100644 --- a/ewsdr.lpi +++ b/ewsdr.lpi @@ -115,6 +115,10 @@ + + + +