Color Text Scrolling

This is going to be part of my QB-like IDE (QBLIDE, pronounced cube-lied). It scrolls text with the arrow keys. Thanks to DJ Peters (Joshy) for the base code, and Dr_D for correcting my UDT errors. Will compile in 0.16 and 0.17 without modification thanks to a little preproc trick.

Kind of useless right now, but interesting. Comment out the screenlock/unlock to see this thing really fly.

'base code from DJ Peters (Joshy)
'Spaz_man modified it to use colored text and did some cleanup
'Dr_D corrected mistakes in UDT usage

#Include "fbgfx.bi"

#if __FB_VERSION__ >= "0.17"
  Using FB
#endif

ScreenRes 640,400,8
#define max_x 100
#define max_y 100

Type text Field=1
  char As String*1
  fgc As Ubyte
  bgc As Ubyte
End Type

Dim As text Ptr    lpRow,lpTextBuffer
Dim As Integer     xPos,yPos,xLast,yLast,i,j,doit=0

lpTextBuffer=callocate(max_x*max_y*sizeof(text))

ScreenInfo xLast,yLast
xLast Shr=3:yLast Shr=3

For i = 0 To max_x*max_y-1
  lpTextBuffer[i].char=Chr(32+Int(Rnd*32))
  lpTextBuffer[i].fgc=Int(Rnd*8)
  lpTextBuffer[i].bgc=Int(Rnd*8)
Next

lpTextBuffer[0              ].char = Chr$(65) ' left top
lpTextBuffer[max_x-1        ].char = Chr$(65) ' right top
lpTextBuffer[(max_y-1)*max_x].char = Chr$(65) ' left bottom
lpTextBuffer[max_y*max_x-1  ].char = Chr$(65) ' right bottom

lpTextBuffer[0              ].fgc  = 1
lpTextBuffer[max_x-1        ].fgc  = 1 ' right top
lpTextBuffer[(max_y-1)*max_x].fgc  = 1 ' left bottom
lpTextBuffer[max_y*max_x-1  ].fgc  = 1 ' right bottom

lpTextBuffer[0              ].bgc  = 2 ' left top
lpTextBuffer[max_x-1        ].bgc  = 2 ' right top
lpTextBuffer[(max_y-1)*max_x].bgc  = 2 ' left bottom
lpTextBuffer[max_y*max_x-1  ].bgc =  2 ' right bottom

Print __FB_VERSION__
Sleep
Cls

Do
  If MultiKey(SC_UP   ) And yPos > 0 Then yPos-=1:doit=1
  If MultiKey(SC_DOWN ) And yPos < max_y-yLast Then yPos+=1:doit=1
  If MultiKey(SC_LEFT ) And xPos > 0 Then xPos-=1:doit=1
  If MultiKey(SC_RIGHT) And xPos < max_x-xLast Then xPos+=1:doit=1

  If doit=1 Then
    lpRow=lpTextBuffer+xPos+yPos*max_x
    windowtitle xPos & "," & yPos
    screenlock
    For i=1 To yLast
      For j=0 To xLast-1
        Color lpRow[j].fgc,lpRow[j].bgc
        Print lpRow[j].char;
      Next
      lpRow+=max_x
    Next
    DoIt=0
    screenunlock
  End If
Loop Until MultiKey(SC_ESCAPE)
deallocate(lpTextBuffer)
End
Unless otherwise stated, the content of this page is licensed under Creative Commons Attribution-Share Alike 2.5 License.