用VB实现窗口图标最小化到通知栏

合集下载

用VB实现任务栏右下角的小图标

用VB实现任务栏右下角的小图标

用VB实现任务栏右下角的小图标将VB应用程序缩成系统状态栏图标二法第一种方法:VB光盘的tools\unsupport\systray目录下有一个例子,将此目录复制到硬盘,编译生成一个OCX控件,在自己的程序中使用此控件,可以实现将程序图标放于右下角系统图标区,这方法比调用API要简单得多第二种方法:梁洁仪---- 在很多应用程序中,其操作窗口缩小后将变成一图标放置在系统状态栏中。

---- 为什么有的程序可以缩小成图标呢?---- 对于Windows来说,这些图标并非窗口或程序,它们只是图标,能作出这样的功能,关键在于调用了Windows的API函数Shell_NotifyIcon,在Visual Basic开发环境中,通过其所附带的API浏览器,我们可查找出Shell_NotifyIcon 的声明格式如下:---- Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias"Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long---- 现把本函数声明中的参数分别说明如下:---- 参数dwMessage为消息设置值,它可以是以下的几个常数值:0、1、2。

在程序中为了使用更方便,我们把它们定义为三个常量:NIM_ADD、NIM_MODIFY及NIM_DELETE,本示例中的常量及Shell_NotifyIcon调用都可以在窗口新建的模块中声明它:Public Const NIM_ADD = 0 //加入图标到系统状态栏中Public Const NIM_MODIFY = 1 //修改系统状态栏中的图标Public Const NIM_DELETE = 2 //删除系统状态栏中的图标---- 这三个常量的应用将中下文中具体介绍。

在VB中实现移动没有标题栏的窗口

在VB中实现移动没有标题栏的窗口

在VB中实现移动没有标题栏的窗口方法二 (可用这种方法通过消息的发送实现移动无标题窗体。

当鼠标按下、移动或释放时,将鼠标在窗体上按下的消息(消息值为HTCAPTION)发出,就能拖动窗体了。

代码如下:Private Declare Function ReleaseCapture Lib "user32" () As LongPrivate Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long,ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPrivate Const WM_NCLBUTTONDOWN = &&HA1Private Const HTCAPTION = 2’以上API函数和常数的声明可在VB自带的“API浏览器”中找到Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)’在窗体的MouseDown事件中添加以下代码If Button = 1 ThenCall ReleaseCaptureCall SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)End IfEnd SubPrivate Sub Command1_Click()End ’退出程式End Sub这种方法实现起来比第一种方法更容易,只有几行代码,并且没有那么多的变量,窗体被拖动时和普通窗体相同,只有一个虚框随鼠标的移动而移动,当释放鼠标时窗体才移动到相应的位置。

用到了两个API函数。

在visual basic中如何拖动窗体或控件现在的许多windows下的应用程序,都采用了图形化的界面,例如:winamp等!这样做的好处是可以使程序界面更漂亮生动,更具吸引力。

VB教程

VB教程

VB教程网/VBjc/Vb.HTM编写趣味撞球小游戏文章来源:沐风经典文章作者:佚名Visual Basic是一个功能强大的工具,它有一大特点就是易学易用,下面我们就通过写一个“趣味撞球”的程序来初步体会一下。

首先启动VB5,新建一个标准的EXE工程。

此时可以看到,工程包括一个Form1框体。

在Form1边框的右下角按住鼠标左键不放,拖动鼠标把Form1的面积改为适当大小,比如6930×4320。

再在属性框中把Form1的ScaleMode 属性改为3-Pixel,表明我们将以像素为我们的坐标计算单位,把Form1的StartUpPosition 属性设为2-CenterScreen,使运行时窗体出现在屏幕正中。

现在,在控件面板上选取CommandButton(命令按钮)控件,为Form1添加Command1和Command2两个按钮控件,把它们的大小设为121×25,再在属性框中把Command1的Caption填为“&GO”,把Command2的Caption填为“&QUIT”,并把Command1放到框体的右上角,把Command2放到框体的右下角。

然后,在控件面板上选取Timer(时钟)控件,为Form1添加一个Timer1时钟控件。

再在属性框中把它的Enabled属性改为False,Interval属性改为50,前一个值表示该时钟控件是否激活,后一个值决定该时钟控件产生Timer事件的间隔时间,我们将用它来控制小球的移动频率。

到此为止,我们已经完成了全部的界面设计工作。

接下来要做的全部工作就是填入程序代码了。

Dim BallX As IntegerDim BallY As IntegerDim AddX As IntegerDim AddY As IntegerDim HitX As IntegerDim W As IntegerDim H As IntegerPrivate Sub Command1_Click()BallX=Int(Rnd(1)*Form1.ScaleWidth/10)*5+25BallY=Int((Form1.ScaleHeight)/10)*5AddX=-5AddY=-5Form_PaintTimer1.Enabled=TrueEnd SubPrivate Sub Command2_Click()EndEnd SubPrivate Sub Form_MouseMove(Button As Integer,Shift As Integer,X As Single,Y As Single) X=X-50If X<15 Then X=15If X>W-105 Then X=W-105HitX=XIf Timer1.Enabled=True ThenLine(16,H-5)-(W-6,H),&HC0C0C0,BF Line(HitX,H)-(HitX+100,H-5),0,BF End IfEnd SubPrivate Sub Form_Paint()ClsW=Int((ScaleWidth-140)/5)*5H=Int((ScaleHeight-10)/5)*5 BackColor=&HC0C0C0Line(10,10)-(15,H),0,BFLine(W-5,10)-(W,H),0,BFLine(10,10)-(W,15),0,BFEnd SubPrivate Sub Timer1_Timer()Form1.Circle(BallX,BallY),4,&HC0C0C0 BallX=BallX+AddXBallY=BallY+AddYForm1.Circle(BallX,BallY),4,0If BallX<=20 Then AddX=-AddXIf BallY<=20 Then AddY=-AddYIf BallX>=W-10 Then AddX=-AddXIf BallY>=H-10 ThenIf BallXHitX+100 ThenTimer1.Enabled=FalseForm_PaintEnd IfAddY=-AddYEnd IfEnd Sub一旦程序代码输入完毕,你就可以按F5开始执行它,或是在File菜单里选取Make来生成EXE执行文件了,瞧,小球已经在你的屏幕上蹦来蹦去了。

vb-窗口控制

vb-窗口控制

