Crear un TButton con un skin

[aeff]

saludos, quisiera que me ayudaran a crear un componente heredado del TButton y que se le pueda aplicar un skin, bueno, hasta el momento este skin consiste en rellenar la region del control con un color y pintar un simple rectángulo sobre esa region, para lo cual obtengo el HDC del objeto y se lo asigno al Handle de un objeto TCanvas dentro del nuevo componente, lo que ocurre es que cuando puslo el nuevo TButton ya no se repinta más, ¿por qué será?, ¿me pueden dar una ayuda con esto?

aqui les va el código que he implementado hasta el momento:

Código Delphi [-]
type
 TXButton = class (TButton)
    protected
      FLastWndProc: TWndMethod;
      procedure NewWndProc(var Message: TMessage);
    public
      Canvas: TCanvas;
      constructor Create(aOwner: TComponent); override;
      procedure Click; override;
  end;
 
(...)
 
  constructor TXButton.Create(aOwner: TComponent);
  begin
    Inherited;
    Canvas := TCanvas.Create;
    FLastWndProc := WindowProc;
    WindowProc := NewWndProc;
  end;
  procedure TXButton.Click;
  begin
    inherited;
  end;
  procedure TXButton.NewWndProc(var Message: TMessage);
  var
    DC: HDC;
    vPaintStruct: TPaintStruct;
    procedure Draw();
    begin
      Canvas.Handle := DC;
      Canvas.Brush.Color := RGB(25, 190, 240);
      Canvas.FillRect(Canvas.ClipRect);
      Canvas.Rectangle(5,5, 25 , 15);
    end;
  begin
    case  Message.Msg of
      WM_PAINT:
        begin
          DC := BeginPaint(Handle, vPaintStruct);
          Draw();
          EndPaint(Handle, vPaintStruct);
        end;
       WM_LBUTTONDOWN: begin DRaw(); FLastWndProc(Message); DRaw();end;
       WM_LBUTTONUP: begin DRaw();FLastWndProc(Message); DRaw();end;
       WM_MOUSEMOVE: begin DRaw(); FLastWndProc(Message);DRaw(); end;
       CM_MOUSELEAVE: begin DRaw(); FLastWndProc(Message); DRaw(); end;
       else     FLastWndProc(Message);
    end;
  end;

aqui está como yo creo el objeto en tiempo de ejecución, en el evento OnClick de un button:

Código Delphi [-]
procedure TForm1.Button1Click(Sender: TObject);
begin
  //
    aBtn :=TXButton.Create(Self);
    aBtn.Parent := self;
    aBtn.Left := 50;
    aBtn.Top:=50;
end;

muchas gracias de antemano, espero recivir ayuda !
saludos!

aeff!

[roman]

Revisa este artículo de Zarko Gajic, así como el código fuente que pone ahí. Yo creo que eso te puede ayudar a resolver tu duda.

// Saludos

[aeff]

saludos roman,

hermano sucede que por algunas cuestiones y problemas de mi país de origen no gozo de privilegios para alcanzar el enlace que me recomiendas, por favor, me podrian dar ayuda públicamente en este foro, no se, si no es mucho pedir que publiques parte de este artículo, al menos lo escencial en este foro,

muchas garcias compadre,

saludos!
aeff!

[roman]

Bueno, siendo que Zarco Gajic lo publica para todo mundo, espero no hacer mal en replicar aquí su código:

Código Delphi [-]
{
Article: 

TColorButton - button with color properties 

http://delphi.about.com/library/weekly/aa061104a.htm

Full source code of the TColorButton Delphi component, 
an extension to the standard TButton control, with font 
color, background color and mouse over color properties.


Download the ZIPed source.
}

ColorButton.pas



unit ColorButton;

{
Article:

TColorButton - button with Color properties

http://delphi.about.com/library/weekly/aa061104a.htm

Full source code of the TColorButton Delphi component,
an extension to the standard TButton control,
with font color, background color and mouse over color properties.

}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, StdCtrls, Buttons, ExtCtrls;

