モザイク(W)矩形範囲指定         <TOP>


CreateBrushIndirect LOGBRUSH構造体を定義して論理ブラシを作成
SetRect RECT構造体の値を設定
FillRect ブラシで矩形領域を塗りつぶす
DeleteObject オブジェクトを削除
DrawFocusRect 指定の矩形の周囲にフォーカスを示す点線を描画
GetDC デバイスコンテキストのハンドルを取得
ReleaseDC デバイスコンテキストを解放
 

モザイクサイズの2乗に当たる各ポイントの色を取得しそれらの平均値を設定しています。

いろいろな画像をテストするため、ファイルをドラッグ&ドロップするようにしました。

更に、矩形範囲を指定できるようにしてみました。Picture1(左側)は、比較のための画像で特別必要ではありません。

DrawFocusRectは、もう一度実行すると消去されます。

矩形領域設定時、領域を連続して表示するには、
Var Shared oy1 As Single
Var Shared oy2 As Single
を加え

Declare Sub Picture2_MouseMove edecl (ByVal Button%, ByVal Shift%, ByVal sx!, ByVal sy!)
Sub Picture2_MouseMove(ByVal Button%, ByVal Shift%, ByVal sx!, ByVal sy!)
    Var rct As RECT
    Var Ret As Long

    rct.Left = x1
    rct.Top = y1

    If Button% = 1 Then
        x2 = sx
        y2 = sy

        'マウス移動前の矩形領域を設定し、消去
        rct.Right = ox2
        rct.Bottom = oy2
        Ret = Api_DrawFocusRect(hDC, rct)

        '現在の矩形領域を設定し、表示
        rct.Right = x2
        rct.Bottom = y2
        Ret = Api_DrawFocusRect(hDC, rct)

        '現在の矩形領域情報を保持
        ox2 = x2
        oy2 = y2
    End If
End Sub

 

上記を加えた例

 

参照

モザイク(T)

モザイク(U)

モザイク(V)

 

'================================================================
'= モザイク(W)範囲指定
'=    (Mosaic4.bas)
'================================================================
#include "Windows.bi"

Type LOGBRUSH
    lbStyle As Long
    lbColor As Long
    lbHatch As Long
End Type

Type RECT
    Left   As Long
    Top    As Long
    Right  As Long
    Bottom As Long
End Type

Type sColor
    r As Byte
    g As Byte
    b As Byte
End Type

' LOGBRUSH構造体を定義して論理ブラシを作成
Declare Function Api_CreateBrushIndirect& Lib "gdi32" Alias "CreateBrushIndirect" (lpLogBrush As LOGBRUSH)

' RECT構造体の値を設定
Declare Function Api_SetRect& Lib "user32" Alias "SetRect" (lpRect As RECT, ByVal X1&, ByVal Y1&, ByVal X2&, ByVal Y2&)

' ブラシで矩形領域を塗りつぶす
Declare Function Api_FillRect& Lib "user32" Alias "FillRect" (ByVal hDC&, ByRef r As RECT, ByVal hBrush&)

' ペン、ブラシ、フォント、ビットマップ、リージョン、パレットのいずれかの論理オブジェクトを削除し、そのオブジェクトに関連付けられていたすべてのシステムリソースを解放。オブジェクトを削除した後は、指定されたハンドルは無効になる
Declare Function Api_DeleteObject& Lib "gdi32" Alias "DeleteObject" (ByVal hObject&)

' 指定の矩形の周囲にフォーカスを示す点線を描画する
Declare Function Api_DrawFocusRect& Lib "user32" Alias "DrawFocusRect" (ByVal hDC&, lpRect As RECT)

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

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

#define BS_SOLID 0                      'ソリッドブラシ

Var Shared Text1 As Object
Var Shared Edit1 As Object
Var Shared Edit2 As Object
Var Shared Button1 As Object
Var Shared Picture1 As Object
Var Shared Picture2 As Object
Var Shared Bitmap As Object

Text1.Attach GetDlgItem("Text1") : Text1.SetFontSize 14
Edit1.Attach GetDlgItem("Edit1") : Edit1.SetFontSize 14
Edit2.Attach GetDlgItem("Edit2") : Edit2.SetFontSize 14
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14
Picture1.Attach GetDlgItem("Picture1")
Picture2.Attach GetDlgItem("Picture2")
BitmapObject Bitmap

