Hej Peter (og andre).
Jeg har også bokset en hel del med dette i VB6, men har for et års tid siden
fået skrevet en klasse (gengivet nedenfor), der gør det meste af arbejdet
for mig.
Fidusen er at lade en formular delegere sin resize-event videre til klassen,
der så resizer-kontrollerne, som specificeret.
Den kan bruges sådan:
Private fTool as clsFormTools
Private Sub Form_Load()
Set fTool = New clsFormTools
With fTool ' Dovenskab - jeg gider ikke skrive det i hver linie
Set .Owner = Me ' Delegér events fra Formen til Klassen
' Angiv hvilke kontroller der skal resizes og hvordan
.MoveOnResize Me.lblTekst, mdTopLeft ' Flyt lodret/vandret
.MoveOnResize Me.txtTekstBox, , sdWidth
End With
End Sub
- parametrene til MoveOnResize vises automatisk, når du bruger den.
Klassen gør iøvrigt en anden ting (der har irriteret mig i VB) - den
"husker" automatisk hvor på skærmen brugeren efterlod formularen (samt i
hvilken
størrelse).
Jeg beklager, at jeg kun har kunnet finde en gl. version - den aktuelle kan
også håndtere min/max størrelser på formen, men det er ret enkelt at lægge
ind.
For mit eget vedkommende, så bruger jeg denne klasse hver gang jeg har en
formular (også selvom den ikke kan resizes), hvilket sparer en utroligt
masse kodearbejde.
God fornøjelse (hvis du altså kan bruge den)
Claus H.
Her er kildeteksten til klassen:
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "clsFormTools"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Public Enum MoveDirection
mdTop
mdLeft
mdTopLeft
mdNone
End Enum
Public Enum SizeDirection
sdHeight
sdWidth
sdHeightWidth
sdNone
End Enum
Private Type typCtrlsToMove
Ctrl As Control
Move As MoveDirection
Size As SizeDirection
ColIX As Long
End Type
Private CtrlsToMove() As typCtrlsToMove
Private CtrlsCount As Long
Private WithEvents mOwner As Form
Attribute mOwner.VB_VarHelpID = -1
Private mSavePos As Boolean
Private fW As Long, fH As Long
Private bW As Long, bH As Long
Public Sub MoveOnResize(Ctrl As Control, Optional cMove As MoveDirection =
mdNone, Optional cSize As SizeDirection = sdNone, Optional ColumnIX As Long)
Dim IX As Long, cIX As Long
Dim ErNy As Boolean
Dim dW As Long, dH As Long
' Se om kontrollen evt. findes i forvejen
If CtrlsCount < 1 Then
ErNy = True
Else
ErNy = True
For IX = 1 To CtrlsCount
If CtrlsToMove(IX).Ctrl Is Ctrl Then
cIX = IX
ErNy = False
Exit For
End If
Next IX
End If
If ErNy Then
CtrlsCount = CtrlsCount + 1
If CtrlsCount > UBound(CtrlsToMove) Then
ReDim Preserve CtrlsToMove(CtrlsCount + 9)
End If
cIX = CtrlsCount
End If
With CtrlsToMove(cIX)
Set .Ctrl = Ctrl
.Move = cMove
.Size = cSize
End With
If ErNy Then
dW = mOwner.Width - bW
dH = mOwner.Height - bH
With CtrlsToMove(cIX)
If .Move = mdLeft Or .Move = mdTopLeft Then
.Ctrl.Left = .Ctrl.Left + dW
End If
If .Move = mdTop Or .Move = mdTopLeft Then
.Ctrl.Top = .Ctrl.Top + dH
End If
If .Size = sdHeight Or .Size = sdHeightWidth Then
.Ctrl.Height = .Ctrl.Height + dH
End If
If .Size = sdWidth Or .Size = sdHeightWidth Then
.Ctrl.Width = .Ctrl.Width + dW
End If
If IsMissing(ColumnIX) Then
.ColIX = -1
Else
.ColIX = ColumnIX
End If
End With
End If
End Sub
Public Property Let SavePos(vData As Boolean)
mSavePos = vData
End Property
Public Property Get SavePos() As Boolean
SavePos = mSavePos
End Property
Public Property Set Owner(vData As Form)
Set mOwner = vData
fW = mOwner.Width
fH = mOwner.Height
bW = fW
bH = fH
DoLoadPos
End Property
Public Property Get Owner() As Form
Set Owner = mOwner
End Property
Private Sub Class_Initialize()
mSavePos = True
ReDim CtrlsToMove(10)
End Sub
Private Sub mOwner_Load()
fW = mOwner.Width
fH = mOwner.Height
DoLoadPos
End Sub
Private Sub mOwner_Resize()
Dim dW As Long, dH As Long
Dim IX As Long
dW = mOwner.Width - fW
dH = mOwner.Height - fH
For IX = 1 To CtrlsCount
With CtrlsToMove(IX)
If .Move = mdLeft Or .Move = mdTopLeft Then
.Ctrl.Left = .Ctrl.Left + dW
End If
If .Move = mdTop Or .Move = mdTopLeft Then
.Ctrl.Top = .Ctrl.Top + dH
End If
If .Size = sdHeight Or .Size = sdHeightWidth Then
.Ctrl.Height = .Ctrl.Height + dH
End If
If .Size = sdWidth Or .Size = sdHeightWidth Then
.Ctrl.Width = .Ctrl.Width + dW
If .ColIX >= 0 Then
On Error Resume Next
' Resize af individuelle kolonner!
' Flexgrid:
If .Ctrl.ColWidth(.ColIX) + dW > 0 Then
.Ctrl.ColWidth(.ColIX) = .Ctrl.ColWidth(.ColIX) + dW
Else
.Ctrl.ColWidth(.ColIX) = 0
End If
End If
End If
End With
Next IX
fW = mOwner.Width
fH = mOwner.Height
End Sub
Private Sub mOwner_Unload(Cancel As Integer)
DoSavePos
End Sub
Private Sub DoLoadPos()
mOwner.Top = GetSetting(App.EXEName, mOwner.Name, "Top", mOwner.Top)
mOwner.Left = GetSetting(App.EXEName, mOwner.Name, "Left", mOwner.Left)
Select Case mOwner.BorderStyle
Case vbSizable, vbSizableToolWindow
mOwner.Width = GetSetting(App.EXEName, mOwner.Name, "Width",
mOwner.Width)
mOwner.Height = GetSetting(App.EXEName, mOwner.Name, "Height",
mOwner.Height)
mOwner.WindowState = GetSetting(App.EXEName, mOwner.Name,
"WindowState", mOwner.WindowState)
End Select
End Sub
Private Sub DoSavePos()
SaveSetting App.EXEName, mOwner.Name, "Top", mOwner.Top
SaveSetting App.EXEName, mOwner.Name, "Left", mOwner.Left
Select Case mOwner.BorderStyle
Case vbSizable, vbFixedToolWindow
SaveSetting App.EXEName, mOwner.Name, "Width", mOwner.Width
SaveSetting App.EXEName, mOwner.Name, "Height", mOwner.Height
SaveSetting App.EXEName, mOwner.Name, "WindowState",
mOwner.WindowState
End Select
End Sub
|