Ayuda con PageControl y TabSheet

[rruffino]

Hola amigos del foro, los molesto porque tengo el siguiente inconveniente:
Mi aplicación tiene una pagecontrol con varias paletas (tabsheet). Lo que quiero hacer y no puedo, es que al hacer click en una de las paletas se me ponga en negrita o incluso cambiar el color de la fuente del Caption de dicha paleta, sin que me modifique nada más. La verdad he probado un par de cosas y no hallo resultados. Desde ya muchas gracias y espero de vuestra ayuda
Saludos, Román

[dec]

Hola,

Conste que no es respuesta, pero, si usaras cierto "TPageControl" que puedes encontrar en la Jedi Library (en la pestaña JVCL Globus 2) hallarías que puedes hacer lo que precisas y mucho más. Si no quisieras utilizarlo tal vez podrías estudiarlo, por ver si puedes implementar el asunto en un "TPageControl" como el que trae Delphi.

[roman]

Si pones la propiedad OwnerDraw del PageControl en true y pones el siguiente código en su evento OnDrawTab:

Código Delphi [-]
procedure TForm1.PageControl1DrawTab(
  Control: TCustomTabControl;
  TabIndex: Integer; const Rect: TRect; Active: Boolean);
var
  R: TRect;
  Texto: String;

begin
  if Active then
  begin
    Control.Canvas.Font.Color := clRed;
    Control.Canvas.Font.Style := [fsBold];
  end;

  Texto := PageControl1.Pages[TabIndex].Caption;

  R := Rect;
  Control.Canvas.FillRect(R);

  if not Active then
    InflateRect(R, 0, -3);

  DrawText(
    Control.Canvas.Handle, PChar(Texto), -1, R,
    DT_SINGLELINE or DT_CENTER or DT_VCENTER);
end;

lograrás que la pestaña activa tenga su rótulo de color rojo en negritas. Pienso que algo así es lo que quieres.

// Saludos

[rruffino]

Roman, era eso exactamente lo que buscaba, gracias!!!

[Migpal]

Pense que era más dificil, Gracias ROMAN.

[Deiv]

Hola,

Empezado por Roman

Si pones la propiedad OwnerDraw del PageControl en true y pones el siguiente código en su evento OnDrawTab:

Buscando en el Foro encontré este hilo, y hace tiempo me preguntaba con algo relacionado al tema:

¿Como cambiar el color predeterminado que tiene la propiedad HotTrack a un rojo por ejemplo?
Deiv

[Deiv]

Hola Yo de nuevo,
He buscado en la Red y he encontrado esta dirección:
http://delphi.about.com/cs/adptips20...ltip0800_2.htm
El código funciona bien para un CheckBox, Label, StaticText, pero no así en un TButton, TTabSheet, donde apunto mi pregunta, ¿Que implementación requiere dicho ejemplo para cambiar el color de la propiedad HotTrack en un TTabSheet?

Código Delphi [-]
procedure TForm1.WndProc(var Mesg : TMessage) ;
begin
{ Here we see which component gets changed. 
  This bit here tells us which
  component the mouse is over }
     if Mesg.LParam = Longint(Label1) then
        ChangeColor(Label1, Mesg.Msg) ;
     if Mesg.LParam = Longint(Label2) then
        ChangeColor(Label2, Mesg.Msg) ;
     if Mesg.LParam = Longint(Label3) then
        ChangeColor(Label3, Mesg.Msg) ;
     if Mesg.LParam = Longint(CheckBox1) then
        ChangeColor(CheckBox1, Mesg.Msg) ;
   inherited WndProc(Mesg) ;
end;
procedure TForm1.ChangeColor
   (Sender : TObject; Msg : Integer) ;
Begin
{ If a label is the one that the mouse
is over then we do this } 
  if Sender IS TLabel Then
   begin
     if (Msg = CM_MOUSELEAVE) then
      (Sender As TLabel).Font.Color:=clWindowText;
     if (Msg = CM_MOUSEENTER) then
      (Sender As TLabel).Font.Color:=clBlue;
   end;
{ If a CheckBox is the one ... } 
  if Sender IS TCheckBox Then
   begin
    if (Msg = CM_MOUSELEAVE) then
     (Sender As TCheckBox).Font.Color:=clWindowText ;
    if (Msg = CM_MOUSEENTER) then
     (Sender As TCheckBox).Font.Color:=clRed ;
   end;
