大家给看看这段代码！

2003-05-07 11:03:29 114 阅读 AI 写同款 · GEO 优化AI 选题数据监测一键分发 ›

RK3588 EVB开发板原理图讲解【六】该原理图展示了eMMC Flash与主控芯片之间的连接关系，以及相关的电源、信号线路和去耦电容等。阅读详情

我的以下这段代码为实现窗体控件随窗体的变化而按比例变化，
为什么只有在最大化是可以实现，
其它变化时却达不到效果？

private Sub Form_Load()

fh1 = Form1.Height
fw1 = Form1.Width

End Sub

Private Sub Form_Resize()
Dim scalex, scaley As Integer
Dim fw2, fh2 As Integer
Dim control As Variant

If Form1.WindowState = 1 Then Exit Sub

fw2 = Form1.Width
fh2 = Form1.Height

scalex = fw2 / fw1
scaley = fh2 / fh1

For Each control In Form1.Controls

If (Val(fh2) < fh1) Or (Val(fh2) > fh1) Then

control.Height = control.Height * scaley

control.Top = control.Top * scaley

End If

If (Val(fw2) < fw1) Or (Val(fw2) > fw1) Then

control.Width = control.Width * scalex

control.Left = control.Left * scalex

End If

Next control

fw1 = Form1.Width
fh1 = Form1.Height

End Sub

...全文

Information Fusion投稿避坑指南：从初稿到返修的完整流程解析（附模板下载）本文详细解析了向Information Fusion投稿的全流程，从初稿准备到返修策略，涵盖了22个关键细节。特别强调了投稿前的隐形门槛、LaTeX模板的字体陷阱、图表规范要求以及返修回复的进阶技巧，帮助研究者避免常见错误，提升稿件接受率。附有实用模板下载，助力学术写作效率提升。阅读详情

guowj

VB基础类 7,788 成员 197,583 内容

+ 关注 + 加入社区

切换为时间正序

qingming81 2003-05-07

打赏
举报

另外，你的原代码中的
Dim scalex, scaley As Integer
有问题，应改用其它名称的变量，且应定义为long型，如下：
dim ssx as long,ssy as long

qingming81 2003-05-07

打赏
举报

http://expert.csdn.net/Expert/topic/1710/1710828.xml?temp=.2830927
其中freehorse_1981() 的代码可看，如下：
'保存窗体的原始宽度
Private FormOldWidth As Long
'保存窗体的原始高度
Private FormOldHeight As Long

'在调用ResizeForm前先调用本函数
Public Sub ResizeInit(FormName As Form)
Dim Obj As Control
FormOldWidth = FormName.ScaleWidth
FormOldHeight = FormName.ScaleHeight
On Error Resume Next
'保存
For Each Obj In FormName
Obj.Tag = Obj.Left & " " & Obj.Top & " " & Obj.Width & " " & Obj.Height & " "
Next Obj
End Sub

'按比例改变表单内各元件的大小，
Public Sub ResizeForm(FormName As Form)
Dim Pos(3) 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 / FormOldWidth
'保存窗体高度缩放比例
ScaleY = FormName.ScaleHeight / FormOldHeight
On Error Resume Next
For Each Obj In FormName
StartPos = 1
For I = 0 To 3
'读取控件的原始位置与大小
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
Next I
Next Obj
End Sub

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

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

道素 2003-05-07

打赏
举报

明白了你的意思，你可能没有刷新
这是我的代码（写成控件）：

Option Explicit

' if True, also fonts are resized
Public ResizeFont As Boolean
' if True, form's height/width ratio is preserved
Public KeepRatio As Boolean

Private Type TControlInfo
ctrl As Control
Left As Single
Top As Single
Width As Single
Height As Single
FontSize As Single
FontName As String
End Type

' this array holds the original position
' and size of all controls on parent form
Dim Controls() As TControlInfo

' a reference to the parent form
Private WithEvents ParentForm As Form
' parent form's size at load time
Private ParentWidth As Single
Private ParentHeight As Single
' ratio of original height/width
Private HeightWidthRatio As Single

Private Sub ParentForm_Load()
' the ParentWidth variable works as a flag
ParentWidth = 0
' save original ratio
HeightWidthRatio = ParentForm.Height / ParentForm.Width
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
If Ambient.UserMode = False Then Exit Sub
' store a reference to the parent form and
' start receiving events
Set ParentForm = Parent
End Sub

