'===========================================================================
' Subject: YES/NO PROMPT BOX                 Date: 02-15-99 (14:00)       
' Author:  Dieter Folger                     Code: PB                     
' Origin:  folger@bamberg.baynet.de        Packet: PB.ABC
'===========================================================================
' ANSWER.BAS for PowerBasic
' Freeware (c) 1996 by Dieter Folger
' A box to ask the user a Yes/No question (similar as the PB-Editor)
' Answer can be given with mouse or keyboard
' QPRINT routine credits to Dave Navarro jr.
'--------------------------------------------------------------------------
'MAIN PROGRAM START
'-------------------------------------------------------------------------
 DEFINT A - Z
 CLS
 DECLARE SUB GetStrLoc() ' need this for QPRINT
 SHARED Mouse
 IF MInit THEN Mouse = 1
 A$ = Answer$ ("Do you really want to quit? (Y/N)", 8, 31)
 PRINT "Answer: ";
 If A$ = "Y" THEN PRINT "Yes" ELSE PRINT "No"
'----------------------------------------------------------------------------
FUNCTION Answer$ (Prompt$, Row, Attr)
'----------------------------------------------------------------------------
 Cols = LEN (Prompt$) + 4
 Col = (80 - Cols) \ 2
 Win Col, Row , Col + Cols, Row + 5, Attr
 IF Mouse THEN MCursor 1
 C = Cols \ 4
 BAttr = (Attr \ 16) * 16
 QPrint Row + 1, Col + 2, Prompt$, Attr
 QPrint Row + 3, Col + C + 6,       "Ü", BAttr
 QPrint Row + 3, Col + C,  "  Yes ",  63
 QPrint Row + 4, Col + C + 1,  "ßßßßßß", BAttr
 QPrint Row + 3, Col + C + 2, "Y", 62
 '--------------------------------------------------
 QPrint Row + 3, Col + Cols - C - 1, "Ü", BAttr
 QPrint Row + 3, Col + Cols - C - 7, "  No  ",  63
 QPrint Row + 4, Col + Cols - C - 6, "ßßßßßß", BAttr
 QPrint Row + 3, Col + Cols - C - 5, "N", 62
 DO
    DO
       K$ = UCASE$(INKEY$)
       IF Mouse THEN MEvent mr, ml, my, mx
    LOOP UNTIL LEN(K$) OR mr OR ml
    IF Mouse THEN
       IF mr THEN K$ = "N" 'right button
       IF ml AND my = Row + 3 THEN
          IF mx > Col + C - 1 AND mx < Col + C + 6 THEN K$ = "Y"
          IF mx > Col + Cols - C - 8 AND mx < Col + Cols - C -1 THEN K$ = "N"
       END IF
    END IF
    IF K$ = CHR$ (27) THEN K$ = "N"
 LOOP UNTIL INSTR("YN",K$)
 IF Mouse THEN MCursor 0
 FUNCTION = K$
END FUNCTION
'-----------------------------
SUB Win (xb, yb, xe, ye, Attr)
'-----------------------------
 a = 201 : b = 205 : c = 187   ' Double frame
 h = 186 :         : d = 186
 g = 200 : f = 205 : e = 188
 QPrint yb, xb, CHR$(a) + REPEAT$(xe-xb-1,CHR$(b)) + CHR$(c), Attr
 FOR i = yb + 1 TO ye - 1
     QPRINT i, xb, CHR$(h) + SPACE$(xe-xb-1) + CHR$(d), Attr
 NEXT
 QPRINT ye, xb, CHR$(g) + REPEAT$(xe-xb-1, CHR$(f)) + CHR$(e), Attr
END SUB
'-------------
FUNCTION MInit
'-------------
 LOCAL tmp
 ! mov ax,0
 ! int &h33
 ! mov tmp, ax
 FUNCTION = tmp
END FUNCTION
'--------------------
SUB MCursor (BYVAL c)
'--------------------
 'c: 1= On / 0=Off
 ! mov ax,c
 ! int &h33
END SUB
'--------------------------------------
SUB MEvent (RButton, LButton, Row, Col)
'--------------------------------------
 LOCAL event, r, c, tmp
 ! mov ax,3
 ! int &h33
 ! mov event, bx
 ! mov r, dx
 ! mov c, cx
 SELECT CASE event
        CASE 1 : LButton = 1
        CASE 2 : RButton = 1
 END SELECT
 Row = r \ 8 + 1
 Col = c \ 8 + 1
 'Wait until button is released again:
 DO
   ! mov ax,3
   ! int &h33
   ! mov tmp,bx
 LOOP UNTIL tmp = 0
END SUB
'===========================================================================
' QPRINT - print string to specified location on the screen in specified color
'
' Note:  String is passed BYVAL to make it compatible with fixed length
'        and flex strings.  Since this uses the internal assembler, PB will
'        automatically release the temporary string handle left on the stack.
'        If it were an external assembler routine, it would be reponsible for
'        releasing the string.
'
' Row   = Screen row to display text
' Col   = Starting column to display text
' Text  = Text string to display on screen
' Attr  = Color attribute to display characters
'
'------------------------------------------------------------------------
SUB QPRINT(BYVAL Row, BYVAL Col, BYVAL Text AS STRING, BYVAL Attr) PUBLIC
'------------------------------------------------------------------------
  LOCAL ScrnSeg
  IF (pbvScrnCard AND 1) = 0 THEN
    ScrnSeg = &HB800        ' color monitor
  ELSE
    ScrnSeg = &HB000        ' mono monitor
  END IF
  ! push DS                 ; save DS for PowerBASIC
  ! push Word Ptr Text      ; push string handle on the stack
  ! call GetStrLoc          ; find the string
  ! jcxz QPExit             ; if it's null, exit
  ! mov  DS, DX             ; put segment in DS
  ! mov  SI, AX             ; put offset in SI
  ! push CX                 ; save length
  ! mov  AX, ScrnSeg        ; put screen segment in AX
  ! mov  ES, AX             ; move to ES
  ! mov  AX, Row            ; put row in AX
  ! dec  AX                 ; minus one
  ! mov  CX, 160            ; AX =
  ! mul  CX                 ;   AX * 160
  ! mov  DI, AX             ; put it in DI
  ! mov  AX, Col            ; put column in AX
  ! dec  AX                 ; minus one
  ! shl  AX, 1              ; times 2
  ! add  DI, AX             ; add to DI
  ! pop  CX                 ; restore length of string
  ! mov  AH, Attr           ; put attribute in AH
WriteChar:
  ! lodsb                   ; get char from string
  ! stosw                   ; write char and attribute to screen
  ! loop WriteChar          ; do it all CX times
QPExit:
  ! pop  DS                 ; restore DS for PowerBASIC
END SUB