lazarus/buttonpanel.pas

{
 *****************************************************************************
 *                                                                           *
 *  This file is part of the Lazarus Component Library (LCL)                 *
 *                                                                           *
 *  See the file COPYING.modifiedLGPL.txt, included in this distribution,    *
 *  for details about the copyright.                                         *
 *                                                                           *
 *  This program is distributed in the hope that it will be useful,          *
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
 *                                                                           *
 *****************************************************************************
}
unit ButtonPanel;

{$mode objfpc}{$h+}

interface

uses
  Buttons, Classes, LCLProc, Controls, Dialogs, ExtCtrls, Forms, Graphics,
  GraphType, LCLType, SysUtils, LCLStrConsts;

type
  TButtonOrder  = (boDefault, boCloseCancelOK, boCloseOKCancel);
  TPanelButton  = (pbOK, pbCancel, pbClose, pbHelp);
  TPanelButtons = set of TPanelButton;

const
  DefShowButtons = [pbOK, pbCancel, pbClose, pbHelp];
  DefShowGlyphs = [pbOK, pbCancel, pbClose, pbHelp];

type
  TPanelBitBtn = class(TCustomBitBtn)
  public
    constructor Create(AOwner: TComponent); override;
  published
    // the translation of the IDE at designtime is used default item
    property Caption stored True;
    property Enabled;
    property Font;
    property Glyph;
    property OnClick;
  end;

  { TCustomButtonPanel }

  TCustomButtonPanel = class(TCustomPanel)
  private
    FShowBevel: Boolean;
    FShowButtons: TPanelButtons;
    FShowGlyphs: TPanelButtons;
    FBevel: TBevel;
    FGlyphs: array[TPanelButton] of TBitmap;
    FButtons: array[TPanelButton] of TPanelBitBtn;
    FButtonsWidth: Integer;
    FButtonsHeight: Integer;
    FButtonOrder: TButtonOrder;
    FDefaultButton: TPanelButton;
    FSpacing: TSpacingSize;
    procedure CreateButton(AButton: TPanelButton);
    procedure DoDefaultButton;
    procedure DoShowButtons;
    procedure DoShowGlyphs;
    procedure SetButtonOrder(Value: TButtonOrder);
    procedure SetDefaultButton(Value: TPanelButton);
    procedure SetShowBevel(AValue: Boolean);
    procedure SetShowButtons(Value: TPanelButtons);
    procedure SetShowGlyphs(Value: TPanelButtons);
    procedure SetSpacing(AValue: TSpacingSize);
    procedure UpdateBevel;
    procedure UpdateButtonOrder;
    procedure UpdateSizes;
  protected
    procedure CalculatePreferredSize(
                         var PreferredWidth, PreferredHeight: integer;
                         WithThemeSpace: Boolean); override;
    function CreateControlBorderSpacing: TControlBorderSpacing; override;
    function CustomAlignInsertBefore(AControl1, AControl2: TControl): Boolean; override;
    procedure CustomAlignPosition(AControl: TControl; var ANewLeft, ANewTop, ANewWidth,
                                  ANewHeight: Integer; var AlignRect: TRect;
                                  AlignInfo: TAlignInfo); override;
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure SetAlign(Value: TAlign); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    property Align default alBottom;
    property AutoSize default True;

    property OKButton: TPanelBitBtn read FButtons[pbOK] stored False;
    property HelpButton: TPanelBitBtn read FButtons[pbHelp] stored False;
    property CloseButton: TPanelBitBtn read FButtons[pbClose] stored False;
    property CancelButton: TPanelBitBtn read FButtons[pbCancel] stored False;
    property ButtonOrder: TButtonOrder read FButtonOrder write SetButtonOrder default boDefault;

    property DefaultButton: TPanelButton read FDefaultButton write SetDefaultButton default pbOK;
    property ShowButtons: TPanelButtons read FShowButtons write SetShowButtons default DefShowButtons;
    property ShowGlyphs: TPanelButtons read FShowGlyphs write SetShowGlyphs default DefShowGlyphs;
    property ShowBevel: Boolean read FShowBevel write SetShowBevel default True;
    property Spacing: TSpacingSize read FSpacing write SetSpacing default 6;
  published
  end;

  { TButtonPanel }

  TButtonPanel = class(TCustomButtonPanel)
  published
    property Align;
    property Anchors;
    property AutoSize;
    property BorderSpacing;
    property OKButton;
    property HelpButton;
    property CloseButton;
    property CancelButton;
    property ButtonOrder;
    property TabOrder;
    property DefaultButton;
    property Spacing;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnUTF8KeyPress;
    property ShowButtons;
    property ShowGlyphs;
    property ShowBevel;
    property Visible;
  end;

