他の色で囲まれた部分を塗りつぶす
投稿者 shu  (社会人)
投稿日時
2012/7/4 00:00:25
ExtFloodFillだけだと塗る色(ブラシ)の指定が足りません。
http://social.msdn.microsoft.com/Forums/ja-JP/vbgeneralja/thread/7c8902d3-37d9-49a7-bdc0-792f9d99b3c7/
に似たような投稿があり解決されているようです。
一応サンプルです。hdc取得はGraphicsが扱える状態であればAPIはいらないです。
http://social.msdn.microsoft.com/Forums/ja-JP/vbgeneralja/thread/7c8902d3-37d9-49a7-bdc0-792f9d99b3c7/
に似たような投稿があり解決されているようです。
一応サンプルです。hdc取得はGraphicsが扱える状態であればAPIはいらないです。
Imports System.Runtime.InteropServices
Public Class Form1
Private Const FLOODFILLBORDER As UInteger = 0 ' 境界色を目印にして塗りつぶすとき
Private Const FLOODFILLSURFACE As UInteger = 1 ' 領域色を目印にして塗りつぶすとき(複数色の境界色で囲まれているときなど)
Private Structure LOGBRUSH
Public lbStyle As Integer
Public lbColor As Integer
Public lbHatch As Integer
End Structure
Private Declare Function CreateBrushIndirect Lib "gdi32" (ByRef lpLogBrush As LOGBRUSH) As IntPtr
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As IntPtr, ByVal hObject As Integer) As <MarshalAs(UnmanagedType.Bool)> Boolean
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As IntPtr) As <MarshalAs(UnmanagedType.Bool)> Boolean
Private Declare Function ExtFloodFill Lib "gdi32" _
(ByVal hdc As IntPtr, _
ByVal X As Integer, _
ByVal Y As Integer, _
ByVal crColor As Integer, _
ByVal wFillType As UInteger) As Boolean
Private ClickPT As Point = New Point(-1, -1)
Private Sub PictureBox1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles PictureBox1.Click
ClickPT = PictureBox1.PointToClient(Control.MousePosition)
PictureBox1.Refresh()
End Sub
Private Sub PictureBox1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles PictureBox1.Paint
Dim g = e.Graphics
For i = 0 To 5
g.FillRectangle(Brushes.Black, i * 35 + 5, 5, 30, 30)
Next
If ClickPT.X >= 0 AndAlso ClickPT.Y >= 0 Then
Dim hdc = g.GetHdc
Dim brs As New LOGBRUSH
brs.lbColor = ColorTranslator.ToWin32(Color.Red)
brs.lbHatch = 0
brs.lbStyle = 0
Dim hNewBrush = CreateBrushIndirect(brs)
Dim hOldBrush = SelectObject(hdc, hNewBrush)
ExtFloodFill(hdc, ClickPT.X, ClickPT.Y, 0, FLOODFILLSURFACE)
g.ReleaseHdc()
DeleteObject(hNewBrush)
End If
ClickPT = New Point(-1, -1)
End Sub
End Class
投稿者 viajar  (その他)
投稿日時
2012/7/11 16:43:19
回答ありがとうございます。
試してみます。
試してみます。
投稿者 下田の住人  (社会人)
投稿日時
2012/7/12 13:43:31
ご参考までに。
以下odeは
http://rucio.cloudapp.net/ThreadDetail.aspx?ThreadId=10691
をもとに作成しました。
PictureBoxが2つ、Labelが2つ、Button 1つをご用意下さい。
[CODE]
Imports System.Runtime.InteropServices
Public Class Form1
Private Declare Function ExtFloodFill Lib "gdi32" ( _
ByVal hdc As IntPtr, _
ByVal x As Integer, _
ByVal y As Integer, _
ByVal crColor As Integer, _
ByVal wFillType As UInteger) As Boolean
Private Declare Function CreateBrushIndirect Lib "gdi32" (ByRef lpLogBrush As LOGBRUSH) As IntPtr
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As IntPtr) As <MarshalAs(UnmanagedType.Bool)> Boolean
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As IntPtr) As IntPtr
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As IntPtr, ByVal hdc As IntPtr) As <MarshalAs(UnmanagedType.Bool)> Boolean
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As IntPtr, _
ByVal hObject As Integer) As <MarshalAs(UnmanagedType.Bool)> Boolean
Private Declare Function GetPixel Lib "gdi32" Alias "GetPixel" (ByVal hdc As IntPtr, ByVal x As Integer, ByVal y As Integer) As Integer
Private Declare Function CreateCompatibleDC Lib "gdi32" Alias "CreateCompatibleDC" (ByVal hdc As IntPtr) As IntPtr
Declare Auto Function BitBlt Lib "GDI32.DLL" ( _
ByVal hdcDest As IntPtr, _
ByVal nXDest As Integer, _
ByVal nYDest As Integer, _
ByVal nWidth As Integer, _
ByVal nHeight As Integer, _
ByVal hdcSrc As IntPtr, _
ByVal nXSrc As Integer, _
ByVal nYSrc As Integer, _
ByVal dwRop As Int32) As Boolean
Private Const FLOODFILLBORDER As UInteger = 0
Private Const FLOODFILLSURFACE As UInteger = 1
Private Const SRCCOPY = &HCC0020&
Private Structure LOGBRUSH
Public lbStyle As Integer
Public lbColor As Integer
Public lbHatch As Integer
End Structure
Dim oldX, oldY As Integer
Dim hDC As IntPtr
Dim hDC2 As IntPtr
以下odeは
http://rucio.cloudapp.net/ThreadDetail.aspx?ThreadId=10691
をもとに作成しました。
PictureBoxが2つ、Labelが2つ、Button 1つをご用意下さい。
[CODE]
Imports System.Runtime.InteropServices
Public Class Form1
Private Declare Function ExtFloodFill Lib "gdi32" ( _
ByVal hdc As IntPtr, _
ByVal x As Integer, _
ByVal y As Integer, _
ByVal crColor As Integer, _
ByVal wFillType As UInteger) As Boolean
Private Declare Function CreateBrushIndirect Lib "gdi32" (ByRef lpLogBrush As LOGBRUSH) As IntPtr
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As IntPtr) As <MarshalAs(UnmanagedType.Bool)> Boolean
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As IntPtr) As IntPtr
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As IntPtr, ByVal hdc As IntPtr) As <MarshalAs(UnmanagedType.Bool)> Boolean
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As IntPtr, _
ByVal hObject As Integer) As <MarshalAs(UnmanagedType.Bool)> Boolean
Private Declare Function GetPixel Lib "gdi32" Alias "GetPixel" (ByVal hdc As IntPtr, ByVal x As Integer, ByVal y As Integer) As Integer
Private Declare Function CreateCompatibleDC Lib "gdi32" Alias "CreateCompatibleDC" (ByVal hdc As IntPtr) As IntPtr
Declare Auto Function BitBlt Lib "GDI32.DLL" ( _
ByVal hdcDest As IntPtr, _
ByVal nXDest As Integer, _
ByVal nYDest As Integer, _
ByVal nWidth As Integer, _
ByVal nHeight As Integer, _
ByVal hdcSrc As IntPtr, _
ByVal nXSrc As Integer, _
ByVal nYSrc As Integer, _
ByVal dwRop As Int32) As Boolean
Private Const FLOODFILLBORDER As UInteger = 0
Private Const FLOODFILLSURFACE As UInteger = 1
Private Const SRCCOPY = &HCC0020&
Private Structure LOGBRUSH
Public lbStyle As Integer
Public lbColor As Integer
Public lbHatch As Integer
End Structure
Dim oldX, oldY As Integer
Dim hDC As IntPtr
Dim hDC2 As IntPtr
投稿者 下田の住人  (社会人)
投稿日時
2012/7/12 13:52:07
続きです。
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
PictureBox1.Refresh()
PictureBox2.Refresh()
PictureBox1.Image = New Bitmap(PictureBox1.Width, PictureBox1.Height)
PictureBox2.Image = New Bitmap(PictureBox2.Width, PictureBox2.Height)
Me.Width = 510 : Me.Height = 500
PictureBox1.Width = 350 : PictureBox1.Height = 300
PictureBox2.Width = 350 : PictureBox2.Height = 300
PictureBox1.BorderStyle = BorderStyle.FixedSingle
PictureBox2.Visible = False
Label1.Text = "マウス左ボタン 自由ライン作図"
Label2.Text = "塗りつぶし マウス右ボタンで"
Label2.ForeColor = Color.Brown
Button1.Text = "画面を最初に戻す"
PictureBox1.Refresh()
PictureBox1.Image = New Bitmap(PictureBox1.Width, PictureBox1.Height)
Dim gr As Graphics = Graphics.FromImage(PictureBox1.Image) ' PictureBox1.CreateGraphics
gr.DrawRectangle(Pens.Red, 20, 20, 100, 100)
gr.DrawRectangle(Pens.Green, 40, 60, 120, 100)
gr.DrawRectangle(Pens.Black, 50, 100, 120, 100)
gr.DrawRectangle(Pens.Blue, 60, 140, 120, 100)
gr.FillRectangle(Brushes.Red, 180, 20, 120, 100)
gr.FillRectangle(Brushes.Blue, 200, 40, 120, 100)
End Sub
Private Sub Button1_Click(sender As System.Object, e As System.EventArgs)
End Sub
Private Sub PictureBox1_Click(sender As Object, e As System.EventArgs) Handles PictureBox1.Click
End Sub
Private Sub PictureBox1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseMove
'---- 自由ラインを描く ---- 閉じた図形とすること
If e.Button = System.Windows.Forms.MouseButtons.Left Then
PictureBox1.Refresh()
Dim g As Graphics = Graphics.FromImage(PictureBox1.Image)
Dim myPen As New Pen(Color.Green, 3)
g.DrawLine(myPen, oldX, oldY, e.X, e.Y)
PictureBox1.Image = PictureBox1.Image
g.Dispose()
'Invalidate()
End If
oldX = e.X : oldY = e.Y
End Sub
投稿者 下田の住人  (社会人)
投稿日時
2012/7/12 13:53:43
続きです。
Private Sub PictureBox1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseDown
If e.Button = System.Windows.Forms.MouseButtons.Right Then
Dim g As Graphics = Graphics.FromImage(PictureBox1.Image)
Dim hWnd As IntPtr = PictureBox1.Handle
Dim hdc As IntPtr = GetWindowDC(hWnd)
Dim wFillType As UInteger = 1 ' FLOODFILLSURFACE
Dim hNewBrush As IntPtr
Dim hOldBrush As IntPtr
Dim NewBrush As LOGBRUSH
NewBrush.lbColor = ColorTranslator.ToWin32(Color.Yellow)
NewBrush.lbStyle = 0
NewBrush.lbHatch = 0
hNewBrush = CreateBrushIndirect(NewBrush)
hOldBrush = SelectObject(hdc, hNewBrush)
ExtFloodFill(hdc, e.X, e.Y, GetPixel(hdc, e.X, e.Y), wFillType) 'wFillType= FLOODFILLSURFACE=1
Dim gr As Graphics = Graphics.FromImage(PictureBox2.Image)
Dim hDC2 = gr.GetHdc
BitBlt(hDC2, 0 - 1, 0 - 1, 350, 300, hdc, 0, 0, SRCCOPY) 'SRCCOPY=&HCC0020&
PictureBox1.Image = PictureBox2.Image
ReleaseDC(hWnd, hdc) 'デバイスコンテキストを開放する
hNewBrush = SelectObject(hdc, hOldBrush) '元のブラシに戻す
DeleteObject(hNewBrush) '不要になったブラシを開放する
g.Dispose()
ReleaseDC(hWnd, hDC2)
gr.Dispose()
End If
End Sub
Private Sub Button1_Click_1(sender As System.Object, e As System.EventArgs) Handles Button1.Click
PictureBox1.Image = Nothing
PictureBox1.Refresh()
PictureBox1.Image = New Bitmap(PictureBox1.Width, PictureBox1.Height)
Dim gr As Graphics = Graphics.FromImage(PictureBox1.Image) ' PictureBox1.CreateGraphics
gr.DrawRectangle(Pens.Red, 20, 20, 100, 100)
gr.DrawRectangle(Pens.Green, 40, 60, 120, 100)
gr.DrawRectangle(Pens.Black, 50, 100, 120, 100)
gr.DrawRectangle(Pens.Blue, 60, 140, 120, 100)
gr.FillRectangle(Brushes.Red, 180, 20, 120, 100)
gr.FillRectangle(Brushes.Blue, 200, 40, 120, 100)
End Sub
End Class
投稿者 viajar  (社会人)
投稿日時
2012/7/29 00:59:00
新たにプロジェクトを作り直した上でshuさんのを丸写ししてみましたが何も起こりませんでした。
厳密に言えば
For i = 0 To 5
g.FillRectangle(Brushes.Black, i * 35 + 5, 5, 30, 30)
Next
の部分がなぜ必要なのかわからない(何をする処理なのかはわかります)ので削除しましたが、それ以外は全くコードの変更も追加もしていません。
エラーも発生しないし画面上に何の変化も起こりませんでした。
厳密に言えば
For i = 0 To 5
g.FillRectangle(Brushes.Black, i * 35 + 5, 5, 30, 30)
Next
の部分がなぜ必要なのかわからない(何をする処理なのかはわかります)ので削除しましたが、それ以外は全くコードの変更も追加もしていません。
エラーも発生しないし画面上に何の変化も起こりませんでした。
投稿者 shu  (社会人)
投稿日時
2012/7/29 05:06:21
> ExtFloodFill(hdc, ClickPT.X, ClickPT.Y, 0, FLOODFILLSURFACE)
の0は黒を表す番号なので描画領域に黒がないと何も塗られません。
なのでサンプルとして
黒い四角を6つ用意し、用意した黒い四角の上でマウスをクリックしたときに
黒い四角が塗られるのが確認出来るようになっています。
ということで黒い四角を作る処理を消してしまっては何も起こらないのは当然です。
の0は黒を表す番号なので描画領域に黒がないと何も塗られません。
なのでサンプルとして
黒い四角を6つ用意し、用意した黒い四角の上でマウスをクリックしたときに
黒い四角が塗られるのが確認出来るようになっています。
ということで黒い四角を作る処理を消してしまっては何も起こらないのは当然です。
投稿者 viajar  (社会人)
投稿日時
2012/8/21 13:55:53
>0は黒を表す番号なので描画領域に黒がないと何も塗られません。
もとからある画像ファイルの塗りつぶしを行いたいのですが……。
下田の住人さんのコードは後で試してみて後日結果を報告いたします。
もとからある画像ファイルの塗りつぶしを行いたいのですが……。
下田の住人さんのコードは後で試してみて後日結果を報告いたします。
投稿者 viajar  (社会人)
投稿日時
2012/8/21 14:29:54
さっき「後日報告します」と書きましたが、今試してみてうまくいきましたので解決したことを報告いたします。
クリックしたところを(他の色で囲まれた部分まで)塗りつぶすようにするにはどうすればいいのでしょうか?
とりあえず色々調べてみてここまでは何とかできたのですが、
特にExtFloodFillのhdcの部分に何を指定すればいいのかわかりません。
ちなみにピクチャーボックスの名称はmapで、panelという名称のパネルの上にピクチャーボックスを設置しています。
使用するかどうかわからない部分はコメントアウトしています。
Public Class main
Private Declare Function ExtFloodFill Lib "gdi32" _
(ByVal hdc As IntPtr, _
ByVal X As Integer, _
ByVal Y As Integer, _
ByVal crColor As Integer, _
ByVal wFillType As UInteger) As Boolean
Private Sub main_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
opendialog.FileName = System.IO.Path.GetDirectoryName(System.Reflection.Assembly.GetExecutingAssembly.Location) & "\map.png"
If My.Computer.FileSystem.FileExists(opendialog.FileName) Then
Dim bmp As Bitmap
bmp = Image.FromFile(opendialog.FileName)
map.Image = bmp
End If
End Sub
Private Sub map_Click(sender As System.Object, e As System.EventArgs) Handles map.Click
'この辺がよくわからない
'Dim bmp As Bitmap = map.Image
'Dim hdc As IntPtr = map.Handle
'Dim brs As Brush = Brushes.GreenYellow
Dim p As New Point
p = Me.PointToClient(Windows.Forms.Cursor.Position)
p.X -= map.Left
p.Y -= map.Top
'ExtFloodFill(hdc, p.X, p.Y, RGB(255, 0, 0), 0)
End Sub
End Class