crear un tcheckbox con un skin

[[Lepe]]

Wow!! no sólo has tomado la idea sino que además lo has mejorado.

Sólo te falta el "override" en CreateParams, el compilador te avisará de todas formas .

En principio no veo nada más, bueno sí, para ser un poco tikis-mikis , ¿no tiene la opción Grayed?? (el estado intermedio entre check y uncheck).

Saludos

[aeff]

precisamente creo que ahora me está dando bateo la implementación de esta opción, o mejor dicho, como no la he implementado aún por no saber como las cosas me están saliendo complicadas, lo que sucede es que si coloco mi opción Checked en true en tiempo de diseño y luego intento desmarcarlo en tiempo de ejecución no funciona, mira a ver si me puedes dar una mano colega:

Código Delphi [-]
type
  TXCustomCheckBox = class (TCustomCheckBox)
  protected
    Canvas: TCanvas;
    FColorBKG,
    FLineColor,
    FLineFocusedColor,
    FBoxColorBKG,
    FBoxShineColor,
    FBoxCheckColor,
    FBoxCheckShadow,
    FTextShadowColor: TColor;
    FChecked,
    FFocused,
    FAutoSize: Boolean;
    FCaption: string;
    procedure CreateParams(var Param: TCreateParams); override;
    procedure CMSize(var Message: TMessage); message WM_SIZE;
    procedure CMEnter(var Message: TMessage); message CM_ENTER;
    procedure CMExit(var Message: TMessage); message CM_EXIT;
    procedure BMSetState(var Message: TMessage); message BM_SETSTATE;
    procedure BMSetChecked(var Message: TMessage); message BM_SETCHECK;
    procedure SetChecked(Value: Boolean);
    procedure SetCaption(Value: string);
    procedure SetAutoSize(Value: Boolean);
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  public
    constructor Create(aOwner: TComponent); override;
  published
    property Checked: Boolean read FChecked write SetChecked;
    property Caption: string read FCaption write SetCaption;
    property Autosize: Boolean read FAutoSize write SetAutoSize;
  end;

implementation

  constructor TXCustomCheckBox.Create(aOwner: TComponent);
  begin
    inherited;
    Height := 19;
    Font.Color := clGray;
    Font.Name := 'Tahoma';
    Font.Style := [fsBold];
    Canvas := TCanvas.Create;
    Canvas.Font.Color := clGray;
    Canvas.Font.Name := 'Tahoma';
    Canvas.Font.Style := [fsBold];
    FAutoSize := true;

    FColorBKG := $003B3B3B;
    FLineColor := clGray - $2E2E2E;
    FLineFocusedColor := RGB(243, 209, 75);
    FBoxColorBKG := $2C2C2C;   {44}
    FBoxShineColor := $616161; {97}
    FBoxCheckColor := clWhite;
    FBoxCheckShadow := clGray - $3F3F3F;
    FTextShadowColor := clGray - $3F3F3F;
  end;

  procedure TXCustomCheckBox.CreateParams(var Param: TCreateParams);
  begin
    inherited;
    Param.Style := Param.Style or BS_OWNERDRAW or BS_CHECKBOX;
  end;

  procedure TXCustomCheckBox.CMSize(var Message: TMessage);
  begin
    inherited;
    SetWindowRgn(Handle, CreateRoundRectRgn(0,0, Width + 1,Height +1, 2, 2), true);    
  end;

  procedure TXCustomCheckBox.CMEnter(var Message: TMessage);
  begin
    inherited;
    FFocused := true;
    Invalidate;
  end;

  procedure TXCustomCheckBox.CMExit(var Message: TMessage);
  begin
    inherited;
    FFocused := false;
    Invalidate;
  end;

  procedure TXCustomCheckBox.BMSetState(var Message: TMessage);
  begin
    inherited;
    Invalidate;
  end;

  procedure TXCustomCheckBox.BMSetChecked(var Message: TMessage);
  begin
    inherited;
    case Message.WParam of
      BST_CHECKED:   FChecked := true;
      BST_UNCHECKED: FChecked := false;
    end;
    Invalidate;
  end;

  procedure TXCustomCheckBox.SetChecked(Value: Boolean);
  begin
    case Value of
      true:  SendMessage(Handle, BM_SETCHECK, BST_CHECKED, 0);
      false: SendMessage(Handle, BM_SETCHECK, BST_UNCHECKED, 0);
    end;

  end;

  procedure TXCustomCheckBox.SetCaption(Value: string);
  begin
    if FCaption <> Value then
      begin
        FCaption := Value;
        Invalidate;
      end;
  end;

  procedure TXCustomCheckBox.SetAutoSize(Value: Boolean);
  begin
    if FAutoSize <> Value then
      begin
        FAutoSize := Value;
        if FAutoSize then Invalidate;
      end;
  end;

  procedure TXCustomCheckBox.WMPaint(var Message: TWMPaint);
  var
    vNewWidth: Integer;
    vPaint: TPaintStruct;
    procedure SetSolidColor(aColor: TColor);
    begin
      Canvas.Pen.Color := aColor;
      Canvas.Brush.Color := aColor;
    end;
  begin

    BeginPaint(Handle, vPaint);
    Canvas.Handle := GetDc(Handle);
    
    if FAutoSize = true then
      begin
        vNewWidth := 25 + Canvas.TextWidth(FCaption) + 5;
        if vNewWidth <> Width then  Width := 25 + Canvas.TextWidth(FCaption) + 5;
      end;

    {BackGround}
    Canvas.Brush.Color := FColorBKG;
    Canvas.FillRect(Canvas.ClipRect);

    {Box}
    Canvas.Brush.Color := FBoxColorBKG;
    case FFocused of
      false:  Canvas.Pen.Color := FLineColor;
      true:   Canvas.Pen.Color := FLineFocusedColor;
    end;  
    Canvas.RoundRect(2, 2, 17, 17, 2,2);
    SetSolidColor(FBoxShineColor);
    Canvas.Rectangle(3, 3, 16, 9);

    {Focus rectangle}
    if FFocused then Canvas.DrawFocusRect(Rect(20, 2, Width - 2, Height -2));
    Canvas.Brush.Style := bsClear;

    {Caption}
    Canvas.Font.Color := FTextShadowColor;    
    Canvas.TextOut(26, 4, FCaption);
    Canvas.Font.Color := Font.Color;
    Canvas.TextOut(25, 3, Caption);

    {Check State}
    if FChecked then
      begin
        Canvas.Font.Style := [fsBold];
        Canvas.Font.Name := 'Tahoma';
        Canvas.Font.Color := FBoxCheckShadow;        Canvas.TextOut(7,3, 'x');
        Canvas.Font.Color := FBoxCheckColor;         Canvas.TextOut(6,2, 'x');        
      end;

    EndPaint(Handle, vPaint);
  end;

