VERSION 5.00
Begin VB.UserControl XEdTileSet 
   ClientHeight    =   3600
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4800
   ScaleHeight     =   240
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   320
   Begin VB.PictureBox pic 
      BackColor       =   &H00E1A822&
      Height          =   1935
      Left            =   0
      ScaleHeight     =   125
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   117
      TabIndex        =   0
      Top             =   0
      Width           =   1815
   End
End
Attribute VB_Name = "XEdTileSet"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'Standard-Eigenschaftswerte:
Private posTop                       As Double
Private posLeft                      As Double
Public Event Click()
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 MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Public Event KeyDown(KeyCode As Integer, Shift As Integer)
Public Event KeyUp(KeyCode As Integer, Shift As Integer)
Public Event Change()
Public DestObj                      As Long
Private ID                           As String
Private m_BorderColor                As OLE_COLOR
Private Const m_def_BorderColor      As Long = vbWhite
Private TSScrollX                    As Double
Private TSScrollY                    As Double
Private m_x                          As Long
Private m_y                          As Long
Private n_x                          As Long
Private n_y                          As Long
Private ms_x                          As Long
Private ms_y                          As Long
Private m_SelTileX                   As Long
Private m_SelTileY                   As Long
Private m_SelTileWidth               As Long
Private m_SelTileHeight              As Long
Public TileSet                      As Integer
Public TintColor                    As Long
Public IgnoreRM2K As Boolean

Public Property Get BorderColor() As OLE_COLOR

    BorderColor = m_BorderColor

End Property

Public Property Let BorderColor(ByVal vNew As OLE_COLOR)

    m_BorderColor = vNew
    PropertyChanged "BorderColor"

End Property

Public Sub Init()

End Sub

Public Sub pic_KeyDown(KeyCode As Integer, _
                       Shift As Integer)

    RaiseEvent KeyDown(KeyCode, Shift)

End Sub

Public Sub pic_KeyUp(KeyCode As Integer, _
                     Shift As Integer)

    RaiseEvent KeyUp(KeyCode, Shift)

End Sub

Public Sub pic_MouseDown(Button As Integer, _
                         Shift As Integer, _
                         x As Single, _
                         y As Single)

  Dim t_x As Long
  Dim t_Y As Long


    If Button = 1 Then
        t_x = x + TSScrollX
        t_Y = y + TSScrollY
        n_x = x
        n_y = y
        m_SelTileX = (t_x - (t_x Mod (DrawModeWidth))) / (Const_TileWidth)  'Snap(t_x, CInt(DrawModeWidth)) / Const_TileWidth  '
        m_SelTileY = (t_Y - (t_Y Mod (DrawModeHeight))) / (Const_TileHeight)   'Snap(t_Y, CInt(DrawModeHeight)) / Const_TileHeight  '
        m_SelTileWidth = DrawModeWidth / Const_TileWidth
        m_SelTileHeight = DrawModeHeight / Const_TileHeight
        RaiseEvent Change
    End If
    If Button = 2 Then
        m_x = x
        m_y = y
    End If
    RaiseEvent MouseDown(Button, Shift, x, y)

End Sub

Public Sub pic_MouseMove(Button As Integer, _
                         Shift As Integer, _
                         x As Single, _
                         y As Single)
        ms_x = x
        ms_y = y
 

 
  Dim s_x  As Long
  Dim s_y  As Long
  Dim t_x  As Long
  Dim t_Y  As Long
  Dim sprw As Long
  Dim sprh As Long
  
  Dim u_x As Long
  Dim u_y As Long
  Dim v_x As Long
  Dim v_y As Long
  
    If Button = 1 Then
    

        s_x = x + TSScrollX
        s_y = y + TSScrollY
        
        u_x = n_x + TSScrollX
        u_y = n_y + TSScrollY
        
        v_x = (u_x - (u_x Mod DrawModeWidth)) / Const_TileWidth
        v_y = (u_y - (u_y Mod DrawModeHeight)) / Const_TileHeight
        
        t_x = (s_x - (s_x Mod DrawModeWidth)) / Const_TileWidth
        t_Y = (s_y - (s_y Mod DrawModeHeight)) / Const_TileHeight
        
        If t_x > v_x Then
        m_SelTileWidth = t_x - v_x + 1
        Else
        m_SelTileWidth = v_x - t_x + 1
        m_SelTileX = t_x
        End If
        
        If t_Y > v_y Then
        m_SelTileHeight = t_Y - v_y + 1
        Else
        m_SelTileHeight = v_y - t_Y + 1
        m_SelTileY = t_Y
        End If

        
        m_SelTileWidth = m_SelTileWidth * Const_TileWidth
        m_SelTileWidth = (m_SelTileWidth + (m_SelTileWidth Mod DrawModeWidth)) / Const_TileWidth
        m_SelTileHeight = m_SelTileHeight * Const_TileHeight
        m_SelTileHeight = (m_SelTileHeight + (m_SelTileHeight Mod DrawModeHeight)) / Const_TileHeight
        
        
        If m_SelTileWidth < (DrawModeWidth / Const_TileWidth) Then
            m_SelTileWidth = (DrawModeWidth / Const_TileWidth)
        End If
        If m_SelTileHeight < (DrawModeHeight / Const_TileHeight) Then
            m_SelTileHeight = (DrawModeHeight / Const_TileHeight)
        End If
        RaiseEvent Change
    End If
    If Button = 2 Then
        If TileSet = 0 Then
            Exit Sub
        End If
        TSScrollX = TSScrollX + m_x - x
        TSScrollY = TSScrollY + m_y - y
        sprw = GFX.TexturePool.TextureWidth(TileSet)
        sprh = GFX.TexturePool.TextureHeight(TileSet)
        If TSScrollX > sprw - UserControl.ScaleWidth Then
            TSScrollX = sprw - UserControl.ScaleWidth
        End If
        If TSScrollY > sprh - UserControl.ScaleHeight Then
            TSScrollY = sprh - UserControl.ScaleHeight
        End If
        If TSScrollX < 0 Then
            TSScrollX = 0
        End If
        If TSScrollY < 0 Then
            TSScrollY = 0
        End If
        m_x = x
        m_y = y
    End If
    RaiseEvent MouseMove(Button, Shift, x, y)

