dcsimg
Results 1 to 6 of 6

Thread: VB6 User Control crash issue on Windows 10

  1. #1

    Thread Starter
    Superbly Moderated NeedSomeAnswers's Avatar
    Join Date
    Jun 2002
    Location
    Manchester uk
    Posts
    2,610

    VB6 User Control crash issue on Windows 10

    Hi All,

    I am having a weird problem with a VB6 control that is used by another VB6 control, that is used by a VB6 dll, that is used by a .Net app, that is used by a Web app that i am currently having to work on.

    The .NET app wont compile because there is a problem with the bottom VB6 control causing the whole chain not to compile.

    The bottom VB6 project that is causing the issue is a project that has a user control and that user control is placed on a form along with a common dialog control and a button and thats it.

    When i go to open the visual designer of the form, it crashes VB6

    If i comment out all the code in the User Control i can then load the form.

    I then tried un-commenting the code a method at a time but i can find no consistency in what method causes the crash so i cant pin point it down

    I have posted the full user control code below, it basically creates a colour grid, for a colour chooser type control

    Does anyone have any idea why this might be happening?

    Option Explicit

    ' ************************************************************
    ' Private constant declarations
    '
    ' ************************************************************
    ' Error base constants
    Private Const sgErrorBase = sgObjectError + 2100
    Private Const sgErrorSource = "SGComCtl.intColorGrid."

    ' Dimension constants
    Private Const sgFixedHeight = 1635
    Private Const sgFixedWidth = 2175
    Private Const sgCellSize = 240
    Private Const sgCellPad = 270
    Private Const sgCellSpace = 15

    ' Color grid dimensions
    Private Const XMin = 1
    Private Const XMax = 8
    Private Const YMin = 1
    Private Const YMax = 6

    ' Property defaults (for PropertyBag consistency)
    Private Const defColor = vbWhite
    Private Const defEnabled = True


    ' ************************************************************
    ' Private variable declarations
    '
    ' ************************************************************
    Private mlngColor(XMin To XMax, YMin To YMax) As OLE_COLOR
    Private mlngCurrent As OLE_COLOR

    Private mlngCurrentX As Long
    Private mlngCurrentY As Long
    Private mblnOnMouse As Boolean


    ' ************************************************************
    ' Event declarations
    '
    ' ************************************************************
    Public Event Click()
    Public Event KeyDown(KeyCode As Integer, Shift As Integer)
    Public Event KeyPress(KeyAscii As Integer)
    Public Event KeyUp(KeyCode As Integer, Shift As Integer)
    Public Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    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)



    ' ************************************************************
    ' Property: Color
    ' Set/Return the current color value
    '
    ' ************************************************************
    Public Property Get Color() As OLE_COLOR
    Color = mlngCurrent
    End Property

    Public Property Let Color(ByVal RHS As OLE_COLOR)
    mlngCurrent = RHS
    Call PropertyChanged("Color")

    ' Locate and draw new color
    Call FindColor(RHS)
    Call DrawSelection
    End Property


    ' ************************************************************
    ' Property: Enabled
    ' Disable the control and redraw appropriately
    '
    ' ************************************************************
    Public Property Get Enabled() As Boolean
    Enabled = UserControl.Enabled
    End Property

    Public Property Let Enabled(ByVal RHS As Boolean)
    UserControl.Enabled = RHS
    Call PropertyChanged("Enabled")

    ' Redraw the control
    Call UserControl_Paint
    End Property



    ' ************************************************************
    ' Property: hWnd
    ' Window handle for control
    '
    ' ************************************************************
    Public Property Get hWnd() As Long
    hWnd = UserControl.hWnd
    End Property


    ' ************************************************************
    ' Method: AboutBox
    ' Show the about form for this dialog
    '
    ' ************************************************************
    Public Sub AboutBox()
    ' Show the about form modally and then release it
    Call frmAbout.Show(vbModal)
    Set frmAbout = Nothing
    End Sub



    ' ************************************************************
    ' Method: Refresh
    ' Completely refresh the control
    '
    ' ************************************************************
    Public Sub Refresh()
    Call UserControl_Resize
    End Sub



    ' ************************************************************
    ' UserControl_Initialise event
    ' Populate array with simple colors on control initialise
    '
    ' ************************************************************
    Private Sub UserControl_Initialize()
    mlngColor(1, 1) = &HFFFFFF
    mlngColor(1, 2) = &HE0E0E0
    mlngColor(1, 3) = &HC0C0C0
    mlngColor(1, 4) = &H808080
    mlngColor(1, 5) = &H404040
    mlngColor(1, 6) = &H0&

    mlngColor(2, 1) = &HC0C0FF
    mlngColor(2, 2) = &H8080FF
    mlngColor(2, 3) = &HFF&
    mlngColor(2, 4) = &HC0&
    mlngColor(2, 5) = &H80
    mlngColor(2, 6) = &H40

    mlngColor(3, 1) = &HC0E0FF
    mlngColor(3, 2) = &H80C0FF
    mlngColor(3, 3) = &H80FF&
    mlngColor(3, 4) = &H40C0&
    mlngColor(3, 5) = &H4080&
    mlngColor(3, 6) = &H404080

    mlngColor(4, 1) = &HC0FFFF
    mlngColor(4, 2) = &H80FFFF
    mlngColor(4, 3) = &HFFFF&
    mlngColor(4, 4) = &HC0C0&
    mlngColor(4, 5) = &H8080&
    mlngColor(4, 6) = &H4040&

    mlngColor(5, 1) = &HC0FFC0
    mlngColor(5, 2) = &H80FF80
    mlngColor(5, 3) = &HFF00&
    mlngColor(5, 4) = &HC000&
    mlngColor(5, 5) = &H8000&
    mlngColor(5, 6) = &H4000&

    mlngColor(6, 1) = &HFFFFC0
    mlngColor(6, 2) = &HFFFF80
    mlngColor(6, 3) = &HFFFF00
    mlngColor(6, 4) = &HC0C000
    mlngColor(6, 5) = &H808000
    mlngColor(6, 6) = &H404000

    mlngColor(7, 1) = &HFFC0C0
    mlngColor(7, 2) = &HFF8080
    mlngColor(7, 3) = &HFF0000
    mlngColor(7, 4) = &HC00000
    mlngColor(7, 5) = &H800000
    mlngColor(7, 6) = &H400000

    mlngColor(8, 1) = &HFFC0FF
    mlngColor(8, 2) = &HFF80FF
    mlngColor(8, 3) = &HFF00FF
    mlngColor(8, 4) = &HC000C0
    mlngColor(8, 5) = &H800080
    mlngColor(8, 6) = &H400040
    End Sub



    ' ************************************************************
    ' UserControl_InitProperties event
    ' Initialise properties for this control
    '
    ' ************************************************************
    Private Sub UserControl_InitProperties()
    ' Set default properties
    Color = defColor
    Enabled = defEnabled
    End Sub



    ' ************************************************************
    ' UserControl_KeyDown event
    ' Passthrough event received from textbox
    '
    ' ************************************************************
    Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
    ' Process keypresses
    Select Case KeyCode
    Case vbKeyLeft, vbKeyRight, vbKeyUp, vbKeyDown
    ' Move color selection according to keypress
    Select Case KeyCode
    Case vbKeyLeft
    mlngCurrentX = mlngCurrentX - 1
    Case vbKeyRight
    mlngCurrentX = mlngCurrentX + 1
    Case vbKeyUp
    mlngCurrentY = mlngCurrentY - 1
    Case vbKeyDown
    mlngCurrentY = mlngCurrentY + 1
    End Select

    ' Validate new co-ordinates and draw color
    Call ValidateCell
    Call DrawSelection

    Case vbKeyReturn
    ' Raise a click event
    RaiseEvent Click

    Case Else
    ' Else raise as normal event
    RaiseEvent KeyDown(KeyCode, Shift)
    End Select
    End Sub



    ' ************************************************************
    ' UserControl_KeyPress event
    ' Passthrough event received from textbox
    '
    ' ************************************************************
    Private Sub UserControl_KeyPress(KeyAscii As Integer)
    RaiseEvent KeyPress(KeyAscii)
    End Sub



    ' ************************************************************
    ' UserControl_KeyUp event
    ' Passthrough event received from textbox
    '
    ' ************************************************************
    Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
    RaiseEvent KeyUp(KeyCode, Shift)
    End Sub



    ' ************************************************************
    ' UserControl_MouseDown event
    ' Passthrough event received from textbox
    '
    ' ************************************************************
    Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseDown(Button, Shift, X, Y)

    ' Only process left button clicks
    If (Button And vbLeftButton) Then
    mblnOnMouse = True

    ' Locate mouse cell and turn on new selection
    Call GetCurrentCell(X, Y)
    Call DrawSelection
    End If
    End Sub



    ' ************************************************************
    ' UserControl_MouseMove event
    ' Passthrough event received from textbox
    '
    ' ************************************************************
    Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseMove(Button, Shift, X, Y)

    ' Check mouse status
    mblnOnMouse = (Button And vbLeftButton)

    ' If left mouse is down move selection
    If mblnOnMouse Then
    Call GetCurrentCell(X, Y)
    Call DrawSelection
    End If
    End Sub



    ' ************************************************************
    ' UserControl_MouseUp event
    ' Passthrough event received from textbox
    '
    ' ************************************************************
    Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseUp(Button, Shift, X, Y)

    ' If we have been left dragging and have released the mouse button set color
    If mblnOnMouse And Not (Button And vbLeftButton) Then
    mblnOnMouse = False

    ' Select new color and raise click event
    mlngCurrent = mlngColor(mlngCurrentX, mlngCurrentY)
    RaiseEvent Click
    End If
    End Sub



    ' ************************************************************
    ' UserControl_Paint event
    ' Call SetColor to redraw control with appropriate colour selected
    '
    ' ************************************************************
    'Private Sub UserControl_Paint()
    ' Dim lngCountX As Long
    ' Dim lngCountY As Long
    ' Dim lngPosX As Long
    ' Dim lngPosY As Long
    '
    ' On Error GoTo ErrorHandler
    '
    ' ' Draw enabled and disable in seperate loops for speed
    ' If UserControl.Enabled Then
    ' ' Process x-axis cells
    ' For lngCountX = XMin To XMax
    ' lngPosX = ((lngCountX - 1) * sgCellPad) + sgCellSpace
    '
    ' ' Process y-axis cells
    ' For lngCountY = YMin To YMax
    ' lngPosY = ((lngCountY - 1) * sgCellPad) + sgCellSpace
    '
    ' ' Set color and draw a 240x240 twip box for each colour
    ' UserControl.FillColor = mlngColor(lngCountX, lngCountY)
    ' Line (lngPosX, lngPosY)-Step(sgCellSize, sgCellSize), , B
    ' Next
    ' Next
    '
    ' ' Draw focus on selected color
    ' Call DrawSelection
    ' Else
    ' ' Paint boxes with solid shadow color to indicate disabled
    ' UserControl.FillColor = vb3DShadow
    '
    ' ' Process x-axis cells
    ' For lngCountX = XMin To XMax
    ' lngPosX = ((lngCountX - 1) * sgCellPad) + 1
    '
    ' ' Process y-axis cells
    ' For lngCountY = YMin To YMax
    ' lngPosY = ((lngCountY - 1) * sgCellPad) + 1
    '
    ' ' Draw a 240x240 twip box for each colour
    ' Line (lngPosX, lngPosY)-Step(sgCellSize, sgCellSize), , B
    ' Next
    ' Next
    ' End If
    '
    'ErrorHandler:
    ' ' This situation may occur when the client site is not yet available for the control
    'End Sub



    ' ************************************************************
    ' UserControl_ReadProperties event
    ' Retrieve control properties from the property bag
    '
    ' ************************************************************
    Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    Color = PropBag.ReadProperty("Color", defColor)
    Enabled = PropBag.ReadProperty("Enabled", defEnabled)
    End Sub



    ' ************************************************************
    ' UserControl_Resize event
    ' Resize UserControl to standard grid dimensions
    '
    ' ************************************************************
    Private Sub UserControl_Resize()
    ' Set the control width and height exactly
    Call UserControl.Size(sgFixedWidth, sgFixedHeight)
    End Sub



    ' ************************************************************
    ' UserControl_Show event
    ' Resize controls to fit usercontrol when control is initialy shown
    '
    ' ************************************************************
    Private Sub UserControl_Show()
    Call UserControl_Resize
    End Sub



    ' ************************************************************
    ' UserControl_WriteProperties event
    ' Store control properties to the property bag
    '
    ' ************************************************************
    Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("Color", mlngCurrent, defColor)
    Call PropBag.WriteProperty("Enabled", UserControl.Enabled, defEnabled)
    End Sub



    ' ************************************************************
    ' Private Method: DrawSelection
    ' Draw the current color selection as active
    '
    ' ************************************************************
    Private Sub DrawSelection()
    Static lngOldX As Long
    Static lngOldY As Long
    Dim lngPosX As Long
    Dim lngPosY As Long

    ' Check if we have an old selection to hide
    If (lngOldX > 0) And (lngOldY > 0) Then
    lngPosX = ((lngOldX - 1) * sgCellPad) + sgCellSpace
    lngPosY = ((lngOldY - 1) * sgCellPad) + sgCellSpace

    ' Set main cell
    UserControl.FillColor = mlngColor(lngOldX, lngOldY)
    Line (lngPosX, lngPosY)-Step(sgCellSize, sgCellSize), , B
    End If

    ' Check if we have new cell to focus on
    If (mlngCurrentX > 0) And (mlngCurrentY > 0) Then
    lngPosX = ((mlngCurrentX - 1) * sgCellPad) + sgCellSpace
    lngPosY = ((mlngCurrentY - 1) * sgCellPad) + sgCellSpace

    ' Set main cell
    UserControl.ForeColor = vb3DHighlight
    Line (lngPosX, lngPosY)-Step(sgCellSize, sgCellSize), , B

    ' Set inner cell
    UserControl.ForeColor = vbWindowText
    UserControl.FillColor = mlngColor(mlngCurrentX, mlngCurrentY)
    Line (lngPosX + 15, lngPosY + 15)-Step(sgCellSize - 30, sgCellSize - 30), , B

    ' Set current color value from grid
    mlngCurrent = mlngColor(mlngCurrentX, mlngCurrentY)
    End If

    ' Store new co-ordinates
    lngOldX = mlngCurrentX
    lngOldY = mlngCurrentY
    End Sub



    ' ************************************************************
    ' Private Method: FindColor
    ' Locate a given color's grid position
    '
    ' ************************************************************
    Private Sub FindColor(ByVal NewColor As OLE_COLOR)
    Dim lngCountX As Long
    Dim lngCountY As Long

    ' Read array looking for given color
    For lngCountX = XMin To XMax
    For lngCountY = YMin To YMax
    ' Check for color match
    If (mlngColor(lngCountX, lngCountY) = NewColor) Then
    ' Set new co-ordinates and exit
    mlngCurrentX = lngCountX
    mlngCurrentY = lngCountY
    Exit Sub
    End If
    Next
    Next

    ' Nothing has been found set to non-standard values
    mlngCurrentX = 0
    mlngCurrentY = 0
    End Sub


    ' ************************************************************
    ' Private Method: GetCurrentCell
    ' Locate a given color's grid position by mouse co-ordinates
    '
    ' ************************************************************
    Private Sub GetCurrentCell(ByVal X As Long, ByVal Y As Long)
    ' Calculate the current position
    mlngCurrentX = ((X) \ sgCellPad) + 1
    mlngCurrentY = ((Y) \ sgCellPad) + 1

    Call ValidateCell
    End Sub



    ' ************************************************************
    ' Private Method: ValidateCell
    ' Validate that current cell co-ordinates are valid
    '
    ' ************************************************************
    Private Sub ValidateCell()
    If (mlngCurrentX > XMax) Then mlngCurrentX = XMax
    If (mlngCurrentX < XMin) Then mlngCurrentX = XMin

    If (mlngCurrentY > YMax) Then mlngCurrentY = YMax
    If (mlngCurrentY < YMin) Then mlngCurrentY = YMin
    End Sub

    Please Mark your Thread "Resolved", if the query is solved & Rate those who have helped you



  2. #2
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    18,997

    Re: VB6 User Control crash issue on Windows 10

    Try commenting out the code in these two routines & see if it still crashes. If that seems to fix the problem, I can tell you how to avoid the problem without commenting out that code

    Property Let Enabled and Property Let Color
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  3. #3

    Thread Starter
    Superbly Moderated NeedSomeAnswers's Avatar
    Join Date
    Jun 2002
    Location
    Manchester uk
    Posts
    2,610

    Re: VB6 User Control crash issue on Windows 10

    Hey LaVolpe thanks for the reply, its appears i have a more general problem as just commenting out those methods doesnt stop VB6 crashing.

    However i would really be interested in your thoughts as to the problems with those subs and what you would do to fix them? It's still possible that its related and i would like to test some stuff out.

    Thanks
    Please Mark your Thread "Resolved", if the query is solved & Rate those who have helped you



  4. #4
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    18,997

    Re: VB6 User Control crash issue on Windows 10

    If you noticed, the Paint event has error trapping with a note that errors can occur when control is being established. Well, your Enabled property calls UserControl_Paint directly and the Color property call DrawSelection which uses the Line method to draw on the control. If there is any chance of introducing errors during ReadProperites/InitiProperties, then don't do the drawing from those events.

    Instead of setting the Enabled property in those 2 events, simply:
    InitiProperties: UserControl.Enabled = defEnabled
    ReadProperites: UserControl.Enabled = PropBag.ReadProperty("Enabled", defEnabled)

    Instead of setting the Color property in those 2 events simply:
    InitiProperties: mlngCurrent = defColor
    ReadProperites: mlngCurrent = PropBag.ReadProperty("Color", defColor)

    More questions. You said, "When i go to open the visual designer of the form, it crashes VB6". The visual designer is the VB6 IDE? The IDE is crashing simply by displaying a form with this control on it? Is there other code for this usercontrol that is not being shown? It appears the usercontrol has a form included in it, but based on your code it is only an "About" type form since it must be called, doubt that has anything to do with this. Does this crash happen with a brand new test project and adding a new usercontrol?

    Nothing I see jumps out at me and says -- hey this could be it.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  5. #5
    PowerPoster
    Join Date
    Jun 2013
    Posts
    4,898

    Re: VB6 User Control crash issue on Windows 10

    Scenarios where I've seen such crashes (with VB6-UserControls) were Stack-Overflows,
    involuntarily caused by "retriggering EventHandlers from EventHandlers"
    (sometimes indirectly, just by setting a Property(Let), or calling another SubRoutine which in turn causes the EventHandler to trigger again).

    In the code you've posted - there might be a few candidates you might change
    (where you call the EventHandler-Routine from within Property-Let-Routines).

    First thing I'd make sure is, to move the "RePaint-Code" out of UserControl_Paint
    (into its own Routine) - and then switch the Control to AutoRedraw = True.
    This way, DoubleBuffering is active - and the UserControl_Paint-Handler is never called.

    Another candidate for potential self-triggering is your UserControl_Resize-Handler
    (where you call a Size-Method).

    Also Property-Let-Routines can be "hardened" a bit (avoiding self-triggering of too many internal Refreshs),
    when on PropLet-Entry you follow the simple rule, to exit immediately, when the internal-Value is already equal to the "new, incoming RHS".

    Olaf

  6. #6

    Thread Starter
    Superbly Moderated NeedSomeAnswers's Avatar
    Join Date
    Jun 2002
    Location
    Manchester uk
    Posts
    2,610

    Re: VB6 User Control crash issue on Windows 10

    Thanks for the great responses guys, but it seems i have something more fundamental wrong with my development machine as two of my colleagues can open and build the project fine, where as even with a number of the changes you suggested mine still crashes.

    Fortunately one of my colleagues has volunteered to do the changes to this project so i am off the hook for now !
    Please Mark your Thread "Resolved", if the query is solved & Rate those who have helped you



Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width