VB6中窗體控件隨窗體縮放自動適應尺寸


各位高手,菜鳥有一個小問題,就是我想讓窗體內的控件隨窗體的縮放自動適應尺寸,怎樣才可以做到呀,拜謝各位了!

12 个解决方案

#1


關注..

#2


你是在什么系統下作的  我給你一個XP的

#3


關注,還有分辨率問題。

#4


Private Sub Form_Resize()
  Dim H, i As Integer

  On Error Resume Next

  Resize_ALL Me

End Sub

Private Sub Form_Load()

  Dim lRet As Long
  Dim apiRECT As RECT
  lRet = SystemParametersInfo(SPI_GETWORKAREA, vbNull, apiRECT, 0)
  If lRet Then
     Me.Width = apiRECT.Right / 72 * 1440 - 180
     Me.Width = Me.Width - 180
     Me.Height = apiRECT.Bottom / 72 * 1440 - 180
     Me.Height = Me.Height - 1620
  End If
  
'+++2006/11/10  E
End Sub

下面的代碼放在模塊里面

Option Explicit

'********************************************
'2006/11/9    
'********************************************
Public Type ctrObj

  Name As String

  Index As Long

  Parrent As String

  Top As Long

  Left As Long

  Height As Long

  Width As Long

  ScaleHeight As Long

  ScaleWidth As Long

End Type

Private FormRecord() As ctrObj

Private ControlRecord() As ctrObj

Private bRunning As Boolean

Private MaxForm As Long

Private MaxControl As Long

Private Const WM_NCLBUTTONDOWN = &HA1

Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Declare Function ReleaseCapture Lib "USER32" () As Long

Public Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type
Public Const SPI_GETWORKAREA = 48
Public Declare Function SystemParametersInfo Lib "USER32" Alias "SystemParametersInfoA" _
    (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, _
    ByVal fuWinIni As Long) As Long

Function ActualPos(plLeft As Long) As Long

    
    If plLeft < 0 Then
    
        ActualPos = plLeft + 75000
    
    Else
    
        ActualPos = plLeft
    
    End If

End Function

Function FindForm(pfrmIn As Form) As Long

   
    Dim i As Long
    
    FindForm = -1
    
    
    If MaxForm > 0 Then
    
        For i = 0 To (MaxForm - 1)
        
            If FormRecord(i).Name = pfrmIn.Name Then
            
                FindForm = i
            
                Exit Function
            
            End If
        
        Next i
    
    End If

End Function

Function AddForm(pfrmIn As Form) As Long

    Dim FormControl As Control
    
    Dim i As Long
    
    ReDim Preserve FormRecord(MaxForm + 1)
    
    
    FormRecord(MaxForm).Name = pfrmIn.Name
    
    FormRecord(MaxForm).Top = pfrmIn.Top
    
    FormRecord(MaxForm).Left = pfrmIn.Left
    
    FormRecord(MaxForm).Height = pfrmIn.Height
    
    FormRecord(MaxForm).Width = pfrmIn.Width
    
    FormRecord(MaxForm).ScaleHeight = pfrmIn.ScaleHeight
    
    FormRecord(MaxForm).ScaleWidth = pfrmIn.ScaleWidth
    
    AddForm = MaxForm
    
    MaxForm = MaxForm + 1
    
    
    
    For Each FormControl In pfrmIn
    
        i = FindControl(FormControl, pfrmIn.Name)
    
        If i < 0 Then
        
            i = AddControl(FormControl, pfrmIn.Name)
        
        End If
    
    Next FormControl



End Function



Function FindControl(inControl As Control, inName As String) As Long

    Dim i As Long
    
    FindControl = -1
        
    
    For i = 0 To (MaxControl - 1)
    
        If ControlRecord(i).Parrent = inName Then
        
            If ControlRecord(i).Name = inControl.Name Then
            
                On Error Resume Next
            
                If ControlRecord(i).Index = inControl.Index Then
                
                    FindControl = i
                
                    Exit Function
                
                End If
                
                On Error GoTo 0
            
            End If
        
        End If
    
    Next i

End Function



