Posts: 14
Threads: 1
Joined: Dec 2003
Yes please, I would be most grateful for that. Regards Alun
Posts: 14
Threads: 1
Joined: Dec 2003
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
Posts: 4,307
Threads: 63
Joined: May 2003
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 =).
Posts: 1,752
Threads: 21
Joined: Jun 2002
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)
|
