TextOut Font zuweisung

[EWeiss]

Wie kann ich TextOut vorher einen Font plus die Farbe zuweisen?

Muss dabei sagen es geht um die API

TCanvas oder Canvas.TextOut steht nicht zur verfügung

Habe nur ein Dc zur verfügung

Delphi-Quellcode:

TextOut(VisInfo^.VisDC, 20, 20, 'TEST', 4);

funktioniert aber mit Schwarzer Schrift und weißen Hintergrund
Der Font ist auch nicht das wahre

gruss Emil

[DeddyH]

Schau doch mal im MSDN.

[Luckie]

Mit SelectObject die gewünschte Schrift, die vorher mit CreateFont erzeugt wurde in den DC selektieren, aber nicht vergessen vorher die alte Schift mrken und alles wieder freigeben.

[EWeiss]

Zitat:

Zitat von Luckie

Mit SelectObject die gewünschte Schrift, die vorher mit CreateFont erzeugt wurde in den DC selektieren, aber nicht vergessen vorher die alte Schift mrken und alles wieder freigeben.

Ahh danke das hilft schon mal weiter bei CreateFont war ich schon
war mir nur nicht klar wie ich den auswählen soll

gruss Emil

[EWeiss]

Hab es mal so gemacht und scheint zu gehen..
Ist das OK ?

Delphi-Quellcode:

Font, OldFont: HFONT;

Delphi-Quellcode:

      SetBkColor(VisInfo^.VisDC, TRANSPARENT);
      SetTextColor(VisInfo^.VisDC, RGB(255,255,255));
      Font := CreateFont(50, 0, 0, 0, 0, 0, 0, 0,
                 ANSI_CHARSET,
                 OUT_DEFAULT_PRECIS,
                 CLIP_DEFAULT_PRECIS,
                 DEFAULT_QUALITY,
                 DEFAULT_PITCH, 'MS Sans Serif');

      OldFont := SelectObject(VisInfo^.VisDC, Font);
      TextOut(VisInfo^.VisDC, 20, 20, 'TEST', 4);
      SelectObject(VisInfo^.VisDC, OldFont);
      DeleteObject(Font);

Nur der Hintergrund trotz dem Transparenten Flag ist nicht transparent
Kann ich das so in der renderproc belassen oder die initialisierung für den Font lieber auslagern?

gruss Emil

[Luckie]

Font noch freigeben, wenn du sie nicht mehr brauchst.

Und was den Hintergrund angeht, du hast die falsche API-Funktion mit den richtigen Paramteren aufgerufen. ;) Du musst SetBkMode mit TRANSPARENT aufrufen und nicht SetBkColor. Irgendwie lustig.

[EWeiss]

Zitat:

Zitat von Luckie

Font noch freigeben, wenn du sie nicht mehr brauchst.

Und was den Hintergrund angeht, du hast die falsche API-Funktion mit den richtigen Paramteren aufgerufen. ;) Du musst SetBkMode mit TRANSPARENT aufrufen und nicht SetBkColor. Irgendwie lustig.

Jo lustig damit setzt man die Farbe;) Was soll's

Wie freigeben ?
Font := 0 ? free geht ja bei HFont nicht

gruss Emil

[Luckie]

Hilfe lesen:

Zitat:

Zitat von MSDN

When you no longer need the font, call the DeleteObject function to delete it.

[EWeiss]

Zitat:

Zitat von Luckie

Hilfe lesen:

Zitat:

Zitat von MSDN

When you no longer need the font, call the DeleteObject function to delete it.

gebe es zurück ;)
Du nicht gelesen ...

Delphi-Quellcode:

DeleteObject(Font);

Oder steht das nicht im meinen Quelltext ;)
hab mich schon gewunder was ich sonst noch freigeben soll
oder meinst du den Alten Font ?

Delphi-Quellcode:

DeleteObject(OldFont);

das würde noch fehlen

gruss Emil

[Luckie]

Oh, sorry, habe ich überlesen.

[EWeiss]

Zitat:

Zitat von Luckie

Oh, sorry, habe ich überlesen.

Jetzt muss ich aber mal heheheheh :wall:

gruss Emil

[EWeiss]

Habe noch ein seltsames problem
Meine Funktion

Delphi-Quellcode:

procedure GetInfo;
var
  r, r2    : Trect;
  StrPos   : String;

begin
  if SoInfo.Title <> '' then
  begin
    r := Rect(5, VisInfo^.h -15, VisInfo^.w-100, VisInfo^.h);
    DrawText(VisInfo^.VisDC, PChar(SoInfo.Title),
             Length(SoInfo.Title), r, DT_BOTTOM or DT_END_ELLIPSIS);

    StrPos := GetSongPosStr(SoInfo.Pos);
    StrPos := StrPos + '' + GetSongPosStr(1000 * SoInfo.Len);

    r2 := Rect(VisInfo^.w-96, VisInfo^.h -15, VisInfo^.w, VisInfo^.h);
    DrawText(VisInfo^.VisDC, PChar(StrPos),
             Length(StrPos), r2, DT_BOTTOM or DT_END_ELLIPSIS);

  end;

