lazarus/lcl/include/bitbtn.inc

{%MainUnit ../buttons.pp}

{
 *****************************************************************************
 *                                                                           *
 *  This file is part of the Lazarus Component Library (LCL)                 *
 *                                                                           *
 *  See the file COPYING.modifiedLGPL, 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.                     *
 *                                                                           *
 *****************************************************************************
}

{------------------------------------------------------------------------------
       TCustomBitBtn Constructor
------------------------------------------------------------------------------}
constructor TCustomBitBtn.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
  FCompStyle := csBitBtn;
  FKind := bkCustom;
  FLayout := blGlyphLeft;
  FSpacing := 3;
  fMargin:=-1;
  FButtonGlyph := TButtonGlyph.Create;
  FButtonGlyph.OnChange := @GlyphChanged;
  Align := alNone;
  RealizeKind;
end;

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

Procedure TCustomBitBtn.Click;
var
  Form : TCustomForm;
Begin
  if FKind = bkClose then Begin
    Form := GetParentForm(Self);
    if Form <> nil then begin
      Form.Close;
      exit;
    end;
  end;
  inherited Click;
End;

Function TCustomBitBtn.GetGlyph : TBitmap;
Begin
  Result := FButtonGlyph.Glyph;
end;

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

Function TCustomBitBtn.IsGlyphStored: Boolean;
begin
  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.GlyphChanged(Sender: TObject);
begin
  if HandleAllocated 
  then begin
    TWSBitBtnClass(WidgetSetClass).SetGlyph(Self, FButtonGlyph);
  end;
  InvalidatePreferredSize;
  AdjustSize;
end;

procedure TCustomBitBtn.ActionChange(Sender: TObject; CheckDefaults: Boolean);

  procedure CopyImage(ImageList: TCustomImageList; Index: Integer);
  var
    CurGlyph: TBitmap;
  begin
    CurGlyph:=Glyph;
    with CurGlyph do begin
      // ToDo: transparency
      Width := ImageList.Width;
      Height := ImageList.Height;
      Canvas.Brush.Color := clMaroon; // whatever
      Canvas.FillRect(Rect(0,0,Width, Height));
      ImageList.Draw(Canvas,0,0,Index,true);
    end;
  end;

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
        CopyImage(ActionList.Images,ImageIndex);
    end;
  end;
end;

procedure TCustomBitBtn.SetKind(AValue: TBitBtnKind);
Begin
  if FKind = AValue then Exit;
  FKind := AValue;
  if FKind = bkCustom then Exit;
  
  RealizeKind;
end;

procedure TCustomBitBtn.SetLayout(AValue: TButtonLayout);
Begin
  if FLayout = AValue then Exit;
  FLayout := AValue;
  if HandleAllocated 
  then TWSBitBtnClass(WidgetSetClass).SetLayout(Self, FLayout);
  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;
end;

procedure TCustomBitBtn.SetNumGlyphs(AValue: Integer);
begin
  if AValue < 0 then AValue := 1;
  if AValue > 4 then AValue := 4;

  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;
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
      BitmapHandle := LoadStockPixmap(BitBtnImages[FKind], MaskHandle);
      if BitmapHandle <> 0 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(fKind);
    ModalResult := BitBtnModalResults[FKind];
    Default := FKind in [bkOk,bkYes];
    Cancel := FKind in [bkCancel,bkNo];
  end;
end;

{ Return the caption associated with the akind value.
  This function replaces BitBtnCaption const because the localizing
  dont work with an const array }
function TCustomBitBtn.GetCaptionOfKind(aKind: TBitBtnKind): String;
begin
  Result:='';
  case aKind of
    bkOK       : Result:=rsmbOK;
    bkCancel   : Result:=rsmbCancel;
    bkHelp     : Result:=rsmbHelp;
    bkYes      : Result:=rsmbYes;
    bkNo       : Result:=rsmbNo;
    bkClose    : Result:=rsmbClose;
    bkAbort    : Result:=rsmbAbort;
    bkRetry    : Result:=rsmbRetry;
    bkIgnore   : Result:=rsmbIgnore;
    bkAll      : Result:=rsmbAll;
    bkNoToAll  : Result:=rsmbNoToAll;
    bkYesToAll : Result:=rsmbYesToAll;
  end;
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;

procedure TCustomBitBtn.TextChanged;
begin
  inherited TextChanged;
  AdjustSize;
end;

class function TCustomBitBtn.GetControlClassDefaultSize: TPoint;
begin
  Result.X:=75;
  Result.Y:=30;
end;

// included by buttons.pp