VERSION 5.00
Begin VB.UserControl XText 
   ClientHeight    =   3600
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4800
   ScaleHeight     =   240
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   320
   ToolboxBitmap   =   "XText.ctx":0000
   Begin VB.TextBox txt 
      Height          =   285
      Left            =   0
      TabIndex        =   0
      Text            =   "Text1"
      Top             =   0
      Width           =   2535
   End
End
Attribute VB_Name = "XText"
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
Dim m_Alpha As Long
Dim m_BorderColor As OLE_COLOR


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 Event Change()


Public ID As String

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

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

Private Sub UserControl_Resize()
txt.Width = UserControl.ScaleWidth
txt.Height = UserControl.ScaleHeight
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 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 = txt.BackColor
End Property


Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
    txt.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

'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 = txt.ForeColor
End Property

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

'ACHTUNG! DIE FOLGENDEN KOMMENTIERTEN ZEILEN NICHT ENTFERNEN ODER VERÄNDERN!
'MappingInfo=txt,txt,-1,Text
Public Property Get Text() As String
Attribute Text.VB_Description = "Gibt den Text zurück, der im Steuerelement enthalten ist, oder legt diesen fest."
    Text = txt.Text
End Property

Public Property Let Text(ByVal New_Text As String)
    txt.Text() = New_Text
    PropertyChanged "Text"
End Property

'Eigenschaftenwerte vom Speicher laden
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    m_Alpha = PropBag.ReadProperty("Alpha", 255)
    txt.BackColor = PropBag.ReadProperty("BackColor", &H80000005)
    txt.ForeColor = PropBag.ReadProperty("ForeColor", &H80000008)
    m_BorderColor = PropBag.ReadProperty("BorderColor", m_def_BorderColor)
    
    txt.Text = PropBag.ReadProperty("Text", "Text1")
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", txt.BackColor, &H80000005)
    Call PropBag.WriteProperty("ForeColor", txt.ForeColor, &H80000008)
    Call PropBag.WriteProperty("BorderColor", m_BorderColor, m_def_BorderColor)
    Call PropBag.WriteProperty("Text", txt.Text, "Text1")
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

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)
If KeyCode = 8 Then
If Len(Text) > 0 Then
Text = Left(Text, Len(Text) - 1)
RaiseEvent Change
End If
End If



RaiseEvent KeyDown(KeyCode, Shift)
End Sub

Public Sub OnKeyPress(KeyAscii As Integer)

Dim c As String
c = Chr(KeyAscii)


If InStr(1, ValidChars, c) > 0 Then
Text = Text & c
RaiseEvent Change
End If

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 = "txt [" & Text & "]"
End Function

Public Sub Render()

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


'Engine.S2D.Effects.RECT posLeft, posTop, UserControl.ScaleWidth, UserControl.ScaleHeight, BackColor, Alpha


Dim txt As String

txt = Text
If Not Engine.FocusCtl Is Nothing Then
If Engine.FocusCtl.ID = ID Then
txt = txt & "_"
End If
End If

RenderBorder
fnt.DrawTextSimple posLeft + 4, posTop + 4, txt, 1, Alpha, , , ForeColor, UserControl.ScaleWidth - 4, UserControl.ScaleHeight - 4
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




