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

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

 Option Explicit'* ************************************************** *'* 程序名称：Demo.bas'* 程序功能：演示VB如何用API操作打印机'* 作者：lyserver'* 联系方式：http://blog.csdn.net/lyserver'* ************************************************** *Private Type DOCINFO cbSize As Long lpszDocName As String lpszOutput As String lpszDatatype As String fwType As LongEnd TypePrivate 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 LongPrivate Const DEFAULT_CHARSET = 1Private Const OUT_DEFAULT_PRECIS = 0Private Const CLIP_DEFAULT_PRECIS = 0Private Const PROOF_QUALITY = 2Private Const DEFAULT_PITCH = 0Private Declare Function MulDiv Lib "kernel32" (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As LongPrivate Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As LongPrivate Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As LongPrivate Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As LongPrivate 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 LongPrivate Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As LongPrivate Declare Function CreateDC Lib "gdi32.dll" Alias "CreateDCA" (ByVal lpszDriver As String, ByVal lpszDevice As String, ByVal lpszOutput As Long, lpInitData As Any) As LongPrivate Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As Long) As LongPrivate Declare Function StartPage Lib "gdi32.dll" (ByVal hdc As Long) As LongPrivate Declare Function StartDoc Lib "gdi32.dll" Alias "StartDocA" (ByVal hdc As Long, lpdi As DOCINFO) As LongPrivate Declare Function EndPage Lib "gdi32.dll" (ByVal hdc As Long) As LongPrivate Declare Function EndDoc Lib "gdi32.dll" (ByVal hdc As Long) As LongPrivate 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 LongPrivate Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As LongPrivate Const HKEY_CURRENT_USER = &H80000001Private 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 stringPrivate Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As LongPrivate 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 usageEnd TypePrivate Declare Function GetVersion Lib "kernel32" () As LongPrivate Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As LongPrivate Const VER_PLATFORM_WIN32_WINDOWS = 1Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As LongPrivate Const SM_CXSCREEN = 0Private Const SM_CYSCREEN = 1Private Declare Function SetMapMode Lib "gdi32" (ByVal hdc As Long, ByVal nMapMode As Long) As LongPrivate Const MM_ANISOTROPIC = 8Private Declare Function SetWindowExtEx Lib "gdi32" (ByVal hdc As Long, ByVal nX As Long, ByVal nY As Long, ByVal lpSize As Long) As LongPrivate Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As LongPrivate Const LOGPIXELSX = 88 ' Logical pixels/inch in XPrivate Const LOGPIXELSY = 90 ' Logical pixels/inch in YPrivate Declare Function SetViewportExtEx Lib "gdi32" (ByVal hdc As Long, ByVal nX As Long, ByVal nY As Long, ByVal lpSize As Long) As LongSub 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 hPrinterDCEnd Sub