ewsdr/FreqDisplay.pas

unit FreqDisplay;

{
  TFreqDisplay — цифровой дисплей частоты с управлением по разрядам
  ===================================================================
  Отображает частоту в Гц вида  14.201.123
  Наводишь мышь на цифру → подсветка разряда.
  Колёсико мыши → меняет выделенный разряд (+/- 10^N).
  Стрелки Left/Right → переключают активный разряд.
  Стрелки Up/Down    → меняют активный разряд.
}

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Controls, Graphics, LCLType;

type
  TFreqChangeEvent = procedure(Sender: TObject; NewFreq: Int64) of object;

  TFreqDisplay = class(TCustomControl)
  private
    FFrequency:   Int64;
    FMinFreq:     Int64;
    FMaxFreq:     Int64;
    FFontSize:    Integer;
    FFontName:    string;
    FColorNormal:   TColor;
    FColorHover:    TColor;
    FColorHoverBG:  TColor;
    FColorDim:      TColor;
    FMinMhzDigits: Integer;
    FDimLeadingZeros: Boolean;
    FCenterText: Boolean;
    FOnChange:    TFreqChangeEvent;

    FHoverDigit:  Integer;          // 0=единицы .. 10=10ГГц, -1=нет
    FDigitX:      array[0..10] of Integer; // X левого края каждой цифры
    FDigitW:      Integer;
    FCharH:       Integer;

    procedure SetFrequency(V: Int64);
    procedure SetFontSize(V: Integer);
    function  ClampFreq(V: Int64): Int64;
    function  DigitAtX(X: Integer): Integer;
    function  DigitStep(D: Integer): Int64;
    procedure ChangeByDigit(D, Delta: Integer);
    procedure BuildDigitMap(const S: string; StartX: Integer);

  protected
    procedure Paint; override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseLeave; override;
    function  DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
      MousePos: TPoint): Boolean; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure Click; override;

  public
    constructor Create(AOwner: TComponent); override;

    property Frequency:   Int64    read FFrequency   write SetFrequency;
    property MinFreq:     Int64    read FMinFreq     write FMinFreq;
    property MaxFreq:     Int64    read FMaxFreq     write FMaxFreq;
    property FontSize:    Integer  read FFontSize    write SetFontSize;
    property FontName:    string   read FFontName    write FFontName;
    property ColorNormal:  TColor  read FColorNormal  write FColorNormal;
    property ColorHover:   TColor  read FColorHover   write FColorHover;
    property ColorHoverBG: TColor  read FColorHoverBG write FColorHoverBG;
    property ColorDim:     TColor  read FColorDim     write FColorDim;
    property MinMhzDigits: Integer read FMinMhzDigits write FMinMhzDigits;
    property DimLeadingZeros: Boolean read FDimLeadingZeros write FDimLeadingZeros;
    property CenterText: Boolean read FCenterText write FCenterText;
    property OnChange:    TFreqChangeEvent read FOnChange write FOnChange;
  end;

implementation

constructor TFreqDisplay.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FFrequency    := 14200000;
  FMinFreq      := 0;
  FMaxFreq      := 2000000000;
  FFontSize     := 20;
  FFontName     := 'Courier New';
  FColorNormal  := TColor($00E8F0FF);
  FColorHover   := TColor($0040DDFF);
  FColorHoverBG := TColor($00182838);
  FColorDim     := TColor($00607080);
  FMinMhzDigits := 1;
  FDimLeadingZeros := False;
  FCenterText    := True;
  FHoverDigit   := -1;
  FDigitW       := 14;
  FCharH        := 24;
  TabStop       := True;
  Width         := 220;
  Height        := 40;
end;

function TFreqDisplay.ClampFreq(V: Int64): Int64;
begin
  if V < FMinFreq then Result := FMinFreq
  else if V > FMaxFreq then Result := FMaxFreq
  else Result := V;
end;

function TFreqDisplay.DigitStep(D: Integer): Int64;
var
  i:      Integer;
  Result_: Int64;
begin
  Result_ := 1;
  for i := 0 to D - 1 do
    Result_ := Result_ * 10;
  Result := Result_;
end;

function TFreqDisplay.DigitAtX(X: Integer): Integer;
var
  i: Integer;
