sspeedbutton.pas

Alpha Controls.v5.46b Source

unit sSpeedButton;
{$I sDefs.inc}
{.$DEFINE LOGGED}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Imglist,
  Buttons, sCommonData, sConst, sDefaults, sFade, comctrls, menus
  {$IFDEF TNTUNICODE}, TntButtons{$ENDIF};

type

{$IFDEF TNTUNICODE}
  TsSpeedButton = class(TTntSpeedButton)
{$ELSE}
  TsSpeedButton = class(TSpeedButton)
{$ENDIF}
  private
{$IFNDEF NOTFORHELP}
    FOldNumGlyphs : integer;
    FOldSpacing : integer;

    FStoredDown : boolean;
    FCommonData: TsCommonData;
    FDisabledKind: TsDisabledKind;
    FOnMouseEnter: TNotifyEvent;
    FOnMouseLeave: TNotifyEvent;
    FadeTimer : TsAnimTimer;
    FDisabledGlyphKind: TsDisabledGlyphKind;
    FGrayed: boolean;
    FBlend: integer;
    FOffset: Integer;
    FImageIndex: integer;
    FImages: TCustomImageList;
    FShowCaption: boolean;
    FAlignment: TAlignment;
    FTextLayout : integer;
    FButtonStyle: TToolButtonStyle;
    FDropdownMenu: TPopupMenu;
    FDrawOverBorder: boolean;
    FOnPaint: TBmpPaintEvent;
    FTextAlignment: TAlignment;
    FAnimatEvents: TacAnimatEvents;

    procedure SetDisabledKind(const Value: TsDisabledKind);
    procedure SetDisabledGlyphKind(const Value: TsDisabledGlyphKind);
    procedure SetBlend(const Value: integer);
    procedure SetGrayed(const Value: boolean);
    procedure SetOffset(const Value: Integer);
    procedure SetImageIndex(const Value: integer);
    procedure SetImages(const Value: TCustomImageList);
    procedure SetShowCaption(const Value: boolean);
    procedure SetAlignment(const Value: TAlignment);
    procedure SetButtonStyle(const Value: TToolButtonStyle);
    procedure SetDropdownMenu(const Value: TPopupMenu);
    procedure SetDrawOverBorder(const Value: boolean);
    procedure SetTextAlignment(const Value: TAlignment);
  protected
    DroppedDown : boolean;
    OldOnChange: TNotifyEvent;
    OldLayout : TButtonLayout;
    OldCaption : acString;
    procedure SetFakeCaption;

    function ArrowWidth : integer;
    procedure DoDrawText(var Rect: TRect; Flags: Longint); virtual;
    procedure DrawCaption; virtual;
    function TextRectSize : TSize; virtual;
    procedure DrawGlyph; virtual;
    function GlyphWidth : integer; virtual;
    function GlyphHeight : integer; virtual;
    function GenMargin : integer;
    procedure UpdateGlyph; virtual;

    procedure PrepareCache; virtual;

    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
    procedure Ac_CMMouseEnter(var Message : TMessage);
    procedure Ac_CMMouseLeave(var Message : TMessage);
    procedure Paint; override;
    procedure GraphRepaint;
    procedure GlyphChanged(Sender: TObject);
    procedure MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    function CurrentState : integer; virtual;
    function CaptionRect : TRect; virtual;
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    procedure AfterConstruction; override;
    function ImgRect : TRect; virtual;
    procedure Invalidate; override;
    procedure Loaded; override;
    procedure WndProc (var Message: TMessage); override;
{$ENDIF} // NOTFORHELP
  published
{$IFNDEF NOTFORHELP}
    property Align;
    property OnPaint : TBmpPaintEvent read FOnPaint write FOnPaint;
{$ENDIF} // NOTFORHELP
    property OnMouseEnter : TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseLeave : TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
    property AnimatEvents : TacAnimatEvents read FAnimatEvents write FAnimatEvents default [aeGlobalDef];
    property Alignment : TAlignment read FAlignment write SetAlignment default taCenter;
    property Blend : integer read FBlend write SetBlend default 0;
    property ButtonStyle : TToolButtonStyle read FButtonStyle write SetButtonStyle default tbsButton;
    property SkinData : TsCommonData read FCommonData write FCommonData;
    property DisabledGlyphKind : TsDisabledGlyphKind read FDisabledGlyphKind write SetDisabledGlyphKind default DefDisabledGlyphKind;
    property DisabledKind : TsDisabledKind read FDisabledKind write SetDisabledKind default DefDisabledKind;
    property DropdownMenu: TPopupMenu read FDropdownMenu write SetDropdownMenu;
    property Grayed : boolean read FGrayed write SetGrayed default False;
    property ImageIndex : integer read FImageIndex write SetImageIndex default -1;
    property Images : TCustomImageList read FImages write SetImages;
    property ShowCaption: boolean read FShowCaption write SetShowCaption default True;
    property DrawOverBorder : boolean read FDrawOverBorder write SetDrawOverBorder default True;
    property TextOffset : Integer read FOffset write SetOffset default 0; // KJS
    property TextAlignment : TAlignment read FTextAlignment write SetTextAlignment default taCenter;
  end;