End Sub

Public Sub pic_MouseUp(Button As Integer, _
                       Shift As Integer, _
                       x As Single, _
                       y As Single)
                       


    RaiseEvent MouseUp(Button, Shift, x, y)
    RaiseEvent Click

End Sub

Public Sub Render()
        
    Dim ts     As Integer
    Dim oldzoom As Double
    Dim engine As cS2D_i
    Dim tsw    As Integer
    Dim tsh    As Integer
    Dim rctX   As Double
    Dim rctY   As Double
    Dim rctW   As Double
    Dim rctH   As Double
    
    oldzoom = ZoomFactor
    ZoomFactor = 1
    Dim oldW As Integer
    Dim oldH As Integer
    oldW = ScreenWidth
    oldH = ScreenHeight
    
    If TileSet = 0 Then
        Exit Sub
    End If
    ts = TileSet
    Set engine = GFX
    
    GFX.Resize pic.ScaleWidth, pic.ScaleHeight
    GFX.Clear
    GFX.BeginScene
       
    TranspBack.RenderTiled 0 - (TSScrollX Mod 32), 0 - (TSScrollY Mod 32), pic.ScaleWidth + (TSScrollX Mod 32), pic.ScaleHeight + (TSScrollY Mod 32)
    tsw = min(engine.TexturePool.TextureWidth(ts), pic.ScaleWidth)
    tsh = min(engine.TexturePool.TextureHeight(ts), pic.ScaleHeight)
    engine.TexturePool.RenderTexture ts, posLeft, posTop, tsw, tsh, tsw, tsh, CInt(TSScrollX), CInt(TSScrollY), , , , , , TintColor
    rctX = posLeft + m_SelTileX * Const_TileWidth - TSScrollX + 1
    rctY = posTop + m_SelTileY * Const_TileHeight - TSScrollY + 1
    rctW = Const_TileWidth * m_SelTileWidth - 1
    rctH = Const_TileHeight * m_SelTileHeight - 1
    If rctX >= pic.ScaleWidth + posLeft Then
        GoTo nodraw
    End If
    If rctY >= pic.ScaleHeight + posTop Then
        GoTo nodraw
    End If
    'If rctX + rctW >= UserControl.ScaleWidth + posLeft - 2 Then rctW = UserControl.ScaleWidth - rctX + posLeft - 2
    'If rctY + rctH >= UserControl.ScaleHeight + posTop - 2 Then rctH = UserControl.ScaleHeight - rctY + posTop - 2
    If rctX + rctW <= posLeft Then
        GoTo nodraw
    End If
    If rctY + rctH <= posTop Then
        GoTo nodraw
    End If
    'If rctX <= posLeft + 2 Then rctW = (m_SelTileWidth * Const_TileWidth) - (posLeft - rctX + 2): rctX = posLeft + 2
    'If rctY <= posTop + 2 Then rctH = (m_SelTileHeight * Const_TileHeight) - (posTop - rctY + 2): rctY = posTop + 2
    Effects.RenderBorderRect CInt(rctX), CInt(rctY), CInt(rctW), CInt(rctH), TintColor, 200, 2, 9999
    Effects.RenderRectangle CInt(rctX), CInt(rctY), CInt(rctW), CInt(rctH), vbWhite, vbWhite, vbWhite, vbBlack, 80, 9999
    
    
nodraw:

