VERSION 5.00
Begin VB.UserControl XScroll 
   ClientHeight    =   3600
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4800
   ScaleHeight     =   240
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   320
   ToolboxBitmap   =   "XScroll.ctx":0000
   Begin VB.VScrollBar vsb 
      Height          =   2895
      Left            =   0
      TabIndex        =   1
      Top             =   0
      Visible         =   0   'False
      Width           =   255
   End
   Begin VB.HScrollBar hsb 
      Height          =   255
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   2655
   End
End
Attribute VB_Name = "XScroll"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'Standard-Eigenschaftswerte:
Const m_def_BackColor = 0
Const m_def_ForeColor = 0
Const m_def_BorderColor = vbWhite

'Eigenschaftsvariablen:
Dim m_BackColor As OLE_COLOR
Dim m_ForeColor As OLE_COLOR
Dim m_BorderColor As OLE_COLOR


Dim m_Alpha As Long


Dim m_Max As Double
Dim m_Min As Double
Dim m_Value As Double

Dim m_Orientation As Boolean

Public Engine As cS2DCTLEngine

Public posTop As Double
Public posLeft As Double

Public ctlVisible As Boolean
Public MySpr As New cS2DSprite

Public fnt As cS2DText
'Ereignisdeklarationen:

Public Event Click()
Public Event Change()
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 ID As String


Const BoxWidth = 16

Dim m_x As Integer
Dim m_y As Integer

'Public Event XClick()


Public Property Get Orientation() As Boolean
Orientation = m_Orientation
End Property

Public Property Let Orientation(vnew As Boolean)

m_Orientation = vnew
hsb.Visible = Not vnew
vsb.Visible = vnew

PropertyChanged "Orientation"
End Property

Public Property Get BorderColor() As OLE_COLOR
    BorderColor = m_BorderColor
End Property

Public Property Let BorderColor(vnew As OLE_COLOR)
    m_BorderColor = vnew
    PropertyChanged "BorderColor"
End Property

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

Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
    m_BackColor = New_BackColor
    PropertyChanged "BackColor"
End Property

Public Property Get Alpha() As Integer
    Alpha = m_Alpha
End Property

Public Property Let Alpha(newalpha As Integer)
m_Alpha = newalpha
PropertyChanged "Alpha"
End Property

Public Property Get Min() As Double
    Min = m_Min

End Property

Public Property Let Min(vnew As Double)
    m_Min = vnew
    PropertyChanged "Min"
End Property

Public Property Get Max() As Double
    Max = m_Max
End Property

Public Property Let Max(vnew As Double)
    m_Max = vnew
    PropertyChanged "Max"
End Property

Public Property Get Value() As Double
Value = m_Value
End Property

Public Property Let Value(vnew As Double)
If vnew > m_Max Then
m_Value = m_Max
ElseIf vnew < m_Min Then
m_Value = m_Min
Else
m_Value = vnew
End If

PropertyChanged "Value"
RaiseEvent Change
End Property


'ACHTUNG! DIE FOLGENDEN KOMMENTIERTEN ZEILEN NICHT ENTFERNEN ODER VERÄNDERN!
'MemberInfo=10,0,0,0
Public Property Get ForeColor() As OLE_COLOR
    ForeColor = m_ForeColor
End Property

Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
    m_ForeColor = New_ForeColor
    PropertyChanged "ForeColor"
End Property



Public Sub Init()
Set fnt = New cS2DText
Set fnt.S2D = Engine.S2D

Set MySpr.S2D = Engine.S2D
MySpr.Initialize Engine.SpritePath & "\border.bmp", vbMagenta

End Sub

'Eigenschaften für Benutzersteuerelement initialisieren
Private Sub UserControl_InitProperties()
    m_BackColor = m_def_BackColor
    m_ForeColor = m_def_ForeColor
    m_Alpha = 255
    m_BorderColor = m_def_BorderColor
    m_Max = 255
    m_Min = 0
    m_Value = 50
    m_Orientation = False
