scustombutton.pas

AlphaControls是一个Delphi标准控件的集合

unit sCustomButton;
{$I sDefs.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, sStyleUtil,
    sMessages, sConst, ExtCtrls, sPanel, sGraphUtils, commctrl, Buttons, Imglist,
    sUtils, ActnList, comctrls, Menus, sButtonControl, sDefaults;

type

{$IFNDEF ALITE}

  TsSpeedButton = class(TsButtonControl)
  private
    FOnStateChange : TNotifyEvent;
    FGlyph: TBitmap;
    procedure SetGlyph(const Value: TBitmap);
  protected
    function AddedWidth : integer; override;
  public
    constructor Create (AOwner: TComponent); override;
    destructor Destroy; override;
//    procedure DrawGlyphEx(g : TBitmap);
    procedure DrawGlyph; override;
    function GlyphWidth : integer; override;
    function GlyphHeight : integer; override;
  published
    property Alignment;
    property AllowAllUp;
    property Blend;
    property ButtonStyle;
    property DisabledGlyphKind;
    property DropdownMenu;
    property Down;
    property Images;
    property ImagesGrayed;
    property ImagesDisabled;
    property ImageIndex;
    property Glyph : TBitmap read FGlyph write SetGlyph;
    property Grayed;
    property GroupIndex;
    property Layout;
    property NumGlyphs;
    property ShowCaption;
    property Spacing;
    property OnStateChange: TNotifyEvent read FOnStateChange write FOnStateChange;
  end;

  TsColorSelect = class(TsButtonControl)
  private
    FColorValue : TColor;
    FOnChange : TNotifyEvent;
    FImgWidth: integer;
    FImgHeight: integer;
    procedure SetColorValue(const Value: TColor);
    procedure SetImgHeight(const Value: integer);
    procedure SetImgWidth(const Value: integer);
  protected
    procedure MouseUp (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  public
    constructor Create (AOwner: TComponent); override;
    procedure DrawGlyph; override;
    function GlyphWidth : integer; override;
    function GlyphHeight : integer; override;
  published
    property ColorValue : TColor read FColorValue write SetColorValue;
    property ImgWidth : integer read FImgWidth write SetImgWidth;
    property ImgHeight : integer read FImgHeight write SetImgHeight;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property Height default 22;
    property Layout;
    property Width default 120;
    property ShowCaption;
    property Spacing;
  end;

{$ENDIF}

  TsButton = class(TsButtonControl)
  private
    FCancel: Boolean;
    FDefault: Boolean;
    FModalResult: TModalResult;
    FShowFocus: boolean;
    FFocusMargin: integer;
    procedure SetDefault(const Value: Boolean);
    procedure SetShowFocus(const Value: boolean);
    procedure SetFocusMargin(const Value: integer);
  protected
    procedure WMKeyUp (var Message: TMessage); message WM_KEYUP;
    procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY;
    procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
    procedure CMFocusChanged(var Message: TCMFocusChanged); message CM_FOCUSCHANGED;
    procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
    procedure MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure SetCanvasProps; override;
  public
    FActive: Boolean;
    constructor Create (AOwner: TComponent); override;
    procedure CreateWnd; override;
    procedure Click; override;
    destructor Destroy; override;
    function ActualShowFocus : boolean;
  published
    property Cancel: Boolean read FCancel write FCancel default False;
    property Default: Boolean read FDefault write SetDefault default False;
    property FocusMargin : integer read FFocusMargin write SetFocusMargin default 1;
    property ModalResult: TModalResult read FModalResult write FModalResult default 0;
    property ShowCaption;
    property ShowFocus : boolean read FShowFocus write SetShowFocus default True;
    property TabOrder;
    property TabStop default True;
  end;

  TsTimerSpeedButton = class(TsButtonControl)
  private
    FAllowTimer: boolean;
  protected
  public
    constructor Create (AOwner: TComponent); override;
  published
    property AllowTimer: boolean read FAllowTimer write FAllowTimer default True;
  end;

{$IFNDEF ALITE}

  TsBitBtn = class(TsButton)
  private
    FGlyph: TBitmap;
    procedure SetGlyph(const Value: TBitmap);
  protected
  public
    constructor Create (AOwner: TComponent); override;
    destructor Destroy; override;
    procedure DrawGlyph; override;
    function GlyphWidth : integer; override;
    function GlyphHeight : integer; override;
  published
    property Alignment;
    property Blend;
    property DisabledGlyphKind;
    property Images;
    property ImagesGrayed;
    property ImagesDisabled;
    property ImageIndex;
    property Glyph : TBitmap read FGlyph write SetGlyph;
    property Grayed;
    property Layout;
    property NumGlyphs;
    property Spacing;
  end;

{$ENDIF}

implementation

uses sStyleSimply, sMaskData;

{$IFNDEF ALITE}

{ TsSpeedButton }

constructor TsSpeedButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  sStyle.COC := COC_TsSpeedButton;
  FGlyph := TBitmap.Create;
  DroppedDown := False;
  TabStop := False;
  if (csDesigning in ComponentState) and (sStyle.Background.Gradient.Data = '') then begin
    sStyle.Background.Gradient.Data := GradientTsSpeedButton;
    sStyle.HotStyle.HotBackground.Gradient.Data := GradientTsSpeedButtonHot;
  end;
end;

function TsSpeedButton.AddedWidth: integer;
begin
  if ButtonStyle = tbsDropDown then begin
    Result := BevelWidth * 2 + 16;
  end
  else Result := 0;
end;

procedure TsSpeedButton.SetGlyph(const Value: TBitmap);
begin
  FGlyph.Assign(Value);
  sStyle.Invalidate;
end;

{
procedure TsSpeedButton.DrawGlyphEx(g: TBitmap);
var
  IRect : TRect;
  Bmp : TBitmap;
  c, MaskColor: TsColor;
  w : integer;
begin
  IRect := ImgRect;
  g.PixelFormat := pf24bit;
  case NumGlyphs of
    1 : begin
      Bmp := TBitmap.Create;
      Bmp.Assign(G);
      Bmp.PixelFormat := pf24bit;
      Bmp.TransparentColor := Bmp.Canvas.Pixels[0, Bmp.Height - 1];

      try
      if not Enabled then begin
        if dgGrayed in DisabledGlyphKind then begin
          GrayScale(Bmp);
        end;
        if dgBlended in DisabledGlyphKind then begin
          MaskColor := TsColor(Bmp.Canvas.Pixels[0, Bmp.Height - 1]);
          BlendTransRectangle(sStyle.FCacheBmp, IRect.Left, IRect.Top, Bmp, Rect(0, 0, Bmp.Width, Bmp.Height), 0.5, MaskColor);
        end
        else begin
          MaskColor := TsColor(Bmp.Canvas.Pixels[0, Bmp.Height - 1]);
          CopyTransBitmaps(sStyle.FCacheBmp, Bmp, IRect.Left, IRect.Top, MaskColor);
        end;
      end
      else begin
        if not sStyle.ControlIsActive and Grayed then begin
          GrayScale(Bmp);
        end;
        MaskColor := TsColor(Bmp.Canvas.Pixels[0, Bmp.Height - 1]);

        if not sStyle.ControlIsActive and (Blend > 0) then begin
          c.C := ColorToRGB(sStyle.Painting.Color);
          BlendTransRectangle(sStyle.FCacheBmp, IRect.Left, IRect.Top, Bmp,
                              Rect(0, 0, Bmp.Width, Bmp.Height), Blend / 100, MaskColor);
        end
        else begin
          CopyTransBitmaps(sStyle.FCacheBmp, Bmp, IRect.Left, IRect.Top, MaskColor);
        end;
      end;
      finally
        FreeAndNil(Bmp);
      end;
    end;
    2 : begin
      w := g.Width div NumGlyphs;
      if not Enabled then begin
        CopyTransRect(sStyle.FCacheBmp, g, IRect.Left, IRect.Top, Rect(w, 0, 2 * w - 1, g.Height - 1), g.Canvas.Pixels[0, g.Height - 1]);
      end
      else begin
        CopyTransRect(sStyle.FCacheBmp, g, IRect.Left, IRect.Top, Rect(0, 0, w - 1, g.Height - 1), g.Canvas.Pixels[0, g.Height - 1]);
      end;
    end;
  end;
end;
}
destructor TsSpeedButton.Destroy;
begin
  if Assigned(FGlyph) then FreeAndNil(FGlyph);
  inherited Destroy;
end;

procedure TsSpeedButton.DrawGlyph;
begin
  if (FGlyph.Width > 0) then begin
    sGraphUtils.DrawGlyphEx(FGlyph, sStyle.FCacheBmp, ImgRect, NumGlyphs, Enabled, Grayed, DisabledGlyphKind, integer(sStyle.controlIsActive), Blend);
  end
  else begin
    inherited;
  end;
end;

function TsSpeedButton.GlyphHeight: integer;
begin
  if FGlyph.Height > 0 then begin
    Result := FGlyph.Height;
  end
  else begin
    Result := inherited GlyphHeight;
  end
end;

function TsSpeedButton.GlyphWidth: integer;
begin
  if FGlyph.Width > 0 then begin
    Result := FGlyph.Width div NumGlyphs;
  end
  else begin
    Result := inherited GlyphWidth;
  end
end;

{ TsColorSelect }

Constructor TsColorSelect.Create(AOwner: TComponent);
begin
  inherited;
  sStyle.COC := COC_TsColorSelect;
  FImgHeight := 12;
  FImgWidth := 32;
  Height := 22;
  Width := 120;
  if (csDesigning in ComponentState) and (sStyle.Background.Gradient.Data = '') then begin
    sStyle.Background.Gradient.Data := GradientTsColorSelect;
    sStyle.HotStyle.HotBackground.Gradient.Data := GradientTsColorSelectHot;
  end;
end;

procedure TsColorSelect.DrawGlyph;
begin
  sStyle.FCacheBmp.Canvas.Pen.Style := psClear;
  sStyle.FCacheBmp.Canvas.Brush.Color := ColorValue;
  sStyle.FCacheBmp.Canvas.Rectangle(ImgRect);
end;

function TsColorSelect.GlyphHeight: integer;
begin
  Result := ImgHeight;
end;

function TsColorSelect.GlyphWidth: integer;
begin
  Result := ImgWidth;
end;

procedure TsColorSelect.MouseUp(Button: TMouseButton; Shift: TShiftState;