VFP 愛用者社區

Ruey · 註冊時間: 2003-03-12 文章: 1698 來自: tunglo 第 1 樓

在Visual FoxPro 6中動態修改打印紙張大小
作者：李彤已閱讀次數：1050

當FoxPro從2.6升級到Visual FoxPro的時候，使用FoxPro的程式師也從面向過程的時代跨入了面向物件的時代。Visual FoxPro可借助工具條、物件、可視控制項來自動完成介面的設計並執行各種任務，同時不犧牲任何資料庫性能。不再只通過代碼來完成任務，新環境讓我們直接圖形化的操作檔、表、物件和類。這是一場多麼偉大的革命啊！但是我們很快發現，它革掉了一個很重要的東西，那就是對印表機的控制。我們失去了對印表機的直接控制能力，只能通過印表機驅動程式間接的使用印表機，就連FoxPro的低級函數Fopen()也只能打開文件和串口，失去了打開並口的能力，更要命的是通過印表機驅動程式在Windows中列印是以頁為單位，打一行字也要走一頁，實在不爽。
怎麼辦呢，我到網上轉了一圈，在Visual FoxPro編程論壇中發現提問最多的問題是列印的問題，其中最多的又是在Windows中印表機送紙以頁為單位的問題，很多用Visual FoxPro編寫超市POS系統的網友，都為無法控制小票的送紙長度而苦惱。雖然在網上沒有找到答案，但也發現了一些線索，有人在以100元的價格兜售一個解決這個問題的軟體，我當了試用版看了一下，發現這個軟體是用Visual FoxPro編寫的，這說明Visual FoxPro有能力解決這個問題。但是100元太貴了如果20元的話我會考慮買一套。通過研究試用版我發現該軟體修改的是印表機的自定義紙的大小，印表機的設置都存在Windows的註冊表裏，雖然修改註冊表是一條比較危險的路，但我必須走下去。
註冊表太大了，我仔細找了很長時間，最後鎖定在“HKEY_LOCAL_MACHINE\ System\CurrentControlSet\Control\Print\Printers\”，在這個鍵下面有我安裝的所有印表機的名字。我試這修改“Epson LQ-1600KII”自定義紙的大小，只有“Default DevMode”的鍵值發生了變化。這個鍵的值很長，如果大家感興趣可以列印出來看，我這裏就省略了。這個鍵的值是以二進位方式存放的，列印出來的是16進制的形式，經過仔細對照發現第48對至第52對發生了變化。進一步研究發現第48對為“01”時印表機是自定義紙，第49對和第50對記錄的是打印紙的長度，第51對和第52對記錄的是打印紙的寬度。如果設置長度為1000時（0.1毫米）第49對為“E8”、第50對為“03”，實際上1000轉換為16進制應該為3E8，這裏反了個（這是幹嗎，不爽！）。我又試了其他幾種又自定義紙的印表機結果相同。好了，現在我們知道了打印紙大小的存放地點，下面可以開始研究如何修改它們了。
Visual FoxPro本身沒有修改註冊表的能力，需要調用Windows的API函數來修改。修改的步驟是這樣的：首先讀取“HKEY_LOCAL_MACHINE\ System\CurrentControlSet\Control\Print\Printers\Default DevMode”的鍵值，由於得到的字串有很多不可顯示字元，所以需要由二進位轉換為16進制，轉換後得到的字串應與在註冊表編輯器（RegEdit.exe）中列印的鍵值一致，然後用16進制表示的打印紙的長度和寬度替換相應位置的字元，最後再由16進制轉換到10進制，轉換為10進制時得到的是應回寫註冊表的字元的ASCII碼，再用CHR（）函數轉換後即可回寫註冊表。到了這裏還不算完，在修改註冊表以後還要修改報表檔。Visual FoxPro 的報表檔實際也是一個表，可以用Use命令打開，欄位Tag2和expr需要做相應更改。在這裏有一點要提醒大家，既然要修改報表檔，那麼報表檔就不能編譯進可執行檔，必須單獨與編譯後的程式一起打包發佈。
我將該程式做成一個函數供大家調用，如果修改成功函數返回.T.，否則是.F.。最困難的是尋找讀取和回寫註冊表二進位鍵值的函數，我在網上查閱了很多資料，沒有發現如何讀取二進位資料的文章，最後是從微軟網站上當了一個讀取文本類型鍵值的函數，經試驗發現當REG_BINARY=1時該函數可以讀取與回寫文本類型的鍵值，REG_BINARY=3時就可以讀取與回寫二進位的鍵值。為了避免不必要的麻煩，我在這個函數中沒有加入設置默認打印紙為自定義紙的功能，請大家創建報表檔時將報表檔設置為自定義紙。我只是在Win98和WinMe中做了測試，請不要在其他作業系統中使用。我沒有嘗試修改沒有自定義紙張設定的印表機，請大家使用之前確認你使用的印表機可以設置自定義紙張。如何調用本文所附的函數有說明，這裏不再贅述。
　
附根源程式：
　
*調用格式：Print_Page(Print_name,Hight,Width)
*Print_name：在註冊表中印表機的名稱，如"Epson LQ-1600KII"、"Epson LQ-300K",必須是字串
*Hight：打印紙的長度，取值範圍依據印表機的範圍，必須是數字
* Epson LQ-1600KII的取值範圍：127--23119（單位：0.1毫米）
*Width：打印紙的寬度，取值範圍依據印表機的範圍，必須是數字
* Epson LQ-1600KII的取值範圍：127--4191（單位：0.1毫米）
　
FUNCTION Print_Page
PARAMETERS Print_Name, _Hight, _Width
　
#DEFINE HKEY_LOCAL_MACHINE -2147483646
　
Local nKey, cSubKey, cValue, cValueRead, lSuccess, cValueToWrite, H_Width, H_Hight
nKey = HKEY_LOCAL_MACHINE
cValue = "Default DevMode"
　
cSubKey = "System\CurrentControlSet\Control\Print\Printers\"+Print_name
H_Width = Iif(Len(Dec10To16Hex(_Width))=3,"0"+Dec10To16Hex(_Width),Dec10To16Hex(_Width))
H_Width = Substr(H_Width,3,2)+Substr(H_Width,1,2) &&取得16進制的寬度值
H_Hight = Iif(Len(Dec10To16Hex(_Hight))=3,"0"+Dec10To16Hex(_Hight),Dec10To16Hex(_Hight))
H_Hight = Substr(H_Hight,3,2)+Substr(H_Hight,1,2) &&取得16進制的長度值
　
cValueRead = ReadREG_SZ(nKey, cSubKey, cValue)
IF (EMPTY(cValueRead)) THEN
Return(.F.) &&讀註冊表錯誤
ELSE
lenght = Len(cValueRead)
cRetValue = Space(0)
For i=1 To lenght
cRetValue = cRetValue+BinaryToChar(Substr(cValueRead,i,1))
EndFor
ENDIF
　
cRetValue = Stuff(cRetValue,93,4,"0001") &&設置默認紙張為自定義紙
cRetValue = Stuff(cRetValue,97,8,H_Hight+H_Width) &&設置紙張的長度為2000,寬度為1000
　
lenght = Len(cRetValue)/2
Binarychar = Space(0)
For k=1 To lenght
Binarychar = Binarychar+Chr(Hex16To10Dec(Substr(cRetValue,(k-1)*2+1,2)))
EndFor
　
cValueToWrite = Binarychar
　
lSuccess = WriteREG_SZ(nKey, cSubKey, cValue, cValueToWrite)
IF (lSuccess) THEN
Return(.T.) &&設置成功
ELSE
Return(.F.) &&設置失敗
ENDIF
Return
　
FUNCTION ReadREG_SZ
* This function reads a REG_SZ value from the registry. If successful,
* it will return the value read. If not successful, it will return an empty string.
PARAMETERS nKey, cSubKey, cValue
* nKey The root key to open. It can be any of the constants defined below.
* #DEFINE HKEY_CLASSES_ROOT -2147483648
* #DEFINE HKEY_CURRENT_USER -2147483647
* #DEFINE HKEY_LOCAL_MACHINE -2147483646
* #DEFINE HKEY_USERS -2147483645
* cSubKey The SubKey to open.
* cValue The value that is going to be read.
　
* Constants that are needed for Registry functions
#DEFINE REG_BINARY 3
　
* WIN 32 API functions that are used
DECLARE Integer RegOpenKey IN Win32API ;
Integer nHKey, String @cSubKey, Integer @nResult
DECLARE Integer RegQueryValueEx IN Win32API ;
Integer nHKey, String lpszValueName, Integer dwReserved,;
Integer @lpdwType, String @lpbData, Integer @lpcbData
DECLARE Integer RegCloseKey IN Win32API Integer nHKey
　
* Local variables used
Local nErrCode && Error Code returned from Registry functions
Local nKeyHandle && Handle to Key that is opened in the Registry
Local lpdwValueType && Type of Value that we are looking for
Local lpbValue && The data stored in the value
Local lpcbValueSize && Size of the variable
Local lpdwReserved && Reserved Must be 0
　
* Initialize the variables
nKeyHandle = 0
lpdwReserved = 0
lpdwValueType = REG_BINARY
lpbValue = ""
　
nErrCode = RegOpenKey(nKey, cSubKey, @nKeyHandle)
* If the error code isn't 0, then the key doesn't exist or can't be opened.
IF (nErrCode # 0) THEN
RETURN ""
ENDIF
　
lpcbValueSize = 1
* Get the size of the data in the value
nErrCode=RegQueryValueEx(nKeyHandle, cValue, lpdwReserved, @lpdwValueType, @lpbValue, @lpcbValueSize)
　
* Make the buffer big enough
lpbValue = SPACE(lpcbValueSize)
nErrCode=RegQueryValueEx(nKeyHandle, cValue, lpdwReserved, @lpdwValueType, @lpbValue, @lpcbValueSize)
　
=RegCloseKey(nKeyHandle)
IF (nErrCode # 0) THEN
RETURN ""
ENDIF
　
lpbValue = LEFT(lpbValue, lpcbValueSize - 1)
RETURN lpbValue
* End of Code
　
　
FUNCTION WriteREG_SZ
* This function writes a REG_SZ value to the registry. If successful,
* its will return .T.. If not successful, it will return .F..
PARAMETERS nKey, cSubKey, cValue, cValueToWrite
* nKey The root key to open. It can be any of the constants defined below
*#DEFINE HKEY_CLASSES_ROOT -2147483648
*#DEFINE HKEY_CURRENT_USER -2147483647
*#DEFINE HKEY_LOCAL_MACHINE -2147483646
*#DEFINE HKEY_USERS -2147483645
* cSubKey The SubKey to open.
* cValueToWrite The value being written to the registry.
　
* Constants that are needed for Registry functions
#DEFINE REG_BINARY 3
　
* WIN 32 API functions that are used
DECLARE Integer RegOpenKey IN Win32API ;
Integer nHKey, String @cSubKey, Integer @nResult
DECLARE Integer RegSetValueEx IN Win32API ;
Integer hKey, String lpszValueName, Integer dwReserved,;
Integer fdwType, String lpbData, Integer cbData
DECLARE Integer RegCloseKey IN Win32API Integer nHKey
　
* Local variables used
Local nErrCode && Error Code returned from Registry functions
Local nKeyHandle && Handle to Key that is opened in the Registry
Local lpdwValueType && Type of Value that we are looking for
Local lpbValue && The data stored in the value
Local lpcbValueSize && Size of the variable
Local lpdwReserved && Reserved Must be 0
　
* Initialize the variables
nKeyHandle = 0
lpdwReserved = 0
lpdwValueType = REG_BINARY
lpbValue = cValueToWrite
　
nErrCode = RegOpenKey(nKey, cSubKey, @nKeyHandle)
* If the error code isn't 0, then the key doesn't exist or can't be opened.
IF (nErrCode # 0) THEN
RETURN .F.
ENDIF
　
lpcbValueSize = LEN(lpbValue) && Store the length of the string
nErrCode=RegSetValueEx(nKeyHandle, cValue, lpdwReserved, lpdwValueType, lpbValue, lpcbValueSize)
　
=RegCloseKey(nKeyHandle)
IF (nErrCode # 0) THEN
RETURN .F.
ENDIF
RETURN .T.
* End of Code
　
　
FUNCTION BinaryToChar
PARAMETERS cchar
Local nint,nmod,char1,char2
ntemp = Int(Asc(cchar)/16)
Store "" To char1,char2
Do Case
Case ntemp = 10
char1 = "a"
Case ntemp = 11
char1 = "b"
Case ntemp = 12
char1 = "c"
Case ntemp = 13
char1 = "d"
Case ntemp = 14
char1 = "e"
Case ntemp = 15
char1="f"
OtherWise
char1 = Str(ntemp,1)
EndCase
nmod = Asc(cchar)-ntemp*16
Do Case
Case nmod = 10
char2 = "a"
Case nmod = 11
char2 = "b"
Case nmod = 12
char2 = "c"
Case nmod = 13
char2 = "d"
Case nmod = 14
char2 = "e"
Case nmod = 15
char2 = "f"
OtherWise
char2 = Str(nmod,1)
EndCase
Return char1+char2
　
　
FUNCTION Hex16To10Dec &&16到十進位
* Converts POSITIVE decimal integers to hex (Char).
* Input: NUMERIC
* Output: CHAR
　
PARAMETER InNum
OutStr = 0
　
For I = 1 To Len(InNum)
OutStr = FindHex(Right(InNum,1))*16^(i-1)+OutStr
InNum = Substr(InNum,1,Len(InNum)-1)
EndFor
　
RETURN(OutStr)
　
FUNCTION FindHex &&16進制到十進位的內部函數
* Lookup table for conversion of alpha hex chars.
* Input: NUMERIC
* Output: VAL
　
PARAMETERS InVal && Integer
Private All Like j*
　
Do Case
Case InVal = "a"
jOutStr = 10
Case InVal = "b"
jOutStr = 11
Case InVal = "c"
jOutStr = 12
Case InVal = "d"
jOutStr = 13
Case InVal = "e"
jOutStr = 14
Case InVal = "f"
jOutStr = 15
OtherWise
jOutStr = Val(InVal)
EndCase
Return(jOutStr)
　
FUNCTION Dec10To16Hex &&十到16進制
* Converts POSITIVE decimal integers to hex (Char).
* Input: NUMERIC
* Output: CHAR
　
PARAMETER InNum
OutStr = Space(0)
　
Do While InNum>0
OutStr = Find16Hex(Mod(InNum,16))+OutStr
InNum = Int(InNum/16)
Enddo
Return(OutStr)
　
FUNCTION Find16Hex &&十到16進制的內部函數
* Lookup table for conversion of alpha hex chars.
* Input: NUMERIC
* Output: CHAR
　
PARAMETERS InVal && Integer
Private All Like j*
　
Do Case
Case InVal = 10
jOutStr = "a"
Case InVal = 11
jOutStr = "b"
Case InVal = 12
jOutStr = "c"
Case InVal = 13
jOutStr = "d"
Case InVal = 14
jOutStr = "e"
Case InVal = 15
jOutStr = "f"
OtherWise
jOutStr = STR(InVal,1,0)
EndCase
Return(jOutStr)

zlz_zb · 註冊時間: 2006-03-20 文章: 11 第 2 樓

您真是高手，太厉害了！！！！！！！

蔡文華 · 註冊時間: 2005-10-31 文章: 118 第 3 樓

[b]我只是在Win98和WinMe中做了測試，請不要在其他作業系統中使用。[/b]

可否研究一下win2000,xp的使用方法呢....??

goto-dream · 註冊時間: 2004-05-11 文章: 909 第 4 樓