Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!Code-Beispiel
Laufschrift mit 64 x 32 Font
| Lizenz: | Erster Autor: | Letzte Bearbeitung: |
| k. A. |  Volta |  27.07.2016 |
'Laufschrift mit 64 x 32 Font (vergroesserter 16x8 Font)
'-Volta- 10.2.2013
'als 32/64Bit Verion 27.7.2016
Declare Sub ImageScale2x(ByVal As Ulong Ptr, ByVal As ULong Ptr)
Declare Sub scroll(image As Any Ptr, s As Long=1)
Declare Function Image_x2(image As Any Ptr) As Any Ptr
ScreenRes 800, 64, 32,,16 'Splashscreen-Modus
Color 0,&Hff00ff 'Hintergrund transparent
Width 800/8, 64/16 'Fonts 16x8 einstellen
Dim As String s= "Dies ist eine Laufschrift !!!" 'Text der Laufschrift
'Dim As String s= "This is a scrolling text!!!"
Dim As Any Ptr a= ImageCreate( Len(s)*8, 16)
Draw String a,(0,0), s, &Hff5555 'mit Font 16x8 in ein Image schreiben
a= Image_x2(a) 'Schrifthoehe -breite *2
a= Image_x2(a) 'Schrifthoehe -breite *2
scroll(a) 'als Laufschrift anzeigen
ImageDestroy a
'ImageScale2x (source image ptr, Dest image ptr)
Sub ImageScale2x(ByVal Image As Ulong Ptr, ByVal Dest As ULong Ptr)
Dim As ULong B, D, E, F, H '|A|B|C|
Dim As Long j, k, ic, dc, dp, x, y, pitch'+-+-+-+ / |E0|E1|
ImageInfo Dest,dp,,,,Dest '|D|E|F| E +--+--+
ImageInfo image,x,y,,pitch,image '+-+-+-+ \ |E2|E3|
pitch \= 4 '|G|H|I|
For k = 0 To y-1
For j = 0 To x-1
If k Then B = Image[ic - pitch] Else B = Image[ic]
If k = y-1 Then H = Image[ic] Else H = Image[ic + pitch]
If j Then
D = E
E = F
Else
E = Image[ic]
D = E
EndIf
If j < x-1 Then F = Image[ic + 1]
If B <> H And D <> F Then
If D = B Then Dest[dc] = D Else Dest[dc] = E
If B = F Then Dest[dc + 1] = F Else Dest[dc + 1] = E
If D = H Then Dest[dc + dp] = D Else Dest[dc + dp] = E
If H = F Then Dest[dc + dp +1] = F Else Dest[dc + dp +1] = E
Else
Dest[dc] = E
Dest[dc + 1] = E
Dest[dc + dp] = E
Dest[dc + dp +1] = E
End If
ic +=1
dc +=2
Next j
ic = ic+pitch-x
dc = dc+((dp-x)*2)
Next k
End Sub
Sub scroll(image As Any Ptr, s As Long)
Dim As Long i, x, ix, iy
ScreenInfo x
ImageInfo image,ix,iy
For i = x To 0 Step -2
Put (i,0),image, PSet
Sleep s,1
Next
For i = 0 To ix Step 2
Put (0,0),image,(i,0)-(ix, iy), PSet
Sleep s,1
Next
End Sub
Function Image_x2(image As Any Ptr) As Any Ptr
Dim image2 As Any Ptr
Dim As long b, h
ImageInfo image, b, h
b *=2 : h *=2 'Schrifthoehe -breite *2
image2= ImageCreate(b, h)
ImageScale2x image, image2
If image Then ImageDestroy image
Function = image2
End Function
| Zusätzliche Informationen und Funktionen | |||||||
|---|---|---|---|---|---|---|---|
|
|||||||
Bearbeiten
Versionen