请参考:
'gptr& 是存放位图Bits数据的内存
'hdc是Printer.hdc
    Dim bi As BITMAPINFO
    Dim dctemp&, dctemp2&
    Dim msg$
    Dim bufsize&
    Dim bm As BITMAP
    Dim ghnd&
    Dim gptr&
    Dim xpix&, ypix&
    Dim uy&, ux&
    Dim di&
    Dim Si As Single
    '创建一个临时的,与设备兼容的设备场景,用于存放预打印的位图。
     dctemp& = CreateCompatibleDC(hdc)
    
    '获取位图信息
    di = GetObjectAPI(obj.Picture, Len(bm), bm)    'GetDeviceCaps:根据指定设备场景代表的设备的功能返回信息
    If (GetDeviceCaps(dctemp, RASTERCAPS)) And RC_DIBTODEV = 0 Then
        msg$ = "设备不支持DIB图象。"
        MsgBox msg$, vbOKOnly + vbCritical, "问题"
    End If    '向BITMAPINFO结构(bi)变量装载DIB信息
    bi.bmiHeader.biSize = Len(bi.bmiHeader)
    bi.bmiHeader.biWidth = bm.bmWidth
    bi.bmiHeader.biHeight = bm.bmHeight
    bi.bmiHeader.biPlanes = 1    bi.bmiHeader.biBitCount = 4    '每一个像素所占用的位(也可以是 1,4,8,16,24,32)
    bi.bmiHeader.biCompression = BI_RGB
    
    '计算数据缓冲区的大小
    bufsize& = bi.bmiHeader.biWidth
    Select Case bi.bmiHeader.biBitCount
        Case 1
            bufsize& = (bufsize& + 7) / 8
        Case 4
            bufsize& = (bufsize& + 1) / 2
        Case 24
            bufsize& = bufsize& * 3
    End Select    bufsize& = ((bufsize& + 3) / 4) * 4
    bufsize& = bufsize& * bi.bmiHeader.biHeight    '创建缓冲区
    ghnd = GlobalAlloc(GMEM_MOVEABLE, bufsize&)
    gptr& = GlobalLock&(ghnd)
    
    '将来自一幅位图的二进制位复制到一幅与设备无关的位图里
    di = GetDIBits(dctemp, obj.Picture, 0, bm.bmHeight, ByVal gptr&, bi, DIB_RGB_COLORS)
    
     '进行缩放计算,并按新的比例打印位图
    ux = bm.bmWidth 
    uy = bm.bmHeight
    di = StretchDIBits(hdc, X, Y, ux, uy, 0, 0, bm.bmWidth, bm.bmHeight, ByVal gptr&, bi, DIB_RGB_COLORS, SRCCOPY)
     '释放缓冲区
    di = GlobalUnlock(ghnd)
    di = GlobalFree(ghnd)
    di = DeleteDC(dctemp)