メモリDCを使った画像の表示例
 　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　玄関へお回り下さい。
メモリDCを使っての画像表示（拡大・縮小・鏡像・180度回転）　　　（１０７）
　　 画像表示にメモリDCを使ったからと言って、特にどうって事はないのですが、しいて言えば
作業用のピクチャーボックスが要らないぐらかな！。

フォームにピクチャーボックス１個とコマンドボタンを配列にして５個とコンボボックスを１個
貼付て下さい。

フォームの宣言セクションに記入

Option Explicit　　 'SampleNo=107　WindowsXP VB6.0(SP5) 2002.05.21
'指定のデバイスコンテキストと互換性のある
'　　　　　　　 メモリデバイスコンテキストを作成する（P251）
Private Declare Function CreateCompatibleDC Lib "gdi32" _
　　(ByVal hdc As Long) As Long
'デバイスコンテキストと互換性のあるビットマップを作成する（P346)
Private Declare Function CreateCompatibleBitmap Lib "gdi32" _
　　(ByVal hdc As Long, ByVal nWidth As Long, _
　　 ByVal nHeight As Long) As Long
'デバイスコンテキストにオブジェクトを選択する（P268)
Private Declare Function SelectObject Lib "gdi32" _
　　(ByVal hdc As Long, ByVal hObject As Long) As Long
'ビットマップのストレッチングモードを設定する(P503)
Private Declare Function SetStretchBltMode Lib "gdi32" _
　　(ByVal hdc As Long, ByVal nStretchMode As Long) As Long
'指定のデバイスコンテキストへビットマップをコピーする（P470)
Private Declare Function BitBlt Lib "gdi32" _
　　(ByVal hDestDC As Long, ByVal x As Long, _
　　 ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, _
　　 ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, _
　　 ByVal dwRop As Long) As Long
'ビットマップを拡大・縮小してコピーする（P504）
Private Declare Function StretchBlt Lib "gdi32" _
　　(ByVal hdc As Long, ByVal x As Long, _
　　 ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, _
　　 ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, _
　　 ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, _
　　 ByVal dwRop As Long) As Long
'デバイスコンテキストを削除する（P252)
Private Declare Function DeleteDC Lib "gdi32" _
　　(ByVal hdc As Long) As Long
'グラフィックオブジェクトを削除しシステムリソースを解放する（P261)
Private Declare Function DeleteObject Lib "gdi32" _
　　(ByVal hObject As Long) As Long
Private Const SRCCOPY = &HCC0020　　　 'そのままコピー
Private SourcePictureName As String　　'画像ファイル名　FullPath
Private Const STRETCH_DELETESCANS = 3　'コピー元のピクセルで置換え(P503)
'一見こちらの方が綺麗な画像のように思えるが何回か繰り返すと色が変になる
Private Const STRETCH_HALFTONE = 4　　 'コピー先のピクセルの平均カラー値をとる
　　
　　 初期設定とメニュー　　　
Private Sub Form_Load()
　　SourcePictureName = "..\image.jpg"
　　'別途プロパティを設定でも可
　　With Picture1
　　　　.ScaleMode = vbPixels
　　　　.AutoSize = True
　　　　.AutoRedraw = False　　 'True でもOKですが、一部変更しないとNG
　　　　Set .Picture = LoadPicture(SourcePictureName)
　　　　.BorderStyle = vbBSNone
　　End With
　　Command1(0).Caption = "原画表示"
　　Command1(1).Caption = "左右鏡像"
　　Command1(2).Caption = "上下鏡像"
　　Command1(3).Caption = "180度回転"
　　Command1(4).Caption = "拡大縮小表示"
　　With Combo1
　　　　.AddItem "0.3"
　　　　.AddItem "0.5"
　　　　.AddItem "0.8"
　　　　.AddItem "1.0"
　　　　.AddItem "1.2"
　　　　.AddItem "1.5"
　　　　.Text = "1.0"
　　End With
End Sub