vb-窗⼝控制定义模块Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long'在窗⼝中建⽴⼀timer(时间控制器),然后在代码窗⼝输⼊如下代码:Private Sub Form_Load()Timer1.Interval = 500End Sub时间控制器的代码如下:Private Sub Timer1_Timer()Dim hwnd As Longhwnd = FindWindow(vbNullString, "计算器") '抓取"计算器"这个窗⼝名称.If (hwnd = 0) ThenIf MsgBox("你没有打开[计算器]程序!点击“确定”退出。

点“取消”继续。

", 49, "错误!") = 1 Then EndElseIf (hwnd <> 0) ThenMsgBox "你已经打开了[计算器]程序.点“确定”退出本程序", , "退出"EndEnd IfEnd Sub模拟键盘事件2.以下为模拟键盘事件.⽐如模拟"r"键.----------------------------------------------------------------------------------------------------------------------------'在模块中定义Public Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal Scan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)在窗⼝中建⽴⼀timer.时间间隔随意.只要不是0就可以了哦.呵呵.Private Sub Timer1_Timer()Call keybd_event(82, 0, 0, 0) '模拟按下"R"键End Sub快捷键例⼦3.以下为快捷键例⼦.⽐如按下"ctrl+A"就退出!'可以设置Form的KeyPreview属性为True,然后在Form_KeyDown事件中添加代码:Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)If KeyCode = Asc("A") And Shift = vbCtrlMask Then unload me '如果ctrl+A键被按下就退出End Sub例⼆:在Form中加⼊Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vkey As Long) As IntegerPrivate Function MyHotKey(vKeyCode) As BooleanMyHotKey = (GetAsyncKeyState(vKeyCode) < 0)End Function'然后在循环中或Timer的Timer事件中检测:Private Sub Timer1_Timer()If MyHotKey(vbKeyA) And vbKeyControl Then 'ctrl+AEnd '关闭End If'其中vbkeyA是键盘″A″的常数,其他键可按F1查得。

VB窗体如何缩小到系统任务栏

VB窗体如何缩小到系统任务栏

如何使用直接从 Visual Basic 系统任务栏本文演示了如何充分利用 Windows 系统送纸器或使用 Visual Basic 的任务栏通知区域。

它将您选择的图标放入任务栏通知区域时鼠标 rested 通过它,将还原应用程序时单击了,并将显示一个弹出式菜单将显示您选择的工具提示的时用鼠标右键单击。

这是所有可能引起的直接处理回调的 Visual Basic 的能力,因此利用完全Shell_NotifyIcon 函数的 Shell32.dll 由被导出。

可以向任何可视的基本项目具有至少一个窗体和标准模块添加下面的示例。

分步示例将下面的代码添加到项目中的标准模块的声明部分:1. 'user defined type required by Shell_NotifyIcon API call2. Public Type NOTIFYICONDATA3. cbSize As Long4. hwnd As Long5. uId As Long6. uFlags As Long7. uCallBackMessage As Long8. hIcon As Long9. szTip As String * 6410. End Type11.12. 'constants required by Shell_NotifyIcon API call:13. Public Const NIM_ADD = &H014. Public Const NIM_MODIFY = &H115. Public Const NIM_DELETE = &H216. Public Const NIF_MESSAGE = &H117. Public Const NIF_ICON = &H218. Public Const NIF_TIP = &H419. Public Const WM_MOUSEMOVE = &H20020. Public Const WM_LBUTTONDOWN = &H201 'Button down21. Public Const WM_LBUTTONUP = &H202 'Button up22. Public Const WM_LBUTTONDBLCLK = &H203 'Double-click23. Public Const WM_RBUTTONDOWN = &H204 'Button down24. Public Const WM_RBUTTONUP = &H205 'Button up25. Public Const WM_RBUTTONDBLCLK = &H206 'Double-click26.27. Public Declare Function SetForegroundWindow Lib "user32"_28. (ByVal hwnd As Long) As Long29. Public Declare Function Shell_NotifyIcon Lib "shell32" _30. Alias "Shell_NotifyIconA" _31. (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) AsBoolean32.33. Public nid As NOTIFYICONDATA34.下面的代码添加到您要为您的应用程序响应系统任务栏图标或通知图标在项目中的任何窗体:35. Private Sub Form_Load()36. 'the form must be fully visible before callingShell_NotifyIcon37. Me.Show38. Me.Refresh39. With nid40. .cbSize = Len(nid)41. .hwnd = Me.hwnd42. .uId = vbNull43. .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE44. .uCallBackMessage = WM_MOUSEMOVE45. .hIcon = Me.Icon46. .szTip = "Your ToolTip" & vbNullChar47. End With48. Shell_NotifyIcon NIM_ADD, nid49. End Sub50.51. Private Sub Form_MouseMove(Button As Integer, Shift AsInteger, X As Single, Y As Single)52. 'this procedure receives the callbacks from the SystemTray icon.53. Dim Result As Long54. Dim msg As Long55. 'the value of X will vary depending upon the scalemodesetting56. If Me.ScaleMode = vbPixels Then57. msg = X58. Else59. msg = X / Screen.TwipsPerPixelX60. End If61. Select Case msg62. Case WM_LBUTTONUP '514 restore form window63. Me.WindowState = vbNormal64. Result = SetForegroundWindow(Me.hwnd)65. Me.Show66. Case WM_LBUTTONDBLCLK '515 restore form window67. Me.WindowState = vbNormal68. Result = SetForegroundWindow(Me.hwnd)69. Me.Show70. Case WM_RBUTTONUP '517 display popup menu71. Result = SetForegroundWindow(Me.hwnd)72. Me.PopupMenu Me.mPopupSys73. End Select74. End Sub75.76. Private Sub Form_Resize()77. 'this is necessary to assure that the minimized windowis hidden78. If Me.WindowState = vbMinimized Then Me.Hide79. End Sub80.81. Private Sub Form_Unload(Cancel As Integer)82. 'this removes the icon from the system tray83. Shell_NotifyIcon NIM_DELETE, nid84. End Sub85.86. Private Sub mPopExit_Click()87. 'called when user clicks the popup menu Exit command88. Unload Me89. End Sub90.91. Private Sub mPopRestore_Click()92. 'called when the user clicks the popup menu Restorecommand93. Dim Result As Long94. Me.WindowState = vbNormal95. Result = SetForegroundWindow(Me.hwnd)96. Me.Show97. End Sub98.使上面的代码添加到同一窗体上的以下属性设置:99. Property Required Setting for Taskbar NotificationArea example100. -----------------------------------------------------------------------101. Icon = The icon you want to appear in the system tray.102. Minbutton = True103. ShownInTaskbar = False104.将下面的菜单项添加到同一窗体使用菜单编辑器:105. Caption Name Enabled Visible Position 106. --------------------------------------------------------- 107. &SysTray mPopupSys True False Main Level 108. &Restore mPopRestore True True Inset one 109. &Exit mPopExit True True Inset one您可以根据需要添加更多菜单项。

VB实现在窗口的标题栏上添加一个按钮的功能实现程序最小化到系统托盘

VB实现在窗口的标题栏上添加一个按钮的功能实现程序最小化到系统托盘

程序运行窗口在窗口的标题栏上添加了一个按钮,实现最小化到系统托盘右键菜单1、复制以下程序段到记事本中另存为文件:Type=ExeReference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINDOWS\system32\std ole2.tlb#OLE AutomationModule=TrayStartup="frmMain"HelpFile=""ExeName32="Project1.exe"Path32="..\..\..\..\..\..\WINDOWS\Desktop"Command32=""Name="Project1"HelpContextID="0"CompatibleMode="0"MajorVer=1MinorVer=0RevisionVer=0AutoIncrementVer=0ServerSupportFiles=0VersionCompanyName="None"CompilationType=0OptimizationType=0FavorPentiumPro(tm)=0CodeViewDebugInfo=0NoAliasing=0BoundsCheck=0OverflowCheck=0 FlPointCheck=0 FDIVCheck=0 UnroundedFP=0 StartMode=0 Unattended=0 Retained=0 ThreadPerObject=0 MaxNumberOfThreads=1[MS Transaction Server] AutoRefresh=1Begin VB.Form frmMainAutoRedraw = -1 'TrueCaption = "TitleBar Tray Button Demo"ClientHeight = 2040ClientLeft = 60ClientTop = 345ClientWidth = 4680LinkTopic = "Form1"ScaleHeight = 2040ScaleWidth = 4680StartUpPosition = 3 '窗口缺省Begin VB.Menu mnuPopUpCaption = ""Visible = 0 'FalseBegin VB.Menu mnuRestoreCaption = "Restore"EndEndEndAttribute VB_Name = "frmMain"Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = TrueAttribute VB_Exposed = FalsePrivate Sub Form_Load()Print "Right Click For Menu"Me.ScaleMode = vbPixels 'The API works in pixelsHook Me 'FormHook Hook()End SubPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)If Button = 2 Then TrayMenu Me 'TrayNotify TrayMneu()End SubPrivate Sub Form_Unload(Cancel As Integer)UnHook 'FormHook UnHook()End SubAttribute VB_Name = "ToolTip"Const WS_EX_TOPMOST = &H8&Const TTS_ALWAYSTIP = &H1Const HWND_TOPMOST = -1Const SWP_NOACTIVATE = &H10Const SWP_NOMOVE = &H2Const SWP_NOSIZE = &H1Const WM_USER = &H400Const TTM_ADDTOOLA = (WM_USER + 4)Const TTF_SUBCLASS = &H10Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As LongPublic Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongType TOOLINFOcbSize As LonguFlags As Longhwnd As Longuid As LongRECT As RECThinst As LonglpszText As StringlParam As LongEnd TypePublic hWndTT As LongPublic Sub CreateTip(hwndForm As Long, szText As String, rct As RECT)hWndTT = CreateWindowEx(WS_EX_TOPMOST, "tooltips_class32", "",TTS_ALWAYSTIP, _0, 0, 0, 0, hwndForm, 0&, App.hInstance, 0&)SetWindowPos hWndTT, HWND_TOPMOST, 0, 0, 0, 0, _SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOACTIVATEDim TI As TOOLINFOWith TI.cbSize = Len(TI).uFlags = TTF_SUBCLASS.hwnd = hwndForm.uid = 1&.lpszText = szText & vbNullChar.RECT = rctEnd WithSendMessage hWndTT, TTM_ADDTOOLA, 0, TIEnd SubPublic Sub KillTip()DestroyWindow hWndTTEnd Sub4、复制以下程序段到记事本中另存为文件:Attribute VB_Name = "DrawButton"Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long Declare Function DrawFrameControl Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal un1 As Long, ByVal un2 As Long) As LongDeclare Function GetTitleBarInfo Lib "user32" (ByVal hwnd As Long, pti As TitleBarInfo) As BooleanDeclare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As LongDeclare Function GetSysColorBrush Lib "user32" (ByVal nIndex As Long) As LongDeclare Function OffsetRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long) As LongType RECTLeft As LongTop As LongRight As LongBottom As LongEnd TypeType TitleBarInfocbSize As LongrcTitleBar As RECT 'A RECT structure that receives the coordinates of the title barrgState(5) As Long 'An array that receives a DWORD value for each element of the title barEnd Type'rgState array Values'0 The titlebar Itself'1 Reserved'2 Min button'3 Max button'4 Help button'5 Close button''rgstate return constatnts'STATE_SYSTEM_FOCUSABLE = &H00100000'STATE_SYSTEM_INVISIBLE = &H00008000'STATE_SYSTEM_OFFSCREEN = &H00010000'STATE_SYSTEM_PRESSED = &H00000008'STATE_SYSTEM_UNAVAILABLE = &H00000001Const DFC_BUTTON = 4Const DFCS_BUTTONPUSH = &H10Const DFCS_PUSHED = &H200Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As LongPublic Declare Function PtInRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long) As LongPublic Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As LongPublic Type POINTAPIx As Longy As LongEnd TypeConst SM_CXFRAME = 32Const COLOR_BTNTEXT = 18Dim lDC As LongPublic R As RECTPublic Sub ButtonDraw(frm As Form, bState As Boolean)Dim TBButtons As IntegerDim TBarHeight As IntegerDim TBButtonHeight As IntegerDim TBButtonWidth As IntegerDim DrawWidth As IntegerDim TBI As TitleBarInfoDim TBIRect As RECTDim bRslt As BooleanDim WinBorder As IntegerWith frmIf .BorderStyle = 0 Then Exit Sub ' Don't draw a button if there is no titlebar'----How Many Buttons in TitleBar------------------------------------------If Not .ControlBox Then TBButtons = 0If .ControlBox Then TBButtons = 1If .ControlBox And .WhatsThisButton ThenIf .BorderStyle < 4 ThenTBButtons = 2ElsetButtons = 1End IfEnd IfIf .ControlBox And .MinButton And .BorderStyle = 2 Then TBButtons = 3If .ControlBox And .MinButton And .BorderStyle = 5 Then TBButtons = 1If .ControlBox And .MaxButton And .BorderStyle = 2 Then TBButtons = 3If .ControlBox And .MaxButton And .BorderStyle = 5 Then TBButtons = 1'------------------------------------------------------------------------'----Get height of Titlebar----------------------------------------------'Using this method gets the height of the titlebar regardless of the window'style. It does, however, restrict its use to Win98/2000. So if you want to'use this code in Win95, then call GetSystemMetrics to find the windowstyle'and titlebar size.TBI.cbSize = Len(TBI)bRslt = GetTitleBarInfo(.hwnd, TBI)TBarHeight = TBIRect.Bottom - TBIRect.Top - 1'-----------------------------------------------------------------------'----Get WindowBorder Size----------------------------------------------If .BorderStyle = 2 Or .BorderStyle = 5 ThenR.Top = GetSystemMetrics(32) + 2WinBorder = R.Top - 6ElseR.Top = 5WinBorder = -1End IfEnd With'---------------------------------------------------------------------------'----Use Titlebar Height to determin button size----------------------------TBButtonHeight = TBarHeight - 4TBButtonWidth = TBButtonHeight + 2'and the size and space of the dot on the buttonDrawWidth = TBarHeight / 8'---------------------------------------------------------------------------'----Determin the position of our button------------------------------------R.Bottom = R.Top + TBButtonHeightSelect Case TBButtonsCase 1R.Right = frm.ScaleWidth - (TBButtonWidth) + WinBorderCase 2R.Right = frm.ScaleWidth - ((TBButtonWidth * 2) + 2) + WinBorderCase 3R.Right = frm.ScaleWidth - ((TBButtonWidth * 3) + 2) + WinBorderCase ElseEnd SelectR.Left = R.Right - TBButtonWidth'--------------------------------------------------------------------------'----Get the Widow DC so that we may draw in the title bar-----------------lDC = GetWindowDC(frm.hwnd)'--------------------------------------------------------------------------'----Determin the position of thedot--------------------------------------Dim StartXY As Integer, EndXY As IntegerSelect Case TBarHeightCase Is < 20StartXY = DrawWidth + 1EndXY = DrawWidth - 1Case ElseStartXY = (DrawWidth * 2)EndXY = DrawWidthEnd Select'--------------------------------------------------------------------------'----We have all the information we need So Draw the button----------------Dim rDot As RECTIf bState ThenDrawFrameControl lDC, R, DFC_BUTTON, DFCS_BUTTONPUSH Or DFCS_PUSHEDrDot.Left = R.Right - (1 + StartXY): rDot.Top = R.Bottom - (1 + StartXY)rDot.Right = R.Right - (1 + EndXY): rDot.Bottom = R.Bottom - (1 + EndXY)ElseDrawFrameControl lDC, R, DFC_BUTTON, DFCS_BUTTONPUSHrDot.Left = R.Right - (2 + StartXY): rDot.Top = R.Bottom - (2 + StartXY)rDot.Right = R.Right - (2 + EndXY): rDot.Bottom = R.Bottom - (2 + EndXY)End IfFillRect lDC, rDot, GetSysColorBrush(COLOR_BTNTEXT)'---------------------------------------------------------------------------'----SetTooltip------------------------------------------------------------ Dim TTRect As RECTTTRect.Bottom = R.Bottom + (TBarHeight - ((TBarHeight * 2) + WinBorder + 5))TTRect.Left = R.Left - (4 - WinBorder)TTRect.Right = R.Right - (4 - WinBorder)TTRect.Top = R.Top + (TBarHeight - ((TBarHeight * 2) + WinBorder + 5))KillTip 'ToolTip KillTip()CreateTip appForm.hwnd, "System Tray", TTRect 'ToolTip CreateTip()End Sub5、复制以下程序段到记事本中另存为文件:Attribute VB_Name = "TrayNotify"Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As LongDeclare Function CreatePopupMenu Lib "user32" () As LongDeclare Function TrackPopupMenu Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal x As Long, ByVal y As Long, ByVal nReserved As Long, ByVal hwnd As Long, ByVal lprc As Any) As LongDeclare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As LongDeclare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As LongType NOTIFYICONDATAcbSize As Longhwnd As Longuid As LonguFlags As LonguCallbackMessage As LonghIcon As Longsztip As String * 64End TypeConst NIM_ADD = &H0Const NIM_DELETE = &H2Const NIM_MODIFY = &H1Const NIF_MESSAGE = &H1Const NIF_ICON = &H2Const NIF_TIP = &H4Const MF_GRAYED = &H1&Const MF_STRING = &H0&Const MF_SEPARATOR = &H800&Const TPM_NONOTIFY = &H80&Const TPM_RETURNCMD = &H100&Public bTraySet As BooleanDim lMenu As LongPublic Sub TraySet(frm As Form, sztip As String, hIcon As Long)Dim NID As NOTIFYICONDATAWith NID.cbSize = Len(NID).hIcon = hIcon.sztip = sztip & vbNullChar.uCallbackMessage = WM_LBUTTONUP.uFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP .uid = 1&End WithShell_NotifyIcon NIM_ADD, NIDbTraySet = TrueEnd SubPublic Sub TrayRestore(frm As Form)Dim NID As NOTIFYICONDATAWith NID.cbSize = Len(NID).uid = 1&End WithShell_NotifyIcon NIM_DELETE, NIDbTraySet = FalseEnd SubPublic Sub TrayMenu(frm As Form)Dim hMenu As Long, tMenu As LongDim MP As POINTAPIGetCursorPos MPhMenu = CreatePopupMenu()If bTraySet ThenAppendMenu hMenu, MF_STRING, 1000, "Restore" ElseAppendMenu hMenu, MF_STRING Or MF_GRAYED, 1000, "Restore"End IfAppendMenu hMenu, MF_SEPARATOR, 0&, 0&AppendMenu hMenu, MF_STRING, 1010, "Exit"tMenu = TrackPopupMenu(hMenu, TPM_NONOTIFY Or TPM_RETURNCMD, MP.x, MP.y, 0&, frm.hwnd, 0&)Select Case tMenuCase 1000TrayRestore frmCase 1010TrayRestore frmUnHookUnload frmCase Else'do nothingEnd SelectDestroyMenu hMenuEnd Sub6、复制以下程序段到记事本中另存为文件:Attribute VB_Name = "FormHook"Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _ (ByVal lpPrevWndFunc As Long, _ByVal hwnd As Long, _ByVal Msg As Long, _ByVal wParam As Long, _ByVal lParam As Long) As LongDeclare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _ (ByVal hwnd As Long, _ByVal nIndex As Long, _ByVal dwNewLong As Long) As LongDeclare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As IntegerPublic Const GWL_WNDPROC = -4Public Const WM_LBUTTONDOWN = &H201Public Const WM_LBUTTONUP = &H202Public Const WM_MOUSEMOVE = &H200Public Const WM_NCMOUSEMOVE = &HA0Public Const WM_NCLBUTTONDOWN = &HA1Public Const WM_NCLBUTTONUP = &HA2Public Const WM_NCLBUTTONDBLCLK = &HA3Public Const WM_NCRBUTTONDOWN = &HA4Public Const WM_NCRBUTTONUP = &HA5Public Const WM_ACTIVATE = &H6Public Const WM_NCPAINT = &H85Public Const WM_PAINT = &HFPublic Const WM_ACTIVATEAPP = &H1CPublic Const WM_MOUSEACTIVATE = &H21Public Const WM_COMMAND = &H111Public Const WM_NCACTIVATE = &H86Public Const WM_DESTROY = &H2Public Const WM_SIZE = &H5Global lpPrevWndProc As LongGlobal gHW As LongGlobal appForm As FormPrivate Function MakePoints(lParam As Long) As POINTAPIDim hexstr As Stringhexstr = Right("00000000" & Hex(lParam), 8)MakePoints.x = CLng("&H" & Right(hexstr, 4)) - (appForm.Left / Screen.TwipsPerPixelX)MakePoints.y = CLng("&H" & Left(hexstr, 4)) - (appForm.Top / Screen.TwipsPerPixelY)End FunctionPublic Sub Hook(frm As Form)Set appForm = frmlpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, AddressOf WindowProc)End SubPublic Sub UnHook()Dim lngReturnValue As LonglngReturnValue = SetWindowLong(gHW, GWL_WNDPROC, lpPrevWndProc) End SubFunction WindowProc(ByVal hwnd As Long, _ByVal uMsg As Long, _ByVal wParam As Long, _ByVal lParam As Long) As Long'------------------------------------------------------------------------------'Messing around in here can cause allsorts of problems.'So, if you must, make sure you save everytihing you want to keep 'before you run the program.'Don't run anything outside of a message selection as it will be 'executed so many times per second that it will slow down system response.Dim lRslt As LongDim retProc As BooleanStatic STButtonState As BooleanStatic Toggle As BooleanStatic i As IntegerOn Error Resume NextSelect Case uMsgCase WM_DESTROYTrayRestore appFormKillTip 'ToolTip KillTip()UnHookretProc = TrueCase WM_NCMOUSEMOVE'Only draw the button when necessaryIf GetAsyncKeyState(vbLeftButton) < 0 ThenIf OverButton(lParam) ThenIf Toggle = False ThenToggle = TrueButtonDraw appForm, Toggle 'DrawButton ButtonDraw()End IfElseIf Toggle = True ThenToggle = FalseButtonDraw appForm, Toggle 'DrawButton ButtonDraw()End IfEnd IfElseSTButtonState = FalseretProc = TrueEnd IfCase WM_NCLBUTTONDOWNIf OverButton(lParam) ThenSTButtonState = TrueButtonDraw appForm, True 'DrawButton ButtonDraw()ElseSTButtonState = FalseretProc = TrueEnd IfCase WM_NCLBUTTONUPSTButtonState = FalseIf OverButton(lParam) ThenTraySet appForm, appForm.Caption, appForm.Icon'TrayNotify TraySet()ButtonDraw appForm, False 'DrawButton ButtonDraw()retProc = FalseElseretProc = TrueEnd IfCase WM_LBUTTONUPSTButtonState = FalseButtonDraw appForm, False 'DrawButton ButtonDraw()If GetAsyncKeyState(vbLeftButton) < 0 And bTraySet Then TrayMenu appForm 'TrayNotify TrayMenu()End IfretProc = TrueCase WM_NCLBUTTONDBLCLK, WM_NCRBUTTONDOWNIf Not OverButton(lParam) ThenretProc = TrueEnd IfCase WM_SIZE, WM_NCPAINT, WM_PAINT, WM_COMMANDButtonDraw appForm, False 'DrawButton ButtonDraw()retProc = TrueCase WM_ACTIVATEAPP, WM_NCACTIVATE, WM_ACTIVATE, WM_MOUSEACTIVATEButtonDraw appForm, False 'DrawButton ButtonDraw()retProc = TrueCase ElseretProc = TrueEnd SelectIf retProc ThenWindowProc = CallWindowProc(lpPrevWndProc, hwnd, uMsg, wParam, lParam)ElseWindowProc = 0End IfEnd FunctionPrivate Function OverButton(lParam As Long) As Boolean Dim MP As POINTAPIMP = MakePoints(lParam)If PtInRect(R, MP.x, MP.y) Then OverButton = True End Function双击工程文件:运行,就可以看到效果。

VBA实用小程序04:在用户窗体标题栏添加最大化和最小化按钮

VBA实用小程序04:在用户窗体标题栏添加最大化和最小化按钮

VBA实用小程序04:在用户窗体标题栏添加最大化和最小化按钮有时候,我们可能相在用户窗体标题栏添加最大化和最小化按钮,以方便对用户窗体的操控。

下面是我找到的一段实现此功能的VBA代码,供大家需要时调用。

#If Win64 ThenPrivate Declare PtrSafeFunction GetWindowLongPtr _Lib 'user32.dll'Alias 'GetWindowLongPtrA' ( _ByVal hwnd As LongPtr, _ByVal nIndex As Long) AsLongPtrPrivate Declare PtrSafeFunction SetWindowLongPtr _Lib 'user32.dll'Alias 'SetWindowLongPtrA' ( _ByVal hwnd As LongPtr, _ByVal nIndex As Long, _ByVal dwNewLong As LongPtr)As LongPtrPrivate Declare PtrSafeFunction FindWindowA _Lib 'user32.dll'( _ByVal lpClassName AsString, _ByVal lpWindowName AsString) As LongPtrPrivate Declare PtrSafeFunction DrawMenuBar _Lib 'user32.dll'( _ByVal hwnd As LongPtr) AsLong#ElsePrivate Declare FunctionGetWindowLongPtr _Lib 'user32.dll'Alias 'GetWindowLongA' ( _ ByVal hwnd As Long, _ByVal nIndex As Long) AsLongPrivate Declare FunctionSetWindowLongPtr _ Lib 'user32.dll'Alias 'SetWindowLongA' ( _ ByVal hwnd As Long, _ByVal nIndex As Long, _ByVal dwNewLong As Long) As LongPrivate Declare FunctionFindWindowA _Lib 'user32.dll'( _ByVal lpClassName AsString, _ByVal lpWindowName AsString) As LongPrivate Declare FunctionDrawMenuBar _Lib 'user32.dll'( _ByVal hwnd As Long) As Long#End IfPrivate Sub UserForm_Initialize() CreateMenuEnd SubPrivate Sub CreateMenu()Const GWL_STYLE As Long = -16Const WS_SYSMENU As Long =&H80000 Const WS_MINIMIZEBOX As Long =&H20000 Const WS_MAXIMIZEBOX As Long =&H10000#If Win64 ThenDim lngFrmWndHdl As LongPtrDim lngStyle As LongPtr#ElseDim lngFrmWndHdl As LongDim lngStyle As Long#End IflngFrmWndHdl =FindWindowA(vbNullString, Me.Caption)lngStyle =GetWindowLongPtr(lngFrmWndHdl, GWL_STYLE) lngStyle = lngStyle OrWS_SYSMENU 'AddSystemMenu lngStyle = lngStyle OrWS_MINIMIZEBOX 'Add MinimizeBox lngStyle = lngStyle Or WS_MAXIMIZEBOX 'Add MaximizeBoxSetWindowLongPtr lngFrmWndHdl,GWL_STYLE, lngStyleDrawMenuBar lngFrmWndHdlEnd Sub将上述代码放置在用户窗体代码模块中,运行后的效果如下图所示:。

VB中控件位置大小自动适应窗体变化的三种模式详解

VB中控件位置大小自动适应窗体变化的三种模式详解

VB中控件位置大小自动适应窗体变化的三种模式详解.doc代码是无需更改的。

第一种。

就是最实用的,就是所有控件的width和height按比例随窗体变化,位置也是当然是按比例哦。

控件的字体不变。

如下复制到代码:'改比例,字体不该。

最实用Option ExplicitPrivate FormOldWidth As Long '保存窗体的原始宽度Private FormOldHeight As Long '保存窗体的原始高度Private Sub Form_Load()Call ResizeInit(Me) '在程序装入时必须加入End SubPrivate Sub Form_Resize()Call ResizeForm(Me) '确保窗体改变时控件随之改变End Sub'在调用ResizeForm前先调用本函数Public Sub ResizeInit(FormName As Form)Dim Obj As ControlFormOldWidth = FormName.ScaleWidthFormOldHeight = FormName.ScaleHeightOn Error Resume NextFor Each Obj In FormNameObj.Tag = Obj.Left & " " & Obj.Top & " " & Obj.Width & " " & Obj.Height & " " Next ObjOn Error GoTo 0End Sub'按比例改变表单内各元件的大小,在调用ReSizeForm前先调用ReSizeInit函数Public Sub ResizeForm(FormName As Form)Dim Pos(4) As DoubleDim i As Long, TempPos As Long, StartPos As LongDim Obj As ControlDim ScaleX As Double, ScaleY As DoubleScaleX = FormName.ScaleWidth / FormOldWidth '保存窗体宽度缩放比例ScaleY = FormName.ScaleHeight / FormOldHeight '保存窗体高度缩放比例On Error Resume NextFor Each Obj In FormNameStartPos = 1For i = 0 To 4'读取控件的原始位置与大小TempPos = InStr(StartPos, Obj.Tag, " ", vbTextCompare)If TempPos > 0 ThenPos(i) = Mid(Obj.Tag, StartPos, TempPos - StartPos)StartPos = TempPos + 1ElsePos(i) = 0End If'根据控件的原始位置及窗体改变大小的比例对控件重新定位与改变大小Obj.Move Pos(0) * ScaleX, Pos(1) * ScaleY, Pos(2) * ScaleX, Pos(3) * ScaleY Next iNext ObjOn Error GoTo 0End Sub第二种,只位置就是控件的left和top随着变。

VBA窗体中最小化和最大化按钮的显示

VBA窗体中最小化和最大化按钮的显示

VBA窗体中最小化和最大化按钮的显示在插入的用户窗体项目中右击鼠标—>查看代码,打开窗体的代码窗口,然后输入下面的API系统调用程序(不需要做任何改动,以下代码与窗体属性值无关):Option ExplicitPrivate Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As LongPrivate Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPrivate Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPrivate Const GWL_STYLE = (-16)Private Const WS_THICKFRAME As Long = &H40000 '(恢复大小)Private Const WS_MINIMIZEBOX As Long = &H20000 '(最小化)Private Const WS_MAXIMIZEBOX As Long = &H10000 '(最大化)'窗体UserForm的初始化Private Sub UserForm_Initialize()Dim hWndForm As LongDim IStyle As LonghWndForm = FindWindow("ThunderDFrame", Me.Caption)IStyle = GetWindowLong(hWndForm, GWL_STYLE)IStyle = IStyle Or WS_THICKFRAME '还原IStyle = IStyle Or WS_MINIMIZEBOX '最小化IStyle = IStyle Or WS_MAXIMIZEBOX '最大化SetWindowLong hWndForm, GWL_STYLE, IStyleEnd Sub完成后运行用户窗体就可以观察到最大化和最小化窗口的效果了。

VB布局随窗口大小改变)

