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