home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
basic
/
library
/
pb
/
pbtlte12
/
demo.bas
< prev
next >
Wrap
BASIC Source File
|
1992-02-28
|
13KB
|
406 lines
$CPU 8086
$LIB ALL OFF
$ERROR ALL OFF
DEFINT A-Z
'Declarations for PBTools
PUBLIC Xpos%(), Ypos%(), WAttr%(), Xlen%(), Ylen%(), BAttr%(), ScrSav$(),_
Brdr%(), Shad%(), Pntr%(), CurWin%, MaxWin%
MaxWin%=20 'Defaults to 15, reset to 20 for demo.
$LINK "PBTLITE.PBU"
$SEGMENT
DIM Menu1$(1:9)
Menu1$(1)=" Border Types "
Menu1$(2)=" Moving Windows "
Menu1$(3)=" Recoloring "
Menu1$(4)=" resiZing "
Menu1$(5)=" scroLling "
Menu1$(6)=" Shadows "
Menu1$(7)=" Titles "
Menu1$(8)=" Other Demos "
Menu1$(9)=" Exit Demo "
DIM Menu2$(1:4)
Menu2$(1)=" Key status "
Menu2$(2)=" String tools "
Menu2$(3)=" string Testing "
Menu2$(4)=" Quit to main "
True$="On "
False$="Off"
Yes$="Yes"
No$="No "
CALL InitPBScreen
CALL Fill(1,1,25,80,178,23)
CALL OpenWin(5,12,13,58,11,20,31,3,1,0) 'Window #1
CALL WPrintC(1,"PBTools:Lite v1.2",0)
CALL WPrintC(2,"Copyright (c) 1990 by Dave Navarro, Jr.",0)
CALL WPrintC(3,"Demo by James R. Davis",0)
IF CurDisplay%=0 THEN Mon$="Monochrome"
IF CurDisplay%=1 THEN Mon$="CGA"
IF CurDisplay%=2 THEN Mon$="EGA"
IF CurDisplay%=3 THEN Mon$="MCGA"
IF CurDisplay%=4 THEN Mon$="VGA"
Text$="A "+Mon$+" monitor is running in display mode"+STR$(VidMode%)
CALL WPrintC(5,Text$,0)
Text$="Video RAM segment located at "+HEX$(VidSeg%)+"H "
CALL WPrintC(6,Text$,0)
Text$="System has"+STR$(FRE(-1)\1024)+"K Free RAM"
CALL WPrintC(7,Text$,0)
Text$="The value of the top of the current cursor is"+STR$(CurTop%)
CALL WPrintC(8,Text$,0)
Text$="The value of the bottom of the current cursor is"+STR$(CurBot%)
CALL WPrintC(9,Text$,0)
CALL WPrintC(11,"Press Any Key to Continue",0)
I$=GetKey$
CALL CloseWin
FirstMenu:
CALL OpenWin(2,20,5,45,2,30,31,3,0,0) 'Window #1
CALL WPrintC(1,"PBTools:Lite v1.2",0)
CALL WPrintC(2,"(C) Copyright 1991 by Dave Navarro, Jr.",0)
CALL WPrintC(3,"Demo by James R. Davis",0)
CALL OpenWin(8,4,11,20,2,30,31,3,1,1) 'Window #2
IF CurDisplay%=0 THEN Menu1$(3)=" =-=-=-=-=-=-=-= "
IF CurDisplay%=0 THEN Hilite%=Attr%(0,7) ELSE Hilite%=Attr%(1,7)
XWin%=1:YWin%=2
MainMenu:
Choice%=Menu%(Menu1$(),1,9,Choice%,Hilite%,Attr%(14,1))
IF Choice%<1 THEN Choice%=9:GOTO MainMenu
IF Choice%=1 THEN BorTypes
IF Choice%=2 THEN MovingWin
IF Choice%=3 THEN CycleColors
IF Choice%=4 THEN Resize
IF Choice%=5 THEN Scrolling
IF Choice%=6 THEN Shadows
IF Choice%=7 THEN Titles
IF Choice%=8 THEN Other
IF Choice%=9 THEN SayBye
GOTO MainMenu
Titles:
CALL OpenWin(7,14,15,55,2,30,31,3,1,0) 'Window #3
CALL WPrintC(6,"You can place titles in 6 different",0)
CALL WPrintC(8,"positions on the window border. ",0)
DELAY 1
CALL Title(1,0,"[Position 1]")
DELAY 1
CALL Title(2,0,"[Position 2]")
DELAY 1
CALL Title(3,0,"[Position 3]")
DELAY 1
CALL Title(4,0,"[Position 4]")
DELAY 1
CALL Title(5,0,"[Position 5]")
DELAY 1
CALL Title(6,0,"[Position 6]")
DELAY 4
CALL CloseWin
GOTO MainMenu
Shadows:
CALL OpenWin(6,13,10,30,2,30,31,0,1,0) 'Window #3
CALL WPrintC(4,"No Shadow!",0)
DELAY 2
CALL OpenWin(8,19,10,30,2,30,31,1,1,0) 'Window #4
CALL WPrintC(3,"Solid Shadow",0)
CALL WPrintC(5,"Drop Left",0)
DELAY 3
CALL OpenWin(10,25,10,30,2,30,31,2,1,0) 'Window #5
CALL WPrintC(3,"Solid Shadow",0)
CALL WPrintC(5,"Drop Right",0)
DELAY 3
CALL OpenWin(12,31,10,30,2,30,31,3,1,0) 'Window #6
CALL WPrintC(3,"Transparent Shadow",0)
CALL WPrintC(5,"Drop Left",0)
DELAY 3
CALL OpenWin(14,37,10,30,2,30,31,4,1,0) 'Window #7
CALL WPrintC(3,"Transparent Shadow",0)
CALL WPrintC(5,"Drop Right",0)
DELAY 3
CALL CloseWin
DELAY 1
CALL CloseWin
DELAY 1
CALL CloseWin
DELAY 1
CALL CloseWin
DELAY 1
CALL CloseWin
GOTO MainMenu
Scrolling:
CALL OpenWin(20,18,4,50,2,30,31,3,0,0) 'Window #3
CALL WPrintC(1,"Scroll the inside of a window any direction!",0)
CALL WPrintC(2,"+/- Speed; Press ESC to end scrolling demo.",0)
CALL OpenWin(8,28,10,50,2,30,31,3,0,0) 'Window #4
CALL WPrintC(1,"Bouncing!!",0)
Yscr%=1:XScr%=20:Xdir%=-1:Ydir%=1:D=1:I$=""
CALL ClrKbd
DO
I$=INKEY$
IF I$="-" THEN INCR D,D/3:IF D>=4 THEN D=4
IF I$="+" THEN DECR D,D/3:IF D<=.000001 THEN D=.000001
IF Xdir%<0 THEN DECR XScr% ELSE INCR XScr%
IF Ydir%<0 THEN DECR YScr% ELSE INCR YScr%
IF XScr%<1 THEN Xdir%=1:SOUND 200,.2 ELSE IF XScr%>37 THEN Xdir%=-1:SOUND 200,.2
IF YScr%<3 THEN YDir%=1:SOUND 200,.2 ELSE IF YScr%>8 THEN YDir%=-1:SOUND 200,.2
IF Xdir%<0 THEN CALL ScrollWin(4) ELSE CALL ScrollWin(3)
IF Ydir%<0 THEN CALL ScrollWin(2) ELSE CALL ScrollWin(1)
DELAY D
LOOP UNTIL I$=CHR$(27)
CALL CloseWin
CALL CloseWin
GOTO MainMenu
Resize:
CALL OpenWin(20,18,4,50,2,30,31,3,0,0) 'Window #3
CALL WPrintC(1,"Resizing windows is easy!!",0)
CALL WPrintC(2,"Press ESC to end resizing demo.",0)
CALL OpenWin(7,35,9,25,2,30,31,0,0,0) 'Window #4
CALL WPrint(1,2,"Resizing!!!",0)
Xlen%=25:Ylen%=9:Xdir%=-1:Ydir%=-1
KeyLoop:
IF Xdir%<0 THEN DECR Xlen% ELSE INCR Xlen%
IF YDir%<0 THEN DECR Ylen% ELSE INCR Ylen%
IF XLen%<15 THEN Xdir%=1 ELSE IF Xlen%>34 THEN Xdir%=-1
IF Ylen%<3 THEN Ydir%=1 ELSE IF Ylen%>15 THEN Ydir%=-1
IF Xdir%<0 THEN CALL ChangeWin(2) ELSE CALL ChangeWin(1)
IF Ydir%<0 THEN CALL ChangeWin(4) ELSE CALL ChangeWin(3)
IF INKEY$<>CHR$(27) THEN KeyLoop
CALL CloseWin
CALL CloseWin
GOTO MainMenu
MovingWin:
CALL OpenWin(21,17,4,50,2,30,31,0,0,0) 'Window #3
CALL WPrintC(1,"Use Arrow Keys to move Menu",0)
CALL WPrintC(2,"Press ESC when your finished. ",0)
CurWin%=2 'Be Careful when you change the current windo!
CALL NoShadow
EndlessLoop:
I$=GetKey$
IF I$=CHR$(27) THEN NoMove
IF I$=CHR$(0,77) AND XWin%<57 THEN INCR XWin%:CALL MoveWin(1)
IF I$=CHR$(0,75) AND XWin%>1 THEN DECR XWin%:CALL MoveWin(2)
IF I$=CHR$(0,80) AND YWin%<3 THEN INCR YWin%:CALL MoveWin(3)
IF I$=CHR$(0,72) AND YWin%>1 THEN DECR YWin%:CALL MoveWin(4)
GOTO EndlessLoop
NoMove:
CurWin%=3
CALL CloseWin
CALL AddShadow(3)
GOTO MainMenu
CycleColors:
IF CurDisplay%=0 THEN MainMenu
CurWin%=1
FOR I%=128 TO 1 STEP -1
CALL WinColor(I%)
FOR T%=1 TO 32000:NEXT T%
IF INKEY$<>"" THEN EXIT FOR
NEXT I%
CALL WinColor%(31)
CurWin%=2
GOTO MainMenu
BorTypes:
CALL OpenWin(7,4,17,76,2,30,31,3,0,0) 'Window #3
IF CurDisplay%=0 THEN Normal%=Attr%(0,7) ELSE Normal%=Attr%(1,7)
FOR I%=3 TO 0 STEP -1 'Window #4-7
CALL OpenWin(8,14+(I%*15),5,13,I%,Normal%,Normal%,3,0,0)
CALL Title(1,0,"[Frame"+STR$(I%)+"]")
NEXT I%
FOR I%=4 TO 0 STEP -1 'Window #8-12
CALL OpenWin(11,8+(I%*14),5,13,I%+4,Attr%(14,4),Attr%(14,4),3,0,0)
CALL Title(1,0,"[Frame"+STR$(I%+4)+"]")
NEXT I%
FOR I%=2 TO 0 STEP -1 'Window #13-16
CALL OpenWin(14,19+(I%*17),5,14,I%+9,Attr%(15,5),Attr%(15,5),3,0,0)
CALL Title(2,0,"[Frame"+STR$(I%+9)+"]")
NEXT I%
FOR I%=1 TO 0 STEP -1 'Window #17-18
CALL OpenWin(17,28+(I%*17),5,14,I%+12,Attr%(8,7),Attr%(8,7),3,0,0)
CALL Title(2,0,"[Frame"+STR$(I%+12)+"]")
NEXT I%
I$=GetKey$
FOR I%=0 TO 14
CALL CloseWin
NEXT I%
GOTO MainMenu
SayBye:
CALL OpenWin(1,1,25,80,0,7,7,0,1,0) 'Window #3
LOCATE 1,1
PRINT "Thanks for giving PBTools:Lite v1.2 a try!"
END
Other:
X%=Xpos%(2)+2:Y%=Ypos%(2)+9
CALL OpenWin(Y%,X%,6,20,2,30,31,3,1,1) 'Window #3
IF CurDisplay%=0 THEN Hilite%=Attr%(0,7) ELSE Hilite%=Attr%(1,7)
XWin%=1:YWin%=2
MainMenu2:
Choic%=Menu%(Menu2$(),1,4,Choic%,Hilite%,Attr%(14,1))
IF Choic%<1 THEN Choic%=4:GOTO MainMenu2
IF Choic%=1 THEN KeyStats
IF Choic%=2 THEN StringTools
IF Choic%=3 THEN StringTests
IF Choic%=4 THEN CALL CloseWin:GOTO MainMenu
GOTO MainMenu2
KeyStats:
CALL OpenWin(20,18,4,50,2,30,31,3,0,0) 'Window #4
CALL WPrintC(1,"Test or toggle the state of any key!",0)
CALL WPrintC(2,"Press ESC to end key demo.",0)
CALL OpenWin(7,28,12,28,2,30,31,3,0,0) 'Window #5
CALL WPrint(1,1," Toggle Keys State ",Attr%(15,4))
CALL WPrint(2,4,"Caps Lock",Attr%(14,1))
CALL WPrint(3,4,"Insert Key",Attr%(14,1))
CALL WPrint(4,4,"Num Lock",Attr%(14,1))
CALL WPrint(5,4,"Scroll Lock",Attr%(14,1))
CALL WPrint(6,1," Alternate Keys ",Attr%(15,4))
CALL WPrint(7,4,"Alt Key",Attr%(14,1))
CALL WPrint(8,4,"Ctrl Key",Attr%(14,1))
CALL WPrint(9,4,"Left Shift",Attr%(14,1))
CALL WPrint(10,4,"Right Shift",Attr%(14,1))
'Set default toggle status
Caps%=CapStat%
Ins%=InsStat%
Num%=NumStat%
Scroll%=ScrollStat%
CALL CapsOff
CALL InsertOff
CALL NumOff
CALL ScrollOff
Alt$=False$
Ctrl$=False$
LShift$=False$
RShift$=False$
DO
IF CapStat% THEN Caps$=True$ ELSE Caps$=False$
IF InsStat% THEN Ins$=True$ ELSE Ins$=False$
IF NumStat% THEN Num$=True$ ELSE Num$=False$
IF ScrollStat% THEN Scroll$=True$ ELSE Scroll$=False$
IF IsAlt% THEN Alt$=True$ ELSE Alt$=False$
IF IsCtrl% THEN Ctrl$=True$ ELSE Ctrl$=False$
IF IsLShift% THEN LShift$=True$ ELSE LShift$=False$
IF IsRShift% THEN RShift$=True$ ELSE RShift$=False$
CALL WPrint(2,21,Caps$,Attr%(15,1))
CALL WPrint(3,21,Ins$,Attr%(15,1))
CALL WPrint(4,21,Num$,Attr%(15,1))
CALL WPrint(5,21,Scroll$,Attr%(15,1))
CALL WPrint(7,21,Alt$,Attr%(15,1))
CALL WPrint(8,21,Ctrl$,Attr%(15,1))
CALL WPrint(9,21,LShift$,Attr%(15,1))
CALL WPrint(10,21,RShift$,Attr%(15,1))
LOOP UNTIL INKEY$=CHR$(27)
'Restore all defaults for toggles
IF Caps% THEN CALL CapsOn
IF Ins% THEN CALL InsertOn
IF Num% THEN CALL NumOn
IF Scroll% THEN CALL ScrollOn
CALL CloseWin
CALL CloseWin
GOTO MainMenu2
StringTools:
N$=""
P$=""
CALL OpenWin(20,18,4,50,2,30,31,3,0,0) 'Window #4
CALL WPrintC(1,"You can do so much with our string tools!",0)
CALL WPrintC(2,"Press ESC to end key demo.",0)
CALL OpenWin(8,28,11,50,2,30,31,3,0,0) 'Window #5
CALL WPrintC(2,"Enter your name:",0)
CALL Box(11,42,3,22,1,0,Attr%(15,1),Attr%(14,4))
CALL TextIn(12,43,20,Attr%(15,4),Attr%(14,4),N$,Term$)
IF Term$=CHR$(27) THEN EndST
CALL WPrintC(6,"Enter your phone number:",0)
CALL Box(15,45,3,16,1,0,Attr%(15,1),Attr%(14,4))
CALL MaskIn(16,46,Attr%(15,4),Attr%(14,4),"(###)###-####",P$,Term$)
IF Term$=CHR$(7) THEN EndST
N$=N$+" "+P$
DELAY 1
CALL NoShadow
CALL ClearWin
FOR X%=1 TO 5
CALL ChangeWin(4)
DELAY .25
NEXT X%
CALL AddShadow(3)
CurWin%=4
CALL WPrintC(1," Manipulating strings is a snap! ",0)
CurWin%=5
CALL WPrintC(1,"Padding the string with characters is a breeze!",0)
CALL Box(10,29,3,48,1,0,Attr%(15,1),Attr%(14,1))
FOR X%=1 TO (46-LEN(N$))/2
N$=LPad$(N$,LEN(N$)+1,32)
CALL WPrint(3,2,N$,Attr%(14,4))
DELAY .5
NEXT X%
FOR X%=1 TO (46-LEN(N$))
N$=RPad$(N$,LEN(N$)+1,32)
CALL WPrint(3,2,N$,Attr%(14,4))
DELAY .5
NEXT X%
CALL WPrintC(3,REPEAT$(46," "),0)
N$=Trim$(N$)
CALL WPrintC(3,N$,Attr%(14,4))
N1$=N$
I$=GetKey$
EndST:
CALL CloseWin
CALL CloseWin
GOTO MainMenu2
StringTests:
CALL OpenWin(20,18,4,50,2,30,31,3,0,0) 'Window #4
CALL WPrintC(1,"Press any key on the keyboard.",0)
CALL WPrintC(2,"Press ESC to end key demo.",0)
CALL OpenWin(8,28,9,44,2,30,31,3,0,0) 'Window #5
CALL WPrintC(1,"Your Input:",Attr%(14,1))
CALL WPrint(3,2,"Input Character Type:",Attr%(14,1))
CALL WPrint(4,2," ASCII : Numeric :",Attr%(14,1))
CALL WPrint(5,2," Alpha : Punctuation:",Attr%(14,1))
CALL WPrint(6,2," Alphanumeric: Other :",Attr%(14,1))
DO
I$=GetKey$
Oth$=Yes$
IF IsASCII%(I$) THEN ASII$=Yes$:Oth$=No$ ELSE ASII$=No$
IF IsAlpha%(I$) THEN Alpha$=Yes$:Oth$=No$ ELSE Alpha$=No$
IF IsAlphaNum%(I$) THEN AlphaNum$=Yes$:Oth$=No$ ELSE AlphaNum$=No$
IF IsNum%(I$) THEN Num$=Yes$:Oth$=No$ ELSE Num$=No$
IF IsPunct%(I$) THEN Punct$=Yes$:Oth$=No$ ELSE Punct$=No$
CALL WPrint(4,18,ASII$,Attr%(15,1))
CALL WPrint(5,18,Alpha$,Attr%(15,1))
CALL WPrint(6,18,AlphaNum$,Attr%(15,1))
CALL WPrint(4,39,Num$,Attr%(15,1))
CALL WPrint(5,39,Punct$,Attr%(15,1))
CALL WPrint(6,39,Oth$,Attr%(15,1))
If Oth$<>Yes$ THEN
CALL WPrint(1,28,I$+" ",Attr%(15,1))
ELSE
CALL WPrint(1,28,"Other",Attr%(15,1))
END IF
LOOP UNTIL I$=CHR$(27)
CALL CloseWin
CALL CloseWin
GOTO MainMenu2