Codepage switching

<< < (11/11)

Alun:
Yes please, I would be most grateful for that. Regards Alun

Alun:
Plasma, you may haved missed my request for you to modify the subprogram for use with Screen 12. Your offer was the last entry on page 2, my request being the first posting on page 3.

Look forward to hearing from you, best regards, Alun

TheBigBasicQ:
I think he must've missed it. In that case you could draw his attention more effectively by sending him a private message(PM).

The link to your inbox on qbasicnews is located just before the logout link on the top right corner of the webpage =).

Plasma:
http://www.phatcode.net/other/codepage.zip

Code:

'========================================================================
' Change the codepage on the fly
' by Plasma
'
' -- Updated: Now supports all text and graphics screen modes --
'
' (Start QB with /L if running in the IDE, and make sure CP437.BIN
'  is in the current directory for the example.)
'========================================================================

DEFINT A-Z
'$INCLUDE: 'QB.BI'

DECLARE SUB LoadCP (Filename$)


' Example:
SCREEN 0
CLS
PRINT "Current codepage"
PRINT CHR$(227), CHR$(230), CHR$(232), CHR$(233), CHR$(234), CHR$(235), CHR$(237)
PRINT
PRINT "Press any key"
k$ = INPUT$(1)

CLS
LoadCP "CP437.BIN"  'Save the old codepage and load codepage 437

PRINT "You are now using codepage 437"
PRINT CHR$(227), CHR$(230), CHR$(232), CHR$(233), CHR$(234), CHR$(235), CHR$(237)
PRINT
PRINT "Press any key"
k$ = INPUT$(1)

CLS
LoadCP ""           'Restore the old codepage

PRINT "Old codepage is now restored"
PRINT CHR$(227), CHR$(230), CHR$(232), CHR$(233), CHR$(234), CHR$(235), CHR$(237)
PRINT
PRINT "Press any key"
k$ = INPUT$(1)

END

