volta
Anmeldungsdatum: 04.05.2005 Beiträge: 1876 Wohnort: D59192
|
Verfasst am: 13.03.2008, 22:30 Titel: Die 3 "eingebauten" FB_Fonts |
|
|
Hi,
gerade erst habe ich entdeckt wie man die 3 fb_fonts, die im fbgfx-Modus immer mitgeliefert werden, gezielt einstellen kann.
Code: | 'set_font.bas by Volta
'Idee von counting_pine
'http://www.freebasic.net/forum/viewtopic.php?p=94251#94251
Sub set_font (ByVal f As Integer)'nur 8, 14 oder 16 funktioniert richtig
Dim As Integer breit, hoch
ScreenInfo breit, hoch
Width breit\8, hoch\f' hier wird auto. Cls ausgeführt
End Sub
Const w = 400, h = 100
ScreenRes w, h, 32 'Set up a graphics screen
Dim As Integer Zeilen, Spalten
Zeilen = LoWord(Width) 'nicht nur im Console-Modus
Spalten = HiWord(Width)'die Anzahl Zeilen und Spalten abfragen.
Print "Voreinstellung bei Sceenres " & w & ", " & h & " (8*8 font)"
Print "Zeilen: " & Zeilen
Print "Spalten: " & Spalten
Draw String (10,80),"Schrifttyp 8x8 Font (Draw String)",&Hffffff
Sleep
set_font 16 ' 8*16 font
Zeilen = LoWord(Width)
Spalten = HiWord(Width)
Print "Set to 8*16 font (Width w\8, h\16)"
Print "Zeilen: " & Zeilen
Print "Spalten: " & Spalten
Draw String (10,80),"Schrifttyp 8x16 Font (Draw String)",&Hff0000
Sleep
set_font 14 ' 8*14 font
Zeilen = LoWord(Width)
Spalten = HiWord(Width)
Print "Set to 8*14 font (Width w\8, h\14)"
Print "Zeilen: " & Zeilen
Print "Spalten: " & Spalten
Draw String (10,80),"Schrifttyp 8x14 Font (Draw String)",&Hff0000
Sleep
set_font 8 ' 8*8 font
Zeilen = LoWord(Width)
Spalten = HiWord(Width)
Print "Set to 8*8 font (Width w\8, h\8)"
Print "Zeilen: " & Zeilen
Print "Spalten: " & Spalten
Draw String (10,80),"Schrifttyp 8x8 Font (Draw String)",&Hff0000
Sleep
| Einziger Nachteil dabei: bei jeder Umstellung des Zeichensatzes wird das Fenster gelöscht (Cls). Also gleichzeitig kann man so nicht verschiedene Zeichensätze benutzen.
Mit Draw String lassen sich die internen Zeichensätze auch nicht direkt benutzen. Aber über eine eigene Routine ähnlich der alten GfxPrint ist das möglich.
Code: | 'fb_font_x.bas by Volta
'ab FB-Version 0.18 (neuer Header für die fb_font's)
'Idee von der alten GfxPrint-Routine
Type fb_font_x
As Integer breit, hoch
As Any Ptr start
End Type
Extern Font8 Alias "fb_font_8x8" As fb_font_x
Extern Font14 Alias "fb_font_8x14" As fb_font_x
Extern Font16 Alias "fb_font_8x16" As fb_font_x
Sub DrawString( ByVal buffer As Any Ptr=0, ByVal xpos As Integer, ByVal ypos As Integer, _
ByRef text As String, ByVal fgcol As Integer=Color, ByRef f As fb_font_x)
Dim As Integer l,bits,xend
Dim row As UByte Ptr
l = Len(text)-1
If l<0 Then Exit Sub
ScreenInfo xend
ScreenLock
For i As Integer = 0 To l
row = text[i]*f.hoch+f.start
For y As Integer= ypos To ypos+f.hoch-1
bits = *row
For x As Integer= xpos To xpos+7
If (bits And 1) Then
If (buffer = 0) Then
PSet (x,y),fgcol
Else
PSet buffer,(x,y),fgcol
End If
End If
bits = bits Shr 1
Next
row +=1
Next
xpos +=f.breit
If (xpos-f.breit)>xend Then Exit For
Next
ScreenUnLock
End Sub
Screen 18,32
DrawString ,10,10,"Schrifttyp 8x8 Font",&hff0000,Font8
DrawString ,30,30,"Schrifttyp 8x14 Font",&h00ff00,Font14
DrawString ,60,60,"Schrifttyp 8x16 Font",&h0000ff,Font16
Draw String (80,80),"Schrifttyp 8x16 Font (Draw String)",&Hffffff
Sleep | Die eigene DrawString - Routine habe ich extra so aufgebaut, dass man von Draw String zu> DrawString nur wenig an dem Aufruf ändern muss.
Viel Spaß damit  _________________ Warnung an Choleriker:
Dieser Beitrag kann Spuren von Ironie & Sarkasmus enthalten.
Zu Risiken & Nebenwirkungen fragen Sie Ihren Therapeuten oder Psychiater. |
|