[DBC] Scrolling Text Box Function With Text Wrap

Author

Message

TDK

Retired Moderator

21

Years of Service

User Offline

Joined: 19th Nov 2002

Location: UK

Posted: 28th Jan 2008 21:16 Edited at: 29th Jan 2008 05:04

Link

This function for DB Classic can be used instead of the Print command to output text to the screen.

The difference is that you can also define a rectangle on the screen into which the text is placed, the background colour of this rectangle and the colour of the printed text.

There's also a border flag so you can have a white line defining the text area if you need it.

When the maximum number of lines available in the text area have been used, the next call to ScrollPrint() will automatically scroll the existing text up to accommodate the new text. Also, lines wider than the text area are automatically wrapped onto the following line.

Calling the function with different variables allows you to have multiple text box areas on the same screen (as shown in the demo).

The Function:

Function ScrollPrint(WindowNum,XPos,YPos,ScrollBoxWidth,ScrollBoxHeight,NewLine$,BColour,TColour,Border)
  Rem ******************************************************************************************
  Rem Note: The following 3 Dim lines MUST be included at the start of your program
  Rem       before calling the function or it will result in an eror.
  Rem
  Rem       Dim Display$(100,6): Rem Array required for function
  Rem       Dim ArrayPointer(0,6): Rem Array required for function
  Rem       Dim SplitLine$(10,6): Rem Array required for function
  Rem
  Rem ******************************************************************************************
  TH = Text Height("A"): Numlines = (ScrollBoxHeight/TH)-2: LinesToAdd = 1
  If NewLine$ <> ""
    LineWidth = Text Width(NewLine$): NumChars = Len(NewLine$)
    If LineWidth > ScrollBoxWidth-10
      ThisLine$ = "": CharCount = 0: TotalCharCount = 0
      Repeat
        Inc CharCount: Inc TotalCharCount
        ThisChar$ = Mid$(NewLine$,CharCount)
        If ThisChar$ = " " Then LastSpace = CharCount
        ThisLine$ = ThisLine$+ThisChar$
        ThisLineLen = Text Width(ThisLine$)
        If ThisLineLen > ScrollBoxWidth-10
          SplitLine$(LinesToAdd,WindowNum)= Left$(ThisLine$,LastSpace)
          NewLine$ = Right$(NewLine$,Len(NewLine$)-Len(SplitLine$(LinesToAdd,WindowNum)))
          Inc LinesToAdd
          CharCount = 0: ThisLine$ = "": ThisLineLen = 0
        Endif
      Until Text Width(NewLine$) < ScrollBoxWidth-10
      SplitLine$(LinesToAdd,WindowNum) = NewLine$
    Endif
    If LinesToAdd = 1
      If ArrayPointer(0,WindowNum) < Numlines+1
        Display$(ArrayPointer(0,WindowNum),WindowNum) = NewLine$
        ArrayPointer(0,WindowNum) = ArrayPointer(0,WindowNum)+1
      Else
        Display$(ArrayPointer(0,WindowNum),WindowNum) = NewLine$
        For N = 0 To Numlines
          Display$(N,WindowNum) = Display$(N+1,WindowNum)
        Next N
      Endif
    Else
      If ArrayPointer(0,WindowNum)+LinesToAdd < Numlines+1
        For N=0 To LinesToAdd-1
          Display$(ArrayPointer(0,WindowNum)+N,WindowNum) = SplitLine$(N+1,WindowNum)
        Next N
        ArrayPointer(0,WindowNum) = ArrayPointer(0,WindowNum)+LinesToAdd
      Else
        For N=0 To LinesToAdd-1
          Display$(ArrayPointer(0,WindowNum)+N,WindowNum) = SplitLine$(N+1,WindowNum): Rem Add These Line To End Of Array
        Next N
        LinesToScroll = LinesToAdd-(NumLines-ArrayPointer(0,WindowNum))-1
        For N = 0 To Numlines+LinesToAdd
          Display$(N,WindowNum) = Display$(N+LinesToScroll,WindowNum)
        Next N
        ArrayPointer(0,WindowNum) = ArrayPointer(0,WindowNum)+LinesToAdd
        If ArrayPointer(0,WindowNum) > Numlines+1 Then ArrayPointer(0,WindowNum) = Numlines+1
      Endif
    Endif
    If Border = 1
      Ink RGB(255,255,255),0
      Box XPos,YPos,XPos+ScrollBoxWidth-1,YPos+ScrollBoxHeight-1
    Endif
    Ink BColour,0
    Box XPos+1,YPos+1,XPos+ScrollBoxWidth-2,YPos+ScrollBoxHeight-2
    Ink TColour,0
    For Y = 0 To NumLines
      Text XPos+4,Y*TH+YPos+2,Display$(Y,WindowNum)
    Next Y
  Endif
