作成者 |
メッセージ |
|
|
たぶんこんな感じです。
デバッグしてないので適当です。ご利用時はデバッグしてからご利用ください。
コード:
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]
|
|
|
投稿記事 |
Posted: 2014年8月27日(水) 22:08 |
|
|
|
|
|
残念ながらなかったかと思います。
プリンターを扱うのは非常に骨が折れて
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項を繋げる関数です。
残念ながらなかったかと思います。 プリンターを扱うのは非常に骨が折れて 1印刷データを用意 2プリンターデバイスコンテキストなんとかを用意 3プリンターデバイスコンテキストとかなんとかに印刷データを書き込んでいく という作業になるかんじです。 プリンターのデバイスコンテキストとかなんとかは CreateDC(0,”プリンターの正式名称”,0,ByVal NULL) で取れます。 文字はDrawTextやらで 絵はStretchBltとかで プリンターのデバイスコンテキストとかなんとかに書き込むかんじです。 画面全体をキャプしてそのままプリンターデバイスコン・・にかいてしまえば COPYと同じような感じかとは思います。
プリンターの正式名称は以下コードで取得できます。 [code] 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[i].pPrinterName)+1) memcpy(buf,pPrinter[i].pPrinterName,lstrlen(pPrinter[i].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項を繋げる関数です。 [/code]
|
|
|
投稿記事 |
Posted: 2014年8月27日(水) 21:49 |
|
|
|
|
|
N88-BASICのCOPYに対応するプリンタ制御命令は無いのですか?
N88-BASICのCOPYに対応するプリンタ制御命令は無いのですか?
|
|
|
投稿記事 |
Posted: 2013年2月22日(金) 12:41 |
|
|
|
|