13358.html
来自「以电子书的形式收集了VB一些常见问题解决方法,可以很方便的查找自己需要解决的问题」· HTML 代码 · 共 26 行
HTML
26 行
<html>
<head>
<title>改变Printer 之印列设定,有解了(附 API)</title>
</head>
<body bgcolor="#FFFFFF" vlink="#808080">
<center>
<h1>改变Printer 之印列设定,有解了(附 API)</h1>
</center>
<hr size=7 width=75%>
<hr size=7 width=75%><p>
Posted by <a href="mailto:hslee@joymail.com">资源分享</a> on May 25, 1999 at 12:38:51:<p>
使用 Data Report 时被 Printer 困扰已久,后来乾脆观察 windows 的<br>注册档变化,写出符合公司需求之 API(可改变印列方向,纸张大小,还原 等),<br>但只符合公司需求.<p> 近日于国外讨论园地发现程式码,为微软之 MCP 所张贴,分享大家<p>'---- 以下原文照刊<br>This is a problem when we work with with data report (VB6). We must use some API functions to deal with this problem.<br>The code below is not test on all printer, if you find any error or bug, please sent to me.<br>The using of this code is easy, just call "Call SetOrientation(vbPRORLandscape) " before to show the report and call "Call SetOrientation(vbPRORPortrait)" after closing the report to restore the previous setting of printer.<br>Please feel free to modify this code to make it satisfy your need. You can make it to print on A3 paper size or do much as well . . .<p>Bye and good luck to you.<br>Huynh Quang Cuong<br>MCP<br>===================================<br>Paste the following code into a module.<br>(请加入以下程式码于"模组"内)<br>'-----------------------------<br>Option Explicit<p>Private Const CCHDEVICENAME = 32<br>Private Const CCHFORMNAME = 32<p>Private Const STANDARD_RIGHTS_REQUIRED = &HF0000<br>Private Const PRINTER_ACCESS_ADMINISTER = &H4<br>Private Const PRINTER_ACCESS_USE = &H8<br>Private Const PRINTER_ALL_ACCESS = _<br> (STANDARD_RIGHTS_REQUIRED Or _<br> PRINTER_ACCESS_ADMINISTER Or _<br> PRINTER_ACCESS_USE)<p>Private Const DM_MODIFY = 8<br>Private Const DM_IN_BUFFER = DM_MODIFY<br>Private Const DM_COPY = 2<br>Private Const DM_OUT_BUFFER = DM_COPY<br>Private Const DMORIENT_PORTRAIT = 1<br>Private Const DMORIENT_LANDSCAPE = 2<br>Private Const DM_ORIENTATION = &H1<p>Private Type DEVMODE<br> dmDeviceName As String * CCHDEVICENAME<br> dmSpecVersion As Integer<br> dmDriverVersion As Integer<br> dmSize As Integer<br> dmDriverExtra As Integer<br> dmFields As Long<br> dmOrientation As Integer<br> dmPaperSize As Integer<br> dmPaperLength As Integer<br> dmPaperWidth As Integer<br> dmScale As Integer<br> dmCopies As Integer<br> dmDefaultSource As Integer<br> dmPrintQuality As Integer<br> dmColor As Integer<br> dmDuplex As Integer<br> dmYResolution As Integer<br> dmTTOption As Integer<br> dmCollate As Integer<br> dmFormName As String * CCHFORMNAME<br> dmLogPixels As Integer<br> dmBitsPerPel As Long<br> dmPelsWidth As Long<br> dmPelsHeight As Long<br> dmDisplayFlags As Long<br> dmDisplayFrequency As Long<br> dmICMMethod As Long<br> dmICMIntent As Long<br> dmMediaType As Long<br> dmDitherType As Long<br> dmReserved1 As Long<br> dmReserved2 As Long<br>End Type<p>Private Type PRINTER_DEFAULTS<br> pDatatype As String<br> pDevMode As Long<br> DesiredAccess As Long<br>End Type<p>Private Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" _<br> (ByVal pPrinterName As String, phPrinter As Long, pDefault _<br> As PRINTER_DEFAULTS) As Long<br>Private Declare Function SetPrinter Lib "winspool.drv" Alias "SetPrinterA" _<br> (ByVal hPrinter As Long, ByVal Level As Long, pPrinter As Any, _<br> ByVal Command As Long) As Long<br>Private Declare Function GetPrinter Lib "winspool.drv" Alias "GetPrinterA" _<br> (ByVal hPrinter As Long, ByVal Level As Long, pPrinter As Any, _<br> ByVal cbBuf As Long, pcbNeeded As Long) As Long<br>Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _<br> (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)<br>Private Declare Function ClosePrinter Lib "winspool.drv" _<br> (ByValhPrinter As Long) As Long<p>Private Declare Function DocumentProperties Lib "winspool.drv" Alias _<br> "DocumentPropertiesA" (ByVal hwnd As Long, ByVal hPrinter As Long, _<br> ByVal pDeviceName As String, ByVal pDevModeOutput As Any, _<br> ByVal pDevModeInput As Any, ByVal fMode As Long) As Long<p>Public Sub SetOrientation(NewOrientation As Long)<br> Dim PrinterHandle As Long<br> Dim PrinterName As String<br> Dim pd As PRINTER_DEFAULTS<br> Dim lpDevMode As DEVMODE<br> Dim Result As Long<br> Dim Needed As Long<br> Dim pFullDevMode As Long<br> Dim pi2_buffer() As Long<p> On Error GoTo errHandle<br> PrinterName = Printer.DeviceName<br> If PrinterName = "" Then Exit Sub<p> pd.pDatatype = vbNullString<br> pd.pDevMode = 0&<br> pd.DesiredAccess = PRINTER_ALL_ACCESS<p> Result = OpenPrinter(PrinterName, PrinterHandle, pd)<br> Result = GetPrinter(PrinterHandle, 2, ByVal 0&, 0, Needed)<br> ReDim pi2_buffer((Needed \ 4))<br> Result = GetPrinter(PrinterHandle, 2, pi2_buffer(0), Needed, Needed)<p> pFullDevMode = pi2_buffer(7)<p> Call CopyMemory(lpDevMode, ByVal pFullDevMode, Len(lpDevMode))<p> '-------- 以下为适宜自行更改部份<br> lpDevMode.dmOrientation = NewOrientation<br> lpDevMode.dmFields = DM_ORIENTATION<br> '------------------------------<p> Call CopyMemory(ByVal pFullDevMode, lpDevMode, Len(lpDevMode))<p> Result = DocumentProperties(0, PrinterHandle, PrinterName, ByVal _<br> pFullDevMode, ByVal pFullDevMode, DM_IN_BUFFER Or DM_OUT_BUFFER)<p> Result = SetPrinter(PrinterHandle, 2, pi2_buffer(0), 0&)<p> Call ClosePrinter(PrinterHandle)<p> Dim p As Printer<br> For Each p In Printers<br> If p.DeviceName = PrinterName Then<br> Set Printer = p<br> Exit For<br> End If<br> Next p<br> Printer.Orientation = lpDevMode.dmOrientation<br> Exit Sub<p>errHandle:<br> '--- Your Error Handle Here<br>End Sub<br>
<br>
<br><hr size=7 width=75%><p>
<a name="followups">Follow Ups:</a><br>
<ul><!--insert: 13358-->
<!--top: 13397--><li><a href="13397.html">Re: 改变Printer 之印列设定,有解了(附 API)</a> <b>Mark</b> <i>08:45:48 5/26/99</i>
(<!--responses: 13397-->0)
<ul><!--insert: 13397-->
</ul><!--end: 13397-->
</ul><!--end: 13358-->
<br><hr size=7 width=75%><p>
</body></html>
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?