ab.com コミュニティ https://www.activebasic.com/forum/ |
|
画面印刷 https://www.activebasic.com/forum/viewtopic.php?t=4078 |
ページ 1 / 1 |
作成者: | りき [ 2013年2月22日(金) 12:41 ] |
記事の件名: | 画面印刷 |
N88-BASICのCOPYに対応するプリンタ制御命令は無いのですか? |
作成者: | kobo [ 2014年8月27日(水) 21:49 ] |
記事の件名: | Re: 画面印刷 |
残念ながらなかったかと思います。 プリンターを扱うのは非常に骨が折れて 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項を繋げる関数です。 |
作成者: | kobo [ 2014年8月27日(水) 22:08 ] |
記事の件名: | 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 |
ページ 1 / 1 | 全ての表示時間は UTC+09:00 です |
Powered by phpBB® Forum Software © phpBB Limited https://www.phpbb.com/ |