モザイク(V) <TOP>
CreateBrushIndirect LOGBRUSH構造体を定義して論理ブラシを作成
SetRect
RECT構造体の値を設定
FillRect
ブラシで矩形領域を塗りつぶす
DeleteObject オブジェクトを削除
GetDC
デバイスコンテキストのハンドルを取得
ReleaseDC
デバイスコンテキストを解放
モザイクサイズの2乗に当たる各ポイントの色を取得しそれらの平均値を設定しています。
いろいろな画像をテストするため、ファイルをドラッグ&ドロップするようにしました。
参照
'================================================================ '= モザイク(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