Hello.
I've been searching for help on this topic and I found and read entirely this helpful thread: http://www.vbforums.com/showthread.p...extboxes/page2.
In answer #67, user MarkT posted an OCX object called Resizer, which I implemented and works perfectly, it even resize fonts, sstabs and it's content (which are difficult to resize or relocate). In the bottom of this post I'm pasting MarkT's original OCX code.
I was saying, it works perfectly for adapting your form to a bigger screen. But the only problem I have is adapting my form to a smaller screen, basically because VB6 itself resize the form to 'fit' the screen, and part of it is lost.
An example.
This is the original form, in a big screen resolution, without resizing anything (OCX does nothing there)
![Name: 1.JPG
Views: 16
Size: 94.7 KB]()
Now, to that I apply resizing in Form_Initialize sub:
And OCX does its trick and you got:
![Name: 2.JPG
Views: 16
Size: 81.9 KB]()
(It works like a charm).
But now, I change my screen resolution to be smaller than the form.
I run it without any resizing, and I get:
![Name: 3.JPG
Views: 18
Size: 44.2 KB]()
(you can't see the frame in the right, and look at the numbers in the bottom)
Now I apply the same resizing code as above, and I get:
![Name: 4.JPG
Views: 16
Size: 50.3 KB]()
I swear, I've tried A LOT of things, I can't restore the lost content. As I said, I think it is because VB6 itself resize the form to 'fit' the screen, and part of it is lost.
The code of the OCX by shragel is:
Module LimitResize.bas:
(As I said, this OCX was posted by MarkT in the mentioned thread, I don't know if he actually made it)
I've been searching for help on this topic and I found and read entirely this helpful thread: http://www.vbforums.com/showthread.p...extboxes/page2.
In answer #67, user MarkT posted an OCX object called Resizer, which I implemented and works perfectly, it even resize fonts, sstabs and it's content (which are difficult to resize or relocate). In the bottom of this post I'm pasting MarkT's original OCX code.
I was saying, it works perfectly for adapting your form to a bigger screen. But the only problem I have is adapting my form to a smaller screen, basically because VB6 itself resize the form to 'fit' the screen, and part of it is lost.
An example.
This is the original form, in a big screen resolution, without resizing anything (OCX does nothing there)
Now, to that I apply resizing in Form_Initialize sub:
Code:
Margen = 500
Prop = Me.Width / Me.Height
Me.Move 0, 0, (Screen.Height - Margen) * Prop, Screen.Height - Margen(It works like a charm).
But now, I change my screen resolution to be smaller than the form.
I run it without any resizing, and I get:
(you can't see the frame in the right, and look at the numbers in the bottom)
Now I apply the same resizing code as above, and I get:
I swear, I've tried A LOT of things, I can't restore the lost content. As I said, I think it is because VB6 itself resize the form to 'fit' the screen, and part of it is lost.
The code of the OCX by shragel is:
Code:
Option Explicit
Dim WithEvents ControlParent As Form
Private Type CtlStats
tName As String
tLeft As Single
tTop As Single
tWidth As Single
tHeight As Single
tFontSize As Single
tX1 As Single
tX2 As Single
tY1 As Single
tY2 As Single
End Type
Dim Stats() As CtlStats
' Control properties
Dim m_ResizeEnabled As Boolean
Dim m_ResizeFont As Boolean
Dim m_MinFormHeight As Integer
Dim m_MinFormWidth As Integer
Dim m_MaxFormHeight As Integer
Dim m_MaxFormWidth As Integer
Dim m_LimitFormSize As Boolean
Public Event ResizeComplete()
Public Property Get LimitFormSize() As Boolean
LimitFormSize = m_LimitFormSize
End Property
Public Property Let LimitFormSize(ByVal New_LimitFormSize As Boolean)
m_LimitFormSize = New_LimitFormSize
PropertyChanged "LimitFormSize"
End Property
Public Property Get MaxFormWidth() As Integer
MaxFormWidth = m_MaxFormWidth
End Property
Public Property Let MaxFormWidth(ByVal New_MaxFormWidth As Integer)
m_MaxFormWidth = New_MaxFormWidth
PropertyChanged "MaxFormWidth"
End Property
Public Property Get MaxFormHeight() As Integer
MaxFormHeight = m_MaxFormHeight
End Property
Public Property Let MaxFormHeight(ByVal New_MaxFormHeight As Integer)
m_MaxFormHeight = New_MaxFormHeight
PropertyChanged "MaxFormHeight"
End Property
Public Property Get MinFormWidth() As Integer
MinFormWidth = m_MinFormWidth
End Property
Public Property Let MinFormWidth(ByVal New_MinFormWidth As Integer)
m_MinFormWidth = New_MinFormWidth
PropertyChanged "MinFormWidth"
End Property
Public Property Get MinFormHeight() As Integer
MinFormHeight = m_MinFormHeight
End Property
Public Property Let MinFormHeight(ByVal New_MinFormHeight As Integer)
m_MinFormHeight = New_MinFormHeight
PropertyChanged "MinFormHeight"
End Property
Public Property Get ResizeEnabled() As Boolean
ResizeEnabled = m_ResizeEnabled
End Property
Public Property Let ResizeEnabled(New_ResizeEnabled As Boolean)
m_ResizeEnabled = New_ResizeEnabled
PropertyChanged "ResizeEnabled"
End Property
Public Property Get ResizeFont() As Boolean
ResizeFont = m_ResizeFont
End Property
Public Property Let ResizeFont(New_ResizeFont As Boolean)
m_ResizeFont = New_ResizeFont
PropertyChanged "ResizeFont"
End Property
Private Sub ControlParent_Resize()
ResizeControls
End Sub
Private Sub ControlParent_Unload(Cancel As Integer)
Dim retval As Long
If LimitFormSize Then
' Restore the window's procedure before closing.
retval = SetWindowLong(frm.hWnd, GWL_WNDPROC, pOldProc)
End If
End Sub
Private Sub UserControl_InitProperties()
ResizeEnabled = True
ResizeFont = True
MinFormWidth = Round(Screen.Width / 500) * 100
MinFormHeight = Round(Screen.Height / 500) * 100
MaxFormWidth = Round(Screen.Width / 100) * 100
MaxFormHeight = Round(Screen.Height / 100) * 100
DoesExist
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
LimitFormSize = PropBag.ReadProperty("LimitFormSize", False)
MaxFormWidth = PropBag.ReadProperty("MaxFormWidth", 32000)
MaxFormHeight = PropBag.ReadProperty("MaxFormHeight", 32000)
MinFormWidth = PropBag.ReadProperty("MinFormWidth", 100)
MinFormHeight = PropBag.ReadProperty("MinFormHeight", 100)
ResizeEnabled = PropBag.ReadProperty("ResizeEnabled", True)
ResizeFont = PropBag.ReadProperty("ResizeFont", True)
If Ambient.UserMode Then
Set ControlParent = UserControl.Parent
If LimitFormSize Then
Set frm = UserControl.Parent
MaxFH = m_MaxFormHeight
MaxFW = m_MaxFormWidth
MinFH = m_MinFormHeight
MinFW = m_MinFormWidth
End If
End If
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
PropBag.WriteProperty "LimitFormSize", m_LimitFormSize, False
PropBag.WriteProperty "MaxFormWidth", m_MaxFormWidth, 32000
PropBag.WriteProperty "MaxFormHeight", m_MaxFormHeight, 32000
PropBag.WriteProperty "MinFormWidth", m_MinFormWidth, 0
PropBag.WriteProperty "MinFormHeight", m_MinFormHeight, 0
PropBag.WriteProperty "ResizeEnabled", m_ResizeEnabled, True
PropBag.WriteProperty "ResizeFont", m_ResizeFont, True
End Sub
Private Sub ControlParent_Load()
'ControlParent.Show
'MsgBox "Antes de cambiar"
'ControlParent.Move 0, 0,
'ControlParent.Height = 11520
'ControlParent.Width =
'frm.Refresh
'MsgBox "Cambié"
GetStats
If LimitFormSize Then
' Set the new window procedure for Form1, saving a pointer to the old one.
pOldProc = SetWindowLong(frm.hWnd, GWL_WNDPROC, AddressOf WindowProc)
End If
End Sub
Private Sub GetStats()
Dim ctl As Control
Dim i As Integer
On Error Resume Next
For Each ctl In ControlParent.Controls
ReDim Preserve Stats(i)
Stats(i).tHeight = ctl.Height / ControlParent.ScaleHeight
Stats(i).tLeft = ctl.Left / ControlParent.ScaleWidth
Stats(i).tTop = ctl.Top / ControlParent.ScaleHeight
Stats(i).tWidth = ctl.Width / ControlParent.ScaleWidth
Stats(i).tName = ctl.Name
Stats(i).tFontSize = ctl.Font.Size / ControlParent.ScaleHeight
Stats(i).tX1 = ctl.X1 / ControlParent.ScaleWidth
Stats(i).tX2 = ctl.X2 / ControlParent.ScaleWidth
Stats(i).tY1 = ctl.Y1 / ControlParent.ScaleHeight
Stats(i).tY2 = ctl.Y2 / ControlParent.ScaleHeight
i = i + 1
Next ctl
End Sub
Private Sub ResizeControls()
Dim ctl As Control
Dim i As Integer
On Error Resume Next
For i = 0 To UBound(Stats)
Set ctl = ControlParent.Controls.Item(i)
If InStr(UCase(ctl.Tag), "CONTROLRESIZE=FALSE") = 0 Then
ctl.Left = ControlParent.ScaleWidth * Stats(i).tLeft
ctl.Width = ControlParent.ScaleWidth * Stats(i).tWidth
ctl.Top = ControlParent.ScaleHeight * Stats(i).tTop
ctl.Height = ControlParent.ScaleHeight * Stats(i).tHeight
ctl.X1 = ControlParent.ScaleWidth * Stats(i).tX1
ctl.X2 = ControlParent.ScaleWidth * Stats(i).tX2
ctl.Y1 = ControlParent.ScaleHeight * Stats(i).tY1
ctl.Y2 = ControlParent.ScaleHeight * Stats(i).tY2
If ResizeFont Then
If InStr(UCase(ctl.Tag), "FONTRESIZE=FALSE") = 0 Then
ctl.Font.Size = ControlParent.ScaleHeight * Stats(i).tFontSize
End If
End If
End If
Set ctl = Nothing
Next i
RaiseEvent ResizeComplete
End Sub
Private Sub UserControl_Resize()
UserControl.Width = 495
UserControl.Height = 495
End Sub
Private Function DoesExist() As Boolean
Dim ctl As Control
Dim i As Integer
Dim strmess As String
For Each ctl In UserControl.Parent.Controls
If TypeOf ctl Is Resizer Then
i = i + 1
End If
Next ctl
If i > 1 Then
strmess = "Placing more than one Resizer Control on a form can cause "
strmess = strmess & "your application" & vbCrLf & "crash. Because of "
strmess = strmess & "this, the second Resizer Control will not be added."
MsgBox strmess, vbCritical, "Control Load Error"
SendKeys "{del}"
End If
End FunctionCode:
Option Explicit
Public Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, _
ByVal hWnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Public Const GWL_WNDPROC = -4
Public Const WM_SIZE = &H5
Public Const WM_GETMINMAXINFO = &H24
' The following variable is accessible to all code in this example.
Public pOldProc As Long ' pointer to the previous window function
Public frm As Form
Public MaxFW As Integer
Public MinFW As Integer
Public MaxFH As Integer
Public MinFH As Integer
' Define the new window procedure.
Public Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Dim retval As Long ' return value
' If they have tried to resize, and they're not allowed to,
' set it back to original size
If uMsg = 562 Then
If frm.WindowState <> vbMinimized Then
'Adjust these as needed
If frm.Height < MinFH Then frm.Height = MinFH
If frm.Height > MaxFH Then MsgBox frm.Height: frm.Height = MaxFH: MsgBox frm.Height
If frm.Width < MinFW Then frm.Width = MinFW
If frm.Width > MaxFW Then frm.Width = MaxFW
End If
Else
retval = CallWindowProc(pOldProc, hWnd, uMsg, wParam, lParam)
End If
' Have this function return whatever the function above returned.
WindowProc = retval
End Function