SUB LoadCP (Filename$) STATIC

  '========================================================================
  ' Change the codepage on the fly
  ' by Plasma
  '
  ' Filename$ - Codepage file to load, or pass a null string ("") to
  '             restore the old code page.
  '------------------------------------------------------------------------
  ' Here's the format of the codepage files if you want to make your own:
  '
  ' Offset  Length  Description
  ' 0       2048    8x8 font  (256 characters, 8 bytes per character)
  ' 2048    3584    8x14 font (256 characters, 14 bytes per character)
  ' 5632    4096    8x16 font (256 characters, 16 bytes per character)
  ' 9728    4096    9x16 font (same as 8x16 font, except a blank 9th column
  '                            is added on the screen, so you can use all 8
  '                            columns without leaving a space)
  '
  ' The total codepage file length should be 13824 bytes.
  '========================================================================
 
  DIM Regs AS RegTypeX
 
  ' Get the current video mode (returns BIOS numbers, not QB)
  Regs.ax = &HF00
  InterruptX &H10, Regs, Regs
  Mode = Regs.ax AND &HFF
 
  IF Filename$ = "" THEN         ' Restore old codepage
    IF LEN(OldFont$) = 8 THEN    ' Graphics Mode
     
      ' In graphics modes, the font can only be changed directly after a
      ' mode set. So we re-set the current screen mode, but enable bit 7 so
      ' the video memory isn't cleared.
      Regs.ax = Mode + &H80
      InterruptX &H10, Regs, Regs
     
      ' Restore old font vector
      DEF SEG = &H0
      POKE &H43 * 4, ASC(MID$(OldFont$, 1, 1))
      POKE &H43 * 4 + 1, ASC(MID$(OldFont$, 2, 1))
      POKE &H43 * 4 + 2, ASC(MID$(OldFont$, 3, 1))
      POKE &H43 * 4 + 3, ASC(MID$(OldFont$, 4, 1))
      POKE &H1F * 4, ASC(MID$(OldFont$, 5, 1))
      POKE &H1F * 4 + 1, ASC(MID$(OldFont$, 6, 1))
      POKE &H1F * 4 + 2, ASC(MID$(OldFont$, 7, 1))
      POKE &H1F * 4 + 3, ASC(MID$(OldFont$, 8, 1))
      OldFont$ = ""

    ELSEIF LEN(OldFont$) >= 2048 THEN   ' Text Mode
     
      ' Load the old font
      Regs.ax = &H1100
      Regs.es = VARSEG(OldFont$)
      Regs.bp = SADD(OldFont$)
      Regs.cx = 256
      Regs.dx = 0
      Regs.bx = FontHeight * &H100
      InterruptX &H10, Regs, Regs
      OldFont$ = ""
   
    ELSE
     
      PRINT "Error in LoadCP: Can't restore old codepage"
      END
    END IF
 
  ELSE
 
    ' Get the height of the font currently on the screen
    Regs.ax = &H1130
    InterruptX &H10, Regs, Regs
    FontHeight = Regs.cx

    IF FontHeight = 16 THEN
   
      ' User [probably] has a VGA, so find out if
      ' the character width is set to 8 or 9.
      Addr = INP(&H3C4)       ' Sequencer
      OUT &H3C4, &H1          ' Select clocking mode register
      Clocking = INP(&H3C5)   ' Read it
      OUT &H3C4, Addr
   
      IF (Clocking AND 1) = 0 THEN  ' Width = 9, so select 9x16 font
        Offset = 9728
        Length = 4096
      ELSE                          ' Width = 8, so select 8x16 font
        Offset = 5632
        Length = 4096
      END IF
 
    ELSEIF FontHeight = 14 THEN  ' Select 8x14 font
      Offset = 2048
      Length = 3584
    ELSE                         ' Select 8x8 font
      FontHeight = 8
      Offset = 0
      Length = 2048
    END IF

    ' Open codepage file and make sure it's valid
    Handle = FREEFILE
    OPEN Filename$ FOR BINARY AS #Handle
    IF LOF(Handle) = 0 THEN
      CLOSE #Handle
      KILL Filename$
      PRINT "Error in LoadCP: Codepage file " + Filename$ + " not found."
      END
    ELSEIF LOF(Handle) <> 13824 THEN
      CLOSE #Handle
      PRINT "Error in LoadCP: Codepage file " + Filename$ + " is an invalid format."
      END
    END IF
 
    ' Load the font we want
    Font$ = SPACE$(Length)
    SEEK #1, Offset + 1
    GET #1, , Font$
    CLOSE #1

    IF (Mode >= &H0 AND Mode <= &H3) OR Mode = &H7 THEN   ' Text mode
 
       ' Mask bit plane 2 (thanks Nathan)
       OUT &H3C4, &H0
       OUT &H3C5, &H1
       OUT &H3C4, &H2
       OUT &H3C5, &H4
       OUT &H3C4, &H4
       OUT &H3C5, &H7
       OUT &H3C4, &H0
       OUT &H3C5, &H3
       OUT &H3CE, &H4
       OUT &H3CF, &H2
       OUT &H3CE, &H5
       OUT &H3CF, &H0
       OUT &H3CE, &H6
       OUT &H3CF, &H0
 
       ' Save old font by reading it directly from video memory
       DEF SEG = &HA000
       OldFont$ = ""
       FOR Char = 0 TO 255
         FOR Row = 0 TO FontHeight - 1
           OldFont$ = OldFont$ + CHR$(PEEK(Char * 32 + Row))
         NEXT
       NEXT

       ' Unmask bit plane 2
       OUT &H3C4, &H0
       OUT &H3C5, &H1
       OUT &H3C4, &H2
       OUT &H3C5, &H3
       OUT &H3C4, &H4
       OUT &H3C5, &H3
       OUT &H3C4, &H0
       OUT &H3C5, &H3
       OUT &H3CE, &H4
       OUT &H3CF, &H0
       OUT &H3CE, &H5
       OUT &H3CF, &H10
       OUT &H3CE, &H6
       OUT &H3CF, &HE

       ' Set the new font
       Regs.ax = &H1100
       Regs.es = VARSEG(Font$)
       Regs.bp = SADD(Font$)
       Regs.cx = 256
       Regs.dx = 0
       Regs.bx = FontHeight * &H100
       InterruptX &H10, Regs, Regs
       Font$ = ""

    ELSE   ' Graphics mode
     
      ' In graphics modes, the font can only be changed directly after a
      ' mode set. So we re-set the current screen mode, but enable bit 7 so
      ' the video memory isn't cleared.
      Regs.ax = Mode + &H80
      InterruptX &H10, Regs, Regs

      ' Save the old font vector
      DEF SEG = &H0
      OldFont$ = CHR$(PEEK(&H43 * 4))
      OldFont$ = OldFont$ + CHR$(PEEK(&H43 * 4 + 1))
      OldFont$ = OldFont$ + CHR$(PEEK(&H43 * 4 + 2))
      OldFont$ = OldFont$ + CHR$(PEEK(&H43 * 4 + 3))
      OldFont$ = OldFont$ + CHR$(PEEK(&H1F * 4))
      OldFont$ = OldFont$ + CHR$(PEEK(&H1F * 4 + 1))
      OldFont$ = OldFont$ + CHR$(PEEK(&H1F * 4 + 2))
      OldFont$ = OldFont$ + CHR$(PEEK(&H1F * 4 + 3))

      ' Set the vector for chars 0-127
      POKE &H43 * 4, SADD(Font$) AND &HFF
      POKE &H43 * 4 + 1, SADD(Font$) \ &H100
      POKE &H43 * 4 + 2, VARSEG(Font$) AND &HFF
      POKE &H43 * 4 + 3, VARSEG(Font$) \ &H100
   
      ' Set the vector for chars 128-255
      POKE &H1F * 4, (SADD(Font$) + Length \ 2) AND &HFF
      POKE &H1F * 4 + 1, (SADD(Font$) + Length \ 2) \ &H100
      POKE &H1F * 4 + 2, VARSEG(Font$) AND &HFF
      POKE &H1F * 4 + 3, VARSEG(Font$) \ &H100

    END IF
  END IF

END SUB


(Make sure you use the new CP437.BIN; I changed the file format)

Navigation

[0] Message Index

[*] Previous page