建立永遠停留在最上層的窗口(VB)

1.建立新的 [標準執行檔] 專案,根據預設值,隨即建立 Form1。
2.在 Form1 上加入兩個指令按鈕 (Command1 與 Command2)。
3.將 Command1 的標題 (Caption) 屬性設為「Always on top」。
4.將 Command2 的標題 (Caption) 屬性設為「Normal」。
5.將下面程式碼放入 Form1 的 [宣告] 區段中: `
      Option Explicit

      Private Sub Command1_Click()
         Dim lR As Long
         lR = SetTopMostWindow(Form1.hwnd, True)
      End Sub

      Private Sub Command2_Click()
         Dim lR As Long
         lR = SetTopMostWindow(Form1.hwnd, False)
      End Sub

6\. | 在 [專案] 功能表上,按一下 [新增模組],在專案中加入新模組。 7\. | 將下面程式碼加入新模組中:

      Option Explicit
      Public Const SWP_NOMOVE = 2
      Public Const SWP_NOSIZE = 1
      Public Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
      Public Const HWND_TOPMOST = -1
      Public Const HWND_NOTOPMOST = -2

      Declare Function SetWindowPos Lib "user32" Alias "SetWindowPos"  _
            (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

      Public Function SetTopMostWindow(hwnd As Long, Topmost As Boolean) _
         As Long

         If Topmost = True Then 'Make the window topmost
            SetTopMostWindow = SetWindowPos(hwnd, HWND_TOPMOST, 0, 0, 0, _
               0, FLAGS)
         Else
            SetTopMostWindow = SetWindowPos(hwnd, HWND_NOTOPMOST, 0, 0, _
               0, 0,FLAGS)
            SetTopMostWindow = False
         End If
      End Function

`

Published At
Categories with Web编程
Tagged with
comments powered by Disqus