scheckbox.pas

Alpha Controls.v5.46b Source

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

interface

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

type
{$IFNDEF NOTFORHELP}
  TsImageIndex = integer;
{$ENDIF} // NOTFORHELP

  TsCheckBox = class(TCustomCheckBox)
{$IFNDEF NOTFORHELP}
  private
    FCommonData: TsCommonData;
    FDisabledKind: TsDisabledKind;
    FGlyphUnChecked: TBitmap;
    FGlyphChecked: TBitmap;
    FTextIndent: integer;
    FPressed : boolean;
    FShowFocus: Boolean;
    FMargin: integer;
    FadeTimer : TsFadeTimer;
    FImages: TCustomImageList;
    FImgChecked: TsImageIndex;
    FImgUnchecked: TsImageIndex;
    FAnimatEvents: TacAnimatEvents;
{$IFNDEF DELPHI7UP}
    FWordWrap : boolean;
    procedure SetWordWrap(const Value: boolean);
{$ENDIF}
    procedure SetDisabledKind(const Value: TsDisabledKind);
    procedure SetGlyphChecked(const Value: TBitmap);
    procedure SetGlyphUnChecked(const Value: TBitmap);
    procedure SetTextIndent(const Value: integer);
    procedure SetShowFocus(const Value: Boolean);
    procedure SetMargin(const Value: integer);
    procedure SetReadOnly(const Value: boolean);
    procedure SetImageChecked(const Value: TsImageIndex);
    procedure SetImages(const Value: TCustomImageList);
    procedure SetImageUnChecked(const Value: TsImageIndex);
{$IFDEF TNTUNICODE}
    function GetCaption: TWideCaption;
    procedure SetCaption(const Value: TWideCaption);
    function GetHint: WideString;
    procedure SetHint(const Value: WideString);
    function IsCaptionStored: Boolean;
    function IsHintStored: Boolean;
    procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
{$ENDIF}
  protected
    FReadOnly: boolean;

    function GetReadOnly: boolean; virtual;
    function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override;
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
    procedure SetChecked(Value: Boolean); override;

    procedure PaintHandler(M : TWMPaint);
    procedure PaintControl(DC : HDC);
    procedure DrawCheckText;
    procedure DrawCheckArea;
    procedure DrawSkinGlyph(i : integer);
    procedure PaintGlyph(Bmp : TBitmap);

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

    function CheckRect: TRect;
    function GlyphWidth : integer;
    function GlyphHeight : integer;

    function GlyphMaskIndex(State : TCheckBoxState) : smallint;
    procedure PrepareCache;
{$IFDEF TNTUNICODE}
    procedure CreateWindowHandle(const Params: TCreateParams); override;
    procedure DefineProperties(Filer: TFiler); override;
    function GetActionLinkClass: TControlActionLinkClass; override;
{$ENDIF}
  public
    function GetControlsAlignment: TAlignment; override;
    procedure AfterConstruction; override;
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
    procedure WndProc(var Message: TMessage); override;
  published
{$IFDEF TNTUNICODE}
    property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
    property Hint: WideString read GetHint write SetHint stored IsHintStored;
{$ELSE}
    property Caption;
{$ENDIF}
    property Action;
    property Alignment;
    property AllowGrayed;
    property Anchors;
    property AutoSize default True;
    property BiDiMode;
    property Checked;
    property Color;
    property Constraints;
    property Ctl3D;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property State;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnClick;
    property OnContextPopup;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
    property Margin : integer read FMargin write SetMargin default 2;
{$ENDIF} // NOTFORHELP
    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 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 Images : TCustomImageList read FImages write SetImages;
    property ReadOnly : boolean read GetReadOnly write SetReadOnly default False;
    property ShowFocus: Boolean read FShowFocus write SetShowFocus default True;
    property TextIndent : integer read FTextIndent write SetTextIndent default 0;
{$IFNDEF DELPHI7UP}
    property WordWrap : boolean read FWordWrap write SetWordWrap default False;
{$ELSE}
    property WordWrap default False;
{$ENDIF}
  end;

var
  PaintState : integer = -1;

implementation

uses sGraphUtils, acntUtils, sAlphaGraph, sVclUtils, sStylesimply, sSkinProps,
  Math, sMessages, sSKinManager{$IFDEF CHECKXP}, UxTheme, Themes{$ENDIF};

{ TsCheckBox }

procedure TsCheckBox.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
{$IFDEF TNTUNICODE}
  TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
{$ENDIF}
  FCommonData.BGChanged := True;
  inherited;
  Repaint;