EndFunction

+ Code Snippet

Function ScrollPrint(WindowNum,XPos,YPos,ScrollBoxWidth,ScrollBoxHeight,NewLine$,BColour,TColour,Border)
  Rem ******************************************************************************************
  Rem Note: The following 3 Dim lines MUST be included at the start of your program
  Rem       before calling the function or it will result in an eror.
  Rem
  Rem       Dim Display$(100,6): Rem Array required for function
  Rem       Dim ArrayPointer(0,6): Rem Array required for function
  Rem       Dim SplitLine$(10,6): Rem Array required for function
  Rem
  Rem ******************************************************************************************
  TH = Text Height("A"): Numlines = (ScrollBoxHeight/TH)-2: LinesToAdd = 1
  If NewLine$ <> ""
    LineWidth = Text Width(NewLine$): NumChars = Len(NewLine$)
    If LineWidth > ScrollBoxWidth-10
      ThisLine$ = "": CharCount = 0: TotalCharCount = 0
      Repeat
        Inc CharCount: Inc TotalCharCount
        ThisChar$ = Mid$(NewLine$,CharCount)
        If ThisChar$ = " " Then LastSpace = CharCount
        ThisLine$ = ThisLine$+ThisChar$
        ThisLineLen = Text Width(ThisLine$)
        If ThisLineLen > ScrollBoxWidth-10
          SplitLine$(LinesToAdd,WindowNum)= Left$(ThisLine$,LastSpace)
          NewLine$ = Right$(NewLine$,Len(NewLine$)-Len(SplitLine$(LinesToAdd,WindowNum)))
          Inc LinesToAdd
          CharCount = 0: ThisLine$ = "": ThisLineLen = 0
        Endif
      Until Text Width(NewLine$) < ScrollBoxWidth-10
      SplitLine$(LinesToAdd,WindowNum) = NewLine$
    Endif
    If LinesToAdd = 1
      If ArrayPointer(0,WindowNum) < Numlines+1
        Display$(ArrayPointer(0,WindowNum),WindowNum) = NewLine$
        ArrayPointer(0,WindowNum) = ArrayPointer(0,WindowNum)+1
      Else
        Display$(ArrayPointer(0,WindowNum),WindowNum) = NewLine$
        For N = 0 To Numlines
          Display$(N,WindowNum) = Display$(N+1,WindowNum)
        Next N
      Endif
    Else
      If ArrayPointer(0,WindowNum)+LinesToAdd < Numlines+1
        For N=0 To LinesToAdd-1
          Display$(ArrayPointer(0,WindowNum)+N,WindowNum) = SplitLine$(N+1,WindowNum)
        Next N
        ArrayPointer(0,WindowNum) = ArrayPointer(0,WindowNum)+LinesToAdd
      Else
        For N=0 To LinesToAdd-1
          Display$(ArrayPointer(0,WindowNum)+N,WindowNum) = SplitLine$(N+1,WindowNum): Rem Add These Line To End Of Array
        Next N
        LinesToScroll = LinesToAdd-(NumLines-ArrayPointer(0,WindowNum))-1
        For N = 0 To Numlines+LinesToAdd
          Display$(N,WindowNum) = Display$(N+LinesToScroll,WindowNum)
        Next N
        ArrayPointer(0,WindowNum) = ArrayPointer(0,WindowNum)+LinesToAdd
        If ArrayPointer(0,WindowNum) > Numlines+1 Then ArrayPointer(0,WindowNum) = Numlines+1
      Endif
    Endif
    If Border = 1
      Ink RGB(255,255,255),0
      Box XPos,YPos,XPos+ScrollBoxWidth-1,YPos+ScrollBoxHeight-1
    Endif
    Ink BColour,0
    Box XPos+1,YPos+1,XPos+ScrollBoxWidth-2,YPos+ScrollBoxHeight-2
    Ink TColour,0
    For Y = 0 To NumLines
      Text XPos+4,Y*TH+YPos+2,Display$(Y,WindowNum)
    Next Y
  Endif
