Buchempfehlung
Mikrocomputertechnik mit Controllern der Atmel AVR-RISC-Familie
Mikrocomputertechnik mit Controllern der Atmel AVR-RISC-Familie
Umfassend, aber leicht verständlich führt dieses Buch in die Programmierung von ATMEL AVR Mikrocontrollern ein. [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

Mehrfarbige Fonts

Uploader:RedakteurJojo
Datum/Zeit:12.05.2008 12:27:11

Function fadefont(maxr As Integer, maxg As Integer, maxb As Integer, fadeval As Integer) As UByte Ptr

    Dim first As UByte = 32
    Dim last As UByte = 255

    Dim myFont As UByte Ptr

    Dim As Integer i,x,y,r,g,b,pntr,depth,bitl,pixel

    ScreenInfo ,,depth

    Select Case depth
    Case Is <= 8: bitl = 1
    Case 9 To 23: bitl = 2
    Case Else: bitl = 4
    End Select

    myFont = ImageCreate((LAST - FIRST + 1) * 8, 17)

    myFont[4] = 0
    myFont[5] = FIRST
    myFont[6] = LAST

    i=130
    Restore OwnCharCopyright
    For y = 0 To 15
        For x = 0 To 7
            pntr = (LAST - FIRST + 1) * depth + (i-First) * depth + y * (Last-First+1) * depth + (x + 1) * bitl
            Read pixel
            If pixel = 0 Then
                myFont[pntr+2]=255
                myFont[pntr+1]=0
                myFont[pntr+0]=255
            Else
                myFont[pntr+2]=255
                myFont[pntr+1]=0
                myFont[pntr+0]=0
            End If
        Next x
    Next y
    For i = FIRST To LAST
        myfont[7 + i - FIRST] = 8
        If i = 32 Then myfont[7 + i - FIRST] = 6
        If i = 33 Then myfont[7 + i - FIRST] = 10
        If i <> 130 Then Draw String myFont, ((i - FIRST) * 8, 1), Chr(i),RGB(255,0,0)
        For x = 0 To 7
            For y = 0 To 15
                pntr = (LAST - FIRST + 1) * depth + (i-First) * depth + y * (Last-First+1) * depth + (x + 1) * bitl
                r = myFont[pntr + 2]
                g = myFont[pntr + 1]
                b = myFont[pntr]
                If r = 255 And g = 0 And b = 0 Then
                    myFont[pntr]=maxb-y*fadeval
                    myFont[pntr+1]=maxg-y*fadeval
                    myFont[pntr+2]=maxr-y*fadeval
                End If
            Next y
        Next x
    Next i
    Function = myfont

End Function

    OwnCharCopyright:
    Data 0,0,0,0,0,0,0,0
    Data 0,0,0,0,0,0,0,0
    Data 0,0,0,0,0,0,0,0
    Data 0,0,1,1,1,1,0,0
    Data 0,1,0,0,0,0,1,0
    Data 1,0,0,1,1,0,0,1
    Data 1,0,1,0,0,0,0,1
    Data 1,0,1,0,0,0,0,1
    Data 1,0,0,1,1,0,0,1
    Data 0,1,0,0,0,0,1,0
    Data 0,0,1,1,1,1,0,0
    Data 0,0,0,0,0,0,0,0
    Data 0,0,0,0,0,0,0,0
    Data 0,0,0,0,0,0,0,0
    Data 0,0,0,0,0,0,0,0
    Data 0,0,0,0,0,0,0,0