Function AddControl(inControl As Control, inName As String) As Long


    ReDim Preserve ControlRecord(MaxControl + 1)
    
    On Error Resume Next
    
    ControlRecord(MaxControl).Name = inControl.Name
    
    ControlRecord(MaxControl).Index = inControl.Index
    
    ControlRecord(MaxControl).Parrent = inName
        
    
    If TypeOf inControl Is Line Then
    
        ControlRecord(MaxControl).Top = inControl.Y1
        
        ControlRecord(MaxControl).Left = ActualPos(inControl.X1)
        
        ControlRecord(MaxControl).Height = inControl.Y2
        
        ControlRecord(MaxControl).Width = ActualPos(inControl.X2)
    
    Else
    
        ControlRecord(MaxControl).Top = inControl.Top
        
        ControlRecord(MaxControl).Left = ActualPos(inControl.Left)
        
        ControlRecord(MaxControl).Height = inControl.Height
        
        ControlRecord(MaxControl).Width = inControl.Width
    
    End If


    inControl.IntegralHeight = False
    
    On Error GoTo 0
    
    AddControl = MaxControl
    
    MaxControl = MaxControl + 1

End Function



Function PerWidth(pfrmIn As Form) As Long



    Dim i As Long
    
    i = FindForm(pfrmIn)
    
    
    
    If i < 0 Then
    
        i = AddForm(pfrmIn)
    
    End If



    PerWidth = (pfrmIn.ScaleWidth * 100) \ FormRecord(i).ScaleWidth

End Function



Function PerHeight(pfrmIn As Form) As Double



    Dim i As Long
    
    i = FindForm(pfrmIn)
    
    
    
    If i < 0 Then
    
        i = AddForm(pfrmIn)
    
    End If



  PerHeight = (pfrmIn.ScaleHeight * 100) \ FormRecord(i).ScaleHeight

End Function



Public Sub ResizeControl(inControl As Control, pfrmIn As Form)



    On Error Resume Next
    
    Dim i As Long
    
    Dim widthfactor As Single, heightfactor As Single
    
    Dim minFactor As Single
    
    Dim yRatio, xRatio, lTop, lLeft, lWidth, lHeight As Long

  
      yRatio = PerHeight(pfrmIn)
    
      xRatio = PerWidth(pfrmIn)
    
      i = FindControl(inControl, pfrmIn.Name)
    


    If inControl.Left < 0 Then
    
        lLeft = CLng(((ControlRecord(i).Left * xRatio) \ 100) - 75000)
    
    Else
    
        lLeft = CLng((ControlRecord(i).Left * xRatio) \ 100)
    
    End If



    lTop = CLng((ControlRecord(i).Top * yRatio) \ 100)
    
    lWidth = CLng((ControlRecord(i).Width * xRatio) \ 100)
    
    lHeight = CLng((ControlRecord(i).Height * yRatio) \ 100)

    If TypeOf inControl Is Line Then



        If inControl.X1 < 0 Then
        
            inControl.X1 = CLng(((ControlRecord(i).Left * xRatio) \ 100) - 75000)
        
        Else
        
            inControl.X1 = CLng((ControlRecord(i).Left * xRatio) \ 100)
        
        End If
        
        inControl.Y1 = CLng((ControlRecord(i).Top * yRatio) \ 100)
        
        If inControl.X2 < 0 Then
        
            inControl.X2 = CLng(((ControlRecord(i).Width * xRatio) \ 100) - 75000)
        
        Else
        
            inControl.X2 = CLng((ControlRecord(i).Width * xRatio) \ 100)
        
        End If
        
        inControl.Y2 = CLng((ControlRecord(i).Height * yRatio) \ 100)
        
    Else
        
        inControl.Move lLeft, lTop, lWidth, lHeight
        
        inControl.Move lLeft, lTop, lWidth
        
        inControl.Move lLeft, lTop

    End If


End Sub







#5


Private Sub Form_Resize()
  Dim H, i As Integer

  On Error Resume Next

  Resize_ALL Me

End Sub

Private Sub Form_Load()

  Dim lRet As Long
  Dim apiRECT As RECT
  lRet = SystemParametersInfo(SPI_GETWORKAREA, vbNull, apiRECT, 0)
  If lRet Then
     Me.Width = apiRECT.Right / 72 * 1440 - 180
     Me.Width = Me.Width - 180
     Me.Height = apiRECT.Bottom / 72 * 1440 - 180
     Me.Height = Me.Height - 1620
  End If
  