Private Sub Command1_Click(Index As Integer)
　　Select Case Index
　　　　Case 0　　　　'原画表示
　　　　　　Set Picture1.Picture = LoadPicture(SourcePictureName)
　　　　Case 1, 2, 3　'鏡像表示・180度回転表示
　　　　　　Call PictureCopy(Picture1, Index, 1)
　　　　Case 4　　　　'拡大縮小表示
　　　　　　Call PictureCopy(Picture1, Index, CSng(Combo1.Text))
　　End Select
End Sub
　　
　　 画像表示のプロシージャを作成

Private Sub PictureCopy(Pic1 As PictureBox, _
　　　　　　　　　　　　　　WorkNo As Integer, Zoom As Single)
　　Dim hMemoryDC　As Long　　'メモリデバイスコンテキストのハンドル
　　Dim hBitmap　　As Long　　'ビットマップのハンドル
　　Dim hOldBitmap As Long　　'直前のビットマップのハンドル
　　Dim x　　　　　As Long　　'コピー開始x座標
　　Dim y　　　　　As Long　　'コピー開始y座標
　　Dim spsw　　　 As Long　　'元の画像の幅
　　Dim spsh　　　 As Long　　'元の画像の高さ
　　Dim cpsw　　　 As Long　　'コピー画像の幅
　　Dim cpsh　　　 As Long　　'コピー画像の高さ
　　Dim Ret As Long
　　With Pic1
　　　　'.Visible = False　　'AutoRedraw = True の場合必要
　　　　'コピー元の画像の幅，高さを取得
　　　　spsw = .ScaleWidth
　　　　spsh = .ScaleHeight
　　End With

　　'メモリデバイスコンテキストを作成する
　　hMemoryDC = CreateCompatibleDC(Pic1.hdc)
　　'互換性のあるビットマップを作成する
　　hBitmap = CreateCompatibleBitmap(Pic1.hdc, spsw, spsh)
　　'メモリDCにオブジェクトを選択する
　　hOldBitmap = SelectObject(hMemoryDC, hBitmap)
　　'メモリDCにビットマップをコピーする
　　BitBlt hMemoryDC, 0&, 0&, spsw, spsh, Pic1.hdc, 0&, 0&, SRCCOPY
　　Select Case WorkNo
　　　　Case 1　　　 '左右方向の鏡像
　　　　　　x = spsw - 1
　　　　　　y = 0&
　　　　　　cpsw = -spsw
　　　　　　cpsh = spsh
　　　　Case 2　　　 '上下方向の鏡像
　　　　　　x = 0&
　　　　　　y = spsh - 1
　　　　　　cpsw = spsw
　　　　　　cpsh = -spsh
　　　　Case 3　　　 '180度回転
　　　　　　x = spsw - 1
　　　　　　y = spsh - 1
　　　　　　cpsw = -spsw
　　　　　　cpsh = -spsh
　　　　Case 4　　　'拡大・縮小表示
　　　　　　x = 0&
　　　　　　y = 0&
　　　　　　cpsw = spsw * Zoom
　　　　　　cpsh = spsh * Zoom
　　　　　　With Pic1
　　　　　　　　.Width = .Width * Zoom
　　　　　　　　.Height = .Height * Zoom
　　　　　　End With
　　　　　　DoEvents　　'AutoRedraw = True の場合不要
　　End Select
　　'コピー先のピクセルをコピー元のピクセルで置換する
　　'WindowsXP の場合指定しておかないと縮小画像がきたない
　　Ret = SetStretchBltMode(Pic1.hdc, STRETCH_DELETESCANS)
　　'コピー開始
　　StretchBlt Pic1.hdc, x, y, cpsw, cpsh, _
　　　　　　　　　　　　　　hMemoryDC, 0&, 0&, spsw, spsh, SRCCOPY
　　Ret = SetStretchBltMode(Pic1.hdc, Ret)　'直前のモードに戻す
　　'メモリDCのハンドルを解放する
　　DeleteDC hMemoryDC
　　DeleteObject hBitmap
　　Pic1.Visible = True
End Sub
　
拡大・縮小時は、拡大・縮小した画像が元になり、何度も拡大縮小を繰り返すと画像が劣化して
しまう、従って拡大・縮小する時は、表示用ピクチャーBoxを別に使用するか、拡大・縮小前に元の
画像を事前に読込んで置く等の工夫が必要になります。






2003/05/01