type
  TColorButton = class(TButton)
  private
    FBackBeforeHoverColor: TColor;
  private
    FCanvas: TCanvas;
    IsFocused: Boolean;
    FBackColor: TColor;
    FForeColor: TColor;
    FHoverColor: TColor;
    procedure SetBackColor(const Value: TColor);
    procedure SetForeColor(const Value: TColor);
    procedure SetHoverColor(const Value: TColor);

    property BackBeforeHoverColor : TColor read FBackBeforeHoverColor write FBackBeforeHoverColor;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure WndProc(var Message : TMessage); override;

    procedure SetButtonStyle(Value: Boolean); override;
    procedure DrawButton(Rect: TRect; State: UINT);

    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM;
    procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property BackColor: TColor read FBackColor write SetBackColor default clBtnFace;
    property ForeColor: TColor read FForeColor write SetForeColor default clBtnText;
    property HoverColor: TColor read FHoverColor write SetHoverColor default clBtnFace;
  end;

procedure Register;

implementation

constructor TColorButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCanvas := TCanvas.Create;
  BackColor := clBtnFace;
  ForeColor := clBtnText;
  HoverColor := clBtnFace;
end; (*Create*)

destructor TColorButton.Destroy;
begin
  FCanvas.Free;
  inherited Destroy;
end; (*Destroy*)

procedure TColorButton.WndProc(var Message : TMessage);
begin
  if (Message.Msg = CM_MOUSELEAVE) then
  begin
    BackColor := BackBeforeHoverColor;
    invalidate;
  end;
  if (Message.Msg = CM_MOUSEENTER) then
  begin
    BackBeforeHoverColor := BackColor;
    BackColor := HoverColor;
    invalidate;
  end;

  inherited;
end; (*WndProc*)

procedure TColorButton.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do 
    Style := Style or BS_OWNERDRAW;
end; (*CreateParams*)

procedure TColorButton.SetButtonStyle(Value: Boolean);
begin
  if Value <> IsFocused then
  begin
    IsFocused := Value;
    Invalidate;
  end;
end; (*SetButtonStyle*)

procedure TColorButton.CNMeasureItem(var Message: TWMMeasureItem);
begin
  with Message.MeasureItemStruct^ do
  begin
    itemWidth  := Width; 
    itemHeight := Height; 
  end; 
end; (*CNMeasureItem*)

procedure TColorButton.CNDrawItem(var Message: TWMDrawItem);
var 
  SaveIndex: Integer;
begin 
  with Message.DrawItemStruct^ do 
  begin 
    SaveIndex := SaveDC(hDC); 
    FCanvas.Lock; 
    try 
      FCanvas.Handle := hDC; 
      FCanvas.Font := Font; 
      FCanvas.Brush := Brush; 
      DrawButton(rcItem, itemState);
    finally
      FCanvas.Handle := 0;
      FCanvas.Unlock; 
      RestoreDC(hDC, SaveIndex); 
    end;
  end; 
  Message.Result := 1; 
end; (*CNDrawItem*)

procedure TColorButton.CMEnabledChanged(var Message: TMessage);
begin 
  inherited; 
  Invalidate;
end; (*CMEnabledChanged*)

procedure TColorButton.CMFontChanged(var Message: TMessage);
begin
  inherited;
  Invalidate;
end; (*CMFontChanged*)


procedure TColorButton.SetBackColor(const Value: TColor);
begin
  if FBackColor <> Value then 
  begin
    FBackColor:= Value;
    Invalidate;
  end;
end; (*SetButtonColor*)

procedure TColorButton.SetForeColor(const Value: TColor);
begin
  if FForeColor <> Value then 
  begin
    FForeColor:= Value;
    Invalidate;
  end;
end; (*SetForeColor*)

procedure TColorButton.SetHoverColor(const Value: TColor);
begin
  if FHoverColor <> Value then 
  begin
    FHoverColor:= Value;
    Invalidate;
  end;