Var Shared hDC As Long
Var Shared x1 As Single
Var Shared x2 As Single
Var Shared y1 As Single
Var Shared y2 As Single
Var Shared Capture As Integer

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    'デバイスコンテキストのハンドルを取得
    hDC = Api_GetDC(Picture2.GethWnd)
End Sub

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var lb As LOGBRUSH
    Var rct As RECT
    Var col As sColor
    Var hBrush As Long
    Var Size As Long
    Var z As Long
    Var x As Long
    Var y As Long
    Var rr As Long
    Var gg As Long
    Var bb As Long
    Var Ret As Long

    Size = Val(Edit1.GetWindowText)

    If x1 + x2 + y + y2 = 0 Then
        x1 = 0
        x2 = 100
        y1 = 0
        y2 = 100
    End If

    '変換する画像の位置の色を取得
    For x = x1 To x2 Step Size
        For y = y1 To y2 Step Size

            'モザイクサイズ(2乗)
            Z = Size ^ 2

      'モザイクサイズ内の各ポイントの色を取得
            For i = 1 To Size
                For j = 1 To Size
                    If Picture1.GetPixel(x + i, y + j) = -1 Then

                        '色を取得できなかった場合
                        z = z - 1
                    Else

                        '取得した色を加算
                        rr = rr + (Picture1.GetPixel(x + i, y + j) And &HFF)
                        gg = gg + ((Picture1.GetPixel(x + i, y + j) \ &H100) And &HFF)
                        bb = bb + ((Picture1.GetPixel(x + i, y + j) \ &H10000) And &HFF)
                    End If
                Next
            Next

            '色を平均値に戻す
            If z <> 0 Then
                col.r = rr / z
                col.g = gg / z
                col.b = bb / z
            End If

            '取得した色を設定
            lb.lbStyle = BS_SOLID
            lb.lbColor = RGB(col.r, col.g, col.b)

            'ブラシを作成
            hBrush = Api_CreateBrushIndirect(lb)

            'RECT構造体に値を設定
            Ret = Api_SetRect(rct, x, y, x + Size, y + Size)

            '矩形領域をブラシで塗りつぶす
            Ret = Api_FillRect(hDC, rct, hBrush)

            rr = 0
            gg = 0
            bb = 0

            'オブジェクトを削除
            Ret = Api_DeleteObject(hBrush)

            CallEvent
        Next
    Next
End Sub

'================================================================
'= シェルドロップされたファイル名を取得
'================================================================
Declare Sub Edit2_DropFiles edecl (ByVal DF As Long)
Sub Edit2_DropFiles(ByVal DF As Long)
    Var FileName As String
    Var CN As Long

    Picture1.Cls
    Picture2.Cls

    CN = GetDropFileCount(DF)
    FileName = GetDropFileName(DF, 0)

    If Right$(FileName, 4) <> ".bmp" Then
        A% = MessageBox("", "BMPファイルをドラッグ&ドロップしてください!", 0, 2)
        Exit Sub
    End If

    Edit2.SetWindowText FileName

    Bitmap.LoadFile FileName
    Picture1.StretchBitmap Bitmap, 0, 0, 100, 100
    Picture2.StretchBitmap Bitmap, 0, 0, 100, 100
    Bitmap.DeleteObject
End Sub

'================================================================
'=
'================================================================
Declare Sub Picture2_MouseDown edecl (ByVal Button%, ByVal Shift%, ByVal sx!, ByVal sy!)
Sub Picture2_MouseDown(ByVal Button%, ByVal Shift%, ByVal sx!, ByVal sy!)
    '矩形領域の左上を設定
    x1 = sx!
    y1 = sy!
End Sub

'================================================================
'=
'================================================================
Declare Sub Picture2_MouseUp edecl (ByVal Button%, ByVal Shift%, ByVal sx!, ByVal sy!)
Sub Picture2_MouseUp(ByVal Button%, ByVal Shift%, ByVal sx!, ByVal sy!)
    Var rct As RECT
    Var Ret As Long

    '矩形領域の右下を設定
    x2 = sx!
    y2 = sy!

    rct.Left = x1
    rct.Top = y1
    rct.Right = x2
    rct.Bottom = y2

    '選択矩形領域を表示
    Ret = Api_DrawFocusRect(hDC, rct)
End Sub

'================================================================
'=
'================================================================
Declare Sub MainForm_QueryClose edecl ()
Sub MainForm_QueryClose()
    'デバイスコンテキストを解放
    Ret = Api_ReleaseDC(Picture2.GethWnd, hDC)
End Sub

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