Font and text functions

[steve_konarski]

Is it possible to use font and text functions createfont , gettxtmetrics etc in a dos program?

I generate graphics out put for a third part program and need to know the font characteristics - charcater widths etc.

I would like to supply a font as the typeface and the use Gettextmetrics to obtain the dimensions of each character.

If not are there any oher programs available to provide this information

[Steven_L_Intel1]

I'm not sure what you mean by "a dos program" in this context. An Intel Visual Fortran program can certainly do this - the WinPrint sample provided in version 10 does exactly what you're looking for so you can use this as an example.

[steve_konarski]

This is the type ofroutine i am looking for - to use the font routines in a FORTRAN CONSOLE PROGRAM - without having a winmain entry, The value of hfont returning from createfont has a value, however the ABCD array from getcharwidth32 and lptm%tmAscent from Gettextmetrics are zero because HDC is zero , I am not sure about BeginPaint (hWnd

___________________________________________________

integer function getfontwidths()

use gdi32
use dfwin
use dflogm
use dfwinty
use dflib
USE DFNLS

implicit none

integer ftwide(256)

character*90 typeface
integer hfont,hdc,hwnd
integer i,j,nhgg,nw, ret,nchars
real fact

integer lenstr
integer ABCD(0:255)
type (T_PAINTSTRUCT) ps

typeface="Arial"
typeface(6:6)=char(0) ! needs null terminator

hdc = BeginPaint (hWnd, ps)
nhgg=-10000
nw=0
hfont = CreateFont(-nhgg, nw, 0, 0, 0, 0, 0, 0, &
DEFAULT_CHARSET, OUT_TT_PRECIS, CLIP_DEFAULT_PRECIS, &
PROOF_QUALITY,INT(DEFAULT_PITCH) ,typeface)!

nchars=255
ret=selectobject(hdc,hfont)
ret=getcharwidth32 (hdc,1,nchars,LOC(ABCD(1)))

ret=Gettextmetrics(hdc,lptm)
fact=10000./lptm%tmAscent

do j=32,nchars
ftwide(j)=ABCD(j)*fact

write(6,*)j,ftwide(j)
enddo

return

end

[Steven_L_Intel1]

If you're using CVF, the FORPRINT sample is what I referred to as WinPrint. You need some sort of device context to get the metrics, whether it be from a device or from a window.

[steve_konarski]

Only got fortran version 6.1 , can the winprint example be obtained from internet , or any ideas to get a device

steve

[Jugoslav_Dujic]

But from the outset, you weren't clear in which format you have to generate the output? Bmp? Wmf? Some custom text format?

Basically, you can call most GDI functions from a console application, but you have to better define what you're aiming at. For example, you can call hDC = GetDC(NULL)...ReleaseDC() to obtain the current screen DC (although you shouldn't draw on it, only take the data from it) -- rather than BeginPaint, which makes no sense outside of a window procedure. You can also call CreateCompatibleBitmap+CreateCompatibleDC to create an off-screen DC, with which you can do as pleased (even save it as a bitmap).

[steve_konarski]

Thanks Juroslav - the GETDC(NULL) did the trick

steve

[steve_konarski]

HI Juroslav - I think the program is nearly there - the version i got now is

_______________________________________________________________
use dfwin
use dflib

implicit none

character*10 font(3),typeface
integer hfont,hdc,hwnd
integer i,j,nhgg,nw, ret,nchars

integer abcd(0:255)

FONT(1)="COUR"
FONT(2)="ARIAL"
FONT(3)="BOOKOS"
font(1)(5:5)=char(0)
font(1)(6:6)=char(0)
font(1)(7:7)=char(0)

do i=1,3

hdc = getdc(null)

nhgg=-10000
nw=0
hfont = createfont(-nhgg, nw, 0, 0, 0, 0, 0, 0, &
default_charset, out_tt_precis, clip_default_precis, &
proof_quality,int(default_pitch) ,font(i))!

nchars=255
ret=selectobject(hdc,hfont)

ret = gettextface(hdc ,10,typeface)
ret=getcharwidth32 (hdc,1,nchars,loc(abcd(1)))

write(6,*)font(i)(1:10), "-" ,typeface(1:10)

do j=32,nchars
write(66,*)j,abcd(j)
enddo

enddo
ret=releasedc(null,hdc)

stop

end

and get thescreen output

COUR -Arial
ARIAL -Arial
BOOKOS -Arial

I seem not to be clearing the "Arial" from the handles for hfont and HDC

Steve

[Jugoslav_Dujic]

Several points:

1. You should check whether hFont = CreateFont(...) succeeds. (hFont.NE.0). I don't think that Windows is smart enough to deduce the intent of "Cour" or "Bookos"
2. CreateXXX GDI functions are tiresome because you have to do the bookeeping of object deletion and selection. You need instead:

hFont = CreateFont(...)
if (hFont.NE.0) then
   hOldFont = SelectObject(hDC, hFont)
   ...
   ret = SelectObject(hDC, hOldFont)
   ret = DeleteObject(hFont)
else
   !error
end if

P.S. it's far more elegant to initialize the character variables as font(2)="Arial"//char(0).

[steve_konarski]

STill no joy - my program is now

______________________________________________

use dfwin
use dflib

implicit none

character*10 font(3),typeface
integer hfont,hdc,hwnd,holdfont
integer i,j,nhgg,nw, ret,nchars

integer abcd(0:255)

FONT(1)="COUR"//char(0)
FONT(2)="dutch"//char(0)
FONT(3)="BOOKOS"//char(0)

do i=1,3

hdc = getdc(null)

nhgg=-10000
nw=0
hfont = createfont(-nhgg, nw, 0, 0, 0, 0, 0, 0, &
default_charset, out_tt_precis, clip_default_precis, &
proof_quality,int(default_pitch) ,font(i))

if (hFont.NE.0) then

nchars=255
holdfont=selectobject(hdc,hfont)

ret = gettextface(hdc ,10,typeface)
ret=getcharwidth32 (hdc,1,nchars,loc(abcd(1)))

write(6,*)font(i)(1:10), "-" ,typeface(1:10),abcd(60)

holdfont=selectobject(hdc,holdfont)
ret = DeleteObject(hFont)
ret=releasedc(null,hdc)

else
write(6,*)'Error'
endif

enddo

stop

end

and get thescreen output

COUR -Arial 5227
ARIAL -Arial 5227
BOOKOS -Arial 5227

Arial does not even appear in the code now but comes out in the output !!! . if i use the same instructions in a "normal" windows graphics program using winmain etc everything is OK

steve

[steve_konarski]

I also took the exe and ran it on other machins in the office and got the same result

[Jugoslav_Dujic]

It's due to an obscure way how the CreateFont "reads your mind". Apparently, when it cannot find an exact match to the requested typeface, it substitutes the default sans-serif scalable font, which happens to be Arial.

The following, however, works for me (enlarge the string sizes):

FONT(1)="Courier New"//char(0) 

FONT(2)="Arial"//char(0)

FONT(3)="Times"//char(0)

Producing:

Courier New -Courier New 5298

Arial -Arial 5227

Times -Times 5093

[steve_konarski]

Many thanks Juroslav - you are a star steve