Einzelnen Beitrag anzeigen

HolgerCW

Registriert seit: 28. Nov 2006
Ort: Marl
1.207 Beiträge
 
Delphi XE7 Enterprise
 
#13

Re: TPageCotnrol -> selber zeichnen -> Schrift bei Tab

  Alt 19. Mär 2008, 11:07
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 ?
  Mit Zitat antworten Zitat