ab.com コミュニティ

ActiveBasicを通したコミュニケーション
現在時刻 - 2017年11月21日(火) 11:32

All times are UTC+09:00




新しいトピックを投稿する  トピックへ返信する  [ 3 件の記事 ] 
作成者 メッセージ
 記事の件名: 画面印刷
投稿記事Posted: 2013年2月22日(金) 12:41 
N88-BASICのCOPYに対応するプリンタ制御命令は無いのですか?


通報する
ページトップ
   
 記事の件名: Re: 画面印刷
投稿記事Posted: 2014年8月27日(水) 21:49 
残念ながらなかったかと思います。
プリンターを扱うのは非常に骨が折れて
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[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項を繋げる関数です。


通報する
ページトップ
   
 記事の件名: Re: 画面印刷
投稿記事Posted: 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


通報する
ページトップ
   
期間内表示:  ソート  
新しいトピックを投稿する  トピックへ返信する  [ 3 件の記事 ] 

All times are UTC+09:00


オンラインデータ

このフォーラムを閲覧中のユーザー: なし & ゲスト[1人]


トピック投稿:  可
返信投稿:  可
記事編集: 不可
記事削除: 不可
ファイル添付: 不可

検索:
ページ移動:  
cron
Powered by phpBB® Forum Software © phpBB Limited
Japanese translation principally by KONISHI Yohsuke