VB布局随窗口大小改变)

VB 布局随窗口大小改变凡用过VB编写Windows应用程序的用户都可能有过这样的经历:当一个经过精心设计的应用程序运行后,如果用户重新调整了窗体的大小,则控制在窗体中的相对位置、控件与窗体的大小比例均会严重失调,程序的界面变得面目全非。

一个好的Windows应用程序的界面,自适应窗体尺寸改变的能力是必不可少的。

笔者在这方面做了一些探讨,希望能对VB编程爱好者提供一些启发和帮助。

1、按照窗体尺寸缩放比例自动调整控件的大小窗体和控件的大小由窗体和控件的Width属性和Height属性确定。

所以当用户界面设计完成之后,窗体及其内部的各控件的Width, Height属性便随之确定下来;从而窗体相对于每一个控件,它们的宽度之比、高度之比均被确定。

如果窗体Forml内的一个文本框Text1的宽(即Text1的Width属性值)为3610,高度(即Text1的Height属性值)为1935;而窗体Form1的上述两个值分别为4890和3615,则它们的宽度之比和高度之比分别为:361014890、193513615。

当用户在程序启动后调整了窗体的尺寸,窗体的宽度和高度将分别为Form1.ScaleWidth,Form1.ScaleHeight;此时应该按上述比例来调整文本框Textl的的高度和宽度值。

