VFP 愛用者社區 :: 觀看文章 - 檢查並自動建立印表機自定紙張尺寸 OO

VFP 愛用者社區
本討論區為 Visual Foxpro 愛用者經驗交流的地方, 請多多利用"搜尋"的功能, 先查看看有無前例可循, 如果還有不懂的再發問. 部份主題有附加檔案, 須先註冊成為社區居民才可以下載.

常見問題

搜尋

會員列表

會員群組

會員註冊

個人資料

登入檢查您的私人訊息

登入

檢查並自動建立印表機自定紙張尺寸 OO

VFP 愛用者社區首頁 -> VFP 討論區

發表人

內容

garfield
Site Admin

註冊時間: 2003-01-30
文章: 2160

第 1 樓

發表於: 星期三四月 19, 2006 11:46 am 文章主題: 檢查並自動建立印表機自定紙張尺寸 OO

在網路中找到的資料, 覺得原始程式看起來很複雜, 對於初學者而言太難理解, 將它寫成副程式, 直接拿來用就好了.
希望能幫助到一些人 ^^

代碼:

*****************************************************
**** 印表機紙張控制, 自定紙張, 可?#93;定紙張大小及邊界
* 範例
* oprn = createobject('prncontrol')
* ? oprn.chkpaper('中一刀' )    &&--如果有建立"中一刀"這個尺寸名稱就傳回 .T. , 尺寸在 .papersizewidth 及 .papersizeheight , 以英吋為主
*大小寫一定要相同
* oprn.addpaper('中一刀',8.5,5.5 )    &&--預定建立的尺寸名稱,英吋寬,英吋長
* oprn.addpaper('12inch',8.5,12,1,2,3,4)    &&--1,2,3,4 各為左右上下
* oprn.delpaper('中一刀' )    &&--預定建立的尺寸名稱,英吋寬,英吋長
* 可以用 regedit 到 localmachine\SYSTEM\CurrentControlSet\Control\Print\Forms 看到新增的資料

Define Class prncontrol As Custom
* 點�}式印表機的�]計本來就是依英吋為主要規格
* oo菜鳥改寫者: garfield
papersizewidth = 8.5
papersizeheight = 5.5
inchtomm = 25.4

oheap = ''
hPrinter=0
nSize=0
aFI1=Space(32)
BytesNeeded=0
NumForms=0
AddForm=0

DIMENSION prnlist[1,2]
DIMENSION paperlist[1]
lcprinter = ""
lcport = ""

Procedure Init
   Declare Integer OpenPrinter In WinSpool.Drv As WS_OpenPrinter ;
      String pPrinterName, ;
      Integer @phPrinter, ;
      String pDefault

   Declare Integer DocumentProperties In WinSpool.Drv ;
      Integer, ;
      Integer, ;
      String, ;
      String, ;
      String, ;
      Integer

   Declare Integer ClosePrinter In WinSpool.Drv As WS_ClosePrinter ;
      Integer hPrinter

   Declare Integer EnumForms In WinSpool.Drv ;
      Integer, ;
      Integer, ;
      String @, ;
      Integer , ;
      Integer @, ;
      Integer @

   Declare Integer AddForm In WinSpool.Drv ;
      Integer, ;
      Integer, ;
      String

   Declare Integer DeleteForm In WinSpool.Drv ;
      Integer, ;
      String

   Declare Long CreateDC In gdi32.Dll ;
      STRING @cDriver, ;
      STRING @cDevice, ;
      STRING cOutput, ;
      STRING cInitData

   Declare Long DeleteDC In gdi32.Dll ;

   Declare Long ResetDC In gdi32.Dll ;
      Integer, ;
      String

   Declare Integer lstrcpy In kernel32.Dll ;
      STRING @lpString1, Integer lpString2

   Declare Integer GetForm In WinSpool.drv ;
      INTEGER,;
      String, ;
      INTEGER,;
      String, ;
      INTEGER,;
      INTEGER

   Declare Integer SetForm In WinSpool.drv ;
      INTEGER,;
      String,;
      Integer,;
      String

   APRINTERS(this.prnlist)
   this.lcprinter = this.prnlist[1,1]

   this.oheap = Createobj("Heap")

   this.paperdata( )

ENDPROC
PROCEDURE paperdata
*susp
   mhPrinter=0
   mNumForms=0
   mBytesNeeded=0
   If WS_OpenPrinter(this.lcprinter , @mhPrinter, 0) <> 0
      NS=REPLICATE(CHR(0), 32)
      RetVal = EnumForms(mhPrinter, 1, @NS, 0, @mBytesNeeded, @mNumForms)
*? RetVal
      bc=mBytesNeeded