end;

Diese zeichnet jetzt den Titel und die Zeit Informationen auf das DC
Es ist aber nicht alles in Ordnung der Text wird verändert .. Bilder im Anhang

Delphi-Quellcode:

      SetBkMode(VisInfo^.VisDC, TRANSPARENT);
      //SetBkColor(VisInfo^.VisDC, rgb(0,0,0));
      SetTextColor(VisInfo^.VisDC, RGB(255,255,255));
      Font := CreateFont(8, 0, 0, 0, 0, 0, 0, 0,
                         ANSI_CHARSET,
                         OUT_DEFAULT_PRECIS,
                         CLIP_DEFAULT_PRECIS,
                         DEFAULT_QUALITY,
                         DEFAULT_PITCH, 'MS Sans Serif');

      OldFont := SelectObject(VisInfo^.VisDC, Font);

Das ist aber nur bei SetBkMode TRANSPARENT
Ist der hintergrund schwarz tritt das problem nicht auf.
Kann ich aber nicht lassen da es beschi... aus sieht.

Was gibt es da für eine möglichkeit um das zu unterbinden ?

gruss Emil

[Muetze1]

Grob vermutet: Du malst den neuen Text an neuer Position (scrollen/neue Chars) und da der Transparent ist und der Hintergrund noch nicht neu gezeichnet wurde, malt er das ganze daneben bzw. darüber.

Ergo: Hintergrund vor der Ausgabe des neuen Textes an der Stelle zeichnen.

[EWeiss]

Zitat:

Zitat von Muetze1

Grob vermutet: Du malst den neuen Text an neuer Position (scrollen/neue Chars) und da der Transparent ist und der Hintergrund noch nicht neu gezeichnet wurde, malt er das ganze daneben bzw. darüber.

Ergo: Hintergrund vor der Ausgabe des neuen Textes an der Stelle zeichnen.

Eigentlich nicht.
Der Text ist immer an einer festen position und wird nicht verändert.

Die Intitialisierung

Delphi-Quellcode:

SetBkMode(VisInfo^.VisDC, TRANSPARENT); 
SetTextColor(VisInfo^.VisDC, RGB(255,255,255)); 
Font := CreateFont(8, 0, 0, 0, 0, 0, 0, 0, 
                   ANSI_CHARSET, 
                   OUT_DEFAULT_PRECIS, 
                   CLIP_DEFAULT_PRECIS, 
                   DEFAULT_QUALITY, 
                   DEFAULT_PITCH, 'MS Sans Serif'); 

OldFont := SelectObject(VisInfo^.VisDC, Font);

wird dann gemacht wenn ein neues Plugin gestartet wird
der Font vorher gelöscht wenn das alte Plugin frei gegeben wird.

Die infos werden in der Render Funktion aufgerufen

Delphi-Quellcode:

GetInfo;

if (not BitBlt(canvas, VisInfo^.x, VisInfo^.y, VisInfo^.w, VisInfo^.h, VisInfo^.VisDC, 0,
  0, SRCCOPY)) then
begin
  VisInfo^.Rendering := False;

  BassFuncs^.SetError(BASS_ERROR_DEVICE);
  Exit;
end;

und danach direkt auf das DC kopiert
Da ändert sich nichts was den Text angeht die reihenfolge bleibt sich gleich.
Es sieht aber so aus das es nur dann auftritt wenn OpenGl Plugins gestartet wurden.
Kann es sein das diese TextOut oder die Transparenz zerstört ?
Wenn ja wie kann ich das beheben.

gruss Emil

[littleDave]

Ich glaube, das Problem liegt daran, dass du mit der Windows GDI auf ein Fensterhandle zeichen willst, dass von OpenGL benutzt wird. Solch ein "Mix" ist überhaupt nicht zu empfehlen, da dadurch genau solche Fehler entstehen können. Wenn du Text auf ein OpenGL-Fenster zeichnen willst, solltest du das auch mit OpenGL machen. Dazu hast du zwei Möglichkeiten.

