' 發展單位：風禹科技驗證有限公司
' 撰寫人：鄭子璉(Tzu-Lien, Cheng, 璉璉) ，成大水利博肄，微軟最有價值專家
' Web: http://tlcheng.twbbs.org/TLCheng/ E-Mail: qvb3377@ms5.hinet.net
' --------------------------------------------------------------------------------------

Module modGraphic
#Region "DCMemoryBitmap"
	Private Class DCMemoryBitmap
		Private m_hDC As IntPtr
		Private m_BitmapInfoHeader As BITMAPINFOHEADER
		Private m_hBitmap As IntPtr
		Private dibBitmap As IntPtr
		Private ppvBits As IntPtr

		Private oldObject As IntPtr
		Private m_HasImage As Boolean = False

		Public ReadOnly Property hDC() As IntPtr
			Get
				Return m_hDC
			End Get
		End Property

		Public ReadOnly Property hBitmap() As IntPtr
			Get
				Return m_hBitmap
			End Get
		End Property

		Public Function ToImage() As Bitmap
			If m_HasImage Then Return Bitmap.FromHbitmap(dibBitmap) Else Return Nothing
		End Function

		Private Sub CreateNew(ByVal Width As Integer, ByVal Height As Integer)
			m_hDC = CreateCompatibleDC(IntPtr.Zero)
			With m_BitmapInfoHeader
				.biBitCount = 32
				.biHeight = Height
				.biSize = System.Runtime.InteropServices.Marshal.SizeOf(m_BitmapInfoHeader)
				.biWidth = Width
				.biPlanes = 1
			End With

			dibBitmap = CreateDIBSection(m_hDC, m_BitmapInfoHeader, 0, ppvBits, 0, 0)
			oldObject = SelectObject(m_hDC, dibBitmap)

			m_HasImage = True
		End Sub

		''' <summary>依指定尺寸建立空白DC</summary>
		''' <param name="Width">寬度，Pixel</param>
		''' <param name="Height">高度，Pixel</param>
		Public Sub New(ByVal Width As Integer, ByVal Height As Integer)
			CreateNew(Width, Height)
		End Sub

		''' <summary>依原圖檔建立DC</summary>
		''' <param name="vImage">來源圖檔</param>
		''' <param name="bCopy">是否將圖面繪製到 DC 上，預設繪製</param>
		Public Sub New(ByVal vImage As Bitmap, Optional ByVal bCopy As Boolean = True)
			If bCopy Then
				CreateNew(vImage.Width, vImage.Height)
				Dim srcBmp As New DCMemoryBitmap(vImage, False)

				BitBlt(hDC, 0, 0, vImage.Width, vImage.Height, srcBmp.hDC, 0, 0, RasterOperationCode.SrcCopy)
				GdiFlush()
			Else
				m_hDC = CreateCompatibleDC(IntPtr.Zero)
				m_hBitmap = vImage.GetHbitmap
				oldObject = SelectObject(m_hDC, m_hBitmap)
			End If

			m_HasImage = True
		End Sub

		Protected Overrides Sub Finalize()
			MyBase.Finalize()

			If m_HasImage Then
				SelectObject(m_hDC, oldObject)
				DeleteObject(dibBitmap)
				DeleteObject(ppvBits)
				DeleteObject(oldObject)
				DeleteDC(m_hDC)
			End If
			m_HasImage = False
		End Sub
	End Class
#End Region

