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

......


...全文
1163 40 打赏 收藏 转发到动态 举报
写回复
用AI写文章
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
  • 打赏
  • 举报
回复
我也曾有想法自己做一个这样的类库呢,可一直没有抽出时间来.
加载更多回复(20)

7,763

社区成员

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