条件付画像拡大縮小転送             <TOP>

StretchBltを使って画像を拡大(縮小)転送してみます。いろいろな条件を選択できるようですが識別しやすい条件のみ選択できるようにしてみました。

ビットマップファイルBitBlt.bmpとBitBlt2.bmpを用意します。例では120×80(ピクセル)

StretchBlt 画像拡大縮小転送

GetDC デバイスコンテキスト取得

ReleaseDC デバイスコンテキスト解放

　

フォーム設計（Picture1とPicture2を異なるサイズに設定します。）

テストに使用した画像（Picture1、Picture2）

　 


'================================================================
'= 画像の拡大縮小転送
'=    (StretchBlt.bas)
'================================================================
#include "Windows.bi"

' 拡縮をともなうグラフィックデバイス間のイメージを転送
Declare Function Api_StretchBlt& Lib "gdi32" Alias "StretchBlt" (ByVal hDC&, ByVal X&, ByVal Y&, ByVal nWidth&, ByVal nHeight&, ByVal hSrcDC&, ByVal xSrc&, ByVal ySrc&, ByVal nSrcWidth&, ByVal nSrcHeight&, ByVal dwRop&)

' 指定されたウィンドウのクライアント領域または画面全体を表すディスプレイデバイスコンテキストのハンドルを取得
Declare Function Api_GetDC& Lib "user32" Alias "GetDC" (ByVal hWnd&)

' デバイスコンテキストを解放
Declare Function Api_ReleaseDC& Lib "user32" Alias "ReleaseDC" (ByVal hWnd&, ByVal hDC&)

#define SRCCOPY &HCC0020                'コピー元をコピー
#define SRCPAINT &HEE0086               'コピー元とコピー先をOR合成
#define SRCAND &H8800C6                 'コピー元とコピー先をAND合成
#define SRCINVERT &H660046              'コピー元とコピー先をXOR合成
#define SRCERASE &H440328               '転送先ビットマップを反転、その結果と転送元ビットマップを論理AND演算子で結合
#define NOTSRCCOPY &H330008             'コピー元を反転してコピー
#define NOTSRCERASE &H1100A6            'コピー元の色と、コピー先の色を論理OR演算子で結合し、さらに反転
#define MERGECOPY &HC000CA              'コピー元の色と、コピー先の色を論理AND演算子で結合
#define MERGEPAINT &HBB0226             '反転した転送元ビットマップとパターンビットマップを論理OR演算子で結合
#define PATCOPY &HF00021                '指定のパターンで描画先へコピー
#define PATINVERT &H5A0049              'XORで指定のパターンと描画先の色を組み合わせる
#define PATPAINT &HF80A09               '指定パターンの色と、コピー元の色を反転した色を論理OR演算子で結合し、結果をコピー先の色と論理OR演算子
#define DSTINVERT &H550009              'コピー先を反転してコピー
#define BLACKNESS &H42                  'すべてを黒にしてコピー
#define WHITENESS &HFF0062              'すべてを白にしてコピー

Var Shared Picture1 As Object
Var Shared Picture2 As Object
Var Shared Radio(4) As Object
Var Shared Bitmap As Object
BitmapObject Bitmap

Picture1.Attach GetDlgItem("Picture1")
Picture2.Attach GetDlgItem("Picture2")
For i = 0 To 4
    Radio(i).Attach GetDlgItem("Radio" & Trim$(Str$(i + 1)))
    Radio(i).SetFontSize 14
Next

Var Shared hDC1 As Long
Var Shared hDC2 As Long
Var Shared WK As Long

'================================================================
'=　
'================================================================
Declare Sub PIC2_BMPSET edecl ()
Sub PIC2_BMPSET()
	Bitmap.LoadFile "BitBlt2.bmp"
'   Picture2.StretchBitmap Bitmap, 0, 0, Picture2.GetWidth, Picture1.GetHeight
    Picture2.DrawBitmap Bitmap, 0, 0
    Bitmap.DeleteObject
End Sub

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    WK = &HCC0020
    Bitmap.LoadFile "BitBlt.bmp"
'   Picture1.StretchBitmap Bitmap, 0, 0, Picture1.GetWidth, Picture1.GetHeight
    Picture1.DrawBitmap Bitmap, 0, 0
    Bitmap.DeleteObject

    hDC1 = Api_GetDC(Picture1.GethWnd)
    hDC2 = Api_GetDC(Picture2.GethWnd)
End Sub

'================================================================
'= Picture1の画像をPicture2に条件付でコピーする
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var Ret As Long

    Ret = API_StretchBLT(hDC2, 0, 0, Picture2.GetWidth, Picture2.GetHeight, hDC1, 0, 0, Picture1.GetWidth, Picture1.GetHeight, WK)
End Sub

'================================================================
'=　
'================================================================
Declare Sub Radio1_on edecl ()
Sub Radio1_on()
    'Picture1をPicture2に転送
    Picture2.Cls
    WK = &HCC0020
End Sub

Declare Sub Radio2_on edecl ()
Sub Radio2_on()
    'Picture1とPicture2をOR合成
    Picture2.Cls
    WK = &HEE0086
    PIC2_BMPSET
End Sub

Declare Sub Radio3_on edecl ()
Sub Radio3_on()
    'Picture1とPicture2をAND合成
    Picture2.Cls
    WK = &H8800C6
    PIC2_BMPSET
End Sub

Declare Sub Radio4_on edecl ()
Sub Radio4_on()
    'Picture1とPicture2をXOR合成
    Picture2.Cls
    WK = &H660008
    PIC2_BMPSET
End Sub

Declare Sub Radio5_on edecl ()
Sub Radio5_on()
    'Picture1を反転して転送
    Picture2.Cls
    WK = &H330009
End Sub

'================================================================
'=　
'================================================================
Declare Sub MainForm_QueryClose edecl (Cancel%, ByVal Mode%)
Sub MainForm_QueryClose(Cancel%, ByVal Mode%)
    Var Ret As Long

    If Cancel% = 0 Then
        Ret = Api_ReleaseDC(Picture1.GethWnd, hDC1)
        Ret = Api_ReleaseDC(Picture2.GethWnd, hDC2)
        End
    End If
End Sub

'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End