Ver Mensaje Individual
  #6  
Antiguo 23-11-2008
Avatar de aeff
aeff aeff is offline
Miembro
 
Registrado: oct 2006
Ubicación: Cuba, Guantánamo
Posts: 348
Reputación: 18
aeff Va camino a la fama
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
Responder Con Cita