by kobo » 2014年8月27日(水) 22:08
たぶんこんな感じです。
デバッグしてないので適当です。ご利用時はデバッグしてからご利用ください。
コード: 全て選択
sub PrinterOut( hSelectPrinterDC as HDC , buf As BytePtr , filename as BytePtr )
'プリンタ出力デバイスコンテキスト hSelectPrinterDC as HDC
'出力内容を指定文字列 buf As BytePtr
'出力絵のファイルパス filename as BytePtr
Dim doc As DOCINFO 'ドキュメントの設定
Dim textmetric as TEXTMETRIC 'フォントの情報
Dim mojxy as RECT '絵の文字を出力する時の位置
Dim hBmpClivan As HANDLE 'ビットマップ ハンドル
Dim hMemClivanDC as HDC 'DC ハンドル
Dim xy as RECT '印刷Bitmap指定座標
Dim BitmapReport As BITMAP 'ビットマップ情報を格納するための構造体
Dim hDC as HDC
Dim hMemDC as HDC
ZeroMemory(VarPtr(doc),len(doc))
doc.cbSize=Len(doc)
'印刷動作
StartDoc(hSelectPrinterDC,doc)
StartPage(hSelectPrinterDC)
'絵を描く
hBmpClivan=LoadImage(GetWindowLong(hMainWnd, GWL_HINSTANCE) as HINSTANCE, filename , IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE)
hDC = GetDC(hMainWnd)
hMemClivanDC=CreateCompatibleDC(hDC) 'メモリ内にデバイスコンテキストを作成する
SelectObject(hMemClivanDC, hBmpClivan) 'ビットマップを選択
SetStretchBltMode(hSelectPrinterDC , HALFTONE) '拡縮可能設定
'ビットマップのサイズを取得
GetObject(hBmpClivan, Len(BitmapReport), BitmapReport)
with xy
.left=0
.top=0
.right=BitmapReport.bmWidth
.bottom=BitmapReport.bmHeight'RogoYbit
'拡縮しながら構築
StretchBlt(hSelectPrinterDC, 0, 0, (.right * 1.2) as long, (.bottom * 1.2) as long, hMemClivanDC, .left , .top , .right , .bottom ,SRCCOPY)
end with
'文字を書く
GetTextMetrics(hSelectPrinterDC,textmetric)
mojxy.left =0 '書き出し位置(左)
mojxy.top =0 '書き出し位置(上)
mojxy.right =0 '設定無し
mojxy.bottom=3 '文字大きさ幅+高
PicTextOut(hSelectPrinterDC , watermarks , VarPtr(mojxy) )
EndPage(hSelectPrinterDC)
EndDoc(hSelectPrinterDC)
ReleaseDC( hMainWnd , hMemDC)
DeleteDC(hMemClivanDC) 'メモリ内のデバイスコンテキストを解放する
If hBmpClivan>0 Then DeleteObject(hBmpClivan) 'ビットマップ ハンドルを破棄する
End sub
Sub PicTextOut(hPDC as HDC , text as BytePtr , mojxy as *RECT )
Dim mojsz as LOGFONT
Dim hmoj as HFONT
Dim mxy as RECT
Dim BackHandle as HANDLE
With mojsz
.lfHeight =-mojxy->bottom *10
.lfWidth =0
.lfEscapement =0
.lfOrientation =0
.lfWeight =0
.lfItalic =0
.lfUnderline =0
.lfStrikeOut =0
.lfCharSet =SHIFTJIS_CHARSET
.lfOutPrecision =OUT_DEFAULT_PRECIS
.lfClipPrecision=CLIP_DEFAULT_PRECIS
.lfQuality =DEFAULT_QUALITY
.lfPitchAndFamily=DEFAULT_PITCH
End With
SetTextColor(hPDC,RGB(&h0,&h0,&h0)) 'テキストの色
SetBkMode(hPDC,TRANSPARENT)
'オブジェクト(描く為のペン種(フォント等で書くとか色々)を作成する
hmoj =CreateFontIndirect(mojsz)
if hmoj=0 then msgbox hMainWnd,"CreateFont失敗","CreateFont"
'デバイスコンテキストにビットマップを選択
BackHandle =SelectObject(hPDC,hmoj)
'デバイスコンテキストが選択成功なら文字を描く
if BackHandle>0 then
with mxy
.left = mojxy->left
.top = mojxy->top
.right = mojxy->bottom *10 * lstrlen(text) + mojxy->left
.bottom = mojxy->bottom *10 * lstrlen(text) + mojxy->top
end with
DrawTextEx(hPDC,text,lstrlen(text),mxy,DT_END_ELLIPSIS,ByVal NULL)
'デバイスコンテキストを元に戻す
SelectObject(hPDC,BackHandle)
else
msgbox hMainWnd,"セレクト失敗 hPDCの取得がされていません","hPDC"
end if
DeleteObject(hmoj)
End Sub
たぶんこんな感じです。
デバッグしてないので適当です。ご利用時はデバッグしてからご利用ください。
[code]
sub PrinterOut( hSelectPrinterDC as HDC , buf As BytePtr , filename as BytePtr )
'プリンタ出力デバイスコンテキスト hSelectPrinterDC as HDC
'出力内容を指定文字列 buf As BytePtr
'出力絵のファイルパス filename as BytePtr
Dim doc As DOCINFO 'ドキュメントの設定
Dim textmetric as TEXTMETRIC 'フォントの情報
Dim mojxy as RECT '絵の文字を出力する時の位置
Dim hBmpClivan As HANDLE 'ビットマップ ハンドル
Dim hMemClivanDC as HDC 'DC ハンドル
Dim xy as RECT '印刷Bitmap指定座標
Dim BitmapReport As BITMAP 'ビットマップ情報を格納するための構造体
Dim hDC as HDC
Dim hMemDC as HDC
ZeroMemory(VarPtr(doc),len(doc))
doc.cbSize=Len(doc)
'印刷動作
StartDoc(hSelectPrinterDC,doc)
StartPage(hSelectPrinterDC)
'絵を描く
hBmpClivan=LoadImage(GetWindowLong(hMainWnd, GWL_HINSTANCE) as HINSTANCE, filename , IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE)
hDC = GetDC(hMainWnd)
hMemClivanDC=CreateCompatibleDC(hDC) 'メモリ内にデバイスコンテキストを作成する
SelectObject(hMemClivanDC, hBmpClivan) 'ビットマップを選択
SetStretchBltMode(hSelectPrinterDC , HALFTONE) '拡縮可能設定
'ビットマップのサイズを取得
GetObject(hBmpClivan, Len(BitmapReport), BitmapReport)
with xy
.left=0
.top=0
.right=BitmapReport.bmWidth
.bottom=BitmapReport.bmHeight'RogoYbit
'拡縮しながら構築
StretchBlt(hSelectPrinterDC, 0, 0, (.right * 1.2) as long, (.bottom * 1.2) as long, hMemClivanDC, .left , .top , .right , .bottom ,SRCCOPY)
end with
'文字を書く
GetTextMetrics(hSelectPrinterDC,textmetric)
mojxy.left =0 '書き出し位置(左)
mojxy.top =0 '書き出し位置(上)
mojxy.right =0 '設定無し
mojxy.bottom=3 '文字大きさ幅+高
PicTextOut(hSelectPrinterDC , watermarks , VarPtr(mojxy) )
EndPage(hSelectPrinterDC)
EndDoc(hSelectPrinterDC)
ReleaseDC( hMainWnd , hMemDC)
DeleteDC(hMemClivanDC) 'メモリ内のデバイスコンテキストを解放する
If hBmpClivan>0 Then DeleteObject(hBmpClivan) 'ビットマップ ハンドルを破棄する
End sub
Sub PicTextOut(hPDC as HDC , text as BytePtr , mojxy as *RECT )
Dim mojsz as LOGFONT
Dim hmoj as HFONT
Dim mxy as RECT
Dim BackHandle as HANDLE
With mojsz
.lfHeight =-mojxy->bottom *10
.lfWidth =0
.lfEscapement =0
.lfOrientation =0
.lfWeight =0
.lfItalic =0
.lfUnderline =0
.lfStrikeOut =0
.lfCharSet =SHIFTJIS_CHARSET
.lfOutPrecision =OUT_DEFAULT_PRECIS
.lfClipPrecision=CLIP_DEFAULT_PRECIS
.lfQuality =DEFAULT_QUALITY
.lfPitchAndFamily=DEFAULT_PITCH
End With
SetTextColor(hPDC,RGB(&h0,&h0,&h0)) 'テキストの色
SetBkMode(hPDC,TRANSPARENT)
'オブジェクト(描く為のペン種(フォント等で書くとか色々)を作成する
hmoj =CreateFontIndirect(mojsz)
if hmoj=0 then msgbox hMainWnd,"CreateFont失敗","CreateFont"
'デバイスコンテキストにビットマップを選択
BackHandle =SelectObject(hPDC,hmoj)
'デバイスコンテキストが選択成功なら文字を描く
if BackHandle>0 then
with mxy
.left = mojxy->left
.top = mojxy->top
.right = mojxy->bottom *10 * lstrlen(text) + mojxy->left
.bottom = mojxy->bottom *10 * lstrlen(text) + mojxy->top
end with
DrawTextEx(hPDC,text,lstrlen(text),mxy,DT_END_ELLIPSIS,ByVal NULL)
'デバイスコンテキストを元に戻す
SelectObject(hPDC,BackHandle)
else
msgbox hMainWnd,"セレクト失敗 hPDCの取得がされていません","hPDC"
end if
DeleteObject(hmoj)
End Sub
[/code]