[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
Solved

Keep aspect ratio VB6

Posted on 2009-04-21
Medium Priority
1,313 Views
I am trying to make a Picturebox to keep the aspect ratio on a Form when Form resize.
I am not loading Image on the PictureBox. The Picturebox has Width = 360 and Height = 180,
when I make the Form wider or taller the Picturebox should size with the Form and always have same aspect ratio between Width and Height.
Code in Visual Basic 6
0
Question by:iscode
• 7
• 4
• 4
• +1

LVL 86

Assisted Solution

Mike Tomlinson earned 80 total points
ID: 24201115
You could do something like this:
(this locks the picturebox to changes in WIDTH of the form)
``````Option Explicit

Private pbWidthPercentage As Double
Private pbAspectRatio As Double

pbWidthPercentage = Me.Picture1.Width / Me.Width
pbAspectRatio = Me.Picture1.Height / Me.Picture1.Width
End Sub

Private Sub Form_Resize()
Me.Picture1.Width = Me.Width * pbWidthPercentage
Me.Picture1.Height = Me.Picture1.Width * pbAspectRatio
End Sub
``````
0

LVL 6

Author Comment

ID: 24203069
When I pull the form on the width to make it bigger the picturebox grow and is not all visible,
how can I prevent this?
0

LVL 5

Expert Comment

ID: 24204672
Hi IsCode,
I suspect a Picturebox can't "stretch" (resize) its image..
You might need to use an Imagebox instead (it can)
Set the Imagebox "Stretch" option = True
You might also need to set the forms :AutoRedraw option to True..
0

LVL 16

Expert Comment

ID: 24204681
Some how, determine what is the maximum width of the form.  Then in the form resize event, don't allow the form to get larger than the calculated maximum width.
``````Private Sub Form_Resize()
If Me.Width > m_CalculatedMaximum Then
Me.Width = m_CalculatedMaximum
End If
End Sub
``````
0

LVL 6

Author Comment

ID: 24204884
Idle mind solution is in right path.

BrianVSoft:
Imagebox is not an option.

HooKooDooKu:
I dont want to control the Form size,

I want to restrict the Picturebox to keep aspect ratio but be all visible and resize on Form resize.
0

LVL 86

Expert Comment

ID: 24205214
It should always be visible width-wise...are you saying you want it to become shorter and adjust the width instead if necessary?
0

LVL 6

Author Comment

ID: 24205613
Yes it (the picturebox) should always be visible width-wise and height-wise
0

LVL 6

Author Comment

ID: 24205640
if I shrink or pull the form width-wise or height-wise the picturebox should be visible but keep aspect ratio
0

LVL 16

Expert Comment

ID: 24205788
Then what you really need to do is when the form resizes, determine the maximum height of the picturebox that will still fit in the form, and the maximum width of the picturebox that will still fit in the form.  Then determine the ratio of the maximums.  If the ratio is greater than the desired ratio, use the maximum heigth of the picturebox, and adjust the width to maintain the desired ratio, but if the ratio is less than the desired ratio, use the maximum width of the picturebox, and adjust the height to maintain the desired ratio.

``````protected m_Ratio as Double = 1.5 'Width is 1.5 times the height
Private Sub Form_Resize()
Dim MaxWidth as Integer
Dim MaxHeigth as Integer
Dim Ratio as Double

MaxWidth = Form.Width - m_FormWidthNotDevotedToPictureBox
MaxHeight = Form.Height - m_FormHeightNotDevotedToPictureBox
Ratio = CDbl( MaxWidth ) / CDbl( MaxHeight )
if Ratio < m_Ratio then
PictureBox.Width = MaxWidth
PictureBox.Height = CInt( CDbl( MaxWidth ) / m_Ratio )
else
PictureBox.Height = MaxHeight
PictureBox.Width = CInt( CDbl( MaxHeight ) * m_Ratio )
endif
end sub

``````
0

LVL 86

Expert Comment

ID: 24205986
I like HooKooDooKu's approach.

Here is another:
(untested as I don't have VB6 on this machine)
``````Option Explicit

Private pbWidthPercentage As Double
Private pbHeightPercentage As Double
Private pbAspectRatio As Double

pbWidthPercentage = Me.Picture1.Width / Me.Width
pbHeightPercentage = Me.Picture1.Height / Me.Height
pbAspectRatio = Me.Picture1.Height / Me.Picture1.Width
End Sub

Private Sub Form_Resize()
Me.Picture1.Width = Me.Width * pbWidthPercentage
Me.Picture1.Height = Me.Picture1.Width * pbAspectRatio
If Me.Picture1.Height > Me.Height Then
Me.Picture1.Height = Me.Height * pbHeightPercentage
Me.Picture1.Width = Me.Picture1.Height / pbAspectRatio
End If
End Sub
``````
0

LVL 6

Author Comment

ID: 24206071
HooKooDooKu:
I get error on first line :
protected m_Ratio as Double = 1.5 'Width is 1.5 times the height
0

LVL 16

Accepted Solution

HooKooDooKu earned 200 total points
ID: 24207672
Sorry, I'm going more C++ than VB coding right now.
replace "protected" with 'Private' to declare a module level variable that is accessable only from within the form.

Other wise, realize the example to just a concept example, not code to actually run (unless it just so happens that the desired width to height ratio you want is 1.5).  Even then, you still have to deal with comming up with your own value for m_FormWidthNotDevotedToPictureBox and m_FormHeightNotDevotedToPictureBox. Idle_Mind's basic approach is to record the percentage of the form the picture box is using so that the picture box scales as a percentage of the form size.

Normally, the way I have programmed such a thing, I would place my PictureBox in the bottom right-hand corner of the form, and as the form grows/shrinks only the picturebox changes sizes with the window.  In which case, during the Form_Load event, I would record how much space there was between the edge of the picture box and the edge of the form, and use that to determine max values.  Something along the lines of the following snippet.
``````private m_Ratio as Double
private m_DeltaWidth as integer
private m_DeltaHeigth as integer

m_DeltaWidth = Form1.Width - PictureBox1.Left - PictureBox1.Width
m_DeltaHeigth = Form1.Heigth - PictureBox1.Top - PictureBox1.Heigth
End Sub
Private Sub Form1_Resize()
Dim MaxWidth as Integer
Dim MaxHeigth as Integer
Dim Ratio as Double

MaxWidth = Form1.Width - PictureBox1.Left - m_DeltaWidth
MaxHeight = Form1.Heigth - PictureBox1.Top - m_DeltaHeight
Ratio = CDbl( MaxWidth ) / CDbl( MaxHeight )
If Ratio < m_Ratio Then
PictureBox1.Width = MaxWidth
PictureBox1.Height = CInt( CDbl( MaxWidth ) / m_Ratio )
Else
PictureBox1.Height = MaxHeight
PictureBox1.Width = CInt( CDbl( MaxHeight ) * m_Ratio )
EndIf
end sub
``````
0

LVL 86

Expert Comment

ID: 24208013
On a side note...this type of thing is SUPER easy in .Net.  Have you considered moving up to VB.Net?  There is the free Express version...
0

LVL 6

Author Comment

ID: 24208296
HooKooDooKu:
Would you put m_Ratio=1.5 in Form_Load ?

Idle_Mind:
Yes I will need to move on to VB.Net soon  :-)
0

LVL 16

Expert Comment

ID: 24208591
Yes, I left setting the ratio out of Form1_Load().  Ment to include the following:

m_Ratio = CDbl( PictureBox1.Width ) / CDbl( PictureBox1.Height )

That way, the ratio and position as setup in the IDE is maintained rather than hardcoding a ratio.
0

LVL 6

Author Comment

ID: 24213956
I think this is absolute solid solution HooKooDooKu, great programming!

I have to award Idle_Mind for his work too because I forgot to mention in topic that the solution had to
have picturebox visible at resize.

Thank you guys
0

Featured Post

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). Uâ€¦
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This lâ€¦
Suggested Courses
Course of the Month20 days, 3 hours left to enroll