即:(调整后的Text1的Width属性值)/( Form1.ScaleWidth)=3610/4890;(调整后的Text1的Height属性值)/(Form1.Scale-Height)=1935/3615;所以调整后的Text1的Width属性值=(3610/4890)* Form1.ScaleWidth;调整后的Text1的Height属性值=(1935/3615) * Form1.ScaleHeight;对于一般控件来说,应该有:调整后的控件的Width属性值=(控件原Width属性值/窗体原Width属性值)*窗体.ScaleWidth调整后的控件的Height属性值=(控件原Height属性值/窗体值/窗体原Height属性值)*窗体.ScaleHeight按照上述方法确定窗体缩放后控件Width和Height属性值,则当窗体尺寸被调整后,控件的大小将按比例得到相应的调整。

VB实现窗口最小化到任务栏

VB实现窗口最小化到任务栏

要实现窗口最小化必须满足以下条件:1:按下最小化按钮,窗体不可见2:最小化后,最小化窗体的图标必须出现在任务栏的通知区域中3:当双击通知区域中的图标时,窗体又显示出来,同时通知区域中的图标消失.要满足上面的条件:1:首先屏蔽窗体中系统自带的最小化图标,即Form.MinButton=False2:声明1个API函数:Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias " Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDA TA) As Long注意:上面这个API函数在XP中没有别名,将别名去掉后为:Public Declare Function Shell_NotifyIcon Lib "shell32.dll"(ByVal dwMessage As Long, lpData As NOTIFYICONDA TA) As Long3:声明7个常数:Public Const NIM_ADD = &H0Public Const NIM_DELETE = &H2Public Const NIF_ICON = &H2Public Const NIF_MESSAGE = &H1Public Const NIF_TIP = &H4Public Const WM_MOUSEMOVE = &H200Public Const WM_LBUTTONDBLCLK = &H2034:定义1个NOTIFYICONDA TA类型Public Type NOTIFYICONDATAcbSize as LonghWnd as LonguId as LonguFlags as LonguCallBackMessage as LonghIcon as LongszTip as StringEnd Type5:声明一个nid的类型Public nid as NOTIFYICONDA TA思路清晰后,开始编写代码1:在窗体中画1个Command,它的Caption属性为:"最小化"2:将窗体Form的MinButton的属性设为:"False"3:在窗体中添加1个模块,模块中的代码为:Public Declare Function Shell_NotifyIcon Lib "shell32.dll"(ByVal dwMessage As Long, lpData As NOTIFYICONDA TA) As LongPublic Const NIM_ADD = &H0Public Const NIM_DELETE = &H2Public Const NIF_ICON = &H2Public Const NIF_MESSAGE = &H1Public Const NIF_TIP = &H4Public Const WM_MOUSEMOVE = &H200Public Const WM_LBUTTONDBLCLK = &H203Public Type NOTIFYICONDATAcbSize as LonghWnd as LonguId as LonguFlags as LonguCallBackMessage as LonghIcon as LongszTip as StringEnd TypePublic nid as NOTIFYICONDA TA4:编写Command的单击事件:Private Sub Command1_Click()nid.cbSize = Len(nid)nid.uId = vbNullnid.hWnd = Me.hWndnid.uFlags = NIF_TIP Or NIF_MESSAGE Or NIF_ICONnid.uCallBackMessage = WM_MOUSEMOVEnid.hIcon = Me.Iconnid.szTip = "窗体最小化"Shell_NotifyIcon NIM_ADD, nidMe.HideEnd Sub5:编写窗体的MouseMove事件:Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim msg As Longmsg = X / 15If msg = WM_LBUTTONDBLCLK ThenMe.ShowShell_NotifyIcon NIM_DELETE, nidEnd IfEnd Sub按F5启动,单击Command,看看通知区域中是不是多了个窗体的图标?双击该图标,窗体又显示出来了!如何做到当我们单击窗口的最小化按钮时,窗口先最小化到任务栏成为按钮,然后消失,图标显示到通知栏呢?大家熟悉的FoxMail能做到,我们也可以做到。