end;

procedure TsCheckBox.AfterConstruction;
begin
  inherited;
  SkinData.Loaded;
end;

function TsCheckBox.GetControlsAlignment: TAlignment;
begin
  if not UseRightToLeftAlignment then
    Result := Alignment
  else
    if Alignment = taRightJustify then
      Result := taLeftJustify
    else
      Result := taRightJustify;
end;

function TsCheckBox.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean;
var
  ss : TSize;
  R : TRect;
  w, h : integer;
begin
  Result := False;
  if FCommonData.Skinned then begin
    if csLoading in ComponentState then Exit;
    if AutoSize then begin
      ss := GetStringSize(Font.Handle, Caption);
      R := CheckRect;
      NewWidth := WidthOf(R) + 2 * Margin + (ss.cx + FTextIndent + 8) * integer(Caption <> '');
      NewHeight := Max(HeightOf(R), 2 * Margin + ss.cy * integer(Caption <> '')) + 2;
      Result := True;
      w := NewWidth; h := NewHeight;
    end;
  end
  else begin
    if AutoSize then begin
      ss := GetStringSize(Font.Handle, Caption);
      NewWidth := ss.cx + 20;
      NewHeight := ss.cy + 4;
    end
    else begin
      w := NewWidth; h := NewHeight;
      Result := inherited CanAutoSize(w, h);
      NewWidth := w; NewHeight := h;
    end;
  end;
end;

function TsCheckBox.CheckRect: TRect;
var
  i : integer;
begin
  if Assigned(Images) and (ImgChecked > -1) and (ImgUnChecked > -1) then begin
    if GetControlsAlignment = taRightJustify
      then Result := Rect(Margin, (Height - GlyphHeight) div 2, Margin + GlyphWidth, GlyphHeight + (Height - GlyphHeight) div 2)
      else Result := Rect(Width - GlyphWidth - Margin, (Height - GlyphHeight) div 2, Width - Margin, GlyphHeight + (Height - GlyphHeight) div 2)
  end
  else if FGlyphChecked.Width > 0 then begin
    if GetControlsAlignment = taRightJustify
      then Result := Rect(Margin, (Height - GlyphHeight) div 2, Margin + GlyphWidth, GlyphHeight + (Height - GlyphHeight) div 2)
      else Result := Rect(Width - GlyphWidth - Margin, (Height - GlyphHeight) div 2, Width - Margin, GlyphHeight + (Height - GlyphHeight) div 2)
  end
  else begin
    i := GlyphMaskIndex(cbChecked);
    if FCommonData.SkinManager.IsValidImgIndex(i) then Result := SkinCheckRect(i) else Result := Rect(0, 0, 16, 16);
  end;
end;

{$IFDEF TNTUNICODE}
procedure TsCheckBox.CMDialogChar(var Message: TCMDialogChar);
begin
  with Message do
    if IsWideCharAccel(Message.CharCode, Caption)
    and CanFocus then
    begin
      SetFocus;
      if Focused then Toggle;
      Result := 1;
    end else
      Broadcast(Message);
end;
{$ENDIF}

constructor TsCheckBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCommonData := TsCommonData.Create(Self, False);
  FCommonData.COC := COC_TsCheckBox;
  FCommonData.FOwnerControl := Self;
  FadeTimer := nil;
  FMargin := 2;
  FShowFocus := True;
  FTextIndent := 0;
  FDisabledKind := DefDisabledKind;
  FGlyphChecked := TBitmap.Create;
  FGlyphUnChecked := TBitmap.Create;
  FAnimatEvents := [aeGlobalDef];
{$IFNDEF DELPHI7UP}
  FWordWrap := False;
{$ELSE}
  WordWrap := False;
{$ENDIF}
  FPressed := False;
  AutoSize := True;
end;

{$IFDEF TNTUNICODE}
procedure TsCheckBox.CreateWindowHandle(const Params: TCreateParams);
begin
  CreateUnicodeHandle(Self, Params, 'BUTTON');
end;

procedure TsCheckBox.DefineProperties(Filer: TFiler);
begin
  inherited;
  TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
{$ENDIF}

destructor TsCheckBox.Destroy;
begin
  StopFading(FadeTimer, FCommonData);
  if Assigned(FCommonData) then FreeAndNil(FCommonData);
  if Assigned(FGlyphChecked) then FreeAndNil(FGlyphChecked);
  if Assigned(FGlyphUnchecked) then FreeAndNil(FGlyphUnChecked);
  if Assigned(FadeTimer) then FreeAndNil(FadeTimer);
  inherited Destroy;
