怎么让这段代码只改变位置 不改变image 大小??? 因为改了之后会失真Private 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 TypePrivate 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 LongFunction ActualPos(plLeft As Long) As Long If plLeft < 0 Then
ActualPos = plLeft + 75000 Else
ActualPos = plLeft
End IfEnd FunctionFunction 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 IfEnd 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 FormControlEnd FunctionFunction 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 FunctionFunction 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 FunctionFunction 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 FunctionFunction 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 FunctionPublic 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)
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 IfEnd SubPublic 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 IfEnd SubPublic 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 SubPublic 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 SubPublic Sub Resize_ALL(Form_Name As Form) Dim OBJ As Object
For Each OBJ In Form_Name
ResizeControl OBJ, Form_Name
Next OBJ
End SubPublic Sub DragForm(frm As Form) On Local Error Resume Next
Call ReleaseCapture
Call SendMessage(frm.hwnd, WM_NCLBUTTONDOWN, 2, 0)End Sub
======================================================================================Private Sub Form_Resize()
Dim H, i As Integer
On Error Resume Next
Resize_ALL Me 'Me是窗体名,Form1,Form2等等都可以End Sub 谢谢
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 TypePrivate 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 LongFunction ActualPos(plLeft As Long) As Long If plLeft < 0 Then
ActualPos = plLeft + 75000 Else
ActualPos = plLeft
End IfEnd FunctionFunction 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 IfEnd 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 FormControlEnd FunctionFunction 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 FunctionFunction 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 FunctionFunction 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 FunctionFunction 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 FunctionPublic 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)
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 IfEnd SubPublic 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 IfEnd SubPublic 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 SubPublic 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 SubPublic Sub Resize_ALL(Form_Name As Form) Dim OBJ As Object
For Each OBJ In Form_Name
ResizeControl OBJ, Form_Name
Next OBJ
End SubPublic Sub DragForm(frm As Form) On Local Error Resume Next
Call ReleaseCapture
Call SendMessage(frm.hwnd, WM_NCLBUTTONDOWN, 2, 0)End Sub
======================================================================================Private Sub Form_Resize()
Dim H, i As Integer
On Error Resume Next
Resize_ALL Me 'Me是窗体名,Form1,Form2等等都可以End Sub 谢谢
解决方案 »
- SetTimer 怎么用啊
- 如何关闭一个正在打开的excel文件,
- Wise Installation System Pro 9.02制作的软件安装程序在打包完成之后运行安装时出现以下错误提示[求助]
- 关于Package&Depolyment向导打包成安装程序的问提!!!!!
- 一个简单的问题不会!!!
- 一个程序需要验证,我截获了他send和recv两个包,怎样编程可以不用验证。用工具也可以
- 在此上下文中已被关闭或无效
- 我想把VB的 Split 函数Join函数封装DLL 给其TC用 请问如何写
- 如何动态创建组件
- uguess(uguess)如何移动到文件的末尾?
- 希望大家给个高见,谢谢了呀!
- 用binary方式逐个字节读取文件,咋末尾多出一个0字节?
这个?