Aber ich kenn mich mit der WinAPI nicht so sonderlich aus und nach meinen nachforschungen habe ich keine richtig schnelle Möglichkeit gefunden, Images mit transparents auf einem Fenster dar zu stellen, welches für einen Font geeignet wäre.
Ein Image mit Transparents auf z.B. einem Fenster zu zeichnen habe ich ja schon vor längerem gefunden. BitBlt und diese DCs habe ich mir auch schon angeschaut, das ist auch immoment meine Lösung, wird aber vermutlich am ende nicht reichen, zumindest nicht so wie ichs aktuell habe
.Code: Alles auswählen
Structure Font
PB_Nr.l[256] ;Spritenummer der Zeichen
Width.l[256] ;die Breite der Sprites
Height.l ;die Höhe der Sprites
Emty.l ;die PB_Nr der leeren Grafik
Spacing.l ;Zeichenabstand
EndStructure
ProcedureDLL CreateFont(Name$, Size, Color, Flags)
Protected FontID.l, *Font.Font, Last.l, Start.l, Stop.l, tempImage.l, TransparentColor.l
;Schwarz ist Transparent!
If Red(Color) <= 8 And Green(Color) <= 8 And Blue(Color) <= 8: Color = RGB(8, 8, 8) : EndIf
;laden des Fonts
FontID = LoadFont(#PB_Any, Name$, Size, Flags)
If FontID = #False
ProcedureReturn #False
EndIf
;resservieren des Speichers
*Font = AllocateMemory(SizeOf(Font))
If *Font = #False
ProcedureReturn #False
EndIf
;erstellt eine 1X1 große Grafik, welches mit transparenter Farbe
;belegt wird, damit es nicht sichtbar ist
TransparentColor = RGB(255, 255, 255)
*Font\Emty = CreateImage(#PB_Any, 1, 1)
StartDrawing(ImageOutput())
Plot(0, 0, TransparentColor)
StopDrawing()
If *Font\Emty = #False : FreeMemory(*Font) : ProcedureReturn #False : EndIf
For Num = 0 To 255
*Font\PB_Nr[Num] = *Font\Emty
Next
;die richtige Höhe ermitteln
Size * 2 ;zur Sicherheit doppelte Höhe beim testen
Start = Size
tempImage = CreateImage(#PB_Any, Size, Size)
StartDrawing(ImageOutput())
Box(0, 0, Size, Size, TransparentColor)
UseFont(FontID)
DrawingFont(FontID())
For Num = 0 To 255 ;durchlaufen aller existierenden Sprites
;ermitteln der Zeichenbreite
*Font\Width[Num] = TextLength(Chr(Num))
If *Font\Width[Num] > 0
;den Buchstaben zeichnen
Box(0, 0, *Font\Width[Num], Size, TransparentColor)
DrawingFont(FontID())
DrawingMode(1)
FrontColor(Red(Color), Green(Color), Blue(Color))
Locate(0, 0)
DrawText(Chr(Num))
;ermitteln des ersten Pixels von oben
For Y = 0 To Size-1
For X = 0 To *Font\Width[Num]-1
If Point(X, Y) <> TransparentColor
Break 2
EndIf
Next
Next
If Start > Y : Start = Y : EndIf
;ermitteln des ersten Pixels von Unten
For Y = Size-1 To 0 Step -1
For X = 0 To *Font\Width[Num]-1
If Point(X, Y) <> TransparentColor
Break 2
EndIf
Next
Next
If Stop < Y : Stop = Y : EndIf
EndIf
Next
StopDrawing()
FreeImage(tempImage)
*Font\Height = Stop - Start+1
;erstellt die einzellnen Grafiken
For Num = 0 To 255
If *Font\Width[Num] > 0
*Font\PB_Nr[Num] = CreateImage(#PB_Any, *Font\Width[Num], *Font\Height)
If *Font\PB_Nr[Num] = #False
FreeImage(*Font\Emty)
For Num2 = 0 To Num-1
FreeImage(*Font\PB_Nr[Num2])
Next
FreeMemory(*Font)
ProcedureReturn #False
EndIf
StartDrawing(ImageOutput())
Box(0, 0, *Font\Width[Num], *Font\Height, TransparentColor)
DrawingFont(FontID())
DrawingMode(1)
FrontColor(Red(Color), Green(Color), Blue(Color))
Locate(0, -Start)
DrawText(Chr(Num))
StopDrawing()
Else
*Font\PB_Nr[Num] = *Font\Emty
EndIf
Next
CloseFont(FontID)
ProcedureReturn *Font
EndProcedure
ProcedureDLL DrawFontText(DC, Text$, X, Y, FontID)
Protected Pos.l, Len.l, Num.l, *Font.Font, X2.l, tempDC.l, SourceDC.l, tempBMP.l, maskDC.l, Width
If FontID = 0
ProcedureReturn #False
EndIf
*Font = FontID
Len = Len(Text$)
For Pos = 1 To Len
Width + *Font\Width[PeekB(@Text$ + Pos - 1) & $FF] + *Font\Spacing
Next
Width - *Font\Spacing
; ---------------------------------------------------------------
;-hier drumm gehts :-)
SourceDC = CreateCompatibleDC_(DC)
tempBMP = CreateBitmap_(Width, *Font\Height, 1, 32, 0)
DeleteObject_(SelectObject_(SourceDC, tempBMP))
X2 = 0
For Num = 0 To Len
tempDC = CreateCompatibleDC_(SourceDC)
Pos = PeekB(@Text$ + Num) & $FF
DeleteObject_(SelectObject_(tempDC, UseImage(*Font\PB_Nr[Pos])))
BitBlt_(SourceDC, X2, 0, *Font\Width[Pos], *Font\Height, tempDC, 0, 0, #SRCCOPY)
X2 + *Font\Width[Pos] + *Font\Spacing
DeleteDC_(tempDC)
Next
; --------------------------------------------------------------
;original aus dem englischen Forum von Fred
maskDC = CreateCompatibleDC_(DC)
tempDC = CreateCompatibleDC_(DC)
hMaskBmp = CreateBitmap_(Width, *Font\Height, 1, 1, 0)
hTempBmp = CreateCompatibleBitmap_(DC, Width, *Font\Height)
DeleteObject_(SelectObject_(maskDC, hMaskBmp))
DeleteObject_(SelectObject_(tempDC, hTempBmp))
BitBlt_ (maskDC, 0, 0, Width, *Font\Height, SourceDC, 0, 0, #SRCCOPY)
BitBlt_ (tempDC, 0, 0, Width, *Font\Height, maskDC, 0, 0, #SRCCOPY)
BitBlt_ (DC, X, Y, Width, *Font\Height, tempDC, 0, 0, #MERGEPAINT)
BitBlt_ (DC, X, Y, Width, *Font\Height, SourceDC, 0, 0, #SRCAND)
DeleteObject_(hMaskBmp)
DeleteObject_(hTempBmp)
DeleteObject_(tempBMP)
DeleteDC_(maskDC)
DeleteDC_(SourceDC)
DeleteDC_(tempDC)
ProcedureReturn #True
EndProcedure
FontID1 = LoadFont(#PB_Any, "Times New Roman", 8)
FontID2 = CreateFont("Times New Roman", 10, RGB(0, 255, 0), 0)
OpenWindow(0, 100, 100, 800, 600, 0, "Font Geschwindigkeits Test")
#Rounds = 10000
StartTimer1 = ElapsedMilliseconds()
For Num = 1 To #Rounds
StartDrawing(WindowOutput())
Box(0, 0, 800, 600, RGB(255,255,255))
DrawingFont(UseFont(FontID1))
DrawingMode(1)
FrontColor(0, 255, 0)
Locate(10, 10)
DrawText("PB-Font")
Locate(10,22)
DrawText("FPS: "+ Str(FPS) + " Round: "+ Str(Num)+"/"+Str(#Rounds))
StopDrawing()
FPSCounter + 1
If ElapsedMilliseconds() >= FPSTimer + 1000 : FPS = FPSCounter : FPSCounter = 0 : FPSTimer = ElapsedMilliseconds() : EndIf
Next
EndTimer1 = ElapsedMilliseconds()
StartTimer2 = ElapsedMilliseconds()
For Num = 1 To #Rounds
DC = StartDrawing(WindowOutput())
Box(0, 0, 800, 600, 0)
DrawFontText(DC, "eigener Font", 10, 10, FontID2)
DrawFontText(DC, "FPS: "+ Str(FPS) + " Round: "+ Str(Num)+"/"+Str(#Rounds), 10, 22, FontID2)
StopDrawing()
FPSCounter + 1
If ElapsedMilliseconds() >= FPSTimer + 1000 : FPS = FPSCounter : FPSCounter = 0 : FPSTimer = ElapsedMilliseconds() : EndIf
Next
EndTimer2 = ElapsedMilliseconds()
Message$ = "Timer1: "+Str(EndTimer1-StartTimer1)+" ms"+Chr(13)+Chr(10)
Message$ + "Timer2: "+Str(EndTimer2-StartTimer2)+" ms"
MessageRequester("Ergebnis", Message$)
Das müsste doch eigentlich möglich sein, ohne dass jedes mal ein DC
für ein zu zeichnender Buchstaben erstellen werden muss. Wie man sieht geht es mit dem Windowsfonts viel schneller.
Vielleicht gibt es aber eine komplet andere möglichkeit? Ein bereits irgend wo gepostete? -.-
Und an dem beispiel nicht beirren lassen, natürlich ist es dafür, später eigene Fonts aus Grafikdateien zu laden
. Das Flimmern ist hier auch nur nebensache, geht nur um die optimierung des Befehls.Wäre um hilfe sehr dankbar
MFG PMV