sbitbtn.pas

Alpha Controls 界面控件包

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

interface

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

type
{$IFDEF TNTUNICODE}
  TsBitBtn = class(TTntBitBtn)
{$ELSE}
  TsBitBtn = class(TBitBtn)
{$ENDIF}
{$IFNDEF NOTFORHELP}
  private
    FOldSpacing : integer;
    FCommonData: TsCommonData;
    FMouseClicked : boolean;
    FDown: boolean;
    RegionChanged : boolean;
    FFocusMargin: integer;
    FDisabledKind: TsDisabledKind;
    FOnMouseEnter: TNotifyEvent;
    FOnMouseLeave: TNotifyEvent;
    FadeTimer : TsFadeTimer;
    FDisabledGlyphKind: TsDisabledGlyphKind;
    FGrayed: boolean;
    FBlend: integer;
    FOffset: Integer;
    FImageIndex: integer;
    FImages: TCustomImageList;
    FShowCaption: boolean;
    FShowFocus: boolean;
    FAlignment: TAlignment;
    FPressed : boolean;
    FDrawOverBorder: boolean;
    FOnPaint: TBmpPaintEvent;
    FTextAlignment: TAlignment;
    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;
    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 SetShowFocus(const Value: boolean);
    procedure SetAlignment(const Value: TAlignment);
    procedure CMFocusChanged(var Message: TCMFocusChanged); message CM_FOCUSCHANGED;
    function GetDown: boolean;
    procedure SetDrawOverBorder(const Value: boolean);
    procedure SetTextAlignment(const Value: TAlignment);
  protected
    FRegion : hrgn;
    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;
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;

    procedure OurPaintHandler(aDC : hdc);
    procedure DoDrawText(const Rect: TRect; Flags: Cardinal);
    procedure DrawCaption;
    function CaptionRect : TRect;
    function TextRectSize : TSize;
    function CurrentState : integer; virtual;
    function GlyphWidth : integer;
    function GlyphHeight : integer;
    function GenMargin : integer;
    procedure PrepareCache;
  public
    Active: Boolean;
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    procedure AfterConstruction; override;
    procedure Loaded; override;
    function ImgRect : TRect;
    procedure WndProc (var Message: TMessage); override;
  published
    property OnPaint : TBmpPaintEvent read FOnPaint write FOnPaint;
{$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 Alignment : TAlignment read FAlignment write SetAlignment default taCenter;
    property Blend : integer read FBlend write SetBlend default 0;
    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 Down : boolean read GetDown write SetDown default False;
    property FocusMargin : integer read FFocusMargin write SetFocusMargin default 1;
    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 ShowFocus : boolean read FShowFocus write SetShowFocus 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;
{$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,
  sBorders, ActnList, sButton, sThirdParty, sSkinManager;

{ TsBitBtn }

function MaxCaptionWidth(Button : TsBitBtn) : integer;
begin
  with Button do begin
    if ShowCaption and (Caption <> '') then begin
      Result := Width - 2 * Margin;
      case Layout of
        blGlyphLeft, blGlyphRight : Result := Result - (Spacing + GlyphWidth) * integer(GlyphWidth <> 0);
      end;
    end
    else Result := 0
  end;
end;

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

function TsBitBtn.CaptionRect: TRect;
var
  GlyphPos: TPoint;
begin
  CalcButtonLayout(ClientRect, Point(GlyphWidth, GlyphHeight), TextRectSize,
                   Layout, Alignment, Margin, Spacing, GlyphPos, Result, DrawTextBiDiModeFlags(0));
end;

procedure TsBitBtn.CMFocusChanged(var Message: TCMFocusChanged);
begin
  if FCommonData.Skinned and Default and not (csDestroying in ComponentState) then with Message do begin
    if (Sender is TsButton) or (Sender is TsBitBtn) then begin
      if Active <> (Sender = Self) then begin
        Active := Sender = Self;
        FCommonData.Invalidate;
      end;
    end
    else if Active <> Default then begin
      Active := Default;
      FCommonData.Invalidate;
    end;
  end;
  inherited;
  if (csDesigning in ComponentState) and not (csDestroying in ComponentState) then begin
    Active := False;
    FCommonData.Invalidate;
  end;
end;

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

  ControlStyle := ControlStyle - [csOpaque];
  FCommonData := TsCommonData.Create(Self, True);
  FCommonData.COC := COC_TsBitBtn;
  FFocusMargin := 1;
  FadeTimer := nil;

  FImageIndex := -1;
  FGrayed := False;
  FBlend := 0;
  FDisabledGlyphKind := DefDisabledGlyphKind;
  FDisabledKind := DefDisabledKind;
  FDrawOverBorder := True;
  FOffset := 0;                                // KJS
  FAlignment := taCenter;
  FShowCaption := True;
  FTextAlignment := taCenter;
  FShowFocus := True;
  FAnimatEvents := [aeGlobalDef];
{$IFNDEF DELPHI7UP}
  FWordWrap := True;
{$ELSE}
  WordWrap := True;
{$ENDIF}
end;

function TsBitBtn.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 TsBitBtn.Destroy;
begin
  StopFading(FadeTimer, FCommonData);
  if Assigned(FCommonData) then FreeAndNil(FCommonData);
  inherited Destroy;
end;

procedure TsBitBtn.DoDrawText(const Rect: TRect; Flags: Cardinal);
var
  R : TRect;
{.$IFDEF TNTUNICODE
  Text: WideString;
$ELSE
  Text: string;
$ENDIF}
begin
  Flags := DrawTextBiDiModeFlags(Flags);
  R := Rect;

  {$IFDEF TNTUNICODE}
  WriteTextExW(FCommonData.FCacheBMP.Canvas, PWideChar(Caption), True, R, Flags,
              FCommonData, ControlIsActive(FCommonData) or Active or ((csDesigning in ComponentState) and Default) or FPressed);
  {$ELSE}
  WriteTextEx(FCommonData.FCacheBMP.Canvas, PChar(Caption), True, R, Flags,
              FCommonData, ControlIsActive(FCommonData) or Active or ((csDesigning in ComponentState) and Default) or FPressed);
  {$ENDIF}
end;

procedure TsBitBtn.DrawCaption;
var
  R : TRect;
  DrawStyle : Cardinal;
begin
  FCommonData.FCacheBmp.Canvas.Font.Assign(Font);
  FCommonData.FCacheBMP.Canvas.Brush.Style := bsClear;
  R := CaptionRect;
  if CurrentState = 2 then OffsetRect(R, 1, 1);
  DrawStyle := DT_EXPANDTABS or GetStringFlags(Self, FTextAlignment);
  if WordWrap then DrawStyle := DrawStyle or DT_WORDBREAK;
  DoDrawText(R, DrawStyle);

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

function TsBitBtn.GenMargin: integer;
begin
  if Margin < 0 then Result := 0 else Result := Margin + 3;
end;

function TsBitBtn.GetDown: boolean;
begin
  Result := FDown or FPressed;
end;

function TsBitBtn.GlyphHeight: integer;
begin
  if (Glyph <> nil) and (Glyph.Height > 0) then begin
    Result := Glyph.Height;
  end
  else if (Images <> nil) and (ImageIndex > -1) then Result := Images.Height else Result := 0;
end;

function TsBitBtn.GlyphWidth: integer;
begin
  if (Glyph <> nil) and (Glyph.Width > 0) then begin
    Result := Glyph.Width div NumGlyphs;
  end
  else if (Images <> nil) and (ImageIndex > -1) then Result := Images.Width else Result := 0;
end;

function TsBitBtn.ImgRect: TRect;
var
  x, y : integer;
  dh, dw : integer;
begin
  x := 0;
  y := 0;
  Result := Rect(0, 0, 0, 0);
  dw := (Width - GlyphWidth - Spacing * integer(ShowCaption and (GlyphWidth > 0) and (Caption <> '')) - TextRectSize.cx) div 2 - GenMargin;
  dh := (Height - GlyphHeight - Spacing * integer(ShowCaption and (GlyphWidth > 0) and (Caption <> '')) - TextRectSize.cy) div 2 - GenMargin;
  case Layout of
    blGlyphLeft : begin
      case Alignment of
        taLeftJustify : begin
          x := GenMargin;
          y := (Height - GlyphHeight) div 2;
        end;
        taCenter : begin
          x := GenMargin + dw;
          y := (Height - GlyphHeight) div 2;
        end;
        taRightJustify : begin
          x := GenMargin + 2 * dw;
          y := (Height - GlyphHeight) div 2;
        end;
      end;
    end;
    blGlyphRight : begin
      case Alignment of
        taLeftJustify : begin
          x := Width - GenMargin - 2 * dw - Spacing * integer(ShowCaption and (GlyphWidth > 0) and (Caption <> '')) - GlyphWidth;
          y := (Height - GlyphHeight) div 2;
        end;
        taCenter : begin
          x := (Width - GlyphWidth + Spacing * integer(ShowCaption and (GlyphWidth > 0) and (Caption <> '')) + TextRectSize.cx) div 2;
          y := (Height - GlyphHeight) div 2;
        end;
        taRightJustify : begin
          x := Width - GlyphWidth - GenMargin;
          y := (Height - GlyphHeight) div 2;
        end;
      end;
    end;
    blGlyphTop : begin
      x := (Width - GlyphWidth) div 2 + 1;
      y := GenMargin + dh;
    end;
    blGlyphBottom : begin
      x := (Width - GlyphWidth) div 2 + 1;
      y := Height - GenMargin - dh - GlyphHeight;
    end;
  end;
  inc(x, integer(CurrentState = 2));
  inc(y, integer(CurrentState = 2));
  Result := Rect(x, y, x + GlyphWidth, y + GlyphHeight);
end;

procedure TsBitBtn.Loaded;
begin
  inherited;
  FCommonData.FCacheBmp.Canvas.Font.Assign(Font);
  FCommonData.Loaded;
  Active := Default; // !!!
end;

procedure TsBitBtn.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;
        DoChangePaint(FadeTimer, FCommonData, True, EventEnabled(aeMouseDown, FAnimatEvents));
      end;
    end;
  end;
  inherited MouseDown(Button, Shift, X, Y);
end;

procedure TsBitBtn.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if FCommonData.Skinned 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;
//    inherited; v4.08
    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;

      FCommonData.Updating := False;
      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 TsBitBtn.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent = Images) then Images := nil;
end;

procedure TsBitBtn.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;