VFP 愛用者社區

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

在Visual FoxPro 6中動態修改打印紙張大小
作者：李彤
--------------------------------------------------------------------------------

當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)