画面印刷
Re: 画面印刷
残念ながらなかったかと思います。
プリンターを扱うのは非常に骨が折れて
1印刷データを用意
2プリンターデバイスコンテキストなんとかを用意
3プリンターデバイスコンテキストとかなんとかに印刷データを書き込んでいく
という作業になるかんじです。
プリンターのデバイスコンテキストとかなんとかは
CreateDC(0,”プリンターの正式名称”,0,ByVal NULL)
で取れます。
文字はDrawTextやらで
絵はStretchBltとかで
プリンターのデバイスコンテキストとかなんとかに書き込むかんじです。
画面全体をキャプしてそのままプリンターデバイスコン・・にかいてしまえば
COPYと同じような感じかとは思います。
プリンターの正式名称は以下コードで取得できます。
プリンターを扱うのは非常に骨が折れて
1印刷データを用意
2プリンターデバイスコンテキストなんとかを用意
3プリンターデバイスコンテキストとかなんとかに印刷データを書き込んでいく
という作業になるかんじです。
プリンターのデバイスコンテキストとかなんとかは
CreateDC(0,”プリンターの正式名称”,0,ByVal NULL)
で取れます。
文字はDrawTextやらで
絵はStretchBltとかで
プリンターのデバイスコンテキストとかなんとかに書き込むかんじです。
画面全体をキャプしてそのままプリンターデバイスコン・・にかいてしまえば
COPYと同じような感じかとは思います。
プリンターの正式名称は以下コードで取得できます。
コード: 全て選択
dim namebuf as BytePtr
Dim ret As DWord
Dim bac As DWord
Dim c As DWord
Dim pPrinter As *PRINTER_INFO_5
Dim i As Long
Dim com as BytePtr
Dim buf as BytePtr
'プリンタ一覧を返却
EnumPrinters(PRINTER_ENUM_LOCAL,NULL,5,pPrinter as BytePtr,0,ret,c)
pPrinter =malloc(ret)
EnumPrinters(PRINTER_ENUM_LOCAL,NULL,5,pPrinter as BytePtr,ret,bac,c)
com= calloc(3)
com[0]=&HD
com[1]=&HA
If c Then
For i=0 To c-1
buf = calloc(lstrlen(pPrinter.pPrinterName)+1)
memcpy(buf,pPrinter.pPrinterName,lstrlen(pPrinter.pPrinterName))
namebuf = DataADD( namebuf , buf )
namebuf = DataADD( namebuf , com)
free(buf)
Next
end if
free( com )
msgbox 0,MakeStr(namebuf),"一覧"
free( namebuf )
*DataADDは1項に2項を繋げる関数です。
Re: 画面印刷
たぶんこんな感じです。
デバッグしてないので適当です。ご利用時はデバッグしてからご利用ください。
デバッグしてないので適当です。ご利用時はデバッグしてからご利用ください。
コード: 全て選択
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