窗体自适应

'模块******************************************
Public Type cp
  wp As Single
  hp As Single
  tp As Single
  lp As Single
End Type


'窗体***********************************************
Const SPI_GETWORKAREA = 48
Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" _
    (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, _
    ByVal fuWinIni As Long) As Long

Dim ap() As cp
Sub ai()
  Dim i As Integer
  If Controls.Count > 0 Then
    '如果窗体中包括菜单，这时程序将出错
    '解决办法：在代码前加"On Error Resume Next"
    For i = 0 To Controls.Count - 1
      With ap(i)
        .wp = Controls(i).Width / Form1.ScaleWidth
        .hp = Controls(i).Height / Form1.ScaleHeight
        .lp = Controls(i).Left / Form1.ScaleWidth
        .tp = Controls(i).Top / Form1.ScaleHeight
      End With
    Next i
  End If
End Sub

Private Sub Command1_Click()
  If Controls.Count > 0 Then
    ReDim ap(0 To Controls.Count - 1)
    ai
    
  Dim lRet As Long
  Dim apiRECT As RECT
  lRet = SystemParametersInfo(SPI_GETWORKAREA, vbNull, apiRECT, 0)
  If lRet Then
     If Me.Width > apiRECT.Right / 72 * 1440 - 180 Then
     MsgBox "sdfds"
     Me.Width = apiRECT.Right / 72 * 1440 - 180
     Me.Width = Me.Width - 180
     End If
     If Me.Height > apiRECT.Bottom / 72 * 1440 - 180 Then
     Me.Height = apiRECT.Bottom / 72 * 1440 - 180
     Me.Height = Me.Height - 180
     End If
  End If

    
    
    
    
    For i = 0 To Controls.Count - 1
      Controls(i).Move ap(i).lp * Form1.ScaleWidth, ap(i).tp * Form1.ScaleHeight, ap(i).wp * Form1.ScaleWidth, ap(i).hp * Form1.ScaleHeight
    Next i
  End If

End Sub

Private Sub Command3_Click()
  End
End Sub

Private Sub Form_Load()
  If Controls.Count > 0 Then
    ReDim ap(0 To Controls.Count - 1)
    ai
    
  Dim lRet As Long
  Dim apiRECT As RECT
  lRet = SystemParametersInfo(SPI_GETWORKAREA, vbNull, apiRECT, 0)
  If lRet Then
     If Me.Width > apiRECT.Right / 72 * 1440 - 180 Then
     MsgBox "sdfds"
     Me.Width = apiRECT.Right / 72 * 1440 - 180
     Me.Width = Me.Width - 180
     End If
     If Me.Height > apiRECT.Bottom / 72 * 1440 - 180 Then
     Me.Height = apiRECT.Bottom / 72 * 1440 - 180
     Me.Height = Me.Height - 180
     End If
  End If

    
    
    
    
    For i = 0 To Controls.Count - 1
      Controls(i).Move ap(i).lp * Form1.ScaleWidth, ap(i).tp * Form1.ScaleHeight, ap(i).wp * Form1.ScaleWidth, ap(i).hp * Form1.ScaleHeight
    Next i
  End If
End Sub
Private Sub Form_Resize()
  If Controls.Count > 0 Then
    Dim i As Integer
    For i = 0 To Controls.Count - 1
      Controls(i).Move ap(i).lp * Form1.ScaleWidth, ap(i).tp * Form1.ScaleHeight, ap(i).wp * Form1.ScaleWidth, ap(i).hp * Form1.ScaleHeight
    Next i
  End If
End Sub

文章来自: 本站原创
引用通告地址: http://www.is21.cn/trackback.asp?tbID=356
Tags: