【叶帆开源区】XP界面窗体制作(可放缩、可缩小到托盘)
叶帆 博客专家认证 业界专家认证 2004-09-19 10:50:30 因为大部分用户的系统平台还是win2000,甚至win98,所以开发程序时,很希望窗体界面为好看的XP风格。现在我把早期的一个仿(金山词霸2002)类XP风格窗体的源码公布出来,供大家参考!
程序界面:http://www.bjjr.com.cn/yefan/pic/xpform.jpg
源码下载:http://http://blog.csdn.net/yefanqiu 【叶帆源码】-XP窗体界面
部分源码:-----------------------
'*************************************************************************
'**模 块 名:frmMain
'**说 明:YFHome 版权所有2003 - 2004(C)
'**创 建 人:叶帆
'**日 期:2003年04月24日
'**修 改 人:
'**日 期:
'**描 述:XP界面
'**版 本:版本1.0
'*************************************************************************
Option Explicit
Public LastState As Integer '窗体的状态
Private Const HTCAPTION = 2
Private Const HTTOP = 12
Private Const HTTOPLEFT = 13
Private Const HTTOPRIGHT = 14
Private Const HTBOTTOM = 15
Private Const HTBOTTOMLEFT = 16
Private Const HTBOTTOMRIGHT = 17
Private Const HTLEFT = 10
Private Const HTRIGHT = 11
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const WM_NCLBUTTONUP = &HA2
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
'*************************************************************************
'**函 数 名:Form_Load
'**输 入:无
'**输 出:无
'**功能描述:
'**全局变量:
'**调用模块:
'**作 者:叶帆
'**日 期:2003年04月24日
'**修 改 人:
'**日 期:
'**版 本:版本1.0
'*************************************************************************
Private Sub Form_Load()
'打开错误处理陷阱
On Error GoTo ErrGoto
'----------------------------------------------------
'代码正文
Dim intX As Integer, intY As Integer, i As Integer, intW As Integer, intH As Integer
'保证当前进程的唯一性
If App.PrevInstance = True Then
Unload Me
End
End If
'--------------------------------
'托盘处理
AddToTray Me, frmMenu.RightMenu '增加图标到托盘
RemoveFromTray '清除托盘内的图标
'把窗体移动到上次关闭时的位置
intX = Val(GetSetting(App.Title, "Settings", "X", Str((Screen.Width - Me.Width) / 2)))
intY = Val(GetSetting(App.Title, "Settings", "Y", Str((Screen.Height - Me.Height) / 2)))
intW = Val(GetSetting(App.Title, "Settings", "W", Str(Me.Width)))
intH = Val(GetSetting(App.Title, "Settings", "H", Str(Me.Height)))
Me.Move intX, intY, intW, intH
'--------------------------------
'窗体圆角处理
Call CornerEdit
'----------------------------------------------------
Exit Sub
'-----------------------------
ErrGoto:
End Sub
'*************************************************************************
'**函 数 名:Form_Resize
'**输 入:无
'**输 出:无
'**功能描述:
'**全局变量:
'**调用模块:
'**作 者:叶帆
'**日 期:2003年04月24日
'**修 改 人:
'**日 期:
'**版 本:版本1.0
'*************************************************************************
Private Sub Form_Resize()
'打开错误处理陷阱
On Error GoTo ErrGoto
'----------------------------------------------
'窗体界面调整
If WindowState <> vbMinimized Then
If Me.Width < 7155 Then
Me.Width = 7155
End If
If Me.Height < 5445 Then '5445
Me.Height = 5445
End If
imgCorner(1).Left = Me.Width - 105
imgCorner(2).Top = Me.Height - 105
imgCorner(3).Left = Me.Width - 105
imgCorner(3).Top = Me.Height - 105
imgBorder(1).Left = Me.Width - 45
imgBorder(2).Top = Me.Height - 45
imgTitleButton(0).Left = Me.Width - 930
imgTitleButton(1).Left = Me.Width - 630
imgTitleButton(2).Left = Me.Width - 330
lblTitle.Width = Me.Width - 345
'----------------------------------------------
End If
'-----------------------------
If WindowState <> vbMinimized Then
LastState = WindowState
Call CornerEdit '窗体圆角处理
End If
'-----------------------------------------------
'托盘处理
Select Case WindowState
Case vbMinimized '最小化
AddToTray Me, frmMenu.RightMenu '增加图标到托盘
SetTrayTip "叶帆软件系列" '设置新的提示信息
Me.Visible = False
Case vbMaximized '最大化
RemoveFromTray '清除托盘内的图标
Case vbNormal '正常状态
RemoveFromTray '清除托盘内的图标
End Select
'----------------------------------------------------
Exit Sub
'-----------------------------
ErrGoto:
Resume Next
End Sub
......