end; (*SetHoverColor*)

procedure TColorButton.DrawButton(Rect: TRect; State: UINT);
var
  Flags, OldMode: Longint;
  IsDown, IsDefault, IsDisabled: Boolean;
  OldColor: TColor;
  OrgRect: TRect;
begin
  OrgRect := Rect;
  Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
  IsDown := State and ODS_SELECTED <> 0;
  IsDisabled := State and ODS_DISABLED <> 0;
  IsDefault := State and ODS_FOCUS <> 0;

  if IsDown then Flags := Flags or DFCS_PUSHED;
  if IsDisabled then Flags := Flags or DFCS_INACTIVE;

  if (IsFocused or IsDefault) then 
  begin 
    FCanvas.Pen.Color := clWindowFrame; 
    FCanvas.Pen.Width := 1; 
    FCanvas.Brush.Style := bsClear; 
    FCanvas.Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom); 
    InflateRect(Rect, - 1, - 1); 
  end; 

  if IsDown then 
  begin
    FCanvas.Pen.Color := clBtnShadow;
    FCanvas.Pen.Width := 1; 
    FCanvas.Brush.Color := clBtnFace; 
    FCanvas.Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom); 
    InflateRect(Rect, - 1, - 1); 
  end 
  else
  begin 
    DrawFrameControl(FCanvas.Handle, Rect, DFC_BUTTON, Flags);
  end; 

  if IsDown then OffsetRect(Rect, 1, 1); 

  OldColor := FCanvas.Brush.Color;
  FCanvas.Brush.Color := BackColor;
  FCanvas.FillRect(Rect); 
  FCanvas.Brush.Color := OldColor;
  OldMode := SetBkMode(FCanvas.Handle, TRANSPARENT); 
  FCanvas.Font.Color := ForeColor;
  if IsDisabled then
    DrawState(FCanvas.Handle, FCanvas.Brush.Handle, nil, Integer(Caption), 0, 
    ((Rect.Right - Rect.Left) - FCanvas.TextWidth(Caption)) div 2, 
    ((Rect.Bottom - Rect.Top) - FCanvas.TextHeight(Caption)) div 2, 
      0, 0, DST_TEXT or DSS_DISABLED) 
  else 
    DrawText(FCanvas.Handle, PChar(Caption), - 1, Rect, 
      DT_SINGLELINE or DT_CENTER or DT_VCENTER);
       
  SetBkMode(FCanvas.Handle, OldMode); 

  if (IsFocused and IsDefault) then
  begin
    Rect := OrgRect;
    InflateRect(Rect, - 4, - 4);
    FCanvas.Pen.Color := clWindowFrame;
    FCanvas.Brush.Color := clBtnFace;
    DrawFocusRect(FCanvas.Handle, Rect);
  end;
end; (*DrawButton*)

procedure Register;
begin
  RegisterComponents('delphi.about.com', [TColorButton]);
end;

end.



{
********************************************
Zarko Gajic
About.com Guide to Delphi Programming
http://delphi.about.com
email: delphi.guide@about.com
free newsletter: http://delphi.about.com/library/blnewsletter.htm
forum: http://forums.about.com/ab-delphi/start/
********************************************
}

Comienza fijándote en el método CreateParams, en donde "le dice" a Windows que él se encargará de todo el dibujado del botón.

// Saludos

[aeff]

exactamente me haz dado la ayuda que necesitaba roman, mil gracias hermano, pensé que me faltaban cosas por hacer, sobre todo lo implementado en el método CreateParams, ahora me doy cuenta por que no me funcionaba correctamente mi versión.

** en realidad a veces pienso que en este foro hay muchos que programan desde que estaban en la barriga de sus madres, tanto conocimientos no se obtiene de la noche a la mañana **

muchas gracias nuevamente, espero volver a necesitar de tu experiencia colega.
saludos!
aeff!

