lazarus/lcl/include/bitbtn.inc

{%MainUnit ../buttons.pp}

{
 *****************************************************************************
  This file is part of the Lazarus Component Library (LCL)

  See the file COPYING.modifiedLGPL.txt, included in this distribution,
  for details about the license.
 *****************************************************************************
}

{------------------------------------------------------------------------------
       TCustomBitBtn Constructor
------------------------------------------------------------------------------}
constructor TCustomBitBtn.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
  FCompStyle := csBitBtn;
  FDefaultCaption := False;
  FKind := bkCustom;
  FLayout := blGlyphLeft;
  FSpacing := 4;
  FMargin := -1;
  FButtonGlyph := TButtonGlyph.Create;
  FButtonGlyph.NumGlyphs := 1;
  FButtonGlyph.OnChange := @GlyphChanged;
  FButtonGlyph.IsDesigning := csDesigning in ComponentState;
  Align := alNone;
  RealizeKind;
end;

{------------------------------------------------------------------------------
       TCustomBitBtn destructor
------------------------------------------------------------------------------}
destructor TCustomBitBtn.Destroy;
begin
  FreeThenNil(FButtonGlyph);
  inherited Destroy;
end;

procedure TCustomBitBtn.Click;
var
  Form : TCustomForm;
begin
  { A TBitBtn with Kind = bkClose should
    - Close the ParentForm if ModalResult = mrNone.
      It should not set ParentForm.ModalResult in this case
    - Close a non-modal ParentForm if ModalResult in [mrNone, mrClose]
    - In all other cases it should behave like any other TBitBtn
  }
  if (FKind = bkClose) then
  begin
    Form := GetParentForm(Self);
    if (Form <> nil) then
    begin
      if (ModalResult = mrNone) or
         ((ModalResult = mrClose) and not (fsModal in Form.FormState)) then
      begin
        Form.Close;
        Exit;
      end;
    end;
  end;
  inherited Click;
end;

procedure TCustomBitBtn.LoadGlyphFromResourceName(Instance: THandle; const AName: String);
begin
  Buttons.LoadGlyphFromResourceName(FButtonGlyph, Instance, AName);
end;

procedure TCustomBitBtn.LoadGlyphFromLazarusResource(const AName: String);
begin
  Buttons.LoadGlyphFromLazarusResource(FButtonGlyph, AName);
end;

procedure TCustomBitBtn.LoadGlyphFromStock(idButton: Integer);
begin
  Buttons.LoadGlyphFromStock(FButtonGlyph, idButton);
end;

function TCustomBitBtn.CanShowGlyph: Boolean;
begin
  Result := not Glyph.Empty and (FButtonGlyph.Images <> nil);
end;

function TCustomBitBtn.GetGlyph : TBitmap;
begin
  Result := FButtonGlyph.Glyph;
end;

function TCustomBitBtn.GetGlyphShowMode: TGlyphShowMode;
begin
  Result := FButtonGlyph.ShowMode;
end;

function TCustomBitBtn.GetNumGlyphs: Integer;
begin
  Result := FButtonGlyph.FNumGlyphs;
end;

function TCustomBitBtn.IsGlyphStored: Boolean;
var
  act: TCustomAction;
begin
  if Action <> nil then
  begin
    result := true;
    act := TCustomAction(Action);
    if (act.ActionList <> nil) and (act.ActionList.Images <> nil) and
      (act.ImageIndex >= 0) and (act.ImageIndex < act.ActionList.Images.Count) then
        result := false;
  end 
  else Result := (Kind = bkCustom) and (FButtonGlyph.Glyph <> nil)
    and (not FButtonGlyph.Glyph.Empty)
      and (FButtonGlyph.Glyph.Width>0) and (FButtonGlyph.Glyph.Height>0);
end;

procedure TCustomBitBtn.SetGlyph(AValue: TBitmap);
begin
  FButtonGlyph.Glyph := AValue;
  InvalidatePreferredSize;
  AdjustSize;
end;

procedure TCustomBitBtn.SetGlyphShowMode(const AValue: TGlyphShowMode);
begin
  FButtonGlyph.ShowMode := AValue;
end;

procedure TCustomBitBtn.GlyphChanged(Sender: TObject);
begin
  if HandleAllocated then
    TWSBitBtnClass(WidgetSetClass).SetGlyph(Self, FButtonGlyph);
  InvalidatePreferredSize;
  AdjustSize;
end;

procedure TCustomBitBtn.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
  inherited ActionChange(Sender,CheckDefaults);
  if Sender is TCustomAction then
  begin
    with TCustomAction(Sender) do
    begin
      if (Glyph.Empty) and (ActionList <> nil) and (ActionList.Images <> nil) and
        (ImageIndex >= 0) and (ImageIndex < ActionList.Images.Count) then
        ActionList.Images.GetBitmap(ImageIndex, Glyph);
    end;
  end;
end;

procedure TCustomBitBtn.SetKind(AValue: TBitBtnKind);
begin
  if FKind = AValue then Exit;
  FKind := AValue;
  if FKind <> bkCustom then
    RealizeKind;
  if not (csLoading in ComponentState) then
    DefaultCaption := FKind <> bkCustom;