End Sub

'Eigenschaftenwerte vom Speicher laden
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

    m_Alpha = PropBag.ReadProperty("Alpha", 255)
    m_BackColor = PropBag.ReadProperty("BackColor", m_def_BackColor)
    m_ForeColor = PropBag.ReadProperty("ForeColor", m_def_ForeColor)
    m_BorderColor = PropBag.ReadProperty("BorderColor", m_def_BorderColor)
    m_Min = PropBag.ReadProperty("Min", 0)
    m_Max = PropBag.ReadProperty("Max", 255)
    m_Value = PropBag.ReadProperty("Value", 50)
    m_Orientation = PropBag.ReadProperty("Orientation", False)
    
    vsb.Visible = m_Orientation
    hsb.Visible = Not m_Orientation
End Sub

Private Sub UserControl_Resize()
hsb.Width = UserControl.ScaleWidth
hsb.Height = UserControl.ScaleHeight

vsb.Width = hsb.Width
vsb.Height = hsb.Height
End Sub

'Eigenschaftenwerte in den Speicher schreiben
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("Alpha", m_Alpha, 255)
    Call PropBag.WriteProperty("BackColor", m_BackColor, m_def_BackColor)
    Call PropBag.WriteProperty("ForeColor", m_ForeColor, m_def_ForeColor)
    Call PropBag.WriteProperty("BorderColor", m_BorderColor, m_def_BorderColor)
    Call PropBag.WriteProperty("Min", m_Min, 0)
    Call PropBag.WriteProperty("Max", m_Max, 255)
    Call PropBag.WriteProperty("Value", m_Value, 50)
    Call PropBag.WriteProperty("Orientation", m_Orientation, False)
End Sub

Public Sub OnMouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseUp(Button, Shift, X, Y)
RaiseEvent Click
End Sub


Public Sub OnMouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then

Dim percent As Double

If Orientation Then
percent = ((Y - m_y) / (UserControl.ScaleHeight - 30))
Else
percent = ((X - m_x) / (UserControl.ScaleWidth - 30))

End If
Value = Value + percent * (m_Max - m_Min)
m_x = X
m_y = Y
End If


RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub

Public Sub OnMouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
m_x = X
m_y = Y
RaiseEvent MouseDown(Button, Shift, X, Y)
End Sub

Public Sub OnKeyDown(KeyCode As Integer, Shift As Integer)
RaiseEvent KeyDown(KeyCode, Shift)
End Sub

Public Sub OnKeyUp(KeyCode As Integer, Shift As Integer)
RaiseEvent KeyUp(KeyCode, Shift)
End Sub


Public Function ToString() As String
ToString = "scrl [" & Min & " < " & Value & " < " & Max & "]"
End Function

Public Sub Render()

If Not Engine.CurCtl Is Nothing Then
If Engine.CurCtl.ID = ID Then

If Engine.MouseIsDown Then
DrawBrightRect
Else
DrawFreakyRect
End If

Else
DrawNormalRect
End If

Else
DrawNormalRect

End If


RenderBorder


If Orientation Then
RenderBoxVert
Else
RenderBoxHorz
End If
'fnt.DrawTextSimple posLeft + UserControl.ScaleWidth / 2 - UserControl.TextWidth(Caption) / 2, posTop + UserControl.ScaleHeight / 2 - UserControl.TextHeight(Caption) / 2, Caption, 1, Alpha, 0, , ForeColor



End Sub


Private Sub DrawFreakyRect()
Dim clr As ColorRGB
clr = SplitColor(BackColor)

Dim clr1 As Long, clr2 As Long, clr3 As Long
clr1 = RGB(clr.r, clr.g, clr.b)
clr2 = RGB(clr.r + 30, clr.g + 30, clr.b + 30)
clr3 = RGB(clr.r + 60, clr.g + 60, clr.b + 60)