begin
  Result := -1;
  if FDigitW = 0 then Exit;
  for i := 0 to 10 do
    if (X >= FDigitX[i]) and (X < FDigitX[i] + FDigitW) then
    begin
      Result := i;
      Exit;
    end;
end;

// Строим карту FDigitX из строки вида "14.201.123"
// Цифры нумеруются справа налево: digit0=единицы, digit8=сотни млн
procedure TFreqDisplay.BuildDigitMap(const S: string; StartX: Integer);
var
  Xs:    array[0..13] of Integer;  // X каждого символа строки (макс 14 симв)
  ci:    Integer;
  xi:    Integer;
  dIdx:  Integer;
  len:   Integer;
begin
  len := Length(S);
  if len > 13 then len := 13;

  xi := StartX;
  for ci := 0 to len - 1 do
  begin
    Xs[ci] := xi;
    Inc(xi, Canvas.TextWidth(S[ci + 1]));
  end;

  // Назначаем digit индексы справа налево, пропуская точки
  dIdx := 0;
  for ci := len - 1 downto 0 do
  begin
    if S[ci + 1] <> '.' then
    begin
      if dIdx <= 10 then
        FDigitX[dIdx] := Xs[ci];
      Inc(dIdx);
    end;
  end;
end;

procedure TFreqDisplay.Paint;
var
  C:       TCanvas;
  S:       string;
  Hz:      Int64;
  Mhz:     Integer;
  KHz:     Integer;
  Ones:    Integer;
  MhzFmt:  string;
  MhzText: string;
  LeadingMhzZeros: Integer;
  TotalW:  Integer;
  StartX:  Integer;
  ChW, ChH: Integer;
  xi:      Integer;
  ci:      Integer;
  ch:      Char;
  dIdx:    Integer;
  col:     TColor;
  DiChar:  array[0..13] of Integer;
  tmpIdx:  Integer;
  len:     Integer;
begin
  C := Canvas;

  // Фон — прозрачный (наследует от Panel)
  C.Brush.Style := bsClear;
  C.FillRect(ClientRect);

  C.Font.Name  := FFontName;
  C.Font.Size  := FFontSize;
  C.Font.Bold  := True;
  C.Font.Style := [fsBold];

  ChW := C.TextWidth('0');
  ChH := C.TextHeight('0');
  FDigitW := ChW;
  FCharH  := ChH;

  Hz   := Abs(FFrequency);
  Mhz  := Hz div 1000000;
  KHz  := (Hz div 1000) mod 1000;
  Ones := Hz mod 1000;
  if FMinMhzDigits > 1 then
    MhzFmt := '%.' + IntToStr(FMinMhzDigits) + 'd'
  else
    MhzFmt := '%d';
  MhzText := Format(MhzFmt, [Mhz]);
  S := MhzText + Format('.%3.3d.%3.3d', [KHz, Ones]);

  LeadingMhzZeros := 0;
  while FDimLeadingZeros and
        (LeadingMhzZeros < Length(MhzText) - 1) and
        (MhzText[LeadingMhzZeros + 1] = '0') do
    Inc(LeadingMhzZeros);

  TotalW := C.TextWidth(S);
  if FCenterText then
    StartX := (Width - TotalW) div 2
  else
    StartX := 2;
  if StartX < 2 then StartX := 2;

  // Строим карту digit → X
  BuildDigitMap(S, StartX);

  // Строим обратную карту символ → digit index
  len := Length(S);
  if len > 13 then len := 13;
  tmpIdx := 0;
  for ci := len - 1 downto 0 do
  begin
    if S[ci + 1] <> '.' then
    begin
      DiChar[ci] := tmpIdx;
      Inc(tmpIdx);
    end
    else
      DiChar[ci] := -1;
  end;

  // Рисуем
  xi := StartX;
  for ci := 0 to len - 1 do
  begin
    ch   := S[ci + 1];
    dIdx := DiChar[ci];

    if ch = '.' then
      col := FColorDim
    else if FDimLeadingZeros and (ci < LeadingMhzZeros) then
      col := FColorDim
    else if dIdx = FHoverDigit then
      col := FColorHover
    else
      col := FColorNormal;

    // Фоновая подсветка активного разряда
    if (dIdx >= 0) and (dIdx = FHoverDigit) then
    begin
      C.Brush.Color := FColorHoverBG;
      C.Brush.Style := bsSolid;
      C.FillRect(Rect(xi - 1, 2, xi + ChW + 1, Height - 2));
      C.Brush.Style := bsClear;
    end;

    C.Font.Color  := col;
    C.Brush.Style := bsClear;
    C.TextOut(xi, (Height - ChH) div 2, ch);
    Inc(xi, C.TextWidth(ch));
  end;

  // Рамка фокуса
  if Focused then
  begin
    C.Pen.Color  := TColor($00004060);
    C.Pen.Style  := psDot;
    C.Pen.Width  := 1;
    C.Brush.Style := bsClear;
    C.Rectangle(1, 1, Width - 2, Height - 2);
    C.Pen.Style := psSolid;
  end;