{$IFNDEF NOTFORHELP}
  TsTimerSpeedButton = class(TsSpeedButton)
  private
    FAllowTimer: boolean;
  public
    constructor Create (AOwner: TComponent); override;
  published
    property AllowTimer: boolean read FAllowTimer write FAllowTimer default True;
  end;
{$ENDIF} // NOTFORHELP

implementation

uses sGraphUtils, sVCLUtils, sMessages, acntUtils, sMAskData, sAlphaGraph, sStyleSimply, sSkinProps,
  sBitBtn, sThirdParty{$IFDEF LOGGED}, sDebugMsgs{$ENDIF}, ActnList, sSkinManager, sBorders;//, MainUnit{!!!};

const AddedWidth = 16;

var
  MenuVisible : boolean = False;

procedure StartFade(Button : TsSpeedButton; Clicked : boolean = False);
var
  i : integer;
begin
  with Button do if not (csDesigning in ComponentState) then begin
    if FadeTimer <> nil then begin
      i := FadeTimer.Iterations - FadeTimer.FadeLevel;
      FreeAndNil(FadeTimer);
    end
    else i := 1;
    if FCommonData.SkinManager.gd[FCommonData.SkinIndex].FadingEnabled and not FadingForbidden then begin
      if FadeTimer = nil then begin
        FadeTimer := TsAnimTimer.Create(nil);
        FadeTimer.Enabled := False;
        FadeTimer.OwnerData := FCommonData;
        if Clicked then FadeTimer.Iterations := FadeTimer.Iterations div 2;
        FadeTimer.FadeLevel := i;
        FadeTimer.BmpFrom.Assign(FCommonData.FCacheBmp);
      end;
      PrepareCache;
      UpdateCorners(FCommonData, 1);
      FadeTimer.Enabled := True;
      FadeTimer.DoFade;
    end;
  end;
end;

procedure StopFading(Button : TsSpeedButton);
begin
  with Button do if not (csDestroying in ComponentState) and not (csDesigning in ComponentState) then begin
    if (FadeTimer <> nil) and not (csDestroying in FadeTimer.ComponentState) then begin
      FadeTimer.Enabled := False;
      if FadeTimer.FadeLevel <> 0 then begin
        FCommonData.BGChanged := True;
        GraphRepaint
      end;
    end;
  end;
  if Assigned(Button.FadeTimer)
    then FreeAndNil(Button.FadeTimer);
end;

procedure DoChangePaint(Button : TsSpeedButton; Clicked : boolean; AllowAnimation : boolean; Direction : TFadeDirection = fdUp);
begin
  try
  if AllowAnimation and not aSkinchanging and Button.FCommonData.Skinned and Button.FCommonData.SkinManager.gd[Button.FCommonData.SkinIndex].FadingEnabled and
       not FadingForbidden and not Button.FCommonData.BGChanged then begin
      Button.FCommonData.BGChanged := True;
      StartFade(Button, Clicked)
    end
    else begin
      Button.FCommonData.BGChanged := True;
      if (Button.FadeTimer <> nil) and (Button.FadeTimer.Enabled) then StopFading(Button);
      Button.GraphRepaint;
    end;
  except
  end;
end;

{ TsSpeedButton }

function MaxCaptionWidth(Button : TsSpeedButton) : integer;
begin
  with Button do begin
    if ShowCaption and (Caption <> '') then Result := Width - ArrowWidth - 2 * Margin - (Spacing + GlyphWidth) * integer(GlyphWidth <> 0) else Result := 0
  end;
end;

function TsSpeedButton.ArrowWidth: integer;
begin
  Result := AddedWidth * integer(ButtonStyle = tbsDropDown);
end;

