找了几天了,就是搞不定,请高手帮助

各位高手,我是一个VB初学者,现在编了一个小程序公司在用,但公司有的用笔记本,有的用台式机,分辨率有1024*768和800*600的,但我用800*600编程的,现在笔记本用户用软件的时侯总是感觉别扭,我在网上下载了几个能自动适应分辨率的代码,但窗体一启动就变大了,总之用不好,我不知不会用还是不能用。请高手指点。代码如下:
1、在标准模块部分
Option Explicit
Private FormOldWidth As Long
    '保存窗体的原始宽度
Private FormOldHeight As Long
    '保存窗体的原始高度

'在调用ResizeForm前先调用本函数
Public Sub ResizeInit(FormName As Form)
   Dim Obj As Control
   FormOldWidth = FormName.ScaleWidth
   FormOldHeight = FormName.ScaleHeight
   On Error Resume Next
   For Each Obj In FormName
     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
      '读取控件的原始位置与大小

       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
   On Error GoTo 0
End Sub

2、窗体部分
Private Sub Form_Load()

Call ResizeInit(Me)  '在程序装入时必须加入

End Sub

Private Sub Form_Resize()

 Call ResizeForm(Me)  '确保窗体改变时控件随之改变

End Sub

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值