crear un tcheckbox con un skin
 

SALUDOS

resulta ser que desde hace algun tiempo estoy programando componentes basandome en los estandars para aplicarles una especie de skin, la cual es simple practicamente, consiste en pintar mi propio estilo usando el canvas de los mismos, hace ya unos dias se me presentaron dudas para conformar mi nuevo TButton y las hice publicas aqui en los foros, el problema con el TButton ya fue resuelto, pero ahora se me presenta un problema similar con el TCheckbox, sucede que cuando doy click o presiono barra espaciadora sobre el nuevo componente con "skin" para cambiar su estado de chequeo se pinta como es normalmente y luego se efectuan los cambios sobre el canvas del mismo para "skinearlo" a mi manera, esto provoca un efecto algo desagradable como si fuera un parpadeo, quisiera que alguien me ayude a solucionar esto porque hasta el momento no hallo solucion alguna, posteriormente muestro la implementación de lo que he hecho hasta ahora, ojalá me puedan ayudar:

Código Delphi [-]

type
  TXCheckBox = class (TCheckBox)
  private
  protected
    procedure CMDrawItem(var Message: TWMDrawItem); message WM_PAINT;
    procedure SetChecked(Value: Boolean); override;
    procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
    procedure Click; override;
    procedure Toggle; override;
    procedure CreateParams(var Param: TCreateParams); override;
  public
    constructor Create(aOwner: TComponent); override;
end;
 
implementation

  constructor TXCheckBox.Create(aOwner: TComponent);
  begin
    inherited;
  end;
  procedure TXCheckBox.CreateParams(var Param: TCreateParams);
  begin
    inherited;
    Param.Style := Param.Style or BS_OWNERDRAW;
  end;
    procedure TXCheckBox.Toggle;
    begin
      inherited;
      invalidate;
    end;
    procedure TXCheckBox.Click;
    begin
      inherited;
      invalidate;
    end;
    procedure TXCheckBox.CNCommand(var Message: TWMCommand);
    begin
      inherited;
      invalidate;
    end;

  procedure TXCheckBox.SetChecked(Value: Boolean);
  begin
    inherited;
    Invalidate;
  end;
  procedure TXCheckBox.CMDrawItem(var Message: TWMDrawItem);
  var
    DC: TCanvas;
    a: TPaintStruct;
  begin
    BeginPaint(Handle, a);
    DC := TCanvas.Create;
    DC.Handle := GetDc(Handle);
    DC.Brush.Style := bsSolid;
    DC.Brush.Color := clGray;
    DC.RoundRect(2,2,13,13, 3,3);
    DC.Brush.Style := bsClear;
    if Checked then
      DC.TextOut(5,0, 'x');
    EndPaint(Handle, a);
  end;
end.

bueno, a esto le falta un mundo aún, solo quiero solucionar el problema del parpadeo por el momento.


mil gracias de antemano colegas
saludos!! :cool:
aeff!!

hola, espero que me puedan ayudar en esto colegas, en verdad aún no doy con la solución, al menos me pueden dar una idea, no se, usar otra clase para heredar?????!! qué me pueden decir????!, se los voy a agradecer enormemente hermanos.

mil gracias de antemano,
saludos!
aeff!

Vale, según veo estás de suerte ;). La clase TCheckBox sólo publica las propiedades, no implementa nada.

Según "las normas de creación de componentes", la clase TCustomCheckBox es la correcta para heredar de ella.

Fíjate en TcustomCheckbox y TCheckBox, lo mismo debes hacer tú.

El TXCustomCheckBox es el que implementa todas las características y después TXCheckBox sería quien publica las propiedades en el inspector de objetos. De esta forma podrías incluir nuevas propiedades en el inspector de objeto e incluso ocultar algunas que tiene TCheckBox y que tú no quieras.

Me parece que el parpadeo viene porque usas

Código Delphi [-]
procedure CMDrawItem(var Message: TWMDrawItem); message WM_PAINT;

cuando veo que TWincontrol lo implementa así:

Código Delphi [-]
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;

No me cuadra que tú uses el mensaje TWMDrawItem y Borland use TWMPaint :confused:

Por otro lado, creo que aquí tienes algo más:

Código Delphi [-]
procedure TCustomCheckBox.SetState(Value: TCheckBoxState);
begin
  if FState <> Value then
  begin
    FState := Value;
    if HandleAllocated then
      SendMessage(Handle, BM_SETCHECK, Integer(FState), 0);
    if not ClicksDisabled then Click;
  end;
end;

Cuando le das un clic al checkbox tuyo, primero se ejecuta ese código, que hará que se pinte al completo y supongo que después se ejecutará tu método Paint, de ahí el parpadeo.

SetState no lo puedes modificar porque es un método estático, pero CreateWnd y CreateParams sí lo puedes sobreescribir.

Creo que por ahí van los tiros, aunque habría que mirarlo mejor.

Saludos

bueno, tengo una propuesta para que me la rectifiquen, es una prueba mi objetivo era eliminar el parpadeo, de la forma siguiente ya no ocurre pero necesito saber si esta forma es optimizada o no es conveniente,

Código Delphi [-]
type
  TXCustomCheckBox = class (TCustomCheckBox)
  protected
    st: Integer;
    procedure CreateParams(var Param: TCreateParams);
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure BMSetChecked(var Message: TMessage); message BM_SETCHECK;
    procedure BMSetState(var Msg: Tmessage); message BM_SETSTATE;
  public
    constructor Create(aOwner: TComponent); override;

  end;

implementation

  constructor TXCustomCheckBox.Create(aOwner: TComponent);
  begin
    inherited;
  end;

  procedure TXCustomCheckBox.BMSetState(var Msg: Tmessage);
  begin
    Inherited;
    Invalidate;
  end;

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

  procedure TXCustomCheckBox.BMSetChecked(var Message: TMessage);
  begin
    inherited;
    Invalidate;
    st := Message.WParam;
  end;

  procedure TXCustomCheckBox.WMPaint(var Message: TWMPaint);
  var
    Canvas: TCanvas;
    vPaint: TPaintStruct;
  begin
    BeginPaint(Handle, vPaint);
    Canvas := TCanvas.Create;
    Canvas.Handle := GetDc(Handle);
    Canvas.FillRect(Canvas.ClipRect);
    case st of
      0:Canvas.TextOut(1,1,'a');
      1:Canvas.TextOut(1,1,'b');
    end;
    EndPaint(Handle, vPaint);
  end;

espero que me den sus criterios colegas, mil gracias de antemano,

saludos!
aeff!

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 :D, ¿no tiene la opción Grayed?? (el estado intermedio entre check y uncheck).

Saludos

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

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!

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