Dim dest As RECT
dest.Left = posLeft + 1
dest.Top = posTop + 1
dest.bottom = UserControl.ScaleHeight - 2
dest.Right = UserControl.ScaleWidth - 2

Engine.S2D.Effects.GradiantRect dest, clr1, clr2, clr2, clr3, Alpha

End Sub

Private Sub DrawBrightRect()
Dim clr As ColorRGB
clr = SplitColor(BackColor)

Dim clr1 As Long, clr2 As Long, clr3 As Long
clr1 = RGB(clr.r, clr.g, clr.b)
clr2 = RGB(clr.r + 40, clr.g + 40, clr.b + 40)
clr3 = RGB(clr.r + 80, clr.g + 80, clr.b + 80)


Dim dest As RECT
dest.Left = posLeft + 1
dest.Top = posTop + 1
dest.bottom = UserControl.ScaleHeight - 2
dest.Right = UserControl.ScaleWidth - 2

Engine.S2D.Effects.GradiantRect dest, clr1, clr2, clr2, clr3

End Sub

Private Sub DrawNormalRect()
Dim clr As ColorRGB
clr = SplitColor(BackColor)

Dim clr1 As Long, clr2 As Long, clr3 As Long
clr1 = RGB(clr.r, clr.g, clr.b)
clr2 = RGB(clr.r + 15, clr.g + 15, clr.b + 15)
clr3 = RGB(clr.r + 30, clr.g + 30, clr.b + 30)

Dim dest As RECT
dest.Left = posLeft + 1
dest.Top = posTop + 1
dest.bottom = UserControl.ScaleHeight - 2
dest.Right = UserControl.ScaleWidth - 2

Engine.S2D.Effects.GradiantRect dest, clr1, clr2, clr2, clr3, Alpha
End Sub

Public Sub RenderBoxHorz()
With MySpr
Dim h As Integer, w As Integer
h = UserControl.ScaleHeight
w = UserControl.ScaleWidth

Dim ofs As Integer
ofs = ((Value - Min) / (Max - Min)) * ((w - (BoxWidth + 8)) - 4)


.Render ofs + posLeft + 2, posTop + 2, 4, 4, 0, 0, 4, 4, , , m_ForeColor, m_ForeColor, m_ForeColor, m_ForeColor
.Render ofs + posLeft + 2, posTop + h - 5, 4, 4, 0, 8, 4, 4, , , m_ForeColor, m_ForeColor, m_ForeColor, m_ForeColor
.Render ofs + posLeft + 2 + 4 + BoxWidth, posTop + 2, 4, 4, 8, 0, 4, 4, , , m_ForeColor, m_ForeColor, m_ForeColor, m_ForeColor
.Render ofs + posLeft + 2 + 4 + BoxWidth, posTop + h - 5, 4, 4, 8, 8, 4, 4, , , m_ForeColor, m_ForeColor, m_ForeColor, m_ForeColor

.Render ofs + posLeft + 6, posTop + 2, BoxWidth, 4, 4, 0, 4, 4, , , m_ForeColor, m_ForeColor, m_ForeColor, m_ForeColor
.Render ofs + posLeft + 6, posTop + h - 5, BoxWidth, 4, 4, 8, 4, 4, , , m_ForeColor, m_ForeColor, m_ForeColor, m_ForeColor

.Render ofs + posLeft + 2, posTop + 2 + 4, 4, h - 8 - 2, 0, 4, 4, 4, , , m_ForeColor, m_ForeColor, m_ForeColor, m_ForeColor
.Render ofs + posLeft + 2 + 4 + BoxWidth, posTop + 2 + 4, 4, h - 8 - 2, 8, 4, 4, 4, , , m_ForeColor, m_ForeColor, m_ForeColor, m_ForeColor


End With
End Sub