[Neftali [Germán.Estévez]]

También en el blog de Carlos García Trujillo, en una de sus primeras entradas había un interesante artículo sobre skins. A ver si tienes acceso a esa página.

[roman]

Empezado por aeff

a veces pienso que en este foro hay muchos que programan desde que estaban en la barriga de sus madres, tanto conocimientos no se obtiene de la noche a la mañana

En efecto, felizmente hay mucha gente así en los foros. Y también fuera de ellos, como es el caso de Zarco Gajic, de quien yo me limité a copiar y pegar aquí su código

// Saludos

[aeff]

Neftali, acabo de probar si alcanzo el vínculo que me recomiendas y los resultados han sido negativos, no tengo acceso hasta allá, me hubiera gustado lograr visitar miles de sitios que en estos foros se mencionan que son tremenda fuente bibliográfica sobre programación como de seguro este que me mencionas, espero que con ustedes las dudas que me surjan puedan ser erradicadas, sin más, nuevamente, mil gracias compañeros, ustedes son quien yo aspiro llegar a ser, algún día debo programar al rigor que ustedes son capaces de programar,

muchas gracias!
saludos!
aeff!

[aeff]

saludos!

como muestra de mi agradecimiento quisiera regalarles el nuevo TButton con skin para que lo usen y hagan con este lo que deseen:

Código Delphi [-]
type
  TXButton = class(TButton)
    protected
      FFillColor,
      FHoverColor,
      FNormalColor,
      FLineColor,
      FFocusedLineColor,
      FTextColorNormal,
      FTextColorFocused: TColor;
      FFocused: Boolean;
      procedure CreateParams(var Param: TCreateParams); override;
      procedure WndProc(var Message: TMessage); override;
      procedure SetButtonStyle(Value: Boolean); override;
      procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
      procedure CMFontChange(var Message: TMessage); message CM_FONTCHANGE;
      procedure Click; override;
      procedure DrawButtonSkin();
    public
      Canvas: TCanvas;
      constructor Create(aOwner: TComponent); override;
    published
      property  HoverColor: TColor read FHoverColor write FHoverColor;
      property  NormalColor: TColor read FNormalColor write FNormalColor;
      property  LineColor: TColor read FLineColor write FLineColor;
      property  FocusedLineColor: TColor read FFocusedLineColor write FFocusedLineColor;
      property  TextColorNormal: TColor read FTextColorNormal write FTextColorNormal;
      property  TextColorFocus: TColor read FTextColorFocused write FTextColorFocused;
  end;

