home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / tool / various / kalend / test4.frm < prev    next >
Text File  |  1995-02-27  |  8KB  |  257 lines
  1. VERSION 2.00
  2. Begin Form Form4 
  3.    BorderStyle     =   3  'Fixed Double
  4.    Caption         =   "Moon BitBlt"
  5.    ClientHeight    =   4635
  6.    ClientLeft      =   3210
  7.    ClientTop       =   630
  8.    ClientWidth     =   6435
  9.    Height          =   5565
  10.    Left            =   3150
  11.    LinkTopic       =   "Form4"
  12.    ScaleHeight     =   4635
  13.    ScaleWidth      =   6435
  14.    Top             =   -240
  15.    Width           =   6555
  16.    Begin Kalendar Kalendar1 
  17.       BackColor       =   &H00FFFFFF&
  18.       BorderStyle     =   0  'None
  19.       DateDispStyle   =   2  'User
  20.       DayAlignment    =   0  'Upper Left
  21.       DOWAlign        =   2  'Center
  22.       DOWBackColor    =   &H00FFFFFF&
  23.       DOWBorder       =   0   'False
  24.       DOWDispStyle    =   2  'Medium
  25.       DOWFontBold     =   0   'False
  26.       DOWFontItalic   =   0   'False
  27.       DOWFontName     =   "Times New Roman"
  28.       DOWFontSize     =   12
  29.       DOWFontStrikeThru=   0   'False
  30.       DOWFontUnderline=   0   'False
  31.       DOWForeColor    =   &H00000000&
  32.       EnableKeys      =   -1  'True
  33.       FirstDOW        =   0  'Sunday
  34.       FixedDayHeight  =   0   'False
  35.       FontBold        =   0   'False
  36.       FontItalic      =   0   'False
  37.       FontName        =   "Times New Roman"
  38.       FontSize        =   12
  39.       FontStrikethru  =   0   'False
  40.       FontUnderline   =   0   'False
  41.       ForeColor       =   &H00000000&
  42.       Height          =   4650
  43.       Left            =   0
  44.       LineColor       =   &H00000000&
  45.       MonAlign        =   0  'Left
  46.       MonBackColor    =   &H00FFFFFF&
  47.       MonDispStyle    =   2  'Month/Year
  48.       MonFontBold     =   -1  'True
  49.       MonFontItalic   =   0   'False
  50.       MonFontName     =   "Arial"
  51.       MonFontSize     =   18
  52.       MonFontStrikeThru=   0   'False
  53.       MonFontUnderline=   0   'False
  54.       MonForeColor    =   &H00000000&
  55.       OtherMonBackColor=   &H00C0C0C0&
  56.       OtherMonForeColor=   &H00FFFFFF&
  57.       SelDayBackColor =   &H00C0C0C0&
  58.       SelDayForeColor =   &H00000000&
  59.       ShowAllDays     =   0   'False
  60.       ShowArrows      =   -1  'True
  61.       ShowLines       =   -1  'True
  62.       ShowSelection   =   -1  'True
  63.       TabIndex        =   8
  64.       Text            =   "07/04/94"
  65.       Top             =   -15
  66.       Width           =   6390
  67.    End
  68.    Begin PictureBox Picture1 
  69.       AutoRedraw      =   -1  'True
  70.       BorderStyle     =   0  'None
  71.       Height          =   510
  72.       Index           =   7
  73.       Left            =   6735
  74.       Picture         =   TEST4.FRX:0000
  75.       ScaleHeight     =   510
  76.       ScaleWidth      =   510
  77.       TabIndex        =   7
  78.       Top             =   4185
  79.       Width           =   510
  80.    End
  81.    Begin PictureBox Picture1 
  82.       AutoRedraw      =   -1  'True
  83.       BorderStyle     =   0  'None
  84.       Height          =   510
  85.       Index           =   6
  86.       Left            =   6735
  87.       Picture         =   TEST4.FRX:0302
  88.       ScaleHeight     =   510
  89.       ScaleWidth      =   510
  90.       TabIndex        =   6
  91.       Top             =   3600
  92.       Width           =   510
  93.    End
  94.    Begin PictureBox Picture1 
  95.       AutoRedraw      =   -1  'True
  96.       BorderStyle     =   0  'None
  97.       Height          =   510
  98.       Index           =   5
  99.       Left            =   6735
  100.       Picture         =   TEST4.FRX:0604
  101.       ScaleHeight     =   510
  102.       ScaleWidth      =   510
  103.       TabIndex        =   5
  104.       Top             =   2985
  105.       Width           =   510
  106.    End
  107.    Begin PictureBox Picture1 
  108.       AutoRedraw      =   -1  'True
  109.       BorderStyle     =   0  'None
  110.       Height          =   510
  111.       Index           =   4
  112.       Left            =   6735
  113.       Picture         =   TEST4.FRX:0906
  114.       ScaleHeight     =   510
  115.       ScaleWidth      =   510
  116.       TabIndex        =   4
  117.       Top             =   2415
  118.       Width           =   510
  119.    End
  120.    Begin PictureBox Picture1 
  121.       AutoRedraw      =   -1  'True
  122.       BorderStyle     =   0  'None
  123.       Height          =   510
  124.       Index           =   3
  125.       Left            =   6735
  126.       Picture         =   TEST4.FRX:0C08
  127.       ScaleHeight     =   510
  128.       ScaleWidth      =   510
  129.       TabIndex        =   3
  130.       Top             =   1785
  131.       Width           =   510
  132.    End
  133.    Begin PictureBox Picture1 
  134.       AutoRedraw      =   -1  'True
  135.       BorderStyle     =   0  'None
  136.       Height          =   510
  137.       Index           =   2
  138.       Left            =   6735
  139.       Picture         =   TEST4.FRX:0F0A
  140.       ScaleHeight     =   510
  141.       ScaleWidth      =   510
  142.       TabIndex        =   2
  143.       Top             =   1185
  144.       Width           =   510
  145.    End
  146.    Begin PictureBox Picture1 
  147.       AutoRedraw      =   -1  'True
  148.       BorderStyle     =   0  'None
  149.       Height          =   510
  150.       Index           =   1
  151.       Left            =   6735
  152.       Picture         =   TEST4.FRX:120C
  153.       ScaleHeight     =   510
  154.       ScaleWidth      =   510
  155.       TabIndex        =   1
  156.       Top             =   615
  157.       Width           =   510
  158.    End
  159.    Begin PictureBox Picture1 
  160.       AutoRedraw      =   -1  'True
  161.       BorderStyle     =   0  'None
  162.       Height          =   510
  163.       Index           =   0
  164.       Left            =   6735
  165.       Picture         =   TEST4.FRX:150E
  166.       ScaleHeight     =   510
  167.       ScaleWidth      =   510
  168.       TabIndex        =   0
  169.       Top             =   0
  170.       Width           =   510
  171.    End
  172.    Begin Menu mnuFile 
  173.       Caption         =   "&File"
  174.       Begin Menu mnuFPrint 
  175.          Caption         =   "&Print"
  176.       End
  177.    End
  178. End
  179. Option Explicit
  180.  
  181. Sub Form_Activate ()
  182.     SetDescription Sample4Description()
  183. End Sub
  184.  
  185. Sub Form_Load ()
  186.     Kalendar1.Text = Date
  187. End Sub
  188.  
  189. Sub Form_Resize ()
  190.     Kalendar1.Move 0, 0, Form4.ScaleWidth, Form4.ScaleHeight
  191.     
  192. End Sub
  193.  
  194. Sub Kalendar1_DrawOnDay (hDC As Integer, STATE As Integer, theDay As Long, x As Single, y As Single, x2 As Single, y2 As Single)
  195. Dim retval As Integer
  196. Dim r As Rect, xr As Rect
  197. Dim w As Long, h As Long
  198.     KalWindowAPIRect x, y, x2, y2, r
  199.     InflateRect r, -1, -1
  200.     xr = r
  201.  
  202.     r.top = r.bottom - Picture1(0).Height / Screen.TwipsPerPixelY
  203.     r.left = r.right - Picture1(0).Width / Screen.TwipsPerPixelX
  204.     
  205.     w = Picture1(0).Width / Screen.TwipsPerPixelX
  206.     If w > r.right - r.left Then
  207.         w = r.right - r.left
  208.     End If
  209.  
  210.     h = Picture1(0).Height / Screen.TwipsPerPixelY
  211.     If h > r.bottom - r.top Then
  212.         h = r.bottom - r.top
  213.     End If
  214.  
  215.     retval = BitBlt(hDC, r.left, r.top, w, h, Picture1(theDay Mod 8).hDC, 0, 0, SRCAND)
  216.  
  217.     If theDay < Date Then
  218.         w = MoveTo(hDC, xr.left, xr.top)
  219.         retval = LineTo(hDC, xr.right, xr.bottom)
  220.         w = MoveTo(hDC, xr.right, xr.top)
  221.         retval = LineTo(hDC, xr.left, xr.bottom)
  222.     End If
  223.  
  224. End Sub
  225.  
  226. Sub Kalendar1_QueryChangeDay (theDay As Long, Cancel As Integer)
  227.  
  228.     If theDay < Date Then
  229.         Beep
  230.         Cancel = True
  231.     End If
  232. End Sub
  233.  
  234. Sub mnuFPrint_Click ()
  235. Dim saveBackColor As Long
  236.  
  237.     saveBackColor = Kalendar1.MonBackColor
  238.     
  239.     Kalendar1.MonBackColor = RGB(255, 255, 255)
  240.     Kalendar1.PrintHDC = Printer.hDC
  241.     Kalendar1.PrintAction = KAL_PRINT_LANDSCAPE
  242.     
  243.     Kalendar1.MonBackColor = saveBackColor
  244.     
  245.     Printer.EndDoc
  246.  
  247. End Sub
  248.  
  249. Function Sample4Description () As String
  250. Dim s As String
  251.     s = "This is another of the DrawOnDay event. The moons are drawn by using the API call BitBlt and seven different picture boxes." & CR
  252.     s = s & "Also shown is a use of the QueryChangeDay event. You cannot access dates previous to today."
  253.  
  254.     Sample4Description = s
  255. End Function
  256.  
  257.