一勞永逸讓VB自動改變控制元件大小

chinayuppie發表於2009-10-06

-------------------------------------------------------------------

   當窗體大小改變時,如何動態的改變控制元件的大小是許多VB 程式設計師頭痛的事。有的人設定窗體Resizable 但卻不改變控制元件的大小;有的人則根據控制元件的絕對位置與視窗大小相加減的辦法來重新定位控制元件與改變大小,這種辦法比較繁瑣,且不可重用;當然也有人則限定視窗乾脆不讓改變。有沒有一種簡便易行的辦法?答案是肯定的,下面給出一個一勞永逸的辦法,源程式如下:

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

Private Sub Form_Load()
 
Call ResizeInit(Me)  '在程式裝入時必須加入
End Sub

Private Sub Form_Resize()
 
Call ResizeForm(Me)  '確保窗體改變時控制元件隨之改變
End Sub

   本例中給出了二個函式: ResizeInit 和 ResizeForm ,在呼叫 ResizeForm 之前必須先呼叫 ResizeInit。你可以將本程式拷到窗體程式碼段裡,然後在窗體里加入任意控制元件即可進行測試。

相關文章