VB中控件大小随窗体大小变化

香烟吧8

香烟吧8

2016-02-19 21:46

下面是个超简单的VB中控件大小随窗体大小变化教程,图老师小编精心挑选推荐,大家行行好,多给几个赞吧,小编吐血跪求~

  有时窗体变化后,如改变分辨率后控件大小却不能随之改变。手工代码调整实在麻烦,下面的模块实现自动查找窗体上控件并使其改变大小以适应窗体变化。

  在Form的Resize事件中调用函数Resize_All就能实现控件自动调整大小,如:

  Private Sub Form_Resize()
  Dim H, i As Integer
  On Error Resume Next
  Resize_ALL Me 'Me是窗体名,Form1,Form2等等都可以

  End Sub

  在模块中添加以下代码:

  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

  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)

(本文来源于图老师网站,更多请访问https://m.tulaoshi.com/bianchengyuyan/)

  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)

(本文来源于图老师网站,更多请访问https://m.tulaoshi.com/bianchengyuyan/)

  If i 0 Then
  i = AddForm(pfrmIn)
  End If

  PerHeight = (pfrmIn.ScaleHeight * 100) FormRecord(i).ScaleHeight
  End Function

(本文来源于图老师网站,更多请访问https://m.tulaoshi.com/bianchengyuyan/)

  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

  Public Sub ResizeForm(pfrmIn As Form)

  Dim FormControl As Control
  Dim isVisible As Boolean
  Dim StartX, StartY, MaxX, MaxY As Long
  Dim bNew As Boolean

  If Not bRunning Then
  bRunning = True

  If FindForm(pfrmIn) 0 Then
   bNew = True
  Else
   bNew = False
  End If
  If pfrmIn.Top 30000 Then
   isVisible = pfrmIn.Visible
   On Error Resume Next
   If Not pfrmIn.MDIChild Then
    On Error GoTo 0
    ' ' pfrmIn.Visible = False
   Else

    If bNew Then
     StartY = pfrmIn.Height
     StartX = pfrmIn.Width
     On Error Resume Next
     For Each FormControl In pfrmIn
      If FormControl.Left + FormControl.Width + 200 MaxX Then
       MaxX = FormControl.Left + FormControl.Width + 200
      End If

      If FormControl.Top + FormControl.Height + 500 MaxY Then
       MaxY = FormControl.Top + FormControl.Height + 500
      End If

      If FormControl.X1 + 200 MaxX Then
       MaxX = FormControl.X1 + 200
      End If

      If FormControl.Y1 + 500 MaxY Then
       MaxY = FormControl.Y1 + 500
      End If

      If FormControl.X2 + 200 MaxX Then
       MaxX = FormControl.X2 + 200
      End If

      If FormControl.Y2 + 500 MaxY Then
       MaxY = FormControl.Y2 + 500
      End If

     Next FormControl

     On Error GoTo 0
     pfrmIn.Height = MaxY
     pfrmIn.Width = MaxX
    End If

    On Error GoTo 0
   End If

   For Each FormControl In pfrmIn
    ResizeControl FormControl, pfrmIn
   Next FormControl

   On Error Resume Next

   If Not pfrmIn.MDIChild Then
    On Error GoTo 0
    pfrmIn.Visible = isVisible
   Else

    If bNew Then
    pfrmIn.Height = StartY
    pfrmIn.Width = StartX

    For Each FormControl In pfrmIn
     ResizeControl FormControl, pfrmIn
    Next FormControl

   End If
  End If
  On Error GoTo 0
  End If
  bRunning = False
  End If

  End Sub

  Public Sub SaveFormPosition(pfrmIn As Form)

  Dim i As Long

  If MaxForm 0 Then

  For i = 0 To (MaxForm - 1)

   If FormRecord(i).Name = pfrmIn.Name Then

    FormRecord(i).Top = pfrmIn.Top
    FormRecord(i).Left = pfrmIn.Left
    FormRecord(i).Height = pfrmIn.Height
    FormRecord(i).Width = pfrmIn.Width
    Exit Sub
   End If
  Next i

  AddForm (pfrmIn)
  End If
  End Sub

  Public Sub RestoreFormPosition(pfrmIn As Form)

  Dim i As Long
  If MaxForm 0 Then
  For i = 0 To (MaxForm - 1)
   If FormRecord(i).Name = pfrmIn.Name Then
    If FormRecord(i).Top 0 Then
     pfrmIn.WindowState = 2
    ElseIf FormRecord(i).Top 30000 Then
     pfrmIn.WindowState = 0
     pfrmIn.Move FormRecord(i).Left, FormRecord(i).Top, FormRecord(i).Width, FormRecord(i).Height
    Else
     pfrmIn.WindowState = 1
    End If
     Exit Sub
   End If
  Next i
  End If
  End Sub

  Public Sub Resize_ALL(Form_Name As Form)

  Dim OBJ As Object
  For Each OBJ In Form_Name
  ResizeControl OBJ, Form_Name
  Next OBJ
  End Sub

  Public Sub DragForm(frm As Form)

  On Local Error Resume Next
  Call ReleaseCapture
  Call SendMessage(frm.hwnd, WM_NCLBUTTONDOWN, 2, 0)

  End Sub

展开更多 50%)
分享

猜你喜欢

VB中控件大小随窗体大小变化

编程语言 网络编程
VB中控件大小随窗体大小变化

怀孕50天孕囊大小 孕囊大小有变化

孕囊 怀孕 孕妇
怀孕50天孕囊大小 孕囊大小有变化

s8lol主宰符文怎么配

英雄联盟 网络游戏
s8lol主宰符文怎么配

jquery BS,dialog控件自适应大小

Web开发
jquery BS,dialog控件自适应大小

在ActiveX控件中引入窗体技术

编程语言 网络编程
在ActiveX控件中引入窗体技术

lol偷钱流符文搭配推荐

英雄联盟 网络游戏
lol偷钱流符文搭配推荐

操作VB中的无边框窗体

编程语言 网络编程
操作VB中的无边框窗体

VC中自动改变控件位置和大小的对话框类

编程语言 网络编程
VC中自动改变控件位置和大小的对话框类

lolAD刺客新符文搭配推荐

英雄联盟
lolAD刺客新符文搭配推荐

关于在AJAX中GET回的ResponseText中文乱码的最简解决办法

关于在AJAX中GET回的ResponseText中文乱码的最简解决办法

1场如痴如醉的梦.让我变的如此迷茫.

1场如痴如醉的梦.让我变的如此迷茫.
下拉加载更多内容 ↓