VERSION 5.00
Begin VB.UserControl XList 
   ClientHeight    =   3450
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   3660
   ScaleHeight     =   230
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   244
   ToolboxBitmap   =   "XList.ctx":0000
   Begin VB.PictureBox vsb 
      Height          =   3375
      Left            =   3360
      ScaleHeight     =   3315
      ScaleWidth      =   195
      TabIndex        =   1
      Top             =   0
      Width           =   255
   End
   Begin VB.ListBox lst 
      Height          =   3375
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   3255
   End
End
Attribute VB_Name = "XList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False







Option Explicit
Const m_def_BorderColor = vbWhite


Public Engine As cS2DCTLEngine

Public posTop As Double
Public posLeft As Double
Public ctlVisible As Boolean
Public fnt As cS2DText
Public Misc As String
Dim m_Alpha As Long
Dim m_BorderColor As OLE_COLOR
Dim m_HLColor As OLE_COLOR
Dim m_Text As String
Dim m_DisplayLines As Integer
Dim m_LineHeight As Integer
Dim m_Scrolling As Boolean

Public ListIndex As Integer

Public List As New CHive


Public MySpr As New cS2DSprite

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 KeyPress(KeyAscii As Integer)

Public ID As String

Const ValidChars = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789!""§$%&/()=?`´ß\²³|><µ;,.:-_öäüÄÖÜ+*~'#^° "

Private Sub UserControl_InitProperties()
    m_Alpha = 255
    m_BorderColor = m_def_BorderColor
    Scrolling = True
End Sub

Private Sub UserControl_Resize()
lst.Width = UserControl.ScaleWidth - vsb.Width
vsb.Top = posTop
vsb.Left = lst.Width + posLeft
vsb.Height = UserControl.ScaleHeight

lst.Height = UserControl.ScaleHeight

Dim s As String
Dim lc As Integer

m_LineHeight = UserControl.TextHeight(" ")
Do
lc = lc + 1
If UserControl.TextHeight(String(lc, vbCrLf)) >= UserControl.ScaleHeight Then Exit Do

Loop
m_DisplayLines = lc
End Sub

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 Scrolling() As Boolean
    Scrolling = m_Scrolling
End Property

Public Property Let Scrolling(vNew As Boolean)
    m_Scrolling = vNew
    PropertyChanged "Scrolling"
End Property

Public Sub UpdateScrollingStat()
    vsb.ctlVisible = m_Scrolling
    vsb.Visible = m_Scrolling
    If m_Scrolling = False Then
    vsb.Width = 0
    Else
    vsb.Width = 14
    End If
    
    UserControl_Resize
End Sub
Public Property Get HLColor() As OLE_COLOR
    HLColor = m_HLColor
End Property

Public Property Let HLColor(vNew As OLE_COLOR)
    m_HLColor = vNew
    PropertyChanged "HLColor"
End Property

Public Property Get BorderColorScroll() As OLE_COLOR
    BorderColorScroll = vsb.BorderColor
End Property

Public Property Let BorderColorScroll(vNew As OLE_COLOR)
    vsb.BorderColor = vNew
    PropertyChanged "BorderColorScroll"
End Property

Public Property Get BackColor() As OLE_COLOR
Attribute BackColor.VB_Description = "Gibt die Hintergrundfarbe zurück, die verwendet wird, um Text und Grafik in einem Objekt anzuzeigen, oder legt diese fest."
    BackColor = lst.BackColor
End Property

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

Public Property Get BackColorScroll() As OLE_COLOR
    BackColorScroll = vsb.BackColor
End Property

Public Property Let BackColorScroll(ByVal New_BackColor As OLE_COLOR)
    vsb.BackColor = New_BackColor
    PropertyChanged "BackColorScroll"
End Property

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

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

'ACHTUNG! DIE FOLGENDEN KOMMENTIERTEN ZEILEN NICHT ENTFERNEN ODER VERÄNDERN!
'MappingInfo=txt,txt,-1,ForeColor
Public Property Get ForeColor() As OLE_COLOR
Attribute ForeColor.VB_Description = "Gibt die Vordergrundfarbe zurück, die zum Anzeigen von Text und Grafiken in einem Objekt verwendet wird, oder legt diese fest."
    ForeColor = lst.ForeColor
End Property

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

Public Property Get ForeColorScroll() As OLE_COLOR
    ForeColorScroll = vsb.ForeColor
End Property

Public Property Let ForeColorScroll(ByVal New_ForeColor As OLE_COLOR)
    vsb.ForeColor = New_ForeColor
    PropertyChanged "ForeColorScroll"
End Property



'Eigenschaftenwerte vom Speicher laden
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    m_Alpha = PropBag.ReadProperty("Alpha", 255)
    lst.BackColor = PropBag.ReadProperty("BackColor", &H80000005)
    lst.ForeColor = PropBag.ReadProperty("ForeColor", &H80000008)
    m_BorderColor = PropBag.ReadProperty("BorderColor", m_def_BorderColor)
    m_HLColor = PropBag.ReadProperty("HLColor", vbBlue)
    vsb.BackColor = PropBag.ReadProperty("BackColorScroll", vbBlack)
    vsb.BorderColor = PropBag.ReadProperty("BorderColorScroll", vbBlack)
    vsb.ForeColor = PropBag.ReadProperty("ForeColorScroll", vbBlack)
    m_Scrolling = PropBag.ReadProperty("Scrolling", True)
    UpdateScrollingStat
    vsb.Alpha = m_Alpha
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", lst.BackColor, &H80000005)
    Call PropBag.WriteProperty("ForeColor", lst.ForeColor, &H80000008)
    Call PropBag.WriteProperty("BorderColor", m_BorderColor, m_def_BorderColor)
    Call PropBag.WriteProperty("BorderColorScroll", vsb.BorderColor, vbBlack)
    Call PropBag.WriteProperty("BackColorScroll", vsb.BackColor, vbBlack)
    Call PropBag.WriteProperty("ForeColorScroll", vsb.ForeColor, vbBlack)
    Call PropBag.WriteProperty("HLColor", m_HLColor, vbBlue)
    Call PropBag.WriteProperty("Scrolling", m_Scrolling, True)
    
    UpdateScrollingStat
End Sub


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

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

UserControl_Resize

Engine.InitCtl vsb


End Sub

Public Sub OnMouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If X > lst.Width Then
    vsb.OnMouseUp Button, Shift, X - lst.Width, Y
End If

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 X > lst.Width Then
    vsb.OnMouseMove Button, Shift, X - lst.Width, 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)
If X <= lst.Width Then
If Button = 1 Then


Dim y2 As Single
y2 = Y - 4

Dim l As Integer
l = ((y2 - (y2 Mod m_LineHeight)) / m_LineHeight)
ListIndex = l + Int(vsb.Value) - 1

If ListIndex + 1 > List.Count Then ListIndex = List.Count - 1
End If
Else
vsb.OnMouseDown Button, Shift, X - lst.Width, Y
End If

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 OnKeyPress(KeyAscii As Integer)
RaiseEvent KeyPress(KeyAscii)
End Sub
Public Sub OnKeyUp(KeyCode As Integer, Shift As Integer)
RaiseEvent KeyUp(KeyCode, Shift)
End Sub


Public Function ToString() As String
ToString = "lst [" & m_Text & "]"
End Function

Public Sub Render()

vsb.Min = 1
vsb.Max = List.Count - m_DisplayLines + 1
If vsb.Max < 1 Then vsb.Max = 1
If vsb.Value > vsb.Max Then vsb.Value = vsb.Max


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


'Dim clr As ColorRGB
'clr = SplitColor(BackColor)
'Dim clr1 As Long, clr2 As Long, clr3 As Long
'clr1 = BackColor
'clr2 = RGB(clr.r - 15, clr.g - 15, clr.b - 15)
'clr3 = RGB(clr.r - 30, clr.g - 30, clr.b - 30)

'Engine.S2D.Effects.GradiantRect rct, clr1, clr2, clr2, clr3, Alpha, False
MySpr.RenderTiled posLeft + 4, posTop + 4, UserControl.ScaleWidth - 8, UserControl.ScaleHeight - 8, 12, 12, 4, 4, Alpha

Dim YOfs As Long
Dim sout As String
Dim I As Integer
For I = Int(vsb.Value) To List.Count
If I = ListIndex + 1 Then sout = sout + ">"
'sout = sout & List(i) & vbCrLf

fnt.DrawTextSimple posLeft + 4, posTop + YOfs + 4 + m_LineHeight * (I - Int(vsb.Value)), List(I), , Alpha, , , ForeColor, UserControl.ScaleWidth - 8, UserControl.ScaleHeight - 4

Next


Dim sely As Double
sely = posTop + (((ListIndex + 1) - Int(vsb.Value)) * m_LineHeight) + 4

If sely >= posTop + 4 And sely + m_LineHeight <= posTop + UserControl.ScaleHeight Then
Engine.S2D.Effects.RECT posLeft + 4, sely, UserControl.ScaleWidth - 9, CDbl(m_LineHeight), m_HLColor, 100
End If


RenderBorder

If Scrolling Then
vsb.Render
End If
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 - vsb.Width, 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 - vsb.Width, 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 - vsb.Width, posTop + UserControl.ScaleHeight - 4, 4, 4, 8, 8, 4, 4, Alpha, , m_BorderColor, m_BorderColor, m_BorderColor, m_BorderColor

End With

End Sub