• Bitmap-Fonts: die einzelnen Buchstaben werden in einer Textur gespeichert. Beim rendern zeichnest du dann einfach ein Quad und übergibst die Texturkoordinaten des gewünschten Buchstaben. Diese Methode ist sehr schnell und hat sogar den Vorteil, dass du alle Schriftarten benutzen kannst - egal ob sie auf dem Zielrechner vorhanden sind oder nicht - da du sie ja in ein Bitmap speicherst. Nachteil ist leider der etwas größere Aufwand bei der Erstellung und der Verwaltung der Fonts. Außerdem musst du bei dieser Methode Funktionen wie das Zeichnen oder das Auslesen der Schriftlänge komplett selbst schreiben.
  Hier ein Tool, mit dem sich Bitmap-Fonts erstellen und benutzen lassen: Nitrogen Font Studio: FontStudio - Fonts erstellen Beispielprogramm zur Benutzung
• Windows-Fonts: diese Methode hat relativ identisch zur Windows-Methode. Du erstellst in OpenGL eine Display-Liste, in der die einzelnen Linien jedes Buchstabens gespeichert werden. Dafür gibt es sogar unter Windows bereits eine Funktion, die dir das abnimmt. Mit dieser Methode kannst du soger recht einfach dreidimensionale Schrift verwenden. Der Nachteil dieser Methode ist, dass es relativ zu den Bitmap-Fonts langsamer ist (aber immer noch schneller als die Windows-GDI).
  Hier ein Beispiel, wie du das umsetzen könntest: wglUseFontOutlines

Grüße
Dave

[SirThornberry]

wenn du nicht auf die VCL verzichten musst geht es auch so:

Delphi-Quellcode:

var
  lCanvas: TCanvas;
begin
  lCanvas := TCanvas.Create();
  try
    lCanvas.Handle := Your_HDC;
    try
      lCanvas.Font.Name := 'irgendwas';
      lCanvas.Font.Color := irgendeine;
      [...]
    finally
      lCanvas.Handle := 0;
    end;
  finally
    lCanvas.Free;
  end;

[EWeiss]

Zitat:

Zitat von SirThornberry

wenn du nicht auf die VCL verzichten musst geht es auch so:

Delphi-Quellcode:

var
  lCanvas: TCanvas;
begin
  lCanvas := TCanvas.Create();
  try
    lCanvas.Handle := Your_HDC;
    try
      lCanvas.Font.Name := 'irgendwas';
      lCanvas.Font.Color := irgendeine;
      [...]
    finally
      lCanvas.Handle := 0;
    end;
  finally
    lCanvas.Free;
  end;

Danke werde es mal versuchen bevor ich auf OpenGl zugehe.

@littleDave
Mit den Bitmapfonts mache ich ja schon in vis_BassVis stellt kein problem dar halt nicht unicode fähig.

Die andere variante müßte ich testen denn auch da würden 2 verschiedene Welten aufeinander treffen.
Weiss nicht ob sich BitBlt und OpenGl vertragen, werde es mal testen sollte die andere Methode nicht funktionieren.

gruss Emil

[EWeiss]

Habe es jetzt mal nach TCanvas umgestellt..
Selbe problem hmmmm....

Im Render Event

Delphi-Quellcode:

if SoInfo.Title <> '' then
  BassSoVis1.DrawSongName(VisCanvas);

if (not BitBlt(canvas, VisInfo^.x, VisInfo^.y, VisInfo^.w, VisInfo^.h, VisInfo^.VisDC, 0,
  0, SRCCOPY)) then
begin
  VisInfo^.Rendering := False;

  BassFuncs^.SetError(BASS_ERROR_DEVICE);
  Exit;
end;

Delphi-Quellcode:

procedure OutlinedDrawText(Canvas: TCanvas;
                          r: TRect;
                          const Text: string;
                          OutlineColor: TColor);

var
  OldBrushStyle: TBrushStyle;
  OldFontColor : TColor;

begin
   with Canvas do
   begin
      Lock;
      OldFontColor := Font.Color;
      Font.Color := OutlineColor;
      OldBrushStyle := Brush.Style;
      Brush.Style := bsClear;
      Font.Color := OldFontColor;
      DrawText(Canvas.Handle, PChar(Text),
             Length(SoInfo.Title), r, DT_BOTTOM or DT_END_ELLIPSIS);
      Brush.Style := OldBrushStyle;
      Unlock;
   end;
end;


procedure TBASSSoniqueVis.DrawSongName(Canvas : TCanvas);
var
  Text: String;
  r   : TRect;

begin
   with Canvas do
   begin
      Lock;
      Text := SoInfo.Title;
      Font.Size := 10;
      Font.Name := 'Arial';
      canvas.Brush.Style := bsClear;
      Font.Color := clWhite;
      r := Rect(5, VisInfo^.h -15, VisInfo^.w-100, VisInfo^.h);
      OutlinedDrawText(Canvas, r, Text, clBlack);
      Unlock;
  end;

end;

Was machen ??
Geht auch hier nichts ohne auf OpenGl umzusteigen ?

gruss Emil