ab.com コミュニティ

ActiveBasicを通したコミュニケーション
現在時刻 - 2018年8月15日(水) 17:39

All times are UTC+09:00




新しいトピックを投稿する  トピックへ返信する  [ 2 件の記事 ] 
作成者 メッセージ
投稿記事Posted: 2005年12月07日(水) 00:00 
オフライン

登録日時: 2005年7月19日(火) 07:02
記事: 183
住所: 宮城県
[hide=こちらをインクルードしてください。]
コード:
'定数の定義
Const PSet_BASIC = SRCCOPY
Const OR_BASIC = SRCPAINT
Const XOR_BASIC = SRCINVERT
Const AND_BASIC = SRCAND


'以下、Ver2ライクの定義-----------------------------

Sub PsetBmp( x As Long, y As Long, crColor As DWord )
	Dim retAns As Long
	retAns = Ws_Pset( x, y, crColor )
EndSub
Function Point( x As Long, y As Long ) As Long
	Point = Ws_Point( x, y )
EndFunction
Sub BLoad( strBmpFile As String, ByRef hBmp As Long )
	hBmp = Ws_Bload( strBmpFile )
End Sub
Sub PutBmp( x As Long, y As Long, hBmp As Long)( dwRop As DWord )
	Dim retAns As Long
	If( dwRop=NULL )Then
		dwRop = SRCCOPY
	EndIf
	retAns = Ws_PutBmp( x, y, hBmp, dwRop )
End Sub
Sub GetBmp( x As Long, y As Long, w As Long, h As Long, ByRef hBmp As Long )
	Dim retAns As Long
	retAns = Ws_GetBmp( x, y, w, h, hBmp )
End Sub
Sub FinishBmp( hBmp As Long )
	Ws_CloseBmp( hBmp )
End Sub


'--------------------------------------------------
'以下、本体。

'**************************
'参考
'BackSearchAB.chmの
'タイトル:[AB3] GetBitmap&PutBitmap /投稿者名:AGJ
'タイトル:DLLからビットマップを読込む /投稿者名:ysama
'**************************

Function Ws_Bload( strBmpFile As String ) As Long
	Dim hBmp As Long			  'ビットマップ ハンドル

	Ws_Bload = NULL
	'ビットマップをロード
	hBmp = LoadImage( GetWindowLong(_PromptSys_hWnd, GWL_HINSTANCE), strBmpFile, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE )
	If hBmp=NULL Then
		MessageBox(_PromptSys_hWnd, "ビットマップのオープンに失敗", "Bload命令", MB_OK)
		ExitFunction
	EndIf

	Ws_Bload = hBmp
EndFunction
Sub Ws_CloseBmp( hBmp As Long )
	DeleteObject(hBmp)  'ビットマップ ハンドルを破棄する
EndSub


Function Ws_PutBmp( x As Long, y As Long, hBmp As Long, dwRop As Long ) As Long
	Dim hDC As Long 'デバイスコンテキスト
	Dim BitmapReport As BITMAP	'ビットマップ情報を格納するための構造体
	Dim hMemDC As Long 'メモリ・デバイスコンテキスト

	'描画すべきものが無いとき
	If( hBmp=NULL )Then
		MessageBox(_PromptSys_hWnd, "表示すべき画像がありません", "Put@命令", MB_OK)
		Ws_PutBmp = FALSE
		ExitFunction
	Else
		Ws_PutBmp = TRUE
	EndIf

	'デバイスコンテキストを得る
	hDC = GetDC( _PromptSys_hWnd )

	'ビットマップの描画準備
	GetObject( hBmp, Len(BitmapReport), BitmapReport )'ビットマップのサイズを取得
	hMemDC = CreateCompatibleDC( hDC )  'メモリ・デバイスコンテキストを作成する
	SelectObject( hMemDC, hBmp )	  'ビットマップを選択

	'ビットマップを描画
	BitBlt( hDC, x, y, BitmapReport.bmWidth, BitmapReport.bmHeight,	 hMemDC, 0, 0, dwRop )
	BitBlt( _PromptSys_hMemDC, x, y, BitmapReport.bmWidth, BitmapReport.bmHeight, hMemDC, 0, 0, dwRop )

	'使ったオブジェクトの開放
	DeleteDC( hMemDC )
	ReleaseDC( _PromptSys_hWnd ,hDC )

EndFunction


Function Ws_GetBmp( x As Long, y As Long, w As Long, h As Long, ByRef hBmp As Long ) As Long
	Dim hDC As Long 'デバイスコンテキスト
	Dim hMemDC As Long 'メモリ・デバイスコンテキスト

	If( hBmp<>NULL )Then
	Ws_CloseBmp( hBmp )
	EndIf

	hDC = GetDC( _PromptSys_hWnd )
	hMemDC = CreateCompatibleDC( hDC )
	hBmp = CreateCompatibleBitmap( hDC, w, h )
	SelectObject( hMemDC, hBmp )
