abspane.ctl

Abstract TimeList Control v1.0

VERSION 5.00
Begin VB.UserControl absPane 
   Alignable       =   -1  'True
   AutoRedraw      =   -1  'True
   BackColor       =   &H00C0C0C0&
   ClientHeight    =   855
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   2745
   ControlContainer=   -1  'True
   ScaleHeight     =   855
   ScaleWidth      =   2745
End
Attribute VB_Name = "absPane"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Public Enum BorderType
    None = 0
    Flat = 1
    Frame = 2
    Inset = 3
    Raised = 4
End Enum

Private Const iOffSet = 4
Private Const iOffSet2 = 15

Private mintBorder As BorderType
Private mstrCaption As String

Event KeyDown(KeyCode As Integer, Shift As Integer)
Event KeyPress(KeyAscii As Integer)
Event KeyUp(KeyCode As Integer, Shift As Integer)
Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event Resize()

Public Property Get BackColor() As OLE_COLOR
Attribute BackColor.VB_Description = "Returns/sets the background color used to display text and graphics in an object."
    BackColor = UserControl.BackColor
End Property

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

Public Property Get BorderStyle() As BorderType
Attribute BorderStyle.VB_Description = "Returns/sets the border style for an object."
    BorderStyle = mintBorder
    DrawBorder
End Property

Public Property Let BorderStyle(ByVal New_BorderStyle As BorderType)
    mintBorder = New_BorderStyle
    PropertyChanged "BorderStyle"
End Property

Public Property Get hDC() As Long
Attribute hDC.VB_Description = "Returns a handle (from Microsoft Windows) to the object's device context."
    hDC = UserControl.hDC
End Property

Public Property Get hWnd() As Long
Attribute hWnd.VB_Description = "Returns a handle (from Microsoft Windows) to an object's window."
    hWnd = UserControl.hWnd
End Property

Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
    RaiseEvent KeyDown(KeyCode, Shift)
End Sub

Private Sub UserControl_KeyPress(KeyAscii As Integer)
    RaiseEvent KeyPress(KeyAscii)
End Sub

Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
    RaiseEvent KeyUp(KeyCode, Shift)
End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseDown(Button, Shift, X, Y)
End Sub

Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub

Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub

Public Property Get MousePointer() As Integer
Attribute MousePointer.VB_Description = "Returns/sets the type of mouse pointer displayed when over part of an object."
    MousePointer = UserControl.MousePointer
End Property

Public Property Let MousePointer(ByVal New_MousePointer As Integer)
    UserControl.MousePointer() = New_MousePointer
    PropertyChanged "MousePointer"
End Property

Public Property Get MouseIcon() As Picture
Attribute MouseIcon.VB_Description = "Sets a custom mouse icon."
    Set MouseIcon = UserControl.MouseIcon
End Property

Public Property Set MouseIcon(ByVal New_MouseIcon As Picture)
    Set UserControl.MouseIcon = New_MouseIcon
    PropertyChanged "MouseIcon"
End Property

Private Sub UserControl_Resize()
    DrawBorder
    RaiseEvent Resize
End Sub

Public Property Get ScaleHeight() As Single
Attribute ScaleHeight.VB_Description = "Returns/sets the number of units for the vertical measurement of an object's interior."
    ScaleHeight = UserControl.ScaleHeight
End Property

Public Property Let ScaleHeight(ByVal New_ScaleHeight As Single)
    UserControl.ScaleHeight() = New_ScaleHeight
    PropertyChanged "ScaleHeight"
End Property

Public Property Get ScaleLeft() As Single
Attribute ScaleLeft.VB_Description = "Returns/sets the horizontal coordinates for the left edges of an object."
    ScaleLeft = UserControl.ScaleLeft
End Property

Public Property Let ScaleLeft(ByVal New_ScaleLeft As Single)
    UserControl.ScaleLeft() = New_ScaleLeft
    PropertyChanged "ScaleLeft"
End Property

Public Property Get ScaleTop() As Single
Attribute ScaleTop.VB_Description = "Returns/sets the vertical coordinates for the top edges of an object."
    ScaleTop = UserControl.ScaleTop
End Property

Public Property Let ScaleTop(ByVal New_ScaleTop As Single)
    UserControl.ScaleTop() = New_ScaleTop
    PropertyChanged "ScaleTop"
End Property

Public Property Get ScaleWidth() As Single
Attribute ScaleWidth.VB_Description = "Returns/sets the number of units for the horizontal measurement of an object's interior."
    ScaleWidth = UserControl.ScaleWidth
End Property

Public Property Let ScaleWidth(ByVal New_ScaleWidth As Single)
    UserControl.ScaleWidth() = New_ScaleWidth
    PropertyChanged "ScaleWidth"
