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
連結已複製
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
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).
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
- 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"
- 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).
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
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
