こちらをインクルードしてください。 [ここをクリックすると内容が表示されます] [ここをクリックすると非表示にします]コード: '定数の定義
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
【使い方】
#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)修正しました≫
無効リージョンの処理を忘れてました。直に描画してました(^^;)
今度は、窓が隠れても画像は消えないと思います。
[hide=こちらをインクルードしてください。][code]'定数の定義 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 [/code][/hide] 【使い方】 [b]#N88BASIC利用下[/b]でお願いします。 上記を適当なファイルに保存し、インクルードしてください。
[b]・BMPをファイルから読み込む[/b] [i]Sub BLoad( strBmpFile As String, ByRef hBmp As Long )[/i] strBmpFile ビットマップデータが入ったファイル名を指定します。 hBmp 読み込まれたビットマップデータを示すハンドルが格納されます。
[b]・BMPをプロンプト画面から読み込む[/b](Get@) [i]Sub GetBmp( x As Long, y As Long, w As Long, h As Long, ByRef hBmp As Long )[/i] x,y 選択する長方形の開始点の座標を指定します。 w,h 選択する長方形の終始点の座標を指定します。 hBmp 作成されたビットマップデータを示すハンドルが格納されます。
[b]・読み込んであるBMPを画面に表示する[/b](Put@) [i]Sub PutBmp( x As Long, y As Long, hBmp As Long)[/i] もしくは [i]Sub PutBmp( x As Long, y As Long, hBmp As Long, dwRop As DWord )[/i] x,y ビットマップの左上の座標を指定します。 hBmp ビットマップデータを示すポインタを指定して下さい dwRop ラスタオペレーションを指定します。 PSet_BASIC … ビットマップをそのまま画面にコピーします。 OR_BASIC … ビットマップの色と画面の色をOR演算した結果を表示します。 XOR_BASIC … ビットマップの色と画面の色をXOR演算した結果を表示します。 AND_BASIC … ビットマップの色と画面の色をAND演算した結果を表示します。
[b]・終了処理[/b](AB2では必要ありませんでしたが…) [i]Sub FinishBmp( hBmp As Long )[/i] hBmp ビットマップデータを示すポインタを指定して下さい 上記のBload/GetBmpを使った時は、最後に(End命令の直前とか)必ずこれを呼び出してください。
[b]・指定した座標の色を取得する[/b] [i]Function Point( x As Long, y As Long ) As Long[/i] x,y 座標を指定します 返り値 取得した色が、24ビットデータで返ります。 赤・緑・青への分解(0~255)は [code]r = Point( x, y ) nRed = ( r And &HFF ) nGreen = ( r And &HFF00 ) / &H100 nBlue = ( r And &FF0000 ) / &H10000[/code]でしょうか(すいません。テストしてません)。
[b]・指定したドットを描画する[/b] [i]Sub PsetBmp( x As Long, y As Long, crColor As DWord )[/i] x,y 座標を指定します crColor RGBを指定します。 ※AB3デフォルトのPsetはカラーコード(0~8)にしか 対応してないので、上記Point()/RGBで色を指定するにはこちらが必要。
【使用例】 [code]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[/code]
以上。
AB2のヘルプファイルの説明文と、 BackSearchAB.chmのAGJ様とysama様の投稿を 参考にさせていただきました(とゆうか、まんま?^^;)。 ありがとうございました。
[size=84][color=red]≪12/7(2:08)修正しました≫[/color] 無効リージョンの処理を忘れてました。直に描画してました(^^;) 今度は、窓が隠れても画像は消えないと思います。[/size]
|