! //IB// SRC("&WINDOWT.IBS","IBS") OBJ("&WINDOWT", "OBJ")  
!********************************************************************!
!     PROGRAM IDENTIFICATION
!     TEST EXTENDED WINDOW OPEN TEXT OUT
!     SOURCE: &WINDOW          OBJECT: &WINDOW
!********************************************************************!
!
!     PROGRAM VARIABLES
!
     LENGTH   1   &   COMMON SEL$
     LENGTH   1   &   LOCAL  OPTION$
     LENGTH   4   &   LOCAL TEXT$
!
     LENGTH  3.0  &   LOCAL COUNT,SCRCOUNT
!
     LENGTH 3.0    &  LOCAL SCRSIZE
     LENGTH 3.0    &  LOCAL WCOL,WROW,WWDTH,WHGHT
     LENGTH   4    &  LOCAL WHANDL1$,WHANDL2$
     LENGTH 132    &  LOCAL WCAPTION$
!
!     VARIABLES AND FORMATS FOR FONT SELECTION AND TEXT OUT
     LENGTH    4   & LOCAL SLFHEIGHT$
     LENGTH    4   & LOCAL SLFWIDTH$
     LENGTH    4   & LOCAL SLFESCARP$
     LENGTH    4   & LOCAL SLFORIENT$
     LENGTH    4   & LOCAL SLFWEIGHT$
     LENGTH    1   & LOCAL SLFITALIC$
     LENGTH    1   & LOCAL SLFUNDERLINE$
     LENGTH    1   & LOCAL SLFSTRIKEOUT$
     LENGTH    1   & LOCAL SLFCHARSET$
     LENGTH    1   & LOCAL SLFOUTPREC$
     LENGTH    1   & LOCAL SLFCLIPPREC$
     LENGTH    1   & LOCAL SLFQUALITY$
     LENGTH    1   & LOCAL SLFPITCHFAMILY$
     LENGTH   32   & LOCAL SLFFACENAME$
!
SLOGFONT: FORMAT _
         SLFHEIGHT$; _
         SLFWIDTH$; _
         SLFESCARP$; _
         SLFORIENT$; _
         SLFWEIGHT$; _
         SLFITALIC$; _
         SLFUNDERLINE$; _
         SLFSTRIKEOUT$; _
         SLFCHARSET$; _
         SLFOUTPREC$; _
         SLFCLIPPREC$; _
         SLFQUALITY$; _
         SLFPITCHFAMILY$; _
         SLFFACENAME$
!
SELECTFONT: FORMAT (SELECTFONT); _
            SLFHEIGHT$; _
            SLFWIDTH$; _
            SLFESCARP$; _
            SLFORIENT$; _
            SLFWEIGHT$; _
            SLFITALIC$; _
            SLFUNDERLINE$; _
            SLFSTRIKEOUT$; _
            SLFCHARSET$; _
            SLFOUTPREC$; _
            SLFCLIPPREC$; _
            SLFQUALITY$; _
            SLFPITCHFAMILY$; _
            SLFFACENAME$     
!
!     SCREEN FORMATS
!
2700 FORMAT (CS)
2701 FORMAT (SCREEN=132,27)
2710 FORMAT @(50,3);(SB);'TEST COMET EXTENDED WINDOW TEXT OUT';_
            @(50,4);'CONTINUE? (Y/N)';_
            (TP);(SF);' ';(TP);@(50)
2720 FORMAT @(50,5);(SB);'ENTER COUNT';(TP);(RJ);(SF);'',4;(TP);@(50)
2730 FORMAT @(50,6);(SB);COUNT;(TP);(SF);' ';(TP);(SB);'ENTER TO CONTINUE.';@(50)
2740 FORMAT @(50,22);COUNT
!
TEXT: FORMAT @(20,0);TEXT$;(SF)
!
!     PROGRAM BEGINS
!
     CLEAR
     ERRORTO 9800
     ESCAPETO 9810
!
     PRINT (0,2700)
     PRINT (0,2701)
3000 PRINT (0,2710)
     INPUT (0) OPTION$
     OPTION$ = UCASE(OPTION$)
     IF OPTION$ NE 'Y' GO 9990
3010 PRINT (0,2720)
     INPUT (0) SCRCOUNT
     IF SCRCOUNT = 0 GO 3000     	
!
     COUNT = 1     	
WINDO:
     TEXT$ = STR(COUNT)
     WCOL = 43
     WROW = 5
     WWDTH = 52
     WHGHT = 8
     WCAPTION$ = 'TEST COMET EXTENDED WINDOW TEXT OUT'
     PRINT (CREATEWINDOWEX=WCOL,WROW,WWDTH,WHGHT,68,0,WCAPTION$)
     INPUT WHANDL1$
!
     GOSUB INITLOGFONT
!
     PRINT (0) (WALLPAPERCOLOR=255,255,255)
     PRINT (0) (TRANSPARENTCOLOR=251)
!
     PRINT (0) (MAPMODE=4)              ! use QCRT row/column positions
!
     SLFHEIGHT$ = INTELD(0)
     SLFORIENT$ = INTELD(1)
     SLFWEIGHT$ = INTELD(700)            ! BOLD
     SLFFACENAME$ = 'Arial'+'@00@'       ! ARIAL FONT
     PRINT (0,SELECTFONT)                ! SELECT FONT
     PRINT (0) (SETBKMODE=1)             ! SET BACKGROUND MODE TO TRANSPARENT
     PRINT (0) (SETTEXTCOLOR=0,0,0)      ! SET TEXT COLOUR
!
     PRINT (0) (TEXTOUT=20,0);TEXT$
!
     PAUSE 36
     PRINT (DELETEWINDOWEX=WHANDL1$)
     IF COUNT = SCRCOUNT GO 3000
     COUNT = COUNT + 1	
     PAUSE 54
     PRINT (0,2740)
     GO WINDO	
!
!     SUBROUTINE TO GET DEFAULT FONT
INITLOGFONT:
  SLFHEIGHT$  = INTELD(0) ! Twentieth of a point (using GDI.CreatePointFont)
  SLFWIDTH$  = INTELD(0) ! Match to font
  SLFESCARP$  = INTELD(0) ! No line rotation
  SLFORIENT$ = INTELD(0) ! No char rotation
  SLFWEIGHT$  = INTELD(400)
  SLFITALIC$  = INTEL(0)
  SLFUNDERLINE$  = INTEL(0)
  SLFSTRIKEOUT$  = INTEL(0)
  SLFCHARSET$  = INTEL(0)
  SLFOUTPREC$ = INTEL(0)
  SLFCLIPPREC$ = INTEL(0)
  SLFQUALITY$  = INTEL(1)
  SLFPITCHFAMILY$ = INTEL(0)
  SLFFACENAME$  = "Courier New"+'@00@'
RETURN     
!
!     EXCEPTION PATHS
!
9800 ERRORTO 9800
     IF EXCP = 33 AGAIN
     ERROR
9810 POPALL
     PRINT (DELETEWINDOWEX=WHANDL1$)
     PRINT (0,2730)
     INPUT (0) OPTION$
     GO 3000  	
!
9990 KILL PARTITION$
9999 END