VBcoders Guest



Don't have an account yet? Register
 


Forgot Password?



This code snippet lets you do the following: -Resize controls in a form (and optionally the font si

by Flavio Gonz¨lez V¨zquez (2 Submissions)
Category: Graphics
Compatability: Visual Basic 5.0
Difficulty: Unknown Difficulty
Originally Published: Mon 9th June 2003
Date Added: Mon 8th February 2021
Rating: (1 Votes)

This code snippet lets you do the following: -Resize controls in a form (and optionally the font size) -Disable form title bar buttons

Rate This code snippet lets you do the following: -Resize controls in a form (and optionally the font si



'                                                '
' 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: [email protected] "
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

Download this snippet    Add to My Saved Code

This code snippet lets you do the following: -Resize controls in a form (and optionally the font si Comments

No comments have been posted about This code snippet lets you do the following: -Resize controls in a form (and optionally the font si. Why not be the first to post a comment about This code snippet lets you do the following: -Resize controls in a form (and optionally the font si.

Post your comment

Subject:
Message:
0/1000 characters