y para que no tengas que gastar tiempo prueba con lo siguiente para que crees uno y me diga como solucionar el problema, se puedes claro está hermano:

Código Delphi [-]
procedure TfrmMain.Button1Click(Sender: TObject);
var
  vXCheckBox: TXCustomCheckBox;
begin
  vXCheckBox := TXCustomCheckBox.Create(Self);
  vXCheckBox.Parent := Self;
  vXCheckBox.Left := 40;
  vXCheckBox.Top := 300;
  vXCheckBox.Caption := '« A.E.F.F. »';
  vXCheckBox.Checked := true;
end;

*** aún me falta por implementar opciones para cambiar los colores del estilo, pero primero lo primero***

1000 gracias de antemano,
saludos!
aeff1

[aeff]

espera! espera!, el problema del que te hablé lo acabo de erradicar, mira me parece que como la TButtonControl tiene un método SetChecked y una property Checked ya, parece que lo que yo estaba jodiendo las cosas, lo que hice ahora fue lo siguiente:

Código Delphi [-]
type
  TXCustomCheckBox = class (TCustomCheckBox)
  protected
    Canvas: TCanvas;
    FColorBKG,
    FLineColor,
    FLineFocusedColor,
    FBoxColorBKG,
    FBoxShineColor,
    FBoxCheckColor,
    FBoxCheckShadow,
    FTextShadowColor: TColor;
    FChecked,
    FFocused,
    FAutoSize: Boolean;
    FCaption: string;
    procedure CreateParams(var Param: TCreateParams); override;
    procedure CMSize(var Message: TMessage); message WM_SIZE;
    procedure CMEnter(var Message: TMessage); message CM_ENTER;
    procedure CMExit(var Message: TMessage); message CM_EXIT;
    procedure BMSetState(var Message: TMessage); message BM_SETSTATE;
    procedure BMSetChecked(var Message: TMessage); message BM_SETCHECK;
    procedure SetCaption(Value: string);
    procedure SetAutoSize(Value: Boolean);
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  public
    constructor Create(aOwner: TComponent); override;
  published
    property Caption: string read FCaption write SetCaption;
    property Autosize: Boolean read FAutoSize write SetAutoSize;
    property Checked;    
  end;

...

y además eliminar el método SetChecked de la implementación,

pero ahora, como puedo hacer algo para la opción Grayed, ??? alguna idea??

2000 gracias de antemano colegas!
saludos!
aeff!

[[Lepe]]

Haz published la propiedad AllowGrayed (igual que Checked) y en el wm_paint ten en cuenta que puede tener 3 valores.

Código Delphi [-]
    if Checked = cbGrayed then // corregido, tenía un error
    begin
       pues eso, como quieras pintarlo
    end
    else Checked= cbChecked then
    begin
        Canvas.Font.Style := [fsBold];
        Canvas.Font.Name := 'Tahoma';
        Canvas.Font.Color := FBoxCheckShadow;        Canvas.TextOut(7,3, 'x');
        Canvas.Font.Color := FBoxCheckColor;         Canvas.TextOut(6,2, 'x');        
      end;

El truco parece estar al tiempo de "crear" El tcheckbox:

Código Delphi [-]
procedure TCustomCheckBox.CreateWnd;
begin
  inherited CreateWnd;
  SendMessage(Handle, BM_SETCHECK, Integer(FState), 0);
end;

Fstate puede tener los valores TCheckBoxState = (cbUnchecked, cbChecked, cbGrayed);

cuando dice Integer(Fstate), está cogiendo el primer valor que es cero, es decir, cbUnchecked.

En el procedimiento Toggle, es donde se usa AllowGrayed:

Código Delphi [-]
procedure TCustomCheckBox.Toggle;
begin
  case State of
    cbUnchecked:
      if AllowGrayed then State := cbGrayed else State := cbChecked;
    cbChecked: State := cbUnchecked;
    cbGrayed: State := cbChecked;
  end;
end;

Si está Unchecked y permite tener 3 estados, se pone a cbGrayed.

Saludos