EndFunction

Example Demo Program:

Rem Example Demo For TDK_Man's Scrolling Text Window Function
Rem Copyright TDK_Man January 2008
Rem Creates 3 On-Screen Scrolling Text Windows. User types into Window 3 And
Rem The Computer Generates Random Text In Windows 1 And 2

Dim Display$(100,6): Rem <<<<< Array required for function!!!
Dim ArrayPointer(0,6): Rem <<<<< Array required for function!!!
Dim SplitLine$(10,6): Rem <<<<< Array required for function!!!

Set Display Mode 800,600,32
Sync On: Sync Rate 0
Randomize Timer()

Rem Set Up Function Variables...
XPos1=70: XPos2=410: XPos3=240: Rem X position of scroll boxes
YPos1=50: YPos2=50: YPos3=300: Rem Y position of scroll boxes
ScrollBoxWidth = 320: Rem Width of scroll (Set to screen width for full screen)
ScrollBoxHeight = 240: Rem Height of scroll (Set to screen height for full screen)
Border = 1: Rem Set this to 0 for no border and 1 for a white border
BColour = RGB(0,30,0): Rem Text box background colour value
TColour = RGB(255,255,0): Rem Text colour value

Rem Call Function Three Times To Initialise The Three Text Windows...
ScrollPrint(1,XPos1,YPos1,ScrollBoxWidth,ScrollBoxHeight,"Random Text Window 1",BColour,TColour,Border): Rem <<<< Call this instead of Print
ScrollPrint(2,XPos2,YPos2,ScrollBoxWidth,ScrollBoxHeight,"Random Text Window 2",BColour,TColour,Border): Rem <<<< Call this instead of Print
ScrollPrint(3,XPos3,YPos3,ScrollBoxWidth,ScrollBoxHeight,"User Text Window",BColour,TColour,Border): Rem <<<< Call this instead of Print

Rem Main Loop - Including Allowing You To Add your Own Text To Text Box 3...
Do
  Gosub TextBox1Input: Rem Add Random Text To Text Area 1
  Gosub TextBox2Input: Rem Add Random Text To Text Area 2
  Gosub UserInput: Rem Allow User To Add To Text Area 3
  Sync
Loop
End

TextBox1Input:
  L=Rnd(120)+40: A$ = "": LastChar$=" "
  For N=1 To L
    T = Rnd(36)+97
    If T>122
      If LastChar$<>" "
        LastChar$=" "
        A$ = A$ + LastChar$
      Endif
    Else
      LastChar$=Chr$(T)
      A$ = A$ + LastChar$
    Endif
  Next N
  ScrollPrint(1,XPos1,YPos1,ScrollBoxWidth,ScrollBoxHeight,A$,BColour,TColour,Border): Rem <<<< Call this instead of Print
Return

TextBox2Input:
  L=Rnd(120)+40: A$ = "": LastChar$=" "
  For N=1 To L
    T = Rnd(36)+97
    If T>122
      If LastChar$<>" "
        LastChar$=" "
        A$ = A$ + LastChar$
      Endif
    Else
      LastChar$=Chr$(T)
      A$ = A$ + LastChar$
    Endif
  Next N
  ScrollPrint(2,XPos2,YPos2,ScrollBoxWidth,ScrollBoxHeight,A$,BColour,TColour,Border): Rem <<<< Call this instead of Print
Return

UserInput:
  Ink 0,0: Box 0,550,799,599
  Ink RGB(255,255,255),0: Set Cursor 0,570: Input "Your Own Text: ";A$
  ScrollPrint(3,XPos3,YPos3,ScrollBoxWidth,ScrollBoxHeight,A$,BColour,TColour,Border): Rem <<<< Call this instead of Print
