ab.com コミュニティ

コード: 全て選択

'表示には淡幻星さんが作ったクラスを使っています。
'http://www.activebasic.com/forum/viewtopic.php?t=672
'変数PaintNameにパスが入っている
Sub MainWnd_Paint(hDC As HDC)
    Dim hBmp As HBITMAP              'ビットマップ ハンドル
    Dim hMemDC As HDC          'メモリ内 デバイスコンテキストのハンドル
    Dim BitmapReport As BITMAP    'ビットマップ情報を格納するための構造体
    Dim dx As Long, dy As Long    'ウィンドウサイズとクライアント領域サイズの差
	Dim x As Long,y As Long
	Dim hImage1 As HWND
	Dim hIDC As HDC
	Dim buffer[255] As Byte

    'ファイルが開かれていない場合は抜け出す
    If PaintName="" Then Exit Sub

	hImage1=GetDlgItem(hMainWnd,ImageBox1)
	hIDC=GetDC(hImage1)

    'ファイルをロード
	lp.CreatePic(PaintName)
    hBmp=lp.GetBmpHandle()
    If hBmp=0 Then
        MessageBox(hMainWnd, "ビットマップのオープンに失敗", "エラー", MB_OK)
        Exit Sub
    End If

    'ビットマップのサイズを取得
    GetObject(hBmp As VoidPtr,Len(BitmapReport),BitmapReport)

    'イメージボックスをビットマップのサイズにあわせる
    MoveWindow(hImage1,160,32,BitmapReport.bmWidth,BitmapReport.bmHeight,1)

    hMemDC=CreateCompatibleDC(hDC As HDC) 'メモリ内にデバイスコンテキストを作成する
    SelectObject(hMemDC As HDC,hBmp As VoidPtr)      'ビットマップを選択

    'ビットマップを描画
    BitBlt(hIDC,0,0,BitmapReport.bmWidth,BitmapReport.bmHeight,hMemDC As HDC,0,0,SRCCOPY)
	
	'画像サイズを表示
	x=lp.GetWidth()
	y=lp.GetHeight()
    wsprintf(buffer,"画像: %d×%d",x,y)
    SendMessage(hStatusWnd,SB_SETTEXT,3, buffer As Long)

	ReleaseDC(hImage1,hIDC) 'デバイスコンテキストを解放
    DeleteDC(hMemDC As HDC)   'メモリ内のデバイスコンテキストを解放する
	PaintName="" 'ここでゼロにする
End Sub