【叶帆开源区】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

......


...全文
1077 点赞 收藏 40
写回复
40 条回复
hr88rong 2005年05月31日
收藏!!!!我支持你!学习!
回复 点赞
yufeng7707 2005年05月13日
mark
回复 点赞
ww111222 2005年01月26日

TO: 叶帆

我学习了 这源码,非常不错

  我想 实现这样的功能:

  启动时,任务栏和托盘区都有图标,最小化时 任务栏的图标消失,保留托盘区的图标,恢复或最大化时 任务栏才增加图标,

  改了好长时间都没有搞定,

  大师给指点一下吧

回复 点赞
Andy__Huang 2005年01月14日
up
回复 点赞
yourredsun 2004年11月18日
关注

支持!!!

收藏
回复 点赞
mingtian2008 2004年11月16日
支持!!!
回复 点赞
lt1980 2004年11月16日
关注
回复 点赞
GGL123 2004年11月16日
UP
回复 点赞
viena 2004年11月16日
up
回复 点赞
Winters_lee 2004年11月16日
学习
回复 点赞
tj123 2004年10月21日
控制窗体各个控件的位置,我建议不要用什么控件,那样的话,显示的字体是十分不好看的

还是用相对位置比较不错的,就是相对于一个控件的百分比位置,

当然这样还是有缺点的,当你的窗体改变时有些控件的位置还是变化的,不是固定的

但是我想并不影响程序是使用!

欢迎大家提些意见!


回复 点赞
kmzs 2004年10月04日
好东东
回复 点赞
chenyu5188 2004年10月04日
UP
回复 点赞
叶帆 2004年10月04日
up
回复 点赞
叶帆 2004年09月30日
up
回复 点赞
apple_001 2004年09月30日
找到源码了
回复 点赞
ask999 2004年09月20日
代码下不了
回复 点赞
叶帆 2004年09月20日
【叶帆开源区】其它链接
XP界面窗体制作(可放缩、可缩小到托盘)
http://community.csdn.net/Expert/topic/3387/3387552.xml?temp=.416424
有意思的老人源码
http://community.csdn.net/Expert/topic/3376/3376547.xml?temp=.1939661
VB源码之友
http://community.csdn.net/Expert/topic/3365/3365079.xml?temp=7.926577E-02
定制公用对话框(如photoshop的文件打开对话框)
http://community.csdn.net/Expert/topic/3385/3385386.xml?temp=.2206842
绝对经典的扫雷源码(仿微软扫雷界面)--可以作弊呢!!!
http://community.csdn.net/Expert/topic/3380/3380429.xml?temp=.3048517
MSComm串口通信示例
http://community.csdn.net/Expert/topic/3387/3387736.xml?temp=.2366754
任意透明窗体--运用API实现特异窗体
http://community.csdn.net/Expert/topic/3389/3389796.xml?temp=.8869898
回复 点赞
pandengzhe 2004年09月20日
支持
回复 点赞
EverySoft 2004年09月20日
我也曾有想法自己做一个这样的类库呢,可一直没有抽出时间来.
回复 点赞
发动态
发帖子
VB基础类
创建于2007-09-28

2749

社区成员

19.7w+

社区内容

VB 基础类
社区公告
暂无公告