gedrehter Text verändert Font

[WS1976]

Hallo,

ich benutze den folgenden Code zum gedrehten ausgeben von Texten( stammt aus dem Delphi-Treff ):

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;

procedure TForm1.Button4Click(Sender: TObject);
var n:integer;
begin
  TextOutAngle(PB1.Canvas,100,100,'hallo',900);
end;

Funktioniert alles problemlos, nur mit dem Schönheitsfehler, dass das Steuerelement das danach den Fokus hat seinen Font verändert.
Ich zeichne auf eine Tpaintbox.
Weiss jemand warum das so ist?

Grüsse
Rainer

[alzaimar]

Der Font an sich ändert sich doch nicht, nur sieht er gedreht 'ein wenig' anders aus. Ich finde das auch häßlich, aber imho ist das bei der relativ geringen Auflösung einfach nicht anders zu rendern. Vergrößere den Font mal auf 20-30 pt und schau Dir das Ergebnis an. Bei mir ändert sich dann Nichts mehr.

[WS1976]

Hallo alzaimar,

ich habe nicht das Problem, dass sich der Font des angezeigten Textes ändert.
Es ändert sich der Font des Steuerelements das den Fokus hat.
Beispiel:
Ich habe die Textausgabe mit einem Tbutton ausgelöst.
Nach dem ausführen dieser Prozedur ändert sich der Font des caption von Tbutton.

Grüsse
Rainer

[alzaimar]

:shock: Ach ja, da war doch was...

Versuchs mal damit

Delphi-Quellcode:

Procedure DrawRotated (x,y,Rotation : Integer; Const aText : String);
var
   lf: LOGFONT; // Windows native font structure

begin
  GetObject (MyCanvas.Font.Handle,  SizeOf (lf), @lf);
  lf.lfEscapement := 10 * Rotation;
  lf.lfOrientation := lf.lfEscapement;
  MyCanvas.Font.Handle := CreateFontIndirect(lf);
  MyCanvas.TextOut(x,y,aaText);
end;

[WS1976]

Hallo alzaimar,

danke für deine Antwort. Es funktioniert jetzt.
Aber ich bin neugierig. Warum klappt das jetzt?
Hast du eine Ahnung?

Grüsse
Rainer

[himitsu]

in D2009 geht es auch so (ich weiß nur nicht ab wann .Orientation in TFont drin ist ... D7 kennt es noch nicht)

Delphi-Quellcode:

Procedure TextOutAngle(const Canvas: TCanvas; X, Y: Integer;
  const AText: string; AAngle: Integer);

var
  OldOrientation: Integer;

begin
  OldOrientation := Canvas.Font.Orientation;
  Canvas.Font.Orientation := AAngle;
  Canvas.TextOut(x, y, AText);
  Canvas.Font.Orientation := OldOrientation;
end;


// oder 


Procedure TextOutAngle(const Canvas: TCanvas; X, Y: Integer;
  const AText: string; AAngle: Integer);

var
  OldFont: TFont;

begin
  OldFont := TFont.Create;
  Try
    OldFont.Assign(Canvas.Font);
    Canvas.Font.Orientation := AAngle;
    // hier ließe sich dann noch mehr ändern und es würde auch wieder zurückgesetzt
    Canvas.TextOut(x, y, AText);
  Finally
    Canvas.Font.Assign(OldFont);
    OldFont.Free;
  End;
end;

Warum der Fehler bei dir auftritt, weiß ich nicht, aber eventuell gibt eine Zuweisung auf Font.Handle das alte Handle frei :gruebel:

[Uwe Raabe]

Das geht übrigens auch sehr elegant so:

Delphi-Quellcode:

Procedure TextOutAngle(const Canvas: TCanvas; X, Y: Integer; 
    const AText: string; AAngle: Integer);
var
  Recall: TRecall;
begin
  Recall := TFontRecall.Create(Canvas.Font);
  Try
    Canvas.Font.Orientation := AAngle;
    // hier ließe sich dann noch mehr ändern und es würde auch wieder zurückgesetzt
    Canvas.TextOut(x, y, AText);
  Finally
    Recall.Free;
  End;
end;

[himitsu]

ach dafür war TFontRecall ... hatte mich vorhin schon etwas gefragt, als ich es zufällig in den Sourcen (nach TFont) sah ... nja, aber vielleicht hätt ich och mal sin de OH nachsehn können)