コード: 全て選択
ShellExecute( 0,"open","rundll32.exe","shimgvw.dll,_
ImageView_PrintTo /pt "+Chr$(&h22)+PrintFile+Chr$(&h22)+" "+Chr$(&h22)+PrinterName+Chr$(&h22),_
NULL,SW_SHOW) As Long
コード: 全て選択
'PNG読み込みが困難なので取りあえずBMPに変換する。
'PNG からBMPへ変換 imgctl.dllを使用 'http://www.ruche-home.net/download/?pack=imgctl'
Declare Function PNGtoDIB Lib "imgctl.dll" (ByVal lpBmpFile As String ) As Long
Declare Function DIBtoBMP Lib "imgctl.dll"(ByVal lpPngFile As String,ByVal hDIB As Long ) As Long
Declare Function DeleteDIB Lib "imgctl.dll" (ByVal hDIB As Long ) As Long
DIm ret as long
Dim h As Long
h = PNGtoDIB("D:\abc.png")
ret = DIBtoBMP("D:\abc.bmp", h)
ret = DeleteDIB(h)
コード: 全て選択
'BMPの読み込み
Dim hBmp As Long 'ビットマップ ハンドル
hBmp=LoadImage(GetWindowLong(hMainWnd, GWL_HINSTANCE) As HINSTANCE, "D:\abc.bmp", IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE) As Long
Dim BitmapReport As BITMAP 'ビットマップ情報を格納するための構造体
GetObject(hBmp As VoidPtr, Len(BitmapReport) As Long, BitmapReport) 'ビットマップのサイズを取得
コード: 全て選択
Sub MainWnd_Paint(hPrDC As HDC)
Dim hBmp As VoidPtr 'ビットマップ ハンドル
hBmp=LoadImage(GetWindowLong(hMainWnd, GWL_HINSTANCE) As HINSTANCE, "D:\abc.bmp", IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE)
Dim hMemDC As HDC 'メモリ内 デバイスコンテキストのハンドル
Dim BitmapReport As BITMAP 'ビットマップ情報を格納するための構造体
'ビットマップのサイズを取得
GetObject(hBmp, Len(BitmapReport), BitmapReport)
hMemDC=CreateCompatibleDC(hPrDC) 'メモリ内にデバイスコンテキストを作成する
SelectObject(hMemDC, hBmp) 'ビットマップを選択
Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" ( lpApplicationName As BytePtr, lpKeyName As BytePtr, lpDefault As BytePtr, lpReturnedString As BytePtr, nSize As Long, lpFileName As BytePtr) As Long
'--------印刷してみる
Dim docinfo As DOCINFO
Dim hDC As HDC
Dim PrinterName[255] As Byte
'プリンタ名取得
GetPrivateProfileString( "windows", "device", "error", PrinterName, 256, "Win.ini")
lstrcpy( PrinterName, Left$( PrinterName, InStr( 1, PrinterName, ",")-1))
'DOCINFO初期化
ZeroMemory( VarPtr( docinfo), Len( docinfo))
docinfo.cbSize = Len( docinfo)
docinfo.lpszDocName = PrinterName
'DCを作る。第一引数はドライバ名か"WINSPOOL"、第二引数はプリンタ名
hDC = CreateDC( "WINSPOOL", PrinterName, NULL, ByVal NULL)
'印刷可能範囲の取得
Dim PrinterHORZRES As Long
Dim PrinterVERTRES As Long
PrinterHORZRES = GetDeviceCaps(hDC,HORZRES)
PrinterVERTRES = GetDeviceCaps(hDC,VERTRES)
'印刷ジョブ開始
StartDoc( hDC, docinfo)
StartPage( hDC)
' BitBlt(hDC, 0, 0, BitmapReport.bmWidth, BitmapReport.bmHeight, hMemDC, 0, 0, SRCCOPY)
StretchDIBits( hDC ,_
0 , 0 , PrinterHORZRES , PrinterVERTRES ,_ ' 印刷用紙サイズ
0 , 0 , BitmapReport.bmWidth , BitmapReport.bmHeight ,_ ' オリジナル画像の印刷範囲
hMemDC,_
ByVal BitmapReport.bmType,_ '<===★★おそらくココが悪い★★
DIB_RGB_COLORS ,SRCCOPY)
ReleaseDC(hMainWnd,hDC)
EndPage( hDC)
EndDoc( hDC)
DeleteDC( hDC)
DeleteDC(hMemDC) 'メモリ内のデバイスコンテキストを解放する
DeleteObject(hBmp) 'ビットマップ ハンドルを破棄する
End Sub
コード: 全て選択
'用紙サイズをA4に設定
Printer.PaperSize = vbPRPSA4
'用紙方向を横向きに設定
Printer.Orientation = vbPRORLandscape
'用紙のサイズに画像ファイルを印刷
Printer.PaintPicture LoadPicture("D:\abc.bmp"), 0, 0, _
Printer.ScaleWidth, Printer.ScaleHeight
Printer.EndDoc