• Martes 17 de Septiembre de 2019, 12:22

Autor Tema:  Ayuda Con Calendario  (Leído 869 veces)

moyo18

  • Nuevo Miembro
  • *
  • Mensajes: 9
    • Ver Perfil
Ayuda Con Calendario
« en: Martes 21 de Noviembre de 2006, 22:20 »
0
bueno tengo q hacer un calendario, hasta el momento ya tengo el primer dia del a;o q es el q necesito ya el a;o bisiesto.
el problema esta asi en el a;o 1752 septiembre solo tiene 19 dias
empieza 1,2,14,15 en adelante entonces no se como imprimir en pntalla los dias d el a;o, bueno rodos los dias d todos los a;o, nose como podria ahcerlo.
el programaa tiene q salir q pida  el a;o q quiere saber y q muestre los meses d ese a;o, tiene q salir d 4 meses en 4

enero        julio
febrero     agosto
marzo      sept
abril         oct
mayo       nom
junio        dic

en ese orden pero q se muetren 4 y al bajar salgan los otros 4 y asi.

ya tengo todo hecho solo ese es mi problema como mostrar los dias en pantalla empezando desd el 1 d enero haste el 31 d dic.

ya tengo q dia caeria el prmer dia del a;o solo esta q meta los dias en el calendario pero no se como.

aki les dejo el codigo q llevo, tengo problemas con el array para imprimir en pantalla, casi no puedo usarlos.


