Solved

Vb6 Control Resize  when Form Resize

Posted on 2004-09-02
9
466 Views
Last Modified: 2008-02-01
Hello Brain fart here !!

When I Use this Bas Mocule in a Vb 6 Project, it works almost perfectly.

It resizes Control on the form in proportion to where they were , another words if i max the form the controls stay same size and posisition on the form without using a active x control.

But if i Minimise the form well it crashes hard !!!!!


Code Below
Option Explicit

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 MaxForm As Long
Private MaxControl As Long
Private Function ActualPos(plLeft As Long) As Long
    If plLeft < 0 Then
        ActualPos = plLeft + 75000
    Else
        ActualPos = plLeft
    End If
End Function
Private 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
Private 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
Private 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
Private 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
    On Error GoTo 0
    AddControl = MaxControl
    MaxControl = MaxControl + 1
End Function
Private Function PerWidth(pfrmIn As Form) As Long
Dim i As Long
    i = FindForm(pfrmIn)
    If i < 0 Then
        i = AddForm(pfrmIn)
    End If
    PerWidth = (pfrmIn.ScaleWidth * 100) \ FormRecord(i).ScaleWidth
End Function
Private Function PerHeight(pfrmIn As Form) As Single
Dim i As Long
    i = FindForm(pfrmIn)
    If i < 0 Then
        i = AddForm(pfrmIn)
    End If
    PerHeight = (pfrmIn.ScaleHeight * 100) \ FormRecord(i).ScaleHeight
End Function
Private Sub ResizeControl(inControl As Control, pfrmIn As Form)
Dim i As Long
Dim yRatio, xRatio, lTop, lLeft, lWidth, lHeight As Long
    yRatio = PerHeight(pfrmIn)
    xRatio = PerWidth(pfrmIn)
    i = FindControl(inControl, pfrmIn.Name)
    On Error GoTo Moveit
    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)
    GoTo Moveit
Moveit:
    On Error GoTo MoveError1
    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
        If TypeOf inControl Is Timer Then
            GoTo subExit
        End If
        inControl.Move lLeft, lTop, lWidth, lHeight
    End If
    GoTo subExit
MoveError1:
    On Error GoTo MoveError2
    inControl.Move lLeft, lTop, lWidth
    GoTo subExit
MoveError2:
    On Error GoTo subExit
    inControl.Move lLeft, lTop
subExit:
    On Error GoTo 0
End Sub
Public Sub ResizeForm(pfrmIn As Form)
Dim FormControl As Control
Dim isVisible As Boolean
If pfrmIn.Top < 30000 Then
    isVisible = pfrmIn.Visible
    pfrmIn.Visible = False
    For Each FormControl In pfrmIn
        ResizeControl FormControl, pfrmIn
    Next FormControl
    pfrmIn.Visible = isVisible
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
0
Comment
Question by:Woefman
  • 4
  • 3
  • 2
9 Comments
 
LVL 14

Expert Comment

by:Matti
Comment Utility
Hi!

Try to add there where Resize code begin:

If Me.WindowState = 1 Then exit sub
or in this case:
If pfrmIn.WindowState = 1 Then exit sub


Matti
0
 

Author Comment

by:Woefman
Comment Utility
Wont That Simply Disallow A Minimised Window Then ?
0
 

Author Comment

by:Woefman
Comment Utility
How can i  save a default form size by calling
                    StoreFormPosition Me

How can  i restore a form to its original size or
                 the size that was stored using the StoreFormPosition
                sub by calling
                   RestoreFormPosition Me

and of course useing the module code above,  i think this is why im crashing cause i not sure where to call up these from the form code
0
 
LVL 14

Expert Comment

by:Matti
Comment Utility
>Wont That Simply Disallow A Minimised Window Then ?

It does not effect window position, just won't execute code and saves you from that crash.
If form is minimized controls are not visible and there is no need to scale them.

If you save form size, save it before form is minimised.

Matti
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 1

Expert Comment

by:macaulish
Comment Utility
If Me.WindowState = vbMinimized Then exit sub

It will work.
0
 

Author Comment

by:Woefman
Comment Utility
One last Question: This Code worked Perfectly  " If Me.WindowState = vbMinimized Then exit sub"

I want to be clear  here .

My bas Module does the Control resizing .

But I put this In the FORMS Resize Sub  "If Me.WindowState = vbMinimized Then
exit sub
End if
Exit Sub"
And Underneath This code I have the " ResizeForm Me"   <----Which is The Function in my bas Module


Did I Do this Correctly?  I mean it works but you know its not always if somthing works but rather if it is correctly done .
0
 
LVL 14

Expert Comment

by:Matti
Comment Utility
It's correctly done.
0
 
LVL 1

Accepted Solution

by:
macaulish earned 50 total points
Comment Utility
It's correct but I would code the if then statement on one line like so:

Sub Resize()
    If Me.WindowState = vbMinimized Then exit sub
    ' resize code
end sub

Good luck!
0
 

Author Comment

by:Woefman
Comment Utility
Thank you all, you were all Awesome , you all should not go un recognised as excellent helpers.

to be fair please follow me to my new question which is almost the same topic.

How to allow : Min, Restore, and (X) Close button on a form  "without a user being able to drag the windows size "
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

Suggested Solutions

RIA (Rich Internet Application) tools are interactive internet applications which have many of the characteristics of desktop applications. The RIA tools typically deliver output either by the way of a site-specific browser or via browser plug-in. T…
I know it’s not a new topic to discuss and it has lots of online contents already available over the net. But Then I thought it would be useful to this site’s visitors and can have online repository on vim most commonly used commands. This post h…
In this fifth video of the Xpdf series, we discuss and demonstrate the PDFdetach utility, which is able to list and, more importantly, extract attachments that are embedded in PDF files. It does this via a command line interface, making it suitable …
In this seventh video of the Xpdf series, we discuss and demonstrate the PDFfonts utility, which lists all the fonts used in a PDF file. It does this via a command line interface, making it suitable for use in programs, scripts, batch files — any pl…

763 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now