|
VFP 愛用者社區 本討論區為 Visual Foxpro 愛用者經驗交流的地方, 請多多利用"搜尋"的功能, 先查看看有無前例可循, 如果還有不懂的再發問. 部份主題有附加檔案, 須先註冊成為社區居民才可以下載.
|
上一篇主題 :: 下一篇主題 |
發表人 |
內容 |
Ruey
註冊時間: 2003-03-12 文章: 1698 來自: tunglo
第 1 樓
|
發表於: 星期四 十一月 20, 2003 10:30 am 文章主題: 報表精華--獲取印表機資訊及可用紙張(轉貼) |
|
|
要想得到系統可用的字體,用 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) _________________ #############################
快樂媽咪系列幸福宅配,喝十全雞湯~原來幸福那麼簡單!!
學會VFP使用者社區的搜尋,Code才會更有趣~
############################# |
|
回頂端 |
|
|
|
|
您 無法 在這個版面發表文章 您 無法 在這個版面回覆文章 您 無法 在這個版面編輯文章 您 無法 在這個版面刪除文章 您 無法 在這個版面進行投票 您 無法 在這個版面附加檔案 您 無法 在這個版面下載檔案
|
|