Código: Text
  1. PROGRAM calendar;
  2.  
  3. { MoYo }
  4.  
  5. USES CRT;
  6.  
  7. CONST
  8.  
  9. MaxRows = 108;
  10. BlankCell = '    ';
  11.  
  12. TYPE
  13.  
  14. RowRange = 1..MaxRows;
  15.  
  16. WeekDaysType = (sunday, monday, tuesday, wednesday, thursday,
  17.                  friday, saturday );
  18. MonthsYearType = (january, february, march, april, may, june,
  19.                    july, august, september, october, november, december);
  20.  
  21. CellType = string[4];
  22. YearRange = 1400..2600;
  23.  
  24. CalendarArrayType = array [1..MaxRows,WeekDaysType] of CellType;
  25.  
  26.  
  27. VAR
  28.  
  29. YearChosen : YearRange;
  30.  
  31. CalendarArray : CalendarArrayType;
  32.  
  33. CurrentDay : weekdaystype;
  34.  
  35. Rows,
  36. Columns : BYTE;
  37.  
  38. Z, A, B, C, M : INTEGER;
  39.  
  40. {******************************************************}
  41.  
  42. PROCEDURE Initialize (VAR CalendarArray : CalendarArrayType;
  43.                            MaxRows       : RowRange;
  44.                            BlankCell     : CellType);
  45.  
  46.   VAR
  47.  
  48.     Rows       : RowRange;
  49.     Columns    : WeekDaysType;
  50.  
  51.     CurrentRow       : RowRange;
  52.     CurrentColumn    : WeekDaysType;
  53.  
  54.     CurrentMonth : MonthsYearType;
  55.  
  56.   BEGIN  { Initialize }
  57.  
  58.   CLRSCR;
  59.  
  60.   FOR Rows := 1 to MaxRows do
  61.      BEGIN
  62.  
  63.         FOR Columns := sunday to saturday do
  64.           BEGIN
  65.  
  66.              CalendarArray [ Rows, Columns ] := BlankCell;
  67.  
  68.           END;
  69.  
  70.  
  71.      END;
  72.  
  73.    { Name of the months }
  74.  
  75.    CurrentRow := 1;
  76.  
  77.    CalendarArray [ CurrentRow, Sunday ] := 'Janu';
  78.    CalendarArray [ CurrentRow, Monday ] := 'ary ';
  79.  
  80.    INC (CurrentRow, 9);
  81.  
  82.    CalendarArray [ CurrentRow, Sunday ] := 'Febr';
  83.    CalendarArray [ CurrentRow, Monday ] := 'uary';
  84.  
  85.    INC (CurrentRow, 9);
  86.  
  87.    CalendarArray [ CurrentRow, Sunday ] := 'Marc';
  88.    CalendarArray [ CurrentRow, Monday ] := 'h   ';
  89.  
  90.    INC (CurrentRow, 9);
  91.  
  92.    CalendarArray [ CurrentRow, Sunday ] := 'Apri';
  93.    CalendarArray [ CurrentRow, Monday ] := 'l   ';
  94.  
  95.    INC (CurrentRow, 9);
  96.  
  97.    CalendarArray [ CurrentRow, Sunday ] := 'May ';
  98.    CalendarArray [ CurrentRow, Monday ] := '    ';
  99.  
  100.    INC (CurrentRow, 9);
  101.  
  102.    CalendarArray [ CurrentRow, Sunday ] := 'June';
  103.    CalendarArray [ CurrentRow, Monday ] := '    ';
  104.  
  105.    INC (CurrentRow, 9);
  106.  
  107.    CalendarArray [ CurrentRow, Sunday ] := 'July';
  108.    CalendarArray [ CurrentRow, Monday ] := '    ';
  109.  
  110.    INC (CurrentRow, 9);
  111.  
  112.    CalendarArray [ CurrentRow, Sunday ] := 'Augu';
  113.    CalendarArray [ CurrentRow, Monday ] := 'st  ';
  114.  
  115.    INC (CurrentRow, 9);
  116.  
  117.    CalendarArray [ CurrentRow, Sunday  ] := 'Sept';
  118.    CalendarArray [ CurrentRow, Monday  ] := 'embe';
  119.    CalendarArray [ CurrentRow, Tuesday ] := 'r   ';
  120.  
  121.    INC (CurrentRow, 9);
  122.  
  123.    CalendarArray [ CurrentRow, Sunday ] := 'Octo';
  124.    CalendarArray [ CurrentRow, Monday ] := 'ber ';
  125.  
  126.    INC (CurrentRow, 9);
  127.  
  128.    CalendarArray [ CurrentRow, Sunday ] := 'Nove';
  129.    CalendarArray [ CurrentRow, Monday ] := 'mber';
  130.  
  131.    INC (CurrentRow, 9);
  132.  
  133.    CalendarArray [ CurrentRow, Sunday ] := 'Dece';
  134.    CalendarArray [ CurrentRow, Monday ] := 'mber';
  135.  
  136.  
  137.    { End of the name of the months }
  138.  
  139.    { Name of the days }
  140.  
  141.    CurrentRow := 2;
  142.  
  143.  
  144.    FOR CurrentMonth := January TO December Do
  145.      BEGIN
  146.         CalendarArray [ CurrentRow, Sunday    ] := 'Sun ';
  147.         CalendarArray [ CurrentRow, Monday    ] := 'Mon ';
  148.         CalendarArray [ CurrentRow, Tuesday   ] := 'Tue ';
  149.         CalendarArray [ CurrentRow, Wednesday ] := 'Wed ';
  150.         CalendarArray [ CurrentRow, Thursday  ] := 'Thu ';
  151.         CalendarArray [ CurrentRow, Friday    ] := 'Fri ';
  152.         CalendarArray [ CurrentRow, Saturday  ] := 'Sat ';
  153.  
  154.         INC (CurrentRow, 9);
  155.      END;
  156.  
  157. END;   { Initialize }
  158.  
  159.  
  160.    {  Test Code
  161.  
  162.    FOR Rows := 1 to maxrows DO
  163.  
  164.        BEGIN
  165.        FOR Columns := Sunday TO Saturday DO
  166.  
  167.            WRITE (CalendarArray [ Rows, Columns ]:4);
  168.        WRITELN;
  169.        END;
  170.  
  171.    READKEY;   }
  172.  
  173. {************************************************************}
  174.  
  175. {************************************************************}
  176.  
  177. PROCEDURE  GetTheYear (VAR YearChosen : YearRange );
  178.  
  179. BEGIN    { GetTheYear }
  180.  
  181.    REPEAT
  182.  
  183.    WRITE ('INTRODUCE THE YEAR (1400..2600):'); READLN(YearChosen);
  184.  
  185.    UNTIL (YearChosen >= 1400) AND (YearChosen <= 2600)
  186.  
  187.  
  188. END;     { GetTheYear }
  189.  
  190.   {***********************************************************}
  191.  
  192.   {***********************************************************}
  193.  
  194. Procedure FillCalendarArray ( VAR CalendarArray : CalendarArrayType;
  195.                                   YearChosen : YearRange;
  196.                                   MaxRows : RowRange);
  197.  
  198.  
  199.   { LEAP YEAR }
  200.  
  201.   FUNCTION IsLeapYear (YearChosen : YearRange) : BOOLEAN;
  202.  
  203.   BEGIN
  204.      IsLeapYear := ((YearChosen MOD 4) = 0) AND ((YearChosen MOD 100) <> 0) OR
  205.                      ((YearChosen MOD 400) = 0)
  206.   END;
  207.  
  208.   { END LEAP YEAR }
  209.  
  210.  
  211.  
  212.   PROCEDURE FirstDay (yearChosen : YearRange;
  213.                       VAR Z : Integer);
  214.  
  215.  
  216.  
  217.    BEGIN { Zeller's Congruence }
  218.  
  219.  
  220.     { IGNORE THIS PART, THIS PART IS TO KNOW THE OTHERS DAYS OF THE YEAR
  221.  
  222.        IF ( M<=2 ) THEN
  223.  
  224.          A:= 1+10;
  225.          B:= (YearChosen-1) MOD 100;
  226.          C:= (YearChosen-1) DIV 100;  }
  227.  
  228.        IF ( M>=3) THEN
  229.          BEGIN
  230.             A:= 1-2;
  231.             B:= YearChosen MOD 100;
  232.             C:= YearChosen DIV 100;
  233.          END;
  234.  
  235.     IF YearChosen = 1400 THEN
  236.  
  237.        Z := 5;
  238.  
  239.     {*****************************************************************}
  240.  
  241.      IF (YearChosen >= 1401) AND (YearChosen <= 1500) THEN
  242.  
  243.       BEGIN
  244.  
  245.          Z := (702 + ((26*A) -2) DIV 10 + 1 + B + (B DIV 4) + (C DIV 4) - (2 * C )) MOD 7;
  246.  
  247.           IF ((YearChosen MOD 4) = 0) AND ((YearChosen MOD 100) <> 0) OR ((YearChosen MOD 400) = 0) THEN
  248.  
  249.  
  250.             Z := Z-1
  251.  
  252.           ELSE
  253.  
  254.             Z:= Z-1;
  255.  
  256.  
  257.  
  258.  
  259.       END;
  260.  
  261.  
  262.  
  263.     {******************************************************************}
  264.  
  265.  
  266.     IF (YearChosen >= 1501) AND (YearChosen <= 1700) THEN
  267.  
  268.       BEGIN
  269.  
  270.          Z := (703 + ((26*A) -2) DIV 10 + 1 + B + (B DIV 4) + (C DIV 4) - (2 * C )) MOD 7;
  271.  
  272.           IF ((YearChosen MOD 4) = 0) AND ((YearChosen MOD 100) <> 0) OR ((YearChosen MOD 400) = 0) THEN
  273.  
  274.  
  275.             Z := Z-1
  276.  
  277.           ELSE
  278.  
  279.             Z := Z-1;
  280.  
  281.  
  282.  
  283.  
  284.       END;
  285.  
  286.  
  287.     {*********************************************************}
  288.  
  289.  
  290.       IF (YearChosen >= 1701) AND (YearChosen <= 1751) THEN
  291.  
  292.         BEGIN
  293.  
  294.            Z := (704 + ((26*A) -2) DIV 10 + 1 + B + (B DIV 4) + (C DIV 4) - (2 * C )) MOD 7;
  295.  
  296.             IF ((YearChosen MOD 4) = 0) AND ((YearChosen MOD 100) <> 0) OR ((YearChosen MOD 400) = 0) THEN
  297.  
  298.  
  299.               Z := Z-1
  300.  
  301.             ELSE
  302.  
  303.               Z := Z-1;
  304.  
  305.  
  306.  
  307.         END;
  308.  
  309.      {********************************************************}
  310.  
  311.      IF YearChosen = 1748 THEN
  312.  
  313.         Z:= 6;
  314.  
  315.  
  316.      {********************************************************}
  317.  
  318.      IF YearChosen = 1752 THEN
  319.  
  320.         Z:= 4;
  321.  
  322.     {*************************************************************}
  323.  
  324.      IF (YearChosen >= 1753) AND (YearChosen <= 2600) THEN
  325.  
  326.        BEGIN
  327.  
  328.          Z:= (700 + ((26*A) -2) DIV 10 + 1 + B + (B DIV 4) + (C DIV 4) - (2 * C )) MOD 7;
  329.  
  330.            IF ((YearChosen MOD 4) = 0) AND ((Yearchosen MOD 100) <> 0) OR ((Yearchosen MOD 400) = 0) THEN
  331.  
  332.               Z:= Z - 1;
  333.  
  334.  
  335.        END;
  336.  
  337.  
  338.    END; { Zeller's Congruence }
  339.  
  340. {***************************************************************************}
  341.  
  342.    { days of the months }
  343.  
  344.    FUNCTION Days (VAR Months :  Monthsyeartype; YearChosen : YearRange ) : INTEGER;
  345.  
  346.    BEGIN
  347.  
  348.    CASE Months OF
  349.  
  350.      january : Days := 31;
  351.      february : BEGIN
  352.                     IF ((YearChosen MOD 4) = 0) AND ((YearChosen MOD 100) <> 0) OR
  353.                        ((YearChosen MOD 400) = 0) THEN
  354.                        Days := 29
  355.                     ELSE
  356.                        Days := 28;
  357.                  END;
  358.      march  : Days := 31;
  359.      april  : Days := 30;
  360.      may    : Days := 31;
  361.      june   : Days := 30;
  362.      july   : Days := 31;
  363.      august : Days := 31;
  364.      september :  BEGIN
  365.                      IF YearChosen = 1752 THEN
  366.                         Days := 19
  367.                      ELSE
  368.                         Days := 30;
  369.                   END;
  370.      october : Days := 31;
  371.      november : Days := 30;
  372.      december : Days :=31;
  373.  
  374.    END;
  375.    END;
  376.    { end days of the months }
  377.  
  378.   {begin the fuction }
  379.  
  380.    FUNCTION CurrentDay ( Z : INTEGER ) : WeekDaysType;
  381.  
  382.       BEGIN
  383.  
  384.       CASE Z OF
  385.  
  386.        0 : CurrentDay := saturday;
  387.        1 : CurrentDay := sunday;
  388.        2 : CurrentDay := monday;
  389.        3 : CurrentDay := tuesday;
  390.        4 : CurrentDay := wednesday;
  391.        5 : CurrentDay := thursday;
  392.        6 : CurrentDay := friday;
  393.  
  394.        END;
  395.  
  396.        { end of the function }
  397.  
  398. BEGIN  { FillCalendarArray }
  399.  
  400. FirstDay (YearChosen, Z);
  401.  
  402. END;   { END FillCalendarArray }
  403.  
  404.  
  405.  
  406.  
  407.   { GET THE FIRST DAY OF THE YEAR
  408.  
  409.   IF (year < 2000) THEN
  410.  
  411.          FOR Firstday := (2000 - 1) DOWNTO year DO
  412.  
  413.  
  414.  
  415.  
  416.  
  417.   ELSE
  418.          FOR Firstday := 2000 TO (year - 1) DO
  419.             BEGIN
  420.  
  421.  
  422.             END;
  423.  
  424.  
  425.  
  426.  
  427.    END OF THE FIRST DAY OF THE YEAR }
  428.  
  429.  
  430.   {*****************************************************}
  431.  
  432.   {*****************************************************}
  433.  
  434. { aki es dond tengo q ver lo d los numeros pero no se como hacer para q salgan en pantalla  con los meses y los dias d la semana}
  435.  
  436.  
  437.   PROCEDURE DisplayCalendar (VAR CalendarArray : CalendarArrayType
  438.                                  );
  439.  
  440.     VAR
  441.  
  442.     Daysofyear : INTEGER;
  443.  
  444.     BEGIN
  445.  
  446.     FOR Daysofyear :=  1 TO 31 DO
  447.  
  448.  
  449.     END;
  450.   {*****************************************************}
  451.  
  452.   {*****************************************************}
  453.  
  454. BEGIN { MAIN PROGRAM }
  455.  
  456.  
  457.    Initialize ( CalendarArray, MaxRows, BlankCell);
  458.  
  459.    GetTheYear ( YearChosen );
  460.  
  461.    FillCalendarArray ( CalendarArray,YearChosen, MaxRows   );
  462.  
  463.   {  esta parte me falta  DisplayMonths ( CalendarArray );  }
  464.  
  465.  
  466. END.   { MAIN PROGRAM }
  467.  


a ver si me pueden ayudar a ver como seria un kodigo d for para imprimir en la pantalla, despues yo lo temino