end;

procedure TFreqDisplay.ChangeByDigit(D, Delta: Integer);
var
  Step:    Int64;
  Base:    Int64;
  NewFreq: Int64;
begin
  if D < 0 then Exit;
  Step := DigitStep(D);
  // Нижняя граница текущего разряда (кратная Step)
  Base := (FFrequency div Step) * Step;
  if Delta > 0 then
  begin
    // Вверх: от нижней границы + шаг
    // 7.129.054 + 100 → base=7.129.000 → 7.129.000 + 100 = 7.129.100
    NewFreq := Base + Step * Delta;
  end
  else
  begin
    // Вниз:
    // Если уже кратна — просто шагаем: 7.129.100 - 100 = 7.129.000
    // Если не кратна — возвращаем нижнюю границу: 7.129.054 → 7.129.000
    if FFrequency = Base then
      NewFreq := Base + Step * Delta  // кратна → шагаем
    else
      NewFreq := Base;                // не кратна → снэп к нижней границе
  end;
  NewFreq := ClampFreq(NewFreq);
  if NewFreq <> FFrequency then
  begin
    FFrequency := NewFreq;
    Invalidate;
    if Assigned(FOnChange) then
      FOnChange(Self, FFrequency);
  end;
end;

procedure TFreqDisplay.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  d: Integer;
begin
  inherited;
  d := DigitAtX(X);
  if d <> FHoverDigit then
  begin
    FHoverDigit := d;
    Invalidate;
  end;
  if d >= 0 then Cursor := crHandPoint
  else            Cursor := crDefault;
end;

procedure TFreqDisplay.MouseLeave;
begin
  inherited;
  if FHoverDigit <> -1 then
  begin
    FHoverDigit := -1;
    Invalidate;
  end;
  Cursor := crDefault;
end;

function TFreqDisplay.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
  MousePos: TPoint): Boolean;
var
  d:     Integer;
  Delta: Integer;
  Local: TPoint;
begin
  Result := False;
  Local  := ScreenToClient(MousePos);
  d := FHoverDigit;
  if d < 0 then
    d := DigitAtX(Local.X);
  if d >= 0 then
  begin
    if WheelDelta > 0 then Delta := 1 else Delta := -1;
    ChangeByDigit(d, Delta);
    Result := True;  // обработали — не передаём дальше
  end;
  if not Result then
    Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos);
end;

procedure TFreqDisplay.KeyDown(var Key: Word; Shift: TShiftState);
var
  d: Integer;
begin
  d := FHoverDigit;
  if d < 0 then d := 3;  // по умолчанию — кГц
  case Key of
    VK_UP:   begin ChangeByDigit(d, +1); Key := 0; end;
    VK_DOWN: begin ChangeByDigit(d, -1); Key := 0; end;
    VK_LEFT: begin
               if FHoverDigit < 0 then FHoverDigit := 3;
               if FHoverDigit < FMinMhzDigits + 5 then Inc(FHoverDigit);
               Invalidate; Key := 0;
             end;
    VK_RIGHT: begin
               if FHoverDigit < 0 then FHoverDigit := 3;
               if FHoverDigit > 0 then Dec(FHoverDigit);
               Invalidate; Key := 0;
              end;
  end;
  inherited KeyDown(Key, Shift);
end;

procedure TFreqDisplay.Click;
begin
  inherited;
  SetFocus;
end;

procedure TFreqDisplay.SetFrequency(V: Int64);
begin
  V := ClampFreq(V);
  if V <> FFrequency then
  begin
    FFrequency := V;
    Invalidate;
  end;
end;

procedure TFreqDisplay.SetFontSize(V: Integer);
begin
  if V <> FFontSize then
  begin
    FFontSize := V;
    Invalidate;
  end;
end;

end.