end;

[Deiv]

He encontrado este otro consejo:

Empezado por Peter Below

If you want to change these you have to draw the tabs yourself. Set the page controls OwnerDraw property to true and handle the OnDrawTab event. To find out if the mouse over the tab you are drawing use GetCursorPos to get the current mouse position in screen coordinates, convert to the page controls client coordinates via its ScreenToClient method and do a PtinRect call with that position using the rect you get as parameter to the event handler.

Pero no se encararlo, ¿alguna idea?

[ingabraham]

Empezado por roman

Si pones la propiedad OwnerDraw del PageControl en true y pones el siguiente código en su evento OnDrawTab:

Código Delphi [-]
procedure TForm1.PageControl1DrawTab(
  Control: TCustomTabControl;
  TabIndex: Integer; const Rect: TRect; Active: Boolean);
var
  R: TRect;
  Texto: String;

begin
  if Active then
  begin
    Control.Canvas.Font.Color := clRed;
    Control.Canvas.Font.Style := [fsBold];
  end;

  Texto := PageControl1.Pages[TabIndex].Caption;

  R := Rect;
  Control.Canvas.FillRect(R);

  if not Active then
    InflateRect(R, 0, -3);

  DrawText(
    Control.Canvas.Handle, PChar(Texto), -1, R,
    DT_SINGLELINE or DT_CENTER or DT_VCENTER);
end;

lograrás que la pestaña activa tenga su rótulo de color rojo en negritas. Pienso que algo así es lo que quieres.

// Saludos

hola y para que se le aplique a todas las pagina

[olbeup]

Hay un problema cuando el TabSheet está oculto o no es visible, ya no se corresponden los Caption's de los TabSheet's, si tienes 6 TabSheet y el que hace 3, lo pones oculto, el resto no se corresponde con su título, ¿cómo se pueden solucionar el problema?, la verdad, no lo se.

[*Caro*]

Empezado por ingabraham

hola y para que se le aplique a todas las pagina

Hola, solo tienes que quitar la condición del Active:

Código Delphi [-]
var
  R: TRect;
  Texto: String;
begin
  Control.Canvas.Font.Color := clRed;
  Control.Canvas.Font.Style := [fsBold];

  Texto := PageControl1.Pages[TabIndex].Caption;

  R := Rect;
  Control.Canvas.FillRect(R);
 ...............................
  .................................

Saluditos

[*Caro*]

Empezado por olbeup

Hay un problema cuando el TabSheet está oculto o no es visible, ya no se corresponden los Caption's de los TabSheet's, si tienes 6 TabSheet y el que hace 3, lo pones oculto, el resto no se corresponde con su título, ¿cómo se pueden solucionar el problema?, la verdad, no lo se.

Hola olbeup, prueba de esta forma:

Código Delphi [-]
var
aRect: TRect;
i, TIndex, Ind: Integer;
begin
 if Active then
  begin
   Control.Canvas.Font.Style := [fsBold];
   Control.Canvas.Font.Color := clRed;
  end
 else
 begin
  Control.Canvas.Font.Style := [];
 end;
 aRect := Rect;
 TIndex := -1;
 Ind := TabIndex;
 for i := 0 to PageControl1.PageCount - 1 do
  begin
   if TIndex = TabIndex then Break;
   if not PageControl1.Pages[i].TabVisible then
    Inc(Ind)
   else
    Inc(TIndex);
  end;
 DrawText(Control.Canvas.Handle,PChar(PageControl1.Pages[Ind].Caption),
         -1,aRect,DT_CENTER or DT_SINGLELINE);
end;

Saluditos

[olbeup]

Perfecto, pero el problema radica cuando el Font del TabSheet es negrita lo cual agranda el texto y se sale del marco del TabSheet.

Dejo el código que realizado con el que habéis aportado todos:

