unit SampleRateOverlay; { Overlay виджет для выбора sample rate (span) спектра. Размещается в верхнем левом углу спектрограммы поверх PbSpectrum. Содержит кнопку скрытия левой панели и ряд кнопок span. } {$IFDEF FPC} {$MODE Delphi} {$ENDIF} interface uses Classes, SysUtils, Controls, Graphics, Types, Math; type TSpanSelectEvent = procedure(SampleRate: Integer) of object; THidePanelEvent = procedure of object; TSampleRateOverlay = class(TCustomControl) private FCurrentRate: Integer; FPanelHidden: Boolean; FOnSpanSelect: TSpanSelectEvent; FOnHidePanel: THidePanelEvent; FHitRects: array[0..6] of TRect; // [0]=hide button, [1..6]=span buttons FHitValues: array[0..6] of Integer; // 0=hide, else sample rate FHitCount: Integer; FHotIdx: Integer; procedure DrawSelf(C: TCanvas; W, H: Integer); procedure RegisterHit(const HR: TRect; Value: Integer); protected procedure Paint; override; procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseLeave; override; public constructor Create(AOwner: TComponent); override; procedure SetCurrentRate(Rate: Integer); procedure SetPanelHidden(Hidden: Boolean); property OnSpanSelect: TSpanSelectEvent read FOnSpanSelect write FOnSpanSelect; property OnHidePanel: THidePanelEvent read FOnHidePanel write FOnHidePanel; end; implementation const SPAN_RATES: array[0..5] of Integer = (48000, 96000, 192000, 384000, 768000, 1536000); SPAN_NAMES: array[0..5] of string = ('48k', '96k', '192k', '384k', '768k', '1536k'); HIDE_W = 22; SPAN_H = 18; PAD_X = 4; PAD_Y = 4; BTN_GAP = 3; CLR_BG = TColor($00141414); CLR_BORDER = TColor($00505050); CLR_TEXT = TColor($00D8E6EE); CLR_BTN_NORM = TColor($00543F18); CLR_BTN_HOT = TColor($00624B1D); CLR_BTN_ACT = TColor($00785A20); CLR_BTN_BDR = TColor($00685624); function SpanBtnWidth(const Name: string; C: TCanvas): Integer; begin C.Font.Name := 'Courier New'; C.Font.Size := 7; C.Font.Style := []; Result := C.TextWidth(Name) + 10; if Result < 36 then Result := 36; end; constructor TSampleRateOverlay.Create(AOwner: TComponent); begin inherited Create(AOwner); ControlStyle := ControlStyle + [csOpaque]; FCurrentRate := 192000; FPanelHidden := False; FHitCount := 0; FHotIdx := -1; Cursor := crHandPoint; Width := 320; Height := SPAN_H + PAD_Y * 2; end; procedure TSampleRateOverlay.RegisterHit(const HR: TRect; Value: Integer); begin if FHitCount > High(FHitRects) then Exit; FHitRects[FHitCount] := HR; FHitValues[FHitCount] := Value; Inc(FHitCount); end; procedure TSampleRateOverlay.DrawSelf(C: TCanvas; W, H: Integer); var X, I, TW, TH, BtnW: Integer; HR: TRect; IsAct, IsHot: Boolean; Cap: string; begin FHitCount := 0; // Фон C.Brush.Color := CLR_BG; C.Brush.Style := bsSolid; C.Pen.Style := psClear; C.FillRect(Rect(0, 0, W, H)); // Рамка C.Pen.Style := psSolid; C.Pen.Color := CLR_BORDER; C.Brush.Style := bsClear; C.Rectangle(0, 0, W, H); C.Font.Name := 'Courier New'; C.Font.Size := 7; C.Font.Style := []; TH := C.TextHeight('A'); X := PAD_X; // Кнопка скрытия панели (◀ или ▶) HR := Rect(X, PAD_Y, X + HIDE_W, PAD_Y + SPAN_H); IsHot := (FHotIdx = 0); if IsHot then C.Brush.Color := CLR_BTN_HOT else C.Brush.Color := CLR_BTN_NORM; C.Brush.Style := bsSolid; C.Pen.Style := psClear; C.FillRect(HR); C.Pen.Style := psSolid; C.Pen.Color := CLR_BTN_BDR; C.Brush.Style := bsClear; C.Rectangle(HR); C.Font.Size := 8; if FPanelHidden then Cap := '▶' else Cap := '◀'; TW := C.TextWidth(Cap); C.Font.Size := 7; C.Font.Color := CLR_TEXT; C.Brush.Style := bsClear; C.Font.Size := 8; C.TextOut(HR.Left + (HIDE_W - TW) div 2, HR.Top + (SPAN_H - TH) div 2, Cap); C.Font.Size := 7; RegisterHit(HR, 0); Inc(X, HIDE_W + BTN_GAP); // Кнопки span for I := 0 to High(SPAN_RATES) do begin BtnW := SpanBtnWidth(SPAN_NAMES[I], C); HR := Rect(X, PAD_Y, X + BtnW, PAD_Y + SPAN_H); IsAct := (SPAN_RATES[I] = FCurrentRate); IsHot := (FHotIdx = I + 1); if IsAct then C.Brush.Color := CLR_BTN_ACT else if IsHot then C.Brush.Color := CLR_BTN_HOT else C.Brush.Color := CLR_BTN_NORM; C.Brush.Style := bsSolid; C.Pen.Style := psClear; C.FillRect(HR); C.Pen.Style := psSolid; C.Pen.Color := CLR_BTN_BDR; C.Brush.Style := bsClear; C.Rectangle(HR); TW := C.TextWidth(SPAN_NAMES[I]); C.Font.Color := CLR_TEXT; C.Brush.Style := bsClear; C.TextOut(HR.Left + (BtnW - TW) div 2, HR.Top + (SPAN_H - TH) div 2, SPAN_NAMES[I]); RegisterHit(HR, SPAN_RATES[I]); Inc(X, BtnW + BTN_GAP); end; end; procedure TSampleRateOverlay.Paint; begin DrawSelf(Canvas, Width, Height); end; procedure TSampleRateOverlay.MouseMove(Shift: TShiftState; X, Y: Integer); var I, OldHot: Integer; begin OldHot := FHotIdx; FHotIdx := -1; for I := 0 to FHitCount - 1 do if PtInRect(FHitRects[I], Point(X, Y)) then begin FHotIdx := I; Break; end; if FHotIdx <> OldHot then Invalidate; inherited MouseMove(Shift, X, Y); end; procedure TSampleRateOverlay.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var I: Integer; begin if Button <> mbLeft then Exit; for I := 0 to FHitCount - 1 do if PtInRect(FHitRects[I], Point(X, Y)) then begin if FHitValues[I] = 0 then begin if Assigned(FOnHidePanel) then FOnHidePanel; end else begin if Assigned(FOnSpanSelect) then FOnSpanSelect(FHitValues[I]); end; Break; end; end; procedure TSampleRateOverlay.MouseLeave; begin if FHotIdx >= 0 then begin FHotIdx := -1; Invalidate; end; inherited MouseLeave; end; procedure TSampleRateOverlay.SetCurrentRate(Rate: Integer); begin if FCurrentRate = Rate then Exit; FCurrentRate := Rate; Invalidate; end; procedure TSampleRateOverlay.SetPanelHidden(Hidden: Boolean); begin if FPanelHidden = Hidden then Exit; FPanelHidden := Hidden; Invalidate; end; end.