モザイク(V)         <TOP>


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

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

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

参照

モザイク(T)

モザイク(U)

モザイク(W)

 

'================================================================
'= モザイク(V)
'=    (Mosaic3.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_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

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var hDC As Long
    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

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

    Size = Val(Edit1.GetWindowText)

    Picture2.Cls

    '変換する画像の位置の色を取得
    For x = 0 To Picture1.GetWidth Step Size
        For y = 0 To Picture1.GetHeight 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

    'デバイスコンテキストを解放
    Ret = Api_ReleaseDC(Picture2.GethWnd, hDC)
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

    CN = GetDropFileCount(DF)
    FileName = GetDropFileName(DF, 0)
    Edit2.SetWindowText FileName

    Bitmap.LoadFile FileName
    Picture1.DrawBitmap Bitmap, 0, 0
    Bitmap.DeleteObject
End Sub

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