Fórum Aumentar o box do Chek box via prog #157496

unit smartcheckbox;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  extctrls;

type
  TSmartCheckBox = class(TCustomControl)
  private
    FState    :UINT;
    FChecked  :boolean;
    FEnabled  :boolean;
    FColor    :TColor;
    FCaption  :String;
    FAlignment :TLeftRight;
    procedure DoEnter; override;
    procedure DoExit; override;
    procedure SetCaption(value:String);
    procedure SetAlignment(value:TLeftRight);
    procedure SetState(value :UINT);
    procedure SetColor(Value :TColor);
    procedure setchecked(value:boolean);
    procedure setenabled(value:boolean);
    procedure setname(const NewName:Tcomponentname); override;
  protected
    procedure paint; override;
    procedure click; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  public
    constructor create(AOwner:TComponent); override;
  published
    property Caption :String read FCaption write SetCaption;
    property Alignment : TLeftRight read FAlignment write setalignment;
    property Enabled :boolean read FEnabled write setEnabled default true;
    property Checked :boolean read FChecked write setchecked default false;
    property Color :TColor read FColor write setcolor default clBtnFace;
    property ShowHint;
    property ParentShowHint;
    property OnClick;
    property OnExit;
    property OnEnter;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseUp;
    property PopUpMenu;
    property Font;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents(Smart, [TSmartCheckBox]);
end;

constructor TSmartCheckBox.create(AOwner:TComponent);
begin
  inherited create(AOwner);
  width:=120;
  height:=15;
  FColor:=clBtnFace;
  FEnabled:=true;
  FState:=DFCS_BUTTONCHECK;
  FAlignment:=taRightJustify;
  TabStop:=True;
end;

procedure TSmartCheckBox.setname(const NewName:Tcomponentname);
begin
  inherited setname(NewName);
  FCaption:=NewName;
end;

procedure TSmartCheckBox.SetCaption(value:String);
begin
  FCaption:=value;
  paint;
end;

procedure TSmartCheckBox.SetAlignment(value:TLeftRight);
begin
  FAlignment:=value;
  paint;
end;

procedure TSmartCheckBox.SetState(value :UINT);
begin
  FState:=value;
end;

procedure TSmartCheckBox.SetColor(Value :TColor);
begin
  FColor:=value;
  paint;
end;

procedure TSmartCheckBox.setenabled(value:boolean);
begin
  FEnabled:=value;
  if not value then
  begin
    FState:=DFCS_INACTIVE;
    tabstop:=false;
  end
  else
  begin
    FState:=DFCS_BUTTONCHECK;
    tabstop:=true;
  end;

  if checked then
  begin
    FState:=FState or DFCS_CHECKED
  end;
  
  paint;
end;

procedure TSmartCheckBox.setchecked(value:boolean);
begin
  FChecked:=value;

  if value then
    FState:=DFCS_CHECKED
  else
    FState:=DFCS_BUTTONCHECK;

  if not enabled then
  begin
    FState:=FState or DFCS_INACTIVE
  end;

  paint;
end;

procedure TSmartCheckBox.paint;
var
  TheRect2: Trect;
  TheRect: Trect;
  TheType: UINT;
  Style: Integer;     // holds the pen styles
  PenHandle: HPen;    // the handle of the pen
begin
  TheType := 0;

  if Alignment = taRightJustify then
    TheRect := Rect(1, 1, height, height)
  else
    TheRect := Rect(width-height,1, width, height);

  TheRect2 := Rect(1, 1, width, height);

  TheType := DFC_BUTTON;
  Canvas.Brush.Color := FColor;
  Canvas.Font:=Font;
  Canvas.FillRect(TheRect2);

  if Alignment = taRightJustify then
    Canvas.TextOut(height+3,1,FCaption)
  else
    Canvas.TextOut(1,1,FCaption);

  DrawFrameControl(Canvas.Handle, TheRect, TheType, FState);

  if Focused then
  begin

    Style := PS_DOT;
    PenHandle := CreatePen(Style, 1, 0);
    Canvas.Pen.Handle := PenHandle;

    if Alignment = taRightJustify then
    begin
      Canvas.MoveTo(height+3, 1);
      Canvas.LineTo(width-1, 1);
      Canvas.LineTo(width-1, height-1);
      Canvas.LineTo(height+3, height-1);
      Canvas.LineTo(height+3, 1);
    end
    else
    begin
      Canvas.MoveTo(1, 1);
      Canvas.LineTo(width-height-1, 1);
      Canvas.LineTo(width-height-1, height-1);
      Canvas.LineTo(1, height-1);
      Canvas.LineTo(1,1);
    end;
    DeleteObject(PenHandle);
  end;  

end;

procedure TSmartCheckBox.click;
begin
  if not enabled then
    exit;
  checked:=not checked;
  inherited click;
end;

procedure TSmartCheckBox.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if assigned(OnMousedown) then
    click;
  inherited Mousedown(Button, Shift, X, Y);
end;

procedure TSmartCheckBox.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if key = 32 then
    checked:=not checked;
  inherited KeyDown(Key,Shift);
end;

procedure TSmartCheckBox.DoEnter;
begin
  paint;
  inherited DoEnter;
end;

procedure TSmartCheckBox.DoExit;
begin
  paint;
  inherited DoExit;
end;

end.