home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / BASIC / PBCLON16.ZIP / DEMO.BAS < prev    next >
Encoding:
BASIC Source File  |  1991-09-25  |  6.1 KB  |  209 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |       PBClone  Copyright (c) 1990-1991  Thomas G. Hanlin III         |
  4. '   |                                                                      |
  5. '   +----------------------------------------------------------------------+
  6.  
  7.    DECLARE FUNCTION Floppies2% ()
  8.    DECLARE FUNCTION GetHGA% ()
  9.    DECLARE FUNCTION PCDat$ ()
  10.    DECLARE FUNCTION PCType2% ()
  11.  
  12.    DECLARE SUB CalcAttr (BYVAL Foreground%, BYVAL Background%, Attr%)
  13.    DECLARE SUB Equipment (Memory%, Parallel%, Serial%, Game%)
  14.    DECLARE SUB ExtMem (Kbytes%)
  15.    DECLARE SUB GetCRT (ColorDisplay%)
  16.    DECLARE SUB GetDOSv (MajorVersion%, MinorVersion%)
  17.    DECLARE SUB GetEGA (DisplayType%, KBytes%)
  18.    DECLARE SUB GetLIMM (TotalPages%, FreePages%)
  19.    DECLARE SUB GetLIMV (MajorVersionNum%, MinorVersionNum%)
  20.    DECLARE SUB GetVGA (IsVGA%)
  21.    DECLARE SUB GetXMSm (LargestBlock&, TotalBlocks&)
  22.    DECLARE SUB GetXMSv (MajorVersionNum%, MinorVersionNum%)
  23.    DECLARE SUB NumProc (ProcType%)
  24.    DECLARE SUB Processor (CPU%)
  25.    DECLARE SUB WindowManager (TopRow%, LeftCol%, BottomRow%, RightCol%, Frame%, Fore%, Back%, Grow%, Shade%, TFore%, Title$, Page%, Fast%)
  26.    DECLARE SUB XQPrint (St$, BYVAL Row%, BYVAL Column%, BYVAL Attr%, BYVAL Page%, BYVAL Fast%)
  27.  
  28.    DEFINT A-Z
  29.  
  30.  
  31. '  ----- Pick the colors to use -----------------------------------------------
  32.  
  33.  
  34.    GetCRT Colour
  35.  
  36.    IF Colour THEN
  37.       CalcAttr 7, 1, Attr
  38.    ELSE
  39.       CalcAttr 7, 0, Attr
  40.    END IF
  41.  
  42.  
  43. '  ----- Clear the screen and pop up the window -------------------------------
  44.  
  45.  
  46.    CLS
  47.  
  48.    Fore = 15
  49.    IF Colour THEN
  50.       Back = 1
  51.    ELSE
  52.       Back = 0
  53.    END IF
  54.    Frame = 1
  55.    Grow = 15
  56.    Shade = 0
  57.    Title$ = "PBClone Demo"
  58.    WindowManager 2, 2, 23, 77, Frame, Fore, Back, Grow, Shade, 10, Title$, 0, 1
  59.  
  60.  
  61. '  ----- Add a text note inside the window ------------------------------------
  62.  
  63.  
  64.    Row = 3
  65.    XQPrint "This is an admittedly trivial demo for the PBClone library.  I'll", Row, 3, Attr, 0, 1
  66.    Row = Row + 1
  67.    XQPrint "improve it drastically in later versions.  However, for now it will", Row, 3, Attr, 0, 1
  68.    Row = Row + 1
  69.    XQPrint "provide an example of how to access the PBClone routines.", Row, 3, Attr, 0, 1
  70.    Row = Row + 2
  71.  
  72.  
  73. '  ----- Display processor and coprocessor types ------------------------------
  74.  
  75.  
  76.    Processor CPU
  77.    NumProc NDP
  78.    SELECT CASE CPU
  79.       CASE 1: St$ = "8088"
  80.       CASE 2: St$ = "80186"
  81.       CASE 3: St$ = "80286"
  82.       CASE 4: St$ = "80386"
  83.       CASE ELSE: St$ = "80?86"
  84.    END SELECT
  85.    SELECT CASE NDP
  86.       CASE 1: St$ = St$ + " w/ 8087"
  87.       CASE 2: St$ = St$ + " w/ 80287"
  88.       CASE 3: St$ = St$ + " w/ 80387"
  89.       CASE ELSE
  90.    END SELECT
  91.    XQPrint "Processor: " + St$, Row, 3, Attr, 0, 1
  92.    Row = Row + 1
  93.  
  94.  
  95. '  ----- Display DOS version --------------------------------------------------
  96.  
  97.  
  98.    GetDOSv MajorV, MinorV
  99.    DOSv$ = STR$(MajorV) + "." + RIGHT$("0" + STR$(MinorV), 2)
  100.    IF MajorV > 9 THEN
  101.       St$ = "   OS/2 Compatibility Box"
  102.    ELSE
  103.       St$ = ""
  104.    END IF
  105.    XQPrint "DOS version: " + DOSv$ + St$, Row, 3, Attr, 0, 1
  106.    Row = Row + 1
  107.  
  108.  
  109. '  ----- Display basic equipment info -----------------------------------------
  110.  
  111.  
  112.    Equipment Memory, Parallel, Serial, Game
  113.    XQPrint "Base memory: " + STR$(Memory) + " Kbytes", Row, 3, Attr, 0, 1
  114.    Row = Row + 1
  115.    XQPrint "Parallel ports: " + STR$(Parallel), Row, 3, Attr, 0, 1
  116.    Row = Row + 1
  117.    XQPrint "Serial ports: " + STR$(Serial), Row, 3, Attr, 0, 1
  118.    Row = Row + 1
  119.    REM we'll leave out game ports, since that's not always reliable
  120.  
  121.    XQPrint "Floppy drives: " + STR$(Floppies2), Row, 3, Attr, 0, 1
  122.    Row = Row + 1
  123.  
  124.  
  125. '  ----- Display video adapter type -------------------------------------------
  126.  
  127.  
  128.    GetVGA IsVGA
  129.    GetEGA EGA, Memory
  130.    IF IsVGA THEN
  131.       St$ = "VGA"
  132.    ELSEIF EGA THEN
  133.       St$ = "EGA"
  134.    ELSEIF Colour THEN
  135.       St$ = "CGA"
  136.    ELSE
  137.       IF GetHGA% THEN
  138.          St$ = "Hercules"
  139.       ELSE
  140.          St$ = "MDA"
  141.       END IF
  142.    END IF
  143.    XQPrint "Display: " + St$, Row, 3, Attr, 0, 1
  144.    Row = Row + 1
  145.  
  146.  
  147. '  ----- Display BIOS date and type -------------------------------------------
  148.  
  149.  
  150.    XQPrint "ROM BIOS date: " + PCDat$, Row, 3, Attr, 0, 1
  151.    Row = Row + 1
  152.  
  153.    SELECT CASE PCType2
  154.       CASE 251, 254, 255: St$ = "PC/XT"
  155.       CASE 253: St$ = "PCjr"
  156.       CASE 252: St$ = "PC AT": ATtype = -1
  157.       CASE 250: St$ = "PS/2 Model 30"
  158.       CASE 249: St$ = "PC Convertible"
  159.       CASE 248: St$ = "PS/2 Model 70 or 80": ATtype = -1
  160.       CASE 45, 154: St$ = "Compaq Portable"
  161.       CASE ELSE: St$ = "unknown"
  162.    END SELECT
  163.    XQPrint "Computer type: " + St$, Row, 3, Attr, 0, 1
  164.    Row = Row + 1
  165.  
  166.  
  167. '  ----- Display extended and expanded memory info ----------------------------
  168.  
  169.  
  170.    IF ATtype THEN
  171.       ExtMem Memory
  172.       XQPrint "Extended memory (BIOS): " + STR$(Memory) + " Kbytes", Row, 3, Attr, 0, 1
  173.       Row = Row + 1
  174.    END IF
  175.  
  176.    IF ATtype THEN
  177.       GetXMSv MajorV, MinorV
  178.       GetXMSm LargeBlock&, TotalFree&
  179.       IF MajorV OR MinorV THEN
  180.          St$ = STR$(MajorV) + "." + RIGHT$("0" + STR$(MinorV), 2)
  181.          XQPrint "Extended memory (XMS):", Row, 3, Attr, 0, 1
  182.          Row = Row + 1
  183.          XQPrint "   Version: " + St$, Row, 3, Attr, 0, 1
  184.          Row = Row + 1
  185.          XQPrint "   Free   : " + STR$(TotalFree&) + " Kbytes", Row, 3, Attr, 0, 1
  186.          Row = Row + 1
  187.       END IF
  188.    END IF
  189.  
  190.    GetLIMM TotalPages, FreePages
  191.    IF TotalPages THEN
  192.       GetLIMV MajorV, MinorV
  193.       St$ = STR$(MajorV) + "." + RIGHT$("0" + STR$(MinorV), 2)
  194.       XQPrint "Expanded memory:", Row, 3, Attr, 0, 1
  195.       Row = Row + 1
  196.       XQPrint "   Version: " + St$, Row, 3, Attr, 0, 1
  197.       Row = Row + 1
  198.       XQPrint "   Total  : " + STR$(TotalPages * 16) + " Kbytes", Row, 3, Attr, 0, 1
  199.       Row = Row + 1
  200.       XQPrint "   Free   : " + STR$(FreePages * 16) + " Kbytes", Row, 3, Attr, 0, 1
  201.       Row = Row + 1
  202.    END IF
  203.  
  204.  
  205. '  ----- Make sure the DOS prompt doesn't get in the way ----------------------
  206.  
  207.  
  208.    LOCATE 24, 1, 1
  209.