source: tags/1.1.0/UMenu.pas

unit UMenu;

{$mode delphi}

interface

uses
  Classes, SysUtils, Graphics, Controls, fgl;

type
  TMenuItemKind = (ikButton, ikComboBox, ikCheckBox);

  { TMenuItem }

  TMenuItem = class
    BackgroundColor: TColor;
    BackgroundSelectedColor: TColor;
    Kind: TMenuItemKind;
    Text: string;
    Bounds: TRect;
    Selected: Boolean;
    FontSize: Integer;
    FontColor: Integer;
    Enabled: Boolean;
    procedure Paint(Canvas: TCanvas; P: TPoint); virtual;
    function GetOutputText: string; virtual;
    constructor Create;
  end;

  { TMenuItemCheckBox }

  TMenuItemCheckBox = class(TMenuItem)
  private
    FOnChanged: TNotifyEvent;
  public
    Checked: Boolean;
    procedure Paint(Canvas: TCanvas; P: TPoint); override;
    property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
  end;

  { TMenuItemComboBox }

  TMenuItemComboBox = class(TMenuItem)
  private
    FOnChanged: TNotifyEvent;
  public
    Index: Integer;
    States: TStringList;
    constructor Create;
    destructor Destroy; override;
    procedure Paint(Canvas: TCanvas; P: TPoint); override;
    function GetOutputText: string; override;
    property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
  end;

  { TMenuItemButton }

  TMenuItemButton = class(TMenuItem)
  private
    FOnClick: TNotifyEvent;
  public
    procedure Paint(Canvas: TCanvas; P: TPoint); override;
    property OnClick: TNotifyEvent read FOnClick write FOnClick;
  end;

  { TMenuItems }

  TMenuItems = class(TFPGObjectList<TMenuItem>)
    function AddButton(Text: string; OnClick: TNotifyEvent): TMenuItemButton;
    function AddCheckBox(Text: string; OnChanged: TNotifyEvent): TMenuItemCheckBox;
    function AddComboBox(Text: string; States: array of string; OnChanged:
      TNotifyEvent): TMenuItemComboBox;
  end;

  TMenu = class
  private
    FOnExit: TNotifyEvent;
  public
    Items: TMenuItems;
    Parent: TMenu;
    procedure MouseMove(Position: TPoint);
    procedure MouseUp(Button: TMouseButton; Position: TPoint);
    procedure Paint(Canvas: TCanvas; CanvasSize: TPoint);
    constructor Create;
    destructor Destroy; override;
    property OnExit: TNotifyEvent read FOnExit write FOnExit;
  end;

resourcestring
  SPlay = 'Play';
  SOptions = 'Options';
  SExit = 'Exit';
  SBigMetro = 'Big Metro';
  SDarkMode = 'Dark mode';
  SLanguage = 'Language';
  SCzech = 'Czech';
  SEnglish = 'English';
  SBack = 'Back';
  SAutomatic = 'Automatic';
  SFullScreen = 'Full screen';
  SContinue = 'Continue';
  SRestart = 'Try again';


implementation

{ TMenuItemButton }

procedure TMenuItemButton.Paint(Canvas: TCanvas; P: TPoint);
begin
  if Selected then Canvas.Brush.Color := BackgroundSelectedColor
    else Canvas.Brush.Color := BackgroundColor;
  if Canvas.Brush.Color = clNone then Canvas.Brush.Style := bsClear
    else Canvas.Brush.Style := bsSolid;
  Bounds := Classes.Bounds(P.X, P.Y, Canvas.TextWidth(Text), Canvas.TextHeight(Text));
  Canvas.TextOut(P.X, P.Y, Text);
end;

{ TMenuItemCheckBox }

procedure TMenuItemCheckBox.Paint(Canvas: TCanvas; P: TPoint);
var
  OutputText: string;
begin
  OutputText := Text;
  if Checked then OutputText := '✓' + OutputText;
  if Selected then Canvas.Brush.Color := BackgroundSelectedColor
    else Canvas.Brush.Color := BackgroundColor;
  if Canvas.Brush.Color = clNone then Canvas.Brush.Style := bsClear
    else Canvas.Brush.Style := bsSolid;
  Bounds := Classes.Bounds(P.X, P.Y, Canvas.TextWidth(OutputText), Canvas.TextHeight(OutputText));
  Canvas.TextOut(P.X, P.Y, OutputText);
end;

{ TMenuItem }

procedure TMenuItem.Paint(Canvas: TCanvas; P: TPoint);
begin
end;

function TMenuItem.GetOutputText: string;
begin
  Result := Text;
end;

constructor TMenuItem.Create;
begin
  Enabled := True;
  FontSize := 40;
  FontColor := clWhite;
end;

{ TMenuItemComboBox }

constructor TMenuItemComboBox.Create;
begin
  States := TStringList.Create;
end;