Public Sub RenderBoxVert()
With MySpr
Dim h As Integer, w As Integer
h = UserControl.ScaleHeight
w = UserControl.ScaleWidth

Dim ofs As Integer

If Max = Min Then
ofs = 0
Else
ofs = ((Value - Min) / (Max - Min)) * ((h - (BoxWidth + 8)) - 4)
End If

.Render posLeft + 2, ofs + posTop + 2, 4, 4, 0, 0, 4, 4, , , m_ForeColor, m_ForeColor, m_ForeColor, m_ForeColor
.Render posLeft + w - 5, ofs + posTop + 2, 4, 4, 8, 0, 4, 4, , , m_ForeColor, m_ForeColor, m_ForeColor, m_ForeColor
.Render posLeft + 2, ofs + posTop + 2 + 4 + BoxWidth, 4, 4, 0, 8, 4, 4, , , m_ForeColor, m_ForeColor, m_ForeColor, m_ForeColor
.Render posLeft + w - 5, ofs + posTop + 2 + 4 + BoxWidth, 4, 4, 8, 8, 4, 4, , , m_ForeColor, m_ForeColor, m_ForeColor, m_ForeColor

.Render posLeft + 2, ofs + posTop + 2 + 4, 4, BoxWidth, 0, 4, 4, 4, , , m_ForeColor, m_ForeColor, m_ForeColor, m_ForeColor
.Render posLeft + w - 4, ofs + posTop + 2 + 4, 4, BoxWidth, 0, 4, 4, 4, , , m_ForeColor, m_ForeColor, m_ForeColor, m_ForeColor
.Render posLeft + 2 + 4, ofs + posTop + 2, w - 8 - 3, 4, 4, 0, 4, 4, , , m_ForeColor, m_ForeColor, m_ForeColor, m_ForeColor
.Render posLeft + 2 + 4, ofs + posTop + 2 + BoxWidth + 4, w - 8 - 3, 4, 4, 8, 4, 4, , , m_ForeColor, m_ForeColor, m_ForeColor, m_ForeColor

End With
End Sub

Public Sub RenderBorder()

With MySpr
.Render posLeft, posTop, 4, 4, 0, 0, 4, 4, Alpha, , m_BorderColor, m_BorderColor, m_BorderColor, m_BorderColor
.Render posLeft + 4, posTop, UserControl.ScaleWidth - 8, 4, 4, 0, 4, 4, Alpha, , m_BorderColor, m_BorderColor, m_BorderColor, m_BorderColor
.Render posLeft + UserControl.ScaleWidth - 4, posTop, 4, 4, 8, 0, 4, 4, Alpha, , m_BorderColor, m_BorderColor, m_BorderColor, m_BorderColor
.Render posLeft, posTop + 4, 4, UserControl.ScaleHeight - 8, 0, 4, 4, 4, Alpha, , m_BorderColor, m_BorderColor, m_BorderColor, m_BorderColor
.Render posLeft + UserControl.ScaleWidth - 4, posTop + 4, 4, UserControl.ScaleHeight - 8, 8, 4, 4, 4, Alpha, , m_BorderColor, m_BorderColor, m_BorderColor, m_BorderColor
.Render posLeft, posTop + UserControl.ScaleHeight - 4, 4, 4, 0, 8, 4, 4, Alpha, , m_BorderColor, m_BorderColor, m_BorderColor, m_BorderColor
.Render posLeft + 4, posTop + UserControl.ScaleHeight - 4, UserControl.ScaleWidth - 8, 4, 4, 8, 4, 4, Alpha, , m_BorderColor, m_BorderColor, m_BorderColor, m_BorderColor
.Render posLeft + UserControl.ScaleWidth - 4, posTop + UserControl.ScaleHeight - 4, 4, 4, 8, 8, 4, 4, Alpha, , m_BorderColor, m_BorderColor, m_BorderColor, m_BorderColor

End With

End Sub

