[VB6] Experiments with Resizing and Screen Resolutions (Help needed)

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)
Attachment 107929

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

---

And OCX does its trick and you got:
Attachment 107921
(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:
Attachment 107925
(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:
Attachment 107927

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 Function

---

Module LimitResize.bas:

Code:

---

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

---

(As I said, this OCX was posted by MarkT in the mentioned thread, I don't know if he actually made it)