专栏首页VB小源码VB.NET 实现LED效果源码

VB.NET 实现LED效果源码

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

<左右滑动查看完整代码>

本文分享自微信公众号 - VB小源码(vb_xym)

原文出处及转载信息见文内详细说明,如有侵权,请联系 yunjia_community@tencent.com 删除。

原始发表时间:2019-10-30

本文参与腾讯云自媒体分享计划,欢迎正在阅读的你也加入,一起分享。

我来说两句

0 条评论
登录 后参与评论

推荐阅读

  • 远程办公经验为0,如何将日常工作平滑过度到线上?

    我是一名创业者,我的公司(深圳市友浩达科技有限公司)在2018年8月8日开始运营,现在还属于微型公司。这个春节假期,我一直十分关注疫情动向,也非常关心其对公司带来的影响。

    TVP官方团队
    TAPD 敏捷项目管理腾讯乐享企业邮箱企业编程算法
  • 数据中台,概念炒作还是另有奇效? | TVP思享

    作者简介:史凯,花名凯哥,腾讯云最具价值专家TVP,ThoughtWorks数据智能业务总经理。投身于企业数字化转型工作近20年。2000年初,在IBM 研发企业级中间件,接着加入埃森哲,为大型企业提供信息化架构规划,设计,ERP,云平台,数据仓库构建等技术咨询实施服务,随后在EMC负责企业应用转型业务,为企业提供云迁移,应用现代化服务。现在专注于企业智能化转型领域,是数据驱动的数字化转型的行业布道者,数据中台的推广者,精益数据创新体系的创始人,2019年荣获全球Data IQ 100人的数据赋能者称号,创业邦卓越生态聚合赋能官TOP 5。2019年度数字化转型专家奖。打造了行业第一个数据创新的数字化转型卡牌和工作坊。创建了精益数据创新方法论体系构建数据驱动的智能企业,并在多个企业验证成功,正在向国内外推广。

    TVP官方团队
    大数据数据分析企业
  • 扩展 Kubernetes 之 CRI

    使用 cri-containerd 的调用流程更为简洁, 省去了上面的调用流程的 1,2 两步

    王磊-AI基础
    Kubernetes
  • 扩展 Kubernetes 之 Kubectl Plugin

    kubectl 功能非常强大, 常见的命令使用方式可以参考 kubectl --help,或者这篇文章

    王磊-AI基础
    Kubernetes
  • 多种登录方式定量性能测试方案

    最近接到到一个测试任务,某服务提供了两种登录方式:1、账号密码登录;2、手机号+验证码登录。要对这两种登录按照一定的比例进行压测。

    八音弦
    测试服务 WeTest
  • 线程安全类在性能测试中应用

    首先验证接口参数签名是否正确,然后加锁去判断订单信息和状态,处理用户增添VIP时间事务,成功之后释放锁。锁是针对用户和订单的分布式锁,使用方案是用的redis。

    八音弦
    安全编程算法
  • 使用CDN(jsdelivr) 优化博客访问速度

    PS: 此篇文章适用于 使用 Github pages 或者 coding pages 的朋友,其他博客也类似.

    IFONLY@CUIT
    CDNGitGitHub开源
  • 扩展 Kubernetes 之 CNI

    Network Configuration 是 CNI 输入参数中最重要当部分, 可以存储在磁盘上

    王磊-AI基础
    Kubernetes
  • 聚焦【技术应变力】云加社区沙龙online重磅上线!

    云加社区结合特殊时期热点,挑选备受关注的音视频流量暴增、线下业务快速转线上、紧急上线防疫IoT应用等话题,邀请众多业界专家,为大家提供连续十一天的干货分享。从视野、预判、应对等多角度,帮助大家全面提升「技术应变力」!

    腾小云
  • 京东购物小程序购物车性能优化实践

    它是小程序开发工具内置的一个可视化监控工具,能够在 OS 级别上实时记录系统资源的使用情况。

    WecTeam
    渲染JavaScripthttps网络安全缓存

扫码关注云+社区

领取腾讯云代金券