End Property

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    UserControl.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
    mintBorder = PropBag.ReadProperty("BorderStyle", 0)
    UserControl.MousePointer = PropBag.ReadProperty("MousePointer", 0)
    Set MouseIcon = PropBag.ReadProperty("MouseIcon", Nothing)
    UserControl.ScaleHeight = PropBag.ReadProperty("ScaleHeight", 6300)
    UserControl.ScaleLeft = PropBag.ReadProperty("ScaleLeft", 0)
    UserControl.ScaleTop = PropBag.ReadProperty("ScaleTop", 0)
    UserControl.ScaleWidth = PropBag.ReadProperty("ScaleWidth", 8025)
    mstrCaption = PropBag.ReadProperty("Caption", "Abstract TimeList")
    '*****************************************
    'Drawborder as soon as the control is
    'loaded
    '*****************************************
    DrawBorder
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H8000000F)
    Call PropBag.WriteProperty("BorderStyle", mintBorder, 0)
    Call PropBag.WriteProperty("MousePointer", UserControl.MousePointer, 0)
    Call PropBag.WriteProperty("MouseIcon", MouseIcon, Nothing)
    Call PropBag.WriteProperty("ScaleHeight", UserControl.ScaleHeight, 6300)
    Call PropBag.WriteProperty("ScaleLeft", UserControl.ScaleLeft, 0)
    Call PropBag.WriteProperty("ScaleTop", UserControl.ScaleTop, 0)
    Call PropBag.WriteProperty("ScaleWidth", UserControl.ScaleWidth, 8025)
    Call PropBag.WriteProperty("Caption", mstrCaption, "Abstract TimeList")
End Sub


'*****************************************
'Build the border based on the border type
'*****************************************
Private Sub DrawBorder()
    Dim x1 As Single
    Dim x2 As Single
    Dim y1 As Single
    Dim y2 As Single
    Dim c1 As Long
    Dim c2 As Long
    Dim c3 As Long
    Dim c4 As Long
        
    '*****************************************
    'Reset scale properties or it will screw
    'up graphics methods
    '*****************************************
    UserControl.ScaleLeft = 0
    UserControl.ScaleWidth = UserControl.Width
    UserControl.ScaleTop = 0
    UserControl.ScaleHeight = UserControl.Height
        
    '*****************************************
    'Find the corners
    '*****************************************
    x1 = iOffSet
    y1 = iOffSet
    x2 = UserControl.Width - (iOffSet * 2)
    y2 = UserControl.Height - (iOffSet * 2)
    UserControl.Cls
    
    If UserControl.ScaleHeight > 100 Then
        UserControl.CurrentX = 100
        UserControl.CurrentY = (UserControl.ScaleHeight / 2) - 100
    End If
    
    UserControl.Print mstrCaption
    
    '*****************************************
    'Set each lines color depending on the
    'type of border
    '*****************************************
    Select Case mintBorder
    Case Flat
        c1 = &H808080
        c2 = &H808080
        c3 = &H808080
        c4 = &H808080
    Case Frame
        c1 = &H808080
        c2 = &HFFFFFF
        c3 = &HFFFFFF
        c4 = &H808080
        
    Case Inset
        c1 = &H808080
        c2 = &HFFFFFF
        c3 = &HFFFFFF
        c4 = &H808080

    Case Raised
        c1 = &HFFFFFF
        c2 = &H808080
        c3 = &H808080
        c4 = &HFFFFFF
    End Select
            
    '*****************************************
    'If there is a border then draw it
    '*****************************************
    If mintBorder <> None Then
        UserControl.Line (x1, y1)-(x2, y1), c1
        UserControl.Line (x2, y1)-(x2, y2), c2
        UserControl.Line (x1, y2)-(x2, y2), c3
        UserControl.Line (x1, y1)-(x1, y2), c4
        
        '*****************************************
        'Frame borders have two sets of lines or
        '8 lines instead of 4. The first set is
        'inset the second raised.
        '*****************************************
        If mintBorder = Frame Then
            c1 = &HFFFFFF
            c2 = &H808080
            c3 = &H808080
            c4 = &HFFFFFF
        
            x1 = x1 + iOffSet2
            x2 = x2 - iOffSet2
            y1 = y1 + iOffSet2
            y2 = y2 - iOffSet2
        
            UserControl.Line (x1, y1)-(x2, y1), c1
            UserControl.Line (x2, y1)-(x2, y2), c2
            UserControl.Line (x1, y2)-(x2, y2), c3
            UserControl.Line (x1, y1)-(x1, y2), c4
        End If
        
        '*****************************************
        'Set the Scale properties so we can resize
        'controls in the container without overlapping
        'the border
        '*****************************************
        UserControl.ScaleLeft = x1 + iOffSet
        UserControl.ScaleWidth = x2 - iOffSet
        UserControl.ScaleTop = y1 + iOffSet
        UserControl.ScaleHeight = y2 - iOffSet
    End If
    
    '*****************************************
    'Force an update to the screen just in case
    '*****************************************
    UserControl.Refresh
End Sub

Public Property Get Caption() As String
Attribute Caption.VB_UserMemId = -518
    Caption = mstrCaption
End Property

Public Property Let Caption(ByVal NewCaption As String)
    mstrCaption = NewCaption
    DrawBorder
End Property