Código Delphi [-]
// Redibuja el PageControl (Tab) el título en color
procedure TForm1.OnEventPageControlDrawTab(Control: TCustomTabControl;
  TabIndex: Integer; const Rect: TRect; Active: Boolean);

  procedure SetChangeColorControl(Style: TFontStyles; Color: TColor);
  begin
    Control.Canvas.Font.Style := Style;
    Control.Canvas.Font.Color := Color;
  end;

  function GetTabIndex: Integer;
  var
    I, TIndex, Ind: Integer;
  begin
    // Iniciarlizar variables de seguimiento del TabSheet
    TIndex := -1;
    Ind    := TabIndex;

    // Iniciar bucle y devolver todos los TabSheet visible
    for I := 0 to (PageControl1.PageCount -1) do
    begin
      if (TIndex = TabIndex) then
        Break;

      if (not PageControl1.Pages[i].TabVisible) then
        Inc(Ind)
      else
        Inc(TIndex);
    end;

    Result := Ind;
  end;

var
  R: TRect;
  Texto: String;

begin
  // Comprobar si está activo y hacer cambios en el Font del TabSheet
  if Active then
    SetChangeColorControl([fsBold], clBlue)
  else
    SetChangeColorControl([], clBlack);

  // Guardar el Caption del TabSheet el cual Corresponde
  Texto := (Control as TPageControl).Pages[GetTabIndex].Caption;

  R := Rect;
  Control.Canvas.FillRect(R);

  // Redibujar el TabSheet que corresponde del PageControl
  DrawText(
    Control.Canvas.Handle, PChar(Texto), -1, R,
    DT_SINGLELINE or DT_CENTER or DT_VCENTER);
end;

[olbeup]

Hay un error en el GetTabIndex, ya que sólo actúa sobre el PageControl1, si tenemos varios PageControl no funcionará, dejo código nuevo.

Código Delphi [-]
// Redibuja el Page Control (Tab) el título en color
procedure TfrmServicios.OnEventPageControlDrawTab(Control: TCustomTabControl;
  TabIndex: Integer; const Rect: TRect; Active: Boolean);

  procedure SetChangeColorControl(Style: TFontStyles; Color: TColor);
  begin
    Control.Canvas.Font.Style := Style;
    Control.Canvas.Font.Color := Color;
  end;

  function GetTabIndex: Integer;
  var
    I, TIndex, Ind: Integer;
  begin
    // Iniciarlizar variables de seguimiento del TabSheet
    TIndex := -1;
    Ind    := TabIndex;

    // Iniciar bucle y devolver todos los TabSheet visible
    for I := 0 to ((Control as TPageControl).PageCount -1) do
    begin
      if (TIndex = TabIndex) then
        Break;

      if (not (Control as TPageControl).Pages[i].TabVisible) then
        Inc(Ind)
      else
        Inc(TIndex);
    end;

    Result := Ind;
  end;

var
  R: TRect;
  TabCaption: String;
begin
  // Comprobar si está activo y hacer cambios en el Font del TabSheet
  if Active then
    SetChangeColorControl([fsBold], clBlue)
  else
    SetChangeColorControl([], clBlack);

  // Guardar el Caption del TabSheet el cual Corresponde
  TabCaption := (Control as TPageControl).Pages[GetTabIndex].Caption;

  R := Rect;
  Control.Canvas.FillRect(R);

  // Redibujar el TabSheet que corresponde del PageControl
  DrawText(
    Control.Canvas.Handle, PChar(TabCaption), -1, R,
    DT_SINGLELINE or DT_CENTER or DT_VCENTER);
end;

Un saludo

P.D.: Perdón

[jose.ignacio.ve]

Hola, estuve buscando en todos los foros y no logro pintar toda la pestaña, solo legre pintar el titulo de la pagina seleccionada, yo necesito pintar todo el pagecontrol de azul por ejemplo, ya que lo tengo en blanco unicamente todas las paginas y lo quegre pintar las fuentes que estan dentro de cada pagina paro la pagina no lo pintar alguna ayuda?

[[AgustinOrtu]]

El PageControl por defecto no lo soporta. O usas un componente de terceros (como los Raize) o bien metes adentro de cada pagina un TForm o TFrame empotrado. Es simplemente poner como Parent del objeto empotrado la pestaña

Luego es cuestion de que el objeto empotrado este pintado