If Not IgnoreRM2K Then
    Dim i As Integer
    
    For i = 1 To RM2K_Path_Count
    If RM2K_Paths(i).TileSet = CurrentTileset Then
    Dim rm As RECT
    rm2k.RenderTiled RM2K_Paths(i).x - TSScrollX, RM2K_Paths(i).y - TSScrollY + Const_TileHeight, Const_TileWidth * 3, Const_TileHeight * 3, 150, , vbGreen
    rm2k.RenderTiled RM2K_Paths(i).x - TSScrollX + Const_TileWidth, RM2K_Paths(i).y - TSScrollY, Const_TileWidth * 2, Const_TileHeight, 150, , vbGreen
    End If
    Next i
    
    For i = 1 To RM2K_Animation_Count
    If RM2K_Animations(i).TileSet = CurrentTileset Then
    rm2k.RenderTiled RM2K_Animations(i).x - TSScrollX, RM2K_Animations(i).y - TSScrollY + Const_TileHeight, Const_TileWidth, Const_TileHeight * 3 + 1, 150, , vbYellow
    End If
    Next i
    
    For i = 1 To RM2K_AnimatedPath_Count
    
    If i < 2 Then
    If RM2K_AnimatedPaths(i).TileSet = CurrentTileset Then
    rm2k.RenderTiled RM2K_AnimatedPaths(i).x - TSScrollX, RM2K_AnimatedPaths(i).y - TSScrollY + Const_TileHeight, 1 * Const_TileWidth, 5 * Const_TileHeight, 150, , vbBlue
    rm2k.RenderTiled RM2K_AnimatedPaths(i).x - TSScrollX, RM2K_AnimatedPaths(i).y - TSScrollY + 7 * Const_TileHeight, 1 * Const_TileWidth, 1 * Const_TileHeight, 150, , vbBlue
    rm2k.RenderTiled RM2K_AnimatedPaths(i).x - TSScrollX + Const_TileWidth, RM2K_AnimatedPaths(i).y - TSScrollY, 2 * Const_TileWidth, 8 * Const_TileHeight, 150, , vbBlue
    rm2k.RenderTiled RM2K_AnimatedPaths(i).x - TSScrollX + 4 * Const_TileWidth, RM2K_AnimatedPaths(i).y - TSScrollY, 2 * Const_TileWidth, 1 * Const_TileHeight, 150, , vbBlue
    rm2k.RenderTiled RM2K_AnimatedPaths(i).x - TSScrollX + 3 * Const_TileWidth, RM2K_AnimatedPaths(i).y - TSScrollY + Const_TileHeight, 3 * Const_TileWidth, 3 * Const_TileHeight, 150, , vbBlue
    End If
    End If
    
    Next i
    
    For i = 1 To RMXP_AnimatedPath_Count
    If RMXP_AnimatedPaths(i).TileSet = CurrentTileset Then
    rm2k.RenderTiled RMXP_AnimatedPaths(i).x - TSScrollX, RMXP_AnimatedPaths(i).y - TSScrollY + Const_TileHeight, Const_TileWidth * 12, Const_TileHeight * 3, 150, , vbRed
    rm2k.RenderTiled RMXP_AnimatedPaths(i).x - TSScrollX + Const_TileWidth, RMXP_AnimatedPaths(i).y - TSScrollY, Const_TileWidth * 11, Const_TileHeight, 150, , vbRed
    End If
    Next i
    
End If
    
    
        Effects.RenderRectangle ms_x - 1, ms_y - 1, 3, 3

    
    GFX.EndScene
    GFX.Flip DestObj
    ZoomFactor = oldzoom
    GFX.Resize frmEdMap.picRender.ScaleWidth, frmEdMap.picRender.ScaleHeight
    
End Sub

Public Property Get SelTileHeight() As Long

    SelTileHeight = m_SelTileHeight

End Property

Public Property Let SelTileHeight(ByVal vNew As Long)

    m_SelTileHeight = vNew

End Property

Public Property Get SelTileWidth() As Long

    SelTileWidth = m_SelTileWidth

End Property

Public Property Let SelTileWidth(ByVal vNew As Long)

    m_SelTileWidth = vNew

End Property

Public Property Get SelTileX() As Long

    SelTileX = m_SelTileX

End Property

Public Property Let SelTileX(ByVal vNew As Long)

    m_SelTileX = vNew

End Property

Public Property Get SelTileY() As Long

    SelTileY = m_SelTileY

End Property

Public Property Let SelTileY(ByVal vNew As Long)

  '<:-) :WARNING: 'ByVal ' inserted for Parameter  'vnew As Long'

    m_SelTileY = vNew

End Property

Public Property Get MouseX() As Long
MouseX = m_x
End Property

Public Property Get MouseY() As Long
MouseY = m_y
End Property

Public Function ToString() As String

    ToString = "tileset"

End Function

Private Sub UserControl_Initialize()

    TintColor = vbWhite

End Sub

Private Sub UserControl_InitProperties()

    m_BorderColor = m_def_BorderColor

End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

    m_BorderColor = PropBag.ReadProperty("BorderColor", m_def_BorderColor)

End Sub

Private Sub UserControl_Resize()

    pic.Width = UserControl.ScaleWidth
    pic.Height = UserControl.ScaleHeight

End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

    Call PropBag.WriteProperty("BorderColor", m_BorderColor, m_def_BorderColor)

End Sub

Public Property Get ScaleWidth() As Long
    ScaleWidth = pic.ScaleWidth
End Property


Public Property Get ScaleHeight() As Long
    ScaleHeight = pic.ScaleHeight
End Property
