VFP 愛用者社區

[Ruey]

要想得到系統可用的字體，用 VFP 自己的 AFONT( ) 函數。
要修改報表的頭記錄，你必須知道報表頭記錄中的各參數所代表的含意。
你所說的要得到系統支援的印表機支援的幅面，可以用 WIN32API 完成。
但是 Win32api 在 Windows 9x 和 Windows NT(包括 Windows 2000)中
的調用方式是很不同的。而且據我的試驗，在 Windows 9x 作業系統中
獲取和設置系統支援的印表機支援的幅面都可以實現，但在 windows 2000
中，我只做到了獲取相關資訊，而設置確不起作用(我主要是試驗自定義紙張的設置)，

請看以下代碼：
以下代碼從 windows 註冊表中獲取當前印表機資訊及可用紙張，並將這些資訊顯示在
桌面上，沒有寫設置打印紙張代碼，如果你需要，我也可以寫出來：
我在 windows 2000 和 windows me 中測試通過


*-- 代碼開始
*-- 設置默認的目錄
clear
ccurrentprocedure = sys(16,1)
npathstart = at(":",ccurrentprocedure) - 1
nlenofpath = rat("\", ccurrentprocedure) - (npathstart)
Set default to (substr(ccurrentprocedure, npathstart, nlenofpath))

#Define hkey_local_machine -2147483646

Declare integer RegSetValueEx in win32api
integer,string,integer,integer,string,integer
Declare integer RegOpenKey in WIN32API integer,string,integer @
Declare integer RegQueryValueEx in WIN32API integer,string,integer,integer
@,string @,integer @
Declare integer DeviceCapabilities in "WinSpool.DRV"
string,string,integer,string @,integer
Declare integer RegCloseKey in ADVAPI32.dll integer
DECLARE INTEGER GetProfileString IN Win32API String cSection, String cKey,
String cDefault,String @cBuffer, Integer nBufferSize
Declare INTEGER WriteProfileString IN Win32API String, String, String

*-- 獲取用戶機器的作業系統, 是 Win 9x 還是 NT? ,結果保存在變數 os 中
Declare GetVersionEx in win32api string @OSVERSIONINFO
m.osversion = long2str(148) + replicate(chr(0), 144)
=getversionex(@m.osversion)
m.major = str2long(substr(m.osversion, 5, 4))
m.minor = str2long(substr(m.osversion, 9, 4))
m.build = str2long(substr(m.osversion, 13, 4))
m.platform = str2long(substr(m.osversion, 17, 4))
m.spversion = strtran(substr(m.osversion, 21), chr(0), "")

public devicedata

m.platformname = ""
Do case
Case m.platform = 0
os = "Win 31"
Case m.platform = 1
os = "Win 9x"
Case m.platform = 2
os = "WinNT/Win2000"
Endcase


*-- 以編程方式創建一個報表，並從該報表中獲取系統默認印表機的資訊
*-- 用於判斷用戶的系統中是否安裝了印表機
Set safety off
oldalias = alias()
Create table killyou free (dummy c(1))
Create report killyou from killyou.dbf
Use killyou.frx alias killyou

lcstr = expr

If empty(lcstr)
Messagebox("你的系統中沒有安裝印表機",0,"注意")
Use in killyou
Delete file killyou.frx
Delete file killyou.frt
Delete file killyou.dbf
If !empty(oldalias)
Select (oldalias)
Endif
Return .f.
Endif

Store memlines(expr) to gnnumlines

lcprinter = ""
lcport = ""

*-- 逐行處理備註欄位內容
For gncount = 1 to gnnumlines
If at("DEVICE=",mline(expr,gncount))<>0
lcprinter = substr(mline(expr,gncount),
Endif
If at("OUTPUT",mline(expr,gncount))<>0
lcport = substr(mline(expr,gncount),
Endif
Next

If empty(lcport)
Messagebox("當前印表機不是本地印表機",0,"注意")
Use in killyou
Delete file killyou.frx
Delete file killyou.frt
Delete file killyou.dbf
If !empty(oldalias)
Select (oldalias)
Endif
Return .f.
Endif

Use in killyou
Delete file killyou.frx
Delete file killyou.frt
Delete file killyou.dbf

If !empty(oldalias)
Select (oldalias)
Endif

lnresult = 0
lntype = 0
lcbuffer = space(1024)
lnbuffersize = len(lcbuffer)
devicedata = ''

*--根據用戶的作業系統從 windows 註冊表中獲取默認印表機的 DevMode
if os = "Win 9x"
nt2000 = 0
lnerror =
regopenkey(hkey_local_machine,"System\CurrentControlSet\Control\Print\Printe
rs\" + alltrim(lcprinter),@lnresult)

If !empty(lnerror)
Wait window "打開註冊鍵值時出錯"
Return .f.
Endif
lnerror = regqueryvalueex(lnresult,"Default
DevMode",0,@lntype,@lcbuffer,@lnbuffersize)
lnresult = lnresult

If lnerror = 0 and lcbuffer <> chr(0)
devicedata = left(lcbuffer,lnbuffersize)
Else
Wait window "系統中沒有設置默認印表機"
Return .f.
Endif

else

nt2000 = 32
*--- WIndows 2000 下讀取註冊表中的默認印表機資訊
Local nkey,csubkey,cvalue,nstrings,nloopvar
nkey = hkey_local_machine
csubkey = "System\ControlSet001\Control\Print\Printers\" + lcprinter
+"\DsDriver"
cvalue = "printMediaSupported"
nstrings = readreg_multi_sz(nkey, csubkey, cvalue)

If (nstrings > 0) then
Else
=messagebox("未找到默認印表機.")
Return .f.
Endif

*-- lnerror =
regopenkey(hkey_local_machine,"System\CurrentControlSet\Control\Print\Printe
rs\" + lcprinter,@lnresult)
lnerror =
regopenkey(hkey_local_machine,"System\ControlSet001\Control\Print\Printers\"
+ lcprinter,@lnresult)

If !empty(lnerror)
Wait window "打開註冊鍵值時出錯"
Return .f.
Endif

*-- 獲取印表機資訊
lnerror = regqueryvalueex(lnresult,"Default
DevMode",0,@lntype,@lcbuffer,@lnbuffersize)

If lnerror = 0 and lcbuffer <> chr(0)
devicedata = left(lcbuffer,lnbuffersize)
Else
Wait window "系統中沒有設置默認印表機"
Return .f.
Endif

Endif

*- wait window str(len(devicedata)) && 780 bytes for win2000
*- wait window str(len(devicedata)) && 334 bytes for winme

devicedata1 = devicedata

=strtofile(devicedata,"Default DevMode.txt") && 334 bytes for win9x

lcdata2 = space(512)

lnmax2 = devicecapabilities(lcprinter,lcport,2,@lcdata2,0)

If os = "Win 9x" and at(chr(0) + chr(1),lcdata2) = 0
Wait window '系統默認印表機不支援自定義紙張！'
* Return .f.
Endif

paperstr = iif(lnmax2 > 0,substr(lcdata2,1,lnmax2 * 2),'')
lcdata = space(lnmax2 * 64)

*-- 紙張名列表
lnmax = devicecapabilities(lcprinter,lcport,16,@lcdata,0)
lcdata = alltrim(lcdata)
If os = "Win 9x"
For i = 1 to occurs(chr(0),lcdata)
?alltrim(substr(lcdata,(i-1)*64+1,64)))
Endfor
Else
For i = 1 to alen(acvalueread)
?acvalueread(i)
Endfor

If alen(acvalueread) = occurs(chr(0),lcdata) + 1
Wait window "當前沒有設置自定義紙張"
* Return .f.
Endif

Endif

*-- 顯示原來的默認紙的高和寬，上下左右空格
?hex2dec(49)
&&256 * asc(subst(devicedata,50+nt2000,1)) +
asc(subst(devicedata,49+nt2000,1))
?hex2dec(51)
&&256 * asc(subst(devicedata,52+nt2000,1)) +
asc(subst(devicedata,51+nt2000,1))
?hex2dec(231)
?hex2dec(233)
?hex2dec(235)
?hex2dec(237)

*-- 顯示原來的默認紙張和印表機
listitemid = at(subst(devicedata,47+nt2000,2),paperstr)/2 + 1
?listitemid

If aprinters(gaprinters) > 0
?lcprinter
Else
Wait window '你的系統中沒有安裝印表機.'
Endif

**********************
Procedure Long2Str
**********************
Parameters m.longval
Private i, m.retstr

m.retstr = ""
For i = 24 to 0 step -8
m.retstr = chr(int(m.longval/(2^i))) + m.retstr
m.longval = mod(m.longval, (2^i))
Next
Return m.retstr

**********************
Procedure str2long
**********************
Parameters m.longstr

Private i, m.retval

m.retval = 0
For i = 0 to 24 step 8
m.retval = m.retval + (asc(m.longstr) * (2^i))
m.longstr = right(m.longstr, len(m.longstr) - 1)
Next
Return m.retval

**********************
Procedure hex2dec
**********************
Parameters tnPos
return 256 * asc(subst(devicedata,tnPos + 1 + nt2000,1)) +
asc(subst(devicedata,tnPos+nt2000,1))


**********************
Procedure readreg_multi_sz
**********************
Parameters nkey,csubkey,cvalue
Local
nerrcode,nkeyhandle,lpdwvaluetype,lpbvalue,lpcbvaluesize,lpdwreserved,lnotdo
ne,noccurance,nprevpos,ncurrpos,nelements

nkeyhandle = 0
lpdwreserved = 0
nelements = 0
noccurance = 1
nprevpos = 1
lpdwvaluetype = 7
lnotdone = .t.

nerrcode = regopenkey(nkey, csubkey, @nkeyhandle)
If (nerrcode # 0) then
Return 0
Endif

lpbvalue = ""
lpcbvaluesize = 1
nerrcode=regqueryvalueex(nkeyhandle,cvalue,lpdwreserved,@lpdwvaluetype,@lpbv
alue,@lpcbvaluesize)
lpbvalue = space(lpcbvaluesize)
nerrcode=regqueryvalueex(nkeyhandle, cvalue, lpdwreserved, @lpdwvaluetype,
@lpbvalue, @lpcbvaluesize)

=regclosekey(nkeyhandle)

If (nerrcode # 0) then
Return 0
Endif

Do while lnotdone
ncurrpos = at(chr(0), lpbvalue, noccurance)
If ((ncurrpos > 0) and (ncurrpos < lpcbvaluesize)) then
nelements = nelements + 1
public Dimension acvalueread(nelements)
acvalueread(nelements) = substr(lpbvalue, nprevpos, ncurrpos -
nprevpos)
nprevpos = ncurrpos + 1
noccurance = noccurance + 1
Else
lnotdone = .f.
Endif
Enddo
Return nelements














更改紙張，該示例中用到的變數內容有些是在上一個過程中獲取的

Local lcdevicename,lcoldselect
lcdevicename = devicedata

*-- 設置打印紙的“左空格值” 左空格值是用戶的輸入值
If 左空格值 <> hex2dec(231)
lcdevicename = stuff(lcdevicename,231+thisform.nt2000,2,dec2hex(int(左空
格值)))
Endif

If 右空格值 <> hex2dec(235)
lcdevicename = stuff(lcdevicename,235+nt2000,2,dec2hex(int(右空格值)))
Endif

If 頂空格 <> hex2dec(233)
lcdevicename = stuff(lcdevicename,233+nt2000,2,dec2hex(int(頂空格)))
Endif

If 底空格 <> hex2dec(237)
lcdevicename = stuff(lcdevicename,237+nt2000,2,dec2hex(int(底空格)))
Endif

If "自定義"<>m.cust && 只有自定義紙張可以設置高和寬
lcdevicename = stuff(lcdevicename,49+nt2000,2,dec2hex(報表長度))
lcdevicename = stuff(lcdevicename,51+nt2000,2,dec2hex(報表寬))
Endif

&& 設置用戶選定的紙張爲默認紙張，其中 paperID 是用戶選擇的紙張在紙張列表中的
序號
If paperID > 0 and paperID * 2 <= len(paperstr)
lcdevicename = stuff(lcdevicename,47+nt2000,2,substr(paperstr,paperID *
2 - 1,2))
Endif


*-- 寫註冊表
lnerror = regsetvalueex(thisform.lnresult,'default
devmode',0,0,lcdevicename,len(devicedata))
If lnerror < 0
Wait window '設置時發生錯誤 ！' nowait
Return
Endif


*-- 同時要寫報表文件 .frx
lcoldselect = select(0)

frxfilename = "c:\myreport.frx"

If !file(frxfilename)
Select (lcoldselect)
Wait window '找不到 .frx 報表文件！' nowait
Return
Endif

Use in 0 (frxfilename) alias lcfrxalias

Select lcfrxalias

Go top

i1 = memlines(lcfrxalias.expr)

If i1 = 0
lcstr2 = ;
"DRIVER=winspool"+chr(13)+chr(10)+;
"DEVICE="+lcPrinter + chr(13)+chr(10)+;
"OUTPUT="+lcPort + chr(13)+chr(10)+;
"ORIENTATION=0" + chr(13)+chr(10)+;
"PAPERSIZE=131" + chr(13)+chr(10)+; &&&&&& 請注意這個值，它代表
紙張類型
"PAPERLENGTH=" + alltrim(str(紙長*10)) + chr(13)+chr(10)+;
"PAPERWIDTH=" + alltrim(str(紙寬*10)) + chr(13)+chr(10)+;
"DEFAULTSOURCE=4" + chr(13)+chr(10)+;
"PRINTQUALITY=180" + chr(13)+chr(10)+;
"YRESOLUTION=180" + chr(13)+chr(10)+;
"TTOPTION=1"

Replace in lcfrxalias lcfrxalias.expr with lcstr2

i1 = 11

Endif

Dimension laline(i1)

For i2 = 1 to i1
laline( i2 ) = mline(lcfrxalias.expr,i2)
Endfor

If thisform.cbopaper.listitemid > 0 and thisform.cbopaper.listitemid * 2 <=
len(thisform.paperstr) and "PAPERSIZE"$lcfrxalias.expr
laline(atcline('PAPERSIZE',lcfrxalias.expr)) = 'PAPERSIZE=' +
alltrim(str(asc(substr(paperstr,paperID * 2 -
1,1))+asc(substr(paperstr,paperID * 2,1))*16))
endif

If "DEVICE"$lcfrxalias.expr
laline(atcline('DEVICE',lcfrxalias.expr)) = 'DEVICE=' +
alltrim(lcprinter)
Endif

If "OUTPUT"$lcfrxalias.expr
laline(atcline('OUTPUT',lcfrxalias.expr)) = 'OUTPUT=' + alltrim(lcport)
Endif

If "PAPERLENGTH"$lcfrxalias.expr
laline(atcline('PAPERLENGTH',lcfrxalias.expr)) = 'PAPERLENGTH=' +
alltrim(str(紙長*10))
Endif

If "PAPERWIDTH"$lcfrxalias.expr
laline(atcline('PAPERWIDTH',lcfrxalias.expr)) = 'PAPERWIDTH=' +
alltrim(str(紙寬*10))
Endif

*-- 以下是設置自定義紙張
If "自定義"$this.cbopaper.value and "PAPERSIZE"$lcfrxalias.expr
if thisform.os = "Win 9x"
laline(atcline('PAPERSIZE',lcfrxalias.expr)) = 'PAPERSIZE=256'
else
laline(atcline('PAPERSIZE',lcfrxalias.expr)) = 'PAPERSIZE=131'
endif
Endif

*-- 列印方向
If "ORIENTATION"$lcfrxalias.expr
laline(atcline('ORIENTATION',lcfrxalias.expr)) = 'ORIENTATION=' +
alltrim(str(列印方向-1))
Endif

lcstr = ''

For i2 = 1 to i1
lcstr = lcstr + laline(i2) + chr(13) + chr(10)
Endfor

*-- 改寫 frx 文件
Replace in lcfrxalias lcfrxalias.expr with lcstr

Select lcfrxalias

Pack memo

Use in lcfrxalias

Report form (frxfilename) noconsole

Select (lcoldselect)