#Region "Windows API 宣告"
	<Runtime.InteropServices.DllImport("gdi32.dll")> _
	 Private Function CreateCompatibleDC( _
	ByVal hDC As IntPtr _
	 ) As IntPtr
	End Function

	<Runtime.InteropServices.DllImport("gdi32.dll")> _
	 Private Function DeleteDC( _
	 ByVal hObject As Integer _
	 ) As Integer
	End Function

	<Runtime.InteropServices.DllImport("gdi32.dll")> _
	 Private Function GdiFlush() As Integer
	End Function

	<Runtime.InteropServices.DllImport("gdi32.dll")> _
	Private Function CreateDIBSection( _
	 ByVal hDC As IntPtr, _
	 ByRef pBitmapInfo As BITMAPINFOHEADER, _
	 ByVal iUsage As Integer, _
	 ByVal ppvBits As IntPtr, _
	 ByVal hSection As Integer, _
	 ByVal dwOffset As Integer _
	 ) As IntPtr
	End Function

	' 點
	<Runtime.InteropServices.DllImport("gdi32.dll")> _
	 Private Function GetPixel( _
	  ByVal hDC As IntPtr, _
	  ByVal X As Integer, _
	  ByVal Y As Integer _
	 ) As Integer
	End Function

	' 色筆
	<Runtime.InteropServices.DllImport("gdi32.dll")> _
	 Private Function CreateSolidBrush( _
	ByVal crColor As Integer _
	 ) As IntPtr
	End Function

	' 在裝置環境上選擇使用物件
	<Runtime.InteropServices.DllImport("gdi32.dll")> _
	  Private Function SelectObject( _
	  ByVal hDC As IntPtr, _
	  ByVal hObject As IntPtr _
	  ) As Integer
	End Function

	<Runtime.InteropServices.DllImport("gdi32.dll")> _
	  Private Function DeleteObject( _
	  ByVal hObject As IntPtr _
	  ) As Integer
	End Function

	' 填滿
	<Runtime.InteropServices.DllImport("gdi32.dll", EntryPoint:="ExtFloodFill")> _
	 Private Function apiFloodFill( _
	  ByVal hDC As IntPtr, _
	  ByVal X As Integer, _
	  ByVal Y As Integer, _
	  ByVal crColor As Integer, _
	  ByVal fuFillType As FloodFillType _
	 ) As Integer
	End Function

	<Runtime.InteropServices.DllImport("User32.dll")> _
	 Private Function FillRect( _
	ByVal hDC As IntPtr, _
	ByRef lpRect As apiRect, _
	ByVal hBrush As IntPtr _
	 ) As Integer
	End Function

	<Runtime.InteropServices.DllImport("gdi32.dll")> _
	 Private Function BitBlt( _
	ByVal hDCofTarget As IntPtr, _
	ByVal x As Integer, _
	ByVal y As Integer, _
	ByVal nWidth As Integer, _
	ByVal nHeight As Integer, _
	ByVal hDCofSource As IntPtr, _
	ByVal xSrc As Integer, _
	ByVal ySrc As Integer, _
	ByVal opCode As RasterOperationCode) As Integer
	End Function

	Private Structure BITMAPINFOHEADER
		Dim biSize As Integer
		Dim biWidth As Integer
		Dim biHeight As Integer
		Dim biPlanes As Short
		Dim biBitCount As Short
		Dim biCompression As Integer
		Dim biSizeImage As Integer
		Dim biXPelsPerMeter As Integer
		Dim biYPelsPerMeter As Integer
		Dim biClrUsed As Integer
		Dim biClrImportant As Integer
	End Structure

	<Runtime.InteropServices.StructLayout(Runtime.InteropServices.LayoutKind.Sequential)> Private Structure apiPoint
		Public x As Integer
		Public y As Integer
	End Structure

	<Runtime.InteropServices.StructLayout(Runtime.InteropServices.LayoutKind.Explicit)> Private Structure apiRect
		<Runtime.InteropServices.FieldOffset(0)> Public Left As Integer
		<Runtime.InteropServices.FieldOffset(4)> Public Top As Integer
		<Runtime.InteropServices.FieldOffset(8)> Public Right As Integer
		<Runtime.InteropServices.FieldOffset(12)> Public Bottom As Integer

		Public Sub New(ByVal vRect As Rectangle)
			With vRect
				Left = .Left
				Top = .Top
				Right = .Right
				Bottom = .Bottom
			End With
		End Sub
	End Structure

	' 填滿
	Public Enum FloodFillType As Integer
		Border = 0
		Surface = 1
	End Enum

	Public Enum RasterOperationCode As Integer
		BLACKNESS = &H42
		DSINVERT = &H550009
		MERGECOPY = &HC000CA
		MERGEPAINT = &HBB0226
		NOTSRCCOPY = &H330008
		NOTSRCERASE = &H1100A6
		PATCOPY = &HF00021
		PATINVERT = &H5A0049
		PATPAINT = &HFB0A09
		SrcAnd = &H8800C6
		SrcCopy = &HCC0020
		SrcErase = &H4400328
		SrcInvert = &H660046
		SrcPaint = &HEE0086
		WHITENESS = &HFF0062
	End Enum

	Public Function PaintImage(ByVal targetImage As Bitmap, ByVal sourceImage As Bitmap, ByVal vLocation As Drawing.Point, ByVal vRectangle As Rectangle, Optional ByVal opCode As RasterOperationCode = RasterOperationCode.SrcCopy) As Bitmap
		Dim dcSource As New DCMemoryBitmap(sourceImage, False)
		Dim dcTarget As New DCMemoryBitmap(targetImage)
		BitBlt(dcTarget.hDC, vRectangle.X, vRectangle.Y, vRectangle.Width, vRectangle.Height, dcSource.hDC, vLocation.X, vLocation.Y, opCode)
		GdiFlush()
		Return dcTarget.ToImage
	End Function

	Public Function FloodFill(ByVal vImage As Bitmap, ByVal X As Integer, ByVal Y As Integer, ByVal FillColor As Color, Optional ByVal fuFillType As FloodFillType = FloodFillType.Surface) As Bitmap
		If vImage Is Nothing Then Return Nothing
		Dim dcBitmap As New DCMemoryBitmap(vImage)
		Dim rtnFloodFill As Integer
		Dim apiColor As Integer = ColorTranslator.ToWin32(FillColor)
		'Dim apiColor As Integer = ColorTranslator.ToOle(FillColor)
		Dim hDC As IntPtr = dcBitmap.hDC
		Select Case fuFillType
			Case FloodFillType.Border
				rtnFloodFill = apiFloodFill(hDC, X, Y, apiColor, fuFillType)
			Case FloodFillType.Surface
				Dim hSolidBrush As IntPtr = CreateSolidBrush(apiColor)
				Dim hOldSolidBrush As IntPtr = SelectObject(hDC, hSolidBrush)

				Dim crColor As Integer = GetPixel(hDC, X, Y)
				rtnFloodFill = apiFloodFill(hDC, X, Y, crColor, fuFillType)

				hOldSolidBrush = SelectObject(hDC, hOldSolidBrush)
				DeleteObject(hSolidBrush)
		End Select
		Return dcBitmap.ToImage
	End Function

#End Region



End Module