procedure Register;

implementation

const
  DEFAULT_BUTTONPANEL_BORDERSPACING: TControlBorderSpacingDefault = (
    Left:0; Top:0; Right:0; Bottom:0; Around:6;
  );
  DefMinWidth = 75;
  DefMinHeight = 25;

procedure Register;
begin
  RegisterComponents('Misc', [TButtonPanel]);
end;

constructor TPanelBitBtn.Create(AOwner: TComponent);
begin
  inherited;

  Include(FComponentStyle, csSubComponent);
end;

procedure TCustomButtonPanel.DoShowButtons;
var
  btn: TPanelButton;
begin
  for btn := Low(btn) to High(btn) do
  begin
    if FButtons[btn] = nil
    then CreateButton(btn);

    if btn in FShowButtons
    then begin
      FButtons[btn].Visible := True;
      FButtons[btn].Enabled := True;
    end
    else begin
      FButtons[btn].Visible := False;
      FButtons[btn].Enabled := False;
    end;
  end;

  UpdateButtonOrder;
end;

procedure TCustomButtonPanel.SetShowButtons(Value: TPanelButtons);
begin
  if FShowButtons = Value then
    Exit;

  FShowButtons := Value;

  DoShowButtons;
end;

procedure TCustomButtonPanel.DoShowGlyphs;
var
  btn: TPanelButton;
begin
  for btn := Low(btn) to High(btn) do
  begin
    if FButtons[btn] = nil then Continue;

    if btn in FShowGlyphs
    then begin
      FButtons[btn].Glyph.Assign(FGlyphs[btn]);
    end
    else begin
      FGlyphs[btn].Assign(FButtons[btn].Glyph);
      FButtons[btn].Glyph.Assign(nil);
    end;
  end;
end;

procedure TCustomButtonPanel.SetShowGlyphs(Value: TPanelButtons);
begin
  if FShowGlyphs = Value then Exit;
  FShowGlyphs := Value;
  DoShowGlyphs;
end;

procedure TCustomButtonPanel.SetSpacing(AValue: TSpacingSize);
begin
  if FSpacing = AValue then Exit;
  FSpacing := AValue;
  ReAlign;
end;

procedure TCustomButtonPanel.UpdateBevel;
begin
  if FBevel = nil then Exit;

  case Align of
    alTop:   FBevel.Shape := bsBottomLine;
    alLeft:  FBevel.Shape := bsRightLine;
    alRight: FBevel.Shape := bsLeftLine;
  else
    // default to bottom
    FBevel.Shape := bsTopLine;
  end;

  if Align in [alLeft, alRight]
  then FBevel.Width := 2
  else FBevel.Height := 2;
end;

procedure TCustomButtonPanel.UpdateSizes;
var
  btn: TPanelButton;
begin
  FButtonsHeight := 0;
  for btn := Low(btn) to High(btn) do
  begin
    if FButtons[btn] = nil then Continue;
    if FButtonsHeight > FButtons[btn].Height then Continue;
    FButtonsHeight := FButtons[btn].Height;
  end;

  if Align in [alLeft, alRight]
  then begin
    // give the same width in this case too
    FButtonsWidth := 0;
    for btn := Low(btn) to High(btn) do
    begin
      if FButtons[btn] = nil then Continue;
      if FButtonsWidth > FButtons[btn].Width then Continue;
      FButtonsWidth := FButtons[btn].Width;
    end;
  end;
end;

procedure TCustomButtonPanel.CalculatePreferredSize(var PreferredWidth,
  PreferredHeight: integer; WithThemeSpace: Boolean);
begin
  if HandleAllocated then
  begin
    UpdateSizes;
    if Align in [alTop, alBottom] then
    begin
      PreferredHeight := FButtonsHeight;
      if ShowBevel then
        inc(PreferredHeight, Spacing + FBevel.Height);
    end
    else
    if Align in [alLeft, alRight] then
    begin
      PreferredWidth := FButtonsWidth;
      if ShowBevel then
        inc(PreferredWidth, Spacing + FBevel.Width);
    end;
  end;
end;

