'-------------------------------------- ' 自 动 改 变 控 件 大 小 '-------------------------------------- ' 洪恩在线 求知无限 '-------------------------------------- '本例实现一个控件大小随窗体大小改变而自动改变的文本编辑器 '------名称-------------作用------------ ' Form1 主窗体 ' CmdOpen 通用对话框 ' RichTextBox1 RichTextBox ' mnuNew “新建”菜单项 ' mnuOpen “打开”菜单项 ' mnuSave “保存”菜单项 ' mnuExit “退出”菜单项 ' mnuFont “字体”菜单项 ' mnuPrint “打印”菜单项 ' mnuFind “查找”菜单项 ' mnuNext “查找下一个”菜单项 '------变量-------------作用------------- ' sFind 待查找的字符串 '--------------------------------------- Option Explicit Private FormOldWidth As Long '保存窗体的原始宽度 Private FormOldHeight As Long '保存窗体的原始高度 Public sFind As String '在程序装入时必须加入 Private Sub Form_Load() Call ResizeInit(Me) End Sub '当“退出”菜单项被点击时 Private Sub mnuExit_Click() Unload Me End End Sub '当“查找”菜单项被点击时 Private Sub mnuFind_Click() 'InputBox("弹出的输入框的标题",[默认值], [返回的值]) '语法：InputBox(prompt[, title] [, default] [, xpos] [, ypos] [, helpfile, context]) sFind = InputBox("Find what?", , sFind) 'RichTextBox1.Find 是一个方法，根据给定的字符串，在 RichTextBox 控件中搜索文本 RichTextBox1.Find sFind End Sub '当“字体”菜单项被点击时 Private Sub mnuFont_Click() '显示“字体”对话框 '使用指定的方法，CommonDialog 控件能够显示下列对话。 '---------------------------------------- '方法 所显示的对话框 '---------------------------------------- 'ShowOpen 显示“打开”对话框 'ShowSave 显示“另存为”对话框 'ShowColor 显示“颜色”对话框 'ShowFont 显示“字体”对话框 'ShowPrinter 显示“打印”或“打印选项”对话框 'ShowHelp 调用 Windows 帮助引擎 '---------------------------------------- CmdOpen.Flags = cdlCFBoth + cdlCFEffects CmdOpen.ShowFont '将RichTextBox1的属性根据“字体”对话框的变化作相应设置 '---------------------------------------- '要改变 RichTextBox 控件中的字体特性，可以使用 'SelFontName、SelFontSize 和 SelFontColor 属性。 '---------------------------------------- With RichTextBox1 .SelFontName = CmdOpen.FontName .SelFontSize = CmdOpen.FontSize .SelBold = CmdOpen.FontBold .SelItalic = CmdOpen.FontItalic .SelStrikeThru = CmdOpen.FontStrikethru .SelUnderline = CmdOpen.FontUnderline End With End Sub '当“新建”菜单项被点击时，设置为空 Private Sub mnuNew_Click() RichTextBox1.Text = "" End Sub '当“查找下一个”菜单项被点击时 Private Sub mnuNext_Click() 'SelStart属性－返回或设置所选择的文本的起始点；如果没有文本被选中，则指出插入点的位置。 RichTextBox1.SelStart = RichTextBox1.SelStart + RichTextBox1.SelLength + 1 'object.Find(string, start, end, options) '------------------------------------------ 'Find 方法的语法包含下面部分: '部分 描述 '----------------------------------------- 'object 必需的。对象表达式，其值是“应用于”列表中的一个对象。 'string 必需的。要在控件中查找的字符串表达式。 'start 可选的。决定从哪儿开始搜索的整数字符索引。控件中的每一个字符都有一个可唯一标识的整数索引。控件中文本的第一个字符的索引是 0。 'end 可选的。决定在哪儿结束搜索的整数字符索引。 'options 可选的。用来指定一个或多个可选功能常数的和。所指定的功能如“设置值”中所述。 '----------------------------------------- RichTextBox1.Find sFind, , Len(RichTextBox1) End Sub '当“打开”菜单项被点击时 Private Sub mnuOpen_Click() '参看上面CommonDialog方法 CmdOpen.ShowOpen 'RichTextBox的LoadFile方法 RichTextBox1.LoadFile (CmdOpen.FileName) End Sub '当“打印”菜单项被点击时 Private Sub mnuPrint_Click() CmdOpen.Flags = cdlPDReturnDC + cdlPDNoPageNums If RichTextBox1.SelLength = 0 Then CmdOpen.Flags = CmdOpen.Flags + cdlPDAllPages Else CmdOpen.Flags = CmdOpen.Flags + cdlPDSelection End If '参看上面CommonDialog方法 CmdOpen.ShowPrinter '将 RichTextBox 控件中格式化文本发送给设备进行打印。 '语法 'object.SelPrint (hDC) 'SelPrint 方法的语法包含下面部分: '部分 描述 '----------------------------------------------- 'object 对象表达式，其值是“应用于”列表中的一个对象。 'hdc 设备描述体，是准备用来打印控件内容的设备。 '----------------------------------------------- RichTextBox1.SelPrint CmdOpen.hDC End Sub '当“保存”菜单项被点击时 Private Sub mnuSave_Click() CmdOpen.ShowSave 'RichTextBox的SaveFile方法，保存文本 RichTextBox1.SaveFile (CmdOpen.FileName) End Sub '确保窗体改变时控件随之改变 Private Sub Form_Resize() Call ResizeForm(Me) End Sub '以下为模块中的代码： '--------------------引自------------------- '一 劳 永 逸 让VB 自 动 改 变 控 件 大 小 '深 圳 市 东 门 茂 业 百 货11 楼 '邓 勇 '------------------------------------------- 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 0 End 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 0 End Sub

　　先来看看与控件和对象的大小、位置相关的几个属性，已经列表如下：

　　程序实现的基本思路是在窗体大小改变前取得窗体的ScaleWidth、ScaleHeight以及窗体内各个控件的Left、Top、Width、Height属性，并把它们保存起来。当窗体的大小被改变时，用窗体的新ScaleWidth、ScaleHeight与改变前的值相比，得到一个缩放比例，然后把这个比例与控件的Left、Top、Width、Height属性的乘积作为新的控件位置和大小，重画这些控件。下面是实现的步骤：

　　　1、得到原有窗体ScaleWidth、ScaleHeight属性：
　　　FormOldWidth = FormName.ScaleWidth
　　　FormOldHeight = FormName.ScaleHeight
　　　2、取得各个控件的Left、Top、Width、Height属性并把它们存放在控件的Tag属性中：
　　　Dim Obj As Control　　　'Control是一个对象，表示所有 Visual Basic 内部控件的类名
　　　For Each Obj In FormName
　　　'Tag返回或设置一个表达式用来存储程序中需要的额外数据。
　　　Obj.Tag = Obj.Left & " " & Obj.Top & " " & Obj.Width & " " & Obj.Height & " "
　　　Next Obj
　　　3、当窗体大小改变时计算缩放比例：
　　　'保存窗体宽度缩放比例
　　　ScaleX = FormName.ScaleWidth / FormOldWidth
　　　'保存窗体高度缩放比例
　　　ScaleY = FormName.ScaleHeight / FormOldHeight
　　　4、读取控件的原始位置与大小，并根据缩放比例重新安置控件：
　　　For Each Obj In FormName StartPos = 1
　　　　For i = 0 To 4
　　　　　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

　　好了这样我们就不必担心窗体内的控件大小位置不成比例了，由于程序可以自动改变所有控件的大小，只要是窗体内的控件，大小都随之而变化，可谓“一劳永逸”的好办法。