Return

Rem *****************************************************************************************
Rem ********                             Functions                                  *********
Rem *****************************************************************************************

Function ScrollPrint(WindowNum,XPos,YPos,ScrollBoxWidth,ScrollBoxHeight,NewLine$,BColour,TColour,Border)
  Rem ******************************************************************************************
  Rem Note: The following 3 Dim lines MUST be included at the start of your program
  Rem       before calling the function or it will result in an eror.
  Rem
  Rem       Dim Display$(100,6): Rem Array required for function
  Rem       Dim ArrayPointer(0,6): Rem Array required for function
  Rem       Dim SplitLine$(10,6): Rem Array required for function
  Rem
  Rem ******************************************************************************************
  TH = Text Height("A"): Numlines = (ScrollBoxHeight/TH)-2: LinesToAdd = 1
  If NewLine$ <> ""
    LineWidth = Text Width(NewLine$): NumChars = Len(NewLine$)
    If LineWidth > ScrollBoxWidth-10
      ThisLine$ = "": CharCount = 0: TotalCharCount = 0
      Repeat
        Inc CharCount: Inc TotalCharCount
        ThisChar$ = Mid$(NewLine$,CharCount)
        If ThisChar$ = " " Then LastSpace = CharCount
        ThisLine$ = ThisLine$+ThisChar$
        ThisLineLen = Text Width(ThisLine$)
        If ThisLineLen > ScrollBoxWidth-10
          SplitLine$(LinesToAdd,WindowNum)= Left$(ThisLine$,LastSpace)
          NewLine$ = Right$(NewLine$,Len(NewLine$)-Len(SplitLine$(LinesToAdd,WindowNum)))
          Inc LinesToAdd
          CharCount = 0: ThisLine$ = "": ThisLineLen = 0
        Endif
      Until Text Width(NewLine$) < ScrollBoxWidth-10
      SplitLine$(LinesToAdd,WindowNum) = NewLine$
    Endif
    If LinesToAdd = 1
      If ArrayPointer(0,WindowNum) < Numlines+1
        Display$(ArrayPointer(0,WindowNum),WindowNum) = NewLine$
        ArrayPointer(0,WindowNum) = ArrayPointer(0,WindowNum)+1
      Else
        Display$(ArrayPointer(0,WindowNum),WindowNum) = NewLine$
        For N = 0 To Numlines
          Display$(N,WindowNum) = Display$(N+1,WindowNum)
        Next N
      Endif
    Else
      If ArrayPointer(0,WindowNum)+LinesToAdd < Numlines+1
        For N=0 To LinesToAdd-1
          Display$(ArrayPointer(0,WindowNum)+N,WindowNum) = SplitLine$(N+1,WindowNum)
        Next N
        ArrayPointer(0,WindowNum) = ArrayPointer(0,WindowNum)+LinesToAdd
      Else
        For N=0 To LinesToAdd-1
          Display$(ArrayPointer(0,WindowNum)+N,WindowNum) = SplitLine$(N+1,WindowNum): Rem Add These Line To End Of Array
        Next N
        LinesToScroll = LinesToAdd-(NumLines-ArrayPointer(0,WindowNum))-1
        For N = 0 To Numlines+LinesToAdd
          Display$(N,WindowNum) = Display$(N+LinesToScroll,WindowNum)
        Next N
        ArrayPointer(0,WindowNum) = ArrayPointer(0,WindowNum)+LinesToAdd
        If ArrayPointer(0,WindowNum) > Numlines+1 Then ArrayPointer(0,WindowNum) = Numlines+1
      Endif
    Endif
    If Border = 1
      Ink RGB(255,255,255),0
      Box XPos,YPos,XPos+ScrollBoxWidth-1,YPos+ScrollBoxHeight-1
    Endif
    Ink BColour,0
    Box XPos+1,YPos+1,XPos+ScrollBoxWidth-2,YPos+ScrollBoxHeight-2
    Ink TColour,0
    For Y = 0 To NumLines
      Text XPos+4,Y*TH+YPos+2,Display$(Y,WindowNum)
    Next Y
  Endif