'	StretchBlt( hMemDC, 0, 0, w, h, hDC, x, y, w, h, SRCCOPY )
	StretchBlt( hMemDC, 0, 0, w, h, _PromptSys_hMemDC, x, y, w, h, SRCCOPY )

	DeleteDC( hMemDC )
	ReleaseDC( _PromptSys_hWnd ,hDC )

	Ws_GetBmp = TRUE
EndFunction


Function Ws_Pset( x As Long, y As Long, crColor As DWord ) As Long
	Dim retAns As Long
	Dim hDC As Long

	hDC = GetDC( _PromptSys_hWnd )
		retAns = SetPixel( hDC, x, y, crColor )
	ReleaseDC( _PromptSys_hWnd ,hDC )
	retAns = SetPixel( _PromptSys_hMemDC, x, y, crColor )

	Ws_Pset = TRUE
EndFunction


Function Ws_Point( x As Long, y As Long ) As Long
	Dim hDC As Long 'デバイスコンテキスト
	Dim hMemDC As Long 'メモリ・デバイスコンテキスト

	Ws_Point = GetPixel( _PromptSys_hMemDC, x, y )
EndFunction
[/hide]
【使い方】
#N88BASIC利用下でお願いします。
上記を適当なファイルに保存し、インクルードしてください。

・BMPをファイルから読み込む
Sub BLoad( strBmpFile As String, ByRef hBmp As Long )
 strBmpFile ビットマップデータが入ったファイル名を指定します。
 hBmp 読み込まれたビットマップデータを示すハンドルが格納されます。

・BMPをプロンプト画面から読み込む(Get@)
Sub GetBmp( x As Long, y As Long, w As Long, h As Long, ByRef hBmp As Long )
 x,y 選択する長方形の開始点の座標を指定します。
 w,h 選択する長方形の終始点の座標を指定します。
 hBmp 作成されたビットマップデータを示すハンドルが格納されます。

・読み込んであるBMPを画面に表示する(Put@)
Sub PutBmp( x As Long, y As Long, hBmp As Long)
 もしくは
Sub PutBmp( x As Long, y As Long, hBmp As Long, dwRop As DWord )
 x,y ビットマップの左上の座標を指定します。
 hBmp ビットマップデータを示すポインタを指定して下さい
 dwRop ラスタオペレーションを指定します。
      PSet_BASIC … ビットマップをそのまま画面にコピーします。
      OR_BASIC … ビットマップの色と画面の色をOR演算した結果を表示します。
      XOR_BASIC … ビットマップの色と画面の色をXOR演算した結果を表示します。
      AND_BASIC … ビットマップの色と画面の色をAND演算した結果を表示します。

・終了処理(AB2では必要ありませんでしたが…)
Sub FinishBmp( hBmp As Long )
 hBmp ビットマップデータを示すポインタを指定して下さい
 上記のBload/GetBmpを使った時は、最後に(End命令の直前とか)必ずこれを呼び出してください。

・指定した座標の色を取得する
Function Point( x As Long, y As Long ) As Long
 x,y 座標を指定します
 返り値
  取得した色が、24ビットデータで返ります。
  赤・緑・青への分解(0~255)は
コード:
r = Point( x, y )
nRed = ( r And &HFF )
nGreen = ( r And &HFF00 ) / &H100
nBlue = ( r And &FF0000 ) / &H10000
でしょうか(すいません。テストしてません)。

・指定したドットを描画する
Sub PsetBmp( x As Long, y As Long, crColor As DWord )
 x,y 座標を指定します
 crColor RGBを指定します。
      ※AB3デフォルトのPsetはカラーコード(0~8)にしか
       対応してないので、上記Point()/RGBで色を指定するにはこちらが必要。


【使用例】
コード:
Dim s As String
Dim hBmp As Long

s = "hoge.bmp"
BLoad( s, hBmp )

PutBmp( 1,1, hBmp )
GetBmp( 100,100, 50,50, hBmp )
PutBmp( 280,280, hBmp )

FinishBmp( hBmp )
End
以上。



AB2のヘルプファイルの説明文と、
BackSearchAB.chmのAGJ様とysama様の投稿を
参考にさせていただきました(とゆうか、まんま?^^;)。
ありがとうございました。


≪12/7(2:08)修正しました≫
無効リージョンの処理を忘れてました。直に描画してました(^^;)
今度は、窓が隠れても画像は消えないと思います。


通報する
ページトップ
投稿記事Posted: 2018年8月09日(木) 12:49 
これをAB4でやりたいのですが・・・


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

All times are UTC+09:00


オンラインデータ

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


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

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