モザイク(Ⅳ)矩形範囲指定 <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
上記を加えた例
参照
'================================================================ '= モザイク(Ⅳ)範囲指定 '= (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