scheckedcontrol.pas

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

unit sCheckedControl;

{$I sDefs.inc}
{$IFDEF ALITE}
  {$R SRES.RES}
{$ENDIF}

interface

uses
  Windows, Messages, Classes, Graphics, Controls, Forms, ExtCtrls, sStyleUtil, StdCtrls,
  sConst, sGraphUtils, sUtils, imglist, SysUtils, sStyleEdits, sDefaults;

type
  TsImageIndex = integer;

  TsCheckedControl = class(TCustomControl)
  private
    FAlignment: TAlignment;
    FAllowGrayed: Boolean;
    FLayout: TCheckAreaLayout;
    FShowFocus: Boolean;
    FState: TCheckBoxState;
    FPressed : boolean;
    FOnChange : TNotifyEvent;
    FImgChecked : TsImageIndex;
    FImgUnchecked : TsImageIndex;
    FImages: TCustomImageList;
    FMultiLine: boolean;
    FImgUncheckedHot: TsImageIndex;
    FImgCheckedHot: TsImageIndex;
    FGlyphChecked: TBitmap;
    FGlyphUnChecked: TBitmap;
    FDisabledKind: TsDisabledKind;
    procedure SetState(Value: TCheckBoxState);
    procedure SetLayout (Value: TCheckAreaLayout);
    procedure WMEraseBkGND (var Message: TMessage); message WM_ERASEBKGND;
    procedure SetShowFocus(const Value: Boolean);
    procedure SetImageChecked(const Value: TsImageIndex);
    procedure SetImageCheckedHot(const Value: TsImageIndex);
    procedure SetImageUnChecked(const Value: TsImageIndex);
    procedure SetImageUnCheckedHot(const Value: TsImageIndex);
    procedure SetImages(const Value: TCustomImageList);
    procedure SetAlignment(const Value: TAlignment);
    procedure SetMultiLine(const Value: boolean);
    procedure SetGlyphChecked(const Value: TBitmap);
    procedure SetGlyphUnChecked(const Value: TBitmap);
    procedure SetReadOnly(const Value: boolean);
    procedure SetDisabledKind(const Value: TsDisabledKind);
  protected
    FsStyle : TsStyle;
    FReadOnly: boolean;
    function GetReadOnly: boolean; virtual;
    procedure AdjustSize; override;
    procedure SetChecked (Value: Boolean); virtual;
    function BeforeCheck(Value : boolean) : boolean; virtual;
    procedure MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure Paint; override;
    procedure WndProc (var Message: TMessage); override;
    procedure Toggle; virtual;
    property State: TCheckBoxState read FState write SetState default cbUnchecked;
    property AllowGrayed: Boolean read FAllowGrayed write FAllowGrayed default False;
    procedure CreateWnd; override;
  public
    FChecked : Boolean;
    Margin : integer;
    function CheckRect: TRect;
    procedure PaintControl;
    procedure DrawCheckArea;
    procedure PaintGlyph(Bmp : TBitmap);
    function GlyphWidth : integer;
    function GlyphHeight : integer;

    procedure DrawSkinGlyph(i : integer);
    function SkinGlyphWidth(i : integer) : integer;
    function SkinGlyphHeight(i : integer) : integer;
    function SkinCheckRect(i : integer): TRect;

    procedure DrawParent;
    procedure DrawCheckText;

    function CheckHeight : integer;
    function CheckWidth : integer;

    constructor Create (AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Invalidate; override;
    procedure AfterConstruction; override;
    procedure Loaded; override;
    property Autosize;
  published
    property Alignment: TAlignment read FAlignment write SetAlignment;
    property DisabledKind : TsDisabledKind read FDisabledKind write SetDisabledKind default DefDisabledKind;
    property sStyle: TsStyle read FsStyle write FsStyle;
    property ShowFocus: Boolean read FShowFocus write SetShowFocus default false;
    property Caption;
    property Checked: Boolean read FChecked write SetChecked default false;
    property GlyphChecked : TBitmap read FGlyphChecked write SetGlyphChecked;
    property GlyphUnChecked : TBitmap read FGlyphUnChecked write SetGlyphUnChecked;
    property ImgChecked : TsImageIndex read FImgChecked write SetImageChecked;
    property ImgUnchecked : TsImageIndex  read FImgUnchecked write SetImageUnChecked;
    property ImgCheckedHot : TsImageIndex read FImgCheckedHot write SetImageCheckedHot;
    property ImgUncheckedHot : TsImageIndex  read FImgUncheckedHot write SetImageUnCheckedHot;
    property Images : TCustomImageList read FImages write SetImages;
    property Enabled;
    property Font;
    property Height default 18;
    property Layout: TCheckAreaLayout read FLayout write SetLayout default calLeft;
    property MultiLine: boolean read FMultiLine write SetMultiLine;
    property ParentFont;
    property ReadOnly : boolean read GetReadOnly write SetReadOnly default False;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property Action;
    property Anchors;
    property BiDiMode write SetBidiMode;
    property Constraints;
    property DragKind;
    property ParentBiDiMode;
    property OnEndDock;
    property OnStartDock;
  end;

var
  RADIO_CHECKED,
  RADIO_UNCHECKED,
  RADIO_CHECKEDHOT,
  RADIO_UNCHECKEDHOT,

  CHECK_CHECKED,
  CHECK_UNCHECKED,
  CHECK_CHECKEDHOT,
  CHECK_UNCHECKEDHOT : TBitmap;

implementation

uses sPanel, sVclUtils, sStyleSimply, sMaskData, Dialogs, sSkinProps, sAlphaGraph;

constructor TsCheckedControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  sStyle := TsStyle.Create(Self);
  sStyle.COC := COC_TsCheckedControl;

  ControlStyle := ControlStyle + [csOpaque];
  OnKeyDown := sStyle.onKeyDown;
  FLayout := calLeft;
  Margin := 3;
  SetBounds(0, 0, 100, 17);
  ParentColor := True;
  FPressed := False;
  Height := 18;
  sStyle.Painting.ParentColor := True;
  FGlyphChecked := TBitmap.Create;
  FGlyphUnChecked := TBitmap.Create;
  FDisabledKind := DefDisabledKind;
end;

procedure TsCheckedControl.SetLayout(Value: TCheckAreaLayout);
begin
  if FLayout <> Value then begin
    FLayout := Value;
    sStyle.Invalidate;
  end;
end;

procedure TsCheckedControl.SetChecked(Value: Boolean);
begin
  if FChecked <> Value then begin
    FChecked := BeforeCheck(Value);
    sStyle.Invalidate;
  end;
end;

procedure TsCheckedControl.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Assigned(OnMouseDown) then begin
    OnMouseDown(Self, Button, Shift, X, Y);
  end;
  if not FPressed and Enabled then begin
    if (Button = mbLeft) then begin
      FPressed := True;
      if not RestrictDrawing then sStyle.BGChanged := True;
      Repaint;
      if not (csDesigning in ComponentState) and (not Focused) then begin
        SetFocus;
      end;
    end;
    inherited;
  end;
end;

procedure TsCheckedControl.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if csDestroying in ComponentState then Exit;
  if Assigned(OnMouseUp) then begin
    OnMouseUp(Self, Button, Shift, X, Y);
  end;
  if (Button = mbLeft) and Enabled and FPressed and not ReadOnly then begin
      if not (csDesigning in ComponentState) then begin
        Checked := not Checked;
        Toggle;
        if Assigned(FOnChange) then FOnChange(Self);
      end;
    if not RestrictDrawing then sStyle.BGChanged := True;
    FPressed := False;
    inherited;
  end;
end;

procedure TsCheckedControl.DrawCheckArea;
var
  CheckArea: TRect;
  Bmp : TBitmap;
  ImgIndex, i : integer;
  MaskColor: TsColor;
  procedure PrepareGlyph; begin
    if Assigned(Images) then begin
      Bmp.Width := Images.Width;
      Bmp.Height := Images.Height;
      if sStyle.ControlIsActive then begin
        ImgIndex := iffi(Checked, ImgCheckedHot, ImgUncheckedHot);
      end
      else begin
        ImgIndex := iffi(Checked, ImgChecked, ImgUnchecked);
      end;
      if Images.BkColor = clNone then begin
        Bmp.Canvas.Brush.Color := clFuchsia
      end
      else begin
        Bmp.Canvas.Brush.Color := Images.BkColor;
      end;
      Bmp.Canvas.FillRect(Rect(0, 0, Bmp.Width, Bmp.Height));

      Images.GetBitmap(ImgIndex, Bmp);
    end
    else begin
      if sStyle.ControlIsActive then begin
        if Checked then begin
          if sStyle.COC = COC_TsRadioButton then begin
            if Assigned(RADIO_CHECKEDHOT) then Bmp.Assign(RADIO_CHECKEDHOT);
          end
          else begin
            if Assigned(CHECK_CHECKEDHOT) then Bmp.Assign(CHECK_CHECKEDHOT);
          end;
        end
        else begin
          if sStyle.COC = COC_TsRadioButton then begin
            if Assigned(RADIO_UNCHECKEDHOT) then Bmp.Assign(RADIO_UNCHECKEDHOT);
          end
          else begin
            if Assigned(CHECK_UNCHECKEDHOT) then Bmp.Assign(CHECK_UNCHECKEDHOT);
          end;
        end;
      end
      else begin
        if Checked then begin
          if sStyle.COC = COC_TsRadioButton then begin
            if Assigned(RADIO_CHECKED) then Bmp.Assign(RADIO_CHECKED);
          end
          else begin
            if Assigned(CHECK_CHECKED) then Bmp.Assign(CHECK_CHECKED);
          end;
        end
        else begin
          if sStyle.COC = COC_TsRadioButton then begin
            if Assigned(RADIO_UNCHECKED) then Bmp.Assign(RADIO_UNCHECKED);
          end
          else begin
            if Assigned(CHECK_UNCHECKED) then Bmp.Assign(CHECK_UNCHECKED);
          end;
        end;
      end;
    end;
    Bmp.PixelFormat := pf24bit;
  end;
begin
  if sStyle.SkinIndex > -1 then begin
    if Checked then begin
      i := GetMaskIndex(sStyle.SkinIndex, sStyle.SkinSection, sSkinProps.GlyphChecked);
    end
    else begin
      i := GetMaskIndex(sStyle.SkinIndex, sStyle.SkinSection, sSkinProps.GlyphUnChecked);
    end;
    if IsValidImgIndex(i) then begin
      DrawSkinGlyph(i);
    end;
  end
  else begin
    CheckArea := CheckRect;
    if Checked and (FGlyphChecked.Width > 0) then begin
      PaintGlyph(FGlyphChecked);
    end
    else if not Checked and (FGlyphUnChecked.Width > 0) then begin
      PaintGlyph(FGlyphUnChecked);
    end
    else begin
      Bmp := TBitmap.Create;
      try
        PrepareGlyph;
        MaskColor := TsColor(Bmp.Canvas.Pixels[0, Bmp.Height - 1]);
        CopyTransBitmaps(sStyle.FCacheBmp, Bmp, CheckRect.Left, CheckRect.Top, MaskColor);
      finally
        FreeAndNil(Bmp);
      end;
    end;
  end;
end;

procedure TsCheckedControl.DrawCheckText;
const
  Spacing = 4;
var
  rText: TRect;
  Fmt: integer;
  w : integer;
begin
  if Caption <> '' then begin
    w := HeightOf(CheckRect) + Spacing;
    if FLayout = calLeft then begin
      rText := Rect(w + Margin, Margin, Width - Margin, Height - Margin);
    end
    else begin
      rText := Rect(Margin, Margin, Width - w - Margin, Height - Margin);
    end;
    if FMultiLine then begin
      Fmt := DT_WORDBREAK or DT_TOP;
    end
    else begin
      Fmt := DT_SINGLELINE or DT_VCENTER;
    end;
    Fmt := Fmt or AlignToInt[Alignment];

    rText.Bottom := rText.Bottom - 2;

    sGraphUtils.WriteText(sStyle.FCacheBmp.Canvas, PChar(Caption), True{Enabled}, rText, Fmt);
    rText.Bottom := rText.Bottom + 2;

    sStyle.FCacheBmp.Canvas.Pen.Style := psClear;
    sStyle.FCacheBmp.Canvas.Brush.Style := bsSolid;
    if Focused and ShowFocus then begin
      dec(rText.Bottom);
//      dec(rText.Top);
      InflateRect(rText, 1, 1);
      FocusRect(sStyle.FCacheBmp.Canvas, rText);
//      sStyle.FCacheBmp.Canvas.DrawFocusRect(rText);
    end;
  end;
end;

procedure TsCheckedControl.Invalidate;
begin
  if (csDesigning in ComponentState) and Assigned(FsStyle) then begin
    if not RestrictDrawing then FsStyle.BGChanged := True;
  end;
  inherited;
end;

procedure TsCheckedControl.WndProc(var Message: TMessage);
begin
  case Message.Msg of
    CM_TEXTCHANGED : begin
      if not RestrictDrawing then sStyle.BGChanged := True;
      sStyle.Invalidate;
    end;
    CM_EXIT : begin
      FPressed := False;
    end;
  end;
  if Assigned(FsStyle) then FsStyle.WndProc(Message);
  inherited;
end;

procedure TsCheckedControl.WMEraseBkGND(var Message: TMessage);
begin
  Message.Result := 1;
end;

function TsCheckedControl.BeforeCheck(Value : boolean): boolean;
begin
  Result := Value;
end;

procedure TsCheckedControl.SetShowFocus(const Value: Boolean);
begin
  if FShowFocus <> Value then begin
    FShowFocus := Value;
    sStyle.Invalidate;
  end;
end;

procedure TsCheckedControl.SetState(Value: TCheckBoxState);