戻り値の受け取り方
Posted: 2006年8月17日(木) 13:24
GetPixel(ハンドル,x座標,y座標)
で、返ってきたRGB値はどのように受け取ればいいんですか?
DWord 型の変数で受け取るみたいなのですが・・・。
で、返ってきたRGB値はどのように受け取ればいいんですか?
DWord 型の変数で受け取るみたいなのですが・・・。
コード: 全て選択
Dim rgb As DWord
rgb=GetPixel(ハンドル,x座標,y座標)
Debug '変数rgbにRGB値が入ります。
コード: 全て選択
Dim rgb As DWord
' GetPixel()関数の戻り値をDWrod型ローカル変数rgbに格納
rgb=GetPixel(ハンドル,x座標,y座標)
' DWord型ローカル変数rgbの値をデバッガに出力します。
OutputDebugString(Str$(rgb))
コード: 全て選択
If CLR_INVALID<>GetPixel(ハンドル,x座標,y座標) Then
' GetPixel()関数が成功した場合の処理
End If
DWord値からそれぞれのRGB成分を抽出する方法を知りたいということでは?> GetPixel(ハンドル,x座標,y座標)
> で、返ってきたRGB値はどのように受け取ればいいんですか?
> DWord 型の変数で受け取るみたいなのですが・・・。
たとえば、DWord値からそれぞれのRGB成分を抽出する方法を知りたいということでは?
コード: 全て選択
'[ActiveBasic 4.24:動作確認済み(一部省略)]
Dim rgb As DWord
Dim R As Byte, G As Byte, B As Byte
'ここで、すでに変数「rgb」に値が入っているとします。
R = rgb Mod 256
rgb \= 256
G = rgb Mod 256
rgb \= 256
B = rgb Mod 256
'ここまで実行すれば、Rに赤の成分、Gに緑の成分、Bに青の成分が入っています。
'ちなみに、変数「rgb」の値は、書き換えられているので注意してください。
End
コード: 全て選択
'[ActiveBasic 4.24:動作確認済み(一部省略)]
Dim rgb As DWord
Dim RGB_Color(2) As Byte
'ここで、すでに変数「rgb」に値が入っているとします。
'RGBのそれぞれの成分を取得します
Get_RGB(rgb, RGB_Color)
Print RGB_Color(0) '赤の成分
Print RGB_Color(1) '緑の成分
Print RGB_Color(2) '青の成分
End
Sub Get_RGB(Color_Num As DWord, ByRef RGB_Num() As Byte)
RGB_Num(0) = Color_Num Mod 256
Color_Num \= 256
RGB_Num(1) = Color_Num Mod 256
Color_Num \= 256
RGB_Num(2) = Color_Num Mod 256
End Sub
コード: 全て選択
Const GetRValue(rgb) = (rgb And &hff) Const GetGValue(rgb) = ((rgb >> 8) And &hff) Const GetBValue(rgb) = ((rgb >> 16) And &hff)
コード: 全て選択
'-----------------------------------------------------------------------------
' イベント プロシージャ
'-----------------------------------------------------------------------------
' このファイルには、ウィンドウ [MainWnd] に関するイベントをコーディングします。
' ウィンドウ ハンドル: hMainWnd
' TODO: この位置にグローバルな変数、構造体、定数、関数を定義します。
'ビットマップのファイル名
Dim FileName As String
'「開く」ダイアログの拡張子フィルター
Dim BitmapFileFilter As String
BitmapFileFilter = "ビットマップ ファイル(*.bmp)" + Chr$(0) + "*.bmp" + Chr$(0) + _
"すべてのファイル(*.*)" + Chr$(0) + "*" + Chr$(0)
'-----------------------------------------------------------------------------
' ウィンドウメッセージを処理するためのコールバック関数
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()
Monochrome_Judge_DestroyObjects()
PostQuitMessage(0)
End Sub
Sub MainWnd_IDM_OPEN_MenuClick()
Dim ofn As OPENFILENAME
Dim buffer As String
'ファイル名を取得
ofn.lStructSize=Len(ofn)
ofn.hwndOwner=hMainWnd
ofn.lpstrFilter=StrPtr(BitmapFileFilter)
ofn.nFilterIndex=1
buffer=ZeroString(MAX_PATH)
ofn.lpstrFile=StrPtr(buffer)
ofn.nMaxFile=MAX_PATH
If GetOpenFileName(ofn)=0 Then Exit Sub
FileName=ofn.lpstrFile
'再描画要求を出す
InvalidateRect(hMainWnd,ByVal 0,1)
End Sub
Sub MainWnd_Paint(hDC As Long)
Dim hBmp As Long 'ビットマップ ハンドル
Dim hMemDC As Long 'メモリ内 デバイスコンテキストのハンドル
Dim BitmapReport As BITMAP 'ビットマップ情報を格納するための構造体
Dim dx As Long, dy As Long 'ウィンドウサイズとクライアント領域サイズの差
'ファイルが開かれていない場合は抜け出す
If FileName="" Then Exit Sub
'ビットマップをロード
hBmp=LoadImage(GetWindowLong(hMainWnd, GWL_HINSTANCE), FileName, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE)
If hBmp=0 Then
MessageBox(hMainWnd, "ビットマップのオープンに失敗", "BmpViewer", MB_OK)
Exit Sub
End If
'ビットマップのサイズを取得
GetObject(hBmp, Len(BitmapReport), BitmapReport)
'ウィンドウサイズとクライアント領域サイズの差を計算
Dim rc_Window As RECT, rc_Client As RECT
GetWindowRect(hMainWnd, rc_Window)
GetClientRect(hMainWnd, rc_Client)
dx = (rc_Window.right - rc_Window.left) - (rc_Client.right - rc_Client.left)
dy = (rc_Window.bottom - rc_Window.top) - (rc_Client.bottom - rc_Client.top)
'ウィンドウサイズをビットマップのサイズにあわせる
MoveWindow(hMainWnd, rc_Window.left, rc_Window.top, BitmapReport.bmWidth+dx ,BitmapReport.bmHeight+dy, 1)
hMemDC=CreateCompatibleDC(hDC) 'メモリ内にデバイスコンテキストを作成する
SelectObject(hMemDC, hBmp) 'ビットマップを選択
'ビットマップを描画
BitBlt(hDC, 0, 0, BitmapReport.bmWidth, BitmapReport.bmHeight, hMemDC, 0, 0, SRCCOPY)
Dim hDCBit As HDC
Const GetRValue(rgb) = (rgb And &hff)
Dim r As Long
Dim x As Long
Dim rgb As DWord
hDCBit=GetDC(hBit)
For x=1 to 480
rgb=GetPixel(hMemDC,x,240)
r=GetRValue(rgb)
LineTo(hDCBit,x,r)
Next x
End Sub
コード: 全て選択
Sub SaveBmp(Dest As String,hDC As HDC,bx As Long,by As Long,x As Long,y As Long)(hWnd As HWND)
Dim FileHeader As String
Dim FileLof As Long
Dim I As Long
Dim J As Long
Dim X As Long
Dim A$ As String
Dim Color As Long
Dim Rect As RECT
If x=0 or y=0 then
GetClientRect(hWnd,Rect)
x=Rect.right-bx
y=Rect.bottom-by
End If
'ファイルサイズの計算
FileLof=x*3
if FileLof Mod 4<>0 then FileLof=Int(FileLof/4+1)*4
FileLof=FileLof*y+54
'ヘッダ作成
FileHeader="BM"+_
Chr$((FileLof And &HFF) As Byte)+Chr$((FileLof>>8 And &HFF) As Byte)+Chr$((FileLof>>16 And &HFF) As Byte)+Chr$((FileLof>>24 And &HFF) As Byte)+_
Chr$(0)+Chr$(0)+_
Chr$(0)+Chr$(0)+_
Chr$(54)+Chr$(0)+Chr$(0)+Chr$(0)+_
Chr$(40)+Chr$(0)+Chr$(0)+Chr$(0)+_
Chr$((x And &HFF) As Byte)+Chr$((x>>8 And &HFF) As Byte)+Chr$((x>>16 And &HFF) As Byte)+Chr$((x>>24 And &HFF) As Byte)+_
Chr$((y And &HFF) As Byte)+Chr$((y>>8 And &HFF) As Byte)+Chr$((y>>16 And &HFF) As Byte)+Chr$((y>>24 And &HFF) As Byte)+_
Chr$(1)+Chr$(0)+_
Chr$(24)+Chr$(0)+_
Chr$(0)+Chr$(0)+Chr$(0)+Chr$(0)+_
Chr$(0)+Chr$(0)+Chr$(0)+Chr$(0)+_
Chr$(0)+Chr$(0)+Chr$(0)+Chr$(0)+_
Chr$(0)+Chr$(0)+Chr$(0)+Chr$(0)+_
Chr$(0)+Chr$(0)+Chr$(0)+Chr$(0)+_
Chr$(0)+Chr$(0)+Chr$(0)+Chr$(0)
'書き込み開始
Open Dest As #1
Field #1,54
Put #1,1,FileHeader
Field #1,1
X=55
A$=Ex"\0"
For I=y-1 To 0 Step -1
For J=0 To x-1
Color=GetPixel(hDC,bx+J,by+I)
A$[0]=GetRValue(Color)
Put #1,X,A$
A$[0]=GetGValue(Color)
Put #1,X+1,A$
A$[0]=GetBValue(Color)
Put #1,X+2,A$
X=X+3
Next J
Select Case x Mod 4
Case 1
X=X+3
Case 2
X=X+2
Case 3
X=X+1
End Select
Next I
Close #1
End Sub
コード: 全て選択
SaveBmp("1.bmp",GetDC(hMainWnd),0,0,0,0,hMainWnd)