Visual Basic6 美化简洁类模块 扁平UI

效果：

以下为FEUI类模块内容
'FlatEazyUI
'BY: JayshonYves
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Const WM_SYSCOMMAND = &H112
Private Const SC_MOVE = &HF010&
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Const WS_EX_LAYERED = &H80000
Private Const GWL_EXSTYLE = (-20)
Private Const LWA_ALPHA = &H2
Private Const LWA_COLORKEY = &H1

Dim WithEvents frmclose As Label
Attribute frmclose.VB_VarHelpID = -1
Dim WithEvents SmallCt As Label
Attribute SmallCt.VB_VarHelpID = -1
Dim WithEvents frmbigs As Shape
Attribute frmbigs.VB_VarHelpID = -1
Dim WithEvents frmbig As Label
Attribute frmbig.VB_VarHelpID = -1
Dim WithEvents Frmad As Form
Attribute Frmad.VB_VarHelpID = -1
Dim FrmObj As Form
Dim QLineC
Dim wCtColor
Dim SmallB As Boolean, BigB As Boolean, CloseB As Boolean

Public Function FEUI(frm As Form, SmallCtB As Boolean, BigCtB As Boolean, CloseCtB As Boolean, Optional FrmBC As String, Optional Linecolor As String, Optional CtColor As String, Optional Alpha As Integer) As String
On Error Resume Next
'设置默认参数
If AlphaAm = True Then Alpha = 0
If Linecolor = "" Then Linecolor = &HFFFF00
If CtColor = "" Then CtColor = vbWhite
If FrmBC = "" Then FrmBC = &H404040
If Alpha > 255 Then Alpha = 255
If Alpha < 0 Then Alpha = 0

SmallB = SmallCtB
BigB = BigCtB
CloseB = CloseCtB
Set FrmObj = frm
Set Frmad = frm
QLineC = Linecolor
wCtColor = CtColor

With frm
.AutoRedraw = True
.BackColor = FrmBC
End With

'窗体标题
Set frmCaption = frm.Controls.Add("vb.label", "TitleCaption")
With frmCaption
.Visible = True
.Font = "微软雅黑"
.AutoSize = "true"
.Caption = frm.Caption
.Left = 200
.Top = 120
.BackStyle = 0
.ForeColor = CtColor
.FontSize = 10
End With

'设置关闭按钮
If CloseCtB = True Then
Set frmclose = frm.Controls.Add("vb.label", "Closebtn")
With frmclose
.Visible = True
.AutoSize = False
.Top = 150
.Left = frm.Width - 150 - 240
.Width = 240
.Height = 240
.BackStyle = 0
End With
frm.Line (frm.Width - 150 - 240, 150)-(frm.Width - 150, 150 + 240), CtColor
frm.Line (frm.Width - 150, 150)-(frm.Width - 150 - 240, 150 + 240), CtColor
End If

'设置最小化按钮
If SmallCtB = True Then
Dim Mo As Integer
If BigCtB = True Then Mo = 150 + 240 Else Mo = 0
If CloseCtB = False Then Mo = Mo - (150 + 240) Else Mo = Mo
frm.Line (frm.Width - 150 - 240 - 150 - 240 - Mo, 150 + 230)-(frm.Width - 150 - 240 - 150 - Mo, 150 + 230), CtColor
Set SmallCt = frm.Controls.Add("vb.label", "Smallbtn")
With SmallCt
.Visible = True
.AutoSize = False
.Top = 150
.Left = frm.Width - 150 - 240 - 150 - 240 - Mo
.Width = 240
.Height = 240
.BackStyle = 0
End With
End If

'设置最大化按钮
If BigCtB = True Then
Dim MoB As Integer
If CloseCtB = True Then MoB = 150 + 240 Else MoB = 0
Set frmbigs = frm.Controls.Add("vb.shape", "Bigbtn")
With frmbigs
.BorderColor = CtColor
.Visible = True
.Height = 255
.Width = 255
.Top = 150
.Left = frm.Width - 150 - 240 - MoB
.BorderStyle = 1
.BackColor = 0
.FillStyle = 1
.Shape = 0
.BorderWidth = 1
End With
Set frmbig = frm.Controls.Add("vb.label", "Bigbtns")
With frmbig
.Visible = True
.AutoSize = False
.Top = 150
.Left = frm.Width - 150 - 240 - MoB
.Width = 255
.Height = 255
.BackStyle = 0
End With

End If

Call PrintLines

Dim rtn As Long
rtn = GetWindowLong(frm.hwnd, GWL_EXSTYLE)
rtn = rtn Or WS_EX_LAYERED
SetWindowLong frm.hwnd, GWL_EXSTYLE, rtn
SetLayeredWindowAttributes frm.hwnd, 0, Alpha, LWA_ALPHA
End Function
Private Sub RePrint()
'重绘过程
FrmObj.Cls
PrintLines
'CloseButton
If CloseB = True Then
FrmObj.Line (FrmObj.Width - 150 - 240, 150)-(FrmObj.Width - 150, 150 + 240), wCtColor
FrmObj.Line (FrmObj.Width - 150, 150)-(FrmObj.Width - 150 - 240, 150 + 240), wCtColor
frmclose.Left = FrmObj.Width - 150 - 240
End If
'BigButton
If BigB = True Then
Dim MoB As Integer
If CloseB = True Then MoB = 150 + 240 Else MoB = 0
frmbigs.Left = FrmObj.Width - 150 - 240 - MoB
frmbig.Left = FrmObj.Width - 150 - 240 - MoB
End If
'SmallButton
If SmallB = True Then
Dim Mo As Integer
If BigB = True Then Mo = 150 + 240 Else Mo = 0
If CloseB = False Then Mo = Mo - (150 + 240) Else Mo = Mo
FrmObj.Line (FrmObj.Width - 150 - 240 - 150 - 240 - Mo, 150 + 230)-(FrmObj.Width - 150 - 240 - 150 - Mo, 150 + 230), wCtColor
SmallCt.Left = FrmObj.Width - 150 - 240 - 150 - 240 - Mo
End If
End Sub
Private Sub PrintLines()
FrmObj.Line (0, 0)-(0, FrmObj.Height), QLineC
FrmObj.Line (0, 0)-(FrmObj.Width, 0), QLineC
FrmObj.Line (FrmObj.Width - 10, 0)-(FrmObj.Width - 10, FrmObj.Height - 10), QLineC
FrmObj.Line (0, FrmObj.Height - 10)-(FrmObj.Width, FrmObj.Height - 10), QLineC
End Sub
Private Sub frmclose_Click()
Unload FrmObj
End Sub
Private Sub Smallct_Click()
FrmObj.WindowState = 1
End Sub
Private Sub frmbig_Click()
If FrmObj.WindowState <> 2 Then
FrmObj.WindowState = 2
Else
FrmObj.WindowState = 0
End If
RePrint
End Sub
Private Sub Frmad_Resize()
'FrmObj.Cls
'Call PrintLines
End Sub
Private Sub Frmad_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If FrmObj.WindowState <> 2 Then
ReleaseCapture
SendMessage FrmObj.hwnd, WM_SYSCOMMAND, SC_MOVE + HTCAPTION, 0
End If
End Sub