home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 24 / CDACTUAL24.iso / corel / DRAW / SCRIPTS / SCRIPTS / CALENDAR.CSC < prev    next >
Encoding:
Text File  |  1998-01-06  |  67.6 KB  |  1,917 lines
  1. REM El Asistente de calendarios (Calendar Wizard)
  2. REM Creates a calendar
  3.  
  4. '********************************************************************
  5. ' 
  6. '   Script:    Calendar.csc
  7. ' 
  8. '   Copyright 1996 Corel Corporation. Reservados todos los derechos.
  9. ' 
  10. '   Descripci≤n: El gui≤n de CorelDRAW para crear calendarios.
  11. '                Dispone de un interfaz tipo asistente que le permite al
  12. '                usuario personalizar un calendario.
  13. ' 
  14. '********************************************************************
  15.  
  16. #addfol  "..\..\..\scripts"
  17. #include "ScpConst.csi"
  18. #include "DrwConst.csi"
  19.  
  20. '/////FUNCTION & SUBROUTINE DECLARATIONS/////////////////////////////
  21. DECLARE SUB CreateText ( InText AS STRING, \\
  22.                          InFontName AS STRING, \\
  23.                     InFontSize AS LONG, \\
  24.                         InBold AS BOOLEAN, \\
  25.                         InItalic AS BOOLEAN, \\
  26.                         InStrikeout AS BOOLEAN, \\
  27.                     InUnderline AS BOOLEAN, \\
  28.                        InRed AS INTEGER, \\
  29.                        InGreen AS INTEGER, \\
  30.                        InBlue AS INTEGER )
  31. DECLARE FUNCTION GetWeekday( Wkd AS DATE ) AS INTEGER
  32. DECLARE FUNCTION GetNumRows( InMonthNum AS INTEGER, InYear AS INTEGER ) \\
  33.                          AS INTEGER
  34. DECLARE FUNCTION GetNumDays( InMonthNum AS INTEGER, InYear AS INTEGER ) \\
  35.                          AS INTEGER
  36. DECLARE FUNCTION FileExists( InFileName AS STRING ) AS BOOLEAN
  37. DECLARE SUB DoGraphics(     InUsePicture AS BOOLEAN,       \\
  38.                         InUseBorder AS BOOLEAN,        \\
  39.                         InPictureFile AS STRING,       \\
  40.                      InBorderFile AS STRING,        \\
  41.                      BYREF InTopLeftX AS LONG,      \\
  42.                      BYREF InTopLeftY AS LONG,      \\
  43.                      BYREF InBottomRightX AS LONG,  \\
  44.                      BYREF InBottomRightY AS LONG )
  45. DECLARE FUNCTION Min( Val1 AS LONG, Val2 AS LONG ) AS LONG
  46. DECLARE SUB AddMargins( BYREF InTopLeftX AS LONG, \\
  47.                         BYREF InTopLeftY AS LONG, \\
  48.                         BYREF InBottomRightX AS LONG, \\
  49.                         BYREF InBottomRightY AS LONG )
  50. DECLARE FUNCTION CalcHowMany( InHowMany AS INTEGER, \\
  51.                               InMonth AS INTEGER, \\
  52.                               InYear AS INTEGER ) AS LONG
  53.  
  54. DECLARE FUNCTION CreateDC LIB "gdi32" (BYVAL lpDriverName AS STRING, \\
  55.                                        BYVAL lpDeviceName AS LONG, \\
  56.                                        BYVAL lpOutput AS LONG, \\
  57.                                        BYVAL lpInitData AS LONG) AS LONG ALIAS "CreateDCA"
  58. DECLARE FUNCTION GetDeviceCaps LIB "gdi32" (BYVAL hDC AS LONG, \\
  59.                                             BYVAL nIndex AS LONG) AS LONG ALIAS "GetDeviceCaps"
  60. DECLARE FUNCTION DeleteDC LIB "gdi32" (BYVAL hDC AS LONG) AS LONG ALIAS "DeleteDC"
  61. DECLARE FUNCTION GetNumberOfDisplayColors( ) AS LONG
  62.  
  63. '/////GLOBAL VARIABLES & CONSTANTS///////////////////////////////////
  64. GLOBAL CONST TITLE_ERRORBOX$      = "Error del Asistente de calendarios"
  65. GLOBAL CONST TITLE_INFOBOX$       = "Informaci≤n sobre Asistente de calendarios"
  66. GLOBAL NL AS STRING         ' These must be declared as 
  67. GLOBAL NL2 AS STRING     ' variables, not constants, because
  68. NL$ = CHR(10) + CHR(13)    ' we cannot assign expressions
  69. NL2$ = NL + NL             ' to constants.
  70.  
  71. 'Constants for Dialog Return Values
  72. GLOBAL CONST DIALOG_RETURN_OK%     = 1
  73. GLOBAL CONST DIALOG_RETURN_CANCEL% = 2
  74. GLOBAL CONST DIALOG_RETURN_NEXT% = 3
  75. GLOBAL CONST DIALOG_RETURN_BACK% = 4
  76.  
  77. ' The bitmap graphic names.
  78. GLOBAL BITMAP_INTRODIALOG AS STRING
  79. GLOBAL CONST BITMAP_PREVIEW_SIMPLE AS STRING   = "\Cal1.bmp"
  80. GLOBAL CONST BITMAP_PREVIEW_LEFT AS STRING    = "\Cal2.bmp"
  81. GLOBAL CONST BITMAP_PREVIEW_RIGHT AS STRING    = "\Cal3.bmp"
  82. DIM NumColors AS LONG
  83. NumColors& = GetNumberOfDisplayColors()
  84. IF NumColors& <= 256 THEN
  85.     BITMAP_INTRODIALOG$ = "\CalB16.bmp"
  86. ELSE
  87.     BITMAP_INTRODIALOG$ = "\CalB.bmp"
  88. ENDIF
  89.  
  90. ' The previous wizard page's position.
  91. GLOBAL LastPageX AS LONG
  92. GLOBAL LastPageY AS LONG
  93. LastPageX& = -1
  94. LastPageY& = -1
  95.  
  96. ' The current directory when the script was started.
  97. GLOBAL CurDir AS STRING
  98.  
  99. ' The return value of various functions.
  100. GLOBAL GenReturn& AS LONG
  101.  
  102. ' Check to see if CorelDRAW's automation object is available.
  103. ON ERROR RESUME NEXT
  104. WITHOBJECT OBJECT_DRAW
  105.     IF (ERRNUM > 0) THEN
  106.         ' Failed to create the automation object.
  107.         ERRNUM = 0
  108.         GenReturn& = MESSAGEBOX( "No ha podido encontrar CorelDRAW."+NL2+\\
  109.                               "Si este error persiste,"+ \\
  110.                              "puede que necesite volver a instalar"+      \\
  111.                              "CorelDRAW.",                  \\
  112.                                 TITLE_ERRORBOX,              \\
  113.                              MB_STOP_ICON )
  114.         STOP
  115.     ENDIF
  116. ON ERROR EXIT
  117.  
  118. '/////INTRODUCTORY DIALOG//////////////////////////////////////////////
  119.  
  120. BEGIN DIALOG OBJECT IntroDialog 290, 180, "Asistente de calendarios", SUB IntroDialogEventHandler
  121.     PUSHBUTTON  181, 160, 46, 14, .NextButton, "&Siguiente>"
  122.     PUSHBUTTON  135, 160, 46, 14, .BackButton, "< &Atrßs"
  123.     CANCELBUTTON  234, 160, 46, 14, .CancelButton
  124.     TEXT  93, 10, 181, 20, .Text1, "Bienvenido al Asistente de calendarios de Corel."
  125.     TEXT  93, 56, 187, 18, .Text3, "Para empezar a crear su calendario, haga clic en Siguiente."
  126.     IMAGE  10, 10, 75, 130, .IntroImage
  127.     GROUPBOX  10, 150, 270, 5, .LineGroupBox
  128.     TEXT  93, 30, 189, 21, .Text4, "Este asistente le guiarß a travΘs de las etapas necesarias para crear un bonito calendario."
  129. END DIALOG
  130.  
  131. SUB IntroDialogEventHandler(BYVAL ControlID%, BYVAL Event%)
  132.     IF Event% = EVENT_INITIALIZATION THEN     
  133.         IntroDialog.BackButton.Enable FALSE 
  134.     ENDIF
  135.     IF Event% = EVENT_MOUSE_CLICK THEN     ' Mouse click event.
  136.         SELECT CASE ControlID%
  137.             CASE IntroDialog.NextButton.GetID()
  138.                 LastPageX& = IntroDialog.GetLeftPosition()
  139.                 LastPageY& = IntroDialog.GetTopPosition()
  140.                 IntroDialog.CloseDialog DIALOG_RETURN_NEXT%
  141.             CASE IntroDialog.CancelButton.GetID()
  142.                 IntroDialog.CloseDialog DIALOG_RETURN_CANCEL%
  143.         END SELECT
  144.     ENDIF
  145.  
  146. END FUNCTION
  147.  
  148. '/////PAGE SIZE DIALOG//////////////////////////////////////////////
  149.  
  150. ' Arrays of page sizes and dimensions.
  151. GLOBAL ArrayPageNames$(6) : GLOBAL ArrayPageDim!(6, 2)
  152. ' Letter size
  153.     ArrayPageNames$(1)     = "Carta - 8.50 x 11.00 pulg."
  154.     ArrayPageDim!(1, 1)    = 8.50
  155.     ArrayPageDim!(1, 2)    = 11.0
  156. ' Legal size
  157.     ArrayPageNames$(2)    = "Oficio - 8.50 x 14.00 pulg."
  158.     ArrayPageDim!(2, 1) = 8.50
  159.     ArrayPageDim!(2, 2) = 14.0
  160. ' Executive size
  161.     ArrayPageNames$(3)    = "Ejecutivo - 7.25 x 10.50 pulg."
  162.     ArrayPageDim!(3, 1)    = 7.25
  163.     ArrayPageDim!(3, 2)    = 10.50
  164. ' A4 size
  165.     ArrayPageNames$(4)    = "A4 - 8.26 x 11.69 pulg."
  166.     ArrayPageDim!(4, 1) = 8.26
  167.     ArrayPageDim!(4, 2) = 11.69
  168. ' A5 size
  169.     ArrayPageNames$(5)    = "A5 - 5.83 x 8.26 pulg."
  170.     ArrayPageDim!(5, 1)    = 5.83
  171.     ArrayPageDim!(5, 2)    = 8.26
  172. ' B5 size
  173.     ArrayPageNames$(6)    = "B5 - 7.17 x 10.13 pulg."
  174.     ArrayPageDim!(6, 1)    = 7.17
  175.     ArrayPageDim!(6, 2) = 10.13
  176.  
  177. ' Variables needed for the dialog.
  178. GLOBAL PageSize AS INTEGER    ' The user's selected page size.
  179.  
  180. ' Set up the page size default.
  181. PageSize% = 1
  182.  
  183. BEGIN DIALOG OBJECT SizeDialog 0, 0, 290, 180, "Asistente de calendarios", SUB SizeDialogEventHandler
  184.     PUSHBUTTON  181, 160, 46, 14, .NextButton, "&Siguiente >"
  185.     PUSHBUTTON  135, 160, 46, 14, .BackButton, "< &Atrßs"
  186.     CANCELBUTTON  234, 160, 46, 14, .CancelButton
  187.     LISTBOX  94, 23, 187, 81, .SizesList
  188.     TEXT  94, 10, 186, 10, .Text1, "Seleccione el tama±o de pßgina de su calendario."
  189.     IMAGE  10, 10, 75, 130, .SizeImage
  190.     GROUPBOX  10, 150, 270, 5, .LineGroupBox
  191. END DIALOG
  192.  
  193. SUB SizeDialogEventHandler(BYVAL ControlID%, BYVAL Event%)
  194.  
  195.     SELECT CASE Event%
  196.         CASE EVENT_INITIALIZATION&
  197.             ' Set up the page sizes list box.
  198.             SizeDialog.SizesList.SetArray ArrayPageNames$        
  199.             SizeDialog.SizesList.SetSelect PageSize%
  200.  
  201.         CASE EVENT_MOUSE_CLICK&
  202.             SELECT CASE ControlID%
  203.                 CASE SizeDialog.BackButton.GetID()
  204.                     LastPageX& = SizeDialog.GetLeftPosition()
  205.                     LastPageY& = SizeDialog.GetTopPosition()
  206.                     SizeDialog.CloseDialog DIALOG_RETURN_BACK%
  207.                 CASE SizeDialog.NextButton.GetID()
  208.                     LastPageX& = SizeDialog.GetLeftPosition()
  209.                     LastPageY& = SizeDialog.GetTopPosition()    
  210.                     SizeDialog.CloseDialog DIALOG_RETURN_NEXT%
  211.                 CASE SizeDialog.CancelButton.GetID()
  212.                     SizeDialog.CloseDialog DIALOG_RETURN_CANCEL%
  213.                 CASE SizeDialog.SizesList.GetID()
  214.                     PageSize% = SizeDialog.SizesList.GetSelect()                    
  215.             END SELECT
  216.     END SELECT    
  217.  
  218. END SUB
  219.  
  220. '/////ORIENTATION DIALOG/////////////////////////////////////////
  221.  
  222. ' Variables needed for the dialog.
  223. GLOBAL Orient AS INTEGER    ' The user's selected page orientation.
  224.  
  225. ' Constants for the orientation.
  226. GLOBAL CONST CAL_ORIENT_PORTRAIT% = 1
  227. GLOBAL CONST CAL_ORIENT_LANDSCAPE% = 2
  228.  
  229. ' Set up the orientation default.
  230. Orient% = CAL_ORIENT_PORTRAIT%
  231.  
  232. BEGIN DIALOG OBJECT OrientDialog 0, 0, 290, 180, "Asistente de calendarios", SUB OrientDialogEventHandler
  233.     PUSHBUTTON  181, 160, 46, 14, .NextButton, "&Siguiente>"
  234.     PUSHBUTTON  135, 160, 46, 14, .BackButton, "< &Atrßs"
  235.     CANCELBUTTON  234, 160, 46, 14, .CancelButton
  236.     TEXT  94, 10, 186, 20, .Text1, "Seleccione una orientaci≤n de pßgina."
  237.     IMAGE  10, 10, 75, 130, .OrientImage
  238.     GROUPBOX  10, 150, 270, 5, .LineGroupBox
  239.     OPTIONGROUP .OrientGroup
  240.         OPTIONBUTTON  102, 32, 104, 11, .Portrait, "Vertical"
  241.         OPTIONBUTTON  102, 46, 82, 12, .Landscape, "Horizontal"
  242. END DIALOG
  243.  
  244. SUB OrientDialogEventHandler(BYVAL ControlID%, BYVAL Event%)
  245.  
  246.     SELECT CASE Event%
  247.         CASE EVENT_INITIALIZATION&
  248.             ' Set up the page orientation option buttons.
  249.             IF Orient% = CAL_ORIENT_PORTRAIT% THEN
  250.                 OrientDialog.Portrait.SetValue TRUE
  251.             ELSE
  252.                 OrientDialog.Landscape.SetValue TRUE
  253.             ENDIF
  254.  
  255.         CASE EVENT_MOUSE_CLICK&
  256.             SELECT CASE ControlID%
  257.                 CASE OrientDialog.BackButton.GetID()
  258.                     LastPageX& = OrientDialog.GetLeftPosition()
  259.                     LastPageY& = OrientDialog.GetTopPosition()
  260.                     OrientDialog.CloseDialog DIALOG_RETURN_BACK%
  261.                 CASE OrientDialog.NextButton.GetID()
  262.                     LastPageX& = OrientDialog.GetLeftPosition()
  263.                     LastPageY& = OrientDialog.GetTopPosition()        
  264.                     OrientDialog.CloseDialog DIALOG_RETURN_NEXT%
  265.                 CASE OrientDialog.CancelButton.GetID()
  266.                     OrientDialog.CloseDialog DIALOG_RETURN_CANCEL%
  267.                 CASE OrientDialog.Portrait.GetID()
  268.                     Orient% = CAL_ORIENT_PORTRAIT%
  269.                 CASE OrientDialog.Landscape.GetID()
  270.                     Orient% = CAL_ORIENT_LANDSCAPE%                    
  271.             END SELECT
  272.     END SELECT    
  273.  
  274. END SUB
  275.  
  276. '/////STYLE CHOICE DIALOG//////////////////////////////////////////////
  277.  
  278. ' The calendar styles.
  279. GLOBAL CONST CAL_STYLE_SIMPLE%   = 1
  280. GLOBAL CONST CAL_STYLE_LEFT%     = 2
  281. GLOBAL CONST CAL_STYLE_RIGHT%    = 3
  282. GLOBAL CalChoices$(3)
  283. CalChoices$(CAL_STYLE_SIMPLE%) = "Estßndar"
  284. CalChoices$(CAL_STYLE_LEFT%) = "Tφtulo de pßgina izquierda"
  285. CalChoices$(CAL_STYLE_RIGHT%) = "Tφtulo de pßgina derecha"
  286.  
  287. ' The default calendar style.
  288. GLOBAL CONST CAL_DEFAULT_STYLE% = CAL_STYLE_SIMPLE%
  289.  
  290. ' Variables needed for the dialog.
  291. GLOBAL CalStyle AS INTEGER    ' The selected calendar style.
  292.  
  293. ' Set up defaults.
  294. CalStyle = CAL_DEFAULT_STYLE%
  295.  
  296. BEGIN DIALOG OBJECT StyleDialog 0, 0, 290, 180, "Asistente de calendarios", SUB StyleDialogEventHandler
  297.     PUSHBUTTON  181, 160, 46, 14, .NextButton, "&Siguiente >"
  298.     PUSHBUTTON  135, 160, 46, 14, .BackButton, "< &Atrßs"
  299.     CANCELBUTTON  234, 160, 46, 14, .CancelButton
  300.     IMAGE  10, 10, 75, 130, .StyleImage
  301.     GROUPBOX  10, 150, 270, 5, .LineGroupBox
  302.     DDLISTBOX  113, 35, 131, 144, .StyleList
  303.     IMAGE  135, 50, 89, 90, .PreviewImage
  304.     TEXT  94, 10, 181, 24, .Text2, "Seleccione un estilo para su calendario. El estilo seleccionado podrß previsualizarse en el cuadro presentado mßs abajo."
  305. END DIALOG
  306.  
  307. SUB StyleDialogEventHandler(BYVAL ControlID%, BYVAL Event%)
  308.  
  309.     SELECT CASE Event%
  310.         CASE EVENT_INITIALIZATION&
  311.             StyleDialog.StyleList.SetArray CalChoices$
  312.             StyleDialog.StyleList.SetSelect CalStyle%
  313.             
  314.             ' Update the preview image.
  315.             SELECT CASE CalStyle%
  316.                 CASE CAL_STYLE_SIMPLE%
  317.                     StyleDialog.PreviewImage.SetImage CurDir$ + BITMAP_PREVIEW_SIMPLE$
  318.                 CASE CAL_STYLE_LEFT%
  319.                     StyleDialog.PreviewImage.SetImage CurDir$ + BITMAP_PREVIEW_LEFT$
  320.                 CASE CAL_STYLE_RIGHT%
  321.                     StyleDialog.PreviewImage.SetImage CurDir$ + BITMAP_PREVIEW_RIGHT$
  322.             END SELECT
  323.             StyleDialog.PreviewImage.SetStyle STYLE_IMAGE_CENTERED
  324.  
  325.         CASE EVENT_MOUSE_CLICK&
  326.             SELECT CASE ControlID%
  327.                 CASE StyleDialog.BackButton.GetID()
  328.                     LastPageX& = StyleDialog.GetLeftPosition()
  329.                     LastPageY& = StyleDialog.GetTopPosition()
  330.                     StyleDialog.CloseDialog DIALOG_RETURN_BACK%
  331.                 CASE StyleDialog.NextButton.GetID()
  332.                     LastPageX& = StyleDialog.GetLeftPosition()
  333.                     LastPageY& = StyleDialog.GetTopPosition()
  334.                     StyleDialog.CloseDialog DIALOG_RETURN_NEXT%
  335.                 CASE StyleDialog.CancelButton.GetID()
  336.                     StyleDialog.CloseDialog DIALOG_RETURN_CANCEL%
  337.                 CASE StyleDialog.StyleList.GetID()
  338.                     CalStyle% = StyleDialog.StyleList.GetSelect()
  339.                     
  340.                     ' Update the preview image.
  341.                     SELECT CASE CalStyle%
  342.                         CASE CAL_STYLE_SIMPLE%
  343.                             StyleDialog.PreviewImage.SetImage CurDir$ + BITMAP_PREVIEW_SIMPLE$
  344.                         CASE CAL_STYLE_LEFT%
  345.                             StyleDialog.PreviewImage.SetImage CurDir$ + BITMAP_PREVIEW_LEFT$
  346.                         CASE CAL_STYLE_RIGHT%
  347.                             StyleDialog.PreviewImage.SetImage CurDir$ + BITMAP_PREVIEW_RIGHT$
  348.                     END SELECT
  349.  
  350.         END SELECT
  351.     END SELECT
  352.  
  353. END FUNCTION
  354.  
  355. '/////FONT CHOICE DIALOG//////////////////////////////////////////////
  356.  
  357. ' The text defaults.
  358. GLOBAL CONST CAL_DEFAULT_TEXT_SIZE% = 24
  359. GLOBAL CONST CAL_DEFAULT_TEXT_FONT$ = "Arial"
  360. GLOBAL CONST CAL_DEFAULT_TEXT_STYLE$ = "Regular"
  361.  
  362. ' Variables needed for the dialog.
  363. GLOBAL FontName AS STRING    ' The selected font name.
  364. GLOBAL PointSize AS INTEGER    ' The selected font size.
  365. GLOBAL Red AS INTEGER        ' The selected font's red component.
  366. GLOBAL Green AS INTEGER        ' The selected font's green component.
  367. GLOBAL Blue AS INTEGER        ' The selected font's blue component.
  368. GLOBAL Weight AS INTEGER        ' The selected font's weight.
  369. GLOBAL StrikeOut AS BOOLEAN    ' The selected font's strikeout setting.
  370. GLOBAL Underline AS BOOLEAN    ' The selected font's underline setting.
  371. GLOBAL Bold AS BOOLEAN        ' The selected font's bold setting.
  372. GLOBAL Italic AS BOOLEAN        ' The selected font's italic setting.
  373.  
  374. ' Set up defaults.
  375. FontName$ = CAL_DEFAULT_TEXT_FONT$
  376. PointSize% = CAL_DEFAULT_TEXT_SIZE%
  377. Red% = 0
  378. Green% = 0
  379. Blue% = 0
  380. Weight% = FONT_NORMAL&
  381. Strikeout = FALSE
  382. Underline = FALSE
  383. Bold = FALSE
  384. Italic = FALSE
  385.  
  386. BEGIN DIALOG OBJECT FontDialog 0, 0, 290, 180, "Asistente de calendarios", SUB FontDialogEventHandler
  387.     PUSHBUTTON  181, 160, 46, 14, .NextButton, "&Siguiente>"
  388.     PUSHBUTTON  135, 160, 46, 14, .BackButton, "< &Atrßs"
  389.     CANCELBUTTON  234, 160, 46, 14, .CancelButton
  390.     TEXT  94, 53, 116, 19, .Text1, "Consejo:"
  391.     IMAGE  10, 10, 75, 130, .FontImage
  392.     GROUPBOX  10, 150, 270, 5, .LineGroupBox
  393.     PUSHBUTTON  147, 37, 76, 14, .FontButton, "Seleccione fuente"
  394.     TEXT  94, 10, 181, 25, .Text2, "Puede darle un nuevo aspecto a su calendario seleccionando una fuente y un color. Para ello pulse el bot≤n de mßs abajo."
  395.     TEXT  125, 53, 162, 39, .Text4, "No se preocupe de seleccionar el tama±o de la fuente. El Asistente de calendarios seleccionarß automßticamente el tama±o de la fuentes que necesite."
  396. END DIALOG
  397.  
  398. SUB FontDialogEventHandler(BYVAL ControlID%, BYVAL Event%)
  399.  
  400.     DIM FontReturn AS INTEGER    ' The return value of the font dialog.
  401.  
  402.     SELECT CASE Event%
  403.         CASE EVENT_INITIALIZATION&
  404.             ' Nothing to initialize.
  405.  
  406.         CASE EVENT_MOUSE_CLICK&
  407.             SELECT CASE ControlID%
  408.                 CASE FontDialog.BackButton.GetID()
  409.                     LastPageX& = FontDialog.GetLeftPosition()
  410.                     LastPageY& = FontDialog.GetTopPosition()
  411.                     FontDialog.CloseDialog DIALOG_RETURN_BACK%
  412.                 CASE FontDialog.NextButton.GetID()
  413.                     LastPageX& = FontDialog.GetLeftPosition()
  414.                     LastPageY& = FontDialog.GetTopPosition()
  415.                     FontDialog.CloseDialog DIALOG_RETURN_NEXT%
  416.                 CASE FontDialog.CancelButton.GetID()
  417.                     FontDialog.CloseDialog DIALOG_RETURN_CANCEL%
  418.                 CASE FontDialog.FontButton.GetID()
  419.     
  420.                     ' Display the font dialog box.
  421.                     FontReturn% = GetFont(FontName$,                 \\
  422.                                       PointSize%,                 \\
  423.                                       Weight%,                 \\
  424.                                       Italic,                 \\
  425.                                       Underline,                 \\
  426.                                       Strikeout,                 \\
  427.                                       Red,                     \\
  428.                                       Green,                     \\
  429.                                       Blue) 
  430.                     IF NOT FontReturn% THEN
  431.                         ' The user pressed cancel.  We should not have
  432.                         ' to restore the defaults, but if GetFont
  433.                         ' empties FontName and Style, we must.
  434.                         IF (LEN(FontName$) = 0) THEN
  435.                             FontName$ = CAL_DEFAULT_TEXT_FONT$
  436.                         ENDIF
  437.                         IF (PointSize% = 0) THEN
  438.                             PointSize% = CAL_DEFAULT_TEXT_SIZE%
  439.                         ENDIF
  440.                     ENDIF
  441.                     ' Convert the weight value to either bold or non-bold.
  442.                     IF (Weight% > FONT_NORMAL&) THEN
  443.                         Bold = TRUE
  444.                     ELSE
  445.                         Bold = FALSE
  446.                     ENDIF
  447.  
  448.         END SELECT
  449.     END SELECT
  450.  
  451. END FUNCTION
  452.  
  453. '/////DATE CHOICE DIALOG///////////////////////////////////////////
  454.  
  455. ' Set the months of the year.
  456. GLOBAL Months$(12)
  457. Months$(1) =  FORMATDATE(CDAT("1996-01-01"), "MMMM")
  458. Months$(2) =  FORMATDATE(CDAT("1996-02-01"), "MMMM")
  459. Months$(3) =  FORMATDATE(CDAT("1996-03-01"), "MMMM")
  460. Months$(4) =  FORMATDATE(CDAT("1996-04-01"), "MMMM")
  461. Months$(5) =  FORMATDATE(CDAT("1996-05-01"), "MMMM")
  462. Months$(6) =  FORMATDATE(CDAT("1996-06-01"), "MMMM")
  463. Months$(7) =  FORMATDATE(CDAT("1996-07-01"), "MMMM")
  464. Months$(8) =  FORMATDATE(CDAT("1996-08-01"), "MMMM")
  465. Months$(9) =  FORMATDATE(CDAT("1996-09-01"), "MMMM")
  466. Months$(10) = FORMATDATE(CDAT("1996-10-01"), "MMMM")
  467. Months$(11) = FORMATDATE(CDAT("1996-11-01"), "MMMM")
  468. Months$(12) = FORMATDATE(CDAT("1996-12-01"), "MMMM")
  469.  
  470. ' Set the days of the week.
  471. GLOBAL Weekdays$(7)
  472. Weekdays$(1) = FORMATDATE(CDAT("1996-01-07"), "dddd")
  473. Weekdays$(2) = FORMATDATE(CDAT("1996-01-01"), "dddd")
  474. Weekdays$(3) = FORMATDATE(CDAT("1996-01-02"), "dddd")
  475. Weekdays$(4) = FORMATDATE(CDAT("1996-01-03"), "dddd")
  476. Weekdays$(5) = FORMATDATE(CDAT("1996-01-04"), "dddd")
  477. Weekdays$(6) = FORMATDATE(CDAT("1996-01-05"), "dddd")
  478. Weekdays$(7) = FORMATDATE(CDAT("1996-01-06"), "dddd")
  479.  
  480. ' Abbreviated days of the week.
  481. GLOBAL WeekdaysShort$(7)
  482. WeekdaysShort$(1) = FORMATDATE(CDAT("1996-01-07"), "ddd")
  483. WeekdaysShort$(2) = FORMATDATE(CDAT("1996-01-01"), "ddd")
  484. WeekdaysShort$(3) = FORMATDATE(CDAT("1996-01-02"), "ddd")
  485. WeekdaysShort$(4) = FORMATDATE(CDAT("1996-01-03"), "ddd")
  486. WeekdaysShort$(5) = FORMATDATE(CDAT("1996-01-04"), "ddd")
  487. WeekdaysShort$(6) = FORMATDATE(CDAT("1996-01-05"), "ddd")
  488. WeekdaysShort$(7) = FORMATDATE(CDAT("1996-01-06"), "ddd")
  489.  
  490. ' Variables needed by the dialog.
  491. GLOBAL Year AS INTEGER     ' The year of the first calendar to generate.
  492. GLOBAL Month AS INTEGER     ' The month of the first calendar to generate.
  493. GLOBAL HowMany AS INTEGER ' How many months to generate.
  494.  
  495. ' Set up defaults.
  496. Year% = 1996
  497. Month% = 9 
  498. HowMany% = 1
  499.  
  500. BEGIN DIALOG OBJECT DateDialog 0, 0, 290, 180, "Asistente de calendarios", SUB DateDialogEventHandler
  501.     PUSHBUTTON  181, 160, 46, 14, .NextButton, "&Terminar"
  502.     PUSHBUTTON  135, 160, 46, 14, .BackButton, "< &Atrßs"
  503.     CANCELBUTTON  234, 160, 46, 14, .CancelButton
  504.     IMAGE  10, 10, 75, 130, .DateImage
  505.     GROUPBOX  10, 150, 270, 5, .LineGroupBox
  506.     TEXT  106, 37, 24, 10, .Text2, "Mes"
  507.     DDLISTBOX  133, 35, 55, 168, .MonthList
  508.     TEXT  94, 10, 181, 17, .Text5, "Seleccione el primer mes del a±o y el a±o para los que desea crear un calendario."
  509.     TEXT  201, 37, 17, 13, .Text4, "A±o"
  510.     TEXT  94, 58, 181, 27, .Text9, "Inserte el n·mero de meses de calendarios que desee generar. Puede crear un a±o completo de calendarios insertando el n·mero 12."
  511.     TEXT  132, 91, 59, 12, .Text6, "N·mero de meses"
  512.     SPINCONTROL  222, 35, 35, 13, .YearSpin
  513.     SPINCONTROL  196, 88, 33, 13, .RepeatSpin
  514. END DIALOG
  515.  
  516. SUB DateDialogEventHandler(BYVAL ControlID%, BYVAL Event%)
  517.  
  518.     DIM MBReturn AS INTEGER    ' The return value of the MESSAGEBOX function.
  519.     DIM TodayDate AS DATE    ' Today's date (used to set the month and year).
  520.     DIM TodayYear AS LONG    ' The current year.
  521.     DIM TodayMonth AS LONG    ' The current month.
  522.     DIM TodayDay AS LONG    ' The current day.
  523.     DIM TodayDW AS LONG        ' Today's day of the week.
  524.     
  525.     SELECT CASE Event%
  526.         CASE EVENT_INITIALIZATION&
  527.             ' Use the current month and year as defaults.
  528.             TodayDate = GETCURRDATE()
  529.             GETDATEINFO TodayDate, TodayYear&, TodayMonth&, TodayDay&, TodayDW&
  530.             Year% = TodayYear&
  531.             Month% = TodayMonth&
  532.         
  533.             DateDialog.YearSpin.SetValue Year%
  534.             DateDialog.RepeatSpin.SetValue HowMany%
  535.             DateDialog.MonthList.SetArray Months$
  536.             DateDialog.MonthList.SetSelect Month%
  537.             
  538.         CASE EVENT_MOUSE_CLICK&
  539.             SELECT CASE ControlID%
  540.                 CASE DateDialog.BackButton.GetID()
  541.                     LastPageX& = DateDialog.GetLeftPosition()
  542.                     LastPageY& = DateDialog.GetTopPosition()
  543.                     IF (DateDialog.YearSpin.GetValue() < 1900) OR \\
  544.                        (DateDialog.YearSpin.GetValue() > 2300) THEN
  545.                         MBReturn = MESSAGEBOX("Inserte un a±o entre" + \\
  546.                                               "1900 y 2300 inclusive.",      \\
  547.                                               TITLE_INFOBOX,                  \\
  548.                                               MB_INFORMATION_ICON)
  549.                         DateDialog.YearSpin.SetValue Year%    
  550.                     ELSEIF (DateDialog.RepeatSpin.GetValue() < 1) OR \\
  551.                            (DateDialog.RepeatSpin.GetValue() > 999) THEN
  552.                          MBReturn = MESSAGEBOX("Inserte un n·mero de" + \\
  553.                                                "meses entre 1 y 999 inclusive.",\\
  554.                                                TITLE_INFOBOX, MB_INFORMATION_ICON)
  555.                         DateDialog.RepeatSpin.SetValue HowMany%
  556.                     ELSE
  557.                         Year% = DateDialog.YearSpin.GetValue()
  558.                         HowMany% = DateDialog.RepeatSpin.GetValue()
  559.                         DateDialog.CloseDialog DIALOG_RETURN_BACK%
  560.                     ENDIF
  561.                 CASE DateDialog.NextButton.GetID()
  562.                     LastPageX& = DateDialog.GetLeftPosition()
  563.                     LastPageY& = DateDialog.GetTopPosition()
  564.                     IF (DateDialog.YearSpin.GetValue() < 1900) OR \\
  565.                        (DateDialog.YearSpin.GetValue() > 2300) THEN
  566.                         MBReturn = MESSAGEBOX("Inserte un a±o entre" + \\
  567.                                               "1900 y 2300 inclusive.",      \\
  568.                                               TITLE_INFOBOX,                   \\
  569.                                               MB_INFORMATION_ICON)
  570.                         DateDialog.YearSpin.SetValue Year%    
  571.                     ELSEIF (DateDialog.RepeatSpin.GetValue() < 1) OR \\
  572.                            (DateDialog.RepeatSpin.GetValue() > 18) THEN
  573.                          MBReturn = MESSAGEBOX("Inserte un n·mero de" + \\
  574.                                                "meses entre 1 y 18 inclusive.",\\
  575.                                                TITLE_INFOBOX, MB_INFORMATION_ICON)
  576.                         DateDialog.RepeatSpin.SetValue HowMany%
  577.                     ELSE
  578.                         Year% = DateDialog.YearSpin.GetValue()
  579.                         HowMany% = DateDialog.RepeatSpin.GetValue()
  580.                         DateDialog.CloseDialog DIALOG_RETURN_NEXT%
  581.                     ENDIF
  582.                 CASE DateDialog.CancelButton.GetID()
  583.                     DateDialog.CloseDialog DIALOG_RETURN_CANCEL%
  584.                 CASE DateDialog.MonthList.GetID()
  585.                     Month% = DateDialog.MonthList.GetSelect()
  586.             END SELECT
  587.             
  588.         CASE EVENT_CHANGE_IN_CONTENT&
  589.             SELECT CASE ControlID%
  590.                 CASE DateDialog.YearSpin.GetID()
  591.                     IF (DateDialog.YearSpin.GetValue() < 1900) THEN
  592.                         MBReturn = MESSAGEBOX("Inserte un a±o entre" + \\
  593.                                               "1900 y 2300 inclusive.",      \\
  594.                                               TITLE_INFOBOX,                   \\
  595.                                               MB_INFORMATION_ICON)
  596.                         DateDialog.YearSpin.SetValue 1900
  597.                     ELSEIF (DateDialog.YearSpin.GetValue() > 2300) THEN
  598.                         MBReturn = MESSAGEBOX("Inserte un a±o entre" + \\
  599.                                               "1900 y 2300 inclusive.",      \\
  600.                                               TITLE_INFOBOX,                   \\
  601.                                               MB_INFORMATION_ICON)
  602.                         DateDialog.YearSpin.SetValue 2300
  603.                     ENDIF
  604.                 CASE DateDialog.RepeatSpin.GetID()
  605.                     IF (DateDialog.RepeatSpin.GetValue() < 1) THEN
  606.                          MBReturn = MESSAGEBOX("Inserte un n·mero de" + \\
  607.                                                "meses entre 1 y 18 inclusive.",\\
  608.                                                TITLE_INFOBOX, MB_INFORMATION_ICON)
  609.                         DateDialog.RepeatSpin.SetValue 1
  610.                     ELSEIF (DateDialog.RepeatSpin.GetValue() > 18) THEN
  611.                          MBReturn = MESSAGEBOX("Inserte un n·mero de" + \\
  612.                                                "meses entre 1 y 18 inclusive.",\\
  613.                                                TITLE_INFOBOX, MB_INFORMATION_ICON)
  614.                         DateDialog.RepeatSpin.SetValue 18
  615.                     ENDIF
  616.                 
  617.             END SELECT
  618.             
  619.     END SELECT
  620.  
  621. END FUNCTION
  622.  
  623. '/////PICTURE AND BORDER CHOICE DIALOG///////////////////////////////
  624.  
  625. ' Variables needed by the dialog.
  626. GLOBAL UsePicture AS BOOLEAN    ' Add a picture to the calendar?
  627. GLOBAL UseBorder AS BOOLEAN   ' Add a border to the calendar?
  628. GLOBAL PictureFile AS STRING  ' Name and path of the picture.
  629. GLOBAL BorderFile AS STRING   ' Name and path of the border.
  630. GLOBAL TmpFileName AS STRING  ' A temporary file name.
  631.  
  632. ' Set up defaults.
  633. UsePicture = FALSE
  634. UseBorder  = FALSE
  635. PictureFile$ = ""
  636. BorderFile$ = ""
  637.  
  638. BEGIN DIALOG OBJECT PicDialog 0, 0, 290, 180, "Asistente de calendarios", SUB PicDialogEventHandler
  639.     PUSHBUTTON  181, 160, 46, 14, .NextButton, "&Siguiente>"
  640.     PUSHBUTTON  135, 160, 46, 14, .BackButton, "< &Atrßs"
  641.     CANCELBUTTON  234, 160, 46, 14, .CancelButton
  642.     IMAGE  10, 10, 75, 130, .PicImage
  643.     GROUPBOX  10, 150, 270, 5, .LineGroupBox
  644.     TEXT  90, 110, 28, 11, .Text9, "Consejo:"
  645.     TEXT  90, 10, 181, 17, .Text5, "┐Desea a±adir una imagen a su calendario?"
  646.     CHECKBOX  90, 25, 90, 12, .PictureCheck, "Sφ.Nombre del arch. es:"
  647.     TEXTBOX  180, 24, 50, 13, .PicTextBox
  648.     PUSHBUTTON  233, 24, 53, 13, .PictureButton, "Selecc. archi."
  649.     CHECKBOX  90, 76, 90, 12, .BorderCheck, "Sφ.Nombre del arch. es:"
  650.     TEXTBOX  180, 75, 50, 13, .BorderTextBox
  651.     PUSHBUTTON  233, 75, 53, 13, .BorderButton, "Selecc. archi."
  652.     TEXT  90, 45, 181, 27, .Text6, "TambiΘn puede a±adirle un margen a su calendario. Para obtener resultados ≤ptimos, deberφa seleccionar un margen del directorio de clipart Mßrgenes/Marcos."
  653.     TEXT  125, 110, 157, 40, .Text8, "Para un aspecto ≤ptimo de su calendario, seleccione como mßximo una de las opciones arriba. De otra manera, puede que no tenga suficiente espacio en su pßgina para el calendario."
  654. END DIALOG
  655.  
  656. SUB PicDialogEventHandler(BYVAL ControlID%, BYVAL Event%)
  657.  
  658.     DIM MBReturn AS INTEGER    ' The return value of the MESSAGEBOX function.
  659.     DIM NoGo AS BOOLEAN        ' Whether the user is allowed to move to
  660.                         ' another pane of the wizard.
  661.     
  662.     SELECT CASE Event%
  663.         CASE EVENT_INITIALIZATION&
  664.             IF UsePicture THEN
  665.                 PicDialog.PictureCheck.SetValue 1
  666.             ELSE
  667.                 PicDialog.PictureCheck.SetValue 0
  668.             ENDIF
  669.             PicDialog.PictureCheck.SetThreeState FALSE
  670.             IF UseBorder THEN
  671.                 PicDialog.BorderCheck.SetValue 1
  672.             ELSE
  673.                 PicDialog.BorderCheck.SetValue 0
  674.             ENDIF
  675.             PicDialog.BorderCheck.SetThreeState FALSE
  676.             PicDialog.PicTextBox.SetText PictureFile$
  677.             PicDialog.BorderTextBox.SetText BorderFile$
  678.             IF PicDialog.PictureCheck.GetValue() THEN
  679.                 PicDialog.PicTextBox.Enable TRUE
  680.                 PicDialog.PictureButton.Enable TRUE
  681.             ELSE
  682.                 PicDialog.PicTextBox.Enable FALSE
  683.                 PicDialog.PictureButton.Enable FALSE
  684.             ENDIF
  685.             IF PicDialog.BorderCheck.GetValue() THEN
  686.                 PicDialog.BorderTextBox.Enable TRUE
  687.                 PicDialog.BorderButton.Enable TRUE
  688.             ELSE
  689.                 PicDialog.BorderTextBox.Enable FALSE
  690.                 PicDialog.BorderButton.Enable FALSE
  691.             ENDIF                    
  692.  
  693.         CASE EVENT_MOUSE_CLICK&
  694.             SELECT CASE ControlID%
  695.                 CASE PicDialog.PictureCheck.GetID()
  696.                     IF PicDialog.PictureCheck.GetValue() THEN
  697.                         PicDialog.PicTextBox.Enable TRUE
  698.                         PicDialog.PictureButton.Enable TRUE
  699.                         UsePicture = TRUE
  700.                     ELSE
  701.                         PicDialog.PicTextBox.Enable FALSE
  702.                         PicDialog.PictureButton.Enable FALSE
  703.                         UsePicture = FALSE
  704.                     ENDIF
  705.                 CASE PicDialog.BorderCheck.GetID()
  706.                     IF PicDialog.BorderCheck.GetValue() THEN
  707.                         PicDialog.BorderTextBox.Enable TRUE
  708.                         PicDialog.BorderButton.Enable TRUE
  709.                         UseBorder = TRUE
  710.                     ELSE
  711.                         PicDialog.BorderTextBox.Enable FALSE
  712.                         PicDialog.BorderButton.Enable FALSE
  713.                         UseBorder = FALSE
  714.                     ENDIF                    
  715.                 CASE PicDialog.PictureButton.GetID()
  716.                     TmpFileName$ = GETFILEBOX( \\
  717.                            "Todos los archivos|*.*", \\
  718.                            "Seleccione una imagen", \\
  719.                            FILE_OPEN )
  720.                        IF LEN(TmpFileName$) > 0 THEN
  721.                            PicDialog.PicTextBox.SetText TmpFileName$
  722.                        ENDIF
  723.                 CASE PicDialog.BorderButton.GetID()
  724.                     TmpFileName$ = GETFILEBOX( \\
  725.                            "*.*", \\
  726.                            "Seleccione un margen", \\
  727.                            FILE_OPEN )
  728.                        IF LEN(TmpFileName$) > 0 THEN
  729.                            PicDialog.BorderTextBox.SetText TmpFileName$
  730.                        ENDIF                
  731.                 CASE PicDialog.BackButton.GetID()
  732.                     LastPageX& = PicDialog.GetLeftPosition()
  733.                     LastPageY& = PicDialog.GetTopPosition()
  734.                     NoGo = FALSE
  735.                     IF PicDialog.PictureCheck.GetValue() THEN
  736.                         IF (NOT FileExists( \\
  737.                             PicDialog.PicTextBox.GetText())) THEN
  738.                         NoGo = TRUE
  739.                         ENDIF
  740.                     ELSEIF PicDialog.BorderCheck.GetValue() THEN
  741.                         IF (NOT FileExists( \\
  742.                             PicDialog.BorderTextBox.GetText())) THEN
  743.                          NoGo = TRUE
  744.                         ENDIF
  745.                     ENDIF
  746.                     IF PicDialog.PictureCheck.GetValue() AND \\
  747.                        PicDialog.BorderCheck.GetValue() AND \\
  748.                        Orient% = CAL_ORIENT_LANDSCAPE% THEN
  749.                         MBReturn% = MESSAGEBOX( "No es" + \\
  750.                                        "posible crear un calendario" + \\
  751.                                        "con orientaci≤n horizontal y" + \\
  752.                                        "tambiΘn una imagen y un margen.  " + \\
  753.                                        "No hay suficiente espacio" + \\
  754.                                        "en la pßgina." + NL2 + \\
  755.                                        "Seleccione o bien una imagen o un" + \\
  756.                                        "margen, o bien ninguno y vuΘlvalo a intentarlo.", \\
  757.                                        TITLE_INFOBOX$, \\
  758.                                        MB_OK_ONLY& )
  759.                         NoGo = TRUE
  760.                     ENDIF
  761.                     IF NOT NoGo THEN
  762.                         PictureFile$ = PicDialog.PicTextBox.GetText()
  763.                         BorderFile$ = PicDialog.BorderTextBox.GetText()
  764.                         UsePicture = PicDialog.PictureCheck.GetValue()
  765.                         UseBorder = PicDialog.BorderCheck.GetValue()
  766.                         PicDialog.CloseDialog DIALOG_RETURN_BACK%
  767.                     ENDIF
  768.                 CASE PicDialog.NextButton.GetID()
  769.                     LastPageX& = PicDialog.GetLeftPosition()
  770.                     LastPageY& = PicDialog.GetTopPosition()
  771.                     NoGo = FALSE
  772.                     IF PicDialog.PictureCheck.GetValue() THEN
  773.                         IF (NOT FileExists( \\
  774.                             PicDialog.PicTextBox.GetText())) THEN
  775.                         NoGo = TRUE
  776.                         ENDIF
  777.                     ELSEIF PicDialog.BorderCheck.GetValue() THEN
  778.                         IF (NOT FileExists( \\
  779.                             PicDialog.BorderTextBox.GetText())) THEN
  780.                          NoGo = TRUE
  781.                         ENDIF
  782.                     ENDIF
  783.                     IF PicDialog.PictureCheck.GetValue() AND \\
  784.                        PicDialog.BorderCheck.GetValue() AND \\
  785.                        Orient% = CAL_ORIENT_LANDSCAPE THEN
  786.                         MBReturn% = MESSAGEBOX( "No es" + \\
  787.                                        "posible crear un calendario" + \\
  788.                                        "con una orientaci≤n horizontal y" + \\
  789.                                        "tambiΘn una imagen y un margen.  " + \\
  790.                                        "No hay suficiente espacio" + \\
  791.                                        "en la pßgina." + NL2 + \\
  792.                                        "Seleccione o bien una imagen o un" + \\
  793.                                        "margen, o bien ninguno y vuΘlvalo a intentarlo.", \\
  794.                                        TITLE_INFOBOX$, \\
  795.                                        MB_OK_ONLY& )
  796.                         NoGo = TRUE
  797.                     ENDIF
  798.                     IF NOT NoGo THEN
  799.                         PictureFile$ = PicDialog.PicTextBox.GetText()
  800.                         BorderFile$ = PicDialog.BorderTextBox.GetText()
  801.                         UsePicture = PicDialog.PictureCheck.GetValue()
  802.                         UseBorder = PicDialog.BorderCheck.GetValue()
  803.                         PicDialog.CloseDialog DIALOG_RETURN_NEXT%
  804.                     ENDIF
  805.                 CASE PicDialog.CancelButton.GetID()
  806.                     DateDialog.CloseDialog DIALOG_RETURN_CANCEL%
  807.             END SELECT
  808.     END SELECT
  809.  
  810. END FUNCTION
  811.  
  812. '/////PROCESSING DIALOG/////////////////////////////////////////////////////
  813.  
  814. BEGIN DIALOG OBJECT ProcessingDialog 204, 50, "Asistente de calendarios - Procesando", SUB ProcessingDialogEventHandler
  815.     TEXT  39, 7, 143, 13, .Text5, "Su calendario se estß elaborando. Espere."
  816.     PROGRESS 22, 27, 162, 11, .Progress
  817. END DIALOG
  818.  
  819. SUB ProcessingDialogEventHandler(BYVAL ControlID%, BYVAL Event%)
  820.  
  821.     DIM MessageText AS STRING    ' Text to use in a MESSAGEBOX.
  822.     DIM GenReturn AS INTEGER        ' The return value of various routines.
  823.     
  824.     SELECT CASE Event%
  825.         CASE EVENT_INITIALIZATION&
  826.  
  827. ' <<<<< BEGIN REVERSE INDENT TO SAVE SPACE
  828.  
  829. ' Initialize the progress bar.
  830. ProcessingDialog.Progress.SETMINRANGE 0
  831. ProcessingDialog.Progress.SETMAXRANGE CalcHowMany( HowMany%, Month%, Year% )
  832. ProcessingDialog.Progress.SETINCREMENT 1
  833.  
  834. ' Determine the necessary page dimensions.
  835. DIM PageX AS LONG : DIM PageY AS LONG
  836. IF (Orient% = CAL_ORIENT_PORTRAIT%) THEN
  837.     PageX& = ArrayPageDim!(PageSize%, 1)
  838.     PageY& = ArrayPageDim!(PageSize%, 2)
  839. ELSE
  840.     PageX& = ArrayPageDim!(PageSize%, 2)
  841.     PageY& = ArrayPageDim!(PageSize%, 1)
  842. ENDIF
  843.  
  844. ' Connect to CorelDRAW, then create a new document for the calendar.
  845. .FileNew
  846. .SuppressPainting FALSE
  847.  
  848. ' Loop through all the calendars we have to create, and build each one.
  849. DIM Counter AS INTEGER
  850. DIM WeekdayCounter AS INTEGER
  851. DIM RowCounter AS INTEGER
  852. DIM DayCounter AS INTEGER
  853. DIM CurMonth AS INTEGER
  854. CurMonth% = Month%
  855. DIM CurYear AS INTEGER
  856. CurYear% = Year%
  857. DIM PageX_TM AS LONG    ' The horizontal page size in tenths of a micron.
  858. DIM PageY_TM AS LONG    ' The vertical page size in tenths of a micron. 
  859. DIM TitleX AS LONG        ' The generated width of the title text.
  860. DIM TitleY As LONG        ' The generated height of the title text.
  861. DIM DayX AS LONG        ' The width of the text for a specific day.
  862. DIM DayY AS LONG        ' The height of the text for a specific day.
  863. DIM NeededY AS LONG        ' The required height for the weekday names.
  864. DIM NumRows AS INTEGER    ' The number of rows needed in this month.
  865. DIM RowHeight AS LONG    ' The height of a row.
  866. DIM ColWidth AS LONG    ' The width of a column.
  867. DIM CurRow AS INTEGER    ' The current row number being processed.
  868. DIM CurCol AS INTEGER    ' The current column number being processed.
  869. DIM DaySize AS LONG        ' The size (in points) we need for the numbers.
  870. DIM WeekdayBarHeight AS LONG    ' The height of the weekday bar.
  871.  
  872. FOR Counter% = 1 TO HowMany%
  873.  
  874.     ' Create a new page.
  875.     IF NOT (Counter% = 1) THEN
  876.         .InsertPages 0, 1
  877.     ENDIF
  878.     
  879.     ' Set the page orientation.    
  880.     IF (Orient% = CAL_ORIENT_PORTRAIT%) THEN
  881.         .SetPageOrientation DRAW_ORIENT_PORTRAIT&
  882.     ELSE
  883.         .SetPageOrientation DRAW_ORIENT_LANDSCAPE&
  884.     ENDIF
  885.  
  886.     ' Set the size of the new page.    
  887.     PageX_TM& = PageX&*LENGTHCONVERT(LC_INCHES&, LC_TENTHS_OFA_MICRON&, 1)
  888.     PageY_TM& = PageY&*LENGTHCONVERT(LC_INCHES&, LC_TENTHS_OFA_MICRON&, 1)
  889.     .SetPageSize PageX_TM&, PageY_TM&
  890.  
  891.     ' Determine the boundaries within which we can draw the calendar.
  892.     ' These coordinates are relative to the center of the page.
  893.     DIM TopLeftX AS LONG : DIM TopLeftY AS LONG      ' The top left corner.
  894.     DIM BottomRightX AS LONG : DIM BottomRightY AS LONG ' The bottom right corner.
  895.     TopLeftX& = (PageX& / -2)*LENGTHCONVERT(LC_INCHES&, LC_TENTHS_OFA_MICRON&, 1)
  896.     TopLeftY& = (PageY& / 2)*LENGTHCONVERT(LC_INCHES&, LC_TENTHS_OFA_MICRON&, 1)
  897.     BottomRightX& = (PageX& / 2)*LENGTHCONVERT(LC_INCHES&, LC_TENTHS_OFA_MICRON&, 1)
  898.     BottomRightY& = (PageY& / -2)*LENGTHCONVERT(LC_INCHES&, LC_TENTHS_OFA_MICRON&, 1)
  899.  
  900.     ' Factor in the margins.
  901.     AddMargins TopLeftX&, TopLeftY&, BottomRightX&, BottomRightY&
  902.  
  903.     ' Draw the borders and/or picture, if necessary.
  904.     ' Adjust the calendar boundaries appropriately.
  905.     DoGraphics UsePicture, \\
  906.                UseBorder, \\
  907.                PictureFile$, \\
  908.                BorderFile$, \\
  909.                TopLeftX&, \\
  910.                TopLeftY&, \\
  911.                BottomRightX&, \\
  912.                BottomRightY&
  913.  
  914.     ' Create the title (the month and year).
  915.     CreateText Months$(CurMonth%) + " " + CSTR(CurYear%), \\
  916.                FontName$,                                 \\
  917.              24,                                          \\
  918.                Bold,                                      \\
  919.                Italic,                                    \\
  920.                Strikeout,                                 \\
  921.              Underline,                            \\
  922.                Red%,                                      \\
  923.                Green%,                                    \\
  924.                Blue%
  925.  
  926.     ' Create the title differently depending on the style selected.
  927.     IF CalStyle% = CAL_STYLE_SIMPLE% THEN
  928.     
  929.         ' Make the text proportional to the size it should occupy
  930.         ' on the page.
  931.         .GetSize TitleX&, TitleY&
  932.         .SetSize BottomRightX& - TopLeftX&, \\
  933.                  (BottomRightX& - TopLeftX&) * (TitleY& / TitleX&)
  934.     
  935.         ' Add in some whitespace above and below for effect.
  936.         .GetSize TitleX&, TitleY&
  937.         .SetPosition TopLeftX&, TopLeftY&
  938.         TopLeftY& = TopLeftY& - TitleY& - (0.3 * TitleY&)
  939.  
  940.     ELSEIF CalStyle% = CAL_STYLE_LEFT% THEN
  941.  
  942.         ' Rotate the text by 90 degrees.
  943.         .RotateObject 90 * 1000000, -1, 0,0
  944.  
  945.         ' Make the text proportional to the size it should occupy
  946.         ' on the page.
  947.         .GetSize TitleX&, TitleY&
  948.         .SetSize (TopLeftY& - BottomRightY&) * (TitleX& / TitleY&), \\
  949.                    TopLeftY& - BottomRightY&
  950.  
  951.         ' Position the text along the left hand side.
  952.         .SetPosition TopLeftX&, TopLeftY&
  953.         .GetSize TitleX&, TitleY&
  954.         TopLeftX& = TopLeftX& + TitleX& + (0.3 * TitleX&)
  955.  
  956.     ELSEIF CalStyle% = CAL_STYLE_RIGHT% THEN
  957.  
  958.         ' Rotate the text back by 90 degrees.
  959.         .RotateObject -90 * 1000000, -1, 0,0
  960.  
  961.         ' Make the text proportional to the size it should occupy
  962.         ' on the page.
  963.         .GetSize TitleX&, TitleY&
  964.         .SetSize (TopLeftY& - BottomRightY&) * (TitleX& / TitleY&), \\
  965.                    TopLeftY& - BottomRightY&
  966.  
  967.         ' Position the text along the right hand side.
  968.         .SetReferencePoint DRAW_REF_TOP_RIGHT&
  969.         .SetPosition BottomRightX&, TopLeftY&
  970.         .SetReferencePoint DRAW_REF_TOP_LEFT&
  971.         .GetSize TitleX&, TitleY&
  972.         BottomRightX& = BottomRightX& - TitleX& - (0.3 * TitleX&)
  973.  
  974.     ENDIF    
  975.  
  976.     ProcessingDialog.Progress.Step
  977.  
  978.     ' Determine how big the weekday names need to be.
  979.     CreateText "MiΘrcoles",                               \\
  980.                FontName$,                                 \\
  981.              24,                                    \\
  982.                Bold,                                      \\
  983.                Italic,                                    \\
  984.                Strikeout,                                 \\
  985.              Underline,                            \\
  986.                Red%,                                      \\
  987.                Green%,                                    \\
  988.                Blue%
  989.     .GetSize DayX&, DayY&
  990.     .SetSize (BottomRightX& - TopLeftX&)/7 * 0.8, \\
  991.              ((BottomRightX& - TopLeftX&)/7) * 0.8 * (DayY& / DayX&)
  992.     .GetSize DayX&, DayY&
  993.     NeededY& = DayY&
  994.     .DeleteObject
  995.     
  996.     ' Create a background rectangle.
  997.     WeekdayBarHeight& = DayY& * 2
  998.     .CreateRectangle TopLeftY&, \\
  999.                      TopLeftX&, \\
  1000.                      TopLeftY& - WeekdayBarHeight&, \\
  1001.                      BottomRightX&
  1002.     .StoreColor DRAW_COLORMODEL_RGB&, Red%, Green%, Blue%, 0
  1003.     .ApplyUniformFillColor
  1004.     .StoreColor DRAW_COLORMODEL_RGB&, Red%, Green%, Blue%, 0
  1005.     .SetOutlineColor
  1006.  
  1007.     ' Create a rectangle enclosing the whole calendar.
  1008.     .CreateRectangle TopLeftY&, TopLeftX&, BottomRightY&, BottomRightX&
  1009.     .ApplyOutline LENGTHCONVERT(LC_INCHES, LC_TENTHS_OFA_MICRON, 0.03), \\
  1010.               DRAW_OUTLINE_TYPE_SOLID, \\
  1011.               DRAW_OUTLINE_CAPS_BUTT,  \\
  1012.               DRAW_OUTLINE_JOIN_MITER, \\
  1013.               100, \\
  1014.               0, \\
  1015.               0, \\
  1016.               0, \\
  1017.               0, \\
  1018.               0
  1019.     .StoreColor DRAW_COLORMODEL_RGB&, Red%, Green%, Blue%, 0
  1020.     .SetOutlineColor
  1021.     ProcessingDialog.Progress.Step
  1022.  
  1023.     ' Generate the weekday names.
  1024.     FOR WeekdayCounter% = 1 TO 7 
  1025.     
  1026.         ' Create the text (in white), scale it, then position it.
  1027.         CreateText Weekdays$(WeekdayCounter),          \\
  1028.                     FontName$,                          \\
  1029.                  24,                              \\
  1030.                     Bold,                               \\
  1031.                     Italic,                             \\
  1032.                     Strikeout,                          \\
  1033.                   Underline,                      \\
  1034.                     255,                                \\
  1035.                     255,                                \\
  1036.                     255%
  1037.         .GetSize DayX&, DayY&
  1038.         .SetSize NeededY& * (DayX& / DayY&), NeededY&
  1039.         
  1040.         ' Center the text vertically.
  1041.         .SetReferencePoint DRAW_REF_MIDDLE_LEFT&
  1042.         .SetPosition TopLeftX& + (WeekdayCounter% - 1)* \\
  1043.                      ((BottomRightX& - TopLeftX&)/7),   \\
  1044.                      TopLeftY& - (WeekdayBarHeight&/2)
  1045.         .SetReferencePoint DRAW_REF_TOP_LEFT&
  1046.         
  1047.         ' Draw vertical rulings.
  1048.         .BeginDrawCurve  TopLeftX& + (WeekdayCounter%)* \\
  1049.                          ((BottomRightX& - TopLeftX&)/7), TopLeftY&
  1050.         .DrawCurveLineTo TopLeftX& + (WeekdayCounter%)* \\
  1051.                          ((BottomRightX& - TopLeftX&)/7), BottomRightY&
  1052.         .EndDrawCurve
  1053.         .ApplyOutline LENGTHCONVERT(LC_INCHES, LC_TENTHS_OFA_MICRON, 0.03), \\
  1054.                       DRAW_OUTLINE_TYPE_SOLID, \\
  1055.                       DRAW_OUTLINE_CAPS_BUTT,  \\
  1056.                       DRAW_OUTLINE_JOIN_MITER, \\
  1057.                       100, \\
  1058.                       0, \\
  1059.                       0, \\
  1060.                       0, \\
  1061.                       0, \\
  1062.                       0
  1063.         .StoreColor DRAW_COLORMODEL_RGB&, Red%, Green%, Blue%, 0
  1064.         .SetOutlineColor
  1065.         ProcessingDialog.Progress.Step
  1066.  
  1067.     NEXT WeekdayCounter
  1068.     
  1069.     ' Subtract the amount of space that was used by the weekdays bar.
  1070.     TopLeftY& = TopLeftY& - WeekdayBarHeight&
  1071.     
  1072.     ' Determine how many rows we need for this month.
  1073.     NumRows% = GetNumRows(CurMonth, CurYear)
  1074.  
  1075.     ' Calculate the height and width of the columns.
  1076.     RowHeight& = (TopLeftY& - BottomRightY&) / NumRows%
  1077.     ColWidth&  = (TopLeftX& - BottomRightX&) / 7
  1078.     
  1079.     ' Draw in the row lines.
  1080.     FOR RowCounter% = 1 TO (NumRows% - 1)
  1081.     
  1082.         .BeginDrawCurve TopLeftX&, TopLeftY&-RowHeight&*RowCounter%
  1083.         .DrawCurveLineTo BottomRightX&, TopLeftY&-RowHeight&*RowCounter%
  1084.         .EndDrawCurve
  1085.         .ApplyOutline LENGTHCONVERT(LC_INCHES, LC_TENTHS_OFA_MICRON, 0.03), \\
  1086.                       DRAW_OUTLINE_TYPE_SOLID, \\
  1087.                       DRAW_OUTLINE_CAPS_BUTT,  \\
  1088.                       DRAW_OUTLINE_JOIN_MITER, \\
  1089.                       100, \\
  1090.                       0, \\
  1091.                       0, \\
  1092.                       0, \\
  1093.                       0, \\
  1094.                       0
  1095.         .StoreColor DRAW_COLORMODEL_RGB&, Red%, Green%, Blue%, 0
  1096.         .SetOutlineColor
  1097.     
  1098.     NEXT RowCounter%
  1099.     ProcessingDialog.Progress.Step
  1100.  
  1101.     ' Due to the nature of typeface numerics, it would not be
  1102.     ' aesthetically pleasing to do a proportional resize on the
  1103.     ' day numbers.  So we will calculate an appropriate point size.
  1104.     DaySize& = LENGTHCONVERT( LC_TENTHS_OFA_MICRON&, \\
  1105.                               LC_POINTS&, \\
  1106.                               RowHeight& * 0.15 )
  1107.  
  1108.     ' Draw in the day numbers.
  1109.     CurRow% = 1
  1110.     CurCol% = GetWeekday(CDAT( STR(CurYear%) + "-" + STR(CurMonth%) + "-1"))
  1111.     FOR DayCounter% = 1 TO GetNumDays( CurMonth%, CurYear% )
  1112.     
  1113.         ' Create the day number.
  1114.         CreateText STR(DayCounter%),                 \\
  1115.                     FontName$,                        \\
  1116.                  DaySize&,                       \\
  1117.                     Bold,                             \\
  1118.                     Italic,                           \\
  1119.                     Strikeout,                        \\
  1120.                   Underline,                    \\
  1121.                     Red%,                             \\
  1122.                     Green%,                           \\
  1123.                     Blue% 
  1124.         .SetPosition TopLeftX&-((CurCol%-1)*ColWidth&)-ColWidth&*0.07, \\
  1125.                      TopLeftY&-(CurRow%*RowHeight&)+RowHeight&*0.92
  1126.  
  1127.         ' Update the current row and column.
  1128.         IF (CurCol% = 7) THEN
  1129.            CurCol% = 1
  1130.            CurRow% = CurRow% + 1
  1131.         ELSE
  1132.            CurCol% = CurCol% + 1
  1133.         ENDIF
  1134.  
  1135.         ' Update the progress bar.
  1136.         ProcessingDialog.Progress.Step
  1137.     
  1138.     NEXT DayCounter%
  1139.     
  1140.     ' Update the year and month we are processing.
  1141.     IF CurMonth% = 12 THEN
  1142.         CurMonth% = 1
  1143.         CurYear% = CurYear% + 1
  1144.     ELSE
  1145.         CurMonth% = CurMonth% + 1
  1146.     ENDIF
  1147.  
  1148. NEXT Counter%
  1149.  
  1150. .ResumePainting
  1151.  
  1152. GenReturn% = MESSAGEBOX( "íHa terminado de crear su calendario!", \\
  1153.                          TITLE_INFOBOX$, \\
  1154.                          MB_OK_ONLY& )
  1155. ProcessingDialog.CloseDialog DIALOG_RETURN_OK%
  1156.  
  1157. ' >>>>> END REVERSE INDENT
  1158.                                     
  1159.     END SELECT
  1160.  
  1161. END FUNCTION
  1162.  
  1163. '********************************************************************
  1164. ' MAIN
  1165. '
  1166. '
  1167. '********************************************************************
  1168.  
  1169. '/////LOCAL VARIABLES////////////////////////////////////////////////
  1170. DIM MessageText AS STRING    ' Text to use in a MESSAGEBOX.
  1171. DIM CurStep AS INTEGER        ' The user's current dialog number.
  1172.  
  1173. ' Set up a general error handler.
  1174. ON ERROR GOTO MainErrorHandler
  1175.  
  1176. ' Retrieve the directory where the script was started.
  1177. CurDir$ = GETCURRFOLDER()
  1178. IF MID(CurDir$, LEN(CurDir$), 1) = "\" THEN
  1179.     CurDir$ = LEFT(CurDir$, LEN(CurDir$) - 1)
  1180. ENDIF
  1181.  
  1182. CONST NS_FINISH%         = 0
  1183. CONST NS_INTRODIALOG%     = 1
  1184. CONST NS_SIZEDIALOG%      = 2
  1185. CONST NS_ORIENTDIALOG%     = 3
  1186. CONST NS_STYLEDIALOG%     = 4
  1187. CONST NS_DATEDIALOG%     = 5
  1188. CONST NS_PICDIALOG%       = 6
  1189. CONST NS_FONTDIALOG%      = 7
  1190.  
  1191. ' Loop, displaying dialogs in the required order.
  1192. CurStep% = NS_INTRODIALOG%
  1193. WHILE (CurStep% <> NS_FINISH%)
  1194.  
  1195.     SELECT CASE CurStep%
  1196.         CASE NS_INTRODIALOG%
  1197.             IF (LastPageX& <> -1) THEN
  1198.                 IntroDialog.Move LastPageX&, LastPageY&
  1199.             ENDIF        
  1200.             IntroDialog.IntroImage.SetImage CurDir$ + BITMAP_INTRODIALOG$
  1201.             IntroDialog.IntroImage.SetStyle STYLE_SUNKEN
  1202.             IntroDialog.IntroImage.SetStyle STYLE_IMAGE_CENTERED
  1203.             IntroDialog.SetStyle STYLE_NOMINIMIZEBOX
  1204.             GenReturn& = DIALOG(IntroDialog)
  1205.             SELECT CASE GenReturn&
  1206.                 CASE DIALOG_RETURN_NEXT%
  1207.                     CurStep% = NS_SIZEDIALOG%
  1208.                 CASE DIALOG_RETURN_CANCEL%
  1209.                     STOP        
  1210.                 CASE ELSE
  1211.                     CurStep% = NS_INTRODIALOG%
  1212.             END SELECT
  1213.  
  1214.         CASE NS_SIZEDIALOG%
  1215.             SizeDialog.Move LastPageX&, LastPageY&
  1216.             SizeDialog.SizeImage.SetImage CurDir$ + BITMAP_INTRODIALOG$
  1217.             SizeDialog.SizeImage.SetStyle STYLE_SUNKEN
  1218.             SizeDialog.SizeImage.SetStyle STYLE_IMAGE_CENTERED
  1219.             SizeDialog.SetStyle STYLE_NOMINIMIZEBOX
  1220.             GenReturn& = DIALOG(SizeDialog)
  1221.             SELECT CASE GenReturn&
  1222.                 CASE DIALOG_RETURN_NEXT%
  1223.                     CurStep% = NS_ORIENTDIALOG%
  1224.                 CASE DIALOG_RETURN_BACK%
  1225.                     CurStep% = NS_INTRODIALOG%
  1226.                 CASE DIALOG_RETURN_CANCEL%
  1227.                     STOP                            
  1228.                 CASE ELSE
  1229.                     CurStep% = NS_SIZEDIALOG%
  1230.             END SELECT
  1231.  
  1232.         CASE NS_ORIENTDIALOG%
  1233.             OrientDialog.Move LastPageX&, LastPageY&
  1234.             OrientDialog.OrientImage.SetImage CurDir$ + BITMAP_INTRODIALOG$
  1235.             OrientDialog.OrientImage.SetStyle STYLE_SUNKEN
  1236.             OrientDialog.OrientImage.SetStyle STYLE_IMAGE_CENTERED
  1237.             OrientDialog.SetStyle STYLE_NOMINIMIZEBOX
  1238.             GenReturn& = DIALOG(OrientDialog)
  1239.             SELECT CASE GenReturn&
  1240.                 CASE DIALOG_RETURN_NEXT%
  1241.                     CurStep% = NS_STYLEDIALOG%
  1242.                 CASE DIALOG_RETURN_BACK%
  1243.                     CurStep% = NS_SIZEDIALOG%
  1244.                 CASE DIALOG_RETURN_CANCEL%
  1245.                     STOP                            
  1246.                 CASE ELSE
  1247.                     CurStep% = NS_ORIENTDIALOG%
  1248.             END SELECT
  1249.             
  1250.         CASE NS_STYLEDIALOG%
  1251.             StyleDialog.Move LastPageX&, LastPageY&
  1252.             StyleDialog.StyleImage.SetImage CurDir$ + BITMAP_INTRODIALOG
  1253.             StyleDialog.StyleImage.SetStyle STYLE_SUNKEN
  1254.             StyleDialog.StyleImage.SetStyle STYLE_IMAGE_CENTERED
  1255.             StyleDialog.PreviewImage.SetStyle STYLE_SUNKEN
  1256.             StyleDialog.PreviewImage.SetStyle STYLE_IMAGE_CENTERED
  1257.             StyleDialog.SetStyle STYLE_NOMINIMIZEBOX
  1258.             GenReturn& = DIALOG(StyleDialog)
  1259.             SELECT CASE GenReturn&
  1260.                 CASE DIALOG_RETURN_NEXT%
  1261.                     CurStep% = NS_FONTDIALOG%
  1262.                 CASE DIALOG_RETURN_BACK%
  1263.                     CurStep% = NS_ORIENTDIALOG%
  1264.                 CASE DIALOG_RETURN_CANCEL%
  1265.                     STOP                            
  1266.                 CASE ELSE
  1267.                     CurStep% = NS_STYLEDIALOG%
  1268.             END SELECT
  1269.  
  1270.         CASE NS_FONTDIALOG%
  1271.             FontDialog.Move LastPageX&, LastPageY&
  1272.             FontDialog.FontImage.SetImage CurDir$ + BITMAP_INTRODIALOG
  1273.             FontDialog.FontImage.SetStyle STYLE_SUNKEN
  1274.             FontDialog.FontImage.SetStyle STYLE_IMAGE_CENTERED
  1275.             FontDialog.SetStyle STYLE_NOMINIMIZEBOX
  1276.             GenReturn& = DIALOG(FontDialog)
  1277.             SELECT CASE GenReturn&
  1278.                 CASE DIALOG_RETURN_NEXT%
  1279.                     CurStep% = NS_PICDIALOG%
  1280.                 CASE DIALOG_RETURN_BACK%
  1281.                     CurStep% = NS_STYLEDIALOG%
  1282.                 CASE DIALOG_RETURN_CANCEL%
  1283.                     STOP                            
  1284.                 CASE ELSE
  1285.                     CurStep% = NS_FONTDIALOG%
  1286.             END SELECT
  1287.  
  1288.         CASE NS_DATEDIALOG%
  1289.             DateDialog.Move LastPageX&, LastPageY&
  1290.             DateDialog.DateImage.SetImage CurDir$ + BITMAP_INTRODIALOG$
  1291.             DateDialog.DateImage.SetStyle STYLE_SUNKEN
  1292.             DateDialog.DateImage.SetStyle STYLE_IMAGE_CENTERED
  1293.             DateDialog.SetStyle STYLE_NOMINIMIZEBOX
  1294.             GenReturn& = DIALOG(DateDialog)
  1295.             SELECT CASE GenReturn&
  1296.                 CASE DIALOG_RETURN_NEXT%
  1297.                     CurStep% = NS_FINISH%
  1298.                 CASE DIALOG_RETURN_BACK%
  1299.                     CurStep% = NS_PICDIALOG%
  1300.                 CASE DIALOG_RETURN_CANCEL%
  1301.                     STOP                            
  1302.                 CASE ELSE
  1303.                     CurStep% = NS_DATEDIALOG%
  1304.             END SELECT
  1305.  
  1306.         CASE NS_PICDIALOG%
  1307.             PicDialog.Move LastPageX&, LastPageY&
  1308.             PicDialog.PicImage.SetImage CurDir$ + BITMAP_INTRODIALOG
  1309.             PicDialog.PicImage.SetStyle STYLE_SUNKEN
  1310.             PicDialog.PicImage.SetStyle STYLE_IMAGE_CENTERED
  1311.             PicDialog.SetStyle STYLE_NOMINIMIZEBOX
  1312.             GenReturn& = DIALOG(PicDialog)
  1313.             SELECT CASE GenReturn&
  1314.                 CASE DIALOG_RETURN_NEXT%
  1315.                     CurStep% = NS_DATEDIALOG%
  1316.                 CASE DIALOG_RETURN_BACK%
  1317.                     CurStep% = NS_FONTDIALOG%
  1318.                 CASE DIALOG_RETURN_CANCEL%
  1319.                     STOP                            
  1320.                 CASE ELSE
  1321.                     CurStep% = NS_PICDIALOG%
  1322.             END SELECT
  1323.  
  1324.     END SELECT
  1325. WEND
  1326.  
  1327. ' Create the calendars, then end.
  1328. GenReturn& = DIALOG(ProcessingDialog)
  1329. STOP
  1330.  
  1331. MainErrorHandler:
  1332.     ERRNUM = 0
  1333.     MessageText$ = "Ha ocurrido un error general durante el"
  1334.     MessageText$ = MessageText$ + "procesamiento del asistente." + NL2
  1335.     MessageText$ = MessageText$ + "Puede intentarlo de nuevo."
  1336.     GenReturn& = MESSAGEBOX(MessageText$, TITLE_ERRORBOX$, \\
  1337.                             MB_OK_ONLY& OR MB_EXCLAMATION_ICON&)
  1338.  
  1339.     ' Just to be safe, though DRAW is supposed to do it anyway if
  1340.     ' a script terminates, re-enable painting.
  1341.     ON ERROR RESUME NEXT
  1342.     .ResumePainting
  1343.     ERRNUM = 0
  1344.     STOP
  1345.  
  1346. '********************************************************************
  1347. '
  1348. '    Name:    CreateText (subroutine)
  1349. '
  1350. '    Action:    Creates a string of artistic text within CorelDRAW.
  1351. '              Does not size it.
  1352. '
  1353. '    Params:    InMonth - The month of the calendar.
  1354. '              InYear  - The year of the calendar.
  1355. '              InFontName - The font to use.
  1356. '            InFontSize - The size of font (points).
  1357. '              InBold - Make the font bold?
  1358. '              InItalic - Make the font italic?
  1359. '              InStrikeout - Use strikeout?
  1360. '              InRed, InGreen, InBlue - Colour values.
  1361. '
  1362. '    Returns:    None.
  1363. '
  1364. '    Comments:    None.
  1365. '
  1366. '********************************************************************
  1367. SUB CreateText ( InText AS STRING, \\
  1368.                InFontName AS STRING, \\
  1369.               InFontSize AS LONG, \\
  1370.                InBold AS BOOLEAN, \\
  1371.                InItalic AS BOOLEAN, \\
  1372.                InStrikeout AS BOOLEAN, \\
  1373.               InUnderline AS BOOLEAN, \\
  1374.               InRed AS INTEGER, \\
  1375.               InGreen AS INTEGER, \\
  1376.               InBlue AS INTEGER)
  1377.  
  1378.     DIM DrawStyleCode AS INTEGER ' The font style to send to DRAW.
  1379.     DIM DrawPointSize AS INTEGER ' The font size to send to DRAW.
  1380.     DIM DrawUnderline AS INTEGER ' The underline code to send to DRAW.
  1381.     DIM DrawStrikeout AS INTEGER ' The strikeout code to send to DRAW.
  1382.  
  1383.     ' Create the title's text.
  1384.     .CreateArtisticText InText$, 0, 0
  1385.  
  1386.     ' Determine the settings to send to DRAW.
  1387.     IF InBold AND InItalic THEN
  1388.         DrawStyleCode% = DRAW_FONT_STYLE_BOLD_ITALIC%
  1389.     ELSEIF Bold THEN
  1390.         DrawStyleCode% = DRAW_FONT_STYLE_BOLD%
  1391.     ELSEIF Italic THEN
  1392.         DrawStyleCode% = DRAW_FONT_STYLE_NORMAL_ITALIC%
  1393.     ELSE
  1394.         DrawStyleCode% = DRAW_FONT_STYLE_NORMAL%
  1395.     ENDIF 
  1396.     DrawPointSize% = InFontSize * 10 
  1397.     IF InUnderline THEN
  1398.         DrawUnderline% = DRAW_FONT_UNDERLINE_SINGLE_THICK%
  1399.     ELSE
  1400.         DrawUnderline% = DRAW_FONT_UNDERLINE_NONE%
  1401.     ENDIF
  1402.     IF InStrikeout THEN
  1403.         DrawStrikeout% = DRAW_FONT_STRIKEOUT_SINGLE_THICK%
  1404.     ELSE
  1405.         DrawStrikeout% = DRAW_FONT_STRIKEOUT_NONE%
  1406.     ENDIF
  1407.  
  1408.     ' Apply the formatting.
  1409.     .SetCharacterAttributes 0, \\
  1410.                         30000, \\
  1411.                         InFontName$, \\
  1412.                         DrawStyleCode%, \\
  1413.                         DrawPointSize%, \\
  1414.                         DrawUnderline%, \\
  1415.                         DRAW_FONT_OVERLINE_NONE%, \\
  1416.                         DrawStrikeout%, \\
  1417.                         DRAW_FONT_PLACEMENT_NORMAL%, \\
  1418.                         0,    \\ 
  1419.                         1000, \\ 
  1420.                         1000, \\
  1421.                         DRAW_FONT_ALIGNMENT_NONE%            
  1422.     .StoreColor DRAW_COLORMODEL_RGB&, InRed%, InGreen%, InBlue%, 0
  1423.     .ApplyUniformFillColor
  1424.  
  1425. END SUB
  1426.  
  1427. '********************************************************************
  1428. '
  1429. '    Name:    FileExists (function)
  1430. '
  1431. '    Action:    Determines if a given file exists.
  1432. '              If it does not exist, displays an error message.
  1433. '
  1434. '    Params:    InFileName - The file name and path to test.
  1435. '
  1436. '    Returns:    TRUE if the file exists.  FALSE otherwise, along
  1437. '              with displaying an error message.
  1438. '
  1439. '    Comments:    None.
  1440. '
  1441. '********************************************************************
  1442. FUNCTION FileExists( InFileName AS STRING ) AS BOOLEAN
  1443.  
  1444.     DIM ReturnedSize AS LONG  ' The size of InFileName.
  1445.     DIM MsgResult AS LONG     ' The result of the MESSAGEBOX call.
  1446.     
  1447.     ' Grab the size of InFileName.
  1448.     ReturnedSize& = FILESIZE( InFileName$ )
  1449.     
  1450.     ' If InFileName is empty, complain.
  1451.     IF LEN(InFileName$) = 0 THEN
  1452.         MsgResult = MESSAGEBOX("Por cada cuadro que desee comprobar, "+\\
  1453.                                "debe especificar el nombre del archivo."+\\
  1454.                                "No puede salir del espacio en blanco."+NL2+\\
  1455.                                "Vuelva a intentarlo.", \\
  1456.                                 TITLE_ERRORBOX, \\
  1457.                               MB_OK_ONLY)
  1458.         FileExists = FALSE
  1459.         EXIT FUNCTION
  1460.     ENDIF
  1461.     
  1462.     ' If it doesn't exist, complain.
  1463.     IF (ReturnedSize& > 0) THEN
  1464.         FileExists = TRUE
  1465.     ELSE
  1466.         MsgResult = MESSAGEBOX("No se ha encontrado el archivo'" + \\
  1467.                                InFileName$ + "'." + NL2 + \\
  1468.                                "Inserte el nombre de otro archivo y" + \\
  1469.                                "acceso.", \\
  1470.                                 TITLE_ERRORBOX, \\
  1471.                               MB_OK_ONLY)
  1472.         FileExists = FALSE
  1473.     ENDIF
  1474.  
  1475. END FUNCTION
  1476.  
  1477. '********************************************************************
  1478. '
  1479. '    Name:    GetWeekday (function)
  1480. '
  1481. '    Action:    Returns a number which indicates which day of the
  1482. '              week a date refers to.  (Day 1 is Sunday.)
  1483. '
  1484. '    Params:    Wkd - The date to investigate.
  1485. '
  1486. '    Returns:    A number which indicates which day of the week the
  1487. '              date falls on.
  1488. '
  1489. '    Comments:    None.
  1490. '
  1491. '********************************************************************
  1492. FUNCTION GetWeekday( Wkd AS DATE ) AS INTEGER
  1493.  
  1494.     CONST Offset% = 6       ' An offset to use in the calculations.
  1495.     DIM WeekTemp AS LONG ' A temporary variable in the calculations.
  1496.     
  1497.     ' These calculations are based on the fact that all dates in
  1498.     ' CorelSCRIPT are actually represented by the number of days
  1499.     ' since December 31, 1899.
  1500.     WeekTemp& = INT(Wkd) + Offset%
  1501.     GetWeekday = (WeekTemp& MOD 7) + 1
  1502.  
  1503. END FUNCTION
  1504.  
  1505. '********************************************************************
  1506. '
  1507. '    Name:    GetNumRows (function)
  1508. '
  1509. '    Action:    Returns the number of rows needed in a calendar whose
  1510. '              first column is Sunday for a given month and year.
  1511. '
  1512. '    Params:    InMonthNum - The month number (January is 1).
  1513. '              InYearNum  - The year.
  1514. '
  1515. '    Returns:    Either 4, 5, or 6 depending on how many rows are needed
  1516. '              (4 is very rare -- happens in Feb. 1998, for example).
  1517. '
  1518. '    Comments:    Months$(12) must be global.
  1519. '
  1520. '********************************************************************
  1521. FUNCTION GetNumRows( InMonthNum AS INTEGER, InYear AS INTEGER ) AS INTEGER
  1522.  
  1523.     DIM RowCount AS INTEGER    ' The number of rows used up so far.
  1524.     DIM CurDay AS INTEGER    ' The current day being processed.
  1525.     DIM CurDate AS DATE        ' The current date being processed.
  1526.     
  1527.     ' Loop through all the days in this month.
  1528.     RowCount% = 1
  1529.     CurDay% = 1
  1530.     WHILE CurDay% < GetNumDays(InMonthNum%, InYear%)
  1531.         CurDate = STR(CurDay%) + " " + Months$(InMonthNum%) + \\
  1532.                   " " + STR(InYear%)
  1533.         IF (GetWeekday(CurDate) = 7) THEN
  1534.             RowCount% = RowCount% + 1
  1535.         ENDIF
  1536.         CurDay% = CurDay% + 1
  1537.     WEND
  1538.     
  1539.     ' Return the result.
  1540.     GetNumRows% = RowCount%
  1541.  
  1542. END FUNCTION
  1543.  
  1544. '********************************************************************
  1545. '
  1546. '    Name:    GetNumDays (function)
  1547. '
  1548. '    Action:    Returns the number of days in a given month for a
  1549. '              given year.
  1550. '
  1551. '    Params:    InMonthNum - The month number (January is 1).
  1552. '              InYearNum  - The year.
  1553. '
  1554. '    Returns:    A number from 28 to 31.
  1555. '
  1556. '    Comments:    Leap years are properly taken into account.
  1557. '
  1558. '********************************************************************
  1559. FUNCTION GetNumDays( InMonthNum AS INTEGER, InYear AS INTEGER ) AS INTEGER
  1560.  
  1561.     ' The days in each month.
  1562.     DIM DaysInMonths%(12)
  1563.     DaysInMonths%(1) = 31        
  1564.     DaysInMonths%(2) = 28 ' Leap years are taken into account later.            
  1565.     DaysInMonths%(3) = 31
  1566.     DaysInMonths%(4) = 30
  1567.     DaysInMonths%(5) = 31
  1568.     DaysInMonths%(6) = 30
  1569.     DaysInMonths%(7) = 31
  1570.     DaysInMonths%(8) = 31
  1571.     DaysInMonths%(9) = 30
  1572.     DaysInMonths%(10) = 31
  1573.     DaysInMonths%(11) = 30
  1574.     DaysInMonths%(12) = 31    
  1575.  
  1576.     ' Adjust for leap years.
  1577.     IF (InYear MOD 4 = 0 AND InYear MOD 100 <> 0) OR InYear MOD 400 = 0 THEN
  1578.         DaysInMonths%(2) = 29
  1579.     END IF
  1580.  
  1581.     ' Return the proper number.
  1582.     GetNumDays% = DaysInMonths%(InMonthNum%)
  1583.  
  1584. END FUNCTION
  1585.  
  1586. '********************************************************************
  1587. '
  1588. '    Name:    Min (function)
  1589. '
  1590. '    Action:    Returns the lowest of two numbers.
  1591. '
  1592. '    Params:    Val1 - The first number.
  1593. '            Val2 - The second number.
  1594. '
  1595. '    Returns:    Whichever is smallest, Val1 or Val2.
  1596. '
  1597. '    Comments:    None.
  1598. '
  1599. '********************************************************************
  1600. FUNCTION Min( Val1 AS LONG, Val2 AS LONG ) AS LONG
  1601.  
  1602.     IF Val1& < Val2& THEN
  1603.         Min& = Val1&
  1604.     ELSE
  1605.         Min& = Val2&
  1606.     ENDIF
  1607.  
  1608. END FUNCTION
  1609.  
  1610. '********************************************************************
  1611. '
  1612. '    Name:    DoGraphics (subroutine)
  1613. '
  1614. '    Action:    Draws a picture and/or a border if necessary on
  1615. '              the current page in CorelDRAW.  Adjusts the calendar
  1616. '              rectangle variables to account for the picture and/or
  1617. '              border.
  1618. '
  1619. '    Params:    UsePicture - Use a picture?
  1620. '              UseBorder  - Use a border?
  1621. '              PictureFile$ - The name of the picture file to use.
  1622. '              BorderFile$  - The name of the border file to use.
  1623. '              TopLeftX& - The top left-hand corner of the calendar
  1624. '                          rectangle;  X-coordinate.
  1625. '              TopLeftY& - The top left-hand corner of the calendar
  1626. '                          rectangle;  Y-coordinate.
  1627. '              BottomRightX& - The bottom right-hand corner of the
  1628. '                              calendar rectangle;  X-coordinate.
  1629. '              BottomRightY& - The bottom right-hand corner of the
  1630. '                              calendar rectangle;  Y-coordinate.  
  1631. '
  1632. '    Returns:    None.
  1633. '
  1634. '    Comments:    The 'calendar rectangle' reflects the space where
  1635. '              the actual 'calendar' part of the calendar will be
  1636. '              drawn (minus graphics and border).
  1637. '              May stop the wizard (with an appropriate error
  1638. '              message) if the border or picture is in a format
  1639. '              DRAW cannot recognize.
  1640. '
  1641. '********************************************************************
  1642. SUB DoGraphics( InUsePicture AS BOOLEAN,       \\
  1643.                 InUseBorder AS BOOLEAN,        \\
  1644.                 InPictureFile AS STRING,       \\
  1645.              InBorderFile AS STRING,        \\
  1646.              BYREF InTopLeftX AS LONG,      \\
  1647.              BYREF InTopLeftY AS LONG,      \\
  1648.              BYREF InBottomRightX AS LONG,  \\
  1649.              BYREF InBottomRightY AS LONG )
  1650.  
  1651.     DIM CurFile AS STRING    ' The current file we're trying to import.
  1652.     DIM BorderOffsetX AS LONG ' How much space to leave on the sides.
  1653.     DIM BorderOffsetY AS LONG' How much space to leave on the top and bottom.
  1654.     DIM PicXSize AS LONG    ' The X size of the imported picture.
  1655.     DIM PicYSize AS LONG    ' The Y size of the imported picture.
  1656.     DIM AvailableX AS LONG    ' How much X space we have for the picture.
  1657.     DIM AvailableY AS LONG    ' How much Y space we have for the picture.
  1658.     DIM NeededX AS LONG        ' How big should the picture be?
  1659.     DIM NeededY AS LONG        ' How big should the picture be?
  1660.     DIM TempTopLeftY AS LONG ' A temporary variable storing InTopLeftY.
  1661.  
  1662.     ' Borders should be factored in first.
  1663.     IF InUseBorder THEN
  1664.         
  1665.         ' Set up an error handler to capture file import errors.
  1666.         ON ERROR GOTO DG_Error_Import
  1667.         
  1668.         ' Import the border.
  1669.         CurFile$ = InBorderFile$
  1670.         .FileImport CurFile$
  1671.  
  1672.         ' Successfully finished the import.
  1673.         ON ERROR EXIT
  1674.         
  1675.         ' For borders, we will resize to fit the page.  Aspect
  1676.         ' ratio is not taken into account here, because most
  1677.         ' borders look good even when distorted.
  1678.         .SetSize InBottomRightX& - InTopLeftX&, \\
  1679.                  InTopLeftY& - InBottomRightY&
  1680.         .SetPosition InTopLeftX&, InTopLeftY&
  1681.  
  1682.         ' We have no way of knowing how wide the border is.
  1683.         ' Conveniently, however, the borders in BORDERS\FRAMES
  1684.         ' need about 1.4 inches on the sides and 1.5 on the top
  1685.         ' and bottom.
  1686.         BorderOffsetX& = LENGTHCONVERT( LC_INCHES&, \\
  1687.                                        LC_TENTHS_OFA_MICRON&, \\
  1688.                                        1.4 )
  1689.         BorderOffsetY& = LENGTHCONVERT( LC_INCHES&, \\
  1690.                                        LC_TENTHS_OFA_MICRON&, \\
  1691.                                        1.5 )
  1692.         InTopLeftX& = InTopLeftX& + BorderOffsetX&
  1693.         InTopLeftY& = InTopLeftY& - BorderOffsetY&
  1694.         InBottomRightX& = InBottomRightX& - BorderOffsetX&
  1695.         InBottomRightY& = InBottomRightY& + BorderOffsetY&
  1696.  
  1697.     ENDIF
  1698.     
  1699.     ' Next, we process graphics.  These should go inside the
  1700.     ' border (if there is one) and take up the top half of
  1701.     ' the calendar rectangle.
  1702.     IF InUsePicture THEN
  1703.         
  1704.         ' Set up an error handler to capture file import errors.
  1705.         ON ERROR GOTO DG_Error_Import
  1706.         
  1707.         ' Import the picture.
  1708.         CurFile$ = InPictureFile$
  1709.         .FileImport CurFile$
  1710.  
  1711.         ' Successfully finished the import.
  1712.         ON ERROR EXIT
  1713.         
  1714.         ' Calculate how much space we have for the picture.
  1715.         AvailableX& = InBottomRightX& - InTopLeftX&
  1716.         AvailableY& = (InTopLeftY& - InBottomRightY&) / 2
  1717.         
  1718.         ' Pictures require an aspect ratio based resize so
  1719.         ' that their proportions do not become distorted.
  1720.         .GetSize PicXSize&, PicYSize&
  1721.         TempTopLeftY& = InTopLeftY&
  1722.         IF (PicXSize& > PicYSize&) THEN
  1723.             NeededX& = AvailableX& 
  1724.             NeededY& = NeededX& * (PicYSize& / PicXSize&)
  1725.  
  1726.             ' Make special provisions so that the calendar does
  1727.             ' not get too small.
  1728.             IF (NeededY& > AvailableY&) THEN
  1729.                 NeededY& = AvailableY& 
  1730.                 NeededX& = NeededY& * (PicXSize& / PicYSize&)
  1731.             ENDIF
  1732.  
  1733.             ' Recalculate the calendar space.
  1734.             InTopLeftY& = InTopLeftY& - \\
  1735.                              Min(CLNG((AvailableX& * (PicYSize& / PicXSize&))), \\
  1736.                                  AvailableY&)
  1737.         ELSE
  1738.             NeededY& = AvailableY&
  1739.             NeededX& = NeededY& * (PicXSize& / PicYSize&)
  1740.  
  1741.             ' Recalculate the calendar space.
  1742.             InTopLeftY& = InTopLeftY& - AvailableY&
  1743.         ENDIF
  1744.         .SetSize NeededX&, NeededY&
  1745.         
  1746.         ' Center the picture horizontally in the picture area.
  1747.         .SetReferencePoint DRAW_REF_TOP_MIDDLE&
  1748.         .SetPosition InTopLeftX& + (AvailableX& / 2), \\
  1749.                    TempTopLeftY&
  1750.         .SetReferencePoint DRAW_REF_TOP_LEFT&
  1751.  
  1752.         ' Add in some extra margin space above the month name.
  1753.         InTopLeftY& = InTopLeftY& - LENGTHCONVERT( LC_INCHES&, \\
  1754.                                                      LC_TENTHS_OFA_MICRON&, \\
  1755.                                                      0.25 )
  1756.  
  1757.     ENDIF
  1758.     
  1759.     EXIT SUB
  1760.     
  1761. DG_Error_Import:
  1762.     ERRNUM = 0
  1763.     DIM MsgReturn AS LONG    ' The return value of MESSAGEBOX.
  1764.     MsgReturn& = MESSAGEBOX( "No se ha podido importar el archivo'" + \\
  1765.                         CurFile$ + "'." + NL2 +     \\
  1766.                         "Verifique que CorelDRAW puede" + \\
  1767.                         "importar este tipo de archivo de grßficos" + \\
  1768.                         "y vuelva a ejecutar este asistente.", \\
  1769.                         TITLE_ERRORBOX$, \\
  1770.                         MB_STOP_ICON& )
  1771.     STOP
  1772.     
  1773. END SUB
  1774.  
  1775. '********************************************************************
  1776. '
  1777. '    Name:    AddMargins (subroutine)
  1778. '
  1779. '    Action:    Reduces the size of the calendar rectangle on
  1780. '              all sides equivalent to a margin size that will
  1781. '              work with most printers (0.5 in.)
  1782. '
  1783. '    Params:    TopLeftX& - The top left-hand corner of the calendar
  1784. '                          rectangle;  X-coordinate.
  1785. '              TopLeftY& - The top left-hand corner of the calendar
  1786. '                          rectangle;  Y-coordinate.
  1787. '              BottomRightX& - The bottom right-hand corner of the
  1788. '                              calendar rectangle;  X-coordinate.
  1789. '              BottomRightY& - The bottom right-hand corner of the
  1790. '                              calendar rectangle;  Y-coordinate.  
  1791. '
  1792. '    Returns:    None.
  1793. '
  1794. '    Comments:    The 'calendar rectangle' reflects the space where
  1795. '              the actual 'calendar' part of the calendar will be
  1796. '              drawn (minus graphics and border).
  1797. '
  1798. '********************************************************************
  1799. SUB AddMargins( BYREF InTopLeftX AS LONG, \\
  1800.                 BYREF InTopLeftY AS LONG, \\
  1801.                 BYREF InBottomRightX AS LONG, \\
  1802.                 BYREF InBottomRightY AS LONG )
  1803.  
  1804.     CONST ReductionInches! = 0.5  ' The reduction in inches.
  1805.     DIM ReductionAmount AS LONG    ' How much to reduce each side by.
  1806.  
  1807.     ' Calculate the reduction in tenths of a micron.    
  1808.     ReductionAmount& = LENGTHCONVERT( LC_INCHES&, \\
  1809.                                        LC_TENTHS_OFA_MICRON&, \\
  1810.                                        ReductionInches! )
  1811.  
  1812.     ' Make the adjustments.
  1813.     InTopLeftX& = InTopLeftX& + ReductionAmount&
  1814.     InTopLeftY& = InTopLeftY& - ReductionAmount&
  1815.     InBottomRightX& = InBottomRightX& - ReductionAmount&
  1816.     InBottomRightY& = InBottomRightY& + ReductionAmount&
  1817.  
  1818. END SUB
  1819.  
  1820. '********************************************************************
  1821. '
  1822. '    Name:    CalcHowMany (function)
  1823. '
  1824. '    Action:    Calculates the number of ticks there should be
  1825. '              on the processing progress bar.
  1826. '
  1827. '    Params:    HowMany - The number of months we're generating.
  1828. '              Month - The first month we're generating.
  1829. '              Year - The first year we're generating. 
  1830. '
  1831. '    Returns:    A LONG number of ticks.
  1832. '
  1833. '    Comments:    This calculation assumes one tick per day, plus 10
  1834. '              extra ticks for each month.
  1835. '
  1836. '********************************************************************
  1837. FUNCTION CalcHowMany( InHowMany AS INTEGER, \\
  1838.                       InMonth AS INTEGER, \\
  1839.                       InYear AS INTEGER ) AS LONG
  1840.  
  1841.     CONST Offset& = 10        ' A number to add for each month.
  1842.  
  1843.     DIM Counter AS INTEGER    ' A counter for the loop.
  1844.     DIM Accum AS LONG        ' An accumulator variable.
  1845.     DIM CurYear AS INTEGER    ' The current year.
  1846.     DIM CurMonth AS INTEGER    ' The current month.
  1847.  
  1848.     Accum& = 0
  1849.     CurMonth% = InMonth%
  1850.     CurYear% = InYear%
  1851.     FOR Counter% = 1 TO InHowMany%
  1852.         ' Update the accumulator based on the number of days in
  1853.         ' the current month.
  1854.         Accum& = Accum& + GetNumDays( CurMonth%, CurYear% ) + Offset&
  1855.  
  1856.         ' Increment the month.
  1857.         IF CurMonth% = 12 THEN
  1858.             CurMonth% = 1
  1859.             CurYear% = CurYear% + 1
  1860.         ELSE
  1861.             CurMonth% = CurMonth% + 1
  1862.         ENDIF
  1863.     NEXT Counter%
  1864.  
  1865.     ' Return the accumulated value.
  1866.     CalcHowMany& = Accum&
  1867.  
  1868. END FUNCTION
  1869.  
  1870. '********************************************************************
  1871. '
  1872. '    Name:    GetNumberOfDisplayColors (function)
  1873. '
  1874. '    Action:    Returns the number of colors the user's screen
  1875. '              currently supports.
  1876. '
  1877. '    Params:    None.  
  1878. '
  1879. '    Returns:    None.
  1880. '
  1881. '    Comments:    To avoid overflows, this routine never returns
  1882. '              a number of colors greater than 16777216.  If there
  1883. '              are more colors, it returns this maximum.
  1884. '
  1885. '********************************************************************
  1886. FUNCTION GetNumberOfDisplayColors( ) AS LONG
  1887.  
  1888.     ' Constants to send to GetDeviceCaps.
  1889.     CONST BITSPIXEL& = 12    ' Gets the number of color bits per pixel.
  1890.     CONST PLANES& = 14        ' Gets the number of color planes.
  1891.     
  1892.     DIM hDC AS LONG        ' A display DC to query.
  1893.     DIM NumColors AS SINGLE    ' The retrieved number of colors.    
  1894.     DIM NumPlanes AS LONG    ' The retrieved number of planes.
  1895.     DIM NumBitsPixel AS LONG ' The retrieved number of bits per pixel.
  1896.     DIM RetVal AS LONG        
  1897.     
  1898.     ' Create a DC, then query it for the number of colors.
  1899.     hDC& = CreateDC("DISPLAY", 0, 0, 0)
  1900.     NumPlanes& = GetDeviceCaps(hDC, Planes&)
  1901.     NumBitsPixel& = GetDeviceCaps(hDC, BitsPixel&)
  1902.     NumColors! = CSNG(2) ^ CSNG(CSNG(NumPlanes&) * CSNG(NumBitsPixel&))
  1903.     RetVal& = DeleteDC(hDC)
  1904.     
  1905.     ' To avoid overflows with really high color displays, the
  1906.     ' maximum will be 24 bit color.
  1907.     IF NumColors! > 16777216 THEN
  1908.         GetNumberOfDisplayColors = 16777216
  1909.     ELSE
  1910.         GetNumberOfDisplayColors = NumColors!
  1911.     ENDIF
  1912.     
  1913. END FUNCTION
  1914.  
  1915. END WITHOBJECT
  1916.  
  1917.