Programming Tool Box/SIMS_2.iso/tool/various/kalend/test2.frm

Text File | 1995-02-27 | 6KB | 172 lines

VERSION 2.00
Begin Form Form2
   BorderStyle     =   3  'Fixed Double
   Caption         =   "Complete Custom Day"
   ClientHeight    =   3675
   ClientLeft      =   3195
   ClientTop       =   345
   ClientWidth     =   4845
   Height          =   4200
   Left            =   3135
   LinkTopic       =   "Form2"
   ScaleHeight     =   3675
   ScaleWidth      =   4845
   Top             =   -120
   Width           =   4965
   Begin ComboBox lstMonth
      Height          =   300
      Left            =   105
      Style           =   2  'Dropdown List
      TabIndex        =   2
      Top             =   105
      Width           =   3060
   End
   Begin ComboBox lstYear
      Height          =   300
      Left            =   3255
      Style           =   2  'Dropdown List
      TabIndex        =   1
      Top             =   105
      Width           =   1485
   End
   Begin Kalendar Kalendar1
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   1  'Fixed Single
      DateDispStyle   =   2  'User
      DayAlignment    =   0  'Upper Left
      DOWAlign        =   2  'Center
      DOWBackColor    =   &H0000FFFF&
      DOWBorder       =   0   'False
      DOWDispStyle    =   2  'Medium
      DOWFontBold     =   -1  'True
      DOWFontItalic   =   0   'False
      DOWFontName     =   "MS Sans Serif"
      DOWFontSize     =   8.25
      DOWFontStrikeThru=   0   'False
      DOWFontUnderline=   0   'False
      DOWForeColor    =   &H00000000&
      EnableKeys      =   -1  'True
      FirstDOW        =   0  'Sunday
      FixedDayHeight  =   0   'False
      ForeColor       =   &H00000000&
      Height          =   3195
      Left            =   105
      LineColor       =   &H00C0C0C0&
      MonAlign        =   2  'Center
      MonBackColor    =   &H0000FFFF&
      MonDispStyle    =   0  'None
      MonFontBold     =   -1  'True
      MonFontItalic   =   0   'False
      MonFontName     =   "MS Sans Serif"
      MonFontSize     =   8.25
      MonFontStrikeThru=   0   'False
      MonFontUnderline=   0   'False
      MonForeColor    =   &H00000000&
      OtherMonBackColor=   &H00C0C0C0&
      OtherMonForeColor=   &H00FFFFFF&
      SelDayBackColor =   &H000000FF&
      SelDayForeColor =   &H00000000&
      ShowAllDays     =   0   'False
      ShowArrows      =   -1  'True
      ShowLines       =   -1  'True
      ShowSelection   =   -1  'True
      TabIndex        =   0
      Text            =   "01/04/94"
      Top             =   390
      Width           =   4635
   End
End
Option Explicit

Sub Form_Activate ()
    SetDescription Sample2Description()
End Sub

Sub Form_Load ()
Dim i As Integer
    lstMonth.AddItem "January"
    lstMonth.AddItem "February"
    lstMonth.AddItem "March"
    lstMonth.AddItem "April"
    lstMonth.AddItem "May"
    lstMonth.AddItem "June"
    lstMonth.AddItem "July"
    lstMonth.AddItem "August"
    lstMonth.AddItem "September"
    lstMonth.AddItem "October"
    lstMonth.AddItem "November"
    lstMonth.AddItem "December"

    For i = 1962 To 2020
        lstYear.AddItem "" & i
    Next

    Kalendar1.Text = Date
End Sub

Sub Kalendar1_ClickDay ()
    UpdateCombos Kalendar1, lstMonth, lstYear
End Sub

Sub Kalendar1_DrawDay (hDC As Integer, State As Integer, theDay As Long, x As Single, y As Single, x2 As Single, y2 As Single, Cancel As Integer)
Dim retval As Integer
Dim oldPen As Integer
Dim txtDay As String
Dim r As Rect
Dim oldBrush
Dim oldColor, oldTextColor
Dim lx As Long

    txtDay = Format(theDay, "d")

    ' Convert the rectangle back to twips for the form.
    r.left = x / Screen.TwipsPerPixelX
    r.top = y / Screen.TwipsPerPixelY
    r.right = x2 / Screen.TwipsPerPixelX
    r.bottom = y2 / Screen.TwipsPerPixelY

    oldPen = SelectObject(hDC, GetStockObject(BLACK_PEN))

    Select Case State
        Case KAL_STATE_SELECTED_WITHOUT:
            oldBrush = SelectObject(hDC, GetStockObject(LTGRAY_BRUSH))
            oldColor = SetBkColor(hDC, RGB(192, 192, 192))
            oldTextColor = SetTextColor(hDC, 0)
        Case KAL_STATE_SELECTED_WITH:
            oldBrush = SelectObject(hDC, GetStockObject(LTGRAY_BRUSH))
            oldColor = SetBkColor(hDC, RGB(192, 192, 192))
            oldTextColor = SetTextColor(hDC, RGB(255, 0, 0))
        Case KAL_STATE_NOT_SELECTED:
            oldBrush = SelectObject(hDC, GetStockObject(WHITE_BRUSH))
            oldColor = SetBkColor(hDC, RGB(255, 255, 255))
            oldColor = SetTextColor(hDC, 0)
    End Select
    retval = Ellipse(hDC, r.left, r.top, r.right, r.bottom)
    retval = DrawText(hDC, txtDay, Len(txtDay), r, DT_CENTER Or DT_VCENTER Or DT_SINGLELINE)

    retval = SelectObject(hDC, oldPen)
    retval = SelectObject(hDC, oldBrush)
    lx = SetBkColor(hDC, oldColor)
    lx = SetTextColor(hDC, oldTextColor)
    Cancel = True
End Sub

Sub lstMonth_Click ()
    KalSetMonth Kalendar1, lstMonth.ListIndex + 1, 1, Val(lstYear.Text)
End Sub

Sub lstYear_Click ()
    KalSetMonth Kalendar1, lstMonth.ListIndex + 1, 1, Val(lstYear.Text)
End Sub

Function Sample2Description () As String
Dim S As String
Dim CR As String

    S = "This sample shows how the programmer has complete control over how the day boxes are drawn in a Kalendar. Each day "
    S = S & "box is drawn by using the Windows API function Ellipse." & CR
    S = S & "This sample also shows a custom 'month navigation' method."
    Sample2Description = S
End Function