home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / fortran / mslang / fonts / fsampler.for next >
Text File  |  1993-07-02  |  1KB  |  53 lines
  1. C     Write a test pattern to the screen using the MS fonts
  2. C
  3.       include 'fgraph.fi'
  4.       include 'fgraph.fd'
  5.  
  6.       integer*2 ly
  7.  
  8.       character*2 fnt
  9.       character*80 pattern1,pattern2
  10.  
  11.       record /xycoord/ xy
  12.       record /fontinfo/ fontdata
  13.  
  14.       istat = setvideomode($maxresmode)
  15.  
  16.       if ( registerfonts('msfonts.fon') .lt. 0 )
  17.      +   STOP 'Error: cannot register font'
  18.  
  19.       pattern1='Test pattern [abcdefghijklmnopqrstuvwxyz] 1234567890'
  20.       pattern2='  aTbWilO [ABCDEFGHIJKLMNOPQRSTUVWXYZ]'
  21.  
  22.       ly = 15
  23.       fnt = 'n1'
  24.       i = 1
  25.       do while ( setfont(fnt) .ge. 0)
  26.  
  27.         istat = getfontinfo(fontdata)
  28.  
  29.         call moveto(0, ly, xy)
  30.         call outgtext(pattern1)
  31.  
  32.         ly = ly + fontdata.pixheight  !add line spacing for current font
  33.  
  34.         call moveto(0, ly, xy)
  35.         call outgtext(pattern2)
  36.  
  37.         ly = ly + fontdata.pixheight
  38.  
  39.         i = i+1
  40.         fnt(2:2) = char(i+48)
  41.  
  42.       end do
  43.  
  44.       write(*,'(1x,A,I3,A)') 'Found ', i-1, ' fonts'
  45.       read (*,*)
  46.  
  47.       call unregisterfonts()
  48.       i = setvideomode($DEFAULTMODE)
  49.  
  50.       end
  51.  
  52.  
  53.