procedure TCustomButtonPanel.UpdateButtonOrder;
const
  TabOrders: array[TButtonOrder, 0..3] of TPanelButton = (
    {$IFDEF UNIX}
    {boDefault      } (pbOK, pbCancel, pbClose, pbHelp),
    {$ELSE}
    {boDefault      } (pbCancel, pbOK, pbClose, pbHelp),
    {$ENDIF}
    {boCloseCancelOK} (pbOK, pbCancel, pbClose, pbHelp),
    {boCloseOKCancel} (pbCancel, pbOK, pbClose, pbHelp)
  );
var
  i: Integer;
begin
  //set taborder
  for i := Low(TabOrders[FButtonOrder]) to High(TabOrders[FButtonOrder]) do
  begin
    if FButtons[TabOrders[FButtonOrder, i]] = nil then Continue;
    FButtons[TabOrders[FButtonOrder, i]].TabOrder := High(TabOrders[FButtonOrder]) - i;
  end;
  Realign;
end;

procedure TCustomButtonPanel.SetAlign(Value: TAlign);
begin
  inherited SetAlign(Value);
  UpdateBevel;
  UpdateSizes;
  Realign;
end;

procedure TCustomButtonPanel.SetButtonOrder(Value: TButtonOrder);
begin
  if FButtonOrder = Value then Exit;
  FButtonOrder := Value;
  UpdateButtonOrder;
end;

procedure TCustomButtonPanel.DoDefaultButton;
var
  btn: TPanelButton;
begin
  for btn := Low(btn) to High(btn) do
  begin
    if FButtons[btn] = nil then Continue;
    FButtons[btn].Default := FDefaultButton = btn;
  end;
end;

procedure TCustomButtonPanel.SetDefaultButton(Value: TPanelButton);
begin
  if FDefaultButton = Value then
    Exit;

  FDefaultButton := Value;

  DoDefaultButton;
end;

procedure TCustomButtonPanel.SetShowBevel(AValue: Boolean);
begin
  if FShowBevel = AValue then exit;
  FShowBevel := AValue;

  if not FShowBevel
  then begin
    FreeAndNil(FBevel);
    Exit;
  end;

  FBevel := TBevel.Create(Self);
  FBevel.Parent := Self;
  FBevel.Name   := 'Bevel';
  FBevel.Align := alCustom;

  UpdateBevel;
end;

procedure TCustomButtonPanel.Loaded;
begin
  inherited Loaded;

  Realign;
end;

procedure TCustomButtonPanel.Notification(AComponent: TComponent;
  Operation: TOperation);
var
  btn: TPanelButton;
begin
  if Operation=opRemove
  then begin
    for btn := Low(btn) to High(btn) do
    begin
      if FButtons[btn] <> AComponent then Continue;
      FButtons[btn] := nil;
      Exclude(FShowButtons, btn);
    end;
  end;
  inherited Notification(AComponent, Operation);
  UpdateSizes;
end;

constructor TCustomButtonPanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  ControlStyle := ControlStyle + [csOwnedChildsSelectable];

  Align      := alBottom;
  BevelInner := bvNone;
  BevelOuter := bvNone;
  Caption    := '';
  ControlStyle := ControlStyle - [csSetCaption];
  AutoSize   := True;
  FSpacing := 6;
  ShowBevel := True;


  FDefaultButton := pbOK;
  FButtonOrder   := boDefault;
  FShowButtons   := DefShowButtons;
  FShowGlyphs    := DefShowGlyphs;

  // create the buttons
  DoShowButtons;
end;

procedure TCustomButtonPanel.CreateButton(AButton: TPanelButton);
const
  NAMES: array[TPanelButton] of String = (
    'OKButton', 'CancelButton', 'CloseButton', 'HelpButton'
  );
  KINDS: array[TPanelButton] of TBitBtnKind = (
    bkOK, bkCancel, bkClose, bkHelp
  );

  function GetCaption(Btn: TPanelButton): string;
  begin
    case Btn of
      pbOK: Result:=rsMbOK;
      pbCancel: Result:=rsMbCancel;
      pbClose: Result:=rsMbClose;
      pbHelp: Result:=rsMbHelp;
    else
      Result:='?';
    end;
  end;