end;

procedure TCustomBitBtn.SetLayout(AValue: TButtonLayout);
begin
  if FLayout = AValue then Exit;
  FLayout := AValue;
  if HandleAllocated then
  begin
    TWSBitBtnClass(WidgetSetClass).SetLayout(Self, FLayout);
    InvalidatePreferredSize;
  end;
  AdjustSize;
end;

procedure TCustomBitBtn.SetMargin(const AValue: integer);
begin
  if FMargin = AValue then Exit;
  FMargin := AValue;
  if HandleAllocated  then
    TWSBitBtnClass(WidgetSetClass).SetMargin(Self, FMargin);
  AdjustSize;
  if csDesigning in ComponentState then
    Invalidate;
end;

procedure TCustomBitBtn.SetNumGlyphs(AValue: Integer);
begin
  if AValue < Low(TNumGlyphs) then AValue := Low(TNumGlyphs);
  if AValue > High(TNumGlyphs) then AValue := High(TNumGlyphs);

  if AValue <> FButtonGlyph.NumGlyphs then
  Begin
    FButtonGlyph.NumGlyphs := TNumGlyphs(AValue);
    Invalidate;
  end;
end;

procedure TCustomBitBtn.SetSpacing(AValue: Integer);
begin
  if (FSpacing = AValue) or (AValue < -1) then Exit;
  FSpacing := AValue;
  if HandleAllocated then
    TWSBitBtnClass(WidgetSetClass).SetSpacing(Self, FSpacing);
  AdjustSize;
  if csDesigning in ComponentState then
    Invalidate;
end;

procedure TCustomBitBtn.RealizeKind;
var
  GlyphValid, Handled: Boolean;
  CustomGlyph: TGraphic;
  BitmapHandle, MaskHandle: HBitmap;
begin
  if (Kind <> bkCustom) then
  begin
    GlyphValid := False;
    
    // first let the user override
    if GetDefaultBitBtnGlyph <> nil then
    begin
      Handled := False;
      CustomGlyph := GetDefaultBitBtnGlyph(Kind, Handled);
      if Handled then
      begin
        Glyph.Assign(CustomGlyph);
        CustomGlyph.Free;
        GlyphValid := True;
      end;
    end;

    // then ask the widgetset
    if not GlyphValid then 
    begin
      if ThemeServices.GetStockImage(BitBtnImages[Kind], BitmapHandle, MaskHandle) then
      begin
        Glyph.Handle := BitmapHandle;
        Glyph.MaskHandle := MaskHandle;
        GlyphValid := True;
      end;
    end;
    
    if not GlyphValid then
    begin
      CustomGlyph := GetLCLDefaultBtnGlyph(Kind);
      if CustomGlyph <> nil then
      begin
        Glyph.Assign(CustomGlyph);
        CustomGlyph.Free;
        GlyphValid := True;
      end;
    end;
  end;

  if not (csLoading in ComponentState) then
  begin
    Caption := GetCaptionOfKind(Kind);
    ModalResult := BitBtnModalResults[Kind];
    Default := Kind in [bkOk, bkYes];
    Cancel := Kind in [bkCancel, bkNo];
  end;
end;

{ Return the caption associated with the akind value.
  This function replaces BitBtnCaption const because the localizing
  do not work with an const array }
function TCustomBitBtn.GetCaptionOfKind(AKind: TBitBtnKind): String;
begin
  Result := GetButtonCaption(BitBtnImages[Kind]);
  if Result = '?' then
    Result := '';
end;

class procedure TCustomBitBtn.WSRegisterClass;
begin
  inherited WSRegisterClass;
  RegisterCustomBitBtn;
end;

procedure TCustomBitBtn.InitializeWnd;
begin
  inherited InitializeWnd;
  TWSBitBtnClass(WidgetSetClass).SetGlyph(Self, FButtonGlyph);
  TWSBitBtnClass(WidgetSetClass).SetLayout(Self, FLayout);
  TWSBitBtnClass(WidgetSetClass).SetMargin(Self, FMargin);  
  TWSBitBtnClass(WidgetSetClass).SetSpacing(Self, FSpacing);  
end;

function TCustomBitBtn.IsCaptionStored: Boolean;
begin
  Result := inherited IsCaptionStored and not DefaultCaption;
end;

procedure TCustomBitBtn.Loaded;
begin
  inherited Loaded;
  if (Kind <> bkCustom) and DefaultCaption and (Caption = '') then
  begin
    Caption := GetCaptionOfKind(Kind); // Will trigger TextChanged
    DefaultCaption := True;
  end;
end;

procedure TCustomBitBtn.TextChanged;
begin
  inherited TextChanged;
  AdjustSize;
  DefaultCaption := False;
end;

class function TCustomBitBtn.GetControlClassDefaultSize: TSize;
begin
  Result.CX := 75;
  Result.CY := 30;
end;

procedure TCustomBitBtn.CMAppShowBtnGlyphChanged(var Message: TLMessage);
begin
  if GlyphShowMode = gsmApplication then
    FButtonGlyph.Refresh;
end;

// included by buttons.pp