VB如何使用API直接操作打印机

    有时出于某种原因，我们需要使用API直接操作打印机，而不是使用Printer对象。在网上这类代码较少，而且功能也不齐全，所以写了这段代码。由于写得匆忙，且没有安装打印，因此差错在所难免，希望朋友们指正。

 Option Explicit '* ************************************************** * '* 程序名称：Demo.bas '* 程序功能：演示VB如何用API操作打印机 '* 作者：lyserver '* 联系方式：http://blog.youkuaiyun.com/lyserver '* ************************************************** * Private Type DOCINFO cbSize As Long lpszDocName As String lpszOutput As String lpszDatatype As String fwType As Long End Type Private Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal H As Long, ByVal W As Long, ByVal E As Long, ByVal O As Long, ByVal W As Long, ByVal I As Long, ByVal u As Long, ByVal S As Long, ByVal C As Long, ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, ByVal PAF As Long, ByVal F As String) As Long Private Const DEFAULT_CHARSET = 1 Private Const OUT_DEFAULT_PRECIS = 0 Private Const CLIP_DEFAULT_PRECIS = 0 Private Const PROOF_QUALITY = 2 Private Const DEFAULT_PITCH = 0 Private Declare Function MulDiv Lib "kernel32" (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long Private Declare Function CreateDC Lib "gdi32.dll" Alias "CreateDCA" (ByVal lpszDriver As String, ByVal lpszDevice As String, ByVal lpszOutput As Long, lpInitData As Any) As Long Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As Long) As Long Private Declare Function StartPage Lib "gdi32.dll" (ByVal hdc As Long) As Long Private Declare Function StartDoc Lib "gdi32.dll" Alias "StartDocA" (ByVal hdc As Long, lpdi As DOCINFO) As Long Private Declare Function EndPage Lib "gdi32.dll" (ByVal hdc As Long) As Long Private Declare Function EndDoc Lib "gdi32.dll" (ByVal hdc As Long) As Long Private Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long Private Const HKEY_CURRENT_USER = &H80000001 Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long ' Note that if you declare the lpData parameter as String, you must pass it By Value. Private Const REG_SZ = 1 ' Unicode nul terminated string Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long Private Const ERROR_SUCCESS = 0& Private Type OSVERSIONINFO dwOSVersionInfoSize As Long dwMajorVersion As Long dwMinorVersion As Long dwBuildNumber As Long dwPlatformId As Long szCSDVersion As String * 128 ' Maintenance string for PSS usage End Type Private Declare Function GetVersion Lib "kernel32" () As Long Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long Private Const VER_PLATFORM_WIN32_WINDOWS = 1 Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long Private Const SM_CXSCREEN = 0 Private Const SM_CYSCREEN = 1 Private Declare Function SetMapMode Lib "gdi32" (ByVal hdc As Long, ByVal nMapMode As Long) As Long Private Const MM_ANISOTROPIC = 8 Private Declare Function SetWindowExtEx Lib "gdi32" (ByVal hdc As Long, ByVal nX As Long, ByVal nY As Long, ByVal lpSize As Long) As Long Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long Private Const LOGPIXELSX = 88 ' Logical pixels/inch in X Private Const LOGPIXELSY = 90 ' Logical pixels/inch in Y Private Declare Function SetViewportExtEx Lib "gdi32" (ByVal hdc As Long, ByVal nX As Long, ByVal nY As Long, ByVal lpSize As Long) As Long Sub Main() '获得操作系统版本号 Dim ovi As OSVERSIONINFO GetVersionEx ovi '获得默认打印机 Dim dwSize As Long Dim strBuffer As String, PrinterName As String, DriverName As String, PortName As String dwSize = 255 strBuffer = String(dwSize, vbNullChar) If ovi.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then 'WIN16 GetProfileString "windows", "device", "", strBuffer, dwSize Else 'WIN32 Dim hKey As Long, dwType As Long RegOpenKey HKEY_CURRENT_USER, "Software/Microsoft/Windows NT/CurrentVersion/Windows", hKey dwType = REG_SZ RegQueryValueEx hKey, "Device", 0, dwType, ByVal strBuffer, dwSize RegCloseKey hKey End If Dim strArray() As String strArray = Split(Left(strBuffer, InStr(strBuffer, vbNullChar) - 1), ",") PrinterName = strArray(0) DriverName = strArray(1) PortName = strArray(2) '创建打印机DC Dim hPrinterDC As Long hPrinterDC = CreateDC(DriverName, PrinterName, 0, ByVal 0&) '创建一个24像素大小的字体 Dim hDesktopDC As Long Dim hFont As Long, hOldFont As Long hDesktopDC = GetDC(0) hFont = CreateFont(-MulDiv(24, GetDeviceCaps(hDesktopDC, LOGPIXELSY), 72), 0, 0, 0, 0, 0, 0, 0, DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, PROOF_QUALITY, DEFAULT_PITCH, "楷体_GB2312") ReleaseDC 0, hDesktopDC '将字体选入打印机DC hOldFont = SelectObject(hPrinterDC, hFont) '调整打印机与屏幕分辨率 Dim x As Long, y As Long Dim xLogPixperInch As Long, yLogPixPerInch As Long Dim xExt As Long, yExt As Long x = GetSystemMetrics(SM_CXSCREEN) y = GetSystemMetrics(SM_CYSCREEN) SetMapMode hPrinterDC, MM_ANISOTROPIC '转换坐标映射方式 SetWindowExtEx hPrinterDC, x, y, ByVal 0& '确定窗口大小 xLogPixperInch = GetDeviceCaps(hPrinterDC, LOGPIXELSX) yLogPixPerInch = GetDeviceCaps(hPrinterDC, LOGPIXELSY) xExt = x * xLogPixperInch / 96 '得到设备坐标和逻辑坐标的比例 yExt = y * yLogPixPerInch / 96 SetViewportExtEx hPrinterDC, xExt, yExt, 0 '确定视口大小 '开始打印 Dim di As DOCINFO StartDoc hPrinterDC, di '进纸 StartPage hPrinterDC '打印一个字符串 strBuffer = "我爱你中国！" TextOut hPrinterDC, 10, 10, strBuffer, LenB(StrConv(strBuffer, vbFromUnicode)) '退纸 EndPage hPrinterDC '结束打印 EndDoc hPrinterDC '还原打印机DC中的字体 SelectObject hPrinterDC, hOldFont '删除创建的字体 DeleteObject hFont '删除打印机DC DeleteDC hPrinterDC End Sub