VB窗体自适应有什么好的方法？

unsv29 2009-08-18 10:02:47

有什么好的控件或者是程序请奉献一把！！！！

自适应好的方法多谢！！！

...全文

559 39 打赏收藏转发到动态举报

写回复

用AI写文章

39 条回复

切换为时间正序

请发表友善的回复…

发表回复

lingf_l 2010-05-16

打赏
举报

厉害，这里的都是高手啊

nbabest23 2009-08-19

打赏
举报

学习

unsv29 2009-08-19

打赏
举报

28楼的好用啊我再多次尝试一下！！！

jhone99 2009-08-19

打赏
举报

见鬼了，你先用这个，我研究一下那个

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

          If TypeOf Obj Is ComboBox Then

                Obj.Tag = Obj.Left & " " & Obj.Top & " " & Obj.Width & " " & Obj.FontSize & " "

          ElseIf TypeOf Obj Is CommandButton Then

                Obj.Tag = Obj.Left & " " & Obj.Top & " " & Obj.Width & " " & Obj.Height & " " & Obj.FontSize & " "

          ElseIf TypeOf Obj Is Line Then

                Obj.Tag = Obj.X1 & " " & Obj.X2 & " " & Obj.Y1 & " " & Obj.Y2 & " " & Obj.BorderWidth & " "

          Else

                Obj.Tag = Obj.Left & " " & Obj.Top & " " & Obj.Width & " " & Obj.Height & " "



          End If

      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 5

          '读取控件的原始位置与大小

              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

        '根据控件的原始位置及窗体改变大小的比例对控件重新定位与改变大小

          Next i



            If TypeOf Obj Is ComboBox Then

                Obj.FontSize = Pos(3) * ScaleY

                Obj.Move Pos(0) * ScaleX, Pos(1) * ScaleY, Pos(2) * ScaleX

            ElseIf TypeOf Obj Is CommandButton Then

                Obj.FontSize = Pos(4) * ScaleY

                Obj.Move Pos(0) * ScaleX, Pos(1) * ScaleY, Pos(2) * ScaleX, Pos(3) * ScaleY

            ElseIf TypeOf Obj Is Line Then

                Obj.X1 = Pos(0) * ScaleX

                Obj.X2 = (Pos(1) - Pos(0)) * ScaleX + Obj.X1

                Obj.Y1 = Pos(2) * ScaleY

                Obj.Y2 = (Pos(3) - Pos(2)) * ScaleY + Obj.Y1

                Obj.BorderWidth = Pos(4) * Sqr(ScaleX * ScaleX + ScaleY * ScaleY)

            Else

                Obj.Move Pos(0) * ScaleX, Pos(1) * ScaleY, Pos(2) * ScaleX, Pos(3) * ScaleY

            End If

      Next Obj

      On Error GoTo 0

  End Sub



Private Sub Form_Initialize()

    Call ResizeInit(Me)

End Sub



Private Sub Form_Resize()

    Call ResizeForm(Me)

End Sub

unsv29 2009-08-19

打赏
举报

这个问题看样子确实有难度。平时各位回答本小菜鸟的问题那是相当的踊跃啊。

今天咋的了？？？

说明什么？？

说明本问题难度那是相当的大。

unsv29 2009-08-19

打赏
举报

24楼还是不行啊？？？？晕了！！！！

多谢多谢哈哈哈多谢

哈哈

还是image图片显示不出来。

你试一试看看能显示么？？

unsv29 2009-08-19

打赏
举报

22楼你以为这玩意简单啊你稍微修改下试试！！！！
稍微修改下能搞定的话，那像jhone99这么高水平的牛人早就搞定了

你要多向jhone99学习！！！！

22楼看你说话的语气似乎22楼更牛？？？

看你表现

表现的好本小皇帝给你个芝麻官当！OK？？？

jhone99 2009-08-19

