[RESOLVED] [VB6] - crashes without tell me why and i can't see the error:(

[joaquim]

Option Explicit

Enum ScrollingBars
    None = 0
    Vertical = 1
    Horizontal = 2
    Both = 3
End Enum

Enum ScrollingWays
    None = 0
    ScrollObject = 1
    Automatic = 2
End Enum

Dim ScrlBars As ScrollingBars
Dim strFileName As String
Dim lngBackColor As Long
Dim VerticalValue As Long
Dim HorizontalValue As Long
Dim lngOriginalBackcolor As Long
Dim blnShowed As Boolean
Dim Scroolling As ScrollingWays

Public Property Get ScrollWay() As ScrollingWays
    ScrollWay = Scroolling
End Property

Public Property Let ScrollWay(ByVal vNewValue As ScrollingWays)
    Scroolling = vNewValue
    PropertyChanged "ScrollWay"
End Property

Public Property Get ViewWidth() As Long
    ViewWidth = picView.Width
End Property

Public Property Let ViewWidth(ByVal vNewValue As Long)
    picView.Width = vNewValue
    Call ScrollingValues
    PropertyChanged "ViewWidth"
End Property

Public Property Get ViewWidthPosition() As Long
    ViewWidthPosition = ScrollingHorizontal.Value
End Property

Public Property Let ViewWidthPosition(ByVal vNewValue As Long)
    If vNewValue > ScrollingHorizontal.Max Then vNewValue = ScrollingHorizontal.Max
    If vNewValue < 0 Then vNewValue = 0
    ScrollingHorizontal.Value = vNewValue
    PropertyChanged "ViewWidthPosition"
End Property

Public Property Get ViewHeigth() As Long
    ViewHeigth = picView.Height
End Property

Public Property Let ViewHeigth(ByVal vNewValue As Long)
    picView.Height = vNewValue
    Call ScrollingValues
    PropertyChanged "ViewHeight"
End Property

Public Property Get ViewHeigthPosition() As Long
    ViewHeigthPosition = ScrollingVertical.Value
End Property

Public Property Let ViewHeigthPosition(ByVal vNewValue As Long)
    If vNewValue > ScrollingVertical.Max Then vNewValue = ScrollingVertical.Max
    If vNewValue < 0 Then vNewValue = 0
    ScrollingVertical.Value = vNewValue
    PropertyChanged "ViewHeightPosition"
End Property

Public Property Get ShowScrollingBars() As ScrollingBars
   ShowScrollingBars = ScrlBars
End Property

Public Property Let ShowScrollingBars(ByVal vNewValue As ScrollingBars)
    ScrlBars = vNewValue
    If vNewValue = 0 Then
        ScrollingHorizontal.Visible = False
        ScrollingVertical.Visible = False
        Picture1.Visible = False
    ElseIf vNewValue = Horizontal Then
        ScrollingHorizontal.Visible = True
        ScrollingVertical.Visible = False
        Picture1.Visible = False
    ElseIf vNewValue = Vertical Then
        ScrollingHorizontal.Visible = False
        ScrollingVertical.Visible = True
        Picture1.Visible = False
    ElseIf vNewValue = Both Then
        Picture1.Visible = True
        ScrollingHorizontal.Visible = True
        ScrollingVertical.Visible = True
        Picture1.Visible = True
    End If
    Call UserControl_Resize
    PropertyChanged "ShowScrollingBars"
End Property

Private Sub picView_Resize()
    ViewWidth = picView.Width
    ViewHeigth = picView.Height
End Sub

Private Sub ScrollingHorizontal_Change()
    Dim i As Long
    If HorizontalValue > ScrollingHorizontal.Value Then
        picView.Left = picView.Left + (Abs(ScrollingHorizontal.Value - HorizontalValue))
    ElseIf HorizontalValue < ScrollingHorizontal.Value Then
        picView.Left = picView.Left - (Abs(ScrollingHorizontal.Value - HorizontalValue))
    End If
    For i = 0 To UserControl.ContainedControls.Count - 1
        If HorizontalValue > ScrollingHorizontal.Value Then
            UserControl.ContainedControls(i).Left = UserControl.ContainedControls(i).Left + (Abs(ScrollingHorizontal.Value - HorizontalValue)) * Screen.TwipsPerPixelX
        ElseIf HorizontalValue < ScrollingHorizontal.Value Then
            UserControl.ContainedControls(i).Left = UserControl.ContainedControls(i).Left - (Abs(ScrollingHorizontal.Value - HorizontalValue)) * Screen.TwipsPerPixelX
        End If
    Next i
    HorizontalValue = ScrollingHorizontal.Value
    picView.Refresh
End Sub

Private Sub ScrollingHorizontal_Scroll()
    Call ScrollingHorizontal_Change