procedure TsSpeedButton.AfterConstruction;
begin
  inherited;
  FCommonData.Loaded;
  if FCommonData.Skinned then ControlStyle := ControlStyle + [csOpaque]; 
end;

function TsSpeedButton.CaptionRect: TRect;
var
  l, t, r, b : integer;
  dh, dw : integer;
  Size : TSize;
begin
  l := 0; t := 0; r := 0; b := 0;
  Size := TextRectSize;
  case Layout of
    blGlyphLeft : begin
      dw := (Width - ArrowWidth - GlyphWidth - Spacing * integer((GlyphWidth > 0) and (Caption <> '')) - Size.cx) div 2 - GenMargin;
      t := (Height - Size.cy) div 2;
      b := Height - t;
      case Alignment of
        taLeftJustify : begin
          l := Margin + GlyphWidth + Spacing * integer(GlyphWidth > 0);
          r := Width - ArrowWidth - GenMargin - dw * 2;
        end;
        taCenter : begin
          l := GenMargin + dw + GlyphWidth + Spacing * integer(GlyphWidth > 0);
          r := Width - ArrowWidth - GenMargin - dw;
        end;
        taRightJustify : begin
          l := GenMargin + 2 * dw + GlyphWidth + Spacing * integer(GlyphWidth > 0);
          r := Width - ArrowWidth - GenMargin;
        end;
      end;
      FTextLayout := DT_LEFT;
    end;
    blGlyphRight : begin
      dw := (Width - ArrowWidth - GlyphWidth - Spacing * integer((GlyphWidth > 0) and (Caption <> '')) - Size.cx) div 2 - GenMargin;
      t := (Height - Size.cy) div 2;
      b := Height - t;
      case Alignment of
        taLeftJustify : begin
          l := GenMargin;
          r := GenMargin + Size.cx
        end;
        taCenter : begin
          l := GenMargin + dw;
          r := GenMargin + dw + Size.cx
        end;
        taRightJustify : begin
          l := GenMargin + 2 * dw;
          r := GenMargin + 2 * dw + Size.cx
        end;
      end;
      FTextLayout := DT_RIGHT;
    end;
    blGlyphTop : begin
      dh := (Height - GlyphHeight - Spacing * integer((GlyphHeight > 0) and (Caption <> '')) - Size.cy) div 2 - GenMargin;
      l := (Width - Size.cx - ArrowWidth) div 2;
      t := (GenMargin + dh + GlyphHeight + Spacing * integer((GlyphHeight > 0) and (Caption <> '')));
      r := Width - (Width - Size.cx - ArrowWidth) div 2 - ArrowWidth;
      b := Height - dh - GenMargin;
      FTextLayout := DT_CENTER;
    end;
    blGlyphBottom : begin
      dh := (Height - GlyphHeight - Spacing * integer((GlyphHeight > 0) and (Caption <> '')) - Size.cy) div 2 - GenMargin;
      l := (Width - Size.cx - ArrowWidth) div 2;
      t := GenMargin + dh;
      r := Width - (Width - Size.cx - ArrowWidth) div 2 - ArrowWidth;
      b := Height - dh - GenMargin - GlyphHeight - Spacing * integer((GlyphHeight > 0) and (Caption <> ''));
      FTextLayout := DT_CENTER;
    end;
  end;
  Result := Rect(l - 1 + FOffset, t, r + 2 + FOffset, b);
  if CurrentState = 2 then {FState in [bsDown, bsExclusive]then} OffsetRect(Result, 1, 1);
end;

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

  FCommonData := TsCommonData.Create(Self, True);
  FCommonData.COC := COC_TsSPEEDBUTTON;
  FadeTimer := nil;

  FButtonStyle := tbsButton;
  FImageIndex := -1;
  FGrayed := False;
  FBlend := 0;
  FDisabledGlyphKind := DefDisabledGlyphKind;
  FDisabledKind := DefDisabledKind;
  FOffset := 0;                                // KJS
  FAlignment := taCenter;
  FShowCaption := True;
  FDrawOverBorder := True;
  FTextAlignment := taCenter;
  OldOnChange := Glyph.OnChange;
  Glyph.OnChange := GlyphChanged;
  FAnimatEvents := [aeGlobalDef];
end;

function TsSpeedButton.CurrentState: integer;
begin
  if FState in [bsDown, bsExclusive] then Result := 2 else if ControlIsActive(FCommonData) then Result := 1 else Result := 0
end;

destructor TsSpeedButton.Destroy;
begin
  StopFading(Self);