EndFunction

+ Code Snippet

Rem Example Demo For TDK_Man's Scrolling Text Window Function
Rem Copyright TDK_Man January 2008
Rem Creates 3 On-Screen Scrolling Text Windows. User types into Window 3 And
Rem The Computer Generates Random Text In Windows 1 And 2

Dim Display$(100,6): Rem <<<<< Array required for function!!!
Dim ArrayPointer(0,6): Rem <<<<< Array required for function!!!
Dim SplitLine$(10,6): Rem <<<<< Array required for function!!!

Set Display Mode 800,600,32
Sync On: Sync Rate 0
Randomize Timer()

Rem Set Up Function Variables...
XPos1=70: XPos2=410: XPos3=240: Rem X position of scroll boxes
YPos1=50: YPos2=50: YPos3=300: Rem Y position of scroll boxes
ScrollBoxWidth = 320: Rem Width of scroll (Set to screen width for full screen)
ScrollBoxHeight = 240: Rem Height of scroll (Set to screen height for full screen)
Border = 1: Rem Set this to 0 for no border and 1 for a white border
BColour = RGB(0,30,0): Rem Text box background colour value
TColour = RGB(255,255,0): Rem Text colour value

Rem Call Function Three Times To Initialise The Three Text Windows...
ScrollPrint(1,XPos1,YPos1,ScrollBoxWidth,ScrollBoxHeight,"Random Text Window 1",BColour,TColour,Border): Rem <<<< Call this instead of Print
ScrollPrint(2,XPos2,YPos2,ScrollBoxWidth,ScrollBoxHeight,"Random Text Window 2",BColour,TColour,Border): Rem <<<< Call this instead of Print
ScrollPrint(3,XPos3,YPos3,ScrollBoxWidth,ScrollBoxHeight,"User Text Window",BColour,TColour,Border): Rem <<<< Call this instead of Print

Rem Main Loop - Including Allowing You To Add your Own Text To Text Box 3...
Do
  Gosub TextBox1Input: Rem Add Random Text To Text Area 1
  Gosub TextBox2Input: Rem Add Random Text To Text Area 2
  Gosub UserInput: Rem Allow User To Add To Text Area 3
  Sync
Loop
End

TextBox1Input:
  L=Rnd(120)+40: A$ = "": LastChar$=" "
  For N=1 To L
    T = Rnd(36)+97
    If T>122
      If LastChar$<>" "
        LastChar$=" "
        A$ = A$ + LastChar$
      Endif
    Else
      LastChar$=Chr$(T)
      A$ = A$ + LastChar$
    Endif
  Next N
  ScrollPrint(1,XPos1,YPos1,ScrollBoxWidth,ScrollBoxHeight,A$,BColour,TColour,Border): Rem <<<< Call this instead of Print
Return

TextBox2Input:
  L=Rnd(120)+40: A$ = "": LastChar$=" "
  For N=1 To L
    T = Rnd(36)+97
    If T>122
      If LastChar$<>" "
        LastChar$=" "
        A$ = A$ + LastChar$
      Endif
    Else
      LastChar$=Chr$(T)
      A$ = A$ + LastChar$
    Endif
  Next N
  ScrollPrint(2,XPos2,YPos2,ScrollBoxWidth,ScrollBoxHeight,A$,BColour,TColour,Border): Rem <<<< Call this instead of Print
Return

UserInput:
  Ink 0,0: Box 0,550,799,599
  Ink RGB(255,255,255),0: Set Cursor 0,570: Input "Your Own Text: ";A$
  ScrollPrint(3,XPos3,YPos3,ScrollBoxWidth,ScrollBoxHeight,A$,BColour,TColour,Border): Rem <<<< Call this instead of Print
Return

Rem *****************************************************************************************
Rem ********                             Functions                                  *********
Rem *****************************************************************************************

