'--------------------------------------'           自 动 改 变 控 件 大 小'--------------------------------------'            洪恩在线 求知无限'--------------------------------------'本例实现一个控件大小随窗体大小改变而自动改变的文本编辑器'------名称-------------作用------------'       Form1           主窗体'       CmdOpen         通用对话框'       RichTextBox1    RichTextBox'       mnuNew          “新建”菜单项'       mnuOpen         “打开”菜单项'       mnuSave         “保存”菜单项'       mnuExit         “退出”菜单项'       mnuFont         “字体”菜单项'       mnuPrint        “打印”菜单项'       mnuFind         “查找”菜单项'       mnuNext         “查找下一个”菜单项'------变量-------------作用-------------'       sFind           待查找的字符串'---------------------------------------Option ExplicitPrivate 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 MeEndEnd Sub '当“查找”菜单项被点击时Private Sub mnuFind_Click()'InputBox("弹出的输入框的标题",[默认值], [返回的值])'语法：InputBox(prompt[, title] [, default] [, xpos] [, ypos] [, helpfile, context])sFind = InputBox("Find what?", , sFind)'RichTextBox1.Find 是一个方法，根据给定的字符串，在 RichTextBox 控件中搜索文本RichTextBox1.Find sFindEnd Sub '当“字体”菜单项被点击时Private Sub mnuFont_Click()'显示“字体”对话框'使用指定的方法，CommonDialog 控件能够显示下列对话。'----------------------------------------'方法         所显示的对话框'----------------------------------------'ShowOpen    显示“打开”对话框'ShowSave    显示“另存为”对话框'ShowColor   显示“颜色”对话框'ShowFont    显示“字体”对话框'ShowPrinter 显示“打印”或“打印选项”对话框'ShowHelp    调用 Windows 帮助引擎'----------------------------------------CmdOpen.Flags = cdlCFBoth + cdlCFEffectsCmdOpen.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.FontUnderlineEnd WithEnd 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 + cdlPDNoPageNumsIf RichTextBox1.SelLength = 0 Then    CmdOpen.Flags = CmdOpen.Flags + cdlPDAllPagesElse    CmdOpen.Flags = CmdOpen.Flags + cdlPDSelectionEnd If'参看上面CommonDialog方法CmdOpen.ShowPrinter'将 RichTextBox 控件中格式化文本发送给设备进行打印。'语法'object.SelPrint (hDC)'SelPrint 方法的语法包含下面部分:'部分         描述'-----------------------------------------------'object       对象表达式，其值是“应用于”列表中的一个对象。'hdc          设备描述体，是准备用来打印控件内容的设备。'-----------------------------------------------RichTextBox1.SelPrint CmdOpen.hDCEnd 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

评论