当前位置: 源码素材网 » VB教程 » 详情页

一个自由控制窗体控制缩放的VB控件代码

  •   时间:2019-01-30
  • 概述:自动缩放

Vb控制代码,可自由缩放窗体中的控制,比如commbox/Listbox等控件,里面是一些声明及方法,需要和其它VB代码配合使用,后附有使用例子。

Attribute VB_Name = "mod_restrictsize"
Option Explicit
'***********************************
'全局API声明
'***********************************
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
'***********************************
'局部变量
'***********************************
    Private startupheight As Long
    Private startupwidth As Long
'***********************************
'全局变量
'***********************************
    Private defWindowProc As Long
    Private minX As Long
    Private minY As Long
    Private maxX As Long
    Private maxY As Long
'***********************************
'全局常数
'***********************************
    Private Const WM_GETMINMAXINFO As Long = &H24
    Private Const GWL_WNDPROC = (-4)
'***********************************
'类型声明
'***********************************
'全局
Private Type POINTAPI
    x As Long
    y As Long
End Type
'局部
Private Type MINMAXINFO
    ptReserved As POINTAPI
    ptMaxSize As POINTAPI
    ptMaxPosition As POINTAPI
    ptMinTrackSize As POINTAPI
    ptMaxTrackSize As POINTAPI
End Type
'***********************************
'用户接口
'***********************************
'-------------------------------
'窗体约束
'-------------------------------
Public Sub restrictform(resrictform As Form)
    Dim startupwidth As Long
    Dim startupheight As Long
    With resrictform
        startupwidth = .width \ Screen.TwipsPerPixelX
        startupheight = .height \ Screen.TwipsPerPixelY
        minX = startupwidth
        minY = startupheight
        maxX = Screen.width \ Screen.TwipsPerPixelX
        maxY = Screen.height \ Screen.TwipsPerPixelY
        SubClass .hwnd
    End With
End Sub
'-------------------------------
'窗体释放
'-------------------------------
Public Sub unrestrictform(restrictform As Form)
    UnSubClass restrictform.hwnd
End Sub
'***********************************
'子集
'***********************************
    '-------------------------------
    '开始子集
    '-------------------------------
    Private Sub SubClass(hwnd As Long)
        On Error Resume Next
        defWindowProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
    End Sub

    '-------------------------------
    '结束子集
    '-------------------------------
    Private Sub UnSubClass(hwnd As Long)
        If defWindowProc Then
            SetWindowLong hwnd, GWL_WNDPROC, defWindowProc
            defWindowProc = 0
        End If
    End Sub
'***********************************
'窗体缩放程序
'***********************************
Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Select Case uMsg
        Case WM_GETMINMAXINFO
            Dim MMI As MINMAXINFO
            CopyMemory MMI, ByVal lParam, LenB(MMI)
            With MMI
                .ptMinTrackSize.x = minX
                .ptMinTrackSize.y = minY
                .ptMaxTrackSize.x = maxX
                .ptMaxTrackSize.y = maxY
            End With
            CopyMemory ByVal lParam, MMI, LenB(MMI)
            WindowProc = 0
        Case Else
            WindowProc = CallWindowProc(defWindowProc, hwnd, uMsg, wParam, lParam)
    End Select
End Function

    相关声明:

      若“一个自由控制窗体控制缩放的VB控件代码”有损您的权益,请告之我们删除内容。
      部分文章来源于网络,版权归原作者所有。