end;

const
  CheckBoxStates : array[0..2] of TCheckBoxState = (cbUnchecked, cbChecked, cbGrayed);

procedure TsCheckBox.DrawCheckArea;
var
  CheckArea: TRect;
  i : integer;
  TempBmp : TBitmap;
begin
  if Assigned(Images) and (ImgChecked > -1) and (ImgUnChecked > -1) then begin
    TempBmp := TBitmap.Create;
    TempBmp.Width := GlyphWidth;
    TempBmp.Height := GlyphHeight;
    TempBmp.PixelFormat := pf24bit;

    Images.GetBitmap(iffi(Checked, ImgChecked, ImgUnChecked), TempBmp);

    PaintGlyph(TempBmp);

    FreeAndNil(TempBmp);
  end
  else if FGlyphChecked.Width > 0 then begin
    CheckArea := CheckRect;
    if Checked then begin
      PaintGlyph(FGlyphChecked);
    end
    else if not Checked then begin
      if (FGlyphUnChecked.Width > 0) then PaintGlyph(FGlyphUnChecked);
    end;
  end
  else begin
    if PaintState <> - 1
      then i := GlyphMaskIndex(CheckBoxStates[PaintState])
      else i := GlyphMaskIndex(State);
    if SkinData.SkinManager.IsValidImgIndex(i) then DrawSkinGlyph(i);
  end;
end;

procedure TsCheckBox.DrawCheckText;
var
  rText: TRect;
  Fmt: integer;
  t, b, w, h, dx : integer;
begin
  if Caption <> '' then begin
    w := Width - (WidthOf(CheckRect) + FTextIndent + 2 * Margin + 2);

    rText := Rect(0, 0, w, 0);
    Fmt := DT_CALCRECT;
    if WordWrap
      then Fmt := Fmt or DT_WORDBREAK
      else Fmt := Fmt or DT_SINGLELINE;
    AcDrawText(FCommonData.FCacheBMP.Canvas.Handle, Caption, rText, Fmt);
    h := HeightOf(rText);
    dx := WidthOf(rText);
    t := Max((Height - h) div 2, Margin);
    b := Height - t;

    Fmt := 0;
    if GetControlsAlignment = taRightJustify then begin
      rText := Rect(Width - w - Margin + 2, t, Width - w - Margin + 2 + dx, b);
      if not WordWrap then Fmt := DT_LEFT;
    end
    else begin
      rText := Rect(Margin, t, w + Margin, b);
    end;
    OffsetRect(rText, -integer(WordWrap), -1);
    if WordWrap
      then Fmt := Fmt or DT_WORDBREAK or DT_TOP or DT_CENTER
      else Fmt := Fmt or DT_SINGLELINE or DT_TOP;

    acWriteTextEx(FCommonData.FCacheBmp.Canvas, PacChar(Caption), True, rText, Fmt, FCommonData, ControlIsActive(FCommonData) and not ReadOnly);

    FCommonData.FCacheBmp.Canvas.Pen.Style := psClear;
    FCommonData.FCacheBmp.Canvas.Brush.Style := bsSolid;
    if Focused and ShowFocus then begin
      dec(rText.Bottom, 1 + integer(not WordWrap));
      inc(rText.Top);
      InflateRect(rText, 1, 1);
      FocusRect(FCommonData.FCacheBmp.Canvas, rText);
    end;
  end;
end;

procedure TsCheckBox.DrawSkinGlyph(i: integer);
var
  R : TRect;
  Mode : integer;
begin
  if FCommonData.FCacheBmp.Width < 1 then exit;
  CtrlParentColor := clFuchsia;
  R := SkinCheckRect(i);
  if FPressed then Mode := 2 else if ControlIsActive(FCommonData) and not ReadOnly then Mode := 1 else Mode := 0;
  sAlphaGraph.DrawSkinGlyph(FCommonData.FCacheBmp, R.TopLeft, Mode, 1, FCommonData.SkinManager.ma[i])
end;

{$IFDEF TNTUNICODE}
function TsCheckBox.GetActionLinkClass: TControlActionLinkClass;
begin
  Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
end;

function TsCheckBox.GetCaption: TWideCaption;
begin
  Result := TntControl_GetText(Self)
end;

function TsCheckBox.GetHint: WideString;
begin
  Result := TntControl_GetHint(Self)
end;
{$ENDIF}

function TsCheckBox.GetReadOnly: boolean;
begin