End Sub

Private Sub ScrollingVertical_Change()
    Dim i As Long
    If VerticalValue > ScrollingVertical.Value Then
        picView.Top = picView.Top + (Abs(ScrollingVertical.Value - VerticalValue))
    ElseIf VerticalValue < ScrollingVertical.Value Then
        picView.Top = picView.Top - (Abs(ScrollingVertical.Value - VerticalValue))
    End If
    For i = 0 To UserControl.ContainedControls.Count - 1
        If VerticalValue > ScrollingVertical.Value Then
            UserControl.ContainedControls(i).Top = UserControl.ContainedControls(i).Top + (Abs(ScrollingVertical.Value - VerticalValue)) * Screen.TwipsPerPixelX
        ElseIf VerticalValue < ScrollingVertical.Value Then
            UserControl.ContainedControls(i).Top = UserControl.ContainedControls(i).Top - (Abs(ScrollingVertical.Value - VerticalValue)) * Screen.TwipsPerPixelX
        End If
    Next i
    VerticalValue = ScrollingVertical.Value
    picView.Refresh
End Sub

Private Sub ScrollingVertical_Scroll()
    Call ScrollingVertical_Change
End Sub

Private Sub Timer1_Timer()
    Picture1.ZOrder 0
    ScrollingHorizontal.ZOrder 0
    ScrollingVertical.ZOrder 0
End Sub

Private Sub UserControl_Hide()
    blnShowed = False
End Sub

Private Sub UserControl_Initialize()
    lngBackColor = &H8000000F
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    ViewWidth = PropBag.ReadProperty("ViewWidth", 0)
    ViewWidthPosition = PropBag.ReadProperty("ViewWidthPosition", 0)
    ViewHeigth = PropBag.ReadProperty("ViewHeigth", 0)
    ViewHeigthPosition = PropBag.ReadProperty("ViewHeigthPosition", 0)
    ShowScrollingBars = PropBag.ReadProperty("ShowScrollingBars", 0)
    FileName = PropBag.ReadProperty("FileName", "")
    BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
    picView.Picture = PropBag.ReadProperty("Image", Nothing)
    ScrollWay = PropBag.ReadProperty("ScrollWay", 0)
End Sub

Private Sub UserControl_Resize()
    ScrollingHorizontal.Top = UserControl.Height / Screen.TwipsPerPixelY - ScrollingHorizontal.Height - 4
    ScrollingHorizontal.Width = UserControl.Width / Screen.TwipsPerPixelX - 4
    ScrollingVertical.Left = UserControl.Width / Screen.TwipsPerPixelX - ScrollingHorizontal.Height - 4
    ScrollingVertical.Height = UserControl.Height / Screen.TwipsPerPixelY - 4
    picView.Height = UserControl.Height
    picView.Width = UserControl.Width
    picView.Refresh
    If ScrlBars = Both Then
        ScrollingVertical.Height = ScrollingVertical.Height - 16
        ScrollingHorizontal.Width = ScrollingHorizontal.Width - 16
    End If
    Picture1.Top = UserControl.Height / Screen.TwipsPerPixelY - Picture1.Height - 4
    Picture1.Left = UserControl.Width / Screen.TwipsPerPixelX - Picture1.Width - 4
    Call ScrollingValues
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    PropBag.WriteProperty "ViewWidth", ViewWidth, 0
    PropBag.WriteProperty "ViewWidthPosition", ViewWidthPosition, 0
    PropBag.WriteProperty "ViewHeigth", ViewWidth, 0
    PropBag.WriteProperty "ViewHeigthPosition", ViewHeigthPosition, 0
    PropBag.WriteProperty "ShowScrollingBars", ShowScrollingBars, 0
    PropBag.WriteProperty "FileName", FileName, ""
    PropBag.WriteProperty "BackColor", BackColor, &H8000000F
    PropBag.WriteProperty "Image", picView.Image, Nothing
    PropBag.WriteProperty "ScrollWay", ScrollWay, 0
End Sub

Public Property Get FileName() As String
    FileName = strFileName
End Property

Public Property Let FileName(ByVal vNewValue As String)
    On Error GoTo erro
    strFileName = vNewValue
    picView.Picture = LoadPicture(strFileName)
    picView.BackColor = GetPixel(picView.hdc, 0, 0)
    UserControl.BackColor = picView.BackColor
    lngBackColor = picView.BackColor
    lngOriginalBackcolor = lngBackColor
    picView.AutoSize = True
    'picView.AutoSize = False
    Call ScrollingValues
    HorizontalValue = ScrollingHorizontal.Value
    VerticalValue = ScrollingVertical.Value
    PropertyChanged "FileName"
erro:
    Exit Property
End Property