打赏
举报

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

          If TypeOf Obj Is Line Then

                Obj.Tag = Obj.X1 & " " & Obj.X2 & " " & Obj.Y1 & " " & Obj.Y2 & " " & Obj.BorderWidth & " "

          Else

                Obj.Tag = Obj.Left & " " & Obj.Top & " " & Obj.Width & " " & Obj.Height & " " & Obj.FontSize & " "



          End If

      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 5

          '读取控件的原始位置与大小

              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

        '根据控件的原始位置及窗体改变大小的比例对控件重新定位与改变大小

          Next i



            If TypeOf Obj Is ComboBox Then

                Obj.FontSize = Pos(4) * ScaleY

                Obj.Move Pos(0) * ScaleX, Pos(1) * ScaleY, Pos(2) * ScaleX

            ElseIf TypeOf Obj Is Line Then

                Obj.X1 = Pos(0) * ScaleX

                Obj.X2 = (Pos(1) - Pos(0)) * ScaleX + Obj.X1

                Obj.Y1 = Pos(2) * ScaleY

                Obj.Y2 = (Pos(3) - Pos(2)) * ScaleY + Obj.Y1

                Obj.BorderWidth = Pos(4) * Sqr(ScaleX * ScaleX + ScaleY * ScaleY)

            Else

                If TypeOf Obj Is CommandButton Then Obj.FontSize = Pos(4) * ScaleY

                Obj.Move Pos(0) * ScaleX, Pos(1) * ScaleY, Pos(2) * ScaleX, Pos(3) * ScaleY

            End If

      Next Obj

      On Error GoTo 0

  End Sub



Private Sub Form_Initialize()

    Call ResizeInit(Me)

End Sub



Private Sub Form_Resize()

    Call ResizeForm(Me)

End Sub

unsv29 2009-08-19

打赏
举报

回21楼

就用你19楼的代码别的代码什么也不用然后在窗体上加个image控件，然后将image的picture属性添加一个图片，然后将图片的stretch的属性改为true。然后运行，结果图片没了。

如果用你8楼的代码别的代码什么也不用然后在窗体上加个image控件，然后将image的picture属性添加一个图片，然后将图片的stretch的属性改为true。然后运行，结果图片可以看到，并且可以自适应。

另外：19楼的代码可以让字体大小变化

8楼的代码字体大小无法变化

无·法 2009-08-19

打赏
举报

楼主属小皇帝类型，人家给了部分代码，也给了思路“fontsize或font.size”还在嚷嚷，其实自己稍微修改下就行了。

显示图片这个你自己就应该分析下，比如是不是autoredraw的设置问题等等。

jhone99 2009-08-19

打赏
举报

你现在的代码贴出来

unsv29 2009-08-19

打赏
举报

你这个代码是可以放大啊但是把image图片给弄没了！！！显示不出图片了。

你在8楼的代码可以显示图片

jhone99 2009-08-19

打赏
举报

这个可以改变字体大小

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

          If TypeOf Obj Is Line Then

                Obj.Tag = Obj.X1 & " " & Obj.X2 & " " & Obj.Y1 & " " & Obj.Y2 & " " & Obj.BorderWidth & " "

          Else

                Obj.Tag = Obj.Left & " " & Obj.Top & " " & Obj.Width & " " & Obj.Height & " " & Obj.FontSize & " "



          End If

      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 5

          '读取控件的原始位置与大小

              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

        '根据控件的原始位置及窗体改变大小的比例对控件重新定位与改变大小

          Next i

            

            If TypeOf Obj Is ComboBox Then

                Obj.FontSize = Pos(4) * ScaleY

                Obj.Move Pos(0) * ScaleX, Pos(1) * ScaleY, Pos(2) * ScaleX

            ElseIf TypeOf Obj Is Line Then

                Obj.X1 = Pos(0) * ScaleX

                Obj.X2 = (Pos(1) - Pos(0)) * ScaleX + Obj.X1

                Obj.Y1 = Pos(2) * ScaleY

                Obj.Y2 = (Pos(3) - Pos(2)) * ScaleY + Obj.Y1

                Obj.BorderWidth = Pos(4) * Sqr(ScaleX * ScaleX + ScaleY * ScaleY)

            Else

                Obj.FontSize = Pos(4) * ScaleY

                Obj.Move Pos(0) * ScaleX, Pos(1) * ScaleY, Pos(2) * ScaleX, Pos(3) * ScaleY

            End If

      Next Obj

      On Error GoTo 0

  End Sub



Private Sub Form_Initialize()

    Call ResizeInit(Me)

End Sub



Private Sub Form_Resize()

    Call ResizeForm(Me)

End Sub