*? 'bc=',bc
      mTemp=REPLICATE(CHR(0), bc)
      RetVal = EnumForms(mhPrinter, 1, @mTemp, bc , @mBytesNeeded, @mNumForms)
*? RetVal
      Temp = REPLICATE(CHR(0), bc)

      Declare RtlMoveMemory IN kernel32 As CopyMemory;
         STRING @ Destination,;
         STRING Source,;
         INTEGER nLength

      CopyMemory(@Temp,mTemp,bc)

      DIMENSION this.paperlist[mNumForms,3]

*wait
      For I = 1 To mNumForms
         sn = (I - 1) * 32 + 1
         sn = substr(Temp,sn,32)
         sTemp = Space(512)
         ss = substr(sn,5,4)
         x = 0
         = lstrcpy(@sTemp, this.LONGTONUM(ss))
*? i,Chr(0)$sTemp,ss,this.LONGTONUM(ss),stemp
         If !Chr(0)$sTemp
            PtrCtoVbString = ""
         Else
            this.paperlist[i,1] = alltrim(Left(sTemp, at(Chr(0),sTemp)-1))
            this.paperlist[i,2] = this.LONGTONUM(substr(sn, 9,4))/1000    &&-- mm
            this.paperlist[i,3] = this.LONGTONUM(substr(sn,13,4))/1000    &&-- mm
         Endif
      Next

   Else
      Wait window "無法取得印表機紙張資訊"
   Endif

   =WS_ClosePrinter(mhPrinter)

ENDPROC
PROCEDURE longtonum
   Lparameter TCLONG
   Declare RtlMoveMemory IN WIN32API AS RtlCopyLong ;
      INTEGER @ DestNum, ;
      STRING @ pVoidSource, ;
      INTEGER nLength
   Local NNUM
   NNUM = 0
   =RTLCOPYLONG(@NNUM, TCLONG, 4)
   Return NNUM
ENDPROC
Procedure NumtoDword
   Lparameter TNNUM
   Declare RtlMoveMemory IN WIN32API AS RtlCopyLong ;
      STRING @pDestString, ;
      INTEGER @pVoidSource, ;
      INTEGER nLength
   Local CSTRING
   CSTRING = SPACE(4)
   =RTLCOPYLONG(@CSTRING, BITOR(TNNUM,0), 4)
   Return CSTRING
ENDPROC

Procedure addpaper
   LPARAMETERS mname , mwidth , mheight, mleft , mright , mtop, mbotton
   IF TYPE('mleft')#'N'
      mleft=0
   ENDIF
   IF TYPE('mright')#'N'
      mright=0
   ENDIF
   IF TYPE('mtop')#'N'
      mtop = 0
   ENDIF
   IF TYPE('mbotton')#'N'
      mbotton=0
   endif
   LOCAL mret
   mret = .f.
   mhPrinter = 0
   mBytesNeeded=0
   If EMPTY(mname) OR mwidth<=0 OR mheight<=0
      WAIT windows '紙張資料有問題, 無法建立紙張資料' nowait
   else
      If WS_OpenPrinter(this.lcprinter, @mhPrinter, 0) <> 0
         FormName=alltrim(mname)+Chr(0)+Chr(0)
         NSTRINGBASE = this.OHEAP.ALLOCBLOB(FormName)
         RetVal = AddForm(mhPrinter,1,this.NUMTODWORD(0)+this.NUMTODWORD(NSTRINGBASE)+;
            this.NUMTODWORD(mwidth*this.inchtomm*1000)+this.NUMTODWORD(mheight*this.inchtomm*1000)+;
            this.NUMTODWORD(mleft*this.inchtomm*1000)+this.NUMTODWORD(mtop*this.inchtomm*1000)+;
            this.NUMTODWORD((mwidth-mright)*this.inchtomm*1000)+this.NUMTODWORD((mheight-mbotton)*this.inchtomm*1000))

**//             this.NUMTODWORD(mwidth*this.inchtomm*1000)+this.NUMTODWORD(mheight*this.inchtomm*1000)
         =WS_ClosePrinter(mhPrinter)
         If RetVal = 0 Then
            Messagebox("無法?#93;定紙張 !")
         ELSE
            this.paperdata()
            *經實測經驗, 須執行兩次才能正常抓出paper資料
            this.paperdata()
            mret = .t.
         Endif
      Else
         Wait window "無法取得印表機紙張資訊"
      Endif
   ENDIF
   RETURN mret
Endproc

