Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Mehrfarbige Fonts
| Uploader: |  Jojo |
| 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