Can't leave well enough a

 BBS: Inland Empire Archive
Date: 03-16-92 (05:14)             Number: 176
From: STEVE GARTRELL               Refer#: NONE
  To: ALL                           Recvd: NO  
Subj: Can't leave well enough a      Conf: (2) Quik_Bas

'***NOTE:  This will only work in SCREEN 0;  memory storage methods differ
'***       vastly in the graphics screens requiring much more complex code
'***       for pop-up windows!!!  Of course, you can remove the window stuff.
'
DEFINT A-Z
DECLARE SUB PushWindow (row%, col%, NumRows%, NumCols%)
DECLARE SUB PopWindow ()
DECLARE FUNCTION WhatPrinterNum% ()
'$INCLUDE: 'QB.BI'
'$DYNAMIC

DIM SHARED DispSave(1, 1) AS INTEGER

CLS
FOR RowCnt% = 0 TO 15
 LOCATE 5 + RowCnt%, 5
 FOR ColorCnt% = 0 TO 48
  COLOR ColorCnt% MOD 16, 0
  PRINT LTRIM$(STR$(ColorCnt% MOD 16));
 NEXT ColorCnt%
NEXT RowCnt%

COLOR 7, 0
CLS

PrintFile% = WhatPrinterNum%
IF PrintFile% THEN

 'ordinarily you'd call your print subroutine passing PrintFile%
 '  as a parameter- this is just an example

 PRINT #PrintFile, "This part works"; CHR$(12);
 CLOSE #PrintFile%
END IF

END

SUB PopWindow
'
DEF SEG = &HB800
FOR cnt% = 1 TO UBOUND(DispSave, 1)
 POKE DispSave(cnt%, 1), DispSave(cnt%, 2) MOD 256
NEXT cnt%
DEF SEG
'
ERASE DispSave
'
END SUB

SUB PushWindow (row%, col%, NumRows%, NumCols%)
'
NumBytes% = (NumCols% * 2) * NumRows%
MemRow% = row% - 1                          'compensate for zero base
MemCol% = col% - 1
ByteCnt% = 0
'
REDIM DispSave(1 TO NumBytes%, 2) AS INTEGER
'
DEF SEG = &HB800
FOR RowCnt% = 0 TO NumRows% - 1
 MemOffset% = ((MemRow% + RowCnt%) * 160) + (MemCol% * 2)
 EndOffset% = ((MemRow% + RowCnt%) * 160) + ((MemCol% + NumCols%) * 2)
 FOR MemOffset% = MemOffset% TO EndOffset% - 1
  ByteCnt% = ByteCnt% + 1
  DispSave(ByteCnt%, 1) = MemOffset%
  DispSave(ByteCnt%, 2) = PEEK(MemOffset%)
 NEXT MemOffset%
NEXT RowCnt%
DEF SEG
'
END SUB

FUNCTION WhatPrinterNum%
'
PrinterFound% = 0
PrintFile% = 0
'
DIM RegsToASM AS RegType, RegsFromASM AS RegType
'
DO
 FOR PrinterNum% = 0 TO 2
  RegsToASM.ax = &H7                          'ding-a-ling...
  RegsToASM.dx = PrinterNum%
  CALL INTERRUPT(&H17, RegsToASM, RegsFromASM)
  IF (RegsFromASM.ax AND &H2900) = 0 THEN     'no errors?
   IF (RegsFromASM.ax AND &H1000) THEN     'on line?
    PrinterFound% = PrinterNum% + 1
    EXIT FOR
   END IF
  END IF
 NEXT PrinterNum%
 IF PrinterFound% = 0 THEN
  BEEP
  PushWindow 8, 15, 7, 47
  COLOR 14, 1
  LOCATE 8, 15
  PRINT "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»";
  LOCATE 9, 15
  PRINT "º                                             º";
  LOCATE 10, 15
  PRINT "º      Your printer is not responding.        º";
  LOCATE 11, 15
  PRINT "º        Please check your printer.           º";
  LOCATE 12, 15
  PRINT "º [ESC] aborts print; any other key to retry. º";
  LOCATE 13, 15
  PRINT "º                                             º";
  LOCATE 14, 15
  PRINT "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ";
  DO
   diskey$ = INKEY$
  LOOP UNTIL LEN(diskey$)
  PopWindow
  COLOR 7, 0
  IF ASC(diskey$) = 27 THEN
   EXIT DO
  END IF
 END IF
LOOP UNTIL PrinterFound%
'
IF PrinterFound% THEN
 PrinterFile$ = "LPT" + LTRIM$(STR$(PrinterFound%)) + ":"
 PrintFile% = FREEFILE
 OPEN PrinterFile$ FOR OUTPUT AS PrintFile%
END IF
'
WhatPrinterNum% = PrintFile%
'
END FUNCTION


--- DB B1061/071082
 * Origin: RadioLink! Columbus, Ohio (614)766-2162 HST/DS (1:226/140)