Procedure delpaper
   LPARAMETERS mname
   *大小寫一定要相同
   LOCAL mret
   mret = .f.
   mhPrinter = 0
   mBytesNeeded=0
   If WS_OpenPrinter(this.lcprinter, @mhPrinter, 0) <> 0
      papername= mname
      RetVal = DeleteForm(mhPrinter,papername)
      =WS_ClosePrinter(mhPrinter)
      If RetVal = 0 Then
         Messagebox("無法刪除紙張資料 !")
      Else
         this.paperdata()
      Endif

   Else
      Wait window "無法取得印表機紙張資訊"
   Endif
   RETURN mret
Endproc

Procedure chkpaper
   LPARAMETERS mname
   *大小寫一定要相同
   LOCAL i, mret
   i = ASCAN( this.paperlist , mname)
   IF i>0
      mret = .t.
      i = (i+2) /3
      this.papersizewidth= this.paperlist[i,2]/ this.inchtomm
      this.papersizeheight= this.paperlist[i,3]/ this.inchtomm
   ELSE
      mret = .f.
      this.papersizewidth= 0
      this.papersizeheight= 0
   endif
   RETURN mret
Endproc

Procedure Destroy
Endproc
Enddefine

**************
Define Class HEAP As Custom
Protected INHANDLE, INNUMALLOCSACTIVE,IAALLOCS[1,3]
INHANDLE = Null
INNUMALLOCSACTIVE = 0
IAALLOCS = Null
Name = "heap"

Procedure ALLOC
Lparameter nSize
Declare Integer HeapAlloc In WIN32API As HAlloc Integer hHeap, Integer dwFlags, Integer dwBytes
Declare Integer HeapSize In WIN32API As HSize Integer hHeap, Integer dwFlags, Integer lpcMem
Local NPTR
With This
   NPTR = HAlloc(.INHANDLE, 0, @nSize)
   If NPTR # 0
      .INNUMALLOCSACTIVE = .INNUMALLOCSACTIVE + 1
      Dimension .IAALLOCS[.inNumAllocsActive,3]
      .IAALLOCS[.inNumAllocsActive,1] = NPTR
      .IAALLOCS[.inNumAllocsActive,2] = HSize(.INHANDLE, 0, NPTR)
      .IAALLOCS[.inNumAllocsActive,3] = .T.
   Else
      NPTR = Null
   Endif
Endwith
Return NPTR
Endproc

Function ALLOCBLOB
Lparameter CBSTRINGTOCOPY
Local NALLOCPTR
With This
   NALLOCPTR = .ALLOC(Len(CBSTRINGTOCOPY))
   If ! Isnull(NALLOCPTR)
      .COPYTO(NALLOCPTR,CBSTRINGTOCOPY)
   Endif
Endwith
Return NALLOCPTR
Endfunc

Function ALLOCSTRING
Lparameter CSTRING
Return This.ALLOCBLOB(CSTRING + Chr(0))
Endfunc

Function ALLOCINITAS
Lparameter NSIZEOFBUFFER, NBYTEVALUE
If Type("nByteValue") # "N" Or ! Between(NBYTEVALUE,0,255)
   NBYTEVALUE = 0
Endif
Return This.ALLOCBLOB(Replicate(Chr(NBYTEVALUE),NSIZEOFBUFFER))
Endfunc

Procedure DEALLOC
Lparameter NPTR
Declare Integer HeapFree In WIN32API As HFree ;
   INTEGER hHeap, ;
   INTEGER dwFlags, ;
   INTEGER lpMem
Local NCTR
NCTR = Null
With This
   NCTR = .FINDALLOCID(NPTR)
   If ! Isnull(NCTR)
      =HFree(.INHANDLE, 0, NPTR)
      .IAALLOCS[nCtr,3] = .F.
   Endif
Endwith
Return ! Isnull(NCTR)
Endproc

Procedure COPYTO
Lparameter NPTR, CSOURCE
Declare RtlMoveMemory In WIN32API As RtlCopy ;
   INTEGER nDestBuffer, ;
   STRING @pVoidSource, ;
   INTEGER nLength
Local NCTR
NCTR = Null
If Type("nPtr") = "N" And Type("cSource") $ "CM" ;
      AND ! (Isnull(NPTR) Or Isnull(CSOURCE))
   With This
      NCTR = .FINDALLOCID(NPTR)
      If ! Isnull(NCTR)
         =RtlCopy((.IAALLOCS[nCtr,1]), ;
            CSOURCE, ;
            MIN(Len(CSOURCE),.IAALLOCS[nCtr,2]))
      Endif
   Endwith
Endif
Return ! Isnull(NCTR)
Endproc

Procedure COPYFROM
Lparameter NPTR
Declare RtlMoveMemory In WIN32API As RtlCopy ;
   STRING @DestBuffer, ;
   INTEGER pVoidSource, ;
   INTEGER nLength
