让我们试试这个。
- 在项目中创建一个新类,将其命名为
TPanel 并粘贴到您可以在下面找到的自定义 Panel 类中,覆盖现有定义。
- 编译项目,然后在工具箱中找到新的
TPanel 控件并将一个实例放到一个窗体中。
在窗体上,而不是在一个彩色面板中,否则它会成为另一个控件的子控件,它将被限制在其范围内。
- 为
TPanel 的Paint 事件添加一个事件处理程序,并将此代码插入到处理程序方法中:
Private Sub TPanel1_Paint(sender As Object, e As PaintEventArgs) Handles TPanel1.Paint
Dim canvas As Control = DirectCast(sender, Control)
Dim rect As Rectangle = ScaleImageFrame(imgBasketBall, canvas.ClientRectangle)
e.Graphics.SmoothingMode = SmoothingMode.AntiAlias
e.Graphics.CompositingMode = CompositingMode.SourceOver
e.Graphics.PixelOffsetMode = PixelOffsetMode.Half
e.Graphics.DrawImage(imgBasketBall, rect)
End Sub
Private Function ScaleImageFrame(sourceImage As Bitmap, destinationFrame As Rectangle) As Rectangle
Dim rect As RectangleF = New RectangleF(0, 0, sourceImage.Width, sourceImage.Height)
'Define the ratio between the Image Rectangle and the Container ClientRectangle
Dim ratio As Single = CType(Math.Max(destinationFrame.Width, destinationFrame.Height) /
Math.Max(rect.Width, rect.Height), Single)
rect.Size = New SizeF(rect.Width * ratio, rect.Height * ratio)
'Use Integer division to avoid negative values
rect.Location = New Point((destinationFrame.Width - CInt(rect.Width)) \ 2,
(destinationFrame.Height - CInt(rect.Height)) \ 2)
Return Rectangle.Round(rect)
End Function
- 在表单中,创建一个包含图像的位图对象实例;还设置面板的位置 (
TPanel)
名为 panColored1 和 panColored2 的控件应该是必须放置图像的两个现有面板的名称。示例代码使用TPanel1.Location( (...) ) 将图像定位在 2 个面板的中间
Private imgBasketBall As Bitmap = Nothing
Public Sub New()
InitializeComponent()
imgBasketBall = DirectCast(Image.FromFile("basketball.png").Clone(), Bitmap)
TPanel1.Size = New Size(120, 120)
TPanel1.Location = New Point(panColored1.Left + (panColored1.Width - TPanel1.Width) \ 2,
panColored1.Top + (panColored1.Height + panColored2.Height - TPanel1.Height) \ 2)
TPanel1.BringToFront()
End Sub
结果:
Bitmap Size Bitmap Size
(1245x1242) (1178x2000)
TPanel(透明面板)类:
Imports System.ComponentModel
<DesignerCategory("Code")>
Public Class TPanel
Inherits Panel
Private Const WS_EX_TRANSPARENT As Integer = &H20
Public Sub New()
Me.SetStyle(ControlStyles.AllPaintingInWmPaint Or
ControlStyles.UserPaint Or
ControlStyles.Opaque Or
ControlStyles.ResizeRedraw, True)
Me.SetStyle(ControlStyles.OptimizedDoubleBuffer, False)
Me.UpdateStyles()
End Sub
Protected Overrides Sub OnPaint(e As PaintEventArgs)
e.Graphics.FillRectangle(Brushes.Transparent, Me.ClientRectangle)
MyBase.OnPaint(e)
End Sub
Protected Overrides ReadOnly Property CreateParams() As CreateParams
Get
Dim parameters As CreateParams = MyBase.CreateParams
parameters.ExStyle = parameters.ExStyle Or WS_EX_TRANSPARENT
Return parameters
End Get
End Property
End Class