RainBow Scroll Text

[kevin]

 RainBow Scroll Text

 This example creates a TEXT like replacement that draws the rainbow coloured message.  The text is coloured using a scan line palette, this creates  the classic retro  RASTER bar style effect of old.  

   

PlayBASIC Code: [Select]

   c1=rndrgb()
   c2=rndrgb()
   c3=rndrgb()
   c4=rndrgb()

   ShadeBox   0,0,200,5,C1,c2,c2,c1
   ShadeBox 200,0,400,5,C2,c3,c3,c2
   ShadeBox 400,0,600,5,C3,c4,c4,c3
   ShadeBox 600,0,800,5,C4,c1,c1,c4

   Dim Palette(799)
   For lp=0 to 799
         Palette(lp)=Point(lp,0) | $ff000000
   next

   loadFont "arial",2,128,0
   MakeBitmapFont 2,$ffffffff,8
   Setfont 2   


   ScreenVsync on

   Message$="Hello World Hello World Hello World............................."
   ScrollWidth=GetTextWidth(Message$)
   ScrollX=800
   
   Do
      Cls 0

      For ylp=0 to 5
         RainBowText(Message$,ScrollX,100*ylp,Palette(),Ylp=0)   
      next
      ScrollX-=1
      if ScrollX<(-ScrollWidth) then ScrollX=800
   
      print Fps()
      Sync
   loop
   
   

Function RainBowText(Message$,xpos,ypos,Pal(),BumpOffset)   
   oldink=getink()
   ScreenWidth=GetScreenWidth()
   ScreenHeight=GetScreenHeight()

   y1=ypos
   y2=ypos+GetTextHeight(Message$)

   Palsize=Getarrayelements(pal())

   static Offset
   Offset=mod(Offset+(BumpOffset*4),PalSize)

   lockbuffer
   For ylp=y1 to y2
      ScreenViewport 0,ylp,ScreenWidth,ylp+1
      pos=mod(Offset+(ylp-y1),PalSize)
      Ink Pal(pos)
      text xpos,ypos,Message$   
   next
   unlockbuffer
   ScreenViewport 0,0,ScreenWidth,ScreenHeight
   ink oldink
EndFunction



 

 Built using PlayBASIC V1.64M .