akogan's Profile User Rating: -----

Reputation: 0 Apprentice
New Members
Active Posts:
1 (0 per day)
21-March 13
Profile Views:
Last Active:
User is offline Mar 23 2013 04:19 AM

Previous Fields

Dream Kudos:
Icon   akogan has not set their status

Posts I've Made

  1. In Topic: Resize Form & Controls For Screen Size - VB6

    Posted 21 Mar 2013

    My modification to handel some other controls that gets error by TabIndex. (Timers etc.)

    The code in Form Load is just:

    GetLocation Me

    The code in GetLocation with my modification to handel the error:

    Public Sub GetLocation(frm As Form)
    Dim i As Integer
    On Error Resume Next
    ' Load the current positions of each object into a user defined type array.
    ' This information will be used to rescale them in the Resize function.

    'Loop through each control
    For Each curr_obj In frm
    'Resize the Array by 1, and preserve
    'the original objects in the array

    ReDim Preserve List(i)
    With List(i)
    .Name = curr_obj
    .Index = curr_obj.TabIndex
    .Left = curr_obj.Left
    .Top = curr_obj.Top
    .width = curr_obj.width
    .height = curr_obj.height
    End With
    If Err > 0 Then
    i = i - 1
    Err = 0
    End If

    i = i + 1
    Next curr_obj
    On Error GoTo ErrorGetLocation
    ' This is what the object sizes will be compared to on rescaling.
    iHeight = frm.height
    iWidth = frm.width
    Exit Sub
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure GetLocation of Formular Form1"
    Resume ExitGetLocation

    End Sub
    in Form_Resize I use only:

    Private Sub Form_Resize()
    ResizeControls Me
    End Sub

    In Resize Control I adjust directly the font size:

    Public Sub ResizeControls(frm As Form)
    Dim i As Integer
    ' Get ratio of initial form size to current form size
    If iHeight = 0 Or iWidth = 0 Then Exit Sub
    x_size = frm.height / iHeight
    y_size = frm.width / iWidth

    'Loop though all the objects on the form
    'Based on the upper bound of the # of controls
    For i = 0 To UBound(List)
    'Grad each control individually
    For Each curr_obj In frm
    'Check to make sure its the right control
    On Error GoTo GetNextControl
    If curr_obj.TabIndex = List(i).Index Then
    'Then resize the control
    With curr_obj
    .Left = List(i).Left * y_size
    .width = List(i).width * y_size
    .height = List(i).height * x_size
    .Top = List(i).Top * x_size
    'If curr_obj.Name = "txtFieldContent" Then Stop
    .FontSize = SetFontSize()
    End With
    End If
    'Get the next control
    Err = 0
    Resume Next

    Next curr_obj
    Next i
    End Sub

    Great code

My Information

Member Title:
New D.I.C Head
Age Unknown
Birthday Unknown

Contact Information

Click here to e-mail me


akogan hasn't added any friends yet.


akogan has no profile comments yet. Why not say hello?