TPageCotnrol -> selber zeichnen -> Schrift bei Tabs hochkant

[HolgerCW]

Mein Font ist "Tahoma" Ist der Truetype und wodran erkenne ich einen Truetype Font ?

Weil ohne den Owner-Draw hat Delphi ja auch Tahoma drehen können !

[DeddyH]

Sry, ich hab die beiden Beispiele verwechselt . Allerdings ändert sich bei mir die Schriftgröße etc. nicht, wenn ich das verlinkte Beispiel verwende.

[HolgerCW]

Ich nutze auch keine Paintbox sondern ein TPageControl. Vielleicht liegt es daran.
Ich mache es so:

Delphi-Quellcode:

procedure Berechtigung_Tab_zeichnen(PageControl: TPageControl; Bilder: Boolean;Control: TCustomTabControl; Der_TabIndex: Integer; const Rect: TRect; Active: Boolean);
var
 I, Y: Integer;

with Control as TPageControl do
begin

 canvas.Brush.Style := bssolid;
 canvas.font.Color  := clbtntext;
 
 If PageControl.TabPosition = tpRight then
 begin
  TextOutAngle(Canvas, rect.left, rect.top, Pages[Der_Tabindex].Caption, 900);
 end
 else
 begin
  canvas.TextOut(rect.left+26,rect.top+5,Pages[Der_Tabindex].Caption);
 end;
 
 If Bilder = TRUE then PageControl.Images.Draw(control.Canvas,rect.Left+7,rect.Top+2, Der_Tabindex);

end;
end;

Hier nochmal die TextOutAngel - Procedure:

Delphi-Quellcode:

procedure TextOutAngle(const Canvas: TCanvas; X, Y: Integer; const AText: String; AAngle: Integer);
var
 hCurFont: HFONT;
 LogFont: TLogFont;
begin

 with Canvas do
 begin
  hCurFont := Font.Handle;
  try
   GetObject(Font.Handle, SizeOf(LogFont), @LogFont);
   LogFont.lfEscapement := AAngle;
   LogFont.lfOrientation := AAngle;

   Font.Handle := CreateFontIndirect(LogFont);
   try
    TextOut(X, Y, AText);
   finally
    DeleteObject(Font.Handle);
   end;
  finally
   Font.Handle := hCurFont;
  end;
 end;
end;

Vielleciht stimmt was mit meiner oberen Procedure nicht ?

[taaktaak]

Moin, Moin,

folgendes verwirrt mich...

Delphi-Quellcode:

procedure ~~(PageControl:TPageControl; ~~ Control: TCustomTabControl~~); 
.. 
with Control as TPageControl do  // << ist das korrekt?? die Proc-Parameter sagen doch etwas anderes?!

[HolgerCW]

auch wenn ich

with PageControl do mache passiert das selbe. Die komplette Schrift auf dem PageControl wird Fett

...

[taaktaak]

Moin, Moin.

Die Ursache liegt darin, dass in TextOutAngle() der in dieser Prozedur verwendete temporäre Font nicht die korrekten Werte aus dem für das TabControl festgelegten Font übernimmt. Dieses soll ja eigentlich mit

GetObject(Font.Handle, SizeOf(LogFont),@LogFont); erfolgen. Zusätzlich wird dort nur mit lfEscapement und lfOrientation der übernommene Font gedreht.

Eine Korrektur der Symptome kannst du erreichen, indem du die "falschen" Werte quasi manuell in dieser Prozedur setzt. Um die fette Schrift zu eleminieren also z.B. Logfont.lfWeight:=FW_Normal.

Das ist aber eigentlich ein absolut hilfloses Vorgehen und nicht Sinn der Sache - ich muss aber gestehen: Mehr kann ich dazu im Augenblick nicht beitragen

[HolgerCW]

ICh denke das Problem liegt ncoh woanders.

Denn auch wenn ich mit:

Delphi-Quellcode:

If PageControl.TabPosition = tpRight then 
begin

abfrage, das er nur bei PageControls mit Rechtsausrichtung die Drehung machen soll, wirken sich die Änderungen auch auf die anderen PageControls aus. Bei andere PageControls wiederrum funktioniert sogar die Drehung mit Verschiebung um +26. Das heisst das in der Zeile:

canvas.TextOut(rect.left+26,rect.top+5,Pages[Der_Tabindex].Caption); irgendwie die Drehung auch Auswirkung zeigt. Irgendwie muss ich das Globale da raus kriegen ?

Ich rufe ja auch von jedem PageControl über das Draw Ereignis diese Procedure auf ...

Bin ratlos ?

...

[HolgerCW]

Ich habe es jetzt hionbekommen, das nur ein PageControl davon beeinflusst wird, aber irgendwie zeichnet er nur misst. Hat vielleicht jemand noch eine alternative Lösung gegenüber den beiden anfänglichen Lösungen ?