VB根据窗体自动调整窗体内控件大小 注：实用，可以直接引用

最新推荐文章于 2023-08-29 16:16:58 发布
最新推荐文章于 2023-08-29 16:16:58 发布
阅读量1.2k 收藏 6
点赞数 1
版权声明：本文为博主原创文章，遵循 CC 4.0 BY-SA 版权协议，转载请附上原文出处链接和本声明。
本文链接：https://blog.csdn.net/miaozk2006/article/details/82416248
版权
VB代码实现窗体尺寸变化时，窗体内控件自动按比例调整大小，适用于各种控件布局的动态适应。
摘要由CSDN通过智能技术生成

代码如下：

Option Explicit
Private ObjOldWidth     As Long       '保存窗体的原始宽度
Private ObjOldHeight     As Long     '保存窗体的原始高度
Private ObjOldFont     As Single     '保存窗体的原始字体比

Private Sub Form_Resize()
    '确保窗体改变时控件随之改变
    Call ResizeForm(Me)
End Sub

Private Sub Form_Load()
    '在程序装入时必须加入
    Call ResizeInit(Me)
End Sub

'模块

'在调用ResizeForm前先调用本函数
Public Sub ResizeInit(FormName As Form)
    Dim Obj     As Control
    ObjOldWidth = FormName.ScaleWidth
    ObjOldHeight = FormName.ScaleHeight
    ObjOldFont = FormName.Font.Size / ObjOldHeight
    On Error Resume Next

    For Each Obj In FormName
        Obj.Tag = Obj.Left & "   " & Obj.Top & "   " & Obj.Width & "   " & Obj.Height & "   "
    Next Obj

    On Error GoTo 0

End Sub

'按比例改变表单内各元件的大小，
'在调用ReSizeForm前先调用ReSizeInit函数
Public Sub ResizeForm(FormName As Form)

    Dim Pos(4)     As Double
    Dim i     As Long, TempPos       As Long, StartPos       As Long
    Dim Obj     As Control
    Dim ScaleX     As Double, ScaleY       As Double

    ScaleX = FormName.ScaleWidth / ObjOldWidth
    '保存窗体宽度缩放比例
    ScaleY = FormName.ScaleHeight / ObjOldHeight
    '保存窗体高度缩放比例
    On Error Resume Next

    For Each Obj In FormName
        StartPos = 1

        For i = 0 To 4
            '读取控件的原始位置与大小
            TempPos = InStr(StartPos, Obj.Tag, "   ", vbTextCompare)

            If TempPos > 0 Then
                Pos(i) = Mid$(Obj.Tag, StartPos, TempPos - StartPos)
                StartPos = TempPos + 1
            Else
                Pos(i) = 0
            End If

            '根据控件的原始位置及窗体改变大
            '小的比例对控件重新定位与改变大小
            Obj.Move Pos(0) * ScaleX, Pos(1) * ScaleY, Pos(2) * ScaleX, Pos(3) * ScaleY
            Obj.Font.Size = ObjOldFont * FormName.ScaleHeight

        Next i

    Next Obj

    On Error GoTo 0

End Sub



