Ayuda con PageControl y TabSheet

roman · #1 11-10-2005

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 · #2 11-10-2005

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

Migpal · #3 11-10-2005

Pense que era más dificil, Gracias ROMAN.

Deiv · #4 12-12-2006

Hola,

Cita:

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 · #5 17-12-2006

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 · #6 19-12-2006

He encontrado este otro consejo:

Cita:

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 · #7 10-06-2011

Cita:

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 · #8 14-07-2011

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* · #9 14-07-2011

Cita:

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 · #10 15-07-2011

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 · #11 15-07-2011

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 · #12 21-10-2015

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?

*Caro* · #13 14-07-2011

Cita:

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

Herramientas	Buscar en Tema
Mostrar Versión Imprimible Enviar por Correo	Buscar en Tema: Búsqueda Avanzada
Desplegado
Cambiar a Modo Lineal Modo Híbrido Cambiar a Modo Hilado