VB 控件随窗口大小改变

VB 控件随窗口大小改变

VB 控件随窗口大小改变一个好的Windows应用程序的界面,自适应窗体尺寸改变的能力是必不可少的。

笔者在这方面做了一些探讨,希望能对VB编程爱好者提供一些启发和帮助。

凡用过VB编写Windows应用程序的用户都可能有过这样的经历:当一个经过精心设计的应用程序运行后,如果用户重新调整了窗体的大小,则控制在窗体中的相对位置、控件与窗体的大小比例均会严重失调,程序的界面变得面目全非。

1、按照窗体尺寸缩放比例自动调整控件在窗体中的相对位置控件在窗体中的位置由该控件的Left和Top属性确定。

程序启动后如果窗体被缩放,只要按照缩放的比例来重新调整窗体内各控件的Left和Top属性值即可。

所以根据上面介绍的原理,在窗体被缩放之后,只要按照下面的关系来设置控件的Left和Top属性值即可。

调整后控件的Left属性值=(控件原Left属性值/窗体原Left属性值)*窗体.ScaleWidth;调整后控件的Top属性值=(控件原Top属性值/窗体原Top属性值)*窗体.ScaleHeight;2、按照窗体尺寸缩放比例自动调整控件的大小窗体和控件的大小由窗体和控件的Width属性和Height属性确定。

