ASCII Chars -> large chars 
Author Message
 ASCII Chars -> large chars

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 »



Mon, 04 May 1998 03:00:00 GMT  
 ASCII Chars -> large chars
Update on accessing SB/CD drive:

Just to let you know I'm still working on the problem regarding talking to
a SB/CD-ROM drive (playing Audio CDs, WAV's etc).
I have come across a set of routines for PDS/QB/VB-DOS which, in the short
time I have been able to test them, appear to be very well behaved: they even
coped with me running the Creative Labs CD player simultaneously, &
trying to play different tracks from each player! (In fact, it was the
Creative player that got more confused!!)
This therefore appears to be very robust code.

I got it from simtel/msdos/basic, the file name is acdkit10.zip.
Two problems: (a) it's shareware, not free
              (b) there's no source code, just the QuickLibrary + sample
                  programme.

Saul Ansbacher e-mailed me the Pascal source code for accessing the CD drive,
but I'm still working on converting that - does anyone know how to get a
driver handle in QBasic? Anyone know what I mean?? Basically, I need to know
what the Pascal commands Assign & Reset do, and how to implement them in
QBasic.

I've tried using the WAV player in the QB Fanzine: although audible, the
sound quality was not very good: worse than using a PC internal speaker
driver (and that's saying something :-)) Also, it would not run whilst
something else, e.g. the Creative audio CD player or mixer, was running.
This is something beyond me, perhaps someone else knows more about this?

A question was also asked about the value returned by the SBDetect function
in the Fanzine. (It was 4 for the AWE32.) I can now confirm it is also 4 for
the SB16 Value!
--
============================================================================

| Mech Eng Dept, Imperial College, London|  except from a vending machine! |
============================================================================



Mon, 04 May 1998 03:00:00 GMT  
 ASCII Chars -> large chars

Quote:
> '  ...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)

Please email me USEFUL.BAS
it sounds very useful :^)
thanks
--
 Nathan Fredrickson
 PEI, Canada        



Mon, 04 May 1998 03:00:00 GMT  
 
 [ 5 post ] 

 Relevant Pages 

1. ASCII -> large chars

2. problem with char field and special ascii char

3. char after each 2 chars in a string.

4. Reading a text file char by char.

5. Getting a single char, Putting a single char.

6. Char by Char file input?

7. REPOST: Want mask chars but not prompt chars in MaskEdBox (from Aug 22)

8. Want mask chars but not prompt chars in MaskEdBox

9. Help required for Unicode Chars(greek chars)

10. Search Char By Char Like MS Index Searches

11. Win API To Search Char by Char

12. problem with char to ASCII conversion

 

 
Powered by phpBB® Forum Software