implementation

  constructor TXButton.Create(aOwner: TComponent);
  begin
    inherited;
    Canvas := TCanvas.Create;
    FFillColor := clGray;
    FHoverColor := clSilver;
    FNormalColor := clGray;
    FLineColor := clBlack;
    FFocusedLineColor := $004BD1F3;
    FTextColorNormal := clWindowText;
    FTextColorFocused := $000FC4E3;
    Font.Name := 'Tahoma';
  end;

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

  procedure TXButton.WndProc(var Message: TMessage);
  var
    aP: TPaintStruct;
  begin
    case Message.Msg of
      CM_MOUSELEAVE: begin FFillColor := FNormalColor;  Invalidate; end;
      CM_MOUSEENTER: begin FFillColor := FHoverColor;   Invalidate; end;
    end;

    inherited;
  end;

  procedure TXButton.SetButtonStyle(Value: Boolean);
  begin
    FFocused := Value;
    if Value then
      Invalidate;
  end;

  procedure TXButton.CNDrawItem(var Message: TWMDrawItem);
  var
    SaveIndex: Integer;
  begin
    with Message.DrawItemStruct^ do
    begin
      SaveIndex := SaveDC(hDC);
      Canvas.Lock;
      try
        Canvas.Handle := hDC;
        Canvas.Font := Font;
        Canvas.Brush := Brush;
        DrawButtonSkin();
      finally
        Canvas.Handle := 0;
        Canvas.Unlock;
        RestoreDC(hDC, SaveIndex);
      end;
    end;
    Message.Result := 1;
  end;

  procedure TXButton.CMFontChange(var Message: TMessage);
  begin
    Invalidate;
    Inherited;
  end;

  procedure TXButton.Click;
  begin
    inherited;
    FFillColor := FHoverColor;
    Invalidate;
    Application.ProcessMessages;
    Sleep(70);
    Application.ProcessMessages;
    FFillColor := FNormalColor;
    Invalidate;
  end;

  procedure TXButton.DrawButtonSkin();
  var
    tX, tY, lColor: Integer;
  begin
    {Asignando el valores del canvas normal}

    Canvas.Font.Name := Font.Name;
    Canvas.Font.Style := Font.Style;    

    {Pintado el estilo}
    Canvas.Brush.Color := FFillColor;
    Canvas.FillRect(Canvas.ClipRect);
    case FFocused of
      false:  begin
                Canvas.Font.Color := FTextColorNormal;
                Canvas.Pen.Color := FLineColor;
              end;
      true:   begin
                Canvas.Font.Color := FTextColorFocused;
                Canvas.Pen.Color := FFocusedLineColor;
              end;
    end;
    Canvas.Rectangle(1,1, Width -1, Height -1);
    if not FFocused then Canvas.DrawFocusRect(Rect(1,1,Width -1, Height -1)); 
    lColor := Canvas.Brush.Color;
    Canvas.Pen.Color := FFillColor + $0A0A0A;
    Canvas.Brush.Color := FFillColor + $0A0A0A;

    {brillo}
    Canvas.Rectangle(3,3, Width -3, Height div 2);

    {bajo brillo oscuro}
    Canvas.Pen.Color := FFillColor - $050505;
    Canvas.Brush.Color := FFillColor - $050505;
    Canvas.Rectangle(3, Height div 2, Width -3, Height div 2 + 2);

    Canvas.Pen.Color := FFillColor - $020202;
    Canvas.Brush.Color := FFillColor - $020202;
    Canvas.Rectangle(3, Height div 2 + 2, Width -3, Height div 2 + 2 + 2);

    Canvas.Brush.Style := bsClear;
    tX := (Width div 2) - (Canvas.TextWidth(Caption) div 2);
    tY := (Height div 2) - (Canvas.TextHeight(Caption) div 2);
    Canvas.TextOut(tX, tY, Caption);
  end;

entonces, por si desean hacer una prueba rápida, les muestro como los creo hasta el momento, en el evento OnCreate de la Form:

Código Delphi [-]
procedure TfrmMain.FormCreate(Sender: TObject);
var
  oBtn: TXButton;
begin
  //
  oBtn := TXButton.Create(Self);
  oBtn.Parent := self;
  oBtn.Left := 100;
  oBtn.Top := 50;
  oBtn.Caption := 'XButton1';
  oBtn.Caption := 'A.E.F.F';

  oBtn := TXButton.Create(Self);
  oBtn.Parent := self;
  oBtn.Left := 100;
  oBtn.Top := 80;
  oBtn.Caption := 'XButton1';
  oBtn.Caption := 'M.M.L.R';
  oBtn.Font.Style := [fsBold];

  oBtn := TXButton.Create(Self);
  oBtn.Parent := self;
  oBtn.Left := 100;
  oBtn.Top := 110;
  oBtn.Caption := 'XButton1';
  oBtn.Caption := 'C.E.F.D';
  oBtn.Cursor := crHandPoint;
  Screen.Cursors[crHandPoint] := LoadCursorFromFile('C:\WINDOWS\Cursores\dinosau2.ani');

end;

bueno, saludos!
hasta pronto!
aeff!

[aeff]

claro, faltan detalles, pero aún le estoy dando vuelta al asunto!, por ejemplo, cuando se cambie el valor de algunos de los colores de estilo hay que repintar el objeto, ¿no creen?

aeff!