home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / Desktop_In1726743312004.psc / Class1.cls < prev    next >
Encoding:
Visual Basic class definition  |  2004-03-31  |  10.2 KB  |  259 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "clsCalendarStamp"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15. Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
  16. Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
  17. Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
  18.  
  19. Private m_xPos As Long
  20. Private m_yPos As Long
  21. Private m_BorderColor As Long
  22. Private m_Month As Integer
  23. Private m_Year As Integer
  24. Private m_Destination As Form
  25. Private m_TitleFont As String
  26. Private m_TitleColor As Long
  27. Private m_TitleFontSize As Long
  28. Private m_TitleBold As Boolean
  29. Private m_LabelFont As String
  30. Private m_LabelColor As Long
  31. Private m_LabelFontSize As Long
  32. Private m_LabelBold As Boolean
  33. Private m_DayFont As String
  34. Private m_DayColor As Long
  35. Private m_DayFontSize As Long
  36. Private m_DayBold As Boolean
  37. Private m_TodayColor As Long
  38. Private m_TrimIT As Integer
  39. Private m_TrimITDepth As Long
  40. Public Enum TrimIT
  41.     None = 0
  42.     border = 1
  43.     Dropshadow = 2
  44. End Enum
  45. 'Let properties
  46. Public Property Let BackgroundTrimIT(iT As TrimIT)
  47.     m_TrimIT = iT
  48. End Property
  49. Public Property Let TrimITDepth(lDSD As Long)
  50.     m_TrimITDepth = lDSD
  51. End Property
  52. Public Property Let Left(xPos As Long)
  53.     m_xPos = xPos
  54. End Property
  55. Public Property Let Top(ypos As Long)
  56.     m_yPos = ypos
  57. End Property
  58. Public Property Let Background(bgCol As Long)
  59.     m_BorderColor = bgCol
  60. End Property
  61. Public Property Let CalendarMonth(iMonth As Integer)
  62.     m_Month = iMonth
  63. End Property
  64. Public Property Let CalendarYear(iYear As Integer)
  65.     m_Year = iYear
  66. End Property
  67. Friend Property Let TargetImage(ByRef ctlDestination As Form)
  68.     Set m_Destination = ctlDestination
  69. End Property
  70. Public Property Let TitleFont(lTF As String)
  71.     m_TitleFont = lTF
  72. End Property
  73. Public Property Let TitleColor(lTC As Long)
  74.     m_TitleColor = lTC
  75. End Property
  76. Public Property Let TitleFontSize(lTFS As Long)
  77.     m_TitleFontSize = lTFS
  78. End Property
  79. Public Property Let TitleBold(lTB As Long)
  80.     m_TitleBold = lTB
  81. End Property
  82. Public Property Let LabelFont(lLF As String)
  83.     m_LabelFont = lLF
  84. End Property
  85. Public Property Let LabelColor(lLC As Long)
  86.     m_LabelColor = lLC
  87. End Property
  88. Public Property Let LabelFontSize(lLFS As Long)
  89.     m_LabelFontSize = lLFS
  90. End Property
  91. Public Property Let LabelBold(lLB As Long)
  92.     m_LabelBold = lLB
  93. End Property
  94. Public Property Let DayFont(lDF As String)
  95.     m_DayFont = lDF
  96. End Property
  97. Public Property Let DayColor(lDC As Long)
  98.     m_DayColor = lDC
  99. End Property
  100. Public Property Let DayFontSize(lDFS As Long)
  101.     m_DayFontSize = lDFS
  102. End Property
  103. Public Property Let DayBold(lDB As Long)
  104.     m_DayBold = lDB
  105. End Property
  106. Public Property Let TodayColor(lTC As Long)
  107.     m_TodayColor = lTC
  108. End Property
  109.  
  110. Public Sub DrawCalendar()
  111.     'm_bordercolor Outline
  112.     If m_TrimIT = 1 Then
  113.         PrintCalendar m_Destination, m_Month, m_Year, m_xPos - m_TrimITDepth, m_yPos, m_TitleFont, m_BorderColor, m_TitleFontSize, m_TitleBold, m_LabelFont, m_BorderColor, m_LabelFontSize, m_LabelBold, m_DayFont, m_BorderColor, m_DayFontSize, m_DayBold, m_BorderColor
  114.         PrintCalendar m_Destination, m_Month, m_Year, m_xPos + m_TrimITDepth, m_yPos, m_TitleFont, m_BorderColor, m_TitleFontSize, m_TitleBold, m_LabelFont, m_BorderColor, m_LabelFontSize, m_LabelBold, m_DayFont, m_BorderColor, m_DayFontSize, m_DayBold, m_BorderColor
  115.         PrintCalendar m_Destination, m_Month, m_Year, m_xPos, m_yPos - m_TrimITDepth, m_TitleFont, m_BorderColor, m_TitleFontSize, m_TitleBold, m_LabelFont, m_BorderColor, m_LabelFontSize, m_LabelBold, m_DayFont, m_BorderColor, m_DayFontSize, m_DayBold, m_BorderColor
  116.         PrintCalendar m_Destination, m_Month, m_Year, m_xPos, m_yPos + m_TrimITDepth, m_TitleFont, m_BorderColor, m_TitleFontSize, m_TitleBold, m_LabelFont, m_BorderColor, m_LabelFontSize, m_LabelBold, m_DayFont, m_BorderColor, m_DayFontSize, m_DayBold, m_BorderColor
  117.         PrintCalendar m_Destination, m_Month, m_Year, m_xPos - m_TrimITDepth, m_yPos + m_TrimITDepth, m_TitleFont, m_BorderColor, m_TitleFontSize, m_TitleBold, m_LabelFont, m_BorderColor, m_LabelFontSize, m_LabelBold, m_DayFont, m_BorderColor, m_DayFontSize, m_DayBold, m_BorderColor
  118.         PrintCalendar m_Destination, m_Month, m_Year, m_xPos + m_TrimITDepth, m_yPos - m_TrimITDepth, m_TitleFont, m_BorderColor, m_TitleFontSize, m_TitleBold, m_LabelFont, m_BorderColor, m_LabelFontSize, m_LabelBold, m_DayFont, m_BorderColor, m_DayFontSize, m_DayBold, m_BorderColor
  119.         PrintCalendar m_Destination, m_Month, m_Year, m_xPos - m_TrimITDepth, m_yPos - m_TrimITDepth, m_TitleFont, m_BorderColor, m_TitleFontSize, m_TitleBold, m_LabelFont, m_BorderColor, m_LabelFontSize, m_LabelBold, m_DayFont, m_BorderColor, m_DayFontSize, m_DayBold, m_BorderColor
  120.         PrintCalendar m_Destination, m_Month, m_Year, m_xPos + m_TrimITDepth, m_yPos + m_TrimITDepth, m_TitleFont, m_BorderColor, m_TitleFontSize, m_TitleBold, m_LabelFont, m_BorderColor, m_LabelFontSize, m_LabelBold, m_DayFont, m_BorderColor, m_DayFontSize, m_DayBold, m_BorderColor
  121.     End If
  122.     
  123.     'dropshadow in m_bordercolor
  124.     If m_TrimIT = 2 Then
  125.         PrintCalendar m_Destination, _
  126.                       m_Month, m_Year, _
  127.                       m_xPos + m_TrimITDepth, m_yPos + m_TrimITDepth, _
  128.                       m_TitleFont, m_BorderColor, m_TitleFontSize, m_TitleBold, _
  129.                       m_LabelFont, m_BorderColor, m_LabelFontSize, m_LabelBold, _
  130.                       m_DayFont, m_BorderColor, m_DayFontSize, m_DayBold, _
  131.                       m_BorderColor
  132.     End If
  133.     
  134.     'Text
  135.     PrintCalendar m_Destination, _
  136.                  m_Month, m_Year, _
  137.                  m_xPos, m_yPos, _
  138.                  m_TitleFont, m_TitleColor, m_TitleFontSize, m_TitleBold, _
  139.                  m_LabelFont, m_LabelColor, m_LabelFontSize, m_LabelBold, _
  140.                  m_DayFont, m_DayColor, m_DayFontSize, m_DayBold, _
  141.                  m_TodayColor
  142.  
  143. End Sub
  144. Private Sub PrintCalendar(ByRef picIn As Form, iMonth As Integer, iYear As Integer, _
  145.                           xPos As Long, ypos As Long, _
  146.                           TitleFont As String, TitleColor As Long, TitleFontSize As Long, TitleBold As Boolean, _
  147.                           LabelFont As String, LabelColor As Long, LabelFontSize As Long, LabelBold As Boolean, _
  148.                           DayFont As String, DayColor As Long, DayFontSize As Long, DayBold As Boolean, _
  149.                           TodayColor As Long)
  150. Dim sText As String
  151. Dim x As Long
  152. Dim LabelColWidth As Long
  153. Dim LabelTop As Long
  154. Dim DayTop As Long
  155. Dim DayHeight As Long
  156. Dim DayPosX As Long
  157. Dim DayPosY As Long
  158. Dim CurrDayNum As Long
  159. Dim xOffset As Long
  160.     'deduce colwidth
  161.     picIn.Font = LabelFont
  162.     picIn.FontSize = LabelFontSize
  163.     picIn.FontBold = LabelBold
  164.     LabelColWidth = picIn.TextWidth("WW")
  165.     picIn.Font = DayFont
  166.     picIn.FontSize = DayFontSize
  167.     picIn.FontBold = DayBold
  168.     If picIn.TextWidth("WW") > LabelColWidth Then
  169.         LabelColWidth = picIn.TextWidth("WW")
  170.     End If
  171.     LabelColWidth = LabelColWidth + 1
  172.  
  173.     'month label
  174.     picIn.Font = TitleFont
  175.     picIn.FontSize = TitleFontSize
  176.     
  177.     sText = Format(DateSerial(iYear, iMonth, 1), "Mmmm  yyyy")
  178.     picIn.FontBold = TitleBold
  179.     
  180.     SetTextColor picIn.hdc, TitleColor
  181.     If picIn.TextWidth(sText) > (LabelColWidth * 7) Then
  182.         xOffset = picIn.TextWidth(sText) - (LabelColWidth * 7)
  183.         TextOut picIn.hdc, xPos, ypos, sText, Len(sText)
  184.     Else
  185.         xOffset = 0
  186.         TextOut picIn.hdc, xPos + 2 + (LabelColWidth * 7) - picIn.TextWidth(sText), ypos, sText, Len(sText)
  187.     End If
  188.     
  189.     
  190.     LabelTop = picIn.TextHeight(sText) + ypos + 6
  191.     
  192.     
  193.     'day labels
  194.     picIn.Font = LabelFont
  195.     picIn.FontSize = LabelFontSize
  196.     picIn.FontBold = LabelBold
  197.     
  198.     For x = 1 To 7
  199.         sText = Format(x, "Ddd")
  200.         SetTextColor picIn.hdc, LabelColor
  201.         TextOut picIn.hdc, xOffset + (xPos + ((x - 1) * LabelColWidth) + 8) + LabelColWidth - picIn.TextWidth(sText) - 3, LabelTop, Mid(sText, 1, 2), 2
  202.     Next x
  203.     
  204.     DayTop = picIn.TextHeight(sText) + LabelTop + 2
  205.     
  206.     'day numerics
  207.     picIn.Font = DayFont
  208.     picIn.FontSize = DayFontSize
  209.     picIn.FontBold = DayBold
  210.     
  211.     DayHeight = picIn.TextHeight("999")
  212.     
  213.     DayPosX = xPos + (Offset(iMonth, iYear) * LabelColWidth)
  214.     DayPosY = DayTop
  215.     CurrDayNum = 1
  216.     Do
  217.         sText = CurrDayNum
  218.         SetTextColor picIn.hdc, IIf(iMonth = Month(Now) And iYear = Year(Now) And CurrDayNum = Day(Now), TodayColor, DayColor)
  219.         TextOut picIn.hdc, xOffset + DayPosX + LabelColWidth - picIn.TextWidth(sText), DayPosY, sText, Len(sText)
  220.         CurrDayNum = CurrDayNum + 1
  221.         If Format(DateSerial(iYear, iMonth, CurrDayNum), "Ddd") = "Sun" Then
  222.             DayPosX = xPos
  223.             DayPosY = DayPosY + DayHeight
  224.         Else
  225.             DayPosX = DayPosX + LabelColWidth
  226.         End If
  227.     Loop Until CurrDayNum > DaysInMonth(iMonth, iYear)
  228.     
  229. End Sub
  230. Private Function DaysInMonth(iM As Integer, iY As Integer) As Integer
  231. Dim dteStart As Date
  232. Dim dteEnd As Date
  233.     dteStart = DateSerial(iY, iM, 1)
  234.     dteEnd = DateAdd("m", 1, dteStart)
  235.     DaysInMonth = DateDiff("d", dteStart, dteEnd)
  236. End Function
  237. Private Function Offset(iM As Integer, iY As Integer) As Integer
  238. Dim sDte As String
  239.     Offset = 0
  240.     sDte = DateSerial(iY, iM, 1)
  241.     Select Case Format(sDte, "Ddd")
  242.         Case "Sun"
  243.         Offset = 0
  244.         Case "Mon"
  245.         Offset = 1
  246.         Case "Tue"
  247.         Offset = 2
  248.         Case "Wed"
  249.         Offset = 3
  250.         Case "Thu"
  251.         Offset = 4
  252.         Case "Fri"
  253.         Offset = 5
  254.         Case "Sat"
  255.         Offset = 6
  256.     End Select
  257. End Function
  258.  
  259.