|
Das deutsche QBasic- und FreeBASIC-Forum Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
|
Vorheriges Thema anzeigen :: Nächstes Thema anzeigen |
Autor |
Nachricht |
michaelblasin
Anmeldungsdatum: 09.11.2010 Beiträge: 38
|
Verfasst am: 12.02.2018, 21:17 Titel: Benutzer definierter Zeichensatz für ein dreisprachiges Lexi |
|
|
Betr: Benutzer definierter Zeichensatz für ein dreisprachiges Lexikon
Hallo,
In der FREEBASIC Referenz gibt es in der alphabetischen Befehlsreferenz ein Beispiel für einen eingenen Zeichensatz in 'DRAW STRING'.
Der Zeichensatz wird im Programm 'FONT.BAS' in 'myfont.fbf' gespeichert.
Den Zeichensatz will ich ergänzen, das funktioniert auch. Ich habe z.B. das 'A' geändert, es geht.
Den Zeichensatz will ich dann wieder aus der Datei lesen
( Mein Programm 'MichaelFont'), da gibt es aber ein Problem beim compilieren bei:
BLOAD, "myfont.fbf", myFont, 0
Dann ist das
' p = Zeiger auf den FontHeader
p = myFont + IIf(myFont[0] = 7, 32, 4)
p[0] = 0 'Fontversion bisher immer 0
p[1] = Erster 'erster Buchstabe im Font
p[2] = Letzter 'letzter Buchstabe im Font
nicht aus der Datei, sondern aus dem Programm. Es sollte besser aus der Datei sein
Kennt sich jemand aus?
Gruss M Blasin
Das Programmbeispiel darin ist:
-------------------------------------------------
' Programmname FONT.BAS
' CHR-Bereich festlegen
Const Erster = 32, Letzter = 255, Anzahl = (Letzter - Erster) + 1
Dim As UByte Ptr p, myFont
Dim As Integer farbe
' Einen 256 Farbgrafik-Screen (320*200) erzeugen
ScreenRes 320, 200, 8
' Erstellen eines Benutzerfonts in einem Image
' (Anzahl Zeichen * Zeichenbreite , Zeichenhöhe + 1(für Fontheader))
myFont = ImageCreate(Anzahl * 8, 8 +1)
' p = Zeiger auf den FontHeader
p = myFont + IIf(myFont[0] = 7, 32, 4)
p[0] = 0 'Fontversion bisher immer 0
p[1] = Erster 'erster Buchstabe im Font
p[2] = Letzter 'letzter Buchstabe im Font
For i As Integer = Erster To Letzter
p[3 + i - Erster] = 8 'Zeichenbreite
farbe = 60 + (i Mod 24) 'Zeichenfarbe
'Zeichen in Font-Puffer kopieren (aus kleinem Standard Font)
Draw String myFont, ((i - Erster) * 8, 1), Chr(i), farbe
Next i
' Den Font-Puffer können wir mit BSAVE abspeichern.
' Die Anzahl zu speichernde Byte berechnet sich aus
' (Anzahl * Zeichenbreite * (Zeichenhöhe + 1) * Byte_per_Pixel) + ImageHeader
BSave "myfont.fbf", myFont, (Anzahl * 8 * 9 * 1)+32
' Als Bitmap können wir den Font so speichern:
BSave "myfont.bmp", myFont
' Hier zeichnen wir einen String mit unserem Font
Draw String (10, 10), "ABCDEFGHIJKLMNOPQRSTUVWXYZ",, myFont
Draw String (10, 26), "abcdefghijklmnopqrstuvwxyz",, myFont
Draw String (66, 5, "Hello world!",, myFont
ImageDestroy myFont 'Speicherbereich freigeben
Sleep
------------------------------------------------
'Programname 'MichaelFont'
' CHR-Bereich festlegen
Const Erster = 32, Letzter = 255, Anzahl = (Letzter - Erster) + 1
Dim As UByte Ptr p, myFont
Dim As Integer farbe
' Einen 256 Farbgrafik-Screen (320*200) erzeugen
ScreenRes 320, 200, 8
myFont = ImageCreate(Anzahl * 8, 8 +1)
BLOAD, "myfont.fbf", myFont, 0
' p = Zeiger auf den FontHeader
p = myFont + IIf(myFont[0] = 7, 32, 4)
p[0] = 0 'Fontversion bisher immer 0
p[1] = Erster 'erster Buchstabe im Font
p[2] = Letzter 'letzter Buchstabe im Font
' Hier zeichnen wir einen String mit unserem Font
'Draw String (10, 10), "ABCDEFGHIJKLMNOPQRSTUVWXYZ",, myFont
Draw String (10, 26), "abcdefghijklmnopqrstuvwxyz",, myFont
Draw String (66, 5, "Hello world!",, myFont
ImageDestroy myFont 'Speicherbereich freigeben
Sleep |
|
Nach oben |
|
|
volta
Anmeldungsdatum: 04.05.2005 Beiträge: 1875 Wohnort: D59192
|
Verfasst am: 12.02.2018, 23:09 Titel: |
|
|
Hi,
wenn der Zeichensatz erstellt ist, muss er nur geladen werden.
Code: | ' Einen 256 Farbgrafik-Screen (320*200) erzeugen
ScreenRes 320, 200, 8
' Für dieses Beispiel brauchen wir den zuvor
' erstellten Font 'myfont.fbf', siehe Beispiel 2
' Dies brauche ich nur wenn Breite und Hoehe unbekannt sind
' sonst breit = Anzahl * 8 : hoch = 9
Dim As Integer breit, hoch, ff = FreeFile
If Open("myfont.fbf" For Binary Access Read As #ff)<>0 Then
Close #ff
Print "keine Fontdatei gefunden!"
Sleep
End
End If
Get #ff, 14, breit
Get #ff, 18, hoch
Close #ff
' Erstellen eines Benutzerfonts im Image
Dim As UByte Ptr myFont = ImageCreate(breit, hoch)
' Jetzt können wir den Font mit BLoad laden
BLoad "myfont.fbf", myFont
' Ein blauer Hintergrund
'Paint (0, 0), 1
' Hier zeichnen wir einen String mit unserem Font
Draw String (10, 10), "ABCDEFGHIJKLMNOPQRSTUVWXYZ",, myFont
Draw String (10, 26), "abcdefghijklmnopqrstuvwxyz",, myFont
Draw String (66, 58), "Hello world!",, myFont
ImageDestroy myFont 'Speicherbereich freigeben
Sleep | Der Pointer p muss nicht geändert werden- _________________ Warnung an Choleriker:
Dieser Beitrag kann Spuren von Ironie & Sarkasmus enthalten.
Zu Risiken & Nebenwirkungen fragen Sie Ihren Therapeuten oder Psychiater. |
|
Nach oben |
|
|
|
|
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.
|
|