ab.com コミュニティ

ActiveBasicを通したコミュニケーション
現在時刻 - 2017年9月22日(金) 11:40

All times are UTC+09:00




新しいトピックを投稿する  トピックへ返信する  [ 2 件の記事 ] 
作成者 メッセージ
 記事の件名: 画像透明化クラス
投稿記事Posted: 2012年11月08日(木) 20:23 
透過処理が面倒なのでクラスにまとめてみました。

私自身、最近になって画像を表示させることができたくらいの初心者ですので、間違っている箇所があるかもしれません。(一応動作はしました。)

間違えている点、追加する点があればご指摘ください。

[hide]
コード:
Class TOUMEI
Private
	hMainDC As HDC
	hMainBmp As HBITMAP
	hBlackDC As HDC
	hBlackBmp As HBITMAP
	info As BITMAP
	flg As Byte




Public

	Sub ~TOUMEI()
		DeleteData()
	EndSub

	Function CreateTSPARENT(hDC As HDC,bmp As HBITMAP,bkColor As DWord) As Long
		If flg=1 then DeleteData()

		hMainDC=CreateCompatibleDC(hDC)

		If hMainDC=0 then CreateTSPARENT=0:ExitFunction
		hBlackDC=CreateCompatibleDC(hDC)
		hMainBmp=bmp
		SelectObject(hMainDC,hMainBmp)
		GetObject(hMainBmp,Len(info),info)
		hBlackBmp=CreateBitmap(info.bmWidth,info.bmHeight,1,1,0)
		SelectObject(hBlackDC,hBlackBmp)
		SetBkColor(hMainDC,bkColor)
		CreateTSPARENT=BitBlt(hBlackDC,0,0,info.bmWidth,info.bmHeight,hMainDC,0,0,SRCCOPY)

		If CreateTSPARENT=1 then flg=1

	EndFunction
	
	Sub DeleteData()
		DeleteDC(hMainDC)
		DeleteDC(hBlackDC)
		DeleteObject(hMainBmp)
		DeleteObject(hBlackBmp)
		flg=0
	EndSub

	Function PrintData(hDC As HDC,x As Long,y As Long)(w As Long,h As Long,moto_x As Long,moto_y As Long,moto_w As Long,moto_h As Long) As Long
		Dim radi As Double,er[1] As Long,old[1] As Long
		If flg=1 then
			radi=info.bmWidth/info.bmHeight
			If w=0 then w=info.bmWidth
			If h=0 then h=info.bmHeight
			If w=-1 then w=h*radi
			If h=-1 then h=w/radi
			If moto_w=0 then moto_w=info.bmWidth
			If moto_h=0 then moto_h=info.bmHeight
			old[0]=SetStretchBltMode(hBlackDC,COLORONCOLOR)
			old[1]=SetStretchBltMode(hMainDC,COLORONCOLOR)
			er[0]=StretchBlt(hDC,x,y,w,h,hBlackDC,moto_x,moto_y,moto_w,moto_h,SRCAND)
			er[1]=StretchBlt(hDC,x,y,w,h,hMainDC,moto_x,moto_y,moto_w,moto_h,SRCPAINT)
			SetStretchBltMode(hBlackDC,old[0])
			SetStretchBltMode(hMainDC,old[1])

			If er[0] and er[1]=TRUE then PrintData=TRUE

		EndIf

	EndFunction

End Class

[/hide]


コンストラクタなし
●CreateTSPARENT
画像を透過して保持
hDC 貼り付け先(予定)のデバイスコンテキスト
bmp 元の画像
bkColor 透明化する色(RGB(○,△,□)などで指定)

●DeleteData
保持しているデータを破棄

●PrintData
保持しているデータを貼り付け
hDC 貼り付け先のデバイスコンテキスト
x 貼り付け位置(X座標)
y 貼り付け位置(Y座標)
----以下省略可----
w 貼り付け幅
h 貼り付け高さ
moto_x 元の画像読み込み開始位置(X座標)
moto_y 元の画像読み込み開始位置(Y座標)
moto_w 元の画像読み込み幅
moto_h 元の画像読み込み高さ

w,h,moto_w,moto_hは0でデフォルト
wは-1で元画像の比率でhに合わせる
hは-1で元画像の比率でwに合わせる

省略箇所は0指定と同じ

CreateTSPARENTのbmpには淡幻星様作成のWsEasyPicsクラスから取得したビットマップハンドルを格納しても動作することを確認しました。(その場合はWsEasyPicsではなく、当クラスのPrintBmpを使ってください。)

使用例↓
[hide]
コード:
' TODO: この位置にグローバルな変数、構造体、定数、関数を定義します。
Dim buf As TOUMEI,hBmp As HBITMAP
'-----------------------------------------------------------------------------
' ウィンドウメッセージを処理するためのコールバック関数

Function MainWndProc(hWnd As HWND, dwMsg As DWord, wParam As WPARAM, lParam As LPARAM) As DWord
	' TODO: この位置にウィンドウメッセージを処理するためのコードを記述します。

	' イベントプロシージャの呼び出しを行います。
	MainWndProc=EventCall_MainWnd(hWnd,dwMsg,wParam,lParam)
End Function
'-----------------------------------------------------------------------------
' ここから下は、イベントプロシージャを記述するための領域になります。

Sub MainWnd_Destroy()
	mugen_tsuika_DestroyObjects()
	PostQuitMessage(0)
End Sub

Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
	Dim hDC As HDC
	hDC=GetDC(hMainWnd)
	hBmp=LoadImage(NULL,"char.bmp",IMAGE_BITMAP,40,40,LR_LOADFROMFILE)
	buf.CreateTSPARENT(hDC,hBmp,0)
	ReleaseDC(hMainWnd,hDC)
End Sub

Sub MainWnd_Paint(hDC As HDC)
	buf.PrintData(hDC,20,50,60,30)
End Sub
[/hide]

WsEasyPicsを使わせていただく場合は
[hide]
コード:
#include<WSLib7_EasyPics.sbp>
' TODO: この位置にグローバルな変数、構造体、定数、関数を定義します。
Dim buf As TOUMEI
Dim bp As WsEasyPics
'-----------------------------------------------------------------------------
' ウィンドウメッセージを処理するためのコールバック関数

Function MainWndProc(hWnd As HWND, dwMsg As DWord, wParam As WPARAM, lParam As LPARAM) As DWord
	' TODO: この位置にウィンドウメッセージを処理するためのコードを記述します。

	' イベントプロシージャの呼び出しを行います。
	MainWndProc=EventCall_MainWnd(hWnd,dwMsg,wParam,lParam)
End Function
'-----------------------------------------------------------------------------
' ここから下は、イベントプロシージャを記述するための領域になります。

Sub MainWnd_Destroy()
	mugen_tsuika_DestroyObjects()
	PostQuitMessage(0)
End Sub

Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
	Dim hDC As HDC
	hDC=GetDC(hMainWnd)
	bp.BloadPics("char.bmp")
	buf.CreateTSPARENT(hDC,bp.GetHandleBmp(),0)
	ReleaseDC(hMainWnd,hDC)
End Sub

Sub MainWnd_Paint(hDC As HDC)
	buf.PrintData(hDC,20,50,60,30)
End Sub

[/hide]


通報する
ページトップ
   
 記事の件名: 問題発見
投稿記事Posted: 2012年11月08日(木) 20:30 
投稿してすぐ問題に気づきました。

使用例のMainWnd_Destroy()に
コード:
DeleteObject(hBmp)
が必要ですよね。


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

All times are UTC+09:00


オンラインデータ

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


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

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