home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / MAGAZINE / MISC / QBNWS301.ZIP / QBASIC.ZIP / TEMPLATE.BAS < prev   
Encoding:
BASIC Source File  |  1991-11-12  |  2.4 KB  |  83 lines
  1. '
  2. ' Template.BAS - Basic shell for programs using Brent's QBasic toolkit
  3. '
  4. DEFINT A-Z
  5. DECLARE FUNCTION ColorAttr% (Fore%, Back%)
  6. DECLARE FUNCTION LoadBin$ (BinFileName$)
  7. DECLARE SUB BlockCopy (FromSeg%, FromOfs%, ToSeg%, ToOfs%, Count%)
  8. DECLARE SUB SLBox (Top%, Lft%, Bot%, Rgt%, Attr%, Shad%)
  9. TYPE RegTypeX
  10.   AX    AS INTEGER
  11.   BX    AS INTEGER
  12.   CX    AS INTEGER
  13.   DX    AS INTEGER
  14.   BP    AS INTEGER
  15.   SI    AS INTEGER
  16.   DI    AS INTEGER
  17.   Flags AS INTEGER
  18.   DS    AS INTEGER
  19.   ES    AS INTEGER
  20. END TYPE
  21. DIM SHARED Regs AS RegTypeX
  22. DECLARE SUB Interrupt (IntNum%, Regs AS RegTypeX)
  23.  
  24. '
  25. ' Your Code Here
  26. '
  27.  
  28. SUB BlockCopy (FromSeg, FromOfs, ToSeg, ToOfs, Count)
  29.   STATIC MemCopy$
  30.   IF NOT LEN(MemCopy$) THEN MemCopy$ = LoadBin("MemCopy.BIN")
  31.   DEF SEG = VARSEG(MemCopy$)
  32.   CALL Absolute(FromSeg, FromOfs, ToSeg, ToOfs, Count, SADD(MemCopy$))
  33. END SUB
  34.  
  35. FUNCTION ColorAttr (Fore, Back)
  36.   ColorAttr = (Fore AND 16) * 8 + (Back AND 7) * 16 + (Fore AND 15)
  37. END FUNCTION
  38.  
  39. SUB Interrupt (IntNum, Regs AS RegTypeX) STATIC
  40.   STATIC FileNum, IntOffset, Loaded
  41.   ' use fixed-length string to fix its position in memory
  42.   ' and so we don't mess up string pool before routine
  43.   ' gets its pointers from caller
  44.   DIM IntCode AS STRING * 200
  45.   IF NOT Loaded THEN                        ' loaded will be 0 first time
  46.     IntCode = LoadBin("IntCode.BIN")        ' load routine and determine
  47.     IntOffset = INSTR(IntCode$, CHR$(&HCD) + CHR$(&H21)) + 1 ' int # offset
  48.     Loaded = -1
  49.   END IF
  50.   SELECT CASE IntNum
  51.     CASE &H25, &H26, IS > 255               ' ignore these interrupts
  52.     CASE ELSE
  53.       DEF SEG = VARSEG(IntCode)             ' poke interrupt number into
  54.       POKE VARPTR(IntCode) * 1& + IntOffset - 1, IntNum' code block
  55.       CALL Absolute(Regs, VARPTR(IntCode$)) ' call routine
  56.   END SELECT
  57. END SUB
  58.  
  59. FUNCTION LoadBin$ (BinFileName$)
  60.   ' Loads a binary file as a string
  61.   STATIC FileNum, Buf$
  62.   FileNum = FREEFILE
  63.   OPEN BinFileName$ FOR BINARY AS FileNum
  64.   IF LOF(FileNum) = 0 THEN
  65.     CLOSE FileNum
  66.     KILL BinFileName$
  67.     CLS : PRINT "Can't find "; BinFileName$; " - aborting."
  68.     END
  69.   END IF
  70.   Buf$ = SPACE$(LOF(FileNum)) ' size buffer
  71.   GET FileNum, , Buf$
  72.   CLOSE #FileNum
  73.   LoadBin$ = Buf$
  74. END FUNCTION
  75.  
  76. SUB SLBox (Top, Lft, Bot, Rgt, Attr, Shad)
  77.   STATIC SLB$
  78.   IF NOT LEN(SLB$) THEN SLB$ = LoadBin("SLBox.BIN")
  79.   DEF SEG = VARSEG(SLB$)
  80.   CALL Absolute(Top, Lft, Bot, Rgt, Attr, Shad, SADD(SLB$))
  81. END SUB
  82.  
  83.