无边框窗体最大化,但是不档住任务栏

个窗体,一个模块:
窗体上两个按钮,窗体的BorderStyle属性为0,窗体代码如下:
Option Explicit
Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long

Private Sub Command1_Click()
    Me.WindowState = 2
End Sub

Private Sub Command2_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    Dim hTaskBar As Long
    hTaskBar = FindWindow("Shell_TrayWnd", vbNullString)
    Debug.Print hTaskBar
    Dim RC As RECT
    Dim i As Long
    i = GetWindowRect(hTaskBar, RC)
    Dim taskheight As Long
    taskheight = RC.Bottom - RC.Top '任务栏高度
    i = GetWindowRect(GetDesktopWindow, RC)
    Dim maxwidth As Long
    Dim maxheight As Long
    maxwidth = RC.Right - RC.Left '获取屏幕宽度
    maxheight = RC.Bottom - RC.Top - taskheight '屏幕高度-任务栏高度
    LockWindow Me.hwnd, , , maxwidth, maxheight
End Sub

模块代码:
Option Explicit

Public Type POINTAPI
        x As Long
        y As Long
End Type

Public Type MINMAXINFO
        ptReserved As POINTAPI
        ptMaxSize As POINTAPI
        ptMaxPosition As POINTAPI
        ptMinTrackSize As POINTAPI
        ptMaxTrackSize As POINTAPI
End Type

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public 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 Long

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const WM_GETMINMAXINFO = &H24
Public Const GWL_WNDPROC = -4

Global lpPrevWndProc As Long
Public procOld As Long
Public udtMMI As MINMAXINFO
    
Public Function WindowProc(ByVal hwnd As Long, ByVal iMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
     Select Case iMsg
     Case WM_GETMINMAXINFO
        Dim udtMINMAXINFO As MINMAXINFO
        CopyMemory udtMINMAXINFO, ByVal lParam, 40&
        With udtMINMAXINFO
           .ptMaxSize.x = udtMMI.ptMaxSize.x
           .ptMaxSize.y = udtMMI.ptMaxSize.y
           .ptMaxPosition.x = 0
           .ptMaxPosition.y = 0
           .ptMaxTrackSize.x = .ptMaxSize.x
           .ptMaxTrackSize.y = .ptMaxSize.y
           .ptMinTrackSize.x = udtMMI.ptMinTrackSize.x
           .ptMinTrackSize.y = udtMMI.ptMinTrackSize.y
           Debug.Print .ptMaxSize.x & "," & .ptMaxSize.y
        End With
        CopyMemory ByVal lParam, udtMINMAXINFO, 40&
        WindowProc = False
        Exit Function
     End Select
     WindowProc = CallWindowProc(procOld, hwnd, iMsg, wParam, lParam)
End Function

Public Function LockWindow(hwnd As Long, Optional MinWidth As Long, Optional MinHeight As Long, Optional maxwidth As Long, Optional maxheight As Long) As Boolean
     With udtMMI
        '指定窗体最小宽度
        If MinWidth = 0 Then .ptMinTrackSize.x = 0 Else .ptMinTrackSize.x = MinWidth
        '指定窗体最小高度
        If MinHeight = 0 Then .ptMinTrackSize.y = 0 Else .ptMinTrackSize.y = MinHeight
        '指定窗体最大宽度
        If maxwidth = 0 Then .ptMaxSize.x = Screen.Width / Screen.TwipsPerPixelX Else .ptMaxSize.x = maxwidth
        '指定窗体最大高度
        If maxheight = 0 Then .ptMaxSize.y = Screen.Width / Screen.TwipsPerPixelX Else .ptMaxSize.y = maxheight
     End With
     procOld = SetWindowLong(hwnd, -4, AddressOf WindowProc)
End Function

  • 0
    点赞
  • 1
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值