玩酷之家

 找回密码
 立即注册
查看: 3560|回复: 1

控件随窗体高宽度变化

[复制链接]

98

主题

103

帖子

426

积分

中级会员

Rank: 3Rank: 3

积分
426
发表于 2017-10-5 19:02:00 | 显示全部楼层 |阅读模式

随便画几个代码,就可以看到效果了

  1. Option Explicit
  2. Dim FormOWidth As Long, FormOHeight As Long '窗体原始宽度,原始高度
  3. Private Sub ResizerInit(FormName As Form) '在调用ResizerForm前先调用本函数
  4. On Error Resume Next
  5. Dim Obj As Control
  6. FormOWidth = FormName.ScaleWidth
  7. FormOHeight = FormName.ScaleHeight
  8. For Each Obj In FormName
  9. Obj.Tag = Obj.Left & " " & Obj.Top & " " & Obj.Width & " " & Obj.Height & " "
  10. Next Obj
  11. End Sub
  12. Private Sub ResizerForm(FormName As Form) '按比例改变表单内各元件的大小,'在调用ResizerForm前先调用ResizerInit函数
  13. On Error Resume Next
  14. Dim Pos(4) As Double, i As Long, TempPos As Long, StartPos As Long, Obj As Control, ScaleX As Double, ScaleY As Double
  15. ScaleX = FormName.ScaleWidth / FormOWidth '保存窗体宽度缩放比例
  16. ScaleY = FormName.ScaleHeight / FormOHeight '保存窗体高度缩放比例
  17. For Each Obj In FormName
  18. StartPos = 1
  19. For i = 0 To 4
  20. TempPos = InStr(StartPos, Obj.Tag, " ", vbTextCompare) '读取控件的原始位置与大小
  21. If TempPos > 0 Then
  22. Pos(i) = Mid(Obj.Tag, StartPos, TempPos - StartPos)
  23. StartPos = TempPos + 1
  24. Else
  25. Pos(i) = 0
  26. End If
  27. Obj.Move Pos(0) * ScaleX, Pos(1) * ScaleY, Pos(2) * ScaleX, Pos(3) * ScaleY '根据控件的原始位置及窗体改变大小的比例对控件重新定位与改变大小
  28. Next i
  29. Next Obj
  30. End Sub
  31. Private Sub Form_Resize()
  32. If FormOWidth <> 0 And FormOHeight <> 0 Then Call ResizerForm(Me) '窗体改变时改变控件
  33. End Sub
  34. Private Sub Form_Load()
  35. Call ResizerInit(Me) '获取起始窗体控件尺寸
  36. End Sub
复制代码


最多选择要压缩的20张 PNG图像
回复

使用道具 举报

4

主题

20

帖子

157

积分

注册会员

Rank: 2

积分
157
QQ
发表于 2019-3-20 18:49:09 | 显示全部楼层
拿走啦。
细嗅蔷薇。
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|Archiver|手机版|小黑屋|玩酷之家 ( 鄂ICP备14012049号-1 )|

GMT+8, 2020-8-4 16:41 , Processed in 1.076402 second(s), 19 queries .

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表