📄 myfunc.prg
字号:
FUNCTION Print_Page
*调用格式：Print_Page(Print_name,Hight,Width,_File)
*Print_name：在注册表中打印机的名称，如"Epson LQ-1600KII"、"Epson LQ-300K",必须是字符串
* 必须保证打印机可以设置“自定义”打印纸
*Hight：打印纸的长度，取值范围依据打印机的范围，必须是数字
* Epson LQ-1600KII的取值范围：127--23119（单位：0.1毫米）
*Width：打印纸的宽度，取值范围依据打印机的范围，必须是数字
* Epson LQ-1600KII的取值范围：127--4191（单位：0.1毫米）
*_File：打印的报表文件名称，必须带后缀，必须是字符串
PARAMETERS Print_Name, _Hight, _Width, _File
#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), ;
Iif(Len(Dec10To16Hex(_Width))=2,"00"+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), ;
Iif(Len(Dec10To16Hex(_Hight))=2,"00"+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,95,4,"01") &&设置默认纸张为自定义纸
cRetValue = Stuff(cRetValue,97,8,H_Hight+H_Width) &&设置纸张的长度,宽度
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
_gz=Select(1)
Select (_gz)
Use (_file) &&在最高工作区打开报表文件
Go 1
_memo=expr
t1=1
i=1
Do While .T.
t2=Atc(chr(13),_memo,i)
If t2=0
exit
Endif
dime ss_text[i]
ss_text[i]=Substr(_memo,t1,t2-t1)
t1=t2+1
i=i+1
Enddo
t1=Alen(ss_text,1)
For p=1 to t1
If At("PAPERLENGTH=",ss_text[p])>0
ss_text[p]="PAPERLENGTH="+Alltrim(Str(_Hight))
Endif
If At("PAPERWIDTH=",ss_text[p])>0
ss_text[p]="PAPERWIDTH="+Alltrim(Str(_Width))
Endif
EndFor
_memo=""
For p=1 To t1
_memo=_memo+ss_text[p]+Chr(13)
EndFor
Replace Tag2 With cValueToWrite,Expr With _memo &&改写报表文件相应的值
Use
lSuccess = WriteREG_SZ(nKey, cSubKey, cValue, cValueToWrite)
IF (lSuccess) THEN
Return(.T.) &&设置成功返回.T.
ELSE
Return(.F.) &&设置失败返回.F.
ENDIF
Return
FUNCTION ReadREG_SZ
PARAMETERS nKey, cSubKey, cValue
#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, nKeyHandle, lpdwValueType, lpbValue, lpcbValueSize, lpdwReserved
* 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
PARAMETERS nKey, cSubKey, cValue, cValueToWrite
#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, nKeyHandle, lpdwValueType, lpbValue, lpcbValueSize, lpdwReserved
* 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 &&二进制转换成16进制
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)
DECLARE INTEGER CloseHandle IN kernel32 INTEGER hObject
PROCEDURE gethardinfo
#Define FILE_CASE_SENSITIVE_SEARCH 1
#Define FILE_CASE_PRESERVED_NAMES 2
#Define FILE_UNICODE_ON_DISK 4
#Define FILE_PERSISTENT_ACLS 8
#Define FILE_FILE_COMPRESSION 16
#Define FILE_VOLUME_IS_COMPRESSED 32768 && &H8000
Declare INTEGER GetLastError IN kernel32
Declare SHORT GetVolumeInformation IN kernel32;
STRING lpRootPathName,;
STRING @ lpVolumeNameBuffer,;
INTEGER nVolumeNameSize,;
INTEGER @ lpVolumeSerialNumber,;
INTEGER @ lpMaximumComponentLength,;
INTEGER @ lpFlags,;
STRING @ lpFileSystemNameBuffer,;
INTEGER nFileSystemNameSize
retu
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -