ab.com コミュニティ

ActiveBasicを通したコミュニケーション
現在時刻 - 2024年3月29日(金) 06:13

全ての表示時間は UTC+09:00 です




新しいトピックを投稿する  トピックへ返信する  [ 3 件の記事 ] 
作成者 メッセージ
投稿記事Posted: 2006年1月27日(金) 03:56 
オフライン

登録日時: 2005年7月19日(火) 07:02
記事: 183
お住まい: 宮城県
ビットマップを簡単に扱うクラスです。
AB4に、Put@・Get@・Bload(BMP開く)・Bsave(BMP保存)のような
記述を持ち込もうってコンセプトです。
以前に投稿した[AB3]AB2/N88ライクなBLoad/Put@/Get@/Point/Psetを
クラスにまとめて、ちょっと機能追加してみました。

#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 回

通報する
ページトップ
投稿記事Posted: 2006年1月28日(土) 02:54 
オフライン

登録日時: 2005年7月19日(火) 07:02
記事: 183
お住まい: 宮城県
ビットマップのピクセル要素RGBに対して補整曲線を適用するクラスです。
例えば、
 ・&H444444以下のピクセルは&H000000に変更。
 ・&Haaaaaa以上のピクセルは&Hffffffに変更。
 ・y = tanh(x) のようにして、一部の輝度変化を拡大
などのように画像を編集できます。

上記のWsEasyBmpクラスを基底クラスに利用しています。 (※動作確認 AB Ver. 4.10.02)


【使い方】
1、画像補整曲線を以下の関数形で定義します。
Function funcName( dwCor As DWord ) As DWord
  ※引数はDWord型で、返り値もDWord型です。
コード:
'例:赤の輝度が<&Haaならば、青と緑の輝度を無視する(赤のみにする)。
Function HogeBraight( dwCor As DWord ) As DWord
	Dim b As Byte
	b = (dwCor And &Hff) As Byte
	If( b<&Haa )Then
		HogeBraight = b As DWord
	Else
		HogeBraight = dwCor
	End If
End Function
2、Bload()メソッドなどでビットマップを読みます。
3、メソッド
 Function BrightnessEff( funcCor As PFuncBrightnessEffectCuve ) As Long
を呼び出し、引数には補整曲線の関数(の開始ポインタ)を渡します。
この例であれば
 lp.BrightnessEff( AddressOf(HogeBraight) )
となります。


なお、処理中が終わってから制御を返します。
処理が成功するとTRUEが、失敗するとFALSEが返ります。
(別スレッド化は・・・気が向いたらまた後日に^^:)


以上。


通報する
ページトップ
投稿記事Posted: 2006年6月15日(木) 11:18 
オフライン

登録日時: 2005年7月19日(火) 07:02
記事: 183
お住まい: 宮城県
指定したピクセル幅(正方形)でモザイクを掛けます。
実際には、指定ピクセル幅の正方形でRGBを平均化する操作になります。


上記のWsEasyBmpクラスを基底クラスに利用しています。 (※動作確認 AB Ver. 4.24.00)


メソッドの説明。
Function MosaicEff( nPixel As Long ) As Long
nPixelにモザイクの幅を指定してください。
※メソッドIsGetBmpPixel()の返り値がTRUEになってから実行してください。


利用例。
コード:
#N88BASIC

Dim objEff As WsPicsMosaic

objEff.SetBasic()
objEff.BloadPics( "Picture.bmp" )
objEff.IsGetBmpPixel_INFINITE()
objEff.PutBmp( 0, 0, NULL ) '読み込んだ画像を描画。
objEff.MosaicEff_INFINITE( 6 ) '6x6のサイズでモザイク加工。
'objEff.IsGetBmpPixel_INFINITE() 'ピクセル取得が終わるまで待機(PutBmpに対しては必須ではない)
objEff.PutBmp( 0, 0, NULL ) '加工の終わった画像を描画。

Sleep( 5000 )
End

ちなみに、基底クラスのWsEasyBmpも先ほど修正版と差し替えました。


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

全ての表示時間は UTC+09:00 です


オンラインデータ

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


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

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