回 帖 发 新 帖 刷新版面

主题:关于窗体自适应分辨率的问题

我在家里编写了一个程序,家里显示器的分辨率是1440*900(宽屏),在窗体中我把各个控件放在了合适的位置,但拿到单位使用发现单位的各个电脑的分辨率不尽相同,有800*600、1024*768等等等等,这样就造成窗体和内部的控件显示不全的现象,不知是否有方法可以根据分辨率的不同而自动放大或缩小窗体和内部的控件?我看到网上说可以先求出分辨率后再根据分辨率设置窗体和内部的控件的长和宽,分不同的情况用上几个if。。。then。。。。语句,但是我的这个软件中用上了200多个控件,一一修改是不是太麻烦了?麻烦告知是否有较简便的方法?谢谢啦! 

最好附上实例,谢谢了!

回复列表 (共2个回复)

沙发

可以加3个控件:一个框架、一个横滚动条、一个竖滚动条。
首先用鼠标把窗体上所有的控件全部选中,剪切,然后添加框架,框架比窗体略小,框架右边加竖滚动条,下面加横滚动条,再把剪切的控件复制到框架内,这样,当拉动滚动条时,只要编写代码使框架移动即可,框架内的控件会自动随框架移动。对滚动条的要求:当窗体能显示整个框架时,滚动条隐藏,当窗体<框架时,滚动条显示出来。参考代码:

Option Explicit

Dim h0 As Integer '窗体 Height 初值
Dim w0 As Integer '窗体 Width 初值
Dim T1 As Integer '框架 Top 初值
Dim L1 As Integer '框架 Left 初值

Private Sub Form_Load()
h0 = Me.ScaleHeight: w0 = Me.ScaleWidth
VScrollBar1.Min = h0: HScrollBar1.Min = w0
T1 = Frame1.Top: L1 = Frame1.Left 'Frame1左上角坐标
End Sub

Private Sub Form_Resize()
VScrollBar1.Visible = IIf(Me.ScaleHeight < h0, True, False)
HScrollBar1.Visible = IIf(Me.ScaleWidth < w0, True, False)

If ScaleHeight > HScrollBar1.Height Then

  VScrollBar1.Left = HScrollBar1.Width
  VScrollBar1.Height = ScaleHeight + (HScrollBar1.Visible = True) * HScrollBar1.Height
  
  HScrollBar1.Top = VScrollBar1.Height
  HScrollBar1.Width = ScaleWidth + (VScrollBar1.Visible = True) * VScrollBar1.Width

  VScrollBar1.Max = ScaleHeight - HScrollBar1.Height
  HScrollBar1.Max = ScaleWidth - VScrollBar1.Width
  
  VScrollBar1.LargeChange = ScaleHeight
  HScrollBar1.LargeChange = ScaleWidth
End If
End Sub

Sub VScrollBar1SonProgram()
Frame1.Top = T1 + VScrollBar1.Value - h0
End Sub

Sub HScrollBar1SonProgram()
Frame1.Left = L1 + HScrollBar1.Value - w0
End Sub

Private Sub VScrollBar1_Change()
VScrollBar1SonProgram
End Sub

Private Sub VScrollBar1_Scroll()
VScrollBar1SonProgram
End Sub

Private Sub HScrollBar1_Change()
HScrollBar1SonProgram
End Sub

Private Sub HScrollBar1_Scroll()
HScrollBar1SonProgram
End Sub


你自己去调整一下吧,反正思路是这样的。

板凳


我在网上找到一段例子,带到程序里后发现窗体里的控件字体都变小了,这是怎么回事?在那里修改呀?

Option Explicit
Private ObjOldWidth As Long   '保存窗体的原始宽度
Private ObjOldHeight As Long '保存窗体的原始高度
Private ObjOldFont As Single '保存窗体的原始字体比

'在调用ResizeForm前先调用本函数
Public Sub ResizeInit(FormName As Form)
   Dim Obj As Control
  
   ObjOldWidth = FormName.ScaleWidth
   ObjOldHeight = FormName.ScaleHeight
   ObjOldFont = FormName.Font.Size / ObjOldHeight
   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 / ObjOldWidth
   '保存窗体宽度缩放比例
   ScaleY = FormName.ScaleHeight / ObjOldHeight
   '保存窗体高度缩放比例
   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
       Obj.Font.Size = ObjOldFont * FormName.ScaleHeight
     Next i
  
   Next Obj
  
   On Error GoTo 0
End Sub

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

Private Sub Form_Load()
   '在程序装入时必须加入
   Call ResizeInit(Me)
End Sub

我来回复

您尚未登录,请登录后再回复。点此登录或注册