イメージビューア1

イメージビューアを作る

ファイルを選択する

ビットマップファイルを開く

'-----------------------------------------------------------------------------
'  イベント プロシージャ
'-----------------------------------------------------------------------------
' このファイルには、ウィンドウ [MainWnd] に関するイベントをコーディングします。
' ウィンドウ ハンドル: hMainWnd

' TODO: この位置にグローバルな変数、構造体、定数、関数を定義します。
#include<vcrt71.sbp>
Dim hDspDC As HDC
Dim hMemDC As HDC
Dim hBmp As HBITMAP
Dim bmh As Long
Dim bmw As Long
'-----------------------------------------------------------------------------
' ウィンドウメッセージを処理するためのコールバック関数

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

'-----------------------------------------------------------------------------
' ここから下は、イベントプロシージャを記述するための領域になります。

'WM_DESTROY
Sub MainWnd_Destroy()
    DeleteObject(hBmp)
    DeleteDC(hMemDC)
    ReleaseDC(hMainWnd , hDspDC)
    ImgVip_DestroyObjects()
    PostQuitMessage(0)
End Sub

'WM_CREATE
Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
    hDspDC =GetDC(hMainWnd)
    hMemDC =CreateCompatibleDC(hDspDC)
End Sub

'WM_PAINT
Sub MainWnd_Paint(hDC As HDC)
    BitBlt(hDspDC , 0 , 0,bmw,bmh,hMemDC , 0, 0,SRCCOPY)
End Sub


'画像ファイルを開いてhBmpに描く
Sub OpenImg(filenam As *Byte)
    Dim fp As *FILE
    Dim bfh As BITMAPFILEHEADER
    Dim bi  As *BITMAPINFO
    Dim Bytes As DWord
    Dim pixel As *Byte
    Dim WR As RECT, CR As RECT
    Dim dx As Long,dy As Long

    If hBmp <> 0 Then DeleteObject(hBmp)'ビットマップがあれば削除
    
    fp = fopen(filenam , "rb")
    If fp = NULL Then
        MessageBox(hMainWnd , "ファイルを開けません" , "エラー" , MB_OK)
        Exit Sub
    End If

    fread(VarPtr(bfh) , sizeof(BITMAPFILEHEADER) , 1 , fp)
    Bytes = sizeof (BITMAPFILEHEADER)
    
    If bfh.bfType <> &h4D42 Then
        MessageBox(hMainWnd , "ビットマップファイルではありません" , _
            "エラー" , MB_OK)
        Exit Sub
    End If
    
    bi = malloc(bfh.bfOffBits - Bytes)
    fread(bi , 1 ,bfh.bfOffBits - Bytes , fp)
    
    pixel = malloc(bfh.bfSize - bfh.bfOffBits)
    fread(pixel , 1 , bfh.bfSize - bfh.bfOffBits , fp)
    fclose(fp)

    hBmp = CreateDIBitmap(hDspDC , bi->bmiHeader , CBM_INIT , pixel , _
                            ByVal bi , DIB_RGB_COLORS)
    If hBmp = 0 Then
        MessageBox(hMainWnd , "ビットマップを作れません" , "エラー",MB_OK)
        Exit Sub
    End If

    bmh = bi->bmiHeader.biHeight
    bmw = bi->bmiHeader.biWidth
    free(bi)
    free(pixel)

    'ウィンドウサイズとクライアント領域サイズの差を計算
    GetWindowRect(hMainWnd, WR)
    GetClientRect(hMainWnd, CR)
    dx = (WR.right - WR.left) - (CR.right - CR.left)
    dy = (WR.bottom - WR.top) - (CR.bottom - CR.top)
    
    'ウィンドウサイズをビットマップのサイズにあわせる
    MoveWindow(hMainWnd, WR.left, WR.top, bmw+dx ,bmh+dy, 1)
    SelectObject(hMemDC , hBmp)
    MainWnd_Paint(hDspDC)
End Sub

'メニュー開く
Sub MainWnd_IDM_OPEN_MenuClick()
    Dim ofn As OPENFILENAME
    Dim file[MAX_PATH] As Byte
    ofn.hwndOwner = hMainWnd
    ofn.lStructSize = sizeof(OPENFILENAME)'
    ofn.lpstrFilter = Ex"ビットマップ(*.bmp)\0*.bmp\0全てのファイル\0*.*\0\0"
    ofn.nMaxFile = MAX_PATH
    ofn.lpstrFile = file
    GetOpenFileName(ofn)
    If file = NULL Then Exit Sub
    OpenImg(file)
End Sub

'メニュー終了
Sub MainWnd_IDM_EXIT_MenuClick()
    SendMessage(hMainWnd , WM_CLOSE , 0,0)
End Sub

'メニューバージョン情報
Sub MainWnd_IDM_ABOUT_MenuClick()
    MessageBox(hMainWnd , Ex"画像ビューア\nバージョン1.0" , "バージョン" , MB_OK)
End Sub