ewsdr/FlatDropDown.pas

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, Math, 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;
    FItemBtnH96:  Integer;
    FRightInset96: Integer;
    FIsOpen:      Boolean;
    FStyleProc:   TButtonStyleProc;
    FPanelColor:  TColor;
    FOnSelect:    TDropDownSelectEvent;
    procedure ItemClick(Sender: TObject);
    procedure PositionPopup;
  public
    constructor Create(AAnchor: TFlatButton; APopupParent: TWinControl;
                       ACols, ABtnH: Integer; ARightInset96: Integer = 0);
    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;
                                  ARightInset96: Integer = 0);
begin
  inherited Create;
  FAnchor      := AAnchor;
  FPopupParent := APopupParent;
  FColumns     := Max(1, ACols);
  FItemBtnH96  := Max(1, ABtnH);
  FRightInset96 := Max(0, ARightInset96);
  FItemIndex   := 0;
  FIsOpen      := False;
  FStyleProc   := nil;
  FPanelColor  := TColor($00181818);
  FPopup := TPanel.Create(nil);
  FPopup.Parent     := APopupParent;
  FPopup.BevelOuter := bvNone;
  FPopup.Color      := FPanelColor;
  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, ItemBtnH, EdgePad, ItemGap: Integer;
  B: TFlatButton;
begin
  while FPopup.ControlCount > 0 do
    FPopup.Controls[0].Free;
  Count := Length(ANames);
  SetLength(FItemBtns, Count);
  // Popup может жить в контейнере с постоянно зарезервированным overlay-
  // scrollbar gutter. Inset задаётся в 96-DPI координатах и пересчитывается
  // при каждом наполнении: SetItems бывает и до, и после DPI-scale формы.
  PopW := Max(1, FPopupParent.ClientWidth -
                 FPopupParent.Scale96ToForm(FRightInset96));
  ItemBtnH := FPopupParent.Scale96ToForm(FItemBtnH96);
  EdgePad := FPopupParent.Scale96ToForm(2);
  ItemGap := FPopupParent.Scale96ToForm(2);
  BtnW := Max(1, (PopW - 2 * EdgePad) div FColumns);
  FPopup.SetBounds(0, 0, PopW,
                   ((Count + FColumns - 1) div FColumns) * ItemBtnH);
  for I := 0 to Count - 1 do
  begin
    B := MakeFlatBtn(FPopup, ANames[I],
                     EdgePad + (I mod FColumns) * BtnW,
                     (I div FColumns) * ItemBtnH,
                     Max(1, BtnW - ItemGap), ItemBtnH, @ItemClick);
    B.Tag    := I;
    B.Active := (I = FItemIndex);
    if Assigned(FStyleProc) then
      FStyleProc(B, B.Active);
    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 + FPopupParent.Scale96ToForm(2);
  if Y0 + FPopup.Height > FPopupParent.ClientHeight then
    Y0 := P.Y - FAnchor.Height - FPopup.Height -
          FPopupParent.Scale96ToForm(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
  FStyleProc := AStyleProc;
  FPanelColor := APanelColor;
  FPopup.Color := APanelColor;
  for I := 0 to High(FItemBtns) do
    if FItemBtns[I] <> nil then
      AStyleProc(FItemBtns[I], FItemBtns[I].Active);
end;

end.