Buchempfehlung
Visual Basic 6 Kochbuch
Visual Basic 6 Kochbuch
Viele praktische Tipps zum Programmieren mit Visual Basic 6, die sich oft auch auf FB übertragen lassen. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe
Liste
Übersicht / Liste
Neu
Datei hochladen
Suche
Quellcode suchen
Download
Dateidownload

4.6: Verschiedene Schriftgrößen gleichzeitig

Uploader:Redakteurnemored
Datum/Zeit:24.09.2011 12:15:38
Hinweis: Dieser Quelltext ist Bestandteil des Projekts OpenBook: 2D-Spieleprogrammierung, zu dem es auf FreeBASIC-Portal.de eine Projektseite gibt.

' *** CODE 4.6: Verschiedene Schriftgrößen gleichzeitig

'fb_font_x.bas by Volta

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

SCREENRES 300, 200, 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
GETKEY