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

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

Previous Fields

Dream Kudos:
0
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
    ExitGetLocation:
    Exit Sub
    ErrorGetLocation:
    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
    GetNextControl:
    Err = 0
    Resume Next

    Next curr_obj
    Next i
    End Sub
    ---------------------------------------------------------------

    Great code
    thanks

My Information

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

Contact Information

E-mail:
Click here to e-mail me

Friends

akogan hasn't added any friends yet.

Comments

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