home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / pb / library3 / init-u.bas < prev    next >
Encoding:
BASIC Source File  |  1990-11-23  |  6.1 KB  |  193 lines
  1.  
  2. '                      ╔════════════════════════════╗
  3. '                      ║                            ║
  4. '                      ║         INIT_U.BAS         ║
  5. '                      ║                            ║
  6. '                      ║ HB's AP LIBRARY INITIALIZE ║
  7. '                      ║                            ║
  8. '                      ╚════════════════════════════╝
  9.  
  10.  
  11.                             $COMPILE UNIT
  12.                             $ERROR ALL OFF
  13.  
  14.  %False = 0
  15.  %True = NOT %False
  16.  
  17.  DEFINT A-Z
  18.  
  19.  EXTERNAL RD$, VideoSeg&, ColorDisplay, NeedDCon, CursorTop, CursorBottom
  20.  EXTERNAL OrigL, OrigC
  21.  EXTERNAL Up2B$, Esc2Q$, F1Help$, F2Fun$, EnHelp$
  22.  EXTERNAL InitPrt$, GraphicsChrSetOn$, GraphicsChrSetOff$, BoldPrtOn$
  23.  EXTERNAL BoldPrtOff$, ItalicPrtOn$, ItalicPrtOff$, RegPrt$, FastPrt$
  24.  EXTERNAL WidePrt$, BigPrtOn$, BigPrtOff$, LQPrt$, DraftPrt$
  25.  EXTERNAL MicroPrtOn$, MicroPrtOff$, ElitePrt$, PicaPrt$, ReverseLF$
  26.  
  27.  
  28.  DECLARE SUB SCREENPUSH ()
  29.  DECLARE FUNCTION GetYesOrNo ()
  30.  DECLARE FUNCTION IsRodent ()
  31.  DECLARE FUNCTION Cen$ (string)
  32.  
  33. ' =========================================================================
  34.  
  35. SUB Initialize (PrinterType) PUBLIC
  36.  
  37.  %Star10X  = 1: %StarNX1000  = 2: %IBMX24  = 3: %LQ2500 = 4 ' Printer constants
  38.  
  39.  LOCAL VideoSegError
  40.  
  41.  Up2B$ = " ["+CHR$(24)+"] to back up "
  42.  Esc2Q$ = " [ESC] for Main Menu "
  43.  F1Help$ = " [F1] for Help "
  44.  F2Fun$ = " [F2] to SAVE or CLEAR data "
  45. ' EnHelp$ = "  Keys: ["+CHR$(26)+"] & ["+CHR$(27)+"], [HOME]"+_
  46. '                " & [END], [INS] & [DELETE], ^T & ^Y. To go on: ["+CHR$(25)+"]"
  47. EnHelp$ = Cen$ ("You can make an entry in this space now or press [" + _
  48.                              CHR$(25)+"]" + " to go on.")
  49.  IF PrinterType = %Star10X THEN
  50.  
  51. '            <<<  PRINTER CODES FOR STAR GEMINI 10X  >>>
  52.  
  53.  InitPrt$ = CHR$(27) + "F" + CHR$(27) + "P" + CHR$(27) + "W0" + CHR$ (18)
  54.  BoldPrtOn$ = CHR$(27) + "G"
  55.  BoldPrtOff$ = CHR$(27) + "H"
  56.  MicroPrt$ = CHR$(27) + "F" + CHR$(15)
  57.  ElitePrt$ = CHR$(27)+"B"+CHR$(2)
  58.  ItalicPrtOn$ = CHR$(27) + "4"
  59.  ItalicPrtOff$ = CHR$(27) + "5"
  60.  RegPrt$ = CHR$(27) + "E"
  61.  FastPrt$ = CHR$(18) + CHR$(27) + "F"
  62.  WidePrt$ = CHR$(14)
  63.  
  64.  
  65.  ELSEIF PrinterType = %StarNX1000 THEN
  66.  
  67. '              <<<  PRINTER CODES FOR STAR NX - 1000  >>>
  68.  
  69.  InitPrt$ = CHR$(27) + "F" + CHR$(27) + "P" + CHR$(27) + "W0" + CHR$ (18)
  70.  BoldPrtOn$ = CHR$(27) + "G"
  71.  BoldPrtOff$ = CHR$(27) + "H"
  72.  MicroPrt$ = CHR$(15)
  73.  ElitePrt$ = CHR$(27) + "M"
  74.  ItalicPrtOn$ = CHR$(27) + "4"
  75.  ItalicPrtOff$ = CHR$(27) + "5"
  76.  RegPrt$ = CHR$(27) + "E"
  77.  FastPrt$ = CHR$(18) + CHR$(27) + "F"
  78.  WidePrt$ = CHR$(14)
  79.  LQPrt$ = CHR$(27) + "x" + CHR$(1)
  80.  DraftPrt$ = CHR$(27) + "x" + CHR$(0)
  81.  
  82.  ELSEIF PrinterType = %IBMX24 THEN
  83.  
  84. '    <<<  PRINTER CODES FOR PANASONIC KX-P1124 EMULATING PROPRINTER X24  >>>
  85.  
  86.  InitPrt$ = CHR$(27) + "I" + CHR$(0) + CHR$(27) + "[@" + CHR$(4) + CHR$(0) + _
  87.         CHR$(0) + CHR$(0) + CHR$(17) + CHR$(1) + CHR$(27) + "F" + CHR$(27) + _
  88.            "H" + CHR$(18)
  89.  BoldPrtOn$ = CHR$(27) + "G"
  90.  BoldPrtOff$ = CHR$(27) + "H"
  91.  LQPrt$ = CHR$(27) + "I" + CHR$(2)
  92.  MicroPrt$ = CHR$(27)+"I"+CHR$(16)
  93.  MicroLQPrt$ = CHR$(27)+"I"+CHR$(18)
  94.  ElitePrt$ = CHR$(27) + "I" + CHR$(8)
  95.  EliteLQPrt$ = CHR$(27) + "I" + CHR$(10)
  96.  ItalicPrtOn$ = ""
  97.  ItalicPrtOff$ = ""
  98.  RegPrt$ = CHR$(27) + "E"
  99.  FastPrt$ = CHR$(18) + CHR$(27) + "F"
  100.  WidePrt$ = CHR$(14)
  101.  BigPrt$ = CHR$(27) + "[@" + CHR$(4) + CHR$(0) + CHR$(0) + CHR$(0) + _
  102.                  CHR$(17) + CHR$(1) + CHR$(27) + "G"
  103.  
  104.  ELSEIF PrinterType = %LQ2500 THEN
  105.  
  106. '    <<<  PRINTER CODES FOR PANASONIC KX-P1124 EMULATING LQ-2500  >>>
  107.  
  108.  InitPrt$ = CHR$(27) + "@"
  109.  GraphicsChrSetOn$ = CHR$(27) + "t" + CHR$(1) + CHR$(27) + "6"
  110.  GraphicsChrSetOff$ = CHR$(27) + "t" + CHR$(0)
  111.  BoldPrtOn$ = CHR$(27) + "G"
  112.  BoldPrtOff$ = CHR$(27) + "H"
  113.  ItalicPrtOn$ = CHR$(27) + "4"
  114.  ItalicPrtOff$ = CHR$(27) + "5"
  115.  RegPrt$ = CHR$(27) + "E"
  116.  FastPrt$ = CHR$(18) + CHR$(27) + "F"
  117.  WidePrt$ = CHR$(14)
  118.  BigPrtOn$ = CHR$(27) + "w" + CHR$(1) + CHR$(27) + "W" + CHR$(1)
  119.  BigPrtOff$ = CHR$(27) + "w" + CHR$(0) + CHR$(27) + "W" + CHR$(0)
  120.  
  121.  LQPrt$ = CHR$(27) + "x" + CHR$(1)
  122.  DraftPrt$ = CHR$(27) + "x" + CHR$(0)
  123.  MicroPrtOn$ = CHR$(15) '                        137 chr/ln
  124.  MicroPrtOff$ = CHR$(18)
  125.  ElitePrt$ = CHR$(27) + "M"  '                    96 chr/ln
  126.  PicaPrt$ = CHR$(27) + "P"
  127.  ReverseLF$ = CHR$(27) + "j" + CHR$ (30)
  128.  
  129.  END IF
  130. ' _________________________________________________________________________
  131.  
  132. '  GetMonitorType
  133.  
  134.  DEF SEG = &H40
  135.  IF PEEK(&H63)+256*PEEK(&H64)+6 = &H3BA THEN
  136.     ColorDisplay = %False '                      I got this from a .ASM file by
  137.  ELSE                     '                      Mike Mefford -- tho' I don't
  138.     ColorDisplay = %True  '                      speak ASM at all. I just took
  139.  END IF                   '                      the address & byte to check
  140.                           '                      for and it seems to work ...
  141.  
  142. '  CheckVideoAddress
  143.  
  144.  GOSUB SetVideoAddress
  145.  OrigL = CSRLIN: OrigC = CSRLIN
  146.  CALL SCREENPUSH '                               save the screen prior to
  147.  GOSUB WriteAndPeek '                             writing to it ...
  148.  IF VideoSegError THEN
  149.    COLOR 3,0: LOCATE 10,10
  150.    PRINT "ERROR READING MONITOR TYPE. IS THIS A COLOR MONITOR?";
  151.    ColorDisplay = GetYesOrNo
  152.    GOSUB SetVideoAddress
  153.    GOSUB WriteAndPeek
  154.    IF VideoSegError THEN
  155.      COLOR 3,0: LOCATE 12,10
  156.      PRINT "UNABLE TO SET ADDRESS OF DISPLAY CORRECTLY FOR THIS MACHINE"
  157.      LOCATE 14, 14: PRINT "SOME DEEP PROBLEM NEEDS CORRECTED. EXITING NOW."
  158.      STOP
  159.    END IF
  160.  END IF
  161.  
  162.  NeedDCon = (IsRodent <> %False)
  163.  
  164.  EXIT SUB
  165. '           ==================================   end of subroutine HBInit
  166.  
  167. SetVideoAddress:
  168.  
  169.  IF ColorDisplay THEN
  170.      VideoSeg& = &HB800: CursorTop = 6: CursorBottom = 7
  171.  ELSE
  172.      VideoSeg& = &HB000: CursorTop = 14: CursorBottom = 15
  173.  END IF
  174.  RETURN
  175.  
  176.  
  177. WriteAndPeek:
  178.  COLOR 7,0: CLS
  179.  COLOR 0,0
  180.  PRINT "01234"
  181.  DEF SEG = VideoSeg&
  182.  FOR N = 0 TO 4
  183.     IF VAL(CHR$(PEEK(2*N))) <> N OR PEEK (2*N+1) <> 0 THEN
  184.       VideoSegError = %True
  185.       RETURN
  186.     END IF
  187.  NEXT
  188.  RETURN
  189.  
  190.  END SUB
  191.  
  192.  
  193.