29-09-13, 03:25 AM
السلام عليكم
لو حد عنده اى كلاس لبكتشر بوكس او اى كنترول يكون يقبل الشفافية
انا لقيت كلاس بس بيتقل البرنامج جدا
لو حد عنده اى كلاس لبكتشر بوكس او اى كنترول يكون يقبل الشفافية
انا لقيت كلاس بس بيتقل البرنامج جدا
كود :
Imports System.ComponentModel
Imports System.Reflection
Imports System.Drawing.Imaging
Public Class OpPictureBox
Inherits System.Windows.Forms.PictureBox
#Region "Constructor(s)"
Public Sub New()
SetStyle(ControlStyles.SupportsTransparentBackColor, True)
SetStyle(ControlStyles.Opaque, False)
SetStyle(ControlStyles.DoubleBuffer, True)
SetStyle(ControlStyles.OptimizedDoubleBuffer, True)
SetStyle(ControlStyles.AllPaintingInWmPaint, True)
SetStyle(ControlStyles.UserPaint, True)
UpdateStyles()
End Sub
#End Region
#Region "Transparency Part"
#Region "Fields"
Private opa As Double = 1.0R
Private fc As Color = Color.FromKnownColor(KnownColor.Control)
Private mcc As Boolean = True
#End Region
#Region "Properties"
<DefaultValue(1.0R)> _
<TypeConverter(GetType(OpacityConverter))> _
<Description("Set the opacity percentage of the control.")> _
<Category("Control Style")> _
Public Property Opacity As Double
Get
Return Me.opa
End Get
Set(ByVal value As Double)
Me.opa = value
Invalidate()
End Set
End Property
<Browsable(False)> _
<EditorBrowsable(EditorBrowsableState.Never)> _
<DefaultValue(GetType(Color), "Transparent")> _
Public Overrides Property BackColor() As System.Drawing.Color
Get
Return Color.Transparent
End Get
Set(ByVal value As System.Drawing.Color)
End Set
End Property
<Description("Set hot color.")> _
<Category("Control Style")> _
Public Property FillColor() As Color
Get
Return Me.fc
End Get
Set(ByVal value As Color)
Me.fc = value
Invalidate()
End Set
End Property
<Description("Specify whether the control is compatible when putted on a container.")> _
<Category("Control Style")> _
Public Property MultiControlCompatibility As Boolean
Get
Return Me.mcc
End Get
Set(ByVal value As Boolean)
Me.mcc = value
Invalidate()
End Set
End Property
#End Region
#Region "Methods"
Protected Overrides Sub OnPaint(ByVal pe As System.Windows.Forms.PaintEventArgs)
If Me.IsHandleCreated OrElse (Me.Parent IsNot Nothing AndAlso Me.Parent.Created) Then
If Me.mcc Then
Dim bmp As New Bitmap(Me.Parent.ClientRectangle.Width, Me.Parent.ClientRectangle.Height)
Me.Parent.DrawToBitmap(bmp, New Rectangle(New Point(0, 0), bmp.Size))
Dim pt As New Point(0, 0)
If TypeOf Me.Parent Is Form Then
Select Case CType(Me.Parent, Form).FormBorderStyle
Case FormBorderStyle.None
pt = New Point((Me.Parent.Width - Me.Parent.ClientRectangle.Width), (Me.Parent.Height - Me.Parent.ClientRectangle.Height))
Case FormBorderStyle.FixedSingle, FormBorderStyle.FixedDialog, FormBorderStyle.FixedToolWindow
pt = New Point((Me.Parent.Width - Me.Parent.ClientRectangle.Width) - 3, (Me.Parent.Height - Me.Parent.ClientRectangle.Height) - 3)
Case FormBorderStyle.Fixed3D
pt = New Point((Me.Parent.Width - Me.Parent.ClientRectangle.Width) - 5, (Me.Parent.Height - Me.Parent.ClientRectangle.Height) - 5)
Case FormBorderStyle.Sizable, FormBorderStyle.SizableToolWindow
pt = New Point((Me.Parent.Width - Me.Parent.ClientRectangle.Width) - 8, (Me.Parent.Height - Me.Parent.ClientRectangle.Height) - 8)
End Select
End If
bmp = Me.CropImage(bmp, New Rectangle(pt, New Size(Me.Parent.ClientRectangle.Width, Me.Parent.ClientRectangle.Height)))
bmp = Me.CropImage(bmp, New Rectangle(Me.Location, Me.Size))
pe.Graphics.DrawImage(bmp, New Point(0, 0))
End If
Else
MyBase.OnPaint(pe)
Exit Sub
End If
If Not Me.FillColor = Color.Transparent Then
Using fsb As New SolidBrush(Color.FromArgb(Me.opa * 255, Me.FillColor))
pe.Graphics.FillRectangle(fsb, New Rectangle(0, 0, Me.Width, Me.Height))
End Using
End If
Me.DrawImage(pe.Graphics, Me.ClientRectangle)
End Sub
Private Sub DrawImage(ByVal g As Graphics, ByVal rect As Rectangle)
Dim m_matrixArr As Single()() = {New Single() {1, 0, 0, 0, 0}, _
New Single() {0, 1, 0, 0, 0}, _
New Single() {0, 0, 1, 0, 0}, _
New Single() {0, 0, 0, Me.opa, 0}, _
New Single() {0, 0, 0, 0, 1}}
Dim m_Matrix As New ColorMatrix(m_matrixArr)
Dim Attr As New ImageAttributes()
Attr.SetColorMatrix(m_Matrix, ColorMatrixFlag.Default, ColorAdjustType.Bitmap)
Dim client As Rectangle = Me.ClientRectangle
If Me.Image IsNot Nothing Then
Select Case Me.SizeMode
Case PictureBoxSizeMode.AutoSize, PictureBoxSizeMode.Normal
g.DrawImage(Me.Image, New Rectangle(0, 0, Me.Image.Width, Me.Image.Height), 0, 0, Me.Image.Width, Me.Image.Height, GraphicsUnit.Pixel, Attr)
Exit Select
Case PictureBoxSizeMode.CenterImage
If (Me.Image.Width > Me.Width) OrElse (Me.Image.Height > Me.Height) Then
Dim wval As Integer = 0
Dim hval As Integer = 0
If (Me.Image.Width > Me.Width) Then
wval = ((Me.Image.Width - Me.Width) / 2)
End If
If (Me.Image.Height > Me.Height) Then
hval = ((Me.Image.Height - Me.Height) / 2)
End If
Dim myimg As Image = Me.CropImage(Me.Image, New Rectangle(wval, hval, (Me.Image.Width - wval), (Me.Image.Height - hval)))
Dim r As New Rectangle(0, 0, myimg.Width, myimg.Height)
g.DrawImage(myimg, r, 0, 0, myimg.Width, myimg.Height, GraphicsUnit.Pixel, Attr)
Exit Select
Else
Dim x As Integer = ((Me.Width / 2) - (Me.Image.Width / 2))
Dim y As Integer = ((Me.Height / 2) - (Me.Image.Height / 2))
Dim r As New Rectangle(x, y, Me.Image.Width, Me.Image.Height)
g.DrawImage(Me.Image, r, 0, 0, Me.Image.Width, Me.Image.Height, GraphicsUnit.Pixel, Attr)
Exit Select
End If
Case PictureBoxSizeMode.StretchImage
Dim myimg As Image = New Bitmap(Me.Image, Me.Width, Me.Height)
Dim r As New Rectangle(0, 0, myimg.Width, myimg.Height)
g.DrawImage(myimg, r, 0, 0, myimg.Width, myimg.Height, GraphicsUnit.Pixel, Attr)
Exit Select
Case PictureBoxSizeMode.Zoom
Dim wh As Double = (Me.Image.Width / Me.Image.Height)
If Me.Image.Width > Me.Image.Height Then
Dim w As Integer = Me.Width
Dim h As Integer = CInt(w / wh)
Dim x As Integer = 0
Dim y As Integer = Math.Abs((Me.Height - h) / 2)
Dim r As New Rectangle(x, y, w, h)
Dim myimg As Image = New Bitmap(Me.Image, w, h)
g.DrawImage(myimg, r, 0, 0, w, h, GraphicsUnit.Pixel, Attr)
Exit Select
Else
Dim h As Integer = Me.Height
Dim w As Integer = CInt(h * wh)
Dim x As Integer = Math.Abs((Me.Width / 2) - (w / 2))
Dim y As Integer = 0
Dim r As New Rectangle(x, y, w, h)
Dim myimg As Image = New Bitmap(Me.Image, w, h)
g.DrawImage(myimg, r, 0, 0, w, h, GraphicsUnit.Pixel, Attr)
Exit Select
End If
End Select
Return
End If
g.FillRectangle(New SolidBrush(Me.BackColor), rect)
End Sub
Public Function CropImage(ByVal img As System.Drawing.Image, ByVal croppingRect As System.Drawing.Rectangle) As System.Drawing.Image
Using bmp As New Bitmap(img)
If (croppingRect.X > img.Width) OrElse (croppingRect.Y > img.Height) Then
Return New Bitmap(croppingRect.Width, croppingRect.Height)
Exit Function
End If
If ((croppingRect.X + croppingRect.Width) > img.Width) Then
croppingRect.Width = (img.Width - croppingRect.X)
End If
If ((croppingRect.Y + croppingRect.Height) > img.Height) Then
croppingRect.Height = (img.Height - croppingRect.Y)
End If
If (croppingRect.X < 0) Then
croppingRect.X = 0
End If
If (croppingRect.Y < 0) Then
croppingRect.Y = 0
End If
If (croppingRect.Width > img.Width) Then
croppingRect.Width = img.Width
End If
If (croppingRect.Height > img.Height) Then
croppingRect.Height = img.Height
End If
Return bmp.Clone(croppingRect, bmp.PixelFormat)
End Using
End Function
#End Region
#End Region
#Region "Click through part"
#Region "Fields"
Private ct As Boolean = True
Private hlst As New List(Of String)
#End Region
#Region "Properties"
<Description("Set the ability for the user to click through the control.")> _
<Category("Control Style")> _
Public Property ClickThrough As Boolean
Get
Return Me.ct
End Get
Set(ByVal value As Boolean)
Me.ct = value
End Set
End Property
#End Region
#Region "Methods"
Protected Overrides Sub OnClick(ByVal e As System.EventArgs)
MyBase.OnClick(e)
If Me.ct Then
Dim ctrl As Control = Me.GetClickedControl()
ctrl.Focus()
Dim T As Type = ctrl.GetType()
Dim MI As MethodInfo = T.GetMethod("OnClick", (BindingFlags.NonPublic Or BindingFlags.Instance))
MI.Invoke(ctrl, New Object() {e})
End If
End Sub
Private Function GetClickedControl() As Control
For C As Integer = 0 To Me.Parent.Controls.Count - 1
If Not (Me.Parent.Controls(C).Handle = Me.Handle) Then
If Me.ControlOwnCursor(Me.Parent.Controls(C)) Then
Return Me.Parent.Controls(C)
End If
End If
Next
Return Me.Parent
End Function
Private Function ControlOwnCursor(ByVal ctrl As Control) As Boolean
Return ctrl.RectangleToScreen(ctrl.ClientRectangle).Contains(Cursor.Position)
End Function
#End Region
#End Region
End Class