by よしき » 2006年8月18日(金) 16:16
上のコードはまちがいです。
こちらです。
間違いばかりですみません…。
コード: 全て選択
'-----------------------------------------------------------------------------
' イベント プロシージャ
'-----------------------------------------------------------------------------
' このファイルには、ウィンドウ [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
これで白黒画像の黒さグラフを作っているのですが、グラフの保存がなんともできません。それでさっきの質問「BitMapかなにかで保存できるようにしたいのですが、どうすればいいのですか?」です。できませんか?
上のコードはまちがいです。
こちらです。
間違いばかりですみません…。
[code]
'-----------------------------------------------------------------------------
' イベント プロシージャ
'-----------------------------------------------------------------------------
' このファイルには、ウィンドウ [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
[/code]
これで白黒画像の黒さグラフを作っているのですが、グラフの保存がなんともできません。それでさっきの質問「BitMapかなにかで保存できるようにしたいのですが、どうすればいいのですか?」です。できませんか?