登録日時: 2005年7月19日(火) 07:02 記事: 183
お住まい: 宮城県
|
ビットマップを簡単に扱うクラスです。
AB4に、Put@・Get@・Bload(BMP開く)・Bsave(BMP保存)のような
記述を持ち込もうってコンセプトです。
以前に投稿した[AB3]AB2/N88ライクなBLoad/Put@/Get@/Point/Psetを
クラスにまとめて、ちょっと機能追加してみました。
クラスの定義はここをクリックしてください。 [ここをクリックすると内容が表示されます] [ここをクリックすると非表示にします]コード:
'定数の定義
Const PSet_BASIC = SRCCOPY
Const OR_BASIC = SRCPAINT
Const XOR_BASIC = SRCINVERT
Const AND_BASIC = SRCAND
'ビットマップを簡単に扱うためのクラス。
Class WsEasyBmp
hHeapEB As HANDLE
hBmpEB As HBITMAP
dwPixelBits As DWordPtr '複数スレッドから呼び出される。下のfPixelBitsで管理。
fPixelBits As Long '複数スレッドから呼び出される。
hTargetWnd As HWND
hBasicMemDC As HDC
fBasic As Long
cs As CRITICAL_SECTION
hSecondThread As VoidPtr
tID As DWord
hAnyThreadParam As DWord 'スレッド間の値渡し。必ず時間差で呼び出されるので排他処理は不要。
nCpuSleepLevel As Long 'ピクセル取得時のCpu抑制率をミリ秒で指定。マイナスをしてすると、DWordキャストされるので2147483648以上を指定したことを意味し、つまりほぼ停止。
'スレッド間の値渡しのための関数。
Function GetAnyThreadParam() As DWord
GetAnyThreadParam = hAnyThreadParam
End Function
Function SetAnyThreadParam( dwAny As DWord ) As DWord
hAnyThreadParam = dwAny
End Function
'ピクセルデータの配列の有効無効
Function IsPixelBits() As Long
EnterCriticalSection( cs )
IsPixelBits = fPixelBits
LeaveCriticalSection( cs )
EndFunction
Sub SetPixelBits( fFlag As Long )
EnterCriticalSection( cs )
fPixelBits = fFlag
LeaveCriticalSection( cs )
EndSub
'Bmpファイルからピクセル情報を得て、配列に格納しておく
'別スレッドを呼び出して、そちらで読み込む。
Sub GetPixelBits( hBmpEB As HBITMAP )
Dim hDC As HDC
Dim hMemDC As HDC
Dim hMemDC2 As HDC
Dim hBmp2 As HBITMAP
Dim w As Long
Dim h As Long
'前回のスレッドの終了を待つ。
If( hSecondThread<>NULL )Then
If( WAIT_TIMEOUT=WaitForSingleObject(hSecondThread, 0) )Then '念のためスレッド動作中かを確認。
TerminateThread( hSecondThread, 1 )
End If
CloseHandle( hSecondThread )
hSecondThread = NULL
EndIf
'スレッド用にビットマップを複製。hBmpEB→hBmp2
/*
「1つのビットマップオブジェクトを同時に複数の
デバイスコンテキストで選択することはできない.」
http://ls-al.jp/blog/archives/2006/03/post_288.html
*/
w = GetWidth()
h = GetHeight()
hDC = GetDC( hTargetWnd )
hMemDC = CreateCompatibleDC( hDC )
hMemDC2 = CreateCompatibleDC( hDC )
hBmp2 = CreateCompatibleBitmap( hDC, w, h )
If( NULL=SelectObject( hMemDC, hBmpEB ) )Then
'結合に失敗。
MessageBox(hTargetWnd, "ピクセル情報の取得に失敗。与えられたHBITMAPが新規DCに結合できない。", "エラー", MB_OK Or MB_ICONSTOP)
/* そのまま抜けるか、一応最後まで走らせるか・・・。迷うところ。ピクセル有無の無限待機関数の存在を考慮。
DeleteDC( hMemDC )
DeleteDC( hMemDC2 )
ReleaseDC( hTargetWnd ,hDC )
ExitSub
*/
End If
SelectObject( hMemDC2, hBmp2 )
BitBlt( hMemDC2, 0, 0, w, h, hMemDC, 0, 0, SRCCOPY )
DeleteDC( hMemDC )
DeleteDC( hMemDC2 )
ReleaseDC( hTargetWnd ,hDC )
'複製したビットマップからピクセル情報を得る@別スレッドGetPixelBitsA()を作成。
'※複製したビットマップhBmp2はスレッド側で終了時に破棄される。
SetAnyThreadParam( hBmp2 As DWord )
hSecondThread = CreateThread( ByVal NULL, NULL, AddressOf(WsEasyBmp_Static_GetPixelBitsA), VarPtr(This), NULL, VarPtr(tID) )
EndSub
'コールバック関数の類であるスレッドをメンバに持たせるために、
'途中中継を行う静的メソッド。
Sub WsEasyBmp_Static_GetPixelBitsA( vdParam As VoidPtr )
Dim lpWsEasyBmp As *WsEasyBmp
lpWsEasyBmp = vdParam As *WsEasyBmp
lpWsEasyBmp->GetPixelBitsA()
End Sub
Public
'Bmpファイルからピクセル情報を得て、配列に格納しておく:本体。
'※別スレッドとして呼び出される。
' 本当はプライベート・メンバにしたいが、そうすると静的メンバから呼び出せない・・・。
' これって仕様だっけ?
Sub GetPixelBitsA()
Dim nSize As Long
Dim x As Long
Dim y As Long
Dim w As Long
Dim h As Long
Dim hDC As HDC
Dim hMemDC As HDC
Dim hBmpCpy As HBITMAP
'対象となるビットマップハンドルを得る。
'※スレッド間の衝突を考慮
hBmpCpy = GetAnyThreadParam() As HBITMAP
If( dwPixelBits<>NULL )Then
HeapFree( hHeapEB, NULL, dwPixelBits )
dwPixelBits = NULL
EndIf
w = GetWidth()
h = GetHeight()
nSize = w*h
dwPixelBits = HeapAlloc( hHeapEB, HEAP_ZERO_MEMORY, nSize*4 ) 'RGB=24bit ≒ DWord = 4Byte = 32Bit
hDC = GetDC( hTargetWnd )
hMemDC = CreateCompatibleDC( hDC )
SelectObject( hMemDC, hBmpCpy )
For y=0 To h-1
For x=0 To w-1
dwPixelBits[ y*w + x ] = GetPixel( hMemDC, x, y )
Next
Sleep( nCpuSleepLevel As DWord )
Next
DeleteDC( hMemDC )
ReleaseDC( hTargetWnd ,hDC )
'利用したビットマップ(複製)を破棄する。
DeleteObject( hBmpCpy )
'ピクセル情報を取得したことを通知する。
SetPixelBits( TRUE )
ExitThread( 0 )
EndSub
Private
'ビットマップを保存する
'※ysama様のログからコピペ
Function BsaveA(hBmp As Long, pszFile As BytePtr, CBit As Integer) As Integer
'-----------------------------------------------------------------------------
' ビットマップファイルの書込関数
' BsaveA(ビットマップハンドル, ファイル名, 色数*)
' *色数は1-モノクロ, 4-16色, 8-256色, 16, 24, 32はTrueカラーでRGBQUADがない
' 戻り値:成功=TRUE、失敗=FALSE
'-----------------------------------------------------------------------------
Dim hDC As Long, hMem As Long 'デスクトップDCとコンパチビットマップDC
Dim BMPSize As DWORD 'ビットマップサイズ計算用
Dim Bmp As BITMAP '基本情報取得用
Dim Bmf As BITMAPFILEHEADER 'BITMAPFILEHEADER構造体変数
Dim Bmi As BITMAPINFO 'BITMAPINFO構造体変数(ABの場合、既に256個のRGBQUADがついている)
Dim lpBits As BytePtr 'ビットパターンへのメモリーポインター
Dim hFile As Long '書込みファイルハンドル
Dim dwTotal As DWORD '総バイト数
Dim dwTmp As Long 'WriteFile()関数の書込バイト数用
Dim nSuccess As Integer 'GetDIBits関数の成功判定フラグ
'デスティネーションのビットマップ情報構造体を初期化
GetObject(hBmp, Len(Bmp), Bmp)
If(CBit = 0) Then 'CBitが0の場合はDDBのカラービットとする
CBit = Bmp.bmBitsPixel
End If
'CBitのチェック
Select Case(CBit)
Case 1
Case 4
Case 8
Case 16
Case 24
Case 32
Case Else '上記以外は受け付けられない
BsaveA = FALSE
Exit Function
End Select
'BITMAPINFOの準備
Bmi.bmiHeader.biSize = 40 'sizeof(BITMAPINFOHEADER)
Bmi.bmiHeader.biWidth = Bmp.bmWidth
Bmi.bmiHeader.biHeight = Bmp.bmHeight
Bmi.bmiHeader.biPlanes = 1
Bmi.bmiHeader.biBitCount = CBit
Bmi.bmiHeader.biCompression = BI_RGB '0x0
Bmi.bmiHeader.biSizeImage = 0 '圧縮時以外は0
Bmi.bmiHeader.biXPelsPerMeter = 0
Bmi.bmiHeader.biYPelsPerMeter = 0
Bmi.bmiHeader.biClrUsed = 0
Bmi.bmiHeader.biClrImportant = 0
'ビットマップデータサイズを算出(4の倍数でなければならない)
BMPSize = ((CBit * Bmi.bmiHeader.biWidth + 31) \ 32) * 4 * Abs(Bmi.bmiHeader.biHeight)
'BITMAPFILEHEADERの準備
Bmf.bfType = &H4D42 '"BM" - ひっくり返っているが
Bmf.bfReserved1 = 0
Bmf.bfReserved2 = 0
If(CBit <= 8) Then 'BITMAPFILEHEADER + BITMAPINFOHEADER + RGBQUAD
Bmf.bfOffBits = 54 + (4 * (1 << CBit))
Else 'BITMAPFILEHEADER + BITMAPINFOHEADER
Bmf.bfOffBits = 54
End If
Bmf.bfSize = BMPSize + Bmf.bfOffBits 'ファイルサイズ
'ビットパターンデータの準備
lpBits = GlobalAlloc(GPTR, BMPSize) 'ビットパターン用メモリー確保
If(lpBits = 0) Then
MessageBox(hTargetWnd, "メモリ確保に失敗しました", "エラー", MB_OK Or MB_ICONSTOP)
BsaveA = FALSE
Exit Function
End If
'ここで色数を変更
hDC = GetDC(0) 'デスクトップのデバイスコンテキスト
hMem = CreateCompatibleDC(hDC) 'そのコンパチDC
SelectObject(hMem, hBmp) 'ビットマップを読ませる
'ビット配列をGetDIBits関数でlpBitsに取り出す
nSuccess = GetDIBits(hMem, hBmp, 0, Bmp.bmHeight, lpBits, Bmi, DIB_RGB_COLORS)
DeleteDC(hMem) 'コンパチDCを削除
ReleaseDC(0, hDC) 'デスクトップのデバイスコンテキストを開放
If(nSuccess = 0) Then '色数変更失敗
MessageBox(hTargetWnd, "色数変更に失敗しました", "エラー", MB_OK Or MB_ICONSTOP)
GlobalFree(lpBits) '確保したメモリーを解放
BsaveA = FALSE
Exit Function
End If
'--------------
' ファイル作成
'--------------
'書き込み用ファイルを開く
hFile = CreateFile(pszFile, _
GENERIC_WRITE, _
0, _
ByVal NULL, _
CREATE_ALWAYS, _
FILE_ATTRIBUTE_NORMAL, _
NULL)
If(hFile = INVALID_HANDLE_VALUE) Then
MessageBox(hTargetWnd, "ファイルを開くことができませんでした", "エラー", MB_OK Or MB_ICONSTOP)
GlobalFree(lpBits) '確保したメモリーを解放
BsaveA = FALSE
Exit Function
End If
'各ヘッダーの書きこみ
'BITMAPFILEHEADERをファイルへ書き込む
If(WriteFile(hFile, VarPtr(Bmf), 14, VarPtr(dwTmp), ByVal NULL) = 0) Then 'sizeof(BITMAPFILEHEADER) = 14
MessageBox(hTargetWnd, "ビットマップファイルヘッダーを書き込むことができませんでした", "エラー", MB_OK Or MB_ICONSTOP)
GlobalFree(lpBits) '確保したメモリーを解放
CloseHandle(hFile)
BsaveA = FALSE
Exit Function
End If
'BITMAPINFOHEADERとRGBQUADをファイルへ書き込む
If(WriteFile(hFile, VarPtr(Bmi), Bmf.bfOffBits - 14, VarPtr(dwTmp), ByVal NULL) = 0) Then 'BITMAPINFOHEADER + RGBQUAD
MessageBox(hTargetWnd, "ビットマップ情報とカラーテーブルを書き込むことができませんでした", "エラー", MB_OK Or MB_ICONSTOP)
GlobalFree(lpBits) '確保したメモリーを解放
CloseHandle(hFile)
BsaveA = FALSE
Exit Function
End If
'ビットマップビット配列をファイルへ書き込む
If(WriteFile(hFile, lpBits, BMPSize, VarPtr(dwTmp), ByVal NULL) = 0) Then
MessageBox(hTargetWnd, "ビット配列を書き込むことができませんでした", "エラー", MB_OK Or MB_ICONSTOP)
CloseHandle(hFile)
GlobalFree(lpBits) '確保したメモリーを解放
BsaveA = FALSE
Exit Function
End If
'x.BMPファイルをクローズする
If(CloseHandle(hFile)) = 0 Then
MessageBox(hTargetWnd, "ファイルをクローズできませんでした", "エラー", MB_OK Or MB_ICONSTOP)
End If
GlobalFree(lpBits) '確保したメモリーを解放
BsaveA = TRUE
End Function
'ビットマップと逸れに付随するピクセル情報(あれば)を破棄する
Sub WsDeleteEasyBmp()
'ピクセル情報の破棄
SetPixelBits( FALSE )
If( hSecondThread<>NULL )Then
'スレッドが動作中のときは、強制終了する。
TerminateThread( hSecondThread, 1 )
CloseHandle( hSecondThread )
hSecondThread = NULL
EndIf
HeapFree( hHeapEB, NULL, dwPixelBits )
dwPixelBits = NULL
'ビットマップハンドルの破棄
DeleteObject( hBmpEB )
hBmpEB = NULL
EndSub
Public '--------------------------------------------------------------------
Sub WsEasyBmp()
InitializeCriticalSection( cs )
hHeapEB = HeapCreate( NULL, 0, 0 )
hBmpEB = NULL
hSecondThread = NULL
dwPixelBits = NULL
fPixelBits = FALSE
hTargetWnd = NULL
hBasicMemDC = NULL
fBasic = FALSE
nCpuSleepLevel = 0
End Sub
Sub ~WsEasyBmp()
If( hSecondThread<>NULL )Then
'スレッド処理が動作中なら強制終了する。
TerminateThread( hSecondThread, 1 )
WaitForSingleObject( hSecondThread, INFINITE ) '念のため、終了を待機。
CloseHandle( hSecondThread )
hSecondThread = NULL
EndIf
If( hBmpEB<>NULL )Then
WsDeleteEasyBmp()
EndIf
HeapDestroy( hHeapEB )
DeleteCriticalSection( cs )
End Sub
'ターゲットとなる窓のセット
Sub SetTargetWindow( hWnd As HWND )
hTargetWnd = hWnd
fBasic = FALSE
End Sub
'ターゲットになっている窓を返す。
Function GetTargetWindow() As HWND
GetTargetWindow = hTargetWnd
End Function
'コマンドプロンプト用の設定(N88Basicライク)。
Sub SetBasic()
hTargetWnd = _PromptSys_hWnd
hBasicMemDC = _PromptSys_hMemDC
fBasic = TRUE
End Sub
'ビットマップをファイルからロード
Function Bload( pBmpFile As BytePtr ) As Long
If( hBmpEB<>NULL )Then
WsDeleteEasyBmp()
EndIf
hBmpEB = LoadImage( GetWindowLong(hTargetWnd, GWL_HINSTANCE) As HINSTANCE, pBmpFile, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE )
If( hBmpEB=NULL )Then
Bload = FALSE
Else
Bload = TRUE
'ピクセル情報を得ておく。
GetPixelBits( hBmpEB )
EndIf
End Function
'ビットマップをファイルへ保存する。
Function Bsave( pBmpFile As BytePtr ) As Long
Bsave = BsaveA( hBmpEB, pBmpFile, 32 )
End Function
'ビットマップを伸縮しつつ描画
Function PutBmpStretch( x As Long, y As Long, w As Long, h As Long, dwRop As Long ) As Long
PutBmpStretch = PutBmpStretchEx( x, y, w, h, dwRop, NULL ) As Long
End Function
'上記において、hDCが指定されている場合用Exメソッド(RADのPaintイベントとかで必要になる)。
Function PutBmpStretchEx( x As Long, y As Long, w As Long, h As Long, dwRop As Long, hPaintDC As HDC ) As Long
Dim hDC As HDC 'デバイスコンテキスト
Dim BitmapReport As BITMAP 'ビットマップ情報を格納するための構造体
Dim hMemDC As HDC 'メモリ・デバイスコンテキスト
Dim dCNumber As Double
'描画すべきものが無いとき
If( hBmpEB=NULL )Then
PutBmpStretchEx = FALSE
ExitFunction
Else
PutBmpStretchEx = TRUE
EndIf
'ラスタオペレーション省略時の補整
If( dwRop=NULL )Then
dwRop = SRCCOPY
EndIf
'縦横サイズ省略時の補整
GetObject( hBmpEB, Len(BitmapReport), BitmapReport )'ビットマップのサイズを取得
If( (w=0)and(h=0) )Then
w = BitmapReport.bmWidth
h = BitmapReport.bmHeight
Else
If( h<=0 )Then
dCNumber = BitmapReport.bmHeight / BitmapReport.bmWidth
h = ( w*dCNumber ) As Long
End If
If( w<=0 )Then
dCNumber = BitmapReport.bmWidth / BitmapReport.bmHeight
w = ( h*dCNumber ) As Long
End If
End If
'デバイスコンテキストを得る
If( hPaintDC=NULL )Then
hDC = GetDC( hTargetWnd )
Else
hDC = hPaintDC
End If
'ビットマップの描画準備
hMemDC = CreateCompatibleDC( hDC ) 'メモリ・デバイスコンテキストを作成する
SelectObject( hMemDC, hBmpEB ) 'ビットマップを選択
'ビットマップを描画
SetStretchBltMode( hDC, COLORONCOLOR ) '伸縮モードを単純ピクセル削除で指定。
StretchBlt( hDC, x, y, w, h, hMemDC, 0, 0, BitmapReport.bmWidth, BitmapReport.bmHeight, dwRop )
If( fBasic=TRUE )Then
'N88BASICモードのとき(再描画対策)
SetStretchBltMode( hBasicMemDC, COLORONCOLOR )
StretchBlt( hBasicMemDC, x, y, w, h, hMemDC, 0, 0, BitmapReport.bmWidth, BitmapReport.bmHeight, dwRop )
EndIf
'使ったオブジェクトの開放
DeleteDC( hMemDC )
If( hPaintDC=NULL )Then
ReleaseDC( hTargetWnd ,hDC )
End If
EndFunction
'ビットマップを伸縮せずに描画
Function PutBmp( x As Long, y As Long, dwRop As Long ) As Long
PutBmp = PutBmpStretch( x, y, 0, 0, dwRop )
EndFunction
'ビットマップを画面(窓)から得る
Function GetBmp( x As Long, y As Long, w As Long, h As Long ) As Long
Dim hDC As HDC
Dim hMemDC As HDC
If( hBmpEB<>NULL )Then
WsDeleteEasyBmp()
EndIf
hDC = GetDC( hTargetWnd )
hMemDC = CreateCompatibleDC( hDC )
hBmpEB = CreateCompatibleBitmap( hDC, w, h )
SelectObject( hMemDC, hBmpEB )
If( fBasic=TRUE )Then
StretchBlt( hMemDC, 0, 0, w, h, hBasicMemDC, x, y, w, h, SRCCOPY )
Else
StretchBlt( hMemDC, 0, 0, w, h, hDC, x, y, w, h, SRCCOPY )
EndIf
DeleteDC( hMemDC )
ReleaseDC( hTargetWnd ,hDC )
GetBmp = TRUE
'ピクセル情報を得ておく。
GetPixelBits( hBmpEB )
EndFunction
'ビットマップの指定された位置のピクセル情報を返す。
Function GetBmpPixel( x As Long, y As Long ) As DWord
Dim nWidth As Long
Dim nHeight As Long
Dim nRed As Long
Dim nGreen As Long
Dim nBlue As Long
Dim nArry As Long
If( IsPixelBits()=TRUE )Then
nHeight = GetHeight()
If( y < nHeight )Then
nWidth = GetWidth()
If( x < nWidth )Then
GetBmpPixel = dwPixelBits[ y*nWidth + x ]
Else
GetBmpPixel = 0
EndIf
Else
GetBmpPixel = 0
EndIf
Else
GetBmpPixel = 0
EndIf
EndFunction
'ビットマップの縦横の長さを返す。
Function GetWidth() As Long
Dim lp As BITMAP
GetObject( hBmpEB, Len(lp), lp )
GetWidth = lp.bmWidth
EndFunction
Function GetHeight() As Long
Dim lp As BITMAP
GetObject( hBmpEB, Len(lp), lp )
GetHeight = lp.bmHeight
EndFunction
'ピクセルを描く
Sub Pset( x As Long, y As Long, crColor As DWord )
Dim hDC As HDC 'デバイスコンテキスト
hDC = GetDC( hTargetWnd )
SetPixel( hDC, x, y, crColor )
If( fBasic=TRUE )Then
'N88BASICモードのとき(再描画対策)
SetPixel( hBasicMemDC, x, y, crColor )
EndIf
ReleaseDC( hTargetWnd ,hDC )
EndSub
'関数GetBmpPixel()の有効無効
Function IsGetBmpPixel() As Long
IsGetBmpPixel = IsPixelBits()
EndFunction
'関数GetBmpPixel()の有効になるまで待機する
Sub IsGetBmpPixel_INFINITE()
While( FALSE=IsPixelBits() )
Sleep( 1000 )
Wend
EndSub
'窓の指定された位置のピクセル情報を返す。
Function Point( x As Long, y As Long ) As Long
Dim hDC As HDC 'デバイスコンテキスト
hDC = GetDC( hTargetWnd )
Point = GetPixel( hDC, x, y )
If( fBasic=TRUE )Then
'N88BASICモードのとき(再描画対策)
Point = GetPixel( hBasicMemDC, x, y )
EndIf
ReleaseDC( hTargetWnd ,hDC )
EndFunction
'ビットマップハンドルを得る(外部の操作用)。
Function GetHandleBmp() As HBITMAP
GetHandleBmp = hBmpEB
End Function
'ビットマップハンドルを外部からセット
Sub SetHandleBmp( hNewBmp As HBITMAP ) As Long
If( hBmpEB<>NULL )Then
WsDeleteEasyBmp()
EndIf
hBmpEB = hNewBmp
'ピクセル情報を得ておく。
GetPixelBits( hBmpEB )
End Sub
'ビットマップのピクセルデータの入った配列の先頭ポインタを返す。
Function GetPixelArray() As DWordPtr
If( IsPixelBits()=TRUE )Then
GetPixelArray = dwPixelBits
Else
GetPixelArray = NULL
EndIf
End Function
'ビットマップのピクセルデータの入った配列のサイズを返す。
Function GetPixelArraySize() As Long
GetPixelArraySize = GetWidth()*GetHeight()*SizeOf(DWord) 'たぶんSizeOf()=4 理由→ DWord = 4Byte = 32Bit
End Function
'ピクセル取得時のCpu抑制率をミリ秒で指定する。
'取得中は変更不可。
'マイナスを指定すると、取得を行わない(実際には、非常に鈍く行う。サイクル辺り590時間)。
Function SetCpuSleepLevel( nMiliSec As Long ) As Long
If( WAIT_TIMEOUT=WaitForSingleObject(hSecondThread, 0) )Then
SetCpuSleepLevel = FALSE
Else
nCpuSleepLevel = nMiliSec
SetCpuSleepLevel = TRUE
End If
End Function
End Class
#N88BASIC環境下でも、それ以外(ノーマルウィンドウベースとか)の環境でも使えます。
・N88BASIC環境下(N88プロンプトベース)で使う場合は、
Sub SetBasic()
を最初に実行してください。
・それ以外で実行する場合は、ビットマップを貼り付ける窓を
Sub SetTargetWindow( hWnd As HWND )
で指定してください。
・ビットマップをファイルから読み込む
Function Bload( pBmpFile As BytePtr ) As Long
pBmpFile ビットマップデータが入ったファイル名を指定します。
・ビットマップをファイルへ保存する。
Function Bsave( pBmpFile As BytePtr ) As Long
pBmpFile 保存ファイル名を指定します。
・ビットマップを窓、もしくはN88プロンプトへ描画
Function PutBmp( x As Long, y As Long, dwRop As Long ) As Long
x,y ビットマップの左上の座標を指定します。
dwRop ラスタオペレーションを指定します。
PSet_BASIC … ビットマップをそのまま画面にコピーします。
OR_BASIC … ビットマップの色と画面の色をOR演算した結果を表示します。
XOR_BASIC … ビットマップの色と画面の色をXOR演算した結果を表示します。
AND_BASIC … ビットマップの色と画面の色をAND演算した結果を表示します。
※省略(0を指定)するとPSet_BASICとして扱われます。
・伸縮機能付きのPutBmp()(伸縮モードはCOLORONCOLOR)
Function PutBmpStretch( x As Long, y As Long, w As Long, h As Long, dwRop As Long ) As Long
動作はPutBmp()に準ず。
w,h が伸縮後の縦横になる。
( w,h )=( 0,0 )を指定すると、伸縮せずに描画。
( w,h )の一方のみに-1を指定すると、縦横比を維持して伸縮描画。
・デバイスコンテキストを指定できるPutBmpStretch()
Function PutBmpStretchEx( x As Long, y As Long, w As Long, h As Long, dwRop As Long, hPaintDC As HDC ) As Long
動作はPutBmpStretch()に準ず。
hPaintDCにNULLを指定すると、SetTargetWindow()メソッドで指定してある
窓のデバイスコンテキストに対して描画される。
・BMPを窓/プロンプト画面から読み込む
Function GetBmp( x As Long, y As Long, w As Long, h As Long ) As Long
x,y 選択する長方形の開始点の座標を指定します。
w,h 選択する長方形の終始点の座標を指定します。
・窓/プロンプト画面へ、指定したドットを描画する
Sub Pset( x As Long, y As Long, crColor As DWord )
x,y 座標を指定します
crColor RGB(24ビットデータ)を指定します。
・窓/プロンプト画面の、指定した座標の色を取得する
Function Point( x As Long, y As Long ) As Long
x,y 座標を指定します
取得した色が、24ビットデータで返ります。
・ビットマップの、指定された位置のピクセル情報(RGB)を返す。
Function GetBmpPixel( x As Long, y As Long ) As DWord
x,y ビットマップの左上を(0,0)とした座標を指定します
取得した色が、24ビットデータで返ります。
※読み込んだ直後は取得に失敗することがあります。
IsGetBmpPixel()の返り値がTRUEになるまでお待ちください。
・メソッドGetBmpPixel()が有効かどうかを返す。
Function IsGetBmpPixel() As Long
有効(取得可能)であればTRUEを、そうでなければFALSEを返します。
・ビットマップの幅を返す。
Function GetWidth() As Long
・ビットマップの高さを返す。
Function GetHeight() As Long
・ビットマップのピクセルデータ(RGB)の入った配列の先頭ポインタを返す。
Function GetPixelArray() As DWordPtr
配列要素番号は、『縦の位置×幅+横の位置』となります。
・ビットマップのピクセルデータの入った配列のサイズを返す。
Function GetPixelArraySize() As Long
配列要素をコピーするのに必要なサイズがByteで返ります。
・ビットマップハンドルを得る。
Function GetHandleBmp() As HBITMAP
このクラスが保持しているビットマップのハンドルを返します。
外部操作用です。
このメンバで得たビットマップハンドルは削除しないで下さい。
また、別のビットマップをもとのクラスオブジェクトに読み込んだときは、
以前に得たビットマップハンドルは無効になります。
・ビットマップハンドルを外部からセットする。
Sub SetHandleBmp( hNewBmp As HBITMAP ) As Long
別途に作製したビットマップのハンドルを、このクラスに保持させます。
これにより、上記の操作(保存や色の取得)が出来るようになります。
(Jpegなどを別途読み込んで、逸れに対しての操作とか。)
このメンバにセットしたビットマップハンドルは削除する必要は
ありません。クラスオブジェクト内で必要に応じて自動的に削除します。
(※別のビットマップをクラスオブジェクトに読み込んだ時点で削除)
※とくに断りが無い場合、返り値は成功時はTRUE、失敗時はFALSEになります。
例:N88BASICコード: #N88BASIC
Dim lp As WsEasyBmp
Dim w As Long
Dim h As Long
Dim x As Long
Dim y As Long
lp.SetBasic() 'N88BASIC環境をセット
lp.Bload( "hoge.bmp" ) 'ビットマップの読み込み
lp.PutBmp( 0, 0, 0 ) 'とりあえず出力
'ピクセル情報取得可能になるまで待機。
While( lp.IsGetBmpPixel()=FALSE )
Print "*"
Sleep( 100 )
Wend
'1ピクセルごとに描画してみる。
w = lp.GetWidth()
h = lp.GetHeight()
For x=0 To w-1
For y=0 To h-1
lp.Pset( x, h+20+y, lp.GetBmpPixel(x,y) )
Next
Next
'プロンプト画面のピクセル情報を取得し、別の場所に吐き出してみる。
For x=w-32 To w+32
For y=16 To 64
lp.Pset( x+w+64, y, lp.Point(x,y) )
If( lp.Point(x,y)=0 )Then
lp.Pset( x+w+64, y, RGB( 255, 255, 255 ) )
End If
Next
Next
'プロンプト画面の一部を読み込み、ファイルに保存する。
lp.GetBmp( 0, 0, 64, h*2 )
lp.Bsave( "test.bmp" )
例:ノーマルウィンドウコード: ' TODO: この位置にグローバルな変数、構造体、定数、関数を定義します。
Dim lp As WsEasyBmp
'-----------------------------------------------------------------------------
' ここから下は、イベントプロシージャを記述するための領域になります。
Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
lp.SetWnd( hMainWnd ) '入出力を行う窓を設定。
lp.Bload( "hoge.bmp" ) 'ビットマップの読み込み
End Sub
Sub MainWnd_Paint(hDC As HDC)
lp.PutBmp( 16, 16, NULL ) '保持しているビットマップを描画。
End Sub
以上。
※2006.01.28の22時の時点で、修正しています。
N88BASICモードで、Endを書かなかった場合にアクセス違反が出るバグを修正。
※2006.02.1の1時半過ぎの時点で、修正しています。
スレッドの管理を修正(連続でBloadメンバを呼び出したときの対策)。
※2006.06.15の11時過ぎの時点で、修正しています。
主にスレッド管理にいくつかバグ発見し、それを修正。
GetPixelArraySize()が致命的におかしいことに気づき修正。
メソッドに、PutBmpStretchEx(),PutBmpStretch()を追加。
(他にもこっそり追加しているメソッドがあったり?)
いつものように蛇足。
GetBmpPixel()が、読み込んだ直後は取得失敗する理由は、
読み込んだBMPを一度メモリデバイスコンテキストに描画し、
そのピクセルデータをGetPixel()を使って読み取って2次元配列に保存し、
GetBmpPixel()ではその配列から値を返しているため。
大きなBMP(1000×1000くらい?)だと数秒くらい掛かるのかな?
なお、その間の制御は返してますので、フリーズしたりはしないです。
本当はBMPファイルから直に読み取りたかったのですが・・・
上手く読み取れない。横にデータが広がってしまうのです。
BMP構造の理解がいまいち足りないみたいなので、今回はこの辺で妥協。
GetBmp()で読み込んだときにどーせ同じことするわけだし。
ちなみに。
わざわざ配列に一度読み込んで・・・なんて組み方をしたのは、
GetPixelArray()で配列を外に取り出して好きな処理をすることを見据えているから。
ある閾値より暗いところはRGB(0,0,0)に変えるとか、
逆にある閾値より明るいところはRGB(255,255,255)で真っ白にするとか。
そういうRGBを直に操作するような画像加工ソフトを作りたいな~と。
そのためのこのクラスですね。
Jpeg→Gifとかの変換で綺麗にサイズを減らしたりするんじゃないかとw
後は星の写真の背景の処理とか。
・・・インターフェースを組むのが面倒なので、しばらく放置の予感^^;
最後に編集したユーザー 淡幻星 [ 2006年6月15日(木) 11:05 ], 累計 4 回
|
|