Need as many quick answers as I can get!
-
- Veteran
- Posts: 399
- Joined: Wed Mar 02, 2005 9:01 pm
- Location: Nashville, Tennessee
- Contact:
Need as many quick answers as I can get!
3 questions:
1. How can you tell what color(s) there are using the SCREEN function(not statement)? (using the color flag)
2. How do you use PEEKing and POKEing well?
3. A good way to test for drives using a string (drives$) is... (Complete this sentence)
Please put what number you are refering to when you reply.
1. How can you tell what color(s) there are using the SCREEN function(not statement)? (using the color flag)
2. How do you use PEEKing and POKEing well?
3. A good way to test for drives using a string (drives$) is... (Complete this sentence)
Please put what number you are refering to when you reply.
'Subject: LIST OF DRIVES Date: 01-01-90 (00:00)
'Author: Larry Stone Code: QB, PDS
'Origin: FidoNet QUIK_BAS Echo Packet: DISK.ABC
'------------------------------------------------------------------------=
'In QuickBASIC, how do I obtain a list of all active drives (except
'diskette drives). In other words, the C drive and any Novell
'network drives.
DEFINT A-Z
REM $INCLUDE: 'qbx.bi'
DECLARE FUNCTION FDList$ ()
DECLARE FUNCTION HDList$ (FloppyList$)
CLS
PRINT
PRINT FDList$; " _";
PRINT HDList$(FloppyList$)
'FUNCTION FDList$
'
'PURPOSE
'PEEKs at the BIOS Equipment Word to return a list of floppy
'drives installed on the system.
'
'CREDIT(S)
'Larry Stone, based on a routine published in MicroHelp's BUG
'Newsletter, 1/1/90.
'
'Modified to use fixed-length strings.
'---------------------------------------------------------------------
FUNCTION FDList$ STATIC
DEF SEG = 0
FD% = PEEK(&H410) \ 64 + 1 'How many FDs installed?
DEF SEG 'Restore DGROUP
FD$ = SPACE$(FD%)
FOR N% = 1 TO FD% 'Place these letters into FD$
MID$(FD$, N%, 1) = CHR$(64 + N%)
NEXT
FDList$ = FD$ 'Return value
FD$ = ""
END FUNCTION
'PURPOSE
'Uses DOS ISR 21H, Function 44H, Subfunction 09H (Is Drive Remote)
'to return a list of valid, local hard drives.
'
'CREDIT(S)
'Larry Stone, based on a routine published in MicroHelp's BUG
'Newsletter, 1/1/90.
'
'Modified to use fixed-length strings.
'---------------------------------------------------------------------
FUNCTION HDList$ (FloppyList$)
DIM IRegs AS RegType, ORegs AS RegType
FloppyList$ = FDList$ 'Get floppy drive list
FDs% = LEN(FloppyList$) 'How many drives found?
HD% = FDs% + 1 + ABS(FD% = 1) 'If only 1 FD, first is C:
HD$ = SPACE$(HD%)
FOR BL% = HD% TO 26 'Check possible hard drives
IRegs.ax = &H4409 'Set up call
IRegs.bx = BL% 'Drive letter in BL
Interrupt &H21, IRegs, ORegs 'Call DOS
IF (ORegs.flags AND 1) THEN 'Check carry flag
EXIT FOR
END IF
MID$(HD$, HD%, 1) = CHR$(64 + ORegs.bx)'Add the letter
NEXT
HDList$ = HD$ 'Return value
HD$ = ""
END FUNCTION
'Author: Larry Stone Code: QB, PDS
'Origin: FidoNet QUIK_BAS Echo Packet: DISK.ABC
'------------------------------------------------------------------------=
'In QuickBASIC, how do I obtain a list of all active drives (except
'diskette drives). In other words, the C drive and any Novell
'network drives.
DEFINT A-Z
REM $INCLUDE: 'qbx.bi'
DECLARE FUNCTION FDList$ ()
DECLARE FUNCTION HDList$ (FloppyList$)
CLS
PRINT FDList$; " _";
PRINT HDList$(FloppyList$)
'FUNCTION FDList$
'
'PURPOSE
'PEEKs at the BIOS Equipment Word to return a list of floppy
'drives installed on the system.
'
'CREDIT(S)
'Larry Stone, based on a routine published in MicroHelp's BUG
'Newsletter, 1/1/90.
'
'Modified to use fixed-length strings.
'---------------------------------------------------------------------
FUNCTION FDList$ STATIC
DEF SEG = 0
FD% = PEEK(&H410) \ 64 + 1 'How many FDs installed?
DEF SEG 'Restore DGROUP
FD$ = SPACE$(FD%)
FOR N% = 1 TO FD% 'Place these letters into FD$
MID$(FD$, N%, 1) = CHR$(64 + N%)
NEXT
FDList$ = FD$ 'Return value
FD$ = ""
END FUNCTION
'PURPOSE
'Uses DOS ISR 21H, Function 44H, Subfunction 09H (Is Drive Remote)
'to return a list of valid, local hard drives.
'
'CREDIT(S)
'Larry Stone, based on a routine published in MicroHelp's BUG
'Newsletter, 1/1/90.
'
'Modified to use fixed-length strings.
'---------------------------------------------------------------------
FUNCTION HDList$ (FloppyList$)
DIM IRegs AS RegType, ORegs AS RegType
FloppyList$ = FDList$ 'Get floppy drive list
FDs% = LEN(FloppyList$) 'How many drives found?
HD% = FDs% + 1 + ABS(FD% = 1) 'If only 1 FD, first is C:
HD$ = SPACE$(HD%)
FOR BL% = HD% TO 26 'Check possible hard drives
IRegs.ax = &H4409 'Set up call
IRegs.bx = BL% 'Drive letter in BL
Interrupt &H21, IRegs, ORegs 'Call DOS
IF (ORegs.flags AND 1) THEN 'Check carry flag
EXIT FOR
END IF
MID$(HD$, HD%, 1) = CHR$(64 + ORegs.bx)'Add the letter
NEXT
HDList$ = HD$ 'Return value
HD$ = ""
END FUNCTION
Last edited by Macric on Mon Sep 05, 2005 6:30 am, edited 1 time in total.
- Michael Calkins
- Veteran
- Posts: 76
- Joined: Tue Apr 05, 2005 8:40 pm
- Location: Floresville, Texas
- Contact:
Re: Need as many quick answers as I can get!
I am refering to questions #1 and #2.
PEEK reads a byte of memory
POKE writes a byte of memory
DEF SEG sets what segment will be used by PEEK and POKE
Regards,
Michael
DEFINT A-Z
DEF FNhexw$ (n)
temp$ = HEX$(n)
FNhexw$ = STRING$(2 - LEN(temp$), "0") + temp$
END DEF
RANDOMIZE TIMER
DO
COLOR 7, 0: CLS
COLOR INT(RND * 32), INT(RND * 8)
PRINT "What is my color?"
COLOR 7, 0
PRINT "using SCREEN()"
PRINT FNhexw$(SCREEN(1, 1, 0)); FNhexw$(SCREEN(1, 1, 1))
PRINT "using PEEK()"
DEF SEG = &HB800 'the segment for color video memory
ascii = PEEK(&H0) 'get the ASCII value
attrib = PEEK(&H1) 'get the color attribute of the first chracter
'that segment uses byte pairs. Even bytes contain ASCII values, off bytes
'contain color attributes.
DEF SEG
PRINT FNhexw$(ascii); FNhexw$(attrib)
'Using POKE to
FOR i = 0 TO 255
DEF SEG = &HB800
POKE (i * 2) + (80 * 12), i
POKE ((i * 2) + 1) + (80 * 12), &H10 + INT(RND * 6) + &HA
DEF SEG
NEXT i
SLEEP 1
LOOP UNTIL INKEY$ <> ""
WHILE INKEY$ <> "": WEND
SYSTEM
PEEK reads a byte of memory
POKE writes a byte of memory
DEF SEG sets what segment will be used by PEEK and POKE
Regards,
Michael
DEFINT A-Z
DEF FNhexw$ (n)
temp$ = HEX$(n)
FNhexw$ = STRING$(2 - LEN(temp$), "0") + temp$
END DEF
RANDOMIZE TIMER
DO
COLOR 7, 0: CLS
COLOR INT(RND * 32), INT(RND * 8)
PRINT "What is my color?"
COLOR 7, 0
PRINT "using SCREEN()"
PRINT FNhexw$(SCREEN(1, 1, 0)); FNhexw$(SCREEN(1, 1, 1))
PRINT "using PEEK()"
DEF SEG = &HB800 'the segment for color video memory
ascii = PEEK(&H0) 'get the ASCII value
attrib = PEEK(&H1) 'get the color attribute of the first chracter
'that segment uses byte pairs. Even bytes contain ASCII values, off bytes
'contain color attributes.
DEF SEG
PRINT FNhexw$(ascii); FNhexw$(attrib)
'Using POKE to
FOR i = 0 TO 255
DEF SEG = &HB800
POKE (i * 2) + (80 * 12), i
POKE ((i * 2) + 1) + (80 * 12), &H10 + INT(RND * 6) + &HA
DEF SEG
NEXT i
SLEEP 1
LOOP UNTIL INKEY$ <> ""
WHILE INKEY$ <> "": WEND
SYSTEM
Bring on the Maulotaurs! oops...
I like to slay Disciples of D'Sparil...
I like to slay Disciples of D'Sparil...
- Michael Calkins
- Veteran
- Posts: 76
- Joined: Tue Apr 05, 2005 8:40 pm
- Location: Floresville, Texas
- Contact:
more info, just in case
just in case
16 bit code gets more than 64 KB by segmenting. Each segment is 64KB big. Segments overlap every 16 bytes. (16 bytes=1 paragraph). That meanse you can have segments 0000h to FFFFh and offsets from 0000h to FFFFh. The <b>actual</b> address is the segment * 16 + the offset. (this means 20 bit addressing).
Anyway, most of the time you will be concerned with stuff inside a segment. You will have an offset from the start of the segment. For example, in my program above. I used the color memory at B800h. That is the "base" segment. B801:0000 is the same location as B800:0010. However it is better to change the offset, when possible. Think of yourself as being inside a 64KB chunk of memory.
To find the locations of QBASIC varibles, use VARSEG() and VARPTR(). The first returns the segment, the second returns the offset.
Regards,
Michael
16 bit code gets more than 64 KB by segmenting. Each segment is 64KB big. Segments overlap every 16 bytes. (16 bytes=1 paragraph). That meanse you can have segments 0000h to FFFFh and offsets from 0000h to FFFFh. The <b>actual</b> address is the segment * 16 + the offset. (this means 20 bit addressing).
Anyway, most of the time you will be concerned with stuff inside a segment. You will have an offset from the start of the segment. For example, in my program above. I used the color memory at B800h. That is the "base" segment. B801:0000 is the same location as B800:0010. However it is better to change the offset, when possible. Think of yourself as being inside a 64KB chunk of memory.
To find the locations of QBASIC varibles, use VARSEG() and VARPTR(). The first returns the segment, the second returns the offset.
Regards,
Michael
Bring on the Maulotaurs! oops...
I like to slay Disciples of D'Sparil...
I like to slay Disciples of D'Sparil...
-
- Veteran
- Posts: 399
- Joined: Wed Mar 02, 2005 9:01 pm
- Location: Nashville, Tennessee
- Contact:
- The Awakened
- Veteran
- Posts: 144
- Joined: Sun Aug 07, 2005 1:51 am
Well, if the numbers can be between 0 and 255, you could do this:
I put the DEF SEG's inside the loop. I'm not entirely sure that you HAVE to do that, but just to be safe, I did.
Code: Select all
DIM Variables (0 to 39)
x = 1
y = 2 'change to whatever the 2 numbers are that you need
'put the variables in
FOR counter= 0 to 39
DEF SEG = VARSEG (Variables(counter))
POKE VARPTR(Variables(counter)) , x
POKE VARPTR(Variables(counter)) + 1 , y
NEXT
'to get them back
FOR counter = 0 to 39
DEF SEG = VARSEG (Variables(counter))
Value1% = PEEK (VARPTR(Variables(counter)))
Value2% = PEEK (VARPTR(Variables(counter)))
'do whatever you need
NEXT
"Sorry for beating you up with a baseball bat Julian, but I DID think that you were a samsquanch."
-
- Veteran
- Posts: 399
- Joined: Wed Mar 02, 2005 9:01 pm
- Location: Nashville, Tennessee
- Contact:
Need answers b/c I am working on SGUI (Semi-Graphical User Interface) called Eclipse. It has mouse support, and I need POKEing and PEEKing for my window function. I have a sub for returning a foreground, background, and ASCII value of a certain spot on a screen. (using values from the SCREEN function) so my windows, when they go away, appear to have not touched the text under them. Hope that helps you understand.
- Michael Calkins
- Veteran
- Posts: 76
- Joined: Tue Apr 05, 2005 8:40 pm
- Location: Floresville, Texas
- Contact:
Still not sure exactly what you are asking...
INTEGERs? LONGs? BYTEs?what I need to do is be able to put about 40 sets of 2 numbers in memory...
Where in memeory? The video memory? Some QBASIC array?
If you mean copying 1 array to another very quickly, you could use a machine code routine to do it faster than interpreted QBASIC.
Would you be in SCREEN 0?Semi-Graphical
You have already acheived this? Please be specific in what further assitance you need.I have a sub for returning a foreground, background, and ASCII value of a certain spot on a screen. (using values from the SCREEN function) so my windows, when they go away, appear to have not touched the text under them. Hope that helps you understand.
Here is a another demo I wrote, after glancing through your last post. After reading the post several times, I realised you may have already gotten that far. Maybe it will still be some help.
Regards,
Michael
Code: Select all
'Written by Michael Calkins
DEFINT A-Z
wid = 80
hei = 25
DIM sbuffer(0 TO (wid * hei) - 1) AS INTEGER 'a buffer
DIM lin(0 TO 1), col(0 TO 1)
SCREEN 0: WIDTH wid, hei
COLOR 7, 0: CLS
RANDOMIZE TIMER
'generate random background, as an example
FOR l = 1 TO hei
FOR c = 1 TO wid
COLOR INT(RND * 32), INT(RND * 8)
LOCATE l, c: PRINT CHR$(INT(RND * 224) + 32);
NEXT c
NEXT l
SLEEP 2
lin(0) = 10: col(0) = 20 'define the box
lin(1) = 20: col(1) = 60
'choose a random method
SELECT CASE INT(RND * 2)
CASE 0: GOSUB saveboxPEEK 'Use PEEK
CASE 1: GOSUB saveboxSCREEN 'Use SCREEN
END SELECT
COLOR 15, 1
FOR i = 0 TO 1 'draw top and bottom of box
LOCATE lin(i), col(0)
PRINT CHR$(&HDA - (&H1A * i)); STRING$(col(1) - col(0) - 2, &HC4); CHR$(&HBF + (&H1A * i));
NEXT i
FOR i = lin(0) + 1 TO lin(1) - 1 'draw lines in between
LOCATE i, col(0)
PRINT CHR$(&HB3); STRING$(col(1) - col(0) - 2, &H20); CHR$(&HB3);
NEXT i
SLEEP 1
'choose a random method
SELECT CASE INT(RND * 2)
CASE 0: GOSUB restoreboxPOKE 'Use POKE
CASE 1: GOSUB restoreboxPRINT 'Use COLOR and PRINT
END SELECT
SLEEP 1
WHILE INKEY$ <> "": WEND
SYSTEM
saveboxPEEK:
'parameters: lin(0 to 1), col(0 to 1), wid <--all INTEGERs
'internal variables: l,c,ind <-- all INTEGERs
'uses sbuffer(0 to (eid*hei)-1) <-- INTEGER array
DEF SEG = &HB800 'color video memory segment
FOR l = lin(0) TO lin(1)
FOR c = col(0) TO col(1)
ind = ((l - 1) * wid) + (c - 1) 'find index
sbuffer(ind) = PEEK(ind * 2)
'convert to signed
IF sbuffer(ind) > &H7F THEN sbuffer(ind) = (sbuffer(ind) - &H100)
'shift left and add in the color
sbuffer(ind) = (sbuffer(ind) * &H100) OR PEEK((ind * 2) + 1)
NEXT c
NEXT l
DEF SEG
RETURN
restoreboxPOKE:
'parameters: lin(0 to 1), col(0 to 1), wid <--all INTEGERs
'internal variables: l,c,ind <-- all INTEGERs
'uses sbuffer(0 to (eid*hei)-1) <-- INTEGER array
DEF SEG = &HB800 'color video memory segment
FOR l = lin(0) TO lin(1)
FOR c = col(0) TO col(1)
ind = ((l - 1) * wid) + (c - 1) 'find index
'isolate ascii and shift right
POKE ind * 2, (sbuffer(ind) AND &HFF00) \ &H100
'isolate color
POKE (ind * 2) + 1, sbuffer(ind) AND &HFF
NEXT c
NEXT l
DEF SEG
RETURN
saveboxSCREEN:
'parameters: lin(0 to 1), col(0 to 1), wid <--all INTEGERs
'internal variables: l,c,ind <-- all INTEGERs
'uses sbuffer(0 to (eid*hei)-1) <-- INTEGER array
FOR l = lin(0) TO lin(1)
FOR c = col(0) TO col(1)
ind = ((l - 1) * wid) + (c - 1) 'find index
sbuffer(ind) = SCREEN(l, c, 0)
'convert to signed
IF sbuffer(ind) > &H7F THEN sbuffer(ind) = (sbuffer(ind) - &H100)
'shift left and add in color
sbuffer(ind) = (sbuffer(ind) * &H100) OR SCREEN(l, c, 1)
NEXT c
NEXT l
RETURN
restoreboxPRINT:
'parameters: lin(0 to 1), col(0 to 1), wid <--all INTEGERs
'internal variables: l,c,ind,fg,bg,ascii <-- all INTEGERs
'uses sbuffer(0 to (eid*hei)-1) <-- INTEGER array
FOR l = lin(0) TO lin(1)
FOR c = col(0) TO col(1)
ind = ((l - 1) * wid) + (c - 1) 'find index
LOCATE l, c
fg = (sbuffer(ind) AND &HF) 'isolate foreground
IF sbuffer(ind) AND &H80 THEN fg = fg + 16 'is it blinking?
bg = (sbuffer(ind) AND &H70) \ &H10 'isolate background
COLOR fg, bg
ascii = (sbuffer(ind) AND &HFF00) \ &H100 'isolate ascii and shift right
IF ascii < &H0 THEN ascii = ascii + &H100 'convert to unsigned
PRINT CHR$(ascii);
NEXT c
NEXT l
RETURN
Bring on the Maulotaurs! oops...
I like to slay Disciples of D'Sparil...
I like to slay Disciples of D'Sparil...
-
- Veteran
- Posts: 399
- Joined: Wed Mar 02, 2005 9:01 pm
- Location: Nashville, Tennessee
- Contact:
I need 2 reserved numbers for background/foreground, and then a random amount of variables available for use as ASCII codes.INTEGERs? LONGs? BYTEs?
Where in memeory? The video memory? Some QBASIC array?
If you mean copying 1 array to another very quickly, you could use a machine code routine to do it faster than interpreted QBASIC.
Screen 0 in operating environment, screen 12 in screensavers/title screen.Would you be in SCREEN 0?
My screen is 80x43, not 80x25.'Written by Michael Calkins
DEFINT A-Z
wid = 80
hei = 25
=====================
Also, I need a way of recalling these variables from memory, to re-display them on the screen. Long story short, I need to be able to make windows, remove them, and 'not have the text 'under' them harmed.' (most QBers know why it's in quotes.)
- Michael Calkins
- Veteran
- Posts: 76
- Joined: Tue Apr 05, 2005 8:40 pm
- Location: Floresville, Texas
- Contact:
I am not getting what this has to do with PEEK and POKE. You could do something like:I need 2 reserved numbers for background/foreground, and then a random amount of variables available for use as ASCII codes.
DIM foreground AS INTEGER
DIM background AS INTEGER
DIM ASCII(0 to (80*43)-1) AS STRING * 1
no problem. That is why I made it a variable. Just change hei=25 to hei=43. It was just a demo after all. You can adapt any part of it to your own program, if that suits you.My screen is 80x43, not 80x25
That is exactly what my demo did. Are you looking for a more efficient way? I could write a more efficient way using Assembly and CALL absolute(), but the pure QBASIC seemed fairly fast. No offense, but did you even run my demo?Long story short, I need to be able to make windows, remove them, and 'not have the text 'under' them harmed.'
Regards,
Michael
Bring on the Maulotaurs! oops...
I like to slay Disciples of D'Sparil...
I like to slay Disciples of D'Sparil...
-
- Veteran
- Posts: 399
- Joined: Wed Mar 02, 2005 9:01 pm
- Location: Nashville, Tennessee
- Contact:
Okay, sorry for not running your program, I didn;t have an interpreter at the school
Can you make that work with this SUB? It has variables telling the X and Y sides, centers automatically on the screen, and has a title (not important)
If you could, make it a sub called RemoveWindow.
Can you make that work with this SUB? It has variables telling the X and Y sides, centers automatically on the screen, and has a title (not important)
If you could, make it a sub called RemoveWindow.
Code: Select all
DECLARE SUB MakeWindow (title$, wdth%, hght%)
SCREEN 0 ' SCREEN 0 for the best results.
WIDTH 80, 43 ' What Eclipse runs on.
COLOR 0, 9 ' makes the shadow visible. (on a blue background)
CLS ' always CLS after COLOR for a filled screen. (in screen 0)
' USAGE:
MakeWindow "Patz QuickBasic Creations", 50, 18
SUB MakeWindow (title$, wdth%, hght%)
midheight = INT(21 - (hght% / 2))
midwidth = INT(41 - (wdth% / 2))
test1 = wdth% - 2
topbar$ = "?": lowbar$ = "?"
WHILE test1 > 0
LET topbar$ = topbar$ + "?"
LET lowbar$ = lowbar$ + "?"
LET shadow$ = shadow$ + "?"
LET test1 = test1 - 1
WEND
LET shadow$ = shadow$ + "??"
LET topbar$ = topbar$ + "?"
LET lowbar$ = lowbar$ + "?"
COLOR 1, 15
LOCATE midheight, midwidth: PRINT topbar$
newhg = hght% - 2
woah = midheight + newhg
newwd = wdth% - 2
newlo = midheight
make$ = "?" + SPACE$(newwd) + "?"
WHILE newhg > 0
LET newhg = newhg - 1
LET newlo = newlo + 1
LOCATE newlo, midwidth: PRINT make$: LOCATE newlo, midwidth + wdth%: COLOR 0, 7: PRINT "??": COLOR 1, 7
WEND
LOCATE woah, midwidth: PRINT lowbar$
LOCATE woah + 1, midwidth + 2: COLOR 0, 7: PRINT shadow$
LOCATE midheight, midwidth + 2: PRINT title$
END SUB
- Michael Calkins
- Veteran
- Posts: 76
- Joined: Tue Apr 05, 2005 8:40 pm
- Location: Floresville, Texas
- Contact:
I should have mentioned this earlier.
PCOPY is a way of copying the contents of one video memory page to another. In screen mode 0, most people will have 8 video memory pages. So you can use PCOPY 0,1 to save your screen before drawing the menu, and PCOPY 1,0 to restore it after you are done.
Also, please look up the STRING$ function in the QBASIC Help. It will save you some work.
I took the liberty of making your shadows translucent. If you don't like that, then just restore things to the way they were. The PCOPY is what does the saving/restoring. All other changes were either demo, optimization, or translucent shadow effect.
Regards,
Michael
[/code]
PCOPY is a way of copying the contents of one video memory page to another. In screen mode 0, most people will have 8 video memory pages. So you can use PCOPY 0,1 to save your screen before drawing the menu, and PCOPY 1,0 to restore it after you are done.
Also, please look up the STRING$ function in the QBASIC Help. It will save you some work.
I took the liberty of making your shadows translucent. If you don't like that, then just restore things to the way they were. The PCOPY is what does the saving/restoring. All other changes were either demo, optimization, or translucent shadow effect.
Regards,
Michael
Code: Select all
DECLARE SUB RemoveWindow ()
DECLARE SUB MakeWindow (title$, wdth%, hght%)
SCREEN 0 ' SCREEN 0 for the best results.
WIDTH 80, 43 ' What Eclipse runs on.
COLOR 0, 9 ' makes the shadow visible. (on a blue background)
CLS ' always CLS after COLOR for a filled screen. (in screen 0)
FOR l = 1 TO 43
FOR c = 1 TO 80 STEP 2
COLOR INT(RND * 15) + 1, INT(RND * 8)
LOCATE l, c
PRINT CHR$(INT(RND * 224) + 32);
NEXT c
NEXT l
SLEEP 4
' USAGE:
MakeWindow "Patz QuickBasic Creations", 50, 18
SLEEP 3
RemoveWindow
WHILE INKEY$ <> "": WEND
SYSTEM
SUB MakeWindow (title$, wdth%, hght%)
PCOPY 0, 1 'backup old screen
midheight = INT(21 - (hght% / 2))
midwidth = INT(41 - (wdth% / 2))
topbar$ = "?" + STRING$(wdth% - 2, "?") + "?"
lowbar$ = "?" + STRING$(wdth% - 2, "?") + "?"
'shadow$ = STRING$(wdth%, "?")
COLOR 1, 15
LOCATE midheight, midwidth: PRINT topbar$
make$ = "?" + SPACE$(wdth% - 2) + "?"
FOR i% = 1 TO hght% - 2
'LOCATE i% + midheight, midwidth: PRINT make$; : COLOR 0, 7: PRINT "??": COLOR 1, 7
'added for translucent shadow effect:
l% = i% + midheight
LOCATE l%, midwidth: PRINT make$
DEF SEG = &HB800
FOR c% = midwidth + wdth% TO midwidth + wdth% + 1
ind% = ((l% - 1) * 80) + (c% - 1)
POKE ind% * 2 + 1, &H8
NEXT c%
DEF SEG
NEXT i%
LOCATE midheight + hght% - 2, midwidth: PRINT lowbar$
'LOCATE midheight + hght% - 1, midwidth + 2: COLOR 0, 7: PRINT shadow$
'added for translucent shadow effect:
DEF SEG = &HB800
l% = midheight + hght% - 1
FOR c% = midwidth + 2 TO midwidth + wdth% + 1
ind% = ((l% - 1) * 80) + (c% - 1)
POKE ind% * 2 + 1, &H8
NEXT c%
DEF SEG
COLOR 0, 7
LOCATE midheight, midwidth + 2: PRINT title$
END SUB
SUB RemoveWindow
PCOPY 1, 0 'restore old screen
END SUB
Bring on the Maulotaurs! oops...
I like to slay Disciples of D'Sparil...
I like to slay Disciples of D'Sparil...
-
- Veteran
- Posts: 399
- Joined: Wed Mar 02, 2005 9:01 pm
- Location: Nashville, Tennessee
- Contact:
I'm realitivaly new at 'graphics' , su PCOPY will probably save me a ton of troble. thanks a bunch, ur going on the credits! If you have a website, post the name here so I can put it in my credits.
Credits so far:
Michael Calkins (PCOPY)
UWLabs (many ideas I used)
Microsoft (for QBasic)
Pete (for having such a great, helpful site)
My credits generates these as buttons, so when you click it, a box pops up saying how they helped.
Credits so far:
Michael Calkins (PCOPY)
UWLabs (many ideas I used)
Microsoft (for QBasic)
Pete (for having such a great, helpful site)
My credits generates these as buttons, so when you click it, a box pops up saying how they helped.