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;
FBoxShineColor := $616161;
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;
Canvas.Brush.Color := FColorBKG;
Canvas.FillRect(Canvas.ClipRect);
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);
if FFocused then Canvas.DrawFocusRect(Rect(20, 2, Width - 2, Height -2));
Canvas.Brush.Style := bsClear;
Canvas.Font.Color := FTextShadowColor;
Canvas.TextOut(26, 4, FCaption);
Canvas.Font.Color := Font.Color;
Canvas.TextOut(25, 3, Caption);
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