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!

Code-Beispiel

Code-Beispiele » Grafik und Fonts

Laufschrift mit 64 x 32 Font

Lizenz:Erster Autor:Letzte Bearbeitung:
k. A.RedakteurVolta 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
  • Das Code-Beispiel wurde am 11.02.2013 von RedakteurVolta angelegt.
  • Die aktuellste Version wurde am 27.07.2016 von RedakteurVolta gespeichert.
  Bearbeiten Bearbeiten  

  Versionen Versionen