VERSION 5.00
Begin VB.UserControl XCheck 
   ClientHeight    =   3600
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4800
   ScaleHeight     =   240
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   320
   ToolboxBitmap   =   "XCheck.ctx":0000
   Begin VB.CheckBox chk 
      Caption         =   "XCheck"
      Height          =   195
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   1095
   End
End
Attribute VB_Name = "XCheck"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'Standard-Eigenschaftswerte:

Const m_def_ForeColor = 0
'Eigenschaftsvariablen:

Dim m_ForeColor As OLE_COLOR
Dim m_Alpha As Long


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)

Public ID As String

Public spr As New cS2DSprite





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 Checked() As Boolean
    Checked = (chk.Value = 1)
End Property

Public Property Let Checked(vnew As Boolean)
    chk.Value = IIf(vnew, 1, 0)
    PropertyChanged "Checked"
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)
    chk.ForeColor = New_ForeColor
    m_ForeColor = New_ForeColor
    PropertyChanged "ForeColor"
End Property

'ACHTUNG! DIE FOLGENDEN KOMMENTIERTEN ZEILEN NICHT ENTFERNEN ODER VERÄNDERN!
'MappingInfo=cmd,cmd,-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 = chk.Caption
End Property

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

Public Sub Init()
Set spr.S2D = Engine.S2D
spr.Initialize Engine.SpritePath & "\check.bmp", vbMagenta
End Sub

'Eigenschaften für Benutzersteuerelement initialisieren
Private Sub UserControl_InitProperties()
    m_ForeColor = m_def_ForeColor
    m_Alpha = 255
End Sub

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

    chk.Value = IIf(PropBag.ReadProperty("Checked", False), 1, 0)
    m_Alpha = PropBag.ReadProperty("Alpha", 255)
    m_ForeColor = PropBag.ReadProperty("ForeColor", m_def_ForeColor)
    chk.ForeColor = m_ForeColor
    
    chk.Caption = PropBag.ReadProperty("Caption", "Command1")
End Sub

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

'Eigenschaftenwerte in den Speicher schreiben
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("Checked", (chk.Value = 1), 0)
    Call PropBag.WriteProperty("Alpha", m_Alpha, 255)
    Call PropBag.WriteProperty("ForeColor", m_ForeColor, m_def_ForeColor)
    Call PropBag.WriteProperty("Caption", chk.Caption, "Label")
End Sub

Public Sub OnMouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

Checked = Not Checked
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 = "chk [" & Caption & "]"
End Function

Public Sub Render()
Dim rct As RECT

With Engine.S2D.Effects


.RECT posLeft + 1, posTop, 12, 12, vbBlack
.RECT posLeft + 2, posTop + 1, 10, 10, vbWhite, Alpha

If Checked Then spr.RenderFast posLeft + 1, posTop + 1, , , , , Alpha, , vbBlack
End With

'DrawBorder

fnt.DrawText posLeft + 17, posTop - 1, Caption, 1, Alpha
End Sub


