mirror of
https://git.vladimir.cc/vladimir/ewsdr.git
synced 2026-08-25 17:27:32 +00:00
add FlatSlider
This commit is contained in:
+231
@@ -0,0 +1,231 @@
|
||||
unit FlatSlider;
|
||||
|
||||
{ Кастомный горизонтальный ползунок с тёмной темой — замена TTrackBar.
|
||||
Полностью отрисован через Canvas, одинаково выглядит на Windows и Linux. }
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Controls, Graphics, LCLType, Types, Math;
|
||||
|
||||
type
|
||||
TFlatSlider = class(TGraphicControl)
|
||||
private
|
||||
FMin: Integer;
|
||||
FMax: Integer;
|
||||
FPosition: Integer;
|
||||
FReversed: Boolean;
|
||||
FDragging: Boolean;
|
||||
FHot: Boolean;
|
||||
FOnChange: TNotifyEvent;
|
||||
procedure SetPosition(V: Integer);
|
||||
procedure SetMin(V: Integer);
|
||||
procedure SetMax(V: Integer);
|
||||
function PosToX(APos: Integer): Integer;
|
||||
function XToPos(AX: Integer): Integer;
|
||||
protected
|
||||
procedure Paint; override;
|
||||
procedure MouseEnter; override;
|
||||
procedure MouseLeave; override;
|
||||
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
|
||||
X, Y: Integer); override;
|
||||
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
|
||||
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
|
||||
X, Y: Integer); override;
|
||||
function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
|
||||
function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
|
||||
property Min: Integer read FMin write SetMin;
|
||||
property Max: Integer read FMax write SetMax;
|
||||
property Position: Integer read FPosition write SetPosition;
|
||||
property Reversed: Boolean read FReversed write FReversed;
|
||||
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
||||
property Enabled;
|
||||
property Visible;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
const
|
||||
THUMB_R = 6; // радиус ручки (px)
|
||||
TRACK_H = 4; // высота рельса (px)
|
||||
PAD = THUMB_R + 2; // боковой отступ чтобы ручка не вылезала
|
||||
|
||||
CLR_BG = TColor($00181818); // совпадает с CLR_PANEL
|
||||
CLR_TRACK_EMPTY = TColor($00323232);
|
||||
CLR_TRACK_FILL = TColor($00205018); // тёмно-зелёный, как тема
|
||||
CLR_THUMB_NORM = TColor($00407840);
|
||||
CLR_THUMB_HOT = TColor($0066BB66);
|
||||
CLR_THUMB_DRAG = TColor($0099EE99);
|
||||
CLR_THUMB_BDR = TColor($00122012);
|
||||
|
||||
constructor TFlatSlider.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FMin := 0;
|
||||
FMax := 100;
|
||||
FPosition := 0;
|
||||
FReversed := False;
|
||||
FDragging := False;
|
||||
FHot := False;
|
||||
Cursor := crHandPoint;
|
||||
end;
|
||||
|
||||
procedure TFlatSlider.SetPosition(V: Integer);
|
||||
var
|
||||
C: Integer;
|
||||
begin
|
||||
C := EnsureRange(V, FMin, FMax);
|
||||
if FPosition = C then Exit;
|
||||
FPosition := C;
|
||||
Invalidate;
|
||||
if Assigned(FOnChange) then FOnChange(Self);
|
||||
end;
|
||||
|
||||
procedure TFlatSlider.SetMin(V: Integer);
|
||||
begin
|
||||
if FMin = V then Exit;
|
||||
FMin := V;
|
||||
if FPosition < FMin then FPosition := FMin;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TFlatSlider.SetMax(V: Integer);
|
||||
begin
|
||||
if FMax = V then Exit;
|
||||
FMax := V;
|
||||
if FPosition > FMax then FPosition := FMax;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
// Позиция значения → пиксельная X-координата ручки
|
||||
function TFlatSlider.PosToX(APos: Integer): Integer;
|
||||
var
|
||||
Range, TrackW: Integer;
|
||||
begin
|
||||
Range := FMax - FMin;
|
||||
TrackW := Width - PAD * 2;
|
||||
if (Range <= 0) or (TrackW <= 0) then begin Result := PAD; Exit; end;
|
||||
if FReversed then
|
||||
Result := PAD + Round((FMax - APos) / Range * TrackW)
|
||||
else
|
||||
Result := PAD + Round((APos - FMin) / Range * TrackW);
|
||||
end;
|
||||
|
||||
// Пиксельная X-координата → значение позиции
|
||||
function TFlatSlider.XToPos(AX: Integer): Integer;
|
||||
var
|
||||
Range, TrackW, RawX: Integer;
|
||||
begin
|
||||
Range := FMax - FMin;
|
||||
TrackW := Width - PAD * 2;
|
||||
RawX := EnsureRange(AX - PAD, 0, TrackW);
|
||||
if (TrackW <= 0) or (Range <= 0) then begin Result := FMin; Exit; end;
|
||||
if FReversed then
|
||||
Result := FMax - Round(RawX / TrackW * Range)
|
||||
else
|
||||
Result := FMin + Round(RawX / TrackW * Range);
|
||||
Result := EnsureRange(Result, FMin, FMax);
|
||||
end;
|
||||
|
||||
procedure TFlatSlider.Paint;
|
||||
var
|
||||
CY, TX, FL, FR: Integer;
|
||||
TR: TRect;
|
||||
ThC: TColor;
|
||||
begin
|
||||
CY := Height div 2;
|
||||
TX := PosToX(FPosition);
|
||||
|
||||
Canvas.Brush.Color := CLR_BG;
|
||||
Canvas.Brush.Style := bsSolid;
|
||||
Canvas.Pen.Style := psClear;
|
||||
Canvas.FillRect(ClientRect);
|
||||
|
||||
// Рельс — весь
|
||||
TR := Rect(PAD, CY - TRACK_H div 2,
|
||||
Width - PAD, CY + (TRACK_H + 1) div 2);
|
||||
Canvas.Brush.Color := CLR_TRACK_EMPTY;
|
||||
Canvas.RoundRect(TR.Left, TR.Top, TR.Right, TR.Bottom, TRACK_H, TRACK_H);
|
||||
|
||||
// Рельс — заполненная часть
|
||||
if not FReversed then begin FL := PAD; FR := TX; end
|
||||
else begin FL := TX; FR := Width - PAD; end;
|
||||
if FR > FL then
|
||||
begin
|
||||
Canvas.Brush.Color := CLR_TRACK_FILL;
|
||||
Canvas.RoundRect(FL, TR.Top, FR, TR.Bottom, TRACK_H, TRACK_H);
|
||||
end;
|
||||
|
||||
// Ручка — круг
|
||||
if FDragging then ThC := CLR_THUMB_DRAG
|
||||
else if FHot then ThC := CLR_THUMB_HOT
|
||||
else ThC := CLR_THUMB_NORM;
|
||||
Canvas.Brush.Color := ThC;
|
||||
Canvas.Pen.Color := CLR_THUMB_BDR;
|
||||
Canvas.Pen.Style := psSolid;
|
||||
Canvas.Pen.Width := 1;
|
||||
Canvas.Ellipse(TX - THUMB_R, CY - THUMB_R,
|
||||
TX + THUMB_R + 1, CY + THUMB_R + 1);
|
||||
end;
|
||||
|
||||
procedure TFlatSlider.MouseEnter;
|
||||
begin
|
||||
inherited;
|
||||
FHot := True;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TFlatSlider.MouseLeave;
|
||||
begin
|
||||
inherited;
|
||||
FHot := False;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TFlatSlider.MouseDown(Button: TMouseButton; Shift: TShiftState;
|
||||
X, Y: Integer);
|
||||
begin
|
||||
inherited;
|
||||
if Button = mbLeft then
|
||||
begin
|
||||
FDragging := True;
|
||||
SetPosition(XToPos(X));
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFlatSlider.MouseMove(Shift: TShiftState; X, Y: Integer);
|
||||
begin
|
||||
inherited;
|
||||
if FDragging then
|
||||
SetPosition(XToPos(X));
|
||||
end;
|
||||
|
||||
procedure TFlatSlider.MouseUp(Button: TMouseButton; Shift: TShiftState;
|
||||
X, Y: Integer);
|
||||
begin
|
||||
inherited;
|
||||
if Button = mbLeft then
|
||||
begin
|
||||
FDragging := False;
|
||||
Invalidate;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFlatSlider.DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean;
|
||||
begin
|
||||
SetPosition(FPosition + 1);
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
function TFlatSlider.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean;
|
||||
begin
|
||||
SetPosition(FPosition - 1);
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
end.
|
||||
+14
-14
@@ -22,7 +22,7 @@ unit MainForm;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, StrUtils, FreqDisplay, DeviceForm, VfoOverlay, FlatButton, Forms, Controls, Graphics, Dialogs,
|
||||
Classes, SysUtils, StrUtils, FreqDisplay, DeviceForm, VfoOverlay, FlatButton, FlatSlider, Forms, Controls, Graphics, Dialogs,
|
||||
StdCtrls, ExtCtrls, ComCtrls, Buttons, Menus, Math, Types,
|
||||
LCLIntf, LCLType, GraphType,
|
||||
HPSDRProtocol, HPSDRNetwork,
|
||||
@@ -301,8 +301,8 @@ type
|
||||
PanelRX: TPanel;
|
||||
BtnAGCMode: array[0..4] of TFlatButton; // FAST MED SLOW LONG OFF
|
||||
LblAGCTop: TLabel; // показывает значение уровня
|
||||
TrkAGC: TTrackBar; // ползунок уровня AGC
|
||||
TrkVolume: TTrackBar;
|
||||
TrkAGC: TFlatSlider;
|
||||
TrkVolume: TFlatSlider;
|
||||
BtnNR: TFlatButton;
|
||||
BtnNB: TFlatButton;
|
||||
BtnSNB: TFlatButton;
|
||||
@@ -316,7 +316,7 @@ type
|
||||
|
||||
PanelTX: TPanel;
|
||||
LblDrv: TLabel;
|
||||
TrkDrive: TTrackBar;
|
||||
TrkDrive: TFlatSlider;
|
||||
BtnMOX: TFlatButton;
|
||||
PbFwdPower: TPaintBox;
|
||||
PbSWR: TPaintBox;
|
||||
@@ -1529,12 +1529,12 @@ begin
|
||||
|
||||
// AGC level slider
|
||||
MakeLbl(PanelRX, 'THRESH', 4, 50);
|
||||
TrkAGC := TTrackBar.Create(Self);
|
||||
TrkAGC := TFlatSlider.Create(Self);
|
||||
TrkAGC.Parent := PanelRX; TrkAGC.Left := 56; TrkAGC.Top := 46;
|
||||
TrkAGC.Width := LEFT_W - 96; TrkAGC.Height := 20;
|
||||
TrkAGC.Width := LEFT_W - 96; TrkAGC.Height := 16;
|
||||
TrkAGC.Min := 20; TrkAGC.Max := 120; // 20..120 → −20..-120 dBm
|
||||
TrkAGC.Position := FAGCTop;
|
||||
TrkAGC.TickStyle := tsNone; TrkAGC.Reversed := True;
|
||||
TrkAGC.Reversed := True;
|
||||
TrkAGC.OnChange := TrkAGCChange;
|
||||
|
||||
LblAGCTop := TLabel.Create(Self);
|
||||
@@ -1546,11 +1546,11 @@ begin
|
||||
|
||||
// VOL
|
||||
MakeLbl(PanelRX, 'VOL', 4, 74);
|
||||
TrkVolume := TTrackBar.Create(Self);
|
||||
TrkVolume := TFlatSlider.Create(Self);
|
||||
TrkVolume.Parent := PanelRX; TrkVolume.Left := 34; TrkVolume.Top := 70;
|
||||
TrkVolume.Width := LEFT_W - 38; TrkVolume.Height := 20;
|
||||
TrkVolume.Width := LEFT_W - 38; TrkVolume.Height := 16;
|
||||
TrkVolume.Min := 0; TrkVolume.Max := 100;
|
||||
TrkVolume.Position := FVolume; TrkVolume.TickStyle := tsNone;
|
||||
TrkVolume.Position := FVolume;
|
||||
TrkVolume.OnChange := TrkVolumeChange;
|
||||
|
||||
// NR NB SNB ANF MUTE
|
||||
@@ -1581,11 +1581,11 @@ begin
|
||||
LblDrv.Caption := 'DRV'; LblDrv.Font.Color := CLR_TEXTDIM;
|
||||
LblDrv.Font.Name := 'Courier New'; LblDrv.Font.Size := 7;
|
||||
|
||||
TrkDrive := TTrackBar.Create(Self);
|
||||
TrkDrive.Parent := PanelTX; TrkDrive.Left := 34; TrkDrive.Top := 14;
|
||||
TrkDrive.Width := 150; TrkDrive.Height := 22;
|
||||
TrkDrive := TFlatSlider.Create(Self);
|
||||
TrkDrive.Parent := PanelTX; TrkDrive.Left := 34; TrkDrive.Top := 16;
|
||||
TrkDrive.Width := 150; TrkDrive.Height := 16;
|
||||
TrkDrive.Min := 0; TrkDrive.Max := 100; TrkDrive.Position := 50;
|
||||
TrkDrive.TickStyle := tsNone; TrkDrive.OnChange := TrkDriveChange;
|
||||
TrkDrive.OnChange := TrkDriveChange;
|
||||
|
||||
BtnMOX := MakeBtn(PanelTX, 'MOX', 2, 38, 70, 32, BtnMOXClick);
|
||||
BtnMOX.Font.Size := 12; BtnMOX.Font.Bold := True;
|
||||
|
||||
Reference in New Issue
Block a user