Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

200pts: Real world OCX forms.

Posted on 1999-07-12
8
Medium Priority
?
194 Views
Last Modified: 2011-09-20
We're reworking an older VB program that used ~30 frames
and a "curFrame.visible = true" statement to display the
various input controls for different events.

One idea we have is to turn each frame into an ocx.  We'd
like to know if anyone has done this on a large scale
project before and what obstacles you encountered.

Also, if anyone has any other ideas please feel free to
enter them as comments.

TIA,
David Wright
vbprog@hotmail.com

0
Comment
Question by:kildar021799
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
  • 2
  • 2
  • +1
8 Comments
 
LVL 1

Expert Comment

by:jdunck
ID: 1523909
Is it necessary to have all of these inputs on one form?  I ask this, because having 30 frames worth of inputs loaded at a single time is a large memory hit.  Why not split them up into separate forms?
0
 

Author Comment

by:kildar021799
ID: 1523910
One idea we've had is to use forms and just lay them on top of a parent form.

Let me explain:
What the user will see is a static TDBGrid taking up the top 3/4 of a window.  When they select a record in the grid, the area below the grid will show various controls that are specific to the record type.  Those controls contained in 30 frames.  We don't like that approach and thought ocx's might work, but the team lead wants a real world example.

David Wright

0
 
LVL 15

Expert Comment

by:ameba
ID: 1523911
I did this. It was worth the effort. Great memory savings.

There were two Tabs with comboboxes, each holding many items. They needed about 1 second to load. I had to use 'old' style (frames) - it was too slow to dinamically load/unload these 2 control groups.
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 1

Expert Comment

by:jdunck
ID: 1523912
Well, as far as that goes, I whipped up a nifty cheat for loading large combos, too.

There's a form, with a combo box on it.  You load this combo at app startup (assuming, of course, that the combo is static).

Then, any form that needs that pre-loaded combo "hijacks" it, by using SetParent.  If you're interested in this, give me your email address.

-JDunck
0
 
LVL 15

Expert Comment

by:ameba
ID: 1523913
See my link to article, and Mirkwood's comment (OCX-container for forms) in:
http://www.experts-exchange.com/Q.10131839

0
 
LVL 15

Expert Comment

by:ameba
ID: 1523914
jdunck, thanks for the offer. No need for this trick.
Sorry, I didn't notice you were talking to me.
And I agree, 30 frames loaded at a single time is a large memory hit.
0
 
LVL 13

Expert Comment

by:Mirkwood
ID: 1523915
Thanks ameba for the link.

It's very easy to modify this control btw to support loading on demand. That way you can support an unlimited number of pages
0
 
LVL 13

Accepted Solution

by:
Mirkwood earned 600 total points
ID: 1523916
VERSION 5.00
Begin VB.UserControl ctlForm
   ClientHeight    =   1695
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4440
   ScaleHeight     =   1695
   ScaleWidth      =   4440
   ToolboxBitmap   =   "ctlForm.ctx":0000
   Begin VB.Frame ClipFrame
      Appearance      =   0  'Flat
      BorderStyle     =   0  'None
      Caption         =   "Embedded Form Control"
      ForeColor       =   &H80000008&
      Height          =   1455
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   4215
   End
   Begin VB.VScrollBar VScroll1
      Height          =   1455
      Left            =   4200
      TabIndex        =   2
      TabStop         =   0   'False
      Top             =   0
      Width           =   255
   End
   Begin VB.HScrollBar HScroll1
      Height          =   255
      Left            =   0
      TabIndex        =   1
      TabStop         =   0   'False
      Top             =   1440
      Width           =   4215
   End
End
Attribute VB_Name = "ctlForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Private Declare Function SetParent Lib "user32.dll" (ByVal childHwnd As Long, ByVal ParentHwnd As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_CONTROLPARENT = &H10000
Private Const GWL_STYLE = (-16)
Private Const WS_CHILD = &H40000000
Private Const WS_TABSTOP = &H10000
Private Const WS_VISIBLE = &H10000000
Private Const WS_CAPTION = &HC00000
Private Const WS_BORDER = &H800000
Private Const WS_THICKFRAME = &H40000
Private Const WS_SYSMENU = &H80000
Private Const WS_MINIMIZEBOX = &H20000
Private Const WS_MAXIMIZEBOX = &H10000
Private Const SW_NORMAL = 1
Private Const SW_HIDE = 0
Private Const SW_SHOWNA = 8
Private Const SW_SHOWNOACTIVATE = 4

Private WithEvents m_currentformEvents As Form
Attribute m_currentformEvents.VB_VarHelpID = -1
Private m_currentform As Object
Attribute m_currentform.VB_VarHelpID = -1
Private m_oldstyle As Long
Private m_oldparent As Long
Private m_FormOwner As Boolean
Private m_AutoResizeForm As Boolean

Public Event MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Public Event MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Public Event MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Public Event Click()
Public Event DblClick()

Public Tag As Variant

Public Property Get FormOwner() As Boolean
    FormOwner = m_FormOwner
End Property

