VB.NET 實現LED效果源碼
- 2019 年 11 月 1 日
- 筆記
VB.NET LED自定義窗體源碼
Imports System.Drawing.Imaging Public Class LED Private TXT_MASK As Bitmap = Nothing Private IMG_MASK As Bitmap = Nothing Private TF As Boolean = False Public LED_UP As Integer = 50 Public Property INPUT_IMG As Bitmap Get Return TXT_MASK End Get Set(value As Bitmap) TXT_MASK = value MASK() End Set End Property Private Sub MASK() If Created = False Then Exit Sub If Visible = False Then Exit Sub If TXT_MASK Is Nothing Then Exit Sub If TF Then Exit Sub TF = True Using Txbitmap As New Bitmap(TXT_MASK) Dim Bpdata As BitmapData = Txbitmap.LockBits(New Rectangle(0, 0, Txbitmap.Width, Txbitmap.Height), ImageLockMode.ReadWrite, PixelFormat.Format32bppArgb) Dim Bts(Bpdata.Stride * Bpdata.Height) As Byte Runtime.InteropServices.Marshal.Copy(Bpdata.Scan0, Bts, 0, Bts.Length) Txbitmap.UnlockBits(Bpdata) IMG_MASK = Nothing IMG_MASK = New Bitmap(Width, Height) Using G As Graphics = Graphics.FromImage(IMG_MASK) G.Clip = New Region(New Rectangle(0, 0, Width, Height)) Dim W As Integer = 1 Dim W_W As Integer = 1 Using TB As New Bitmap(W + W_W, W + W_W) G.SmoothingMode = Drawing2D.SmoothingMode.HighSpeed Using G2 As Graphics = Graphics.FromImage(TB) G2.Clip = New Region(New Rectangle(0, 0, TB.Width, TB.Height)) G2.FillRectangle(New SolidBrush(Color.FromArgb(255, 15, 15, 15)), New Rectangle(0, 0, W, W)) Using Txb As New TextureBrush(TB) G.FillRectangle(Txb, New Rectangle(0, 0, Width, Height)) End Using End Using End Using Dim WW As Integer = W + W_W For I As Integer = 0 To TXT_MASK.Width - WW For J As Integer = 0 To TXT_MASK.Height - WW Dim Cl As Color = Color.Transparent Dim X, Y As Integer X = I * 4 Y = J * (Txbitmap.Width * 4) Dim Bts2(3) As Byte Bts2(0) = Bts(X + Y) Bts2(1) = Bts(X + Y + 1) Bts2(2) = Bts(X + Y + 2) Bts2(3) = Bts(X + Y + 3) If Bts2(3) <> 0 Then G.Clip = New Region(New Rectangle(I * WW, J * WW, W, W)) Dim AA As Integer = Bts2(2) + LED_UP Dim AB As Integer = Bts2(1) + LED_UP Dim AC As Integer = Bts2(0) + LED_UP AA = If(AA < 0, 0, AA) AB = If(AB < 0, 0, AB) AC = If(AC < 0, 0, AC) AA = If(AA > 255, 255, AA) AB = If(AB > 255, 255, AB) AC = If(AC > 255, 255, AC) G.FillRectangle(New SolidBrush(Color.FromArgb(Bts2(3), AA, AB, AC)), New Rectangle(I * WW, J * WW, W, W)) If I * WW > Width OrElse J * WW > Height Then TF = False Exit Sub End If End If Application.DoEvents() Next Application.DoEvents() Next End Using End Using If IMG_MASK IsNot Nothing Then BackgroundImage = IMG_MASK TF = False End Sub Private Sub LED_Load(sender As Object, e As EventArgs) Handles MyBase.Load MASK() End Sub End Class
<左右滑動查看完整程式碼>