'+++2006/11/10  E
End Sub

下面的代碼放在模塊里面

Option Explicit

'********************************************
'2006/11/9    
'********************************************
Public Type ctrObj

  Name As String

  Index As Long

  Parrent As String

  Top As Long

  Left As Long

  Height As Long

  Width As Long

  ScaleHeight As Long

  ScaleWidth As Long

End Type

Private FormRecord() As ctrObj

Private ControlRecord() As ctrObj

Private bRunning As Boolean

Private MaxForm As Long

Private MaxControl As Long

Private Const WM_NCLBUTTONDOWN = &HA1

Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Declare Function ReleaseCapture Lib "USER32" () As Long

Public Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type
Public Const SPI_GETWORKAREA = 48
Public Declare Function SystemParametersInfo Lib "USER32" Alias "SystemParametersInfoA" _
    (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, _
    ByVal fuWinIni As Long) As Long

Function ActualPos(plLeft As Long) As Long

    
    If plLeft < 0 Then
    
        ActualPos = plLeft + 75000
    
    Else
    
        ActualPos = plLeft
    
    End If

End Function

Function FindForm(pfrmIn As Form) As Long

   
    Dim i As Long
    
    FindForm = -1
    
    
    If MaxForm > 0 Then
    
        For i = 0 To (MaxForm - 1)
        
            If FormRecord(i).Name = pfrmIn.Name Then
            
                FindForm = i
            
                Exit Function
            
            End If
        
        Next i
    
    End If

End Function

Function AddForm(pfrmIn As Form) As Long

    Dim FormControl As Control
    
    Dim i As Long
    
    ReDim Preserve FormRecord(MaxForm + 1)
    
    
    FormRecord(MaxForm).Name = pfrmIn.Name
    
    FormRecord(MaxForm).Top = pfrmIn.Top
    
    FormRecord(MaxForm).Left = pfrmIn.Left
    
    FormRecord(MaxForm).Height = pfrmIn.Height
    
    FormRecord(MaxForm).Width = pfrmIn.Width
    
    FormRecord(MaxForm).ScaleHeight = pfrmIn.ScaleHeight
    
    FormRecord(MaxForm).ScaleWidth = pfrmIn.ScaleWidth
    
    AddForm = MaxForm
    
    MaxForm = MaxForm + 1
    
    
    
    For Each FormControl In pfrmIn
    
        i = FindControl(FormControl, pfrmIn.Name)
    
        If i < 0 Then
        
            i = AddControl(FormControl, pfrmIn.Name)
        
        End If
    
    Next FormControl



End Function



Function FindControl(inControl As Control, inName As String) As Long

    Dim i As Long
    
    FindControl = -1
        
    
    For i = 0 To (MaxControl - 1)
    
        If ControlRecord(i).Parrent = inName Then
        
            If ControlRecord(i).Name = inControl.Name Then
            
                On Error Resume Next
            
                If ControlRecord(i).Index = inControl.Index Then
                
                    FindControl = i
                
                    Exit Function
                
                End If
                
                On Error GoTo 0
            
            End If
        
        End If
    
    Next i

End Function



Function AddControl(inControl As Control, inName As String) As Long


    ReDim Preserve ControlRecord(MaxControl + 1)
    
    On Error Resume Next
    
    ControlRecord(MaxControl).Name = inControl.Name
    
    ControlRecord(MaxControl).Index = inControl.Index
    
    ControlRecord(MaxControl).Parrent = inName
        
    
    If TypeOf inControl Is Line Then
    
        ControlRecord(MaxControl).Top = inControl.Y1
        
        ControlRecord(MaxControl).Left = ActualPos(inControl.X1)
        
        ControlRecord(MaxControl).Height = inControl.Y2
        
        ControlRecord(MaxControl).Width = ActualPos(inControl.X2)
    
    Else
    
        ControlRecord(MaxControl).Top = inControl.Top
        
        ControlRecord(MaxControl).Left = ActualPos(inControl.Left)
        
        ControlRecord(MaxControl).Height = inControl.Height
        
        ControlRecord(MaxControl).Width = inControl.Width
    
    End If


    inControl.IntegralHeight = False
    
    On Error GoTo 0
    
    AddControl = MaxControl
    
    MaxControl = MaxControl + 1

