Ver Mensaje Individual
  #14  
Antiguo 15-07-2011
Avatar de olbeup
olbeup olbeup is offline
Miembro
 
Registrado: jul 2005
Ubicación: Santiago de la Ribera (España)
Posts: 685
Reputación: 19
olbeup Va camino a la fama
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
Responder Con Cita