| 投稿日 | ： 2007/03/05(Mon) 14:24 |
| 投稿者 | ： ダンボ |
| Ｅメール | ： |
| ＵＲＬ | ： |
| タイトル | ： Re^3: ユーザーコントロールがある場合には？ |
Me.Controlですべてのコントロールは含まれていました。ダンボの予想はハズレです。
ガッ さんのコードでは、コントロール内のコントロール座標計算が誤りになりますので下記のように改良しました。
(本当はこれだけでは不十分で、階層の上の方から再配置しないと)
'-------Class1
Option Explicit
Public csControl As Control
Public csParent As Control
Public csLeft As Double
Public csTop As Double
Public csWidth As Double
Public csHeight As Double
Public csFontSize As Double
'-------Form1
Option Explicit
Private Clipped As Boolean
Private ctls As Collection
Private clpScaleWidth As Double
Private clpScaleHeight As Double
Private Sub Form_Load()
Call ClipControl
End Sub
Private Function ClipControl()
'コントロールの現在の状態をクリップする
Dim ctl As Control
Dim ctlst As Class1
On Error Resume Next
Set ctls = New Collection
clpScaleWidth = Me.ScaleWidth
clpScaleHeight = Me.ScaleHeight
For Each ctl In Me.Controls
Set ctlst = New Class1
With ctlst
Set .csControl = ctl
Set .csParent = ctl.Parent
.csLeft = ctl.Left
.csTop = ctl.Top
.csWidth = ctl.Width
.csHeight = ctl.Height
.csFontSize = ctl.FontSize
End With
Call ctls.Add(ctlst)
Next
Clipped = True
End Function
Private Sub Form_Resize()
'クリップしたコントロールをリサイズする
Dim ctlst As Class1
Dim ratScaleWidth As Double
Dim ratScaleHeight As Double
If Clipped Then
On Error Resume Next
'水平、垂直方向の拡大率を決定する
ratScaleWidth = Me.ScaleWidth / clpScaleWidth
ratScaleHeight = Me.ScaleHeight / clpScaleHeight
'それぞれのコントロールを拡大する
For Each ctlst In ctls
With ctlst
.csControl.Top = .csTop * ratScaleHeight + .csParent.Top
.csControl.Left = .csLeft * ratScaleWidth + .csParent.Left
.csControl.Width = .csWidth * ratScaleWidth
.csControl.Height = .csHeight * ratScaleHeight
.csControl.FontSize = .csFontSize * ratScaleWidth 'フォントサイズの拡大幅は適当です
End With
Next
End If
End Sub