'------------------------------------------------'
' '
' RESIZE FORM MODULE © by Flavio González '
' Vázquez 2002 '
' '
' Use this module to advance resize controls '
' operation in VB forms. '
' '
' http://home3.worldonline.es/flaviogv '
' '
' flaviogv@ worldonline.es '
' '
'------------------------------------------------'
Dim
X(), Y(), W(), H(), Contador, Ancho, Alto
'*************
Option Explicit
Private Declare Function
GetSystemMenu Lib
"user32" (ByVal
hwnd As Long
, ByVal
bRevert As Long
) As Long
Private Declare Function
DeleteMenu Lib
"user32" (ByVal
hMenu As Long
, ByVal
nPosition As Long
, ByVal
wFlags As Long
) As Long
Private Const
MF_BYPOSITION = &H400&
Private Const
MF_BYCOMMAND = &H0&
Private Const
SC_CLOSE = &HF060&
Public Const
SC_MAXIMIZE = &HF030&
Public Const
SC_MINIMIZE = &HF020&
Enum
BarButton
QuitButton = 0
MaxButton = 1
MinButton = 2
End Enum
'************
Public
ResizeFontV As Boolean
Public Sub
ResizeControls(Window As
Form)
On Error Resume Next
Dim
n
For
n = 0 To
Contador
Window.Controls(n).Left = (X(n) * Window.Width) / Ancho
Window.Controls(n).Width = (W(n) * Window.Width) / Ancho
Window.Controls(n).Top = (Y(n) * Window.Height) / Alto
Window.Controls(n).Height = (H(n) * Window.Height) / Alto
If
ResizeFontV = True Then
Window.Controls(n).FontSize = Int(Window.Controls(n).Height / 50)
End If
Next
End Sub
Public Sub
SetControlsPositions(Window As
Form)
On Error Resume Next
Dim
n, ControlX, ControlY, ControlW, ControlH, ControlName
Contador = Window.Controls.Count - 1
ReDim
X(Contador), Y(Contador), W(Contador), H(Contador)
For
n = 0 To
Window.Controls.Count - 1
ControlX = Window(n).Left
ControlY = Window(n).Top
ControlW = Window(n).Width
ControlH = Window(n).Height
ControlName = Window(n).Name
X(n) = ControlX
Y(n) = ControlY
W(n) = ControlW
H(n) = ControlH
Next
Ancho = Window.Width
Alto = Window.Height
End Sub
Public Sub
DisableBarButton(Window As
Form, Button As
BarButton)
Dim
systemmenu As Long
systemmenu = GetSystemMenu(Window.hwnd, False
)
Select Case
Button
Case
0
DeleteMenu systemmenu, SC_CLOSE, MF_BYCOMMAND
Case
1
DeleteMenu systemmenu, SC_MAXIMIZE, MF_BYCOMMAND
Case
2
DeleteMenu systemmenu, SC_MINIMIZE, MF_BYCOMMAND
End Select
End Sub
Public Sub
ResizeForm(Window As
Form, Width, Height)
Window.Width = Width
Window.Height = Height
End Sub
Public Sub
ResizeFont(Value As Boolean
)
ResizeFontV = Value
End Sub
Public Sub
AbleAll(Window As
Form, Enable As Boolean
)
On Error Resume Next
Dim
n
For
n = 0 To
Window.Controls.Count - 1
Window(n).Enabled = Enable
Next
End Sub
Public Sub
CreateBackground(Window As
Form, ImagePath As String
, Resizable As Boolean
)
On Error GoTo
ControlError
With
Window.Controls.Add("VB.Image", "imgFGVBackground")
.Picture = LoadPicture(ImagePath)
.Stretch = Resizable
.Visible = True
End With
ControlError:
Select Case
Err.Number
Case
727
MsgBox "Background already exists. You don't able to create more than one background simultaneouly", vbCritical, "Runtime Error on Module"
Case
53
MsgBox "The image " & ImagePath & " don't exists or is wrong.", vbCritical, "Runtime Error on Module"
End Select
End Sub
Public Sub
ResizeBackground(Window As
Form)
If
Window(Window.Controls.Count - 1).Name <> "imgFGVBackground" Then Exit Sub
Window(Window.Controls.Count - 1).Move 0, 0, Window.ScaleWidth, Window.ScaleHeight
End Sub
Public Sub
VisibleControls(Window As
Form, Visible As Boolean
)
On Error Resume Next
Dim
n
For
n = 0 To
Window.Controls.Count - 1
Window(n).Visible = Visible
Next
End Sub
Public Sub
AboutModule(FormToShow As
Form)
Dim
message, message2, antcaption, antheight
antcaption = FormToShow.Caption
antheight = FormToShow.Height
FormToShow.Height = 0
message = "ResizeModule © by Flavio González Vázquez 2003 Web: http://home3.worldonline.es/flaviogv E-Mail: flavio@ya.com"
message2 = Space(Len(message) / 1.5) & message
FormToShow.Refresh
Dim
n
For
n = 1 To
Len(message2)
FormToShow.Caption = Mid(message2, n, Len(message2) / 2)
Wait 500000
Next
FormToShow.Caption = antcaption
FormToShow.Height = antheight
End Sub
Private Sub
Wait(Points)
Dim
n
For
n = 0 To
Points
Next
DoEvents
End Sub