sbutton.pas

Alpha Controls 界面控件包

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

interface

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

type
{$IFDEF TNTUNICODE}
  TsButton = class(TTntButton)
{$ELSE}
  TsButton = class(TButton){$ENDIF}
{$IFNDEF NOTFORHELP}
  private
    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
    FRegion : hrgn;

    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;
    destructor Destroy; override;
    procedure AfterConstruction; override;
    procedure Loaded; override;
    procedure WndProc (var Message: TMessage); override;
    procedure CreateWnd; override;
  published
{$ENDIF} // NOTFORHELP
    {:@event}
    property OnMouseEnter : TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    {:@event}
    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, acUtils, sGraphUtils, sAlphaGraph,
  sBitBtn, sBorders, ActnList, sSkinManager;

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

{ TsButton }

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.AfterConstruction;
begin
  inherited;
  FCommonData.FCacheBmp.Canvas.Font.Assign(Font);
  FCommonData.Loaded;
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 Down 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;
  FAnimatEvents := [aeGlobalDef];
{$IFNDEF DELPHI7UP}
  FWordWrap := True;
{$ELSE}
  WordWrap := True;
{$ENDIF}
  RegionChanged := True;
end;

procedure TsButton.CreateWnd;
begin
  inherited;
end;

function TsButton.CurrentState: integer;
begin
  if Down and (SkinData.FMouseAbove or not (csLButtonDown in ControlState)) then Result := 2 else if ControlIsActive(FCommonData) or Active 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);
var
{$IFDEF TNTUNICODE}
  Text: WideString;
{$ELSE}
  Text: string;
{$ENDIF}
begin
  Text := Caption;
  Flags := DrawTextBiDiModeFlags(Flags);
  {$IFDEF TNTUNICODE}
  WriteTextExW(FCommonData.FCacheBMP.Canvas, PWideChar(Text), True, Rect, Flags,
              FCommonData, ControlIsActive(FCommonData) or Active or ((csDesigning in ComponentState) and Default) or FPressed);
  {$ELSE}
  WriteTextEx(FCommonData.FCacheBMP.Canvas, PChar(Text), True, Rect, Flags,
              FCommonData, ControlIsActive(FCommonData) or Active or ((csDesigning in ComponentState) and Default) or FPressed);
  {$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(True) and Enabled and not (csDesigning in ComponentState) then begin
    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;
        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 Assigned(FCommonData) and FCommonData.Skinned(True) and Enabled and not (csDesigning in ComponentState) 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;
        Repaint;
      end;

      FDown := False;
      if PtInRect(ClientRect, Point(x, y)) then Click;
      try
        if (Self <> nil) and not (csDestroying in ComponentState) then begin
          RegionChanged := True;
          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;
begin
  BeginPaint(Handle, PS);
  if aDC = 0 then DC := GetDC(Handle) else DC := aDC;
  SavedDC := SaveDC(DC);
  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);

      if (FCommonData.BGChanged) and (not FCommonData.UrgentPainting) then begin
        PrepareCache;
      end;
      if RegionChanged then begin
        UpdateCorners(FCommonData, CurrentState);
        if FCommonData.BorderIndex > 0 then begin
          // Top Left
          BitBlt(DC, 0, 0, FCommonData.SkinManager.MaskWidthLeft(FCommonData.BorderIndex), FCommonData.SkinManager.MaskWidthTop(FCommonData.BorderIndex), FCommonData.FCacheBmp.Canvas.Handle, 0, 0, SRCCOPY);
          // Bottom Left
          BitBlt(DC, 0, Height - FCommonData.SkinManager.MaskWidthBottom(FCommonData.BorderIndex), Width, FCommonData.SkinManager.MaskWidthTop(FCommonData.BorderIndex), FCommonData.FCacheBmp.Canvas.Handle, 0, Height - FCommonData.SkinManager.MaskWidthBottom(FCommonData.BorderIndex), SRCCOPY);
          // Bottom Right
          BitBlt(DC, Width - FCommonData.SkinManager.MaskWidthRight(FCommonData.BorderIndex), Height - FCommonData.SkinManager.MaskWidthBottom(FCommonData.BorderIndex), FCommonData.SkinManager.MaskWidthRight(FCommonData.BorderIndex), FCommonData.SkinManager.MaskWidthTop(FCommonData.BorderIndex), FCommonData.FCacheBmp.Canvas.Handle, Width - FCommonData.SkinManager.MaskWidthRight(FCommonData.BorderIndex), Height - FCommonData.SkinManager.MaskWidthBottom(FCommonData.BorderIndex), SRCCOPY);
          // Top Right