常见问题:自动调整窗口内控间的大小

发表于:2007-05-25来源:作者:点击数: 标签:内控间的常见问题窗口自动
这是一个类模块: 1. 建立一个新的类模块,加入下列代码,并给类模块起名(例:autosize) 2. 加入一个窗口并且加入:Private el as new autosize 3. 在 Form_Load 事件中加入 el.init me 4. 在 Form_Resize 事件中加入 el.formresize me Option Explicit Pr

这是一个类模块:
1. 建立一个新的类模块,加入下列代码,并给类模块起名(例:autosize)
2. 加入一个窗口并且加入:Private el as new autosize
3. 在 Form_Load 事件中加入 el.init me
4. 在 Form_Resize 事件中加入 el.formresize me


Option Explicit
Private nFormHeight      As Integer
Private nFormWidth       As Integer
Private nNumOfControls   As Integer
Private nTop()           As Integer
Private nLeft()          As Integer
Private nHeight()        As Integer
Private nWidth()         As Integer
Private nFontSize()      As Integer
Private nRightMargin()   As Integer
Private bFirstTime       As Boolean

Sub Init(frm As Form, Optional nWindState As Variant)
   Dim I          As Integer
   Dim bWinMax    As Boolean

   bWinMax = Not IsMissing(nWindState)

   nFormHeight = frm.Height
   nFormWidth = frm.Width
   nNumOfControls = frm.Controls.Count - 1
   bFirstTime = True
   ReDim nTop(nNumOfControls)
   ReDim nLeft(nNumOfControls)
   ReDim nHeight(nNumOfControls)
   ReDim nWidth(nNumOfControls)
   ReDim nFontSize(nNumOfControls)

   ReDim nRightMargin(nNumOfControls)
   On Error Resume Next
   For I = 0 To nNumOfControls
      If TypeOf frm.Controls(I) Is Line Then
         nTop(I) = frm.Controls(I).Y1
         nLeft(I) = frm.Controls(I).X1
         nHeight(I) = frm.Controls(I).Y2
         nWidth(I) = frm.Controls(I).X2
      Else
         nTop(I) = frm.Controls(I).Top
         nLeft(I) = frm.Controls(I).Left
         nHeight(I) = frm.Controls(I).Height
         nWidth(I) = frm.Controls(I).Width
         nFontSize(I) = frm.FontSize
         nRightMargin(I) = frm.Controls(I).RightMargin
      End If
   Next

   If bWinMax Or frm.WindowState = 2 Then
      frm.Height = Screen.Height
      frm.Width = Screen.Width
   Else
      frm.Height = frm.Height * Screen.Height / 7290
      frm.Width = frm.Width * Screen.Width / 9690
   End If

   bFirstTime = True

End Sub

Sub FormResize(frm As Form)

   Dim I             As Integer
   Dim nCaptionSize  As Integer
   Dim dRatioX       As Double
   Dim dRatioY       As Double
   Dim nSaveRedraw   As Long

   On Error Resume Next
   nSaveRedraw = frm.AutoRedraw

   frm.AutoRedraw = True

   If bFirstTime Then
      bFirstTime = False
      Exit Sub
   End If

   If frm.Height < nFormHeight / 2 Then 
     frm.Height = nFormHeight / 2
   Endif

   If frm.Width < nFormWidth / 2 Then 
     frm.Width = nFormWidth / 2
   Endif
   
  nCaptionSize = 400
   dRatioY = 1# * (nFormHeight - nCaptionSize) _
    / (frm.Height - nCaptionSize)
   dRatioX = 1# * nFormWidth / frm.Width
   On Error Resume Next

   For I = 0 To nNumOfControls
      If TypeOf frm.Controls(I) Is Line Then
         frm.Controls(I).Y1 = Int(nTop(I) / dRatioY)
         frm.Controls(I).X1 = Int(nLeft(I) / dRatioX)
         frm.Controls(I).Y2 = Int(nHeight(I) / dRatioY)
         frm.Controls(I).X2 = Int(nWidth(I) / dRatioX)
      Else
         frm.Controls(I).Top = Int(nTop(I) / dRatioY)
         frm.Controls(I).Left = Int(nLeft(I) / dRatioX)
         frm.Controls(I).Height = Int(nHeight(I) / dRatioY)
         frm.Controls(I).Width = Int(nWidth(I) / dRatioX)
         frm.Controls(I).FontSize = Int(nFontSize(I) / _
        dRatioX) + Int(nFontSize(I) / dRatioX) Mod 2
         frm.Controls(I).RightMargin = Int(nRightMargin(I) / dRatioY)
      End If
   Next

   frm.AutoRedraw = nSaveRedraw

End Sub

原文转自:http://www.ltesting.net