Function ScrollPrint(WindowNum,XPos,YPos,ScrollBoxWidth,ScrollBoxHeight,NewLine$,BColour,TColour,Border)
  Rem ******************************************************************************************
  Rem Note: The following 3 Dim lines MUST be included at the start of your program
  Rem       before calling the function or it will result in an eror.
  Rem
  Rem       Dim Display$(100,6): Rem Array required for function
  Rem       Dim ArrayPointer(0,6): Rem Array required for function
  Rem       Dim SplitLine$(10,6): Rem Array required for function
  Rem
  Rem ******************************************************************************************
  TH = Text Height("A"): Numlines = (ScrollBoxHeight/TH)-2: LinesToAdd = 1
  If NewLine$ <> ""
    LineWidth = Text Width(NewLine$): NumChars = Len(NewLine$)
    If LineWidth > ScrollBoxWidth-10
      ThisLine$ = "": CharCount = 0: TotalCharCount = 0
      Repeat
        Inc CharCount: Inc TotalCharCount
        ThisChar$ = Mid$(NewLine$,CharCount)
        If ThisChar$ = " " Then LastSpace = CharCount
        ThisLine$ = ThisLine$+ThisChar$
        ThisLineLen = Text Width(ThisLine$)
        If ThisLineLen > ScrollBoxWidth-10
          SplitLine$(LinesToAdd,WindowNum)= Left$(ThisLine$,LastSpace)
          NewLine$ = Right$(NewLine$,Len(NewLine$)-Len(SplitLine$(LinesToAdd,WindowNum)))
          Inc LinesToAdd
          CharCount = 0: ThisLine$ = "": ThisLineLen = 0
        Endif
      Until Text Width(NewLine$) < ScrollBoxWidth-10
      SplitLine$(LinesToAdd,WindowNum) = NewLine$
    Endif
    If LinesToAdd = 1
      If ArrayPointer(0,WindowNum) < Numlines+1
        Display$(ArrayPointer(0,WindowNum),WindowNum) = NewLine$
        ArrayPointer(0,WindowNum) = ArrayPointer(0,WindowNum)+1
      Else
        Display$(ArrayPointer(0,WindowNum),WindowNum) = NewLine$
        For N = 0 To Numlines
          Display$(N,WindowNum) = Display$(N+1,WindowNum)
        Next N
      Endif
    Else
      If ArrayPointer(0,WindowNum)+LinesToAdd < Numlines+1
        For N=0 To LinesToAdd-1
          Display$(ArrayPointer(0,WindowNum)+N,WindowNum) = SplitLine$(N+1,WindowNum)
        Next N
        ArrayPointer(0,WindowNum) = ArrayPointer(0,WindowNum)+LinesToAdd
      Else
        For N=0 To LinesToAdd-1
          Display$(ArrayPointer(0,WindowNum)+N,WindowNum) = SplitLine$(N+1,WindowNum): Rem Add These Line To End Of Array
        Next N
        LinesToScroll = LinesToAdd-(NumLines-ArrayPointer(0,WindowNum))-1
        For N = 0 To Numlines+LinesToAdd
          Display$(N,WindowNum) = Display$(N+LinesToScroll,WindowNum)
        Next N
        ArrayPointer(0,WindowNum) = ArrayPointer(0,WindowNum)+LinesToAdd
        If ArrayPointer(0,WindowNum) > Numlines+1 Then ArrayPointer(0,WindowNum) = Numlines+1
      Endif
    Endif
    If Border = 1
      Ink RGB(255,255,255),0
      Box XPos,YPos,XPos+ScrollBoxWidth-1,YPos+ScrollBoxHeight-1
    Endif
    Ink BColour,0
    Box XPos+1,YPos+1,XPos+ScrollBoxWidth-2,YPos+ScrollBoxHeight-2
    Ink TColour,0
    For Y = 0 To NumLines
      Text XPos+4,Y*TH+YPos+2,Display$(Y,WindowNum)
    Next Y
  Endif
EndFunction

Important: Please note that you must initialise the three arrays at the start of the demo in your own program.

Finally, this function was written for a specific task in one of my own programs and not as a 'does everything for everybody' function.

If it doesn't quite suit what you need it for, just shout and I'll see what I can do to amend it to your requirements.

TDK_Man

* TDK's Game Programming Forums - Open To All - DB & Team Request Boards *

Back to top

Profile PM Email Website

Sorry your browser is not supported!

Code Snippets / [DBC] Scrolling Text Box Function With Text Wrap