begin
  if FButtons[AButton] <> nil then Exit;

  FButtons[AButton] := TPanelBitBtn.Create(Self);
  with FButtons[AButton] do
  begin
    Name     := NAMES[AButton];
    Parent   := Self;
    Kind     := KINDS[AButton];
    AutoSize := True;
    Constraints.MinWidth := DefMinWidth;
    Constraints.MinHeight := DefMinHeight;
    Caption  := GetCaption(AButton);
    TabOrder := Ord(AButton); //initial order
    Align    := alCustom;
    if FGlyphs[AButton] = nil
    then begin
      // first time
      FGlyphs[AButton] := TBitmap.Create;
      FGlyphs[AButton].Assign(Glyph);
    end;
    // (re)set the glyph if needed
    if (AButton in FShowGlyphs)
    then Glyph.Assign(FGlyphs[AButton])
    else Glyph.Assign(nil);
    // set default
    if AButton = FDefaultButton
    then Default := True;
  end;
end;

function TCustomButtonPanel.CreateControlBorderSpacing: TControlBorderSpacing;
begin
  Result := TControlBorderSpacing.Create(Self, @DEFAULT_BUTTONPANEL_BORDERSPACING);
end;

function TCustomButtonPanel.CustomAlignInsertBefore(AControl1, AControl2: TControl): Boolean;
begin
  if AControl1 = FBevel then Exit(True);
  if AControl2 = FBevel then Exit(False);

  Result := TWincontrol(AControl2).TabOrder > TWincontrol(AControl1).TabOrder;
end;

procedure TCustomButtonPanel.CustomAlignPosition(AControl: TControl; var ANewLeft, ANewTop,
  ANewWidth, ANewHeight: Integer; var AlignRect: TRect; AlignInfo: TAlignInfo);
var
  Prev: TControl;
begin
  if AControl = FBevel
  then begin
    case Align of
      alTop: begin
        ANewTop := AlignRect.Top + FSpacing + FButtonsHeight;
        ANewLeft := AlignRect.Left;
        ANewWidth := AlignRect.Right - AlignRect.Left;
      end;
      alLeft: begin
        ANewTop := AlignRect.Top;
        ANewLeft := AlignRect.Left + FSpacing + FButtonsWidth;
        ANewHeight := AlignRect.Bottom - AlignRect.Top;
      end;
      alRight: begin
        ANewTop := AlignRect.Top;
        ANewLeft := AlignRect.Right - ANewWidth - FSpacing - FButtonsWidth;
        ANewHeight := AlignRect.Bottom - AlignRect.Top;
      end;
    else
      // bottom, none and custom
      ANewTop := AlignRect.Bottom - ANewHeight - FSpacing - FButtonsHeight;
      ANewLeft := AlignRect.Left;
      ANewWidth := AlignRect.Right - AlignRect.Left;
    end;

    Exit;
  end;

  if (csDesigning in ComponentState) and not AControl.Visible
  then begin
    // when designing, hide doesn't work, so position button outside panel
    ANewLeft := -ANewWidth - 100;
    Exit;
  end;

  // make all buttons the same height
  ANewHeight := FButtonsHeight;
  if Align in [alLeft, alRight]
  then begin
    ANewWidth := FButtonsWidth;

    if AControl = FButtons[pbHelp]
    then begin
      ANewTop := AlignRect.Bottom - ANewHeight;
    end
    else if AlignInfo.ControlIndex = 0
    then begin
      ANewTop := AlignRect.Top;
    end
    else begin
      Prev := TControl(AlignInfo.AlignList[AlignInfo.ControlIndex - 1]);
      ANewTop := Prev.Top + Prev.Height + FSpacing;
    end;
    if Align = alLeft
    then ANewLeft := AlignRect.Left
    else ANewLeft := AlignRect.Right - ANewWidth;
  end
  else begin
    if AControl = FButtons[pbHelp]
    then begin
      ANewLeft := 0
    end
    else if AlignInfo.ControlIndex = 0
    then begin
      ANewLeft := AlignRect.Right - ANewWidth;
    end
    else begin
      Prev := TControl(AlignInfo.AlignList[AlignInfo.ControlIndex - 1]);
      ANewLeft := Prev.Left - ANewWidth - FSpacing;
    end;
    if Align = alTop
    then ANewTop := AlignRect.Top
    else ANewTop := AlignRect.Bottom - ANewHeight;
  end;
end;

destructor TCustomButtonPanel.Destroy;
var
  btn: TPanelButton;
begin
  for btn := Low(btn) to High(btn) do
    FreeAndNil(FGlyphs[btn]);
  inherited Destroy;
end;

end.