最低0.47元/天 解锁文章
miaozk2006
关注
  • 1
    点赞
  • 踩
  • 6
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
vb6.0 控件适应窗口大小
zfulee的专栏
10-18 4675
我们在编写vb6.0控件适应窗口大小时，往往使用以下方法：(按照窗体尺寸缩放比例自动调整控件的大小) 　　窗体和控件的大小由窗体和控件的Width属性和Height属性确定。所以当用户界面设计完成之后，窗体及其内部的各控件的Width, Height属性便随之确定下来；从而
通过resize事件实现随着窗口大小的变化里面的控件大小也随之变化,left,top等等上下左右都会随动
10-15
通过resize事件实现随着窗口大小的变化里面的控件大小也随之变化,left,top等等上下左右都会随动
让控件随窗体大小改变而改变
cike_1111的专栏
02-18 962
模块作用:让控件随窗体大小改变而改变 模块代码: ====请看下面===== Option Explicit Private FormOldWidth As Long 保存窗体的原始宽度 Private FormOldHeight As Long 保存窗体的原始高度 Public Sub ResizeForm(FormName As Form)       Dim Pos(4) As Do
vba窗体控件大小适应
11-24 4510
Dim ctl As Control '窗体控件变量 Dim pos As New Collection '控件 位置比例参数 Dim lng As New Collection '控件 大小比例参数 Private Sub UserForm_Initialize() '利用集合记录各个控件与窗体比例的参数 For Each ctl In Me.Controls pos.Add
VB 控件随窗体大小变化
最新发布
JSY
08-29 404
VB 控件随窗体大小变化
VB:所有控件自适应窗口大小
热门推荐
zhongyhc的专栏
07-13 1万+
Option Explicit Private FormOldWidth As Long '保存窗体的原始宽度 Private FormOldHeight As Long '保存窗体的原始高度 '在调用ResizeForm前先调用本函数 Private Sub ResizeInit(FormName As Form) Dim Obj As Control
VB 控件随窗体自动调整大小.rar
07-10
VB 控件随窗体自动调整大小，像窗口中的ListBox、Image、FileListBox、VB.Frame控件等，都可以随窗口的大小变化而变化，当用户拖动改变窗口大小时，这些控件的大小也会随之改变，这个功能的实现得益于自定义函数Form...
控件大小随窗体的改变而改变VB6.0源代码.rar
04-13
标题“控件大小随窗体的改变而改变VB6.0源代码”表明这是一个示例项目，演示了如何使控件如按钮、文本框等自动调整大小以适应窗体的变化。这种功能在开发响应式用户界面时非常有用，确保程序在不同分辨率或屏幕尺寸...
Windows窗口自动化操作类forVB6_V1.8 源代码
07-29
楼主辛苦开发的源码，0分放送。亲们只要评价五分就是对我的努力付出的最大回报！ 此版本比v1.7的多增加了几个函数和方法，同时也修正了一些bug。 vb封装的一个控制窗口操作的类，使用非常简单！时刻更新。 clsWindow是VB6环境下使用的一个操作外部程序窗口的类，比如得到窗口句柄，得到窗口里某个文本框的内容。非常方便，使用它可以让您脱身于一堆api函数，功能强大使用简单！ 这个类楼主很早就开始封装了，原本打算做成类似DOM对象那样，通过一堆getElmentByXXX等方法实现对桌面程序下各个窗口以及里面各个控件对象的自由访问，但是具体要做的工作太多，目前只实现了一部分，期待大家一起加入更新维护。 目前该类封装了绝大部分对windows窗口的常用操作，例如：获取窗口句柄，设置窗口为活动窗口，设置窗口内文本框内容，点击窗口内的某些按钮等。 这个类现在还在一直不断地扩充，功能已经很强大很广泛，使用它可以轻而易举地设置窗口标题栏文字，移动窗体等等。以前要实现这些操作常常需要一大堆api函数，现在只需要一点点代码就可以了，完全让您脱身于api函数的海洋。当然需要您需要研究每个方法实现原理的话可以看一看源代码。 使用范例： 1）关闭腾讯新闻窗口“腾讯网迷你版”。 Dim window As New clsWindow If window.GetWindowHwndByTitle("腾讯网迷你版") > 0 Then window.CloseWindow '关闭窗口 End If 以上是不是很简洁呢？ 2）获取某个打开的记事本里面的内容。假设记事本标题为“测试.txt - 记事本”，通过SPY等工具查看得知记事本的文本框类名为：Edit，那么我们编写程序如下： Dim window As New clsWindow If window.GetWindowHwndByTitle("测试.txt - 记事本") > 0 Then MsgBox window.GetElementTextByClassName("Edit") End If 这个看起来也很简单，方法自由还可以使用正则匹配，可以写成下面这样： Dim window As New clsWindow If window.GetWindowHwndByTitleRegExp("测试\.txt.*?") > 0 Then MsgBox window.GetElementTextByClassName("Edi", , True)'第三个参数表示是否使用正则，默认为false End If 更多演示案例： 演示程序一（关闭包含“扫雷、蜘蛛纸牌”等系统自带游戏的窗口）： http://files.cnblogs.com/sysdzw/clsWindow1.7_demo1.rar 演示程序二（调用系统计算器，点击里面的按钮进行计算）： http://files.cnblogs.com/sysdzw/clsWindow1.7_demo2.rar 演示程序三（激活移动外部程序窗口）： http://files.cnblogs.com/sysdzw/clsWindow1.7_demo3.rar 演示程序四（调用系统计算器，花样移动出现，效果很好）： http://files.cnblogs.com/sysdzw/clsWindow1.7_demo4.rar clsWindow类最新版下载请关注博客： http://blog.csdn.net/sysdzw/article/details/9083313 '=================================================================================== '描 述：一个操作windows窗口的类，可对窗口进行很多常用的操作(类名为clsWindow) '使用范例：Dim window As New clsWindow ' window.GetWindowHwndByTitle "计算器" ' window.closeWindow '编 程：sysdzw 原创开发，如果有需要对模块扩充或更新的话请邮箱发我一份，共同维护 '发布日期：2013/06/01 '博 客：http://hi.baidu.com/sysdzw ' http://blog.csdn.net/sysdzw 'Email ：sysdzw@163.com 'QQ ：171977759 '版 本：V1.0 初版 2012/12/03 ' V1.1 修正了几个正则相关的函数，调整了部分类结构 2013/05/28 ' V1.2 增加属性Caption，可以获取或设置当前标题栏 2013/05/29 ' V1.3 增加了方法Focus，可以激活当前窗口 2013/06/01 ' 增加了方法Left,Top,Width,Height,Move，处理窗口位置等 ' V1.4 增加了窗口位置调整的几个函数 2013/06/04 ' 增加了得到应用程序路径的函数AppName ' 增加了得到应用程序启动参数的函数AppCommandLine ' V1.5 增加了窗口最大最小化，隐藏显示正常的几个函数 2013/06/06 ' 增加了获取控件相关函数是否使用正则的参数UseRegExp默认F ' V1.6 将Left，Top函数改为属性，可获得可设置 2013/06/10 ' V1.7 增加了CloseApp函数，可以结束进程 2013/06/13 ' 修正了部分跟正则匹配相关的函数 ' 增加函数：GetElementTextByText ' 增加函数：GetElementHwndByText ' V1.8 增加GetWindowHwndByClassName函数 2013/06/26 ' 增加GetWindowHwndByClassNameEx函数 ' 增加GetWindowHwndByAppName函数 ' 增加私有变量hWnd_ ' 增加属性hWnd，可设置，单设置时候会检查，非法则设置为0 ' 更新GetWindowHwndByTitleEx函数，使之可以选择性支持正则 ' 删除GetWindowHwndByTitleRegExp函数，合并到上面函数 ' 增加SetFocus函数，调用Focus实现，为了是兼容VB习惯 ' 扩了ProcessID、AppPath、AppName、AppCommandLine三个函数，可带参数 ' 网友wwb(wwbing@gmail.com)提供了一些函数和方法属性： ' CheckWindow, Load, WindowState, Visible, hDC, ZOrder ' AlphaBlend, Enabled, Refresh, TransparentColor ' 部分采纳网友意见，将句柄变量改为hWnd_，但是hWnd作为公共属性 '===================================================================================
VB6 自动缩放窗体内控件
05-12
VB6 自动缩放窗体内控件 这个我在网上找了好久 终于找到一个不错的 分享出来
VB窗体控件大小随窗体大小变化而变化
10-05
VB窗体控件大小随窗体大小变化自動調整 有时窗体变化后，如改变分辨率后控件大小却不能随之改变。手工代码调整实在麻烦，下面的模块实现自动查找窗体上控件并使其改变大小以适应窗体变化。 在Form的Resize事件中调用函数Resize_All就能实现控件自动调整大小，如： Private Sub Form_Resize() Dim H, i As Integer On Error Resume Next Resize_ALL Me 'Me是窗体名，Form1,Form2等等都可以 End Sub 在模块中添加以下代码： Public Type ctrObj Name As String Index As Long Parrent As String Top As Long Left As Long Height As Long Width As Long ScaleHeight As Long ScaleWidth As Long End Type Private FormRecord() As ctrObj Private ControlRecord() As ctrObj Private bRunning As Boolean Private MaxForm As Long Private MaxControl As Long Private Const WM_NCLBUTTONDOWN = &HA1 Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function ReleaseCapture Lib "USER32" () As Long Function ActualPos(plLeft As Long) As Long If plLeft < 0 Then ActualPos = plLeft + 75000 Else ActualPos = plLeft End If End Function Function FindForm(pfrmIn As Form) As Long Dim i As Long FindForm = -1 If MaxForm > 0 Then For i = 0 To (MaxForm - 1) If FormRecord(i).Name = pfrmIn.Name Then FindForm = i Exit Function End If Next i End If End Function Function AddForm(pfrmIn As Form) As Long Dim FormControl As Control Dim i As Long ReDim Preserve FormRecord(MaxForm + 1) FormRecord(MaxForm).Name = pfrmIn.Name FormRecord(MaxForm).Top = pfrmIn.Top FormRecord(MaxForm).Left = pfrmIn.Left FormRecord(MaxForm).Height = pfrmIn.Height FormRecord(MaxForm).Width = pfrmIn.Width FormRecord(MaxForm).ScaleHeight = pfrmIn.ScaleHeight FormRecord(MaxForm).ScaleWidth = pfrmIn.ScaleWidth AddForm = MaxForm MaxForm = MaxForm + 1 For Each FormControl In pfrmIn i = FindControl(FormControl, pfrmIn.Name) If i < 0 Then i = AddControl(FormControl, pfrmIn.Name) End If Next FormControl End Function Function FindControl(inControl As Control, inName As String) As Long Dim i As Long FindControl = -1 For i = 0 To (MaxControl - 1) If ControlRecord(i).Parrent = inName Then If ControlRecord(i).Name = inControl.Name Then On Error Resume Next If ControlRecord(i).Index = inControl.Index Then FindControl = i Exit Function End If On Error GoTo 0 End If End If Next i End Function Function AddControl(inControl As Control, inName As String) As Long ReDim Preserve ControlRecord(MaxControl + 1) On Error Resume Next ControlRecord(MaxControl).Name = inControl.Name ControlRecord(MaxControl).Index = inControl.Index ControlRecord(MaxControl).Parrent = inName If TypeOf inControl Is Line Then ControlRecord(MaxControl).Top = inControl.Y1 ControlRecord(MaxControl).Left = ActualPos(inControl.X1) ControlRecord(MaxControl).Height = inControl.Y2 ControlRecord(MaxControl).Width = ActualPos(inControl.X2) Else ControlRecord(MaxControl).Top = inControl.Top ControlRecord(MaxControl).Left = ActualPos(inControl.Left) ControlRecord(MaxControl).Height = inControl.Height ControlRecord(MaxControl).Width = inControl.Width End If inControl.IntegralHeight = False On Error GoTo 0 AddControl = MaxControl MaxControl = MaxControl + 1 End Function Function PerWidth(pfrmIn As Form) As Long Dim i As Long i = FindForm(pfrmIn) If i < 0 Then i = AddForm(pfrmIn) End If PerWidth = (pfrmIn.ScaleWidth * 100) \ FormRecord(i).ScaleWidth End Function Function PerHeight(pfrmIn As Form) As Double Dim i As Long i = FindForm(pfrmIn) If i < 0 Then i = AddForm(pfrmIn) End If PerHeight = (pfrmIn.ScaleHeight * 100) \ FormRecord(i).ScaleHeight End Function Public Sub ResizeControl(inControl As Control, pfrmIn As Form) On Error Resume Next Dim i As Long Dim widthfactor As Single, heightfactor As Single Dim minFactor As Single Dim yRatio, xRatio, lTop, lLeft, lWidth, lHeight As Long yRatio = PerHeight(pfrmIn) xRatio = PerWidth(pfrmIn) i = FindControl(inControl, pfrmIn.Name) If inControl.Left < 0 Then lLeft = CLng(((ControlRecord(i).Left * xRatio) \ 100) - 75000) Else lLeft = CLng((ControlRecord(i).Left * xRatio) \ 100) End If lTop = CLng((ControlRecord(i).Top * yRatio) \ 100) lWidth = CLng((ControlRecord(i).Width * xRatio) \ 100) lHeight = CLng((ControlRecord(i).Height * yRatio) \ 100) If TypeOf inControl Is Line Then If inControl.X1 < 0 Then inControl.X1 = CLng(((ControlRecord(i).Left * xRatio) \ 100) - 75000) Else inControl.X1 = CLng((ControlRecord(i).Left * xRatio) \ 100) End If inControl.Y1 = CLng((ControlRecord(i).Top * yRatio) \ 100) If inControl.X2 < 0 Then inControl.X2 = CLng(((ControlRecord(i).Width * xRatio) \ 100) - 75000) Else inControl.X2 = CLng((ControlRecord(i).Width * xRatio) \ 100) End If inControl.Y2 = CLng((ControlRecord(i).Height * yRatio) \ 100) Else inControl.Move lLeft, lTop, lWidth, lHeight inControl.Move lLeft, lTop, lWidth inControl.Move lLeft, lTop End If End Sub Public Sub ResizeForm(pfrmIn As Form) Dim FormControl As Control Dim isVisible As Boolean Dim StartX, StartY, MaxX, MaxY As Long Dim bNew As Boolean If Not bRunning Then bRunning = True If FindForm(pfrmIn) < 0 Then bNew = True Else bNew = False End If If pfrmIn.Top < 30000 Then isVisible = pfrmIn.Visible On Error Resume Next If Not pfrmIn.MDIChild Then On Error GoTo 0 ' ' pfrmIn.Visible = False Else If bNew Then StartY = pfrmIn.Height StartX = pfrmIn.Width On Error Resume Next For Each FormControl In pfrmIn If FormControl.Left + FormControl.Width + 200 > MaxX Then MaxX = FormControl.Left + FormControl.Width + 200 End If If FormControl.Top + FormControl.Height + 500 > MaxY Then MaxY = FormControl.Top + FormControl.Height + 500 End If If FormControl.X1 + 200 > MaxX Then MaxX = FormControl.X1 + 200 End If If FormControl.Y1 + 500 > MaxY Then MaxY = FormControl.Y1 + 500 End If If FormControl.X2 + 200 > MaxX Then MaxX = FormControl.X2 + 200 End If If FormControl.Y2 + 500 > MaxY Then MaxY = FormControl.Y2 + 500 End If Next FormControl On Error GoTo 0 pfrmIn.Height = MaxY pfrmIn.Width = MaxX End If On Error GoTo 0 End If For Each FormControl In pfrmIn ResizeControl FormControl, pfrmIn Next FormControl On Error Resume Next If Not pfrmIn.MDIChild Then On Error GoTo 0 pfrmIn.Visible = isVisible Else If bNew Then pfrmIn.Height = StartY pfrmIn.Width = StartX For Each FormControl In pfrmIn ResizeControl FormControl, pfrmIn Next FormControl End If End If On Error GoTo 0 End If bRunning = False End If End Sub Public Sub SaveFormPosition(pfrmIn As Form) Dim i As Long If MaxForm > 0 Then For i = 0 To (MaxForm - 1) If FormRecord(i).Name = pfrmIn.Name Then FormRecord(i).Top = pfrmIn.Top FormRecord(i).Left = pfrmIn.Left FormRecord(i).Height = pfrmIn.Height FormRecord(i).Width = pfrmIn.Width Exit Sub End If Next i AddForm (pfrmIn) End If End Sub Public Sub RestoreFormPosition(pfrmIn As Form) Dim i As Long If MaxForm > 0 Then For i = 0 To (MaxForm - 1) If FormRecord(i).Name = pfrmIn.Name Then If FormRecord(i).Top < 0 Then pfrmIn.WindowState = 2 ElseIf FormRecord(i).Top < 30000 Then pfrmIn.WindowState = 0 pfrmIn.Move FormRecord(i).Left, FormRecord(i).Top, FormRecord(i).Width, FormRecord(i).Height Else pfrmIn.WindowState = 1 End If Exit Sub End If Next i End If End Sub Public Sub Resize_ALL(Form_Name As Form) Dim OBJ As Object For Each OBJ In Form_Name ResizeControl OBJ, Form_Name Next OBJ End Sub Public Sub DragForm(frm As Form) On Local Error Resume Next Call ReleaseCapture Call SendMessage(frm.hwnd, WM_NCLBUTTONDOWN, 2, 0) End Sub
窗体控件大小随窗体大小变化而变化
09-09
VB窗体控件大小随窗体大小变化而变化的程序
VB6中控件窗体大小自动变化
09-09
VB6中控件窗体大小自动变化 非常好用
Visual Basic 6 Resizer VB6控件动态位置大小调整
03-07
比如你的窗体中有一个DBGrid控件,占了很大一部分,下边有几个按钮 现在需要窗体的大小可调,以使DBGrid可以看到更多的数据,这样的话,窗体上的控件就都需要调整,不然只有窗体变化,而控件不动的话就达不到预期效果,而且...
VB自动调整窗口 控件按比例缩放代码
12-22
VB程序窗口调整 控件按比例缩放代码,非常有用,让程序最大化后不那么难看了
VB.NET 控件随窗体缩放，亲测有效
weixin_45318790的博客
01-06 1561
总算完成了VB.NET格式的代码，亲测有效，直接复制可用；有问题的点都在注释里~
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

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

抵扣说明：

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

余额充值