sbutton.pas

Alpha Controls.v5.46b Source

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

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, sCommonData, Buttons, sConst, sDefaults, sFade{$IFDEF LOGGED}, sDebugMsgs{$ENDIF}
  {$IFDEF TNTUNICODE}, TntStdCtrls {$ENDIF};

type
{$IFDEF TNTUNICODE}
  TsButton = class(TTntButton)
{$ELSE}
  TsButton = class(TButton)
{$ENDIF}
  private
{$IFNDEF NOTFORHELP}
    FCommonData: TsCommonData;
    FMouseClicked : boolean;
    FDown: boolean;
    RegionChanged : boolean;
    FFocusMargin: integer;
    FDisabledKind: TsDisabledKind;
    FOnMouseEnter: TNotifyEvent;
    FOnMouseLeave: TNotifyEvent;
    FadeTimer : TsFadeTimer;
    FPressed : boolean;
    FAnimatEvents: TacAnimatEvents;
{$IFNDEF DELPHI7UP}
    FWordWrap : boolean;
    procedure SetWordWrap(const Value: boolean);
{$ENDIF}
    procedure SetDown(const Value: boolean);
    procedure SetFocusMargin(const Value: integer);
    procedure SetDisabledKind(const Value: TsDisabledKind);
    procedure WMKeyUp (var Message: TWMKey); message WM_KEYUP;
    function GetDown: boolean;
  protected
    IsFocused : boolean;
    FRegion : hrgn;

    procedure SetButtonStyle(ADefault: Boolean); override;
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
    procedure MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;

    procedure OurPaintHandler(aDC : hdc);
    procedure DoDrawText(var Rect: TRect; Flags: Longint); dynamic;
    procedure DrawCaption; dynamic;
    function CaptionRect : TRect; dynamic;
    function TextRectSize : TSize;
    function CurrentState : integer;

    procedure PrepareCache;
  public
    Active: Boolean;
    constructor Create(AOwner:TComponent); override;

    procedure CreateParams(var Params: TCreateParams); override;

    destructor Destroy; override;
    procedure AfterConstruction; override;
    procedure Loaded; override;
    procedure WndProc (var Message: TMessage); override;
  published
{$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 SkinData : TsCommonData read FCommonData write FCommonData;
    property DisabledKind : TsDisabledKind read FDisabledKind write SetDisabledKind default DefDisabledKind;
    property Down : boolean read GetDown write SetDown default False;
    property FocusMargin : integer read FFocusMargin write SetFocusMargin default 1;
{$IFNDEF DELPHI7UP}
    property WordWrap : boolean read FWordWrap write SetWordWrap default True;
{$ELSE}
    property WordWrap default True;
{$ENDIF}
  end;

implementation

uses sVCLUtils, sMessages, acntUtils, sGraphUtils, sAlphaGraph, sBitBtn, sBorders, ActnList, sSkinManager, sStyleSimply;

{ TsButton }

function MaxCaptionWidth(Button : TsButton) : integer;
begin
  with Button do if (Caption <> '') then Result := Width - 2 else Result := 0
end;

procedure TsButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
  inherited ActionChange(Sender, CheckDefaults);
  if Sender is TCustomAction then Self.Enabled := TCustomAction(Sender).Enabled;
end;

procedure TsButton.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  if (SkinData <> nil) and (SkinData.SkinManager <> nil) and SkinData.SkinManager.Active
    then Params.Style := Params.Style or BS_OWNERDRAW;
end;

procedure TsButton.AfterConstruction;
begin
  inherited;
  FCommonData.FCacheBmp.Canvas.Font.Assign(Font);
  FCommonData.Loaded;
end;

procedure TsButton.SetButtonStyle(ADefault: Boolean);
begin
  inherited;
  if ADefault <> IsFocused then begin
    IsFocused := ADefault;
  end;
  SkinData.Invalidate
end;

function TsButton.CaptionRect: TRect;
var
  l, t, r, b : integer;
  Size : TSize;
begin
  Size := TextRectSize;
  l := (Width - Size.cx) div 2;
  t := (Height - Size.cy) div 2;
  b := Height - t;
  r := Width - l;
  Result := Rect(l - 1, t, r + 2, b);
  if CurrentState = 2{ and (SkinData.FMouseAbove or not (csLButtonDown in ControlState))} then OffsetRect(Result, 1, 1);
end;

constructor TsButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle - [csOpaque];
  FCommonData := TsCommonData.Create(Self, True);
  FCommonData.COC := COC_TsBUTTON;
  FDisabledKind := DefDisabledKind;
  FFocusMargin := 1;
  FadeTimer := nil;
  FDown := False;
  FRegion := 1;
  FAnimatEvents := [aeGlobalDef];
{$IFNDEF DELPHI7UP}
  FWordWrap := True;
{$ELSE}
  WordWrap := True;
{$ENDIF}
  RegionChanged := True;
end;

function TsButton.CurrentState: integer;
begin
  if ((SendMessage(Handle, BM_GETSTATE, 0, 0) and BST_PUSHED = BST_PUSHED) or fGlobalFlag) and (SkinData.FMouseAbove or not (csLButtonDown in ControlState))
    then Result := 2
    else if IsFocused or ((GetWindowLong(Handle, GWL_STYLE) and $000F) = BS_DEFPUSHBUTTON) or ControlIsActive(FCommonData) or ((csDesigning in ComponentState) and Default)
      then Result := 1
      else Result := 0
end;

destructor TsButton.Destroy;
begin
  StopFading(FadeTimer, FCommonData);
  if Assigned(FCommonData) then FreeAndNil(FCommonData);
  inherited Destroy;
end;

procedure TsButton.DoDrawText(var Rect: TRect; Flags: Integer);
begin
  Flags := DrawTextBiDiModeFlags(Flags);
{$IFDEF TNTUNICODE}
  WriteTextExW(FCommonData.FCacheBMP.Canvas, PWideChar(Caption), True, Rect, Flags,
              FCommonData, CurrentState <> 0);
{$ELSE}
  WriteTextEx(FCommonData.FCacheBMP.Canvas, PChar(Caption), True, Rect, Flags,
              FCommonData, CurrentState <> 0);
{$ENDIF}
end;

procedure TsButton.DrawCaption;
var
  R : TRect;
  DrawStyle: Longint;
begin
  FCommonData.FCacheBmp.Canvas.Font.Assign(Font);
  FCommonData.FCacheBMP.Canvas.Brush.Style := bsClear;
  R := CaptionRect;
  { Calculate vertical layout }

  DrawStyle := DT_EXPANDTABS or DT_CENTER;
  if WordWrap then DrawStyle := DrawStyle or DT_WORDBREAK;

  DoDrawText(R, DrawStyle);

  if Enabled and Focused and (Caption <> '') and FCommonData.SkinManager.gd[FCommonData.SkinIndex].ShowFocus then begin
    InflateRect(R, FocusMargin, FocusMargin);
    FocusRect(FCommonData.FCacheBMP.Canvas, R);
  end;
end;

function TsButton.GetDown: boolean;
begin
  Result := FDown or FPressed;
end;
 
procedure TsButton.Loaded;
begin
  inherited;
  FCommonData.FCacheBmp.Canvas.Font.Assign(Font);
  FCommonData.Loaded;
end;

procedure TsButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if FCommonData.Skinned and Enabled and not (csDesigning in ComponentState) then begin
    FCommonData.Updating := False;
    if (Button = mbLeft) and not ShowHintStored then begin
      AppShowHint := Application.ShowHint;
      Application.ShowHint := False;
      ShowHintStored := True;
    end;
    FMouseClicked := True;
    if (Button = mbLeft) then begin
      if not Down then begin
        FDown := True;
        RegionChanged := True;
        FCommonData.Updating := FCommonData.Updating;
        FCommonData.BGChanged := False;
        DoChangePaint(FadeTimer, FCommonData, True, EventEnabled(aeMouseDown, FAnimatEvents));
      end;
    end;
  end;
  inherited MouseDown(Button, Shift, X, Y);
end;

procedure TsButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if FCommonData.Skinned and Enabled and not (csDesigning in ComponentState) and FDown then begin
    if Button = mbLeft then begin
      Application.ShowHint := AppShowHint;
      ShowHintStored := False;
    end;

    if not FMouseClicked or (csDestroying in ComponentState) then Exit;
    FMouseClicked := False;
    if (Button = mbLeft) and Enabled then begin
      if (FadeTimer <> nil) and (FadeTimer.FadeLevel < FadeTimer.Iterations) then begin
        FadeTimer.Enabled := False;
        FCommonData.BGChanged := True;
        fGlobalFlag := True;
        Repaint;
        fGlobalFlag := False;
        Delay(30);
      end;
      FCommonData.Updating := False;
      FDown := False;
      try
        if (Self <> nil) and not (csDestroying in ComponentState) then begin
          RegionChanged := True;
          FCommonData.BGChanged := False;
          if Assigned(FCommonData) then DoChangePaint(FadeTimer, FCommonData, True, EventEnabled(aeMouseUp, FAnimatEvents), fdUp);
        end;
      except
      end;
    end;
  end;
  inherited MouseUp(Button, Shift, X, Y);
end;

procedure TsButton.OurPaintHandler;
var
  DC, SavedDC : hdc;
  PS : TPaintStruct;
  b : boolean;
begin
  BeginPaint(Handle, PS);
  try
    FCommonData.Updating := FCommonData.Updating;
    if not FCommonData.Updating and not (Assigned(FadeTimer) and FadeTimer.Enabled) then begin
      FCommonData.BGChanged := FCommonData.BGChanged or FCommonData.HalfVisible or GetBoolMsg(Parent, AC_GETHALFVISIBLE);
      FCommonData.HalfVisible := not RectInRect(Parent.ClientRect, BoundsRect);








      b := (FRegion = 1) or aSkinChanging;