End Function



Function PerWidth(pfrmIn As Form) As Long



    Dim i As Long
    
    i = FindForm(pfrmIn)
    
    
    
    If i < 0 Then
    
        i = AddForm(pfrmIn)
    
    End If



    PerWidth = (pfrmIn.ScaleWidth * 100) \ FormRecord(i).ScaleWidth

End Function



Function PerHeight(pfrmIn As Form) As Double



    Dim i As Long
    
    i = FindForm(pfrmIn)
    
    
    
    If i < 0 Then
    
        i = AddForm(pfrmIn)
    
    End If



  PerHeight = (pfrmIn.ScaleHeight * 100) \ FormRecord(i).ScaleHeight

End Function



Public Sub ResizeControl(inControl As Control, pfrmIn As Form)



    On Error Resume Next
    
    Dim i As Long
    
    Dim widthfactor As Single, heightfactor As Single
    
    Dim minFactor As Single
    
    Dim yRatio, xRatio, lTop, lLeft, lWidth, lHeight As Long

  
      yRatio = PerHeight(pfrmIn)
    
      xRatio = PerWidth(pfrmIn)
    
      i = FindControl(inControl, pfrmIn.Name)
    


    If inControl.Left < 0 Then
    
        lLeft = CLng(((ControlRecord(i).Left * xRatio) \ 100) - 75000)
    
    Else
    
        lLeft = CLng((ControlRecord(i).Left * xRatio) \ 100)
    
    End If



    lTop = CLng((ControlRecord(i).Top * yRatio) \ 100)
    
    lWidth = CLng((ControlRecord(i).Width * xRatio) \ 100)
    
    lHeight = CLng((ControlRecord(i).Height * yRatio) \ 100)

    If TypeOf inControl Is Line Then



        If inControl.X1 < 0 Then
        
            inControl.X1 = CLng(((ControlRecord(i).Left * xRatio) \ 100) - 75000)
        
        Else
        
            inControl.X1 = CLng((ControlRecord(i).Left * xRatio) \ 100)
        
        End If
        
        inControl.Y1 = CLng((ControlRecord(i).Top * yRatio) \ 100)
        
        If inControl.X2 < 0 Then
        
            inControl.X2 = CLng(((ControlRecord(i).Width * xRatio) \ 100) - 75000)
        
        Else
        
            inControl.X2 = CLng((ControlRecord(i).Width * xRatio) \ 100)
        
        End If
        
        inControl.Y2 = CLng((ControlRecord(i).Height * yRatio) \ 100)
        
    Else
        
        inControl.Move lLeft, lTop, lWidth, lHeight
        
        inControl.Move lLeft, lTop, lWidth
        
        inControl.Move lLeft, lTop

    End If


End Sub







#6


支持樓上的兄弟

#7


我覺得自己做個控件比較好
直接往上面一放,幾句代碼就可以了.
以前用過一個,后來不做VB開發就不知道丟哪兒去了,上網找找應該有.

#8


Resize_ALL   Me ?

#9


在說一下如果是在2000系統下開發的話,畫面上的容器太多的話,就不一定有用的

#10


謝謝各位熱心的朋友了,我的問題在各位朋友的幫助下,也得到了解決了!

#11


給我自己試過的一個簡單例子,不知道是否適合你!

'控件大小隨窗體變化自適應,主要是使用了Move方法。

Option Explicit

Private Sub Form_Resize()
   Text1.Move 0, 0, ScaleWidth, ScaleHeight / 3
   Command1.Move 0, (Text1.Height), ScaleWidth / 2, ScaleHeight / 3
End Sub

#12


該回復於2007-12-05 08:59:36被版主刪除

注意!

本站转载的文章为个人学习借鉴使用,本站对版权不负任何法律责任。如果侵犯了您的隐私权益,请联系我们删除。



 
粤ICP备14056181号  © 2014-2021 ITdaan.com