home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Black Box 4
/
BlackBox.cdr
/
progbas
/
pbclon18.arj
/
DEMO.BAS
< prev
next >
Wrap
BASIC Source File
|
1992-04-08
|
6KB
|
209 lines
' +----------------------------------------------------------------------+
' | |
' | PBClone Copyright (c) 1990-1992 Thomas G. Hanlin III |
' | |
' +----------------------------------------------------------------------+
DECLARE FUNCTION Floppies2% ()
DECLARE FUNCTION GetHGA% ()
DECLARE FUNCTION PCDat$ ()
DECLARE FUNCTION PCType2% ()
DECLARE SUB CalcAttr (BYVAL Foreground%, BYVAL Background%, Attr%)
DECLARE SUB Equipment (Memory%, Parallel%, Serial%, Game%)
DECLARE SUB ExtMem (Kbytes%)
DECLARE SUB GetCRT (ColorDisplay%)
DECLARE SUB GetDOSv (MajorVersion%, MinorVersion%)
DECLARE SUB GetEGA (DisplayType%, KBytes%)
DECLARE SUB GetLIMM (TotalPages%, FreePages%)
DECLARE SUB GetLIMV (MajorVersionNum%, MinorVersionNum%)
DECLARE SUB GetVGA (IsVGA%)
DECLARE SUB GetXMSm (LargestBlock&, TotalBlocks&)
DECLARE SUB GetXMSv (MajorVersionNum%, MinorVersionNum%)
DECLARE SUB NumProc (ProcType%)
DECLARE SUB Processor (CPU%)
DECLARE SUB WindowManager (TopRow%, LeftCol%, BottomRow%, RightCol%, Frame%, Fore%, Back%, Grow%, Shade%, TFore%, Title$, Page%, Fast%)
DECLARE SUB XQPrint (St$, BYVAL Row%, BYVAL Column%, BYVAL Attr%, BYVAL Page%, BYVAL Fast%)
DEFINT A-Z
' ----- Pick the colors to use -----------------------------------------------
GetCRT Colour
IF Colour THEN
CalcAttr 7, 1, Attr
ELSE
CalcAttr 7, 0, Attr
END IF
' ----- Clear the screen and pop up the window -------------------------------
CLS
Fore = 15
IF Colour THEN
Back = 1
ELSE
Back = 0
END IF
Frame = 1
Grow = 15
Shade = 0
Title$ = "PBClone Demo"
WindowManager 2, 2, 23, 77, Frame, Fore, Back, Grow, Shade, 10, Title$, 0, 1
' ----- Add a text note inside the window ------------------------------------
Row = 3
XQPrint "This is an admittedly trivial demo for the PBClone library. I'll", Row, 3, Attr, 0, 1
Row = Row + 1
XQPrint "improve it drastically in later versions. However, for now it will", Row, 3, Attr, 0, 1
Row = Row + 1
XQPrint "provide an example of how to access the PBClone routines.", Row, 3, Attr, 0, 1
Row = Row + 2
' ----- Display processor and coprocessor types ------------------------------
Processor CPU
NumProc NDP
SELECT CASE CPU
CASE 1: St$ = "8088"
CASE 2: St$ = "80186"
CASE 3: St$ = "80286"
CASE 4: St$ = "80386"
CASE ELSE: St$ = "80?86"
END SELECT
SELECT CASE NDP
CASE 1: St$ = St$ + " w/ 8087"
CASE 2: St$ = St$ + " w/ 80287"
CASE 3: St$ = St$ + " w/ 80387"
CASE ELSE
END SELECT
XQPrint "Processor: " + St$, Row, 3, Attr, 0, 1
Row = Row + 1
' ----- Display DOS version --------------------------------------------------
GetDOSv MajorV, MinorV
DOSv$ = LTRIM$(STR$(MajorV)) + "." + RIGHT$("0" + LTRIM$(STR$(MinorV)), 2)
IF MajorV > 9 THEN
St$ = " OS/2 Compatibility Box"
ELSE
St$ = ""
END IF
XQPrint "DOS version: " + DOSv$ + St$, Row, 3, Attr, 0, 1
Row = Row + 1
' ----- Display basic equipment info -----------------------------------------
Equipment Memory, Parallel, Serial, Game
XQPrint "Base memory: " + LTRIM$(STR$(Memory)) + " Kbytes", Row, 3, Attr, 0, 1
Row = Row + 1
XQPrint "Parallel ports: " + LTRIM$(STR$(Parallel)), Row, 3, Attr, 0, 1
Row = Row + 1
XQPrint "Serial ports: " + LTRIM$(STR$(Serial)), Row, 3, Attr, 0, 1
Row = Row + 1
REM we'll leave out game ports, since that's not always reliable
XQPrint "Floppy drives: " + LTRIM$(STR$(Floppies2)), Row, 3, Attr, 0, 1
Row = Row + 1
' ----- Display video adapter type -------------------------------------------
GetVGA IsVGA
GetEGA EGA, Memory
IF IsVGA THEN
St$ = "VGA"
ELSEIF EGA THEN
St$ = "EGA"
ELSEIF Colour THEN
St$ = "CGA"
ELSE
IF GetHGA% THEN
St$ = "Hercules"
ELSE
St$ = "MDA"
END IF
END IF
XQPrint "Display: " + St$, Row, 3, Attr, 0, 1
Row = Row + 1
' ----- Display BIOS date and type -------------------------------------------
XQPrint "ROM BIOS date: " + PCDat$, Row, 3, Attr, 0, 1
Row = Row + 1
SELECT CASE PCType2
CASE 251, 254, 255: St$ = "PC/XT"
CASE 253: St$ = "PCjr"
CASE 252: St$ = "PC AT": ATtype = -1
CASE 250: St$ = "PS/2 Model 30"
CASE 249: St$ = "PC Convertible"
CASE 248: St$ = "PS/2 Model 70 or 80": ATtype = -1
CASE 45, 154: St$ = "Compaq Portable"
CASE ELSE: St$ = "unknown"
END SELECT
XQPrint "Computer type: " + St$, Row, 3, Attr, 0, 1
Row = Row + 1
' ----- Display extended and expanded memory info ----------------------------
IF ATtype THEN
ExtMem Memory
XQPrint "Extended memory (BIOS): " + LTRIM$(STR$(Memory)) + " Kbytes", Row, 3, Attr, 0, 1
Row = Row + 1
END IF
IF ATtype THEN
GetXMSv MajorV, MinorV
GetXMSm LargeBlock&, TotalFree&
IF MajorV OR MinorV THEN
St$ = LTRIM$(STR$(MajorV)) + "." + RIGHT$("0" + LTRIM$(STR$(MinorV)), 2)
XQPrint "Extended memory (XMS):", Row, 3, Attr, 0, 1
Row = Row + 1
XQPrint " Version: " + St$, Row, 3, Attr, 0, 1
Row = Row + 1
XQPrint " Free : " + LTRIM$(STR$(TotalFree&)) + " Kbytes", Row, 3, Attr, 0, 1
Row = Row + 1
END IF
END IF
GetLIMM TotalPages, FreePages
IF TotalPages THEN
GetLIMV MajorV, MinorV
St$ = LTRIM$(STR$(MajorV)) + "." + RIGHT$("0" + LTRIM$(STR$(MinorV)), 2)
XQPrint "Expanded memory:", Row, 3, Attr, 0, 1
Row = Row + 1
XQPrint " Version: " + St$, Row, 3, Attr, 0, 1
Row = Row + 1
XQPrint " Total : " + LTRIM$(STR$(TotalPages * 16)) + " Kbytes", Row, 3, Attr, 0, 1
Row = Row + 1
XQPrint " Free : " + LTRIM$(STR$(FreePages * 16)) + " Kbytes", Row, 3, Attr, 0, 1
Row = Row + 1
END IF
' ----- Make sure the DOS prompt doesn't get in the way ----------------------
LOCATE 24, 1, 1