调用:Private Sub Form_Load()
Call ResizeInit(Me)
End subPrivate Sub Form_Resize()
Call ResizeForm(Me)
End subAutoRsize Module:Option Explicit
'定义 FormOldWidth, FormOldHeight 为全局变量,这样其他模块才能调用它
Global FormOldWidth, FormOldHeight'在调用ResizeForm前先调用本函数
Public Sub ResizeInit(FormName As Form)
'Control是一个对象,表示所有 Visual Basic 内部控件的类名。
'可以将一个变量标为 Control 对象,象引把控件放到窗体上的一样来引用它。例如:
'Dim C As Control
'Set C = Command1
Dim Obj As Control
FormOldWidth = FormName.ScaleWidth
FormOldHeight = FormName.ScaleHeight
On Error Resume Next
'Each是一个关键字,作用是针对一个数组或集合中的每个元素,重复执行一组语句。
'语法
'For Each element In Group
For Each Obj In FormName
'Tag返回或设置一个表达式用来存储程序中需要的额外数据。
Obj.Tag = Obj.Left & " " & Obj.Top & " " & Obj.Width & " " & Obj.Height & " "
Next Obj
On Error GoTo 0End 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 / FormOldWidth
'保存窗体高度缩放比例
ScaleY = FormName.ScaleHeight / FormOldHeight
On Error Resume Next
For Each Obj In FormName
StartPos = 1
'读取控件的原始位置与大小
For i = 0 To 4
'InStr函数,返回 Variant (Long),指定一字符串在另一字符串中最先出现的位置。语法:InStr([start, ]string1, string2[, compare])
TempPos = InStr(StartPos, Obj.Tag, " ", vbTextCompare)
If TempPos > 0 Then
'Mid函数,返回Variant (String),其中包含字符串中指定数量的字符。语法:Mid(string, start[, length])
Pos(i) = Mid(Obj.Tag, StartPos, TempPos - StartPos)
StartPos = TempPos + 1
Else
Pos(i) = 0
End If
'根据控件的原始位置及窗体改变大小的比例对控件重新定位与改变大小
'Move方法,用以移动 MDIForm、Form 或控件。语法:object.Move Left, Top, Width, Height
Obj.Move Pos(0) * ScaleX, Pos(1) * ScaleY, Pos(2) * ScaleX, Pos(3) * ScaleY
Next i
Next Obj
On Error GoTo 0End Sub
Call ResizeInit(Me)
End subPrivate Sub Form_Resize()
Call ResizeForm(Me)
End subAutoRsize Module:Option Explicit
'定义 FormOldWidth, FormOldHeight 为全局变量,这样其他模块才能调用它
Global FormOldWidth, FormOldHeight'在调用ResizeForm前先调用本函数
Public Sub ResizeInit(FormName As Form)
'Control是一个对象,表示所有 Visual Basic 内部控件的类名。
'可以将一个变量标为 Control 对象,象引把控件放到窗体上的一样来引用它。例如:
'Dim C As Control
'Set C = Command1
Dim Obj As Control
FormOldWidth = FormName.ScaleWidth
FormOldHeight = FormName.ScaleHeight
On Error Resume Next
'Each是一个关键字,作用是针对一个数组或集合中的每个元素,重复执行一组语句。
'语法
'For Each element In Group
For Each Obj In FormName
'Tag返回或设置一个表达式用来存储程序中需要的额外数据。
Obj.Tag = Obj.Left & " " & Obj.Top & " " & Obj.Width & " " & Obj.Height & " "
Next Obj
On Error GoTo 0End 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 / FormOldWidth
'保存窗体高度缩放比例
ScaleY = FormName.ScaleHeight / FormOldHeight
On Error Resume Next
For Each Obj In FormName
StartPos = 1
'读取控件的原始位置与大小
For i = 0 To 4
'InStr函数,返回 Variant (Long),指定一字符串在另一字符串中最先出现的位置。语法:InStr([start, ]string1, string2[, compare])
TempPos = InStr(StartPos, Obj.Tag, " ", vbTextCompare)
If TempPos > 0 Then
'Mid函数,返回Variant (String),其中包含字符串中指定数量的字符。语法:Mid(string, start[, length])
Pos(i) = Mid(Obj.Tag, StartPos, TempPos - StartPos)
StartPos = TempPos + 1
Else
Pos(i) = 0
End If
'根据控件的原始位置及窗体改变大小的比例对控件重新定位与改变大小
'Move方法,用以移动 MDIForm、Form 或控件。语法:object.Move Left, Top, Width, Height
Obj.Move Pos(0) * ScaleX, Pos(1) * ScaleY, Pos(2) * ScaleX, Pos(3) * ScaleY
Next i
Next Obj
On Error GoTo 0End Sub
http://www.codeclub.net/bbs/
真没想到,居然还是有人把它写出来了以前都是嫌烦才不写
你的代码我试过了,可以用. 谢谢!
不过窗体中的combox框代码中没有被起到作用. 另外SSTAB控件也只能对它显示的一页发生作用,其它的页就没有显示了.
还请继续解决啊!
分不够我再加.
http://vbboshi.myrice.com/vbtech/activex/page_1/file1.htm
有很多地方!
---- ScaleMode属性决定了表单的ScaleHeight、ScaleWidth、ScaleTop、ScaleLeft属性值和表单中控件的Height、Width、Top、Left属性值的度量单位(用户自定义、缇、点、像素、字符、英寸、毫米、厘米等)。一般使Scaletop和ScaleLeft等于零。ScaleHeight、ScaleWidth属性值表示以ScaleMode值为度量单位的表单的高和宽,它们的改变不会使表单的大小和位置发生变化。改变ScaleMode的值不会影响表单和表单中控件的位置和大小,只是表单的ScaleHeight、ScaleWidth属性值和表单中控件的Height、Width、Top、Left属性值要根据新的度量单位自动发生变化。由于表单的大小、表单中控件的位置和大小已经设定,除了"用户自定义"度量单位外,表单的ScaleHeight、ScaleWidth、ScaleTop、ScaleLeft属性值是一定的。只要手工改变表单的ScaleHeight、ScaleWidth、ScaleTop、ScaleLeft任一属性值,ScaleMode的值就变成了"用户自定义"。
---- 用户自定义ScaleHeight值表示将表单的高度等分了ScaleHeight等份,表单中控件的Height属性值是以表单高度等分了ScaleHeight等份的一份为单位。用户自定义ScaleWidth值表示将表单的宽度等分了ScaleWidth等份,表单中控件的Width属性值是以表单宽度等分了ScaleWidth等份的一份为单位。 ---- 例如:有一个表单form1,form1中有一个控件Cammand1,Cammand1的位置和大小已经设计好 form1.ScaleMode=user
form1.Height=6800
form1.ScaleHeight=1000
这时Cammand1.Height的值是以6800/1000=6.8为单位的,
即为表单高度的千分之六点八为单位。 记下表单中每一个希望与表单大小变化而成比例变化的控件的Height、Width、Top、Left值。 用鼠标双击表单没有控件的地方,点出编程界面右上方的表单过程名表,选择Form_Resize过程,在Form_Resize过程编程如下:
Private Sub Form_Resize()
ScaleHeight = 1000
ScaleWidth = 1000
表单中控件名1.top=步骤3记下的值
表单中控件名1.Width=步骤3记下的值
表单中控件名1.Left=步骤3记下的值
表单中控件名2.Height=步骤3记下的值
表单中控件名2.top=步骤3记下的值
表单中控件名2.Width=步骤3记下的值
表单中控件名2.Left=步骤3记下的值
表单中控件名2.Height=步骤3记下的值
... ...
end sub
总之, 通过以上4步就可实现让控件大小和位置随着表单的大小变化而成比例变化,从而解决界面因表单大小的改变而变得不均匀的问题。
(ByVal hwnd As Long, lpPoint As- POINTAPI) As Long 获 得 鼠 标 的 屏 幕 坐 标 放 在lpPoint 中。
Declare Function GetCursorPos Lib "user32"
(lpPoint As POINTAPI) As Long 将 屏 幕 坐 标 转 化 成 客 户 区 坐 标 系 统 的 坐 标, 转 换 后 的 坐 标 仍 在lpPoint 中。
新 开 一 个 工 程, 在Form1 上 放 一 个TextBox 控 件, 命 名 为Text1。 在Form 的MouseMove 事 件 中 捕 获 鼠 标 坐 标, 如 果 鼠 标 的 位 置 与Text1 的 边 界 相 距 很 近( 比 如 说50 Twips,150 效 果 比 较 好), 根 据 需 要 将 Form1 的MousePointer 属 性 值 为vbSizeNS( 垂- 直 尺 寸 线), 或vbSizeWE( 水- 平 尺 寸 线), 或vbSizeNESW( 右 上- 左 下 尺 寸 线), 或vbSizeNWSE( 左 上- 右 下 尺 寸 线)。 用 户 一 看 就 知 道 可 以 改 变 该 控 件 的 尺 寸。 而 在 其 余 区 域 则 将Form1 的MousePointer 属 性 设 成 缺 省 值(vbDefault)。 当 用 户 按 下 鼠 标 键 并 拖 动 鼠 标 时 根 据 当 前 的MousePointer 进 行 判 断 该 如 何 改 变 控 件 的 大 小。 具 体 操 作 可 参 看 附 带 的 例 程。 第 二 中 方 法 不 需 要 调 用API 函 数, 但 需 要 额 外 的 控 件。 同 样 新 开 一 个 工 程, 在Form1 上 放 一 个TextBox 控 件, 命 名 为Text1。 然 后 紧 靠Text1 的 右 侧 放 一 个 高 度 与Text1 相 同 但 宽 度 尽 量 小 的PictureBox 控 件, 命 名 为Picture1。 宽 度 要 小 到 看 不 见 立 体 效 果。 将Picture1 的MousePointer 属 性 设 置 成9 (vbSizeWE) 。 Picture1 的MouseMove 事 件 如 下: Private Sub Text1_MouseMove(Button As Integer,
Shift As Integer, x As Single, y-As Single)
If Button< >1 Then Exit Sub
Picture1.Left=Picture1.Left+X
‘Move Picture
Text1.Width=Picture1.Left-Text1.Left
'Change TextBox's size
End Sub ---- 运 行 程 序, 将 鼠 标 移 到Text1 的 右 边 缘, 这 时 鼠 标 变 成 水- 平 尺 寸 线 的 样 式, 按 住 鼠 标 左 键 左 右 移 动 鼠 标, 你 会 看 到Text1 的 大 小 可 以 自 由 改 变。
---- 以 上 只 是 举 一 些 简 单 的 例 子 说 明 定 制 控 件 尺 寸 的 基 本 方 法, 起 到 抛 砖 引 玉 的 作 用, 读 者 可 以 根 据 需 要 增 强 相 应 的 功 能, 但 要 注 意 建 立 错 误 陷 阱 捕 获 错 误。 第 一 种 方 法 的 源 程 序: 'API Function declare Declare Function ScreenToClient Lib "user32"
(ByVal hwnd As Long, lpPoint _As POINTAPI) As Long
Declare Function GetCursorPos Lib "user32"
(lpPoint As POINTAPI) As Long Type POINTAPI
x As Long
y As Long
End Type Private Sub Form_MouseMove(Button As Integer,
Shift As Integer, x As Single, - y As Single)
Dim Pnt As POINTAPI
Dim CurX As Long
Dim CurY As Long
Dim DistX As Long
Dim DistY As Long Const mDist = 150 '150 twips GetCursorPos Pnt
'Get mouse position
ScreenToClient Me.hwnd, Pnt
'Convert to client coordinate
CurX = Pnt.x * Screen.TwipsPerPixelX
'Pixels to Twips
CurY = Pnt.y * Screen.TwipsPerPixelY
DistX = Abs(CurX - (Text1.Left + Text1.Width))
'distance to text1's
DistY = Abs(CurY - (Text1.Top + Text1.Height)) If DistX < = mDist And DistY < = mDist Then
'set mouse pointer
'according to distance
Form1.MousePointer = vbSizeNWSE
ElseIf DistX < = mDist And DistY > mDist Then
Form1.MousePointer = vbSizeWE
ElseIf DistX > mDist And DistY < = mDist Then
Form1.MousePointer = vbSizeNS
Else
Form1.MousePointer = vbDefault
End If If Button < > 1 Then Exit Sub
If Form1.MousePointer = vbSizeNWSE Then
'change text1' size
Text1.Width = CurX - Text1.Left
Text1.Height = CurY - Text1.Top
End If
If Form1.MousePointer = vbSizeWE Then
Text1.Width = CurX - Text1.Left
End If
If Form1.MousePointer = vbSizeNS Then
Text1.Height = CurY - Text1.Top
End If
End Sub Private Sub Text1_MouseMove(Button As Integer,
Shift As Integer, x As -Single, y As Single)
Form1.MousePointer = vbDefault
'set default mouse pointer
End Sub