我用下面的代码实现了控件随窗口缩放,但控件中的文字大小不知如何随控件一起缩放,这一步很关键,如果不能实现,在窗口缩放时控件中的文字就可能显示不全或显示位置不对!请各位楼主帮帮我,谢谢!
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
'If i < 4 Then
Obj.Move Pos(0) * ScaleX, Pos(1) * ScaleY, Pos(2) * ScaleX, Pos(3) * ScaleY
'Else
'Obj.Font = Obj.Font + Pos(4) * ScaleX
'end If
Next i
Next Obj
On Error GoTo 0
End Sub
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
'If i < 4 Then
Obj.Move Pos(0) * ScaleX, Pos(1) * ScaleY, Pos(2) * ScaleX, Pos(3) * ScaleY
'Else
'Obj.Font = Obj.Font + Pos(4) * ScaleX
'end If
Next i
Next Obj
On Error GoTo 0
End Sub
不过这么做需要一堆代码,不值得。
简化一下,换个方法吧,用个文字图片来做,利用IMAGE控件的自动缩放属性,想大则大想小则小。画面效果还可以美化好多。
最好是改变字体大小,Fontsize保存文字大小的单位是Point(磅)。
并不是所有字体都能支持任意大小的。
Obj.FontSize = Obj.FontSize * ScaleY
请问各位楼主能告诉我具体“修改文字大小”的代码吗?请讲解具体一些,我太笨了,谢谢!!!
--------------------------------------
倒!这里发生了喧宾夺主的哗变!回贴人成了楼主,发帖人已急得妙语连珠了???^_^回到问题:
combo、monthview不是不支持修改字体大小,而是不支持修改控件大小,combo可变宽,却不可变高,monthview两个都不能变,但修改字体大小,它们就会自动变大或变小。FontSize属性并非所有控件都有的,能修改字体的控件一般都有Font属性,但不一定会有FontSize属性,所以建议换用Font.Size属性来修改字体大小。提示:窗体可缩放的代码很常见,控件按比例在缩放窗体中重新布局很常见,但让控件甚至控件字体也跟着按比例缩放,的确少见!也许只有单一种类或少量控件,还好办。但若控件种类很多,要处理起来就很麻烦了,统一代码更难。要小心为了一种毫无必要或没有实用价值的功能而走入死胡同!附:ScaleX 与 ScaleY是VB的两个方法名,若不是出于重载的目的,自定义的名称不要与VB内部名称重名,否则会有很多麻烦,及莫名其妙的错误。另外,别人也容易产生误解,我就是看了半天,才弄明白,那东东竟是你自己的变量!!!
If Obj <> "cbo" And Obj <> "cbo1" And Obj <> "cbo2" And Obj <> "combobox" Then
Obj.Move Pos(0) * ScX, Pos(1) * ScY, Pos(2) * ScX, Pos(3) * ScY
Else
Obj.Move Pos(0) * ScX, Pos(1) * ScY, Pos(2) * ScX ‘我只设计调整combobox的宽度
End If
感谢你能再次指点,thanks!!
----------------
这句肯定会出错,而永远被错误忽略后,从而始终执行
Obj.Move Pos(0) * ScX, Pos(1) * ScY, Pos(2) * ScX, Pos(3) * ScY
这句!再被错误忽略!Obj是对象,不能与字符串进行比较,需用lcase$(obj.name)<>"cbo"之类语句才行当然,若仅为排除combobox类型控件,最好用
if TypeName(obj)<>"ComboBox" then
来判断
combobox 控件改变位置的问题解决了,但datagrid和mshflexgrid等表格控件中的字段宽度无法修改,比如我用下面的代码想修改datagrid控件中字段的宽度怎么不行:(好像根本没有执行一样!)
If Obj.Name = "datagrid" Then
For j = 0 To 8
Obj.Columns(j).Width = Obj.Columns(j).Width * ScX
Next j
End If
请你帮我指点,十分感谢!!!
If Obj.Name = "datagrid" Then
这句,你可在其下面一句设个断点,看看,可能根本没执行,datagrid是控件类名,你不会用它做控件名吧?可用TypeName取类名,另外要注意大小写,你既然比较的是小写字母,可用LCase$(obj.name),除直接比较外,还可用Like进行模糊比较。总之,你要明白,你比较的是什么?我发现你对控件属性的概念,极其混乱!你窗体中到底有多少datagrid和mshflexgrid控件?它们的名称分别都叫什么?
If Obj.Name = "dagd1" Then
For j = 0 To 8
Obj.Columns(j).Width = Obj.Columns(j).Width * ScX
Next j
End If
程序还是好像没有执行这段代码,不知为何?谢谢(小吉)帮我解答!
你对代码,毫无调试能力?这怎么编程呀!总不能全靠自己或别人瞎猜去分析吧!
If LCase$(Obj.Name) = "msfg" Or LCase$(Obj.Name) = "dagd1" Then
For j = 0 To 8
If LCase$(Obj.Name) = "msfg" Then
Obj.ColWidth(j) = Obj.colwidth(j) * ScX
Else
Obj.Columns(j).Width = obj.colwidth(j) * ScX
End If
Next j
End If
===》
Obj.Columns(j).Width = Obj.Columns(j).Width * ScX关于
Obj.ColWidth(j) = Obj.colwidth(j) * ScX
你用的是什么控件 MSHFlexGrid or MSFlexGrid?
这两个控件的ColWidth用法不一样,请参考一下MSDN,附:这样包容错误去调试是很低效的,一个很小的问题,都会耗费很多精力却找不到原因。你这里肯定存在很多错误,因On Error Resume Next而被忽略!所以,建议你调试时,临时注释掉On Error,通过查看错误,来分析一下代码不能正确执行的原因
这样,可能会让一大批错误浮出水面,也许大部分是可以忽略的,为了能迅速抓住主要错误,你要学会各种调试方法,如:在 For j = 0 To 8 这句前,加上一句 On Error GoTo 0 ,便可及时发现这段代码中的错误了。
If LCase$(Obj.Name) = "msfg" Or LCase$(Obj.Name) = "dagd1" Then
On Error GoTo 0
For j = 0 To 8
If LCase$(Obj.Name) = "msfg" Then
Obj.ColWidth(j) = Obj.ColWidth(j) * ScX
Else
Obj.Columns(j).Width = Obj.Columns(j).Width * ScX
End If
Next j
End If
Private Sub Form_Load()
msfg.AllowUserResizing = flexResizeColumns
Form4.msfg.Clear
Form4.msfg.Cols = 9
Form4.msfg.ColWidth(0) = Form4.msfg.Width / 6
Form4.msfg.ColWidth(1) = Form4.msfg.Width / 15
Form4.msfg.ColWidth(2) = Form4.msfg.Width / 9
Form4.msfg.ColWidth(3) = Form4.msfg.Width / 9
Form4.msfg.ColWidth(4) = Form4.msfg.Width / 9
Form4.msfg.ColWidth(5) = Form4.msfg.Width / 9
Form4.msfg.ColWidth(6) = Form4.msfg.Width / 9
Form4.msfg.ColWidth(7) = Form4.msfg.Width / 9
Form4.msfg.ColWidth(8) = Form4.msfg.Width / 9
Form4.msfg.ColAlignment = flexAlignLeftTop
Call ResizeInit(Me)
End Sub
但程序执行到Public Sub ResizeForm(FormName As Form)子程序中的
Obj.Move Pos(0) * ScaleX, Pos(1) * ScaleY, Pos(2) * ScaleX, Pos(3) * ScaleY
就提示“对象不支持该方法或属性!”原来在没有对mshflexgrid初始化定义colwidth的大小时就没有这错误提示,不知为何!!!请你指点,谢谢!
若是,这很正常,For Each Obj In FormName是遍历窗体中的全部控件,而控件并不是都有Move方法(如:菜单),所以肯定会报错,这也是为什么一定要有On Error Resume Next的原因。
注释掉On Error Resume Next,是为了让真正的错误暴露出来,有些可以忽略的正常错误,可不必管它!其实,你只需在出错时,在立即窗口输入Debug.Print Obj.Name,就可知,当前obj是什么控件了。这种调试的基本能力,你要学会。弄清每步都在干什么,你就不会有那么多问题了。为了减少调试中的麻烦,若你只想暴露处理MSHFlexGrid和datagrid控件时的错误,可用下面的结构:
If LCase$(Obj.Name) = "msfg" Then
On Error GoTo 0
For j = 0 To 8 '在这里设个断点,准备跟踪每个Obj.ColWidth(j)的值
.....
Next j
On Error Resume Next
End If
If LCase$(Obj.Name) = "dagd1" Then
On Error GoTo 0
For j = 0 To 8 '在这里设个断点,准备跟踪每个Obj.Columns(j).Width的值
.....
Next j
On Error Resume Next
End If建议MSHFlexGrid和datagrid控件分开处理,看得会更清楚些。
VB调试是很方便的,灵活使用Debug,监视、断点、单步等等手段,很多东西根本就不用问人!你的窗体中控件可能很多,互相干挠现象严重,分段调试(每次注释掉所有与当前测试控件无关的代码),可考虑选用。
Public Sub ResizeForm(FormName As Form, b As Integer)
Dim Pos(4) As Double
Dim i As Long, TempPos As Long, StartPos As Long
Dim Obj As Control
Dim ScX As Double, ScY As Double
Dim j As Integer
'保存窗体宽度缩放比例
ScX = FormName.ScaleWidth / FormOldWidth
'保存窗体高度缩放比例
ScY = 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
On Error Resume Next
If LCase$(Obj.Name) <> "cbo" And LCase$(Obj.Name) <> "cbo1" And LCase$(Obj.Name) <> "cbo2" Then
Obj.Move Pos(0) * ScX, Pos(1) * ScY, Pos(2) * ScX, Pos(3) * ScY
Else
Obj.Move Pos(0) * ScX, Pos(1) * ScY, Pos(2) * ScX
End If
Next i
If LCase$(Obj.Name) = "dagd1" Then
On Error GoTo 0
For j = 0 To 8
Obj.Columns(j).Width = Obj.Columns(j).Width * (ScX - 0.05)
Next j
On Error Resume Next
End If
If LCase$(Obj.Name) = "msfg" Then
On Error GoTo 0
For j = 0 To 8
If j = 0 Then
Obj.ColWidth(0) = Obj.ColWidth(0) * (ScX - 0.3)
Else
Obj.ColWidth(j) = Obj.ColWidth(j) * ScX
End If
On Error Resume Next
Next j
End If
If b = 1 Then
Obj.Font.Size = Obj.Font.Size * ScX
If Obj.Name = "dagd1" Then
Obj.HeadFont.Size = Obj.HeadFont.Size * ScX
End If
If Obj.Name = "msfg" Then
Obj.HeadFont.Size = Obj.HeadFont.Size * ScX
End If
End If
Next Obj
On Error GoTo 0
End Sub
对程序流程做到心中有数是编程的根本,有很多东西应在循环外,你却放到循环内,
For i=...这个循环好象是Tag中的信息为控件定位,这应该是取完四个值后(循环外),才去定位,而你却把Move方法放到这个循环中,我的天,幸好如今电脑的速度快,不然....我知道,很多东西现在说了,你可能一时根本无法吃透,我还是试试改改你的代码吧!稍等
Dim Pos() As String
Dim Obj As Control
Dim ScX As Single, ScY As Single
Dim j As Integer
ScX = FormName.ScaleWidth / FormOldWidth
ScY = FormName.ScaleHeight / FormOldHeight
On Error Resume Next
For Each Obj In FormName.Controls
With Obj
Pos = Split(.Tag, " ")
Pos(0) = Pos(0) * ScX
Pos(1) = Pos(1) * ScY
Pos(2) = Pos(2) * ScX
Pos(3) = Pos(3) * ScY
If LCase$(TypeName(Obj)) <> "combobox" Then
.Move Pos(0), Pos(1), Pos(2), Pos(3)
Else
.Move Pos(0), Pos(1), Pos(2)
End If
If b = 1 Then
.Font.Size = .Font.Size * ScX
If LCase$(.Name) = "dagd1" Then
.HeadFont.Size = .HeadFont.Size * ScX
End If
End If
If LCase$(.Name) = "dagd1" Then
.Columns(0).Width = .Width / 6
.Columns(1).Width = .Width / 15
For j = 2 To 8
.Columns(j).Width = .Width / 9
Next
End If
If LCase$(.Name) = "msfg" Then
.ColWidth(0) = .Width / 6
.ColWidth(1) = .Width / 15
For j = 2 To 8
.ColWidth(j) = .Width / 9
Next
End If
.Tag = Join(Pos)
End With
Next
FormOldWidth = FormName.ScaleWidth
FormOldHeight = FormName.ScaleHeight
End Sub我想,你那个ResizeInit过程,应该是做了些控件Tag初始化的工作吧,下面这部分,是我调试用的,若你的ResizeInit过程做了同样的事,它们就不需要了。Private Sub Form_Load()
Dim i As Long
Dim Obj As Control
For i = 2 To 8
dagd1.Columns.Add i
Next msfg.Clear
msfg.Cols = 9
On Error Resume Next
For Each Obj In Controls
Obj.Tag = Obj.Left & " " & Obj.Top & " " & Obj.Width & " " & Obj.Height
Next
FormOldWidth = ScaleWidth
FormOldHeight = ScaleHeight
End SubPrivate Sub Form_Resize()
ResizeForm Me, 1
End Sub
"按比例改控件大小,想法是好的,但现实程序中并不容易实现,象你这样,想同时改变控件内部比例的程序也不多见,因为窗体宽与高的比例是不确定的,字体改变以宽为标准并不可靠,常会因窗体宽高比的改变,而出现控件比例失调现象。宽与高的变化同时兼顾,你可能需另外有一个折衷的安排。"
其实我们单位买的使用“组态软件”编写的控制系统非常好的实现了窗体和其中控件的同步调整,我不知道它是怎么做的,它在所有窗体下面设了一个hscrollbar控件,可以将窗体及其控件放大或缩小10倍,的确做得很理想!所以我想还是有办法可以达到目的的,得多思考一下!
另外,你给我的代码还是不能实现我想要的结果,我再仔细想想!改天我把写好的打包程序发给你指点指点。我的基础不好,得多多向你学习!!!
当宽与高的比例可变时,虽然复杂一些,但做好条件判断也是可以的,只是会有多种方案(如宽优先或高优先),需自己从中选择一种最适合当前程序的而已。
“按比例改控件大小”很常见,但“同时改变控件内部比例的程序不多见”的原因是改变控件内部比例,需针对不同控件分别写代码,没法通用,控件种类多了就会很麻烦,意义又不大,一般很少采用。我也估计到,改过后的代码,虽然我是调试通过了,但楼主可能还是会用不了,因为你对这些代码的含义还不能理解,执行环境只要遇到一点不同,就可能让你陷入迷惑,一时也没什么好办法能让你很快吃透。这种问题涉及对象变量的后期绑定问题,需要对VB各种控件对象有一个全面了解,能够预测所有可能的对象,并对它们比较熟悉才行,此外调试跟踪、错误处理等知识点也不是一时能说清的。以你目前的基础来看,解决这种问题,有点象在建“空中楼阁”,也许通过钻研能补上一些基础,但这需要时间并加上楼主自身的努力,每个程序环境不同,一段代码在自己程序中运用时,你要用的是思路,而不应照搬源码。
StartUpPosition=2在屏幕居中Screen.Width与Screen.Height可取得屏幕的宽与高。字体或窗体默认使用的是相对大小,只与屏幕分辨率有关,与显示器大小无关,你说的图形显示的物理尺寸,除了需打印机输出等情况外,没有程序会去关心它。
“提示没有注册”,你的第三方控件为共享软件吧?那是要你付费给作者呢,与Regsvr32注册是两回事!
先选好一种打包工具,再具体学会怎么带字体。
字体文件一般很大,非大型软件或与文字处理有关的软件,不建议这样做!
http://community.csdn.net/Expert/TopicView.asp?id=3986245
我找了半天都没有找到合适的工具,请各位帮帮我!