Local NCTR, UBUFFER
UBUFFER = Null
NCTR = Null
If Type("nPtr") = "N" And ! Isnull(NPTR)
   With This
      NCTR = .FINDALLOCID(NPTR)
      If ! Isnull(NCTR)
         UBUFFER = Repl(Chr(0),.IAALLOCS[nCtr,2])
         =RtlCopy(@UBUFFER, ;
            (.IAALLOCS[nCtr,1]), ;
            (.IAALLOCS[nCtr,2]))
      Endif
   Endwith
Endif
Return UBUFFER
Endproc

Protected Function FINDALLOCID
   Lparameter NPTR
   Local NCTR
   With This
      For NCTR = 1 To .INNUMALLOCSACTIVE
         If .IAALLOCS[nCtr,1] = NPTR And .IAALLOCS[nCtr,3]
            Exit
         Endif
      Endfor
      Return Iif(NCTR <= .INNUMALLOCSACTIVE,NCTR,Null)
   Endwith
   Endproc

Procedure SIZEOFBLOCK
Lparameters NPTR
Local NCTR, NSIZEOFBLOCK
NSIZEOFBLOCK = Null
With This
   NCTR = .FINDALLOCID(NPTR)
   Return Iif(Isnull(NCTR),Null,.IAALLOCS[nCtr,2])
Endwith
Endproc

Procedure Destroy
Declare HeapDestroy In WIN32API As HDestroy ;
   INTEGER hHeap

Local NCTR
With This
   For NCTR = 1 To .INNUMALLOCSACTIVE
      If .IAALLOCS[nCtr,3]
         .DEALLOC(.IAALLOCS[nCtr,1])
      Endif
   Endfor
   HDestroy[.inHandle]
Endwith
DoDefault()
Endproc

Procedure Init
Declare Integer HeapCreate In WIN32API As HCreate ;
   INTEGER dwOptions, ;
   INTEGER dwInitialSize, ;
   INTEGER dwMaxSize
#Define SWAPFILEPAGESIZE 4096
#Define BLOCKALLOCSIZE 2 * SWAPFILEPAGESIZE
With This
   .INHANDLE = HCreate(0, BLOCKALLOCSIZE, 0)
   Dimension .IAALLOCS[1,3]
   .IAALLOCS[1,1] = 0
   .IAALLOCS[1,2] = 0
   .IAALLOCS[1,3] = .F.
   .INNUMALLOCSACTIVE = 0
Endwith
Return (This.INHANDLE # 0)
Endproc

ENDDEFINE

_________________
利用>>搜尋<<的功能會比問的還要快得到答案.

回頂端

jepp

註冊時間: 2006-03-03
文章: 30

第 2 樓

發表於: 星期六四月 29, 2006 5:49 pm 文章主題:

請問一下，我把程式碼貼到 .PRG 執行試了一下，為什麼只會出現 "無法?#93;定紙張 !" 。是否有什麼細節須要注意的?

回頂端

garfield
Site Admin

註冊時間: 2003-01-30
文章: 2160

第 3 樓

發表於: 星期六四月 29, 2006 10:16 pm 文章主題:

不可重複執行, 應該用 chkpaper 檢查是否已經建立過紙張尺寸邊界不可設定太大. 可能不適用於 win98 / winme (沒試過) _________________ 利用>>搜尋<<的功能會比問的還要快得到答案.

回頂端

kojanlai0823

註冊時間: 2011-12-02
文章: 74

第 4 樓

發表於: 星期五十二月 02, 2011 3:25 pm 文章主題:

這段程式我用在WIN7上..怎麼都改不過去> <

回頂端

garfield
Site Admin

註冊時間: 2003-01-30
文章: 2160

第 5 樓

發表於: 星期五十二月 02, 2011 6:36 pm 文章主題:

如果不是驅動程式的問題, 可先參考 http://vfp.sunyear.com.tw/viewtopic.php?t=5735 _________________ 利用>>搜尋<<的功能會比問的還要快得到答案.

回頂端

kojanlai0823

註冊時間: 2011-12-02
文章: 74

第 6 樓

發表於: 星期三十二月 28, 2011 5:58 pm 文章主題: 共用印表機LPT

這個API可以寫入紙張格式.. 但如果是分享出來的印表機則無法改變紙張大小.. 這著實讓我頭大.. 還是分享出的印表機需做什麼樣的權限分享嗎??

回頂端

從之前的文章開始顯示:

	VFP 愛用者社區首頁 -> VFP 討論區	所有的時間均為台北時間 (GMT + 8 小時)
第1頁(共1頁)

您無法在這個版面發表文章
您無法在這個版面回覆文章
您無法在這個版面編輯文章
您無法在這個版面刪除文章
您無法在這個版面進行投票
您無法在這個版面附加檔案
您無法在這個版面下載檔案