[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
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
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?
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