7,763
社区成员
发帖
与我相关
我的任务
分享vb生成的界面随电脑分辨率变化方法，下面的程序为热心网友提供，但是运行时提示“编译错误：未找到数据或方法
Public Sub chang(ThisForm As Form)
Dim DesignX As Integer
Dim DesignY As Integer
Dim XFactor As Single
Dim YFactor As Single
Dim X As Integer
DesignX% = 1400: DesignY% = 900
XFactor = (Screen.Width / Screen.TwipsPerPixe1X) / DesignX
YFactor = (Screen.Height / Screen.TwipsPerPixe1Y) / DesignY
If XFactor = 1 And YFactor = 1 Then
Exit Sub
With ThisForm
.Move .Left * XFactor, .Top * YFactor, .Width * XFactor, .Height * YFactor
For X = 0 To .Controls.Count - 1
If TypeOf .Controls(X) Is DriveListBox Then
.Controls(X).Move .Controls(X).Left * XFactor, .Controls(X).Top * XFactor, .Controls(X).Width * XFactor
ElseIf TypeOf .Controls(X) Is ComboBox Then
If T.Controls(X).Style <> 1 Then
.Controls(X).Move .Controls(X).Left * XFactor, .Controls(X).Top * XFactor, .Controls(X).Width * XFactor
End If
Else
.Controls(X).Move .Controls(X).Left * XFactor, .Controls(X).Top * XFactor, .Controls(X).Width * XFactor, .Controls(X).Height * YFactor
If TypeOf .Controls(X) Is TextBox Then
.Controls(X).FontSize = .Controls(X).FontSize * XFactor
ElseIf TypeOf .Controls(X) Is Label Then
.Contr ols(X).FontSize = .Controls(X).FontSize * XFactor
End If
End If
Next X
End With
End Sub
引用是这样的：
Private Sub Command15_Click()
Load Form10
Call chang(Form10)
Form10.Show
End Sub
Dim DesignX As Integer
Dim DesignY As Integer
Dim XFactor As Single
Dim YFactor As Single
Dim X As Integer
DesignX% = 1400: DesignY% = 900
XFactor = (Screen.Width / Screen.TwipsPerPixe1X) / DesignX
YFactor = (Screen.Height / Screen.TwipsPerPixe1Y) / DesignY
If XFactor = 1 And YFactor = 1 Then
Exit Sub
With ThisForm
.Move .Left * XFactor, .Top * YFactor, .Width * XFactor, .Height * YFactor
For X = 0 To .Controls.Count - 1
If TypeOf .Controls(X) Is DriveListBox Then
.Controls(X).Move .Controls(X).Left * XFactor, .Controls(X).Top * XFactor, .Controls(X).Width * XFactor
ElseIf TypeOf .Controls(X) Is ComboBox Then
If T.Controls(X).Style <> 1 Then
.Controls(X).Move .Controls(X).Left * XFactor, .Controls(X).Top * XFactor, .Controls(X).Width * XFactor
End If
Else
.Controls(X).Move .Controls(X).Left * XFactor, .Controls(X).Top * XFactor, .Controls(X).Width * XFactor, .Controls(X).Height * YFactor
If TypeOf .Controls(X) Is TextBox Then
.Controls(X).FontSize = .Controls(X).FontSize * XFactor
ElseIf TypeOf .Controls(X) Is Label Then
.Contr ols(X).FontSize = .Controls(X).FontSize * XFactor
End If
End If
Next X
End With
End Sub
引用是这样的：
Private Sub Command15_Click()
Load Form10
Call chang(Form10)
Form10.Show
End Sub
...全文
请发表友善的回复…
发表回复
zhuhengxuan 2013-08-22
- 打赏
- 举报
你好，谢谢的帮助，但是我在笔记本上14”的显示还是不完整。不知道怎么回事，我编写的时候使用19宽屏的1440*900
我的昵称被占用 2013-08-22
- 打赏
- 举报
我在家里试了一下。我改过的工程可以用.效果还不错。我家里是23"显示器。分辩率:1280X960
我改过的工程就是我的那个图面另存下来改后缀为rar.用rar解压就行了.
zhuhengxuan 2013-08-22
- 打赏
- 举报
非常感谢了！
我的昵称被占用 2013-08-22
- 打赏
- 举报
打开方法就是将图面另存后,再更改扩展名为rar ,解压就可以了.
我先试了一下,要下班了,你将分辩率改小到 1440X900以下试一下看看,是不是有效果了,我电脑的分辩率是1132X842.
如果你还有控件,按照模块里面的示例再改.
我下班了,回家后再帮你测试.
zhuhengxuan 2013-08-22
- 打赏
- 举报
[/quote]
工程还是没有啊
怎么发啊
zhuhengxuan 2013-08-22
- 打赏
- 举报
我的昵称被占用 2013-08-22
- 打赏
- 举报
理论上讲,上面的代码在你本机上运行后,你的窗体是不应该更改的.
DesignX% = 1400: DesignY% = 900
其中上面那句表示,你当前所使用的分辩率为 1400X900;
如果你不是在此分辩率下开发,那上面也要进行相应更改.
另外.如果想要真正让所有的控件都能按想要的方式进行更改位置与大小,
那你应该在后面增加你窗体中所有用到的控件的处理方式.
如果想要正确的结果,请将你要显示的工程中的控体结构发出来.或将工程发出来.
<发工程的方式>
1. 找到一个 jpg图片. 如 F:\1.jpg
2.将要上传的文件压缩. 压缩后的文件放入 F:\2.rar
3.开始->运行->cmd
4.在Dos下输入 F 转到F盘
5.输入 copy /b 1.jpg + 2.rar
6.发贴,插入图片,将刚才的1.jpg上传发出来
zhuhengxuan 2013-08-22
- 打赏
- 举报
你这个方法能运行，但是运行中发现界面出现混乱，还是没有达到目的
我的昵称被占用 2013-08-22
- 打赏
- 举报
Public Sub chang(ThisForm As Form)
On Error Resume Next '忽略错误的代码一般放在第一句
Dim DesignX As Integer
Dim DesignY As Integer
Dim XFactor As Single
Dim YFactor As Single
Dim X As Integer
'..........
'其它代码
'.........
End Sub
我的昵称被占用 2013-08-22
- 打赏
- 举报
'采用这个,你自己按照示例增加就行了.
Public Sub chang(ThisForm As Form)
Dim DesignX As Integer
Dim DesignY As Integer
Dim XFactor As Single
Dim YFactor As Single
Dim X As Integer
DesignX% = 1400: DesignY% = 900
XFactor = (Screen.Width / Screen.TwipsPerPixelX) / DesignX
YFactor = (Screen.Height / Screen.TwipsPerPixelY) / DesignY
If XFactor = 1 And YFactor = 1 Then Exit Sub
With ThisForm
.Move .Left * XFactor, .Top * YFactor, .Width * XFactor, .Height * YFactor
For X = 0 To .Controls.Count - 1
Select Case TypeName(.Controls(X))
Case "DriveListBox" 'DriveListBox控件
.Controls(X).Move .Controls(X).Left * XFactor, .Controls(X).Top * XFactor, .Controls(X).Width * XFactor
Case "ComboBox" 'ComboBox控件
If .Controls(X).Style <> 1 Then
.Controls(X).Move .Controls(X).Left * XFactor, .Controls(X).Top * XFactor, .Controls(X).Width * XFactor
End If
Case "TextBox" 'Textbox控件
.Controls(X).Move .Controls(X).Left * XFactor, .Controls(X).Top * XFactor, .Controls(X).Width * XFactor, .Controls(X).Height * YFactor
.Controls(X).FontSize = .Controls(X).FontSize * XFactor '设置字体,如果感到小了,可以更改
Case "Label" 'Label控件
.Controls(X).Move .Controls(X).Left * XFactor, .Controls(X).Top * XFactor, .Controls(X).Width * XFactor, .Controls(X).Height * YFactor
.Controls(X).FontSize = .Controls(X).FontSize * XFactor '设置字体,如果感到小了,可以更改
'Case "Line" '与上面一样示例,增加其他的控件代码
'....
'.......
Case Else
'除上面申明的控件外,不进行处理 此处也可以增加处理代码
End Select
Next X
End With
End Subzhuhengxuan 2013-08-22
- 打赏
- 举报
我是小白，你说的忽略错误的代码放在那句，谢谢
我的昵称被占用 2013-08-22
- 打赏
- 举报
你窗体上还有line time等控件没?
出现错误应该是有的控件不支持 move方法. 如 line 控件
或不支持 left right等的读写 如 Time控件.
为了避免错误,请在方法的第一句写上一个 on error resume next 忽略错误,或者将窗体上所的控件的处理方式都写入代码中.
zhuhengxuan 2013-08-22
- 打赏
- 举报
我把代码复制进去以后，语句29的语句就错误，”实时错误483，对象不支持的对象或方法“
zhuhengxuan 2013-08-22
- 打赏
- 举报
你好：
我把代码复制进去以后，上面标红的语句就错误，”实时错误483，对象不支持的对象或方法“
我的昵称被占用 2013-08-22
- 打赏
- 举报
'上面的代码错误还有.不能起到作用,以下更改后能起到作用.
Public Sub chang(ThisForm As Form)
Dim DesignX As Integer
Dim DesignY As Integer
Dim XFactor As Single
Dim YFactor As Single
Dim X As Integer
DesignX% = 1400: DesignY% = 900
XFactor = (Screen.Width / Screen.TwipsPerPixelX) / DesignX
YFactor = (Screen.Height / Screen.TwipsPerPixelY) / DesignY
MsgBox XFactor
MsgBox YFactor
If XFactor = 1 And YFactor = 1 Then
Exit Sub
Else
With ThisForm
.Move .Left * XFactor, .Top * YFactor, .Width * XFactor, .Height * YFactor
For X = 0 To .Controls.Count - 1
If TypeOf .Controls(X) Is DriveListBox Then
.Controls(X).Move .Controls(X).Left * XFactor, .Controls(X).Top * XFactor, .Controls(X).Width * XFactor
ElseIf TypeOf .Controls(X) Is ComboBox Then
If .Controls(X).Style <> 1 Then
.Controls(X).Move .Controls(X).Left * XFactor, .Controls(X).Top * XFactor, .Controls(X).Width * XFactor
End If
Else
.Controls(X).Move .Controls(X).Left * XFactor, .Controls(X).Top * XFactor, .Controls(X).Width * XFactor, .Controls(X).Height * YFactor
If TypeOf .Controls(X) Is TextBox Then
.Controls(X).FontSize = .Controls(X).FontSize * XFactor
ElseIf TypeOf .Controls(X) Is Label Then
.Controls(X).FontSize = .Controls(X).FontSize * XFactor
End If
End If
Next X
End With
End If
End Sub我的昵称被占用 2013-08-22
- 打赏
- 举报
Public Sub chang(ThisForm As Form)
Dim DesignX As Integer
Dim DesignY As Integer
Dim XFactor As Single
Dim YFactor As Single
Dim X As Integer
DesignX% = 1400: DesignY% = 900
XFactor = (Screen.Width / Screen.TwipsPerPixe1X) / DesignX
'错误1 上面的单词 TwipsPerPixe1X 应该是 TwipsPerPixel;是字母 lX 不是数字1X
YFactor = (Screen.Height / Screen.TwipsPerPixe1Y) / DesignY
'错误2 与上面一样,请将此二处的数字1改为字母L
If XFactor = 1 And YFactor = 1 Then
Exit Sub
With ThisForm
.Move .Left * XFactor, .Top * YFactor, .Width * XFactor, .Height * YFactor
For X = 0 To .Controls.Count - 1
If TypeOf .Controls(X) Is DriveListBox Then
.Controls(X).Move .Controls(X).Left * XFactor, .Controls(X).Top * XFactor, .Controls(X).Width * XFactor
ElseIf TypeOf .Controls(X) Is ComboBox Then
If T.Controls(X).Style <> 1 Then
.Controls(X).Move .Controls(X).Left * XFactor, .Controls(X).Top * XFactor, .Controls(X).Width * XFactor
End If
Else
.Controls(X).Move .Controls(X).Left * XFactor, .Controls(X).Top * XFactor, .Controls(X).Width * XFactor, .Controls(X).Height * YFactor
If TypeOf .Controls(X) Is TextBox Then
.Controls(X).FontSize = .Controls(X).FontSize * XFactor
ElseIf TypeOf .Controls(X) Is Label Then
.Contr ols(X).FontSize = .Controls(X).FontSize * XFactor
'错误3 此处 .Contr ols 应该是连着的. 即 .Controls 请将空格删除
End If
End If
Next X
End With
'错误4.此处少了End if 请加上 End if
End Sub
'以下是正确的代码,请复制后使用
Public Sub chang(ThisForm As Form)
Dim DesignX As Integer
Dim DesignY As Integer
Dim XFactor As Single
Dim YFactor As Single
Dim X As Integer
DesignX% = 1400: DesignY% = 900
XFactor = (Screen.Width / Screen.TwipsPerPixelX) / DesignX
YFactor = (Screen.Height / Screen.TwipsPerPixelY) / DesignY
If XFactor = 1 And YFactor = 1 Then
Exit Sub
With ThisForm
.Move .Left * XFactor, .Top * YFactor, .Width * XFactor, .Height * YFactor
For X = 0 To .Controls.Count - 1
If TypeOf .Controls(X) Is DriveListBox Then
.Controls(X).Move .Controls(X).Left * XFactor, .Controls(X).Top * XFactor, .Controls(X).Width * XFactor
ElseIf TypeOf .Controls(X) Is ComboBox Then
If T.Controls(X).Style <> 1 Then
.Controls(X).Move .Controls(X).Left * XFactor, .Controls(X).Top * XFactor, .Controls(X).Width * XFactor
End If
Else
.Controls(X).Move .Controls(X).Left * XFactor, .Controls(X).Top * XFactor, .Controls(X).Width * XFactor, .Controls(X).Height * YFactor
If TypeOf .Controls(X) Is TextBox Then
.Controls(X).FontSize = .Controls(X).FontSize * XFactor
ElseIf TypeOf .Controls(X) Is Label Then
.Controls(X).FontSize = .Controls(X).FontSize * XFactor
End If
End If
Next X
End With
End If
End Sub
