home *** CD-ROM | disk | FTP | other *** search
- C Write a test pattern to the screen using the MS fonts
- C
- include 'fgraph.fi'
- include 'fgraph.fd'
-
- integer*2 ly
-
- character*2 fnt
- character*80 pattern1,pattern2
-
- record /xycoord/ xy
- record /fontinfo/ fontdata
-
- istat = setvideomode($maxresmode)
-
- if ( registerfonts('msfonts.fon') .lt. 0 )
- + STOP 'Error: cannot register font'
-
- pattern1='Test pattern [abcdefghijklmnopqrstuvwxyz] 1234567890'
- pattern2=' aTbWilO [ABCDEFGHIJKLMNOPQRSTUVWXYZ]'
-
- ly = 15
- fnt = 'n1'
- i = 1
- do while ( setfont(fnt) .ge. 0)
-
- istat = getfontinfo(fontdata)
-
- call moveto(0, ly, xy)
- call outgtext(pattern1)
-
- ly = ly + fontdata.pixheight !add line spacing for current font
-
- call moveto(0, ly, xy)
- call outgtext(pattern2)
-
- ly = ly + fontdata.pixheight
-
- i = i+1
- fnt(2:2) = char(i+48)
-
- end do
-
- write(*,'(1x,A,I3,A)') 'Found ', i-1, ' fonts'
- read (*,*)
-
- call unregisterfonts()
- i = setvideomode($DEFAULTMODE)
-
- end
-
-
-