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 ''' <summary> ''' 显示歌词 ''' </summary> ''' <param name="MusicText">歌曲语句</param> ''' <param name="s">进度百分比</param> ''' <remarks></remarks> Private Sub ShowLrc(ByVal MusicText As String, ByVal s As Double) BP = New Bitmap(Me.Width, Me.Height) 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)) G.DrawString(MusicText, FT, lg, X + J, Y + J) End Using Next 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)) 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) End Using Next 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) End Using G.DrawImage(GetStringImage(MusicText), New Rectangle(0, 0, Me.Width * s, Me.Height), New Rectangle(0, 0, Me.Width * s, Me.Height), GraphicsUnit.Pixel) End Using Me.BackgroundImage = BP DrawBP(Me, BP, 255) End Sub Private Function GetStringImage(ByVal s As String) As Bitmap If SecondStringBP IsNot Nothing Then SecondStringBP.Dispose() SecondStringBP = New Bitmap(Me.Width, Me.Height) 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) End Using End Using Return SecondStringBP End Function Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load End Sub 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) End Sub Protected Overloads Overrides ReadOnly Property CreateParams() As CreateParams Get Dim cp As CreateParams = MyBase.CreateParams cp.ExStyle = cp.ExStyle Or &H80000 Return cp End Get End Property Private Sub Form1_SizeChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.SizeChanged'调用方法 ShowLrc("桌面歌词效果这是歌词内容", 0.5) End SubEnd Class--------------------------------------------以下代码放于模块里Imports System.Runtime.InteropServicesImports System.Drawing.ImagingImports System.DrawingModule 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 End Function <DllImport("user32.dll", EntryPoint:="ReleaseCapture")> _ Public Function ReleaseCapture() As Integer End Function Public Sub DrawBP(ByVal Forma As Object, ByVal bitmap As Bitmap, ByVal opacity As Byte) If bitmap.PixelFormat <> PixelFormat.Format32bppArgb Then Throw New ApplicationException("The bitmap must be 32ppp with alpha-channel.") 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, _ 0, blend, Win32.ULW_ALPHA) Finally Win32.ReleaseDC(IntPtr.Zero, screenDc) If hBitmap <> IntPtr.Zero Then Win32.SelectObject(memDc, oldBitmap) Win32.DeleteObject(hBitmap) End If Win32.DeleteDC(memDc) End Try End Sub 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 End Sub 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 Sub 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, _ ByVal crKey As Int32, ByRef pblend As BLENDFUNCTION, ByVal dwFlags As Int32) As Bool 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 End Function Public Declare Auto Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hDC As IntPtr) As IntPtr Public Declare Auto Function DeleteDC Lib "gdi32.dll" (ByVal hdc As IntPtr) As Bool <DllImport("gdi32.dll", ExactSpelling:=True)> _ Public Shared Function SelectObject(ByVal hDC As IntPtr, ByVal hObject As IntPtr) As IntPtr End Function Public Declare Auto Function DeleteObject Lib "gdi32.dll" (ByVal hObject As IntPtr) As Bool End ClassEnd Module
----------------
使用方法:
ShowLrc("桌面歌词效果这是歌词内容", 0.5)
[解决办法]
[解决办法]
为了更好推广dylike兄的功能，我把测试的例子贴来大家可以更懒一点，下载直接看到效果。
[解决办法]
很好很强大啊，，，
[解决办法]
牛啊。。。
[解决办法]
[解决办法]
不会玩vb，路过的！
[解决办法]
试试看
[解决办法]
wef ewf w