【叶帆开源区】XP界面窗体制作（可放缩、可缩小到托盘）

Question

因为大部分用户的系统平台还是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 LongPrivate 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 NextEnd Sub......

Answer 1

对了，顺便问一下，以你formresize来看，里面用的硬码写入的窗体位置和button的位置，请问，你在什么分辨率下调试的程序？1024*768?那你有没有试过当你的程序在800*600的效果？或者就算分辨率不变，你有没有试过大字体和小子体的区别？我发现这个东西很成问题，本来我界面调好，用户换了个大字体，结果我放在窗体最底下的按钮被任务栏挡住了，晕死。

Answer 2

guxizhw(失落的彩虹) 你好，谢谢你的关注你说的问题很对，这也是我开源的目的所在，我的源码只作参考，起抛砖引玉的作用希望大家提供好的解决方案，或者源码！

Answer 3

【叶帆开源区】其它链接
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

Answer 4

地址是下面的，多了一个“http://”
源码下载：http://blog.csdn.net/yefanqiu     【叶帆源码】－XP窗体界面

Answer 5

感谢开源，但有BUG，按照我说的顺序操作，大家试试：运行工程，点击最小化按钮，窗口被放入系统托盘区，右击系统托盘图标，选择“恢复”，再单击窗口右上角的关闭按钮。结果是窗口好象关闭了，因为已看不到窗口，但VB的IDE上的“运行”和“停止”按钮状态上可以证明。

Answer 6

这个原因是出现右键菜单后，frmMenu被启动大家可以在“关闭按钮”的事件里 case 2   '关闭....
unload me
End               <-----添加 “End”语句