Public Property Let FormOwner(ByVal newValue As Boolean)
    If newValue <> m_FormOwner Then
        m_FormOwner = newValue
        PropertyChanged "FormOwner"
    End If
End Property

Public Property Get AutoResizeForm() As Boolean
    AutoResizeForm = m_AutoResizeForm
End Property

Public Property Let AutoResizeForm(ByVal newValue As Boolean)
    If newValue <> m_AutoResizeForm Then
        m_AutoResizeForm = newValue
        PropertyChanged "AutoResizeForm"
    End If
End Property


Public Property Set CurrentForm(ByVal newform As Object)
    If Ambient.UserMode = False Then 'are we in design mode
        Err.Raise -1, "ctlForm", "This property can only be changed in run-time"
    End If
   
    RestoreChildForm   'Unload the current form
       
    Set m_currentform = newform 'remember form
    On Error Resume Next
    Set m_currentformEvents = newform 'remember form
    On Error GoTo 0
   
    ModifyChildForm 'Modify new form
End Property

Public Property Get CurrentForm() As Object
    Set CurrentForm = m_currentform
End Property



Private Sub ClipFrame_Click()
    RaiseEvent Click
End Sub

Private Sub ClipFrame_DblClick()
    RaiseEvent DblClick
End Sub

Private Sub ClipFrame_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    RaiseEvent MouseDown(Button, Shift, x, y)
End Sub

Private Sub ClipFrame_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    RaiseEvent MouseMove(Button, Shift, x, y)
End Sub

Private Sub ClipFrame_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    RaiseEvent MouseUp(Button, Shift, x, y)
End Sub

Private Sub HScroll1_Change()
    If (Not m_currentform Is Nothing) Then
        m_currentform.Left = -HScroll1.Value
    End If
End Sub

Private Sub m_currentformevents_Click()
    RaiseEvent Click
End Sub

Private Sub m_currentformevents_DblClick()
    RaiseEvent DblClick
End Sub

Private Sub m_currentformevents_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    RaiseEvent MouseDown(Button, Shift, x, y)
End Sub

Private Sub m_currentformevents_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    RaiseEvent MouseMove(Button, Shift, x, y)
End Sub

Private Sub m_currentformevents_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    RaiseEvent MouseUp(Button, Shift, x, y)
End Sub

Private Sub UserControl_InitProperties()
    WhenControlHasBeenSited
End Sub

Private Sub VScroll1_Change()
    If (Not m_currentform Is Nothing) Then
        m_currentform.Top = -VScroll1.Value
    End If
End Sub

Private Sub HScroll1_GotFocus()
    If (Not m_currentform Is Nothing) Then
        m_currentform.SetFocus
    End If
End Sub

Private Sub VScroll1_GotFocus()
    If (Not m_currentform Is Nothing) Then
        m_currentform.SetFocus
    End If
End Sub


Private Sub UserControl_GotFocus()
    If (Not m_currentform Is Nothing) Then
        m_currentform.SetFocus
     End If
End Sub


Private Sub UserControl_Initialize()
    m_FormOwner = True
    m_AutoResizeForm = True
   
    'UserControl_Resize
   

End Sub

Private Sub WhenControlHasBeenSited()
    On Error GoTo leave
    UserControl_Resize
    Exit Sub
   
leave:
   
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    m_FormOwner = PropBag.ReadProperty("FormOwner", True)
    m_AutoResizeForm = PropBag.ReadProperty("AutoResizeForm", True)
    WhenControlHasBeenSited
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    PropBag.WriteProperty "FormOwner", m_FormOwner, True
    PropBag.WriteProperty "AutoResizeForm", m_AutoResizeForm, True
End Sub

Private Sub UserControl_Resize()
    If Height < HScroll1.Height Then Height = HScroll1.Height
    'Design time
    On Error Resume Next
    ClipFrame.BorderStyle = Abs(Not Ambient.UserMode)
    On Error GoTo 0
    ClipFrame.Move 0, 0, ScaleWidth, ScaleHeight
   
    'Run time
    ResizeForm  'Resize the form
    ResizeScrollbars 'Resize the scrollbars
End Sub

Private Sub UserControl_Terminate()
    Debug.Print "ctlForm terminate"
    RestoreChildForm 'Unload the current form if needed
End Sub


Private Sub ModifyChildForm()
    If (Not m_currentform Is Nothing) Then
        If (m_FormOwner) Then
            On Error Resume Next
            Load m_currentformEvents
            On Error GoTo 0
        End If
        m_oldstyle = GetWindowLong(m_currentform.hwnd, GWL_STYLE)
        Call SetWindowLong(m_currentform.hwnd, GWL_STYLE, (m_oldstyle Or WS_CHILD) And Not (WS_CAPTION Or WS_BORDER Or WS_THICKFRAME Or WS_SYSMENU Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX))
       
        m_currentform.Width = m_currentform.Width - 10 ' Workaround to force repaint
        m_currentform.Width = m_currentform.Width + 10 ' Workaround to force repaint
       
        m_oldparent = SetParent(m_currentform.hwnd, ClipFrame.hwnd)
        ShowWindow m_currentform.hwnd, SW_SHOWNOACTIVATE
       
        ResetScrollbars 'Reset the scrollbars
        ResizeForm
        ResizeScrollbars
       
    End If
