[VB6] - 2D Level Editor problems-VBForums
Results 1 to 4 of 4

Thread: [VB6] - 2D Level Editor problems

  1. #1

    Thread Starter
    PowerPoster joaquim's Avatar
    Join Date
    Apr 2007
    Posts
    2,922

    [VB6] - 2D Level Editor problems

    i'm building an 2D Level Editor, but my scrollbar max values aren't correct
    can anyone advice me?
    Code:
    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
    End Sub
    Last edited by joaquim; Feb 5th, 2012 at 04:09 PM.
    VB6 2D Sprite control

    To live is difficult, but we do it.

  2. #2

    Thread Starter
    PowerPoster joaquim's Avatar
    Join Date
    Apr 2007
    Posts
    2,922

    Re: [VB6] - 2D Level Editor problems

    heres the entire code:
    Code:
    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
        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
        UserControl.BackColor = lngBackColor
        ChangeImageColor picView, picView, GetPixel(picView.hDC, 0, 0), lngBackColor
        
        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 = Image
         Call ScrollingValues
    End Property
    
    Public Property Get Image() As Picture
        Set Image = picView.Image
    End Property
    i need some advice how can i change the backcolor more faster using another picturebox
    Last edited by joaquim; Feb 5th, 2012 at 04:09 PM.
    VB6 2D Sprite control

    To live is difficult, but we do it.

  3. #3

    Thread Starter
    PowerPoster joaquim's Avatar
    Join Date
    Apr 2007
    Posts
    2,922

    Re: [VB6] - 2D Level Editor problems

    heres how i do that:
    Code:
    ~Public Sub ChangeBackcolor(ByRef PicSource As Control, ByRef PicDestiny As Control, ByRef BackColor As Long)
       
        Dim mdc As Long
        Dim mBMP As Long
       
        Dim lngBackColor As Long
        
        mdc = CreateCompatibleDC(PicSource.hDC)
        mBMP = CreateCompatibleBitmap(PicSource.hDC, PicSource.ScaleWidth, PicSource.ScaleHeight)
        SelectObject mdc, mBMP
        BitBlt mdc, 0, 0, PicSource.ScaleWidth, PicSource.ScaleHeight, PicSource.hDC, 0, 0, vbSrcCopy
        lngBackColor = GetPixel(mdc, 0, 0)
        PicDestiny.Picture = Nothing
        PicDestiny.BackColor = BackColor
        TransparentBlt PicDestiny.hDC, 0, 0, PicSource.ScaleWidth, PicSource.ScaleHeight, mdc, 0, 0, PicSource.ScaleWidth, PicSource.ScaleHeight, lngBackColor
        PicDestiny.Refresh
        PicDestiny.Picture = PicDestiny.Image
        DeleteObject mBMP
        DeleteDC mdc
    
    End Sub
    i'm testing the scroll max size, but something isn't right
    when the picturebox have the usercontrol same size, and the scrollbar is visible, the scrollbar stay disabled
    heres how calculate for vertical scrool bar:
    Code:
    ScrollingVertical.Max = picView.ScaleHeight - UserControl.ScaleHeight
        If ScrollingVertical.Visible = True Then ScrollingVertical.Max = ScrollingVertical.Max + ScrollingHorizontal.Height
    can anyone advice about these calculation?
    VB6 2D Sprite control

    To live is difficult, but we do it.

  4. #4

    Thread Starter
    PowerPoster joaquim's Avatar
    Join Date
    Apr 2007
    Posts
    2,922

    Re: [VB6] - 2D Level Editor problems

    finally i put it to work:
    Code:
    ScrollingVertical.Max = picView.Height - UserControl.ScaleHeight + IIf(ShowScrollingBars = Vertical Or ShowScrollingBars = both, ScrollingHorizontal.Height, 0)
        ScrollingHorizontal.Max = picView.Width - UserControl.ScaleWidth + IIf(ShowScrollingBars = Horizontal Or ShowScrollingBars = both, ScrollingVertical.Width, 0)
    and works fine.. thanks
    VB6 2D Sprite control

    To live is difficult, but we do it.

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

Survey posted by VBForums.