VERSION 5.00
Begin VB.UserControl XFrame 
   ClientHeight    =   3600
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4800
   ScaleHeight     =   240
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   320
   ToolboxBitmap   =   "XFrame.ctx":0000
   Begin VB.Frame fra 
      Caption         =   "Frame1"
      Height          =   1575
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   2295
   End
End
Attribute VB_Name = "XFrame"
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 Integer
Dim m_BackAlpha As Integer

Public MySpr As New cS2DSprite

Public Engine As cS2DCTLEngine

Public posTop As Double
Public posLeft As Double
Public ctlVisible As Boolean
Public fnt As cS2DText
'Ereignisdeklarationen:

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)

Private Const CornerWidth As Integer = 8
Private Const CornerHeight As Integer = 8

Public ID As String

'Public Event XClick()



'ACHTUNG! DIE FOLGENDEN KOMMENTIERTEN ZEILEN NICHT ENTFERNEN ODER VERÄNDERN!
'MemberInfo=10,0,0,0

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)
    fra.BackColor = New_BackColor
    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 BackAlpha() As Integer
    BackAlpha = m_BackAlpha
End Property

Public Property Let BackAlpha(vnew As Integer)
m_BackAlpha = vnew
PropertyChanged "BackAlpha"
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

'ACHTUNG! DIE FOLGENDEN KOMMENTIERTEN ZEILEN NICHT ENTFERNEN ODER VERÄNDERN!
'MappingInfo=fra,fra,-1,Caption
Public Property Get Caption() As String
Attribute Caption.VB_Description = "Gibt den Text zurück, der in der Titelleiste eines Objekts oder unter dem Symbol eines Objekts angezeigt wird, oder legt diesen fest."
    Caption = fra.Caption
End Property

Public Property Let Caption(ByVal New_Caption As String)
    fra.Caption() = New_Caption
    PropertyChanged "Caption"
End Property

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

Set MySpr.S2D = Engine.S2D
MySpr.Initialize Engine.SpritePath & "\border.png", 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_BackAlpha = 255
    m_BorderColor = m_def_BorderColor
End Sub

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

    m_Alpha = PropBag.ReadProperty("Alpha", 255)
    m_BackAlpha = PropBag.ReadProperty("BackAlpha", 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)
    
    fra.BackColor = m_BackColor
    
    fra.Caption = PropBag.ReadProperty("Caption", "Command1")
End Sub

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

'Eigenschaftenwerte in den Speicher schreiben
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("Alpha", m_Alpha, 255)
    Call PropBag.WriteProperty("BackAlpha", m_BackAlpha, 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("Caption", fra.Caption, "Command1")
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)
RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub

Public Sub OnMouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
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 Sub OnKeyPress(KeyAscii As Integer)
RaiseEvent KeyPress(KeyAscii)
End Sub

Public Function ToString() As String
ToString = "fra [" & Caption & "]"
End Function

Public Sub Render()


DrawNormalRect
DrawBorder posLeft, posTop, UserControl.ScaleWidth, UserControl.ScaleHeight, 150
fnt.DrawText posLeft + 4, posTop + 4, Caption, 1, m_BackAlpha
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 + 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 + 2
dest.Top = posTop + 2
dest.bottom = UserControl.ScaleHeight - 4
dest.Right = UserControl.ScaleWidth - 4

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

'MySpr2.RenderTiled posLeft + 1, posTop + 1, UserControl.ScaleWidth - 2, UserControl.ScaleHeight - 2, m_BackAlpha, , vbGreen
End Sub

Private Function DrawBorder(X As Double, Y As Double, Width As Double, Height As Double, Alpha As Integer)
        MySpr.Render X, Y, CornerWidth, CornerHeight, , , CornerWidth, CornerHeight, m_Alpha
        MySpr.Render X, Y + Height - CornerHeight, CornerWidth, CornerHeight, , CornerHeight * 2, CornerWidth, CornerHeight, m_Alpha
        MySpr.Render X + Width - CornerWidth, Y + Height - CornerHeight, CornerWidth, CornerHeight, CornerWidth * 2, CornerHeight * 2, CornerWidth, CornerHeight, m_Alpha
        MySpr.Render X + Width - CornerWidth, Y, CornerWidth, CornerHeight, CornerWidth * 2, , CornerWidth, CornerHeight, m_Alpha
        
        MySpr.Render X + CornerWidth, Y, Width - CornerWidth * 2, CornerHeight, CornerWidth, , CornerWidth, CornerHeight, m_Alpha
        MySpr.Render X + CornerWidth, Y + Height - CornerHeight, Width - CornerWidth * 2, CornerHeight, CornerWidth, CornerHeight * 2, CornerWidth, CornerHeight, m_Alpha
        MySpr.Render X, Y + CornerHeight, CornerWidth, Height - CornerHeight * 2, , CornerHeight, CornerWidth, CornerHeight, m_Alpha
        MySpr.Render X + Width - CornerWidth, Y + CornerHeight, CornerWidth, Height - CornerHeight * 2, CornerWidth * 2, CornerHeight, CornerWidth, CornerHeight, m_Alpha
End Function
