There has been a request for a routine to print large characters from a
string. The following is compatible with QBasic (the free MSDOS version,
thanks to Ian Musgrave's Interrupt routine).
Enjoy!!
-Dave
'----------------------------------------------------------------------------
'BIGFONT.BAS by Dave Burbridge
'Short desc: Large printing on screen.
'What it does: Writes Text$ in Colour at about 8x normal size. (Exact scale
' depends on screen mode used). Top left of new Text$ is at
' (TopRow%, LeftCol%).
'
' (part of USEFUL.BAS v2.00)
' (If you want the full version, including this routine, my mouse routines,
' Ian Musgrave's DIR$, and the following delectable delights:
' CalcSkewRect: Calculates (x,y) of vertices of skewed rectangle
' Centre: Writes text in centre of specified row
' CheckInEllipse: Checks whether a point is in an ellipse
' CheckInRect: Checks whether a point is in a rectangle
' DoQuestion: Dialogue box with YES/NO buttons for mouse
' DrawSkewEllipse: Draws a skewed ellipse
' InvertColours: Converts colour on black screen to black on white
' LRS: Converts number into string & strips leading/trailing spaces
' PerpDist: Calculates perpendicular distance of point from line
' PrepDump: Sets screen to b-on-w for copying to Windows Paintbrush
' Stats: Statistics analyser
' WaitForAnyKey: Waits for a key or mouse click, with a timeout option
' ...please e-mail me: it's a large file & I don't want to post it unless you
' want it!! The mouse routines are based on MS's (the ones with PDS7.1) with
' querks tidied up & new routines added)
'
'>>> For QBasic, i.e. for the "free" DOS vesion<<<
'15/11/95
'Version 2.00
'[All routines in this module are for MS-DOS Ver 2.0+]
'
'himself modified it from the interrupt code in MOUSE.BAS by Douggie Green in
'the comp.lang.basic.misc BASIC Code FAQ.
'
'Notes: This module can accept text that may be partially off the screen.
' In screen mode 0, if you are using a WIDTH statement to set a screen
' other than 80x25, you will find BigFont only works properly from
' within a programme. This is because working in in the "Immediate"
' window in mode 0 resets the screen to ?x25 (where ? is the current
' screen width, 40 or 80) after every command. So, in the Immediate
' WINDOW:
' WIDTH 40, 50 'Sets screen size
' LOCATE 25, 1: PRINT "Hello!" 'Prints message in bottom left corner
' of screen, despite the previous
' command.
' Similarly, Ctrl+Breaking, or using the STOP command, or setting a
' breakpoint, or any other method by which you can return to the source
' code whilst your programme is running, will reset the visible screen
' width as above, >>in mode 0 only!!<<. In any other screen mode, the
' width is maintained.
' Note also that it is the >visible< screen width that is reset. The
' values returned by using GetScreenMode will still be those set by your
' last WIDTH statement! So using another WIDTH command will not set the
' screen back to the width you want, since as far as the QBX interpreter
' is concerned, you are already running at that width. Dear old MS,
' don't we love them?
'Example: BigFont 1, 1, 4, "Hello!"
'How it works: First GetScreenMode is called. This returns, among other
' things, the size of the screen, and the maximum number of
' colours that may be supported, in the current mode. The amount
' of the string that will fit on the screen is calculated, to
' avoid trying to move outside the screen. The ROM font table is
' then accessed directly and the bytes defining each character
' in the text are examined. This information is used to construct
' an array of new strings, one for each row of the text (number
' of rows = height of character). The new strings have a block
' character (CHR$(219), I won't tempt fate & flames by printing
' the real character ;-)) if the pixel was coloured, or a space
' ( ) if it was blank. They are then printed to the screen, with
' the first being located at (TopRow, LeftCol).
'----------------------------------------------------------------------------
'----------------------------------------------------------------------------
'Start of real code!!
'
DECLARE SUB BigFont (TopRow%, LeftCol%, Colour%, text$)
DECLARE SUB GetScreenMode (ScrMode%, ScrCols%, ScrRows%, CharHor%, CharVer%, ScrMaxX%, ScrMaxY%, MaxColours%)
DEFINT A-Z
CONST PI = 3.14159265358979#
TYPE RegTypeX
ax AS INTEGER
bx AS INTEGER
cx AS INTEGER
dx AS INTEGER
BP AS INTEGER
SI AS INTEGER
DI AS INTEGER
Flags AS INTEGER
DS AS INTEGER
ES AS INTEGER
END TYPE
DECLARE SUB InterruptX (IntNum%, regs AS RegTypeX)
DIM SHARED regs AS RegTypeX
SCREEN 12 (or 0,1,2,7,8,9,10,11,13 :-))
BigFont 10, 12, 12, "Hello, world!"
SYSTEM
'hex data for interrupt routines
DATA &H55, &H8B, &HEC, &H83, &HEC, &H08, &H56, &H57, &H1E, &H55, &H8B, &H5E
DATA &H06, &H8B, &H47, &H10, &H3D, &HFF, &HFF, &H75, &H04, &H1E, &H8F, &H47
DATA &H10, &H8B, &H47, &H12, &H3D, &HFF, &HFF, &H75, &H04, &H1E, &H8F, &H47
DATA &H12, &H8B, &H47, &H08, &H89, &H46, &HF8, &H8B, &H07, &H8B, &H4F, &H04
DATA &H8B, &H57, &H06, &H8B, &H77, &H0A, &H8B, &H7F, &H0C, &HFF, &H77, &H12
DATA &H07, &HFF, &H77, &H02, &H1E, &H8F, &H46, &HFA, &HFF, &H77, &H10, &H1F
DATA &H8B, &H6E, &HF8, &H5B, &HCD, &H21, &H55, &H8B, &HEC, &H8B, &H6E, &H02
DATA &H89, &H5E, &HFC, &H8B, &H5E, &H06, &H1E, &H8F, &H46, &HFE, &HFF, &H76
DATA &HFA, &H1F, &H89, &H07, &H8B, &H46, &HFC, &H89, &H47, &H02, &H89, &H4F
DATA &H04, &H89, &H57, &H06, &H58, &H89, &H47, &H08, &H89, &H77, &H0A, &H89
DATA &H7F, &H0C, &H9C, &H8F, &H47, &H0E, &H06, &H8F, &H47, &H12, &H8B, &H46
DATA &HFE, &H89, &H47, &H10, &H5A, &H1F, &H5F, &H5E, &H8B, &HE5, &H5D, &HCA
DATA &H02, &H00
'Writes Text$ in Colour at > normal size. Top left of new Text$ is at
' (TopRow, LeftCol).
'
SUB BigFont (TopRow, LeftCol, Colour, text$)
GetScreenMode 0, ScrCols, ScrRows, 0, 0, 0, 0, MaxColours
IF Colour >= MaxColours THEN
COLOR MaxColours - 1
ELSE
COLOR Colour
END IF
FOR i = 1 TO LEN(text$)
Char = ASC(MID$(text$, i, 1))
FOR row = 0 TO 7
IF row <= ScrRows - TopRow THEN
DEF SEG = &HF000
Byte = PEEK(&HFA6D + (Char * 8) + (row + 1))
DEF SEG
FOR Test = 0 TO 7
CharPos = LeftCol + (i - 1) * 8 + Test
IF CharPos <= ScrCols THEN
LOCATE TopRow + row, CharPos
Mask = 2 ^ (7 - Test)
IF Byte AND Mask THEN
PRINT CHR$(219);
ELSE
PRINT " ";
END IF
ELSE
Done = TRUE
EXIT FOR
END IF
NEXT
ELSE
EXIT FOR
END IF
NEXT
IF Done THEN EXIT FOR
NEXT
END SUB
'Returns information on the current screen mode:
' ScrMode = Mode set by last SCREEN statement
' ScrCols = Number of character columns
' ScrRows = Number of character rows
' CharHor = Width in pixels of text character
' CharVer = Height in pixels of text character
' ScrMaxX = Width in pixels of screen
' ScrMaxY = Height in pixels of screen
' MaxColours = Number of colours
'
SUB GetScreenMode (ScrMode, ScrCols, ScrRows, CharHor, CharVer, ScrMaxX, ScrMaxY, MaxColours)
regs.ax = &H1130
regs.bx = &H0
InterruptX &H10, regs
ScrRows = (regs.dx AND 255) + 1
regs.ax = &HF00
InterruptX &H10, regs
ScrCols = (regs.ax AND 65280) / 256
SELECT CASE regs.ax AND 255
CASE 0, 1
ScrMode = 0
CharHor = 9
CharVer = 16
ScrMaxX = 0
ScrMaxY = 0
MaxColours = 16
CASE 2, 3
ScrMode = 0
IF ScrRows = 25 THEN
CharHor = 9
CharVer = 16
ELSE
CharHor = 8
CharVer = 8
END IF
ScrMaxX = 0
ScrMaxY = 0
MaxColours = 16
CASE 4, 5
ScrMode = 1
CharHor = 8
CharVer = 8
ScrMaxX = 320
ScrMaxY = 200
MaxColours = 4
CASE 6
ScrMode = 2
CharHor = 8
CharVer = 8
ScrMaxX = 640
ScrMaxY = 200
MaxColours = 4
CASE 7
ScrMode = 0
IF ScrRows = 25 THEN
CharHor = 9
CharVer = 16
ELSE
CharHor = 8
CharVer = 8
END IF
ScrMaxX = 0
ScrMaxY = 0
MaxColours = 16
CASE 13
ScrMode = 7
CharHor = 8
CharVer = 8
ScrMaxX = 320
ScrMaxY = 200
MaxColours = 16
CASE 14
ScrMode = 8
CharHor = 8
CharVer = 8
ScrMaxX = 640
ScrMaxY = 200
MaxColours = 16
CASE 15
ScrMode = 10
IF ScrRows = 25 THEN
CharHor = 8
CharVer = 14
ELSE
CharHor = 8
CharVer = 8
END IF
ScrMaxX = 640
ScrMaxY = 350
MaxColours = 2
CASE 16
ScrMode = 9
IF ScrRows = 25 THEN
CharHor = 8
CharVer = 14
ELSE
CharHor = 8
CharVer = 8
END IF
ScrMaxX = 640
ScrMaxY = 350
MaxColours = 16
CASE 17
ScrMode = 11
IF ScrRows = 30 THEN
CharHor = 8
CharVer = 16
ELSE
CharHor = 8
CharVer = 8
END IF
ScrMaxX = 640
ScrMaxY = 480
MaxColours = 2
CASE 18
ScrMode = 12
IF ScrRows = 30 THEN
CharHor = 8
CharVer = 16
ELSE
CharHor = 8
CharVer = 8
END IF
ScrMaxX = 640
ScrMaxY = 480
MaxColours = 16
CASE 19
ScrMode = 13
CharHor = 8
CharVer = 8
ScrMaxX = 320
ScrMaxY = 200
MaxColours = 256
END SELECT
END SUB
SUB InterruptX (IntNum, regs AS RegTypeX) STATIC
STATIC FileNum, IntOffset, Loaded
' use fixed-length string to fix its position in memory
' and so we don't mess up string
...
read more »
ASCII Chars -> large chars