所以当用户界面设计完成之后,窗体及其内部的各控件的Width, Height属性便随之确定下来;从而窗体相对于每一个控件,它们的宽度之比、高度之比均被确定。

如果窗体Forml内的一个文本框Text1的宽(即Text1的Width属性值)为3610,高度(即Text1的Height属性值)为1935;而窗体Form1的上述两个值分别为4890和3615,则它们的宽度之比和高度之比分别为:361014890、193513615。

当用户在程序启动后调整了窗体的尺寸,窗体的宽度和高度将分别为Form1.ScaleWidth,Form1.ScaleHeight;此时应该按上述比例来调整文本框Textl的的高度和宽度值。

即:(调整后的Text1的Width属性值)/( Form1.ScaleWidth)=3610/4890;(调整后的Text1的Height属性值)/(Form1.Scale-Height)=1935/3615;所以调整后的Text1的Width属性值=(3610/4890)* Form1.ScaleWidth;调整后的Text1的Height属性值=(1935/3615) * Form1.ScaleHeight;对于一般控件来说,应该有:调整后的控件的Width属性值=(控件原Width属性值/窗体原Width属性值)*窗体.ScaleWidth调整后的控件的Height属性值=(控件原Height属性值/窗体值/窗体原Height属性值)*窗体.ScaleHeight按照上述方法确定窗体缩放后控件Width和Height属性值,则当窗体尺寸被调整后,控件的大小将按比例得到相应的调整。

