Font, DrawText, "wahre" Breite ermitteln

[STARGÅTE]

Tachchen,

Wie ihr sicherlich wisst gibt TextWidth() einem die Breite des Textes zurück, den er "in einem anderen Text" einnehmen würde.
Bei den meisten Fonts erhält man so auch die genaue Breite des Textes.

Nun gibt es aber Fonts bzw Zeichen, die weniger Platz im Text einnehmen, als sie in wirklichkeit groß sind:

Klassisches Beispiel: das "f" bei Times New Roman (Kursiv):

Code: Alles auswählen

Enumeration
 #Window : #Gadget : #Image
EndEnumeration

Global Font = FontID(LoadFont(#PB_Any, "Times New Roman", 32, #PB_Font_Italic))

CreateImage(#Image, 256, 256)

StartDrawing(ImageOutput(#Image))
 DrawingFont(Font)
 DrawingMode(#PB_2DDrawing_Transparent)
 Box(10, 10, TextWidth("f"), TextHeight("f"), $808080)
 DrawText(10, 10, "f", $FFFFFF)
 Box(10, 110, TextWidth(" f "), TextHeight(" f "), $808080)
 DrawText(10, 110, " f ", $FFFFFF)
StopDrawing()

SetClipboardImage(#Image)

OpenWindow(#Window, 0, 0, ImageWidth(#Image), ImageHeight(#Image), "Image", #PB_Window_MinimizeGadget|#PB_Window_ScreenCentered)
 ImageGadget(#Gadget, 0, 0, ImageWidth(#Image), ImageHeight(#Image), ImageID(#Image))

Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow

Wie man sieht wird der "Fuß" und der "Kopf" links bzw rechts abgeschnitten, bzw nicht mit berücksichtig,
weil eben diese Stellen in einem ganzen Wort schon in nächsten Zeichen wären.

Nun brauch ich aber genau diese Überbreite,

Kann man die irgendwie über API herausbekommen, mit der FontID

[Josh]

wie du die BEITE ermitteln kannst, weiß ich nicht ^^
aber vieleicht findest du hier oder da was du brauchst. dann brauchst du dazu sicher noch den device context. wie du zu dem kommst, findest du hier

hoffentlich hilft dir das

[STARGÅTE]

Danke, genau das waren die Infos die ich brauchte...

bekomme inzwischen auch Werte zurück, nur muss ich sie nun noch richtig deuten ...

Wenn ich alles habe was ich brauch meld ich mich wieder, dann Stelle ich die "neuen" Proceduren hier rein...

[Josh]

also mein bester freund in pb ist inzwischen die 'auto vervollständigen liste'. da hab ich bis auf die asm's alles angehackt. mit ein bischen überlegen was an schlüsselwörter passen könnte, hab ich da schon verdammt viel gefunden.

[STARGÅTE]

So, habe mein Ziel erreicht.

Was damit gleich zusätzlich gelöst wurde ist, das nun die "überflüssige" Leerraum bei kleinen Elementen weg.

Zugegeben meine Prozeduren sind nicht das gelbe vom Ei aber sie funktionieren. Denn irgendwie mutte ich ja DrawText() dazu bringen die fehlenden Sachen mit darzustellen, also Leerzeichen ran und abstand weg ^^

Hier die Verbesserungen:


Mit DrawRealText() wird nun der Text richtig eingerückt und komplett dargestellt.

Hintergrund bei mir war, ich musste einem Bitmap-Font erstellen und habe mich gewunder warum manche Zeichen Fehlerhaft sind.

TextShiftLeft(), TextShiftRight() ermitteln die "Verschiebung" des Zeichens
TextRealWidth() ermitteln "reale" Breite des Textes

Code: Alles auswählen

Procedure TextShiftLeft(FontID, Text$)
  Protected ABC.ABC, *DC = CreateCompatibleDC_(0)
  If *DC 
    SelectObject_(*DC, FontID)
    GetCharABCWidths_(*DC, Asc(Left(Text$,1)), Asc(Left(Text$,1)), @ABC)
    DeleteDC_(*DC)
  EndIf
  ProcedureReturn ABC\abcA
EndProcedure

Procedure TextShiftRight(FontID, Text$)
  Protected ABC.ABC, *DC = CreateCompatibleDC_(0)
  If *DC 
    SelectObject_(*DC, FontID)
    GetCharABCWidths_(*DC, Asc(Right(Text$,1)), Asc(Right(Text$,1)), @ABC)
    DeleteDC_(*DC)
  EndIf
  ProcedureReturn ABC\abcC
EndProcedure

Procedure TextRealWidth(FontID, Text$)
  Protected *Char.Character = @Text$
  Protected ABC.ABC, *DC = CreateCompatibleDC_(0), RealWidth
  If *DC 
    SelectObject_(*DC, FontID)
    While *Char\c
      GetCharABCWidths_(*DC, *Char\c, *Char\c, @ABC)
      RealWidth + ABC\abcA + ABC\abcB + ABC\abcC
      *Char + SizeOf(Character)
    Wend
    DeleteDC_(*DCRealWidth)
  EndIf
  ProcedureReturn RealWidth-TextShiftLeft(FontID, Text$)-TextShiftRight(FontID, Text$)
EndProcedure


Procedure DrawRealText(FontID, x, y, Text$, Color)
  Protected Shift = TextShiftLeft(FontID, Text$)
  Text$ = Space(16)+Text$+Space(16)
  DrawText(x-Shift-TextWidth(Space(17))+TextWidth(" "), y, Text$, Color)
EndProcedure



Enumeration
  #Window : #Gadget : #Image
EndEnumeration

Global Font = FontID(LoadFont(#PB_Any, "Times New Roman", 50, #PB_Font_Italic))

CreateImage(#Image, 400,400)

StartDrawing(ImageOutput(#Image))
  DrawingFont(Font)
  DrawingMode(#PB_2DDrawing_Transparent)
  
  Text$ = "jf"
  Width = TextWidth(Text$)
  RealWidth = TextRealWidth(Font, Text$)
  Box(10, 10, Width, TextHeight(Text$), $808080)
  DrawText(10, 10, Text$, $FFFFFF)
  Box(10, 210, RealWidth, TextHeight(Text$), $808080)
  DrawRealText(Font, 10, 210, Text$, $FFFFFF)
  Debug Chr(34)+Text$+chr(34)
  Debug "  Links = "+Str(TextShiftLeft(Font, Text$))
  Debug " Rechts = "+Str(TextShiftRight(Font, Text$))
  
  Text$ = "´ig."
  Width = TextWidth(Text$)
  RealWidth = TextRealWidth(Font, Text$)
  Box(210, 10, Width, TextHeight(Text$), $808080)
  DrawText(210, 10, Text$, $FFFFFF)
  Box(210, 210, RealWidth, TextHeight(Text$), $808080)
  DrawRealText(Font, 210, 210, Text$, $FFFFFF)
  Debug Chr(34)+Text$+chr(34)
  Debug "  Links = "+Str(TextShiftLeft(Font, Text$))
  Debug " Rechts = "+Str(TextShiftRight(Font, Text$))
 
StopDrawing()

SetClipboardImage(#Image)

OpenWindow(#Window, 0, 0, ImageWidth(#Image), ImageHeight(#Image), "Image", #PB_Window_MinimizeGadget|#PB_Window_ScreenCentered)
  ImageGadget(#Gadget, 0, 0, ImageWidth(#Image), ImageHeight(#Image), ImageID(#Image))

Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow

[Kaeru Gaman]

das tatsächliche Problem sehe ich hier beim DrawText() selber:
eigentlich müßte der Text vollständig dargestellt werden, dementsprechend nur zwei pixel weiter links anfangen.
die vor- und hinter-linien sind ja für die überbindung da, deswegen stehen sie "über" den Basisbereich.
der dürfte aber nicht geclippt werden, sondern müßte nach Bedarf ausgedehnt werden.

[STARGÅTE]

Jo, klar, aber das Clip'n macht selbst (zB Paint) falsch ... wenn man Text schribt.

aber selbst wenn DrawText alles vom Zeichen immer darstellt, braucht man trotzdem diese OffsetWerte, damit man Zeichen immer Voll auf einem Image hat, wenn es nur einzeln dargestellt wird.

Ich habe nun bei meiner BitmapFont diese änderungen alle eingebaut.
Und meine Texte werden nun genau so angezeigt wie zB in Word.
Das heißt die Bildungslinien Stimmen nun.

[Kukulkan]

Hallo,

das ist eine gute Lösung, aber die funktioniert nur unter Windows (API). Gibt es nichts allgemeineres um das Problem Plattformunabhängig lösen zu können? Eine Idee dazu?

Grüße,

Volker

[bobobo]

Monospace fonts benutzen

[STARGÅTE]

Das hat mit Monospace nix zu tun bobobo!

Denn selbst wenn die Breite eines Zeichens immer gleich wäre, gibt mir auch dort TextWidth() die Breite im Text-Fluss zurück.
Damit werden auch bei diesen Fonts Serifen und Tropfen abgeschnitten, falls dieser außerhalb der Text-Fluss-Breite liegen.

Außerdem ist das kleine Lösung für das Problem an sich

Eine zimlich blöde Lösung wäre u.u. einfach per Point() die Gebiete außerhalb der Textflussbreite abzutasten und zu ermitteln ab wann es keine Farbe mehr vom Buchstaben gibt.
Natürlich außerhalb der Laufzeit ...