source: trunk/Menu.pas

unit Menu;

interface

uses
  Classes, SysUtils, Graphics, Controls, Generics.Collections, BasicControls;

type
  TMenuItemKind = (ikButton, ikComboBox, ikCheckBox);

  { TMenuItem }

  TMenuItem = class(TControl)
    BackgroundColor: TColor;
    BackgroundSelectedColor: TColor;
    TextColor: TColor;
    TextDisabledColor: TColor;
    Kind: TMenuItemKind;
    Text: string;
    Selected: Boolean;
    TextSize: Integer;
    function GetOutputText: string; virtual;
    constructor Create; override;
  end;

  { TMenuItemCheckBox }

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

  { TMenuItemComboBox }

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

  { TMenuItemButton }

  TMenuItemButton = class(TMenuItem)
  public
    procedure Paint; override;
  end;

  { TMenuItems }

  TMenuItems = class(TObjectList<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; virtual;
    destructor Destroy; override;
    property OnExit: TNotifyEvent read FOnExit write FOnExit;
  end;


implementation

{ TMenuItemButton }

procedure TMenuItemButton.Paint;
var
  P: TPoint;
begin
  P := Point(Bounds.Left, Bounds.Top);
  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;
var
  OutputText: string;
  P: TPoint;
begin
  P := Point(Bounds.Left, Bounds.Top);
  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 }

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

constructor TMenuItem.Create;
begin
  Enabled := True;
  TextSize := 40;
  TextColor := clWhite;
  TextDisabledColor := clSilver;
end;

{ TMenuItemComboBox }

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

destructor TMenuItemComboBox.Destroy;
begin
  FreeAndNil(States);
  inherited;
end;

procedure TMenuItemComboBox.Paint;
var
  P: TPoint;
begin
  P := Point(Bounds.Left, Bounds.Top);
  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
        TMenuItemButton(Items[I]).MouseUp(Position);
      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].TextSize;
      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].TextSize;
      if Items[I].Enabled then Font.Color := Items[I].TextColor
        else Font.Color := Items[I].TextDisabledColor;
      Items[I].Bounds.Left := X;
      Items[I].Bounds.Top := Y;
      Items[I].Canvas := Canvas;
      Items[I].Paint;
      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.