destructor TMenuItemComboBox.Destroy;
begin
  States.Free;
  inherited;
end;

procedure TMenuItemComboBox.Paint(Canvas: TCanvas; P: TPoint);
begin
  if Selected then Canvas.Brush.Color := BackgroundSelectedColor
    else Canvas.Brush.Color := BackgroundColor;
  if Canvas.Brush.Color = clNone then Canvas.Brush.Style := bsClear
    else Canvas.Brush.Style := bsSolid;
  Bounds := Classes.Bounds(P.X, P.Y, Canvas.TextWidth(GetOutputText), Canvas.TextHeight(GetOutputText));
  Canvas.TextOut(P.X, P.Y, GetOutputText);
end;

function TMenuItemComboBox.GetOutputText: string;
begin
  Result := Text + ': ' + States[Index];
end;

{ TMenu }

procedure TMenu.MouseMove(Position: TPoint);
var
  I: Integer;
begin
  for I := 0 to Items.Count - 1 do begin
    if Items[I].Enabled then
      Items[I].Selected := Items[I].Bounds.Contains(Position);
  end;
end;

procedure TMenu.MouseUp(Button: TMouseButton; Position: TPoint);
var
  I: Integer;
begin
  for I := 0 to Items.Count - 1 do begin
    if Items[I].Bounds.Contains(Position) then begin
      if (Items[I] is TMenuItemButton) then begin
        if Assigned(TMenuItemButton(Items[I]).FOnClick) then
          TMenuItemButton(Items[I]).FOnClick(Items[I]);
      end else
      if (Items[I] is TMenuItemCheckBox) then begin
        (Items[I] as TMenuItemCheckBox).Checked := not (Items[I] as TMenuItemCheckBox).Checked;
        if Assigned((Items[I] as TMenuItemCheckBox).FOnChanged) then
          (Items[I] as TMenuItemCheckBox).FOnChanged(Items[I]);
      end else
      if (Items[I] is TMenuItemComboBox) then begin
        (Items[I] as TMenuItemComboBox).Index := ((Items[I] as TMenuItemComboBox).Index + 1) mod
          (Items[I] as TMenuItemComboBox).States.Count;
        if Assigned((Items[I] as TMenuItemComboBox).FOnChanged) then
          (Items[I] as TMenuItemComboBox).FOnChanged(Items[I]);
      end;
    end;
  end;
end;

procedure TMenu.Paint(Canvas: TCanvas; CanvasSize: TPoint);
var
  I: Integer;
  X: Integer;
  Y: Integer;
  LineHeight: Integer;
  TotalWidth: Integer;
  TotalHeight: Integer;
begin
  with Canvas do begin
    TotalWidth := 0;
    TotalHeight := 0;

    // Calculate total dimensions for centering
    Font.Style := [fsBold];
    Brush.Style := bsSolid;
    for I := 0 to Items.Count - 1 do begin
      Font.Size := Items[I].FontSize;
      if TotalWidth < TextWidth(Items[I].GetOutputText) then
        TotalWidth := TextWidth(Items[I].GetOutputText);
      LineHeight := Round(TextHeight('I') * 1.1);
      TotalHeight := TotalHeight + LineHeight;
    end;

    X := (CanvasSize.X - TotalWidth) div 2;
    Y := (CanvasSize.Y - TotalHeight) div 2;

    // Menu items
    Font.Style := [fsBold];
    Brush.Style := bsSolid;
    for I := 0 to Items.Count - 1 do begin
      Font.Size := Items[I].FontSize;
      Font.Color := Items[I].FontColor;
      Items[I].Paint(Canvas, Point(X, Y));
      LineHeight := Round(TextHeight('I') * 1.1);
      Inc(Y, LineHeight);
    end;
  end;
end;

constructor TMenu.Create;
begin
  Items := TMenuItems.Create;
end;

destructor TMenu.Destroy;
begin
  FreeAndNil(Items);
  inherited;
end;

{ TMenuItems }

function TMenuItems.AddButton(Text: string; OnClick: TNotifyEvent
  ): TMenuItemButton;
begin
  Result := TMenuItemButton.Create;
  Result.Text := Text;
  Result.OnClick := OnClick;
  Add(Result);
end;

function TMenuItems.AddCheckBox(Text: string; OnChanged: TNotifyEvent): TMenuItemCheckBox;
begin
  Result := TMenuItemCheckBox.Create;
  Result.Text := Text;
  Result.OnChanged := OnChanged;
  Add(Result);
end;

function TMenuItems.AddComboBox(Text: string; States: array of string
  ; OnChanged: TNotifyEvent): TMenuItemComboBox;
var
  I: Integer;
begin
  Result := TMenuItemComboBox.Create;
  Result.Text := Text;
  Result.OnChanged := OnChanged;
  for I := 0 to Length(States) - 1 do
    Result.States.Add(States[I]);
  Add(Result);
end;


end.