实现VB程序的自启动并将图标加到任务栏

实现VB程序的自启动并将图标加到任务栏
As L ng o
许 多 程 序 都 希 望 在 计 算 机 启 动 后 自动 后 台 运 行 , 这
样 一 方 面 可 以不 干 扰 用 户 在 计 算 机 上 进 行 其 他 操 作 , 一方 面也 可 保 证 实 现 程 序 的某 些 特 殊 功 能。 另 本 文 正 是 从 此 出 发 , 绍 了 一些 有 关 这 方 面 的 实 际 介 编程技 巧。
c D t A n )A n b a sL g sL g a o o
1 用 Wid w n o s的 A I函 数 实 现 程 序 自 P 启 动
面 向 Widw 平 台 的 程 序 员 必 须 使 用 注 册 表 来 no s
( ) 量 声 明 2常
P ia e Co s rv t n tREG Z = 1 S Prv t Co t HKEY i ae ns &H8 0D 0 0 I O0 2 L0CAL M ACHI = NE
— —
A C S ,h eH n l) C E S K y a de
I s h = Re S t au E ( Ke Ha de t ” &, Re u g eV le x h y n l ,“t ,0 t
REG

注 册 表来 完 成 。这 就 要 运 用 Widw P n o sA I函 数 首 先 将 注 册 表 打 开 ; 后 将 应 用 程 序 的 完 整 路 径 作 为 键 然 的键 值 , 到 注 册 表 中 管 理 程 序 自启 动 的 路 径 下 。 放
使 他 们 的 应 用 程 序 与 Widw n o s环 境 完 整 地 结 合 起
来 。 注册 表 是 一 个 系 统 范 围 内 的 多层 次 数 据 库 , 用

VBA修改窗口为最小化、最大化代码

VBA修改窗口为最小化、最大化代码

tion.Cursor=xlWait为沙漏(等待)形 Application.Cursor=xlNormal为正常Application.St
atusBar="大众计算机" ’在地址栏中显示文本 Application.Caption= "大众计算机" 修改标题栏的文字. 其它的知识
Application.TemplatesPath ‘获取工作簿模板的位置 Application.CalculateFull ’重新计算所有
ialogPrint).Show ‘显示打印文档的对话框
精心发布,谢谢阅读收藏,谢谢!
医药网 /
以下的VBA代码,均于Excel中的VBA有关,是用来修改应 用程序的相关属性的。代码收藏如下。 Application.WindowState
=xlMinimized ‘窗口最小化Application.WindowState =xlMaximized 最大化Application
.WindowState =x来自Normal为正常Application.Cursor=xlIBeam ‘设置光标形状为Ⅰ字形Applica
打开的工作簿中的数据 Application.RecentFiles.Maximum=3 ’将最近使用的文档列 表数设为3Application
.RecentFiles(6).Open ’打开最近打开的文档中的第6个文档 Application.AutoCorrect.AddRepla
cement "good", "大众计算机" ’自动将输入的"good"更正 为"大众计算机"Application.Dialogs(xlD

转载.VB设置窗体

转载.VB设置窗体

1、设置窗体2010-11-18 16:42阅读(117)∙赞∙评论(1)∙转载(13)∙分享∙复制地址∙收藏夹按钮收藏∙更多上一篇 | 下一篇:3、程序反向铣_分...1. 如何设置一个From的边界2. 如何建立一个透明的From3. 如何设置窗体在屏幕中的位置4. 如何使最小化和最大化按钮不可用5. 如何使一个窗体不见6. 如何设置使窗体成为非矩形的.7. 如何使一个窗体在屏幕的最顶端.8. 如何显示一个Model和非Model的窗体9. 如何制作一个MDI的窗体10. 如何将你的窗体不显示在任务条上.11. 如何制作一个带启动屏幕的窗体.12. 如何使你的窗体TrayIcon.13. 如何修改控制窗体的尺寸和长宽尺寸.14. 如何建立一个Windows Explorer风格的窗体.15. 如何设置初始的启动窗体16. 如何建立一个有背景图像的窗体==========================================================================================1. 如何设置一个From的边界form总共有七种不同的边界风格让你设置,你可以在设计时刻也可以运行时通过代码动态的来设置它.这七种边none (System.Windows.Forms.FormBorderStyle.None )fixed 3D (System.Windows.Forms.FormBorderStyle.Fixed3D)fixed Dialog (System.Windows.Forms.FormBorderStyle.FixedDialog)fixed Single(System.Windows.Forms.FormBorderStyle.FixedSingle)fixed Tool Window(System.Windows.Forms.FormBorderStyle.FixedToolWindow)sizable(system.windows.forms.formborderstyle.sizable)sizable Tool Window(system.windows.forms.formborderstyle.sizabletoolwindow)在设计方式下在 IDE的 Properties window中设置FormBorderStyle属性就可以了.在运行方式下你可以用代码来完成:dlgbx1.formborderstyle = System.Windows.Forms.FormBorderStyle.FixedDialog这七种边界类型VB6中就有,没有什么大的变化,运行方式下你需要对照不同的枚举变量进行设置.2. 如何建立一个透明的From你可以通过两种方法在设计时刻和运行时刻来做到这一点.设计时刻,你可以在 IDE的 Properties window, 设置Opacity 属性达到这个效果.这个值从0.0到1.0全不透明.运行时刻你可以用下面的编码设置窗体的opactiy属性来做到.具体:frmtransparentform.opacity = 0.76; ( C# )看得出现在很简单了,你已经不用再去了解什么alpha变量了.透明始终只是一种效果,不要滥用它.3. 如何设置窗体在屏幕中的位置你可以设置窗体的startposition属性,一般给你一个保守的选项” WindowsDefaultLocation“ 这样系前的计算机设置来确定一个值,你也可以在设计时将它改成另一个值”Center”.如果你一定要在设计方式下确定窗体在屏幕出现的位置你可以先设置startposition为manual,然后设置locat运行时用代码实现似乎更简洁一些:Form1.Location = new Point (100, 100) ( )当然你也可以分别修改的Location的X和Y值,对应的是窗体的Left和Top属性,比如:form1.left += 200 ( )form1.top -= 100 ( )另外一个属性将也将影响窗体在屏幕的位置:desktoplocation 这个属性主要是在你设置窗体的位置相对于任务在屏幕的顶或左边时,其实相应改动了desktop coordinates (0,0)),你可以这样设置这个不出现在设计属性窗form1.desktoplocation = new Point (100,100)窗体在屏幕中的位置将主要取决于各自用户具体的硬件和设置情况,所以保守的作法是用默认的” WindowsDefa 专业的作法是自己先获取系统的设置然后编码动态计算后进行设置,不然很容易在屏幕上找不到你的窗体.4. 如何使最小化和最大化按钮不可用在设置窗体的form.minimizebox和form.maximizebox 当为True时表示显示,False时表示不可.用编程方式见frmmaxmin.minnimizebox = False ( )frmmaxmin.maxmnimizebox = True ( )5. 如何使一个窗体不见我想最直接的办法是你调用 Hide()方法来做到这一点.不过我想提供另一种方法,看了之后你会获得一些其它的Private Const WS_EX_TOOLWINDOW As Int32 = &H80Private Const WS_POPUP As Int32 = &H80000000Private Const WS_VISIBLE As Int32 = &H10000000Private Const WS_SYSMENU As Int32 = &H80000Private Const WS_MAXIMIZEBOX As Int32 = &H10000Protected Overrides ReadOnly Property CreateParams() As System.Windows.Forms.CreateParamsGetDim cp As System.Windows.Forms.CreateParamscp = MyBase.CreateParamscp.ExStyle = WS_EX_TOOLWINDOWcp.Style = WS_POPUP Or WS_VISIBLE Or WS_SYSMENU Or WS_MAXIMIZEBOXcp.Height = 0cp.Width = 0Return cpEnd GetEnd Property原来是把Height 和Width都设置成0 ,我想这种方式和Hide()调用的底层可能是不同的。

VBA修改窗口为最小化、最大化代码

VBA修改窗口为最小化、最大化代码
以下的VBA代码,均于Excel中的VBA有关,是用来修改应 用程序的相关属性的。代码收藏如下。 Application.WindowState
=xlMinimized ‘窗口最小化Application.WindowState =xlMaximized 最大化Application
.WindowState =xlNormal为正常Application.Cursor=xlIBeam ‘设置光标形状为Ⅰ字形Applica
打开的工作簿中的数据 Application.RecentFiles.Maximum=3 ’将最近使用的文档列 表数设为3Application
.RecentFiles(6).Open ’打开最近打开的文档中的第6个文档 Application.AutoCorrect.AddRepla
cement "good", "大众计算机" ’自动将输入的"good"更正 为"大众计算机"Application.Dialogs(xlD
tion.Cursor=xlWait为沙漏(等待)形 Application.Cursor=xlNormal为正常Applic4; ’在地址栏中显示文本 Application.Caption= "大众计算机" 修改标题栏的文字. 其它的知识
Application.TemplatesPath ‘获取工作簿模板的位置 Application.CalculateFull ’重新计算所有
ialogPrint).Show ‘显示打印文档的对话框
精心发布,谢谢阅读收藏,谢谢!
医药网 /
知识回顾
  1. 1、下载文档前请自行甄别文档内容的完整性,平台不提供额外的编辑、内容补充、找答案等附加服务。
  2. 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
  3. 3、如文档侵犯您的权益,请联系客服反馈,我们会尽快为您处理(人工客服工作时间:9:00-18:30)。
Function Icon_Del(iHwnd As Long, lIndex As Long) As Long
Dim IconVa As NOTIFYICONDATA
Dim L As Long
With IconVa
.hwnd = iHwnd
.uID = lIndex
.cbSize = Len(IconVa)
.cbSize = Len(IconVa)
.uFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP
Icon_Modify = Shell_NotifyIcon(NIM_MODIFY, IconVa)
End With
End Function
Public Const NIF_TIP = 4 ToolTip(提示)有效
API函数声明
图标操作
Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
最关键的一步就是将图标显示在通知栏里,VB里没有现成的做法,我们还得用API函数。API函数库里有一个函数Shell_NotifyIcon(ByVal dwMessage As Long, lpData As NOTIFYICONDATA),是专门操作(包括添加、修改、删除)通知栏里图标的。
点一下通知栏图标,会出现一些诸如"退出"、"显示窗口"的弹出菜单,怎样实现弹出菜单呢?这个很容易实现,因为点击图标会触发图标所在窗口的MouseDown事件,我们把弹出菜单触发过程写入Form1_MouseDown事件即可。具体例程如下:
第一步、为了增强程序的可移植性,我们新建一个模块,取名为:NoticeIcon,在此模块中定义一些常量、自定义类型、所需的API函数说明及操作通知栏图标的三个自定义函数(添加、修改、删除),模块NoticeIcon具体代码如下所示:
定义类型
通知栏图标状态
Public Type NOTIFYICONDATA
cbSize As Long
hwnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * 64
只要我们能截获最小化这个事件发送给窗口的消息,然后换成我们自定义的过程,问题就解决了。大家仔细想一想,当按下最小化按纽时会引发什么事件?最小化时窗口大小会发生变化会引发Form1.Resize事件,我们只要在Form1.Resize事件里用Form1.Visible = False使窗口消失,然后将窗口图标显示到通知栏即可达到我们想要的效果。
Public Const NIM_MODIFY = 1 修改图标
Public Const NIM_DELETE = 2 删除图标
Public Const NIF_MESSAGE = 1 message 有效
Public Const NIF_ICON = 2 图标操作(添加、修改、删除)有效
怎样判断发生Resize事件时窗口是最小化状态呢?VB里没有现成的做法,我们可以用非富的API函数。API函数库里有一个函数IsIconic(ByVal hwnd As Long),它就是专门判断窗口是否已最小化的。这样当Form产生Resize事件时,用IsIconic函数判断一下窗口是否为最小化状态,就可知道是否用户按了最小化按钮。
Dim IconVa As NOTIFYICONDATA
With IconVa
.hwnd = iHwnd
.szTip = sTips + Chr$(0)
.hIcon = hIcon
.uID = IconID
.uCallbackMessage = WM_LBUTTONDOWN
End Type
函数定义
添加图标至通知栏
Public Function Icon_Add(iHwnd As Long, sTips As String, hIcon As Long, IconID As Long) As Long
参数说明:iHwnd:窗口句柄,sTips:当鼠标移到通知栏图标上时显示的提示内容
.cbSize = Len(IconVa)
.uFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP
Icon_Add = Shell_NotifyIcon(NIM_ADD, IconVa)
End With
End Function
删除通知栏图标(参数说明同Icon_Add)
hIcon:图标句柄,IconID:图标Id号
Dim IconVa As NOTIFYICONDATA
With IconVa
.hwnd = iHwnd
.szTip = sTips + Chr$(0)
.hIcon = hIcon
.uID = IconID
.uCallbackMessage = WM_LBUTTONDOWN
Public Const DefaultIconIndex = 1 图标缺省索引
Public Const WM_LBUTTONDOWN = &H201 按鼠标左键
Public Const WM_RBUTTONDOWN = &H204 按鼠标右键
Public Const NIM_ADD = 0 添加图标
End With
Icon_Del = Shell_NotifyIcon(NIM_DELETE, IconVa)
End Function
修改通知栏图标(参数说明同Icon_Add)
Public Function Icon_Modify(iHwnd As Long, sTips As String, hIcon As Long, IconID As Long) As Long
判断窗口是否最小化
Declare Function IsIconic Lib "user32" (ByVal hwnd As Long) As Long
设置窗口位置和状态(position)的功能
Ds Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
相关文档
最新文档