16,557
社区成员
发帖
与我相关
我的任务
分享
以下是代码:
--------------------------------------------------------------------------------
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 Sub
End Class
--------------------------------------------------------------------------------
以下代码放于模块里
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
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 Class
End Module