Ver Mensaje Individual
  #3  
Antiguo 18-11-2024
Badillo Badillo is offline
Miembro
 
Registrado: jun 2021
Posts: 45
Reputación: 0
Badillo Va por buen camino
Disculpen, faltó algo por explicar que no había visto

Saludos y disculpen, faltó algo por explicar que no había visto:

El PageControl que les comento es uno modificado, por lo que estoy viendo el problema debe estar en el método CNDrawItem.

Código Delphi [-]
procedure TMdPageControl.CNDrawItem(var Message: TWMDrawItem);
var
  SaveIndex:  Integer;
  Caption:    string;
  Size:       TSize;
  x,y:        integer;
  Rgn:        HRGN;
  Color:      TColor;
  Rect:       TRect;
begin
  with Message.DrawItemStruct^ do
  begin
    SelectClipRgn(hDC, 0);  // don't get clipped in the original rectangle
    SaveIndex := SaveDC(hDC);
    Canvas.Lock;
    try
      Canvas.Handle := hDC;

      Canvas.Brush.Color := TabColor;
      Caption := MdThemeConstants.GetTranslation(Self.Tabs.Strings[ItemID]);
      Canvas.Font := Font;
      Rect := rcItem;
      Size := Canvas.TextExtent(Caption);

      case TabPosition of
        tpTop:
          begin
            Dec(Rect.Left, 3);
            Inc(Rect.Right, 5);
            Dec(Rect.Top, 4);
            Canvas.Font.Orientation := 0;
            x := Rect.Left + (Rect.Right - Rect.Left - Size.Width) div 2;
            y := Rect.Top + (Rect.Bottom - Rect.Top - Size.Height) div 2 + 1;
          end;
        tpBottom:
          begin
            if Bool(Message.DrawItemStruct.itemState and ODS_SELECTED) then
            begin
              Dec(Rect.Top, 2);
              Dec(Rect.Right, 8);
              Inc(Rect.Bottom, 2);
            end
            else
            begin
              Dec(Rect.Top, 6);
              Dec(Rect.Left, 4);
              Dec(Rect.Right, 4);
              Inc(Rect.Bottom, 4);
            end;
            Canvas.Font.Orientation := 0;
            x := Rect.Left + (Rect.Width div 2 - Size.Width div 2);
            y := Rect.Top + (Rect.Height div 2 - Size.Height div 2);
          end;
        tpLeft:
          begin
            if Bool(Message.DrawItemStruct.itemState and ODS_SELECTED) then
            begin
              Dec(Rect.Left, 2);
              Dec(Rect.Bottom, 8);
              Dec(Rect.Right, 6);
            end
            else
            begin
              Dec(Rect.Left, 4);
              Dec(Rect.Top, 4);
              Dec(Rect.Bottom, 4);
              Dec(Rect.Right, 2);
            end;
            Canvas.Font.Orientation := 900;
            x := Rect.Left + (Rect.Width div 2) - (Size.Height div 2);
            y := Rect.Top + (Rect.Height div 2) + (Size.Width div 2);
          end;
        tpRight:
          begin
            if Bool(Message.DrawItemStruct.itemState and ODS_SELECTED) then
            begin
              Inc(Rect.Left, 2);
              Dec(Rect.Bottom, 8);
              Dec(Rect.Right, 0);
            end
            else
            begin
              Dec(Rect.Left, 2);
              Dec(Rect.Top, 4);
              Dec(Rect.Bottom, 4);
              Inc(Rect.Right, 2);
            end;
            Canvas.Font.Orientation := -900;
            x := Rect.Left + (Rect.Width div 2) + (Size.Height div 2);
            y := Rect.Bottom - (Rect.Height div 2) - (Size.Width div 2);
          end;
      end;
      if Bool(Message.DrawItemStruct.itemState and ODS_SELECTED) then Canvas.Font.Color := TabHighlightedColor;
      Canvas.TextRect(Rect, x, y, Caption);

    finally
      Canvas.Handle := 0;
      Canvas.Unlock;
      RestoreDC(hDC, SaveIndex);
    end;

    // Erase Outer border

    Rgn := CreateRectRgn(0, 0, 0, 0);
    SelectClipRgn(hDC, Rgn);
    DeleteObject(Rgn);
  end;

  Message.Result := 1;
end;

Les adjunto la clase completa y un ejemplo de su funcionamiento.

Gracias una vez más por cualquier ayuda, pero creo que la cosa debe estar en las dimensiones del Rect que la utilizan con el texto viejo y no con el nuevo.
Archivos Adjuntos
Tipo de Archivo: zip MdPageControl.zip (4,7 KB, 1 visitas)
Responder Con Cita