Public Property Get BackColor() As OLE_COLOR
    BackColor = lngBackColor
End Property

Public Property Let BackColor(ByVal vNewValue As OLE_COLOR)
    If vNewValue = -1 Then vNewValue = lngOriginalBackcolor
    lngBackColor = vNewValue
    If lngBackColor <> GetPixel(picView.hdc, 0, 0) Then
        picView.BackColor = lngBackColor
        UserControl.BackColor = lngBackColor
        Call ChangeBackcolor(picView, lngBackColor)
    End If
    PropertyChanged "BackColor"
End Property

Private Sub ScrollingValues()
    ScrollingVertical.Max = picView.ScaleHeight - UserControl.ScaleHeight
    ScrollingHorizontal.Max = picView.ScaleWidth - UserControl.ScaleWidth
    If ScrlBars = Both Then
        ScrollingHorizontal.Max = ScrollingHorizontal.Max + 17
        ScrollingVertical.Max = ScrollingVertical.Max + 17
    End If
    If picView.ScaleHeight <= UserControl.ScaleHeight Then ScrollingVertical.Max = 0
    If picView.ScaleWidth <= UserControl.ScaleWidth Then ScrollingHorizontal.Max = 0
    If ScrollingHorizontal.Max <= 0 Then
        ScrollingHorizontal.Enabled = False
    Else
        ScrollingHorizontal.Enabled = True
    End If
    If ScrollingVertical.Max <= 0 Then
        ScrollingVertical.Enabled = False
    Else
        ScrollingVertical.Enabled = True
    End If
End Sub

Public Property Let Image(ByVal img As Picture)
    Set picView.Picture = img
    Call ScrollingValues
    PropertyChanged "Image"
End Property

Public Property Set Image(ByVal theImage As StdPicture)
     Set picView.Picture = theImage
     Call ScrollingValues
End Property

Public Property Get Image() As Picture
    Set Image = picView.Image
End Property

and in a module:

Option Explicit

Public Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long

Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long

Public Function ChangeBackcolor(Destiny As Variant, NewBackcolorColor As Long)
    Dim PosX As Long
    Dim PosY As Long
    Dim BackColor As Long
    On Error Resume Next
    BackColor = GetPixel(Destiny.hdc, 0, 0)
    For PosY = 0 To Destiny.ScaleHeight
        For PosX = 0 To Destiny.ScaleWidth
            If GetPixel(Destiny.hdc, PosX, PosY) = &HFFFF Then Exit For
            If GetPixel(Destiny.hdc, PosX, PosY) = BackColor Then
                SetPixel Destiny.hdc, PosX, PosY, NewBackcolorColor
            End If
        Next PosX
    Next PosY
End Function

[joaquim]

i put these control in form, then i close the form. but when i open it again, my vb 6 crashes without tell me why(no error message is showed)
can anyone advice me?
heres my groupproject: http://www.megaupload.com/?d=6U3XMNWU
(i don't have space for put it in my count)

[LaVolpe]

If using subclassing or callbacks, rem out code that subclasses or callbacks. See if problem continues. If it doesn't, then your problem is with your subclassing/callback routines? Just a guess

[joaquim]

If using subclassing or callbacks, rem out code that subclasses or callbacks. See if problem continues. If it does, then your problem is with your subclassing/callback routines? Just a guess

no but i found the problem:

Public Function ChangeBackcolor(OriginalPicture As PictureBox, DestinationPicture As PictureBox, BackColor As Long)
    Dim hdc As Long, hOldBmp As Long
    hdc = CreateCompatibleDC(0&)
    hOldBmp = SelectObject(hdc, OriginalPicture.Picture.Handle)
    If OriginalPicture = DestinationPicture Then
        OriginalPicture.Picture = LoadPicture("")
        OriginalPicture.BackColor = BackColor
        TransparentBlt OriginalPicture.hdc, 0, 0, OriginalPicture.Width, OriginalPicture.Height, hdc, 0, 0, OriginalPicture.Width, OriginalPicture.Height, GetPixel(hdc, 0, 0)
        OriginalPicture.Picture = OriginalPicture.Image
    Else
        DestinationPicture.Picture = LoadPicture("")
        DestinationPicture.BackColor = BackColor
        TransparentBlt DestinationPicture.hdc, 0, 0, OriginalPicture.Width, OriginalPicture.Height, hdc, 0, 0, OriginalPicture.Width, OriginalPicture.Height, GetPixel(hdc, 0, 0)
        DestinationPicture.Picture = DestinationPicture.Image
    End If
    Call SelectObject(hdc, hOldBmp)
    Call DeleteDC(hdc)
End Function

these sub was by getpixel() and setpixel() then the cpu needed more time. but i build this new sub and it's more faster
thanks for your help my friend