Private Sub UserControl_Resize()
' refuse to resize
Image1.Move 0, 0
UserControl.Width = Image1.Width
UserControl.Height = Image1.Height
End Sub

' trap the parent form's Resize event
' this include the very first resize event
' that occurs soon after form's load

Private Sub ParentForm_Resize()
If ParentWidth = 0 Then
Rebuild
Else
Refresh
End If
End Sub

' save size and position of all controls on parent form
' you should manually invoke this method each time you add a new control
' to the form (through Load method of a control array)

Sub Rebuild()
' rebuild the internal table
Dim i As Integer, ctrl As Control
' this is necessary for controls that don't support
' all properties (e.g. Timer controls)
On Error Resume Next

If Ambient.UserMode = False Then Exit Sub

' save a reference to the parent form, and its initial size
Set ParentForm = UserControl.Parent
ParentWidth = ParentForm.ScaleWidth
ParentHeight = ParentForm.ScaleHeight

' read the position of all controls on the parent form
ReDim Controls(ParentForm.Controls.Count - 1) As TControlInfo

For i = 0 To ParentForm.Controls.Count - 1
Set ctrl = ParentForm.Controls(i)
With Controls(i)
Set .ctrl = ctrl
.Left = ctrl.Left
.Top = ctrl.Top
.Width = ctrl.Width
.Height = ctrl.Height
.FontSize = ctrl.Font.Size
.FontName = ctrl.Font.Name
End With
Next
End Sub

' update size and position of controls on parent form

Sub Refresh()
Dim i As Integer, ctrl As Control
Dim widthFactor As Single, heightFactor As Single
Dim minFactor As Single

' inhibits recursive calls if KeepRatio = True
Static executing As Boolean
If executing Then Exit Sub

If Ambient.UserMode = False Then Exit Sub

If KeepRatio Then
executing = True
' we must keep original ratio
If ParentForm.WindowState = vbNormal Then
ParentForm.Height = HeightWidthRatio * ParentForm.Width
End If
executing = False
End If

' this is necessary for controls that don't support
' all properties (e.g. Timer controls)
On Error Resume Next

widthFactor = ParentForm.ScaleWidth / ParentWidth
heightFactor = ParentForm.ScaleHeight / ParentHeight
' take the lesser of the two
If widthFactor < heightFactor Then
minFactor = widthFactor
Else
minFactor = heightFactor
End If

' this is a regular resize
For i = 0 To UBound(Controls)
With Controls(i)
' the change of font must occur *before* the resizing
' to account for companion scrollbar of listbox
' and other similar controls
If ResizeFont Then
'.ctrl.Font.Size = .FontSize * minFactor
If (.FontSize * minFactor) < 8 Then
.ctrl.Font.Name = "Small Fonts"
If (.FontSize * minFactor) > 7 Then
.ctrl.Font.Size = 7
Else
.ctrl.Font.Size = .FontSize * minFactor
End If
ElseIf .ctrl.Font.Name <> .FontName Then
.ctrl.Font.Name = .FontName
.ctrl.Font.Size = .FontSize * minFactor
Else
.ctrl.Font.Size = .FontSize * minFactor
End If
End If
' move and resize the controls - we can't use a Move
' method because some controls do not support the change
' of all the four properties (e.g. Height with comboboxes)
If .ctrl.Left < 0 Then
.ctrl.Left = ((.ctrl.Left + 75000) * widthFactor) - 75000
ElseIf .Left < 0 Then
.ctrl.Left = (.Left + 75000) * widthFactor
Else
.ctrl.Left = .Left * widthFactor
End If
.ctrl.Top = .Top * heightFactor
.ctrl.Width = .Width * widthFactor
.ctrl.Height = .Height * heightFactor
End With
Next

End Sub

IwantFlay 2003-05-07

打赏
举报

If Form1.WindowState = 1 Then Exit Sub
把这一句去掉.

另外想说一句.
vb中这样调整大小并不是对所有控件都有用的. 比如说combobox

qingming81 2003-05-07

打赏
举报

在scalex = fw2 / fw1
scaley = fh2 / fh1
之后再加上下述代码看看：
fw1 = fw2
fh1 = fh2

饮水需思源 2003-05-07

打赏
举报

应该是private Sub Form_Resize事件吧

大家给看看这段代码！

相关推荐