- 1PS提示：因为图层已锁定，无法编辑图层的处理方法
- 2Adobe Illustrator CS5 序列号大全
- 3picacg苹果版怎么找不到|picacg ios版是不是下架了介绍
- 4ACDsee注册码免费分享（含ACDsee18、ACDsee10等版本）
- 5苹果iphone自动时间不准确的多种校正方法
- 6PDF浏览器能看3D文件吗？PDF浏览器看3D文件图文详细教程
- 7Potato(马铃薯聊天)怎么注册不了|Potato不能注册处理方法介绍
- 8Potato(土豆聊天)怎么换头像|Potato app更改头像方法介绍
- 9ipad版office如何激活? office365激活的图文说明教程
- 10最新的Adobe Illustrator CS4序列号大全
- 11Mac怎么通过设置VPN来登录youtube等国外网站
- 12qq邮件是否已读怎么看 QQ邮箱已经发出去的邮件怎么知道对方是否已经查看
[摘要]有时窗体变化后，如改变分辨率后控件大小却不能随之改变。手工代码调整实在麻烦，下面的模块实现自动查找窗体上控件并使其改变大小以适应窗体变化。在Form的Resize事件中调用函数Resize_All就能实现控件自动调整大小，如：Private Sub Form_Resize()Dim H, i As...
有时窗体变化后，如改变分辨率后控件大小却不能随之改变。手工代码调整实在麻烦，下面的模块实现自动查找窗体上控件并使其改变大小以适应窗体变化。在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
推荐资讯 总人气榜
最新教程 本月人气
- 1PHP 与 XML: 使用expat函数(一)
- 2VB6如何让程序开机就自动打开
- 3ADO 事件模型
- 4tomcat下中文的完全处理
- 5用PHP动态生成虚拟现实VRML页面
- 6顺序求出c(n,r)的排列组合
- 7tomcat设置技巧(转载)
- 8如何完成大小写完全匹配的查询
- 9其他技巧
- 10用delphi大局部导入某子目录下所有JPG图片文件到数据库
- 11我在使用C#中Treeview与解析XML遇到的问题
- 12ADO如何创建更改删除表
- 1联想黄金斗士s8预约图文说明教程(附联想s8预约网址)
- 2陌陌群聊如何@别人？陌陌群聊@别人方法_绿茶安卓网
- 33星s4手势感应如何用？3星Galaxy s4手势感应视频图文说明教程
- 4lumia920 Amber更新新增技巧演示视频
- 5用php写类似microsoft的挖地雷游戏
- 6我对XSL的理解
- 7用C#写vs插件中的一些Tip
- 8陌陌谁是卧底如何玩？陌陌谁是卧底玩法_绿茶安卓网
- 9vivo xshot设置如何？步步高vivo xshot设置参数
- 10nubia x6 mini设置如何？中兴nubia x6 mini设置参数
- 11nubia x6 mini价格多少钱？中兴nubia x6 mini价格
- 12nubia x6电信版什么时候上市？中兴nubia x6电信版上市时间
