页码,1/9 们 UIPower 企业宣传片 高清版下载 DirectUI Skin++ UIPower 专业界面开发与设计论坛» 界面程序资源».Net 开发技术» VB.NET 桌面歌词效果的制作 回复 发帖 返回列表 1 2 3 4 5 6 7 下一页 koncel 发表于 2010-6-24 18:25 只看该作者 1 # VB.NET 桌面歌词效果的制作 因为这个东西写得很早, 所以代码不是很规范. 另外, 代码只是为了做出效果, 并不具备与音乐的互动功能. VB.NET code 以下是代码 : -------------------------------------------------------------------------------- Dim X, Y As Integer Private BP As Bitmap Dim FT As Font = New Font(" 幼圆 ", 40, FontStyle.Regular, GraphicsUnit.Pixel) Private SecondStringBP As Bitmap ''' ''' 显示歌词 ''' ''' 歌曲语句 ''' 进度百分比 '''
页码,2/9 Using G As Graphics = Graphics.FromImage(BP) G.SmoothingMode = Drawing2D.SmoothingMode.HighQuality G.CompositingMode = Drawing2D.CompositingMode.SourceOver G.TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAliasGridFit X = 20 : Y = 20 For J As Integer = 1 To 5 Using lg As New Drawing2D.LinearGradientBrush(New Point(0, 0), New Point(0, 1), Color.FromArgb(90-90 / 5 * J, 0, 0, 0), Color.FromArgb(100 - J * 20, 0, 0, 0)) Next G.DrawString(MusicText, FT, lg, X + J, Y + J) For I As Integer = 1 To 3 Using lg As New Drawing2D.LinearGradientBrush(New Point(0, 0), New Point(0, 1), Color.FromArgb(90-90 / 3 * I, 0, 0, 0), Color.FromArgb(90-90 / 3 * I, 0, 0, 0)) Next G.DrawString(MusicText, FT, lg, X - I, Y) G.DrawString(MusicText, FT, lg, X - I, Y - I) G.DrawString(MusicText, FT, lg, X, Y - I) G.DrawString(MusicText, FT, lg, X + I, Y - I) G.DrawString(MusicText, FT, lg, X + I, Y) G.DrawString(MusicText, FT, lg, X + I, Y + I) G.DrawString(MusicText, FT, lg, X, Y + I) G.DrawString(MusicText, FT, lg, X - I, Y + I) Using lg As New Drawing2D.LinearGradientBrush(New Point(X, Y), New Point (X, Y + FT.Height), Color.YellowGreen, Color.DarkGreen) G.DrawString(MusicText, FT, lg, X, Y) G.DrawImage(GetStringImage(MusicText), New Rectangle(0, 0, Me.Width * s, Me.Height), New Rectangle(0, 0, Me.Width * s, Me.Height), GraphicsUnit.Pixel) Me.BackgroundImage = BP DrawBP(Me, BP, 255) Private Function GetStringImage(ByVal s As String) As Bitmap If SecondStringBP IsNot Nothing Then SecondStringBP.Dispose() SecondString Using G As Graphics = Graphics.FromImage(SecondStringBP) G.SmoothingMode = Drawing2D.SmoothingMode.HighQuality G.CompositingMode = Drawing2D.CompositingMode.SourceOver G.TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAliasGridFit Using lg As New Drawing2D.LinearGradientBrush(New Point(X, Y), New Point (X, Y + FT.Height), Color.LightYellow, Color.Red) G.DrawString(s, FT, lg, X, Y)
页码,3/9 Return SecondStringBP Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Private Sub Form1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown ReleaseCapture() SendMessage(sender.Handle.ToInt32(), WM_SysCommand, SC_MOVE, 0) Protected Overloads Overrides ReadOnly Property CreateParams() As CreateParams Get End Get End Property Dim cp As CreateParams = MyBase.CreateParams cp.exstyle = cp.exstyle Or &H80000 Return cp Private Sub Form1_SizeChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.SizeChanged ' 调用方法 End Class ShowLrc(" 桌面歌词效果这是歌词内容 ", 0.5) -------------------------------------------------------------------------------- 以下代码放于模块里 Imports System.Runtime.InteropServices Imports System.Drawing.Imaging Imports System.Drawing Module Module1 Public Const WM_SysCommand As Integer = &H112 Public Const SC_MOVE As Integer = &HF012 Public Const SC_NCLBUTTONDOWN = &HA1 <DllImport("user32.dll", EntryPoint:="SendMessage")> _ Public Function SendMessage(ByVal hwnd As Integer, ByVal wmsg As Integer, ByVal wparam As Integer, ByVal lparam As Integer) As Integer <DllImport("user32.dll", EntryPoint:="ReleaseCapture")> _ Public Function ReleaseCapture() As Integer Public Sub DrawBP(ByVal Forma As Object, ByVal bitmap As Bitmap, ByVal opacity As Byte) If bitmap.pixelformat <> PixelFormat.Format32bppArgb Then
页码,4/9 Throw New ApplicationException("The bitmap must be 32ppp with alphachannel.") End If Dim screendc As IntPtr = Win32.GetDC(IntPtr.Zero) Dim memdc As IntPtr = Win32.CreateCompatibleDC(screenDc) Dim hbitmap As IntPtr = IntPtr.Zero Dim oldbitmap As IntPtr = IntPtr.Zero Try hbitmap = bitmap.gethbitmap(color.fromargb(0)) oldbitmap = Win32.SelectObject(memDc, hbitmap) Dim size As New Win32.Size(bitmap.Width, bitmap.height) Dim pointsource As New Win32.Point(0, 0) Dim toppos As New Win32.Point(Forma.Left, Forma.Top) Dim blend As New Win32.BLENDFUNCTION() blend.blendop = Win32.AC_SRC_OVER blend.blendflags = 0 blend.sourceconstantalpha = opacity blend.alphaformat = Win32.AC_SRC_ALPHA Win32.UpdateLayeredWindow(Forma.Handle, screendc, toppos, size, memdc, pointsource, _ Finally End Try 0, blend, Win32.ULW_ALPHA) Win32.ReleaseDC(IntPtr.Zero, screendc) If hbitmap <> IntPtr.Zero Then End If Win32.SelectObject(memDc, oldbitmap) Win32.DeleteObject(hBitmap) Win32.DeleteDC(memDc) Public Class Win32 Public Enum Bool [False] = 0 [True] End Enum <StructLayout(LayoutKind.Sequential)> _ Public Structure Point Public x As Int32 Public y As Int32 Public Sub New(ByVal x As Int32, ByVal y As Int32) Me.x = x Me.y = y
页码,5/9 End Structure <StructLayout(LayoutKind.Sequential)> _ Public Structure Size Public cx As Int32 Public cy As Int32 Public Sub New(ByVal cx As Int32, ByVal cy As Int32) Me.cx = cx Me.cy = cy End Structure <StructLayout(LayoutKind.Sequential, Pack:=1)> _ Private Structure ARGB Public Blue As Byte Public Green As Byte Public Red As Byte Public Alpha As Byte End Structure <StructLayout(LayoutKind.Sequential, Pack:=1)> _ Public Structure BLENDFUNCTION Public BlendOp As Byte Public BlendFlags As Byte Public SourceConstantAlpha As Byte Public AlphaFormat As Byte End Structure Public Const ULW_COLORKEY As Int32 = &H1 Public Const ULW_ALPHA As Int32 = &H2 Public Const ULW_OPAQUE As Int32 = &H4 Public Const AC_SRC_OVER As Byte = &H0 Public Const AC_SRC_ALPHA As Byte = &H1 Public Declare Auto Function UpdateLayeredWindow Lib "user32.dll" (ByVal hwnd As IntPtr, ByVal hdcdst As IntPtr, ByRef pptdst As Point, ByRef psize As Size, ByVal hdcsrc As IntPtr, ByRef pprsrc As Point, _ As Bool ByVal crkey As Int32, ByRef pblend As BLENDFUNCTION, ByVal dwflags As Int32) Public Declare Auto Function GetDC Lib "user32.dll" (ByVal hwnd As IntPtr) As IntPtr <DllImport("user32.dll", ExactSpelling:=True)> _ Public Shared Function ReleaseDC(ByVal hwnd As IntPtr, ByVal hdc As IntPtr) As Integer
页码,6/9 Public Declare Auto Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hdc As IntPtr) As IntPtr As Bool Public Declare Auto Function DeleteDC Lib "gdi32.dll" (ByVal hdc As IntPtr) <DllImport("gdi32.dll", ExactSpelling:=True)> _ Public Shared Function SelectObject(ByVal hdc As IntPtr, ByVal hobject As IntPtr) As IntPtr Public Declare Auto Function DeleteObject Lib "gdi32.dll" (ByVal hobject As IntPtr) As Bool End Class End Module ---------------- 使用方法 : ShowLrc(" 桌面歌词效果这是歌词内容 ", 0.5) su7en 发表于 2010-6-24 18:25 只看该作者 2 # 元老 rmjdw1314 发表于 2010-6-24 18:25 只看该作者 3 # 为了更好推广 dylike 兄的功能, 我把测试的例子贴来大家可以更懒一点, 下载直接看到效果 乞丐 覆雨翻云发表于 2010-6-24 18:25 只看该作者 4 #... 这么差的代码还推荐啊... 元老
页码,7/9 canfly2008 发表于 2010-6-24 18:25 只看该作者 5 # 很好很强大啊,,, 乞丐 enews 发表于 2010-6-24 18:25 只看该作者 6 # 牛啊 大众儒生发表于 2010-6-24 18:25 只看该作者 7 # 引用 3 楼 dylike 的回复 :... 这么差的代码还推荐啊... appeon 发表于 2010-6-24 18:25 只看该作者 8 # 既然这样那就改一下吧. 加入一句 : If BP IsNot Nothing Then BP.Dispose ' 释放旧图片 wince 发表于 2010-6-24 18:25 只看该作者 9 # 引用 7 楼 dylike 的回复 : 乞丐 既然这样那就改一下吧. 加入一句 : If BP tiantian 发表于 2010-6-24 18:25 只看该作者 10 # 引用 8 楼 wuyazhe 的回复 :
页码,8/9 引用 7 楼 dylike 的回复 : 既然这样那就改一下吧. 加入一句 : Private Sub ShowLrc(ByVal MusicText As String, ByVal s 根网科技 anytel 发表于 2010-6-24 18:25 只看该作者 11 # 东迅通 不会玩 vb, 路过的! tianya.cn 发表于 2010-6-24 18:25 只看该作者 12 # 试试看 元老 enews 发表于 2010-6-24 18:25 只看该作者 13 # wef ewf w jzmzlf 发表于 2010-6-24 18:25 只看该作者 14 # ewf ewf w 元老 koncel 发表于 2010-6-24 18:25 只看该作者 15 # awe fewaf weaf DirectUI DirectUI DirectUI SDK
页码,9/9 返回列表 1 2 3 4 5 6 7 下一页 Powered by Discuz! 7.0.0 2001-2009 Comsenz Inc. UIPower.com ( 沪 ICP 备 05028907 号 ) 联系我们 论坛统计 Archiver WAP 站长统计 GMT+8, 16:39, Processed in 0.137024 second(s), 8 queries, Gzip enabled.