program f90_IMFONT implicit none integer,parameter::nn=1000,mm=100 character(len=mm)::fon(1:nn) integer::i,io,nd character(len=50)::fnameR,fnameW,filename character(len=1)::yn call getarg(1,yn) call getarg(2,fnameR) call getarg(3,fnameW) open(11,file=fnameR,status='old') do i=1,nn read(11,'(a)',iostat=io) fon(i) if(io<0)exit end do close(11) nd=i-1 open(12,file=fnameW,status='replace') write(12,'(a)') '' write(12,'(a)') '' write(12,'()') write(12,'(a)') '

Font sample images by Imagemagick

' write(12,'(a)') '' do i=1,nd write (filename,'("img",i3.3,".gif")') i write(12,'(a)') '' end do write(12,'(a)') '
'//trim(adjustl(fon(i)))//& 'img
' write(12,'()') write(12,'(a)') '' write(12,'(a)') '' close(12) open(12,file='bat_font.bat',status='replace') do i=1,nd write (filename,'("img",i3.3,".gif")') i write(12,'(a)') 'convert -background white -fill navy -font c:\Windows\Fonts\'//trim(adjustl(fon(i)))//& ' -pointsize 26 label:@finp.txt '//trim(adjustl(filename)) write(12,'(a)') 'convert -bordercolor "#ffffff" -border 2 '//trim(adjustl(filename))//' temp.gif' write(12,'(a)') 'del '//trim(adjustl(filename)) write(12,'(a)') 'rename temp.gif '//trim(adjustl(filename)) end do close(12) if(yn=='y')then call system('bat_font') end if stop end program f90_IMFONT