End Sub

Private Sub RestoreChildForm()
    If (Not m_currentform Is Nothing) Then

        Dim f As Form
        For Each f In Forms
            If f Is m_currentform Then
                ShowWindow m_currentform.hwnd, SW_HIDE
                m_currentform.Refresh
                Call GetWindowLong(m_currentform.hwnd, m_oldstyle)
                Call SetParent(m_currentform.hwnd, m_oldparent)
                If (m_FormOwner) Then
                    On Error Resume Next
                    Unload m_currentformEvents
                    On Error GoTo 0
                End If
                Set m_currentform = Nothing
                Set m_currentformEvents = Nothing
                ResetScrollbars 'Reset the scrollbars
                ResizeScrollbars 'Resize them
                Exit Sub
            End If
        Next
        Set m_currentform = Nothing
        Set m_currentformEvents = Nothing
'        Debug.Assert 0
    End If
End Sub

Private Sub ResizeForm()
    If (Not m_currentform Is Nothing) Then
        If (m_AutoResizeForm) Then
            m_currentform.Move -HScroll1.Value, -VScroll1.Value, ClipFrame.Width, ClipFrame.Height
        Else
            m_currentform.Move -HScroll1.Value, -VScroll1.Value, m_currentform.Width, m_currentform.Height
        End If
    End If
End Sub

Private Sub ResizeScrollbars()
    Dim bNeedVscroll As Boolean
    Dim bNeedHscroll As Boolean
   
   
    If (Not m_currentform Is Nothing) Then
        Dim clipHeight As Integer
        Dim clipWidth As Integer
        bNeedVscroll = m_currentform.Height > ScaleHeight
        bNeedHscroll = m_currentform.Width > ScaleWidth
       
        'Make room for scrollbar
retry:
        If (bNeedHscroll) Then
            clipHeight = ScaleHeight - HScroll1.Height
            bNeedVscroll = m_currentform.Width > clipWidth
        Else
            clipHeight = ClipFrame.Height
        End If
       
        'Make room for scrollbar
        If (bNeedVscroll) Then
            clipWidth = ScaleWidth - VScroll1.Width
            If (Not bNeedHscroll) Then
                bNeedHscroll = m_currentform.Height > clipHeight
                If (bNeedHscroll) Then
                    GoTo retry
                End If
            End If
        Else
            clipWidth = ClipFrame.Width
        End If
       
        If (bNeedVscroll Or bNeedHscroll) Then
            ClipFrame.Move ClipFrame.Left, ClipFrame.Top, clipWidth, clipHeight
        End If
       
        'Reset scrollbar if not needed
        If (Not bNeedHscroll) Then HScroll1.Value = 0
        If (Not bNeedVscroll) Then VScroll1.Value = 0
       
        'move scrollbar
        HScroll1.Move ClipFrame.Left, ClipFrame.Top + ClipFrame.Height, ClipFrame.Width, HScroll1.Height
        VScroll1.Move ClipFrame.Left + ClipFrame.Width, ClipFrame.Top, VScroll1.Width, ClipFrame.Height
       
        'Set scrollbar metrics
        If (Not m_currentform Is Nothing) Then
            VScroll1.LargeChange = ClipFrame.Height
            HScroll1.LargeChange = ClipFrame.Width
            VScroll1.SmallChange = Screen.TwipsPerPixelY * 8
            HScroll1.SmallChange = Screen.TwipsPerPixelX * 8
            VScroll1.Max = m_currentform.Height - ClipFrame.Height
            HScroll1.Max = m_currentform.Width - ClipFrame.Width
        End If
    Else
        bNeedVscroll = False
        bNeedHscroll = False
    End If
   
    'Set visible
    VScroll1.Visible = bNeedVscroll
    HScroll1.Visible = bNeedHscroll
End Sub

Private Sub ResetScrollbars()
    VScroll1.Value = 0
    HScroll1.Value = 0
End Sub


Private Function GetLastControlHwnd(ByVal obj As Object) As Long
    Dim cont As Control
    Dim tabindex As Integer
    Dim childHwnd As Long
    tabindex = -1
    For Each cont In obj.Controls
        On Error Resume Next
        If cont.TabStop = True Then
            If Err.Number = 0 Then
                If (cont.tabindex > tabindex) Then
                    childHwnd = cont.hwnd
                    tabindex = cont.tabindex
                End If
            End If
        End If
    Next
    GetLastControlHwnd = childHwnd
End Function


0

Featured Post

Hire Technology Freelancers with Gigs

Work with freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely, and get projects done right.

Question has a verified solution.

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

Enums (shorthand for ‘enumerations’) are not often used by programmers but they can be quite valuable when they are.  What are they? An Enum is just a type of variable like a string or an Integer, but in this case one that you create that contains…
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.
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
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

704 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question