Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
 
FAQFAQ   SuchenSuchen   MitgliederlisteMitgliederliste   BenutzergruppenBenutzergruppen  RegistrierenRegistrieren
ProfilProfil   Einloggen, um private Nachrichten zu lesenEinloggen, um private Nachrichten zu lesen   LoginLogin
Zur Begleitseite des Forums / Chat / Impressum
Aktueller Forenpartner:

Die 3 "eingebauten" FB_Fonts

 
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Allgemeine Fragen zu FreeBASIC.
Vorheriges Thema anzeigen :: Nächstes Thema anzeigen  
Autor Nachricht
volta



Anmeldungsdatum: 04.05.2005
Beiträge: 1876
Wohnort: D59192

BeitragVerfasst am: 13.03.2008, 22:30    Titel: Die 3 "eingebauten" FB_Fonts Antworten mit Zitat

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 happy
_________________
Warnung an Choleriker:
Dieser Beitrag kann Spuren von Ironie & Sarkasmus enthalten.
Zu Risiken & Nebenwirkungen fragen Sie Ihren Therapeuten oder Psychiater.
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden Website dieses Benutzers besuchen
Jojo
alter Rang


Anmeldungsdatum: 12.02.2005
Beiträge: 9736
Wohnort: Neben der Festplatte

BeitragVerfasst am: 13.03.2008, 22:46    Titel: Antworten mit Zitat

Hey, gut zu wissen - Das merk ich mir zwinkern
_________________
» Die Mathematik wurde geschaffen, um Probleme zu lösen, die es nicht gäbe, wenn die Mathematik nicht erschaffen worden wäre.
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden Website dieses Benutzers besuchen
Caran



Anmeldungsdatum: 11.03.2007
Beiträge: 290
Wohnort: Lörrach

BeitragVerfasst am: 13.03.2008, 23:06    Titel: Antworten mit Zitat

Durchaus interessant. zwinkern
_________________
Eine Erkenntnis von heute kann die Tochter eines Irrtums von gestern sein.
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
Beiträge der letzten Zeit anzeigen:   
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Allgemeine Fragen zu FreeBASIC. Alle Zeiten sind GMT + 1 Stunde
Seite 1 von 1

 
Gehe zu:  
Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.

 Impressum :: Datenschutz