print_page.prg

不错的用电管理系统,用VFP6.0做的.大家可以下来看看哦

   
   *调用格式：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：打印的报表文件名称，必须带后缀，必须是字符串

FUNCTION Print_Page

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)