synchro.net

home *** CD-ROM | disk | FTP | other *** search

/ synchro.net / synchro.net.tar / synchro.net / modem.madness / SMMPROG / PBGUI200.ZIP / DEMO2.BAS < prev next >

Wrap

BASIC Source File | 1993-07-19 | 20.4 KB | 764 lines

$COMPILE EXE $ALIAS DATA AS "_DATA" $DYNAMIC '************************PBGDEM02.BAS '** defint NEEDED DEFINT A-Z '** $INCLUDE "PBGUI200.BI" $LINK "PBGUI200.PBL" 'Make sure we have a VGA CARD IF BIT(pbvScrnCard,5) = 0 THEN CLS BEEP:BEEP PRINT "This demo REQUIRES a VGA adaptor" END END IF '***** You will need to change FontPath to the location of your Fonts FontPath = "\PB3\PBGFONTS\" CharSpace = 2 Bold = %FALSE DIM AllBlack (0:15) AS SHARED INTEGER,_ AllColor (0:15) AS SHARED INTEGER,_ QuitFlag AS SHARED INTEGER FOR X = 0 TO 15 AllBlack(X) = 0 AllColor(X) = X NEXT X SCREEN 12 '** Do some initialization WindowInit ColorInit MouseInit '***** Main Program PageOne IF PageTwo = 0 THEN END IF PageThree = 0 THEN END IF PageFour= 0 THEN END IF PageFive= 0 THEN END IF PageSix = 0 THEN END IF PageSeven = 0 THEN END '***** All Done screen 0 end '=========================================================================== SUB PageOne STATIC ExitFlag, EditField MouseHide ExitFlag = 0 EditField = 0 '***** Turn Off All Colors Palette using AllBlack(0) '***** Load the screen and screen data dummy = LoadWindow("demo.001") IF dummy = 0 THEN NoScreenData '***** Turn the Colors On Palette using AllColor(0) MousePosition 350,300 MouseShow '***** I know this is bad code but it follows the same format as all '***** the windows. '***** Should be If Event(0) = 1 THEN Exit Loop WHILE NOT ExitFlag GetEvent EditField SELECT CASE Event(0) CASE 1 ExitFlag = %TRUE END SELECT WEND CloseWindow END SUB '=========================================================================== FUNCTION PageTwo STATIC ExitFlag, EditField MouseHide Palette using AllBlack(0) dummy = LoadWindow ("demo.002") IF dummy = 0 THEN NoScreenData Palette USING AllColor(0) ExitFlag = %FALSE EditField = 0 MousePosition 450,100 WHILE NOT ExitFlag GetEvent EditField SELECT CASE Event(0) CASE 1 SELECT CASE Event(1) CASE 1 PageTwo = 1 ExitFlag = %TRUE CASE 2 PageTwo = 2 ExitFlag = %TRUE PageTwo = 0 END SELECT END SELECT WEND CloseWindow END FUNCTION '=========================================================================== FUNCTION PageThree STATIC ExitFlag,EditField ExitFlag = %FALSE MouseHide Palette using AllBlack(0) dummy = LoadWindow ("demo.003") IF dummy = 0 THEN NoScreenData MousePosition 440,130 MouseShow LBDT.BoxLightColor=1 LBDT.BoxBackColor=2 LBDT.BoxDarkColor=3 LBDT.BoxTextColor=9 LBDT.BoxBorderColor =9 LBDT.ButLightColor= 1 LBDT.ButBackColor=2 LBDT.ButDarkColor=3 Palette using AllColor(0) EditField = 0 WHILE NOT ExitFlag GetEvent EditField SELECT CASE Event(0) CASE 1 SELECT CASE Event(1) CASE 1 Redim LBArray(1:10) AS STRING LBArray(1)="New" LBArray(2)="Open F3" LBArray(3)="Pick Alt F3" LBArray(4)="Save F2" LBArray(5)="Write To" LBArray(6)="─" LBArray(7)="Change Dir" LBArray(8)="Dos Shell" LBArray(9)="─" LBArray(10)="Quit Alt X" LBDT.row=75 LBDT.col = 48 LBDT.items = 10 LBDT.height = 10 $IF 0 LBDT.BoxLightColor=1 LBDT.BoxBackColor=2 LBDT.BoxDarkColor=3 LBDT.BoxTextColor=13 LBDT.ButLightColor = 1 LBDT.ButBackColor=2 LBDT.ButDarkColor=3 $ENDIF LBDT.ActiveItems="1111101101" dummy = ListBox(LBArray()) CASE 2 REDIM LBArray(1:5) AS STRING LBArray(1)="Cut" LBArray(2)="Copy" LBArray(3)="Paste" LBArray(4)="Delete" LBArray(5)="Show ClipBoard" LBDT.ActiveItems="11000" LBDT.row=75 LBDT.col = 140 LBDT.items = 5 LBDT.height = 5 $IF 0 LBDT.BoxLightColor=1 LBDT.BoxBackColor=2 LBDT.BoxDarkColor=3 LBDT.BoxTextColor=13 LBDT.ButLightColor = 1 LBDT.ButBackColor=2 LBDT.ButDarkColor=3 $ENDIF LBDT.ActiveItems="11000" dummy = ListBox(LBArray()) CASE 3 REDIM LBArray(1:6) AS STRING LBArray(1)="Find" LBArray(2)="Replace" LBArray(3)="Search Again" LBArray(4)="─" LBArray(5)="Go To Line Number" LBArray(6)="Locate SUB/FUNCTION/Label" LBDT.ActiveItems="111011" LBDT.row=75 LBDT.col = 220 LBDT.items = 6 LBDT.height = 6 $IF 0 LBDT.BoxLightColor=1 LBDT.BoxBackColor=2 LBDT.BoxDarkColor=3 LBDT.BoxTextColor=13 LBDT.ButLightColor = 1 LBDT.ButBackColor=2 LBDT.ButDarkColor=3 $ENDIF dummy = ListBox(LBArray()) CASE 4 REDIM LBArray(1:8) AS STRING LBArray(1)="Run F9" LBArray(2)="Go To Cursor F4" LBArray(3)="Trace Into F7" LBArray(4)="Step Over F8" LBArray(5)="─" LBArray(6)="User Screen Alt-F5" LBArray(7)="Program Reset Ctrl-F2" LBArray(8)="Command$" LBDT.ActiveItems="11111111" LBDT.row=75 LBDT.col = 300 LBDT.items = 8 LBDT.height = 8 dummy = ListBox(LBArray()) CASE 5 REDIM LBArray(1:6) AS STRING LBArray(1)="Compile Main/IDE Alt-F9" LBArray(2)="IDE Compile Ctrl-F9" LBArray(3)="Destination EXE File" LBArray(4)="Find Error" LBArray(5)="Get Info" LBArray(6)="Main File" LBDT.ActiveItems="111111" LBDT.row=75 LBDT.col = 340 LBDT.items = 6 LBDT.height = 6 dummy = ListBox(LBArray()) CASE 6 REDIM LBArray(1:6) AS STRING LBArray(1)="Compiler" LBArray(2)="Linker" LBArray(3)="Environment" LBArray(4)="Directories" LBArray(5)="Save Options" LBArray(6)="Retrieve Options" LBDT.ActiveItems="111111" LBDT.row=75 LBDT.col = 440 LBDT.items = 6 LBDT.height = 6 dummy = ListBox(LBArray()) CASE 7 REDIM LBArray(1:6) AS STRING LBArray(1)="Evaluate Ctrl-F4" LBArray(2)="Call Stack Ctrl-F3" LBArray(3)="Watch Alt-W" LBArray(4)="Break Alt-B" LBArray(5)="Display Swapping Smart" LBArray(6)="Refresh Display" LBDT.ActiveItems="101111" LBDT.row=75 LBDT.col = 380 LBDT.items = 6 LBDT.height = 6 dummy = ListBox(LBArray()) CASE 8 PageThree=0 ExitFlag = %TRUE CASE 9 ButtonSetState 12,%Active CASE 10 ButtonToggleState 12 CASE 11 ButtonSetState 12,%NotActive CASE 12 redim t$(1 to 2) t$(1)="You Have Clicked An Active" t$(2)="Button #1" MBDT.BoxLightColor = 2 MBDT.BoxBackColor = 3 MBDT.BoxDarkColor = 0 MBDT.BoxBorderColor = 6 MBDT.BoxTextColor = 13 MBDT.ButLightColor = 1 MBDT.ButBackColor = 2 MBDT.ButDarkColor = 3 MBDT.ButTextColor = 0 MBDT.FontID.FileName="dub10b" MBDT.ButOneText = "OK"+CHR$(0) MBDT.ButTwoText = CHR$(0) BEEP:BEEP dummy = MessageBox(t$()) CASE 13 PageThree=1 ExitFlag = %TRUE END SELECT END SELECT WEND CloseWindow erase LBArray d&=Fre(0) END FUNCTION '============================================================= FUNCTION PageFour STATIC ExitFlag,EditField ExitFlag = %FALSE MouseHide Palette using AllBlack(0) dummy = LoadWindow ("demo.004") IF dummy = 0 THEN NoScreenData MousePosition 440,370 MouseShow Palette Using AllColor(0) ExitFlag = 0 EditFlag = 0 MapFileState = 7 ModelState = 14 AssumeState = 24 EXEType = 11 WHILE NOT ExitFlag GetEvent EditField SELECT CASE Event(0) CASE 1 SELECT CASE Event(1) CASE 1 PageFour = 0 ExitFlag = %TRUE CASE 2 TO 6, 19 TO 23 ButtonToggleState Event(1) CASE 7 TO 10 ButtonSetState MapFileState,%NotActive MapFileState = Event(1) ButtonSetState MapFileState,%Active CASE 11 to 12 ButtonSetState EXEType,%NotActive EXEType = Event(1) ButtonSetState EXEType,%Active CASE 13 TO 18 ButtonSetState ModelState, %NotActive ModelState = Event(1) ButtonSetState ModelState,%Active CASE 24 TO 26 ButtonSetState AssumeState,%NotActive AssumeState = Event(1) ButtonSetState AssumeState,%Active CASE 27 ExitFlag = %TRUE PageFour = 1 END SELECT END SELECT WEND CloseWindow END FUNCTION FUNCTION PageFive STATIC ExitFlag,EditField ExitFlag = %FALSE MouseHide Palette using AllBlack(0) dummy = LoadWindow ("demo.005") IF dummy = 0 THEN NoScreenData MousePosition 430,420 Palette Using AllColor(0) EditField = 1 Button2State = 0 Button3State =Button2State Button4State=Button2State NumberOfEditFields = 13 WHILE NOT ExitFlag GetEvent EditField SELECT CASE Event(0) CASE 6 SCREEN 0 END CASE 1 'Button Event SELECT CASE Event(1) CASE 1 ExitFlag = %TRUE PageFive = %FALSE CASE 2 IF (EditField > 0 AND EditField< 7) OR_ (EditField > 9 AND EditField < 14) THEN Button2State = NOT Button2State IF Button2State THEN ChangeButtonText 2,"Deactivate" ELSE ChangeButtonText 2,"Activate" END IF FOR x = 7 TO 9 EditFieldToggleState x NEXT x END IF CASE 3 IF (EditField > 0 AND EditField< 10) OR_ (EditField > 12 AND EditField < 14) THEN Button3State = NOT Button3State IF Button3State THEN ChangeButtonText 3,"Deactivate" ELSE ChangeButtonText 3,"Activate" END IF FOR x = 10 TO 12 EditFieldToggleState x NEXT x END IF CASE 4 IF EditField <> 13 THEN Button4State = NOT Button4State IF Button4State THEN ChangeButtonText 4,"Deactivate" ELSE ChangeButtonText 4,"Activate" END IF EditFieldToggleState 13 END IF CASE 5 ExitFlag = %TRUE PageFive = %TRUE END SELECT CASE 2 '***** Edit Event ****** IF EditFieldGetState(Event(2)) = %Active THEN EditField = Event(2) CASE 3 TO 4 'Enter or TAB ******** DO INCR EditField IF EditField > NumberOfEditFields THEN EditField = 1 IF EditFieldGetState(EditField) = %Active THEN EXIT DO LOOP END SELECT WEND CloseWindow END FUNCTION FUNCTION PageSix STATIC ExitFlag,EditField ExitFlag = %FALSE MouseHide Palette using AllBlack(0) dummy = LoadWindow ("demo.006") IF dummy = 0 THEN NoScreenData MousePosition 440,140 MouseShow Palette Using AllColor(0) EditField=0 WHILE NOT ExitFlag GetEvent EditField SELECT CASE Event(0) CASE 1 SELECT CASE Event(1) CASE 1 PageSix = 0 ExitFlag = %TRUE CASE 2 PageSix = 2 ExitFlag = %TRUE END SELECT END SELECT WEND CloseWindow END FUNCTION '========================================================================= FUNCTION PageSeven STATIC ExitFlag,EditField ExitFlag = %FALSE MouseHide Palette using AllBlack(0) dummy = LoadWindow ("demo.007") IF dummy = 0 THEN NoScreenData MousePosition 420,400 MouseShow tc=13 FontLoaded=LoadFont("dub8b") Shadow=%FALSE ShadowColor = 10 GOSUB PrintP1 Palette Using AllColor(0) Pallete 10,0,0,0 MouseShow ExitFlag = %FALSE EditField = 0 PageNum=1 tc = 13 WHILE NOT ExitFlag GetEvent EditField SELECT CASE Event(0) CASE 1 SELECT CASE Event(1) CASE 1 PageSeven = 1 ExitFlag = %TRUE CASE 2 DECR PageNum SELECT CASE PageNum CASE 1 Pallete 13,&H15,&H15,&H15 Pallete 10,&H15,&H15,&H15'3 GOSUB DrawBox GOSUB PrintP1 Pallete 13,0,&H3F,&H3F '13 Pallete 10,0,0,0 ButtonSetState 2,%NotActive MousePosition 420,400 CASE 2 Pallete 13,&H15,&H15,&H15'3 Pallete 10,&H15,&H15,&H15'3 GOSUB DrawBox GOSUB PrintP2 Pallete 13,0,&H3F,&H3F '13 Pallete 10,0,0,0 ButtonSetState 3,%Active END SELECT CASE 3 INCR PageNum SELECT CASE PageNum CASE 2 Pallete 13,&H15,&H15,&H15'3 Pallete 10,&H15,&H15,&H15'3 GOSUB DrawBox GOSUB PrintP2 Pallete 13,0,&H3F,&H3F '13 Pallete 10,0,0,0 CASE 3 Pallete 13,&H15,&H15,&H15'3 Pallete 10,&H15,&H15,&H15'3 GOSUB DrawBox GOSUB PrintP3 Pallete 13,0,&H3F,&H3F '13 Pallete 10,0,0,0 ButtonSetState 3,%NotActive MousePosition 420,250 END SELECT ButtonSetState 2,%Active CASE 4 ButtonSetState 5,%Active ButtonSetState 4,%NotActive Shadow = %TRUE CASE 5 Shadow = %FALSE ButtonSetState 4,%Active ButtonSetState 5,%NotActive END SELECT END SELECT WEND CloseWindow Pallete 10,&H20,&H3F,&H20 Exit FUNCTION PrintP1: WindowPrint 45,60,"1- PB3 directly creates TSR",tc,0 WindowPrint 60,65,"(terminate/stay-resident) programs",tc,0 WindowPrint 75,65,"which can pop-down to a memory",tc,0 WindowPrint 90,65,"image of 4K! Memory resident",tc,0 WindowPrint 105,65,"programs can be activated by",tc,0 WindowPrint 120,65,"practically any stimulus: a hot key",tc,0 WindowPrint 135,65,"timer, inactivity, a hardware or",tc,0 WindowPrint 150,65,"software interrupt,even a message",tc,0 WindowPrint 165,65,"from a foreground program. In fact",tc,0 WindowPrint 180,65,"it's possible for multiple TSRs to",tc,0 WindowPrint 195,65,"activate each other repeatedly",tc,0 WindowPrint 210,65,"with two - way communication",tc,0 WindowPrint 225,65,"throughout. NO other language",tc,0 WindowPrint 240,65,"offers this capability as an",tc,0 WindowPrint 255,65,"integral part of the compiler",tc,0 WindowPrint 45,310,"2- PB3 uses all real mode memory",tc,0 WindowPrint 60,315,"for dynamic strings. It's the first",tc,0 WindowPrint 75,315,"and only Basic with a no-limit, ",tc,0 WindowPrint 90,315,"handle - based string memory",tc,0 WindowPrint 105,315,"manager; QB is limited to less ",tc,0 WindowPrint 120,315,"than 64K, and PDS has 'inside'",tc,0 WindowPrint 135,315,"segmentation limits.",tc,0 WindowPrint 165,310,"3-The PB3 String Memory Manager",tc,0 WindowPrint 180,315,"is a resource available to any ",tc,0 WindowPrint 195,315,"user code. Both Basic and ",tc,0 WindowPrint 210,315,"Assembler code can allocate,",tc,0 WindowPrint 225,315,"release and alter memory blocks",tc,0 WindowPrint 240,315,"as required by the programmer." ,tc,0 WindowPrint 255,315,"While other compilers allow you",tc,0 WindowPrint 270,315,"to calculate string location or",tc,0 WindowPrint 285,315,"assignment none allow the full",tc,0 WindowPrint 300,315,"memory managment functionality",tc,0 WindowPrint 315,315,"of PowerBASIC",tc,0 RETURN PrintP2: WindowPrint 45,60,"4- PB3 compiles to true machine",tc,0 WindowPrint 60,63,"code in the integrated environment",tc,0 WindowPrint 75,65,"the identical code as an .EXE file",tc,0 WindowPrint 90,65,"No need to deal with a slow",tc,0 WindowPrint 105,65,"p-code interpreter as in QB & PDS",tc,0 WindowPrint 120,65,"That means faster development,",tc,0 WindowPrint 135,65,"and the elimination of subtle",tc,0 WindowPrint 150,65,"differences between interpreted",tc,0 WindowPrint 165,65,"and compiled results.",tc,0 WindowPrint 195,60,"5 - PB3 offers unsigned integer",tc,0 WindowPrint 210,65,"variable types: BYTE, WORD,",tc,0 WindowPrint 225,65," DOUBLE WORD.",tc,0 WindowPrint 240,65,"byte: 0 - 255",tc,0 WindowPrint 255,65,"word: 0 - 65,535",tc,0 WindowPrint 270,65,"dword:0 - 4,294,967,295",tc,0 WindowPrint 285,65,"Unsigned integers are not ",tc,0 WindowPrint 300,65,"available in other Basics",tc,0 WindowPrint 45,310,"6- Optionally, PB3 can require that",tc,0 WindowPrint 60,315,"all variables be declared before",tc,0 WindowPrint 75,315,"use; this option greatly enhances",tc,0 WindowPrint 90,315,"the probability of catching typos",tc,0 WindowPrint 105,315,"automatically during compilation",tc,0 WindowPrint 135,315,"7- Dual Monitor Support is offered",tc,0 WindowPrint 150,315,"in the PowerBASIC Integrated",tc,0 WindowPrint 165,315,"Environment and the PBD Stand- ",tc,0 WindowPrint 180,315,"alone debugger. This allows the",tc,0 WindowPrint 195,315,"programmer to simultaneously",tc,0 WindowPrint 210,315,"view a full screen of source code",tc,0 WindowPrint 225,315,"and debug information with a ",tc,0 WindowPrint 240,315,"second full screen generated by",tc,0 WindowPrint 255,315,"the target program. Annoying",tc,0 WindowPrint 270,315,"screen flashes and pauses are ",tc,0 WindowPrint 285,315,"eliminated",tc,0 WindowPrint 300,315,"",tc,0 RETURN PrintP3: WindowPrint 45,60,"<< There really are 100 reasons >>",tc,0 WindowPrint 60,65,"",tc,0 WindowPrint 75,65,"They are all listed in the GAP",tc,0 WindowPrint 90,65,"ReadMe file.",tc,0 WindowPrint 105,65,"",tc,0 WindowPrint 120,65,"I have listed the first seven here",tc,0 WindowPrint 135,65,"in this demo to demonstrate the",tc,0 WindowPrint 150,65,"speed of the PBGUI font drawing",tc,0 WindowPrint 165,65,"routines",tc,0 WindowPrint 180,60,"",tc,0 WindowPrint 195,55,"Although the screen was read from",tc,0 WindowPrint 210,55,"disk ALL printing is done on the fly.",tc,0 WindowPrint 240,65,"",tc,0 WindowPrint 255,65,"",tc,0 WindowPrint 270,65,"",tc,0 WindowPrint 285,65,"",tc,0 WindowPrint 300,65,"",tc,0 WindowPrint 45,310,"For PowerBASIC 3.00 Information",tc,0 WindowPrint 60,315,"",tc,0 WindowPrint 75,315," SPECTRA Publishing",tc,0 WindowPrint 90,315," 1030 D East Duane Ave.",tc,0 WindowPrint 105,315," Sunnyvale, CA 94086",tc,0 WindowPrint 120,315," 800-245-6717",tc,0 WindowPrint 135,315,"",tc,0 WindowPrint 150,315,"Thank You for trying this demo",tc,0 WindowPrint 165,315,"",tc,0 WindowPrint 180,315,"The toolkit should be available",tc,0 WindowPrint 195,315,"by August 1, 1993 and can be",tc,0 WindowPrint 210,315,"found in the PCVENB Forum ",tc,0 WindowPrint 225,315,"on CompuServe.",tc,0 WindowPrint 240,315,"",tc,0 WindowPrint 255,315," James C. Fuller",tc,0 WindowPrint 270,315,"",tc,0 WindowPrint 285,315," CSERVE - 70117,1040",tc,0 WindowPrint 300,315," GENIE J.FULLER",tc,0 RETURN $IF 0 WindowPrint 45,60,"",tc,0 WindowPrint 60,63,"",tc,0 WindowPrint 75,65,"",tc,0 WindowPrint 90,65,"",tc,0 WindowPrint 105,65,"",tc,0 WindowPrint 120,65,"",tc,0 WindowPrint 135,65,"",tc,0 WindowPrint 150,65,"",tc,0 WindowPrint 165,65,"",tc,0 WindowPrint 195,60,"",tc,0 WindowPrint 210,65,"",tc,0 WindowPrint 225,65,"",tc,0 WindowPrint 240,65,"",tc,0 WindowPrint 255,65,"",tc,0 WindowPrint 270,65,"",tc,0 WindowPrint 285,65,"",tc,0 WindowPrint 300,65,"",tc,0 WindowPrint 45,310,"",tc,0 WindowPrint 60,315,"",tc,0 WindowPrint 75,315,"",tc,0 WindowPrint 90,315,"",tc,0 WindowPrint 105,315,"",tc,0 WindowPrint 135,315,"",tc,0 WindowPrint 150,315,"",tc,0 WindowPrint 165,315,"",tc,0 WindowPrint 180,315,"",tc,0 WindowPrint 195,315,"",tc,0 WindowPrint 210,315,"",tc,0 WindowPrint 225,315,"",tc,0 WindowPrint 240,315,"",tc,0 WindowPrint 255,315,"",tc,0 WindowPrint 270,315,"",tc,0 WindowPrint 285,315,"",tc,0 WindowPrint 300,315,"",tc,0 $ENDIF END FUNCTION '***** Erases the text. DrawBox: line(65,90)-(310,385),3,bf line(320,90)-(555,385),3,bf RETURN '======================================================== SUB NoScreenData SCREEN 0: CLS BEEP:BEEP: PRINT " DEMO2 WAS UNABLE TO FIND A SCREEN DATA FILE" PRINT " MAKE SURE YOU ARE RUNNING THIS DEMO FROM THE SAME DIRECTORY" PRINT " WHERE THE DEMO.00x FILES ARE LOCATED." PRINT PRINT " THESE FILES ARE CREATED BY RUNNING DEMO1.BAS SEE READ.ME FILE" PRINT PRINT " STRIKE ANY KEY" WHILE INKEY$="":WEND END END SUB