home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 January / Chip_1999-01_cd.bin / zkuste / delphi / D1 / CALPNL.ZIP / Calpnl.pas < prev    next >
Pascal/Delphi Source File  |  1996-03-13  |  36KB  |  1,106 lines
  1. unit Calpnl;
  2.  
  3. { Posted in the hope that I can repay a little of my enormous debt to
  4.   those many unselfish people who have made my life easier with freeware
  5.   and code snippets.
  6.  
  7.                                  -o0o-
  8.  
  9.   TCalenPnl, a freeware Calendar descended from TCustomPanel. The really
  10.   hard work for this component was done by Robert Vivrette, and is adapted
  11.   from his freeware TDateEdit form.
  12.  
  13.   I needed a panel-based Calendar, and adapted the CalPop code to suit.
  14.   TCalenPnl retains all the properties of a TPanel, and adds a few more.
  15.   Some of the interesting published properties are...
  16.  
  17.   ShowDate:    Shows\Hides the buttons and 'MMMMM YYYY' display
  18.           above the abbreviated day names at the top. The Months
  19.                 or Years can then be changed programmatically by
  20.                 ScrollBars or similar.
  21.  
  22.   DayWidth:    Uses 1 to 3 characters (M, Mo, Mon) to define the day name.
  23.  
  24.   Font:        Big deal! Actually, the point is that the Font can be
  25.           changed (typically the size would be changed) when 
  26.                 TCalenPnl is Resized (OnResize).
  27.  
  28.   OnDateChange:    A centralized event that allows users to change Labels,
  29.                 ScrollBars, Graphs or ProgressBars when the CalendarDate
  30.                 property is changed, internally or externally.
  31.  
  32.   Some interesting Public properties...
  33.  
  34.   CalendarDate: A TDateTime property that you can read or write to
  35.           programmatically. The fractional part of CalendarDate,
  36.                 i.e. the time, is not stored.
  37.  
  38.   WeekNumber:     An integer representing the... Week number of the TCalenPnl.Year.
  39.  
  40.   DayOfYear:     Integer value for days that have passed, in the current
  41.           (CalendarDate) year.
  42.  
  43.   DaysInYear:    Integer, can be either 365 or 366. It could have just as
  44.           easily been Boolean (it calls the Boolean IsLeapYear protected
  45.                 Function), but it suited my project.
  46.  
  47.   .Day, .Month, .Year are all integer Public Properties.
  48.  
  49.   There is some repitition in the code, as Robert's CalPop relies on the date
  50.   being changed only by the buttons, therefore only in increments of one. I
  51.   required TCalenPnl to be able to be set by other controls, so there is some
  52.   duplication.  A really clever programmer, over a rainy weekend, could re-do
  53.   the code to shrink it a touch.
  54.  
  55.   You may have to look closely at some of the code, as it has been written to
  56.   prevent a user entering an invalid date, which can happen with a ScrollBar.
  57.   If the date highlighted is 31 August, and the user scrolls to September, the
  58.   CalendarDate.Day is reset to the DaysInMonth (ie, 30), to prevent an error.
  59.   Shouldn't be a problem as it almost guarantees no errors, but be aware.
  60.  
  61.   If you use 'MMMM DD YYYY' format in your Win International settings, ie US
  62.   users, then the example above would use August 31. In other words, the code
  63.   is 'Internationalized', to that extent.
  64.  
  65.   While CalPnl.PAS  and the CalPnl.DCR have been produced in Delphi 2.0, there
  66.   is no reason why the .PAS would not work in 16 bit Delphi, apart from a few
  67.   // comments.
  68.  
  69.   I considered a dynamic StartOfWeek, as some other calendar programmes offer,
  70.   because it is culturally presumptuous of me to use Sunday as day 1.  If you
  71.   wish to modify the source, please do so, and send me a copy to re-post.
  72.  
  73.   If you have any criticisms or suggestions, please send them to me...
  74.  
  75.                      Peter Crain
  76.                      Brisbane, Queensland.
  77.                      AUSTRALIA.
  78.                      Compuserve 100237,2735
  79. }
  80.  
  81. interface
  82.  
  83. uses
  84.  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  85.   Forms, Dialogs, extctrls, Menus;
  86. const
  87.  BORDER = 2; 
  88.  DAYS_IN_MONTH: array[1..12] of Integer = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
  89.  BUTTON_WIDTH = 16;
  90. type
  91.  TDayWidth = (dw1Char, dw2Char, dw3Char);
  92.  TPaintJob = (All, Header, Dates);
  93. type
  94.  TDateType = record
  95.   aYear, aMonth, aDay : Word;
  96. End; {Record}
  97. type
  98.  TCalenPnl = class(TCustomPanel)
  99. private
  100.  g_MouseDown : BOOL;
  101.  g_PrevYear, g_PrevMonth : Word;
  102.  g_DateArray : array[1..42] of string[2];
  103.  g_CurrDateIndex : Integer;
  104.  g_PrevDateIndex : Integer;
  105.  g_DayTitles : Array[0..6] of string[3]; {moved from const to enable Int ShortDayNames}
  106.  FOnDblClick: TNotifyEvent;
  107.  FOnDateChange: TNotifyEvent;
  108.  FButton: TMouseButton;
  109.  FButtonDown: Boolean;
  110.  FShowDate: Boolean;
  111.  FUseLongDate: Boolean;
  112.  g_RectHeight: Integer;
  113.  g_Width: Integer;
  114.  HeadingRect: TRect;
  115.  CalendarRect : TRect;
  116.  FMonth: Integer;
  117.  FDay: Integer;
  118.  FYear: Integer;
  119.  FDayWidth: TDayWidth;
  120.  FCalendarDate: TDateTime;
  121.  FWeekNumber: Integer;
  122.  FDayOfYear: Integer;
  123.  FDaysInYear: Integer;
  124.  procedure SetCalendarDate(aDate: TDateTime);
  125.  procedure SetMonth(Value: Integer);
  126.  procedure SetDay(Value: Integer);
  127.  procedure SetYear(Value: Integer);
  128.  function GetShowDate: Boolean;
  129.  procedure SetShowDate(Value: Boolean);
  130.  procedure SetDayWidth(Value: TDayWidth);
  131.  function GetUseLongDate: Boolean;
  132.  procedure SetUseLongDate(Value: Boolean);
  133.  function JulDate1stWeek(JD : TDateTime) : TDateTime;
  134.  function WeekNo(JDate : TDateTime): Integer;
  135.  function GetWeekNumber: Integer;
  136.  function DOY (y, m, d : Word): Integer;
  137.  function GetDayOfYear: Integer;
  138.  function GetDaysInYear: integer;
  139.  
  140. protected
  141.  procedure Paint; override;
  142.  procedure DateChange;
  143.  procedure DrawMonthHeader;
  144.  procedure DrawDaysHeader;
  145.  procedure DrawDates;
  146.  procedure DrawFocusFrame(nIndex : Integer);
  147.  procedure LoadDateArray;
  148.  function GetMonthBegin: Integer;
  149.  function DaysInMonth(nMonth, nYear : Integer): Integer;
  150.  function IsLeapYear(AYear: Integer): Boolean;
  151.  function SetDate(nDays : Integer): Boolean;
  152.  function GetLeftButtonRect : TRect;
  153.  function GetRightButtonRect : TRect;
  154.  function GetRectFromIndex(nIndex : Integer): TRect;
  155.  function GetIndexFromDate : Integer;
  156.  function GetIndexFromPoint(nLeft : Integer ; nTop : Integer) : Integer;
  157.  procedure DrawButtons;
  158.  procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  159.     X, Y: Integer); override;
  160.  procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
  161.      X, Y: Integer); override;
  162.  procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  163.  function ValidDate(aDate: TDateType) : Boolean;
  164.  
  165. public
  166.  constructor Create(AOwner: TComponent); override;
  167.  property Day: Integer read FDay write SetDay;
  168.  property Month: Integer read FMonth write SetMonth;
  169.  property Year: Integer read FYear write SetYear;
  170.  property CalendarDate: TDateTime read FCalendarDate write SetCalendarDate;
  171.  property WeekNumber: Integer read GetWeekNumber;
  172.  property DayOfYear: Integer read GetDayOfYear;
  173.  property DaysInYear: Integer read GetDaysInYear;
  174.  
  175. published
  176.  property Align;
  177.  property BevelInner default bvLowered;
  178.  property BevelOuter default bvRaised;
  179.  property BevelWidth default 1;
  180.  property BorderStyle default bsNone;
  181.  property BorderWidth default 1;
  182.  property Color;
  183.  property Ctl3D;
  184.  property Cursor;
  185.  property DragCursor;
  186.  property DragMode;
  187.  property Enabled;
  188.  property Font;
  189.  property Height default 160;
  190.  property HelpContext;
  191.  property Hint;
  192.  property Left;
  193.  property Locked;
  194.  property Name;
  195.  property ParentColor;
  196.  property ParentCtl3D;
  197.  property ParentFont;
  198.  property ParentShowHint;
  199.  property PopupMenu;
  200.  property ShowHint;
  201.  property TabOrder;
  202.  property TabStop;
  203.  property Tag;
  204.  property Top;
  205.  property Visible;
  206.  property Width default 160;
  207.  property ShowDate: Boolean read GetShowDate write SetShowDate default True;
  208.  property UseLongDate: Boolean read GetUseLongDate write SetUseLongDate; {defaults to False}
  209.  property DayWidth: TDayWidth read FDayWidth write SetDayWidth default dw3Char;
  210.  property OnClick;
  211.  property OnDblClick;
  212.  property OnDragDrop;
  213.  property OnDragOver;
  214.  property OnEndDrag;
  215.  property OnEnter;
  216.  property OnExit;
  217.  property OnMouseDown;
  218.  property OnMouseMove;
  219.  property OnMouseUp;
  220.  property OnResize;
  221.  property OnDateChange: TNotifyEvent read FOnDateChange write FOnDateChange;
  222.  
  223. end;
  224.  
  225. procedure Register;
  226.  
  227. implementation
  228.  
  229. procedure Register;
  230. begin
  231.   RegisterComponents('Samples', [TCalenPnl]);
  232. end;
  233.  
  234. function PointInRect( const rectTest: TRect; X, Y: integer ): boolean;
  235. begin
  236.   Result := ( ( X >= rectTest.Left ) and ( X <= rectTest.Right ) and
  237.      ( Y >= rectTest.Top ) and ( Y <= rectTest.Bottom ) );
  238. end;
  239.  
  240. function TCalenPnl.GetShowDate: Boolean;
  241. begin
  242.  Result := FShowDate;
  243. end;
  244.  
  245. procedure TCalenPnl.SetShowDate(Value: Boolean);
  246. begin
  247.  if Value <> FShowDate then
  248.   begin FShowDate := Value;
  249.   Refresh;
  250.  end;
  251. end;
  252.  
  253. function TCalenPnl.GetUseLongDate: Boolean;
  254. begin
  255.  Result := FUseLongDate;
  256. end;
  257.  
  258. procedure TCalenPnl.SetUseLongDate(Value: Boolean);
  259. begin
  260.  if Value <> FUseLongDate then
  261.   begin FUseLongDate := Value;
  262.   Refresh;
  263.  end;
  264. end;
  265.  
  266. procedure TCalenPnl.SetDayWidth(Value: TDayWidth);
  267. begin
  268.  if Value <> FDayWidth then
  269.   begin FDayWidth := Value;
  270.   Refresh;
  271.  end;
  272. end;
  273.  
  274. constructor TCalenPnl.Create(AOwner: TComponent);
  275. var
  276.  iCount: Integer;
  277.  aY, aM, aD: Word;
  278. begin
  279.  inherited Create(AOwner);
  280.  Height := 160;
  281.  Width := 160;
  282.  BevelOuter := bvRaised;
  283.  BevelInner := bvLowered;
  284.  BevelWidth := 1;
  285.  BorderStyle := bsNone;
  286.  BorderWidth := 1;
  287.  DayWidth := dw3Char;
  288.  for iCount := 0 to 6 do g_DayTitles[iCount] := ShortDayNames[iCount +1];
  289.  FCalendarDate := Date;
  290.  FShowDate := True;
  291.  DecodeDate(FCalendarDate, aY, aM, aD );
  292.  FMonth := Integer(aM);
  293.  FDay := Integer(aD);
  294.  FYear := Integer(aY);
  295.  g_PrevDateIndex := 0;
  296.  LoadDateArray;
  297.  SetDate(0);
  298.  g_MouseDown := False;
  299. end;
  300.  
  301. procedure TCalenPnl.Paint;
  302. var
  303.  iInnerSpace, iWBorder, iHBorder, iInnerW, innerH, iLMargin, iLinesH: Integer;
  304. begin
  305.  inherited Paint;
  306.  iInnerSpace := 0;
  307.  if BorderStyle = bsSingle then iInnerSpace := 1;
  308.  if BevelOuter <> bvNone then iInnerSpace := BevelWidth + iInnerSpace;
  309.  if BevelInner <> bvNone then iInnerSpace:= BevelWidth + iInnerSpace;  { + 1}
  310.  iInnerSpace:= BorderWidth + iInnerSpace;
  311.  {iInnerSpace = the border, including bevels, on 1 side}
  312.  iInnerW := Width - (iInnerSpace * 2);
  313.  iWBorder := iInnerW div 100;
  314.  {g_Width is a product of useable space, not all space}
  315.  {clear space less a border both sides, makes g_Width narrower}
  316.  g_Width := (iInnerW - (iWBorder * 2)) div 7;
  317.  innerH := Height - (iInnerSpace * 2);
  318.  iHBorder := innerH div 100;
  319.  if ShowDate then iLinesH := 8 else iLinesH := 7;
  320.  {take out 2 iHBorder for spacing at top}
  321.  g_RectHeight := (innerH - (iHBorder * 2) ) div iLinesH;
  322.  iLMargin := (iInnerW - (g_Width * 7)) div 2;
  323.  HeadingRect := ClientRect;
  324.  HeadingRect.Top := HeadingRect.Top + iInnerSpace + iHBorder;
  325.  HeadingRect.Left := HeadingRect.Left + iInnerSpace + iLMargin ;
  326.  HeadingRect.Right := HeadingRect.Left + (g_Width * 7) ;
  327.  if ShowDate then HeadingRect.Bottom := HeadingRect.Top + (g_RectHeight * 2)
  328.    else HeadingRect.Bottom := HeadingRect.Top + g_RectHeight;
  329.  CalendarRect := HeadingRect;
  330.  CalendarRect.Top := HeadingRect.Bottom ;
  331.  CalendarRect.Bottom := CalendarRect.Top + (g_RectHeight * 6);
  332.  Canvas.Brush.Color := clBtnFace;
  333.  Canvas.FillRect(CalendarRect);
  334.  g_CurrDateIndex := FDay + GetMonthBegin - 1;
  335.  if ShowDate then
  336.   begin
  337.    DrawButtons;
  338.    DrawMonthHeader;
  339.   end;
  340.  DrawDaysHeader;
  341.  DrawDates;
  342.  DrawFocusFrame(g_CurrDateIndex);
  343. end;
  344.  
  345. procedure TCalenPnl.DrawMonthHeader;
  346. var
  347.    iRectHt, iSpaces, iIndent: Integer;
  348.    sMonth : String;
  349.    pMonth : PChar;
  350.    TempRect : TRect;
  351. begin
  352.   with Canvas do
  353.    begin
  354.     Font.Color := clBlack;
  355.     Font.Style := [fsBold];
  356.     if UseLongDate then sMonth := FormatDateTime( 'mmmm yyyy', FCalendarDate )
  357.       else sMonth := FormatDateTime( 'mmm yyyy', FCalendarDate );
  358.     pMonth := StrAlloc( Length( sMonth ) + BORDER );
  359.     StrPCopy( pMonth, sMonth );
  360.     TempRect := HeadingRect;
  361.     iRectHt := HeadingRect.Bottom - HeadingRect.Top;
  362.     iIndent := (TempRect.Right - TempRect.Left) div 20;
  363.     iSpaces := (iRectHt div 20) * BORDER;
  364.     if iSpaces = 0 then iSpaces := 1;
  365.     TempRect.Top := TempRect.Top + iSpaces ;
  366.     TempRect.Bottom := TempRect.Top + g_RectHeight ;
  367.     TempRect.Left := TempRect.Left + iIndent + BUTTON_WIDTH + 1;
  368.     TempRect.Right := TempRect.Right - (iIndent + BUTTON_WIDTH + 1);
  369.     Brush.Color := clBtnFace;
  370.     Brush.Style := bsSolid;
  371.     FillRect( TempRect );
  372.     DrawText( Handle, pMonth, Length( sMonth ), TempRect,
  373.              ( DT_CENTER or DT_TOP or DT_SINGLELINE ) );
  374.    end;
  375.   StrDispose( pMonth );
  376. end;
  377.  
  378. procedure TCalenPnl.DrawDaysHeader;
  379. var
  380.    i, iDayWidth: Integer;
  381.    pDay: PChar;
  382.    ARect: TRect;
  383. begin
  384.   Case DayWidth of
  385.    dw1Char : iDayWidth := 1;
  386.    dw2Char : iDayWidth := 2;
  387.    dw3Char : iDayWidth := 3;
  388.    else iDayWidth := 1;
  389.   end;
  390.   pDay := StrAlloc( 3 );
  391.   ARect := HeadingRect;
  392.   ARect.Right := ARect.Left + g_Width;
  393.   if ShowDate then ARect.Top := ARect.Top + g_RectHeight ;
  394.   { Cycle through the days }
  395.   Canvas.Font.Style := [fsBold]; {make Days Bold}
  396.   for i := 0 to 6 do   
  397.      begin
  398.         if (i = 0) or (i = 6) then Canvas.Font.Color := clRed
  399.           else Canvas.Font.Color := clBlack;
  400.         StrPCopy( pDay, Copy(g_DayTitles[i], 1, iDayWidth));
  401.         DrawText( Canvas.Handle, pDay, iDayWidth, ARect,
  402.                 ( DT_CENTER or DT_VCENTER or DT_SINGLELINE ) ); 
  403.         ARect.Left := ARect.Right;
  404.         ARect.Right := ARect.Right + g_Width;
  405.      end;
  406.      Canvas.Font.Color := clBlack;
  407.      Canvas.Font.Style := [];  {reset Days <> Bold}
  408.      { Draw line below days }
  409.      with Canvas do
  410.         begin
  411.            ARect.Top := CalendarRect.Top - 4;
  412.            ARect.Left := HeadingRect.Left;
  413.            ARect.Right := HeadingRect.Right;
  414.            Pen.Color := clBtnHighlight;
  415.            MoveTo( ARect.Left , ARect.Top);
  416.            LineTo( ARect.Right, ARect.Top );
  417.            Pen.Color := clBtnShadow;
  418.            MoveTo( ARect.Left,  ARect.Top + 1 );
  419.            LineTo( ARect.Right, ARect.Top + 1  );
  420.         end;
  421.      StrDispose( pDay );
  422. end;
  423.  
  424. procedure TCalenPnl.DrawDates;
  425. var
  426.    nIndex, nWeek, nDay: Integer;
  427.    pDate: PChar;
  428.    TempRect: Trect;
  429. begin
  430.  pDate := StrAlloc( 3 );
  431.  With Canvas do
  432.   begin
  433.   { Define normal font }
  434.    Font.Style := [];
  435.    Pen.Color := clBlack;
  436.    { Cycle through the weeks }
  437.    for nWeek := 1 to 6 do
  438.     begin
  439.      { Cycle through the days }
  440.      for nDay := 1 to 7 Do
  441.       begin
  442.        nIndex := nDay + ( ( nWeek - 1 ) * 7 );
  443.        StrPCopy( pDate, g_DateArray[nIndex] );
  444.        TempRect := CalendarRect; {OPTIMIZE: can it go outside loop?}
  445.        With TempRect Do
  446.         begin
  447.          Left := Left + (g_Width * (nDay - 1));
  448.          Top := Top + (g_RectHeight * (nWeek -1));
  449.          Bottom := Top +  g_RectHeight ;
  450.          Right := Left + g_Width;
  451.         end;
  452.         if (nDay = 1) or (nDay = 7) then Font.Color := clRed else Font.Color := clBlack;
  453.         DrawText( Handle, pDate, Length( g_DateArray[nIndex] ),
  454.           TempRect, ( DT_CENTER or DT_VCENTER or DT_TOP or DT_SINGLELINE ) );
  455.         Font.Color := clBlack;
  456.        end;
  457.       end;
  458.      end;
  459.      StrDispose( pDate );
  460. end;
  461.  
  462. procedure TCalenPnl.LoadDateArray;
  463. var
  464.   nIndex : Integer;
  465.   nBeginIndex, nEndIndex : Integer;
  466. begin
  467.   nBeginIndex := GetMonthBegin;
  468.   nEndIndex := nBeginIndex + DaysInMonth(FMonth, FYear) - 1;
  469.   for nIndex := 1 to 42 do
  470.   begin
  471.      If ( nIndex < nBeginIndex ) or ( nIndex > nEndIndex ) Then
  472.         g_DateArray[nIndex] := '  '
  473.      else
  474.         g_DateArray[nIndex] := IntToStr( ( nIndex - nBeginIndex ) + 1 );
  475.   end;
  476. end;
  477.  
  478. function TCalenPnl.GetMonthBegin: Integer;
  479. var
  480.   FirstDate: TDateTime;
  481. begin
  482.   FirstDate := EncodeDate( FYear, FMonth, 1 );
  483.   Result := DayOfWeek( FirstDate ); { day of week for 1st of month }
  484. end;
  485.  
  486. function TCalenPnl.DaysInMonth(nMonth, nYear : Integer): Integer;
  487. begin
  488.   Result := DAYS_IN_MONTH[nMonth]; { leap-year Feb is special }
  489.   if ( nMonth = 2 ) and IsLeapYear(nYear) then Inc( Result );
  490. end;
  491.  
  492. function TCalenPnl.IsLeapYear(AYear: Integer): Boolean;
  493. begin
  494.   Result := (AYear mod 4 = 0) and ((AYear mod 100 <> 0) or (AYear mod 400 = 0));
  495. end;
  496.  
  497. function TCalenPnl.SetDate(nDays : Integer): Boolean;
  498. var
  499.   aY, aM, aD: Word;
  500.   PrevDay: Word;
  501. begin
  502.  Result := True;
  503.  try
  504.   {Save current date information}
  505.   g_PrevDateIndex := g_CurrDateIndex;
  506.   DecodeDate(FCalendarDate, g_PrevYear, g_PrevMonth, PrevDay);
  507.   {Change the date and update member variables}
  508.   FCalendarDate := FCalendarDate + nDays;
  509.   DecodeDate(FCalendarDate, aY, aM, aD);
  510.   g_CurrDateIndex := ( aD + GetMonthBegin ) - 1;
  511.   {Reload Date Array & paint ONLY if month or year changed}
  512.   If (aM <> g_PrevMonth) or (aY <> g_PrevYear)Then
  513.    begin
  514.     FMonth := aM;
  515.     FYear := aY;
  516.     LoadDateArray;
  517.    end;
  518.   FDay := aD;
  519.  except
  520.   MessageBeep(MB_ICONEXCLAMATION);
  521.   Result := False;
  522.  end;
  523. end;
  524.  
  525. Function TCalenPnl.ValidDate(aDate: TDateType) : Boolean;
  526. Begin       {is cool as no exception is generated by invalid date}
  527.  ValidDate := True;
  528.   With aDate do
  529.    Begin
  530.     If (aMonth > 12) Or (aMonth < 1) Or (aDay < 1) or (aYear < 1) or (aYear > 9999) then
  531.      Begin
  532.       ValidDate := False;
  533.       Exit;
  534.      End;
  535.     If (aMonth = 2) And IsLeapYear(Integer(aYear)) then Dec(aDay);
  536.     If aDay > DaysInMonth(aMonth, aYear) then ValidDate := False;
  537.    End;
  538. End;
  539.  
  540. procedure TCalenPnl.SetCalendarDate(aDate: TDateTime);
  541. var
  542.  aYear, aMonth, aDay: Word;
  543. begin
  544. try
  545.  if FCalendarDate <> aDate then
  546.   begin
  547.    DecodeDate(aDate, aYear, aMonth, aDay);
  548.    FCalendarDate := aDate;
  549.    FYear := Integer(aYear);
  550.    FMonth := Integer(aMonth);
  551.    FDay := Integer(aDay);
  552.    LoadDateArray;
  553.    DateChange;
  554.    Refresh;
  555.   end;
  556. except
  557.   MessageBeep(MB_ICONEXCLAMATION);
  558.  end;
  559. end;
  560.  
  561. procedure TCalenPnl.SetMonth(Value: Integer);
  562. var
  563.  mDate : TDateType;
  564.  wValue, aY, aM, aD: Word;
  565.  iDaysInM : word;
  566. begin {no test for new <> old as that would fail at startup}
  567.  if (Value < 1) or (Value > 12) then
  568.   begin    {first test}
  569.    MessageBeep(MB_ICONEXCLAMATION);
  570.    Exit;
  571.   end;
  572.  wValue := Word(Value);
  573.  iDaysInM := DaysInMonth(wValue, FYear);
  574.  if iDaysInM < FDay then FDay := iDaysInM;
  575.  with mDate do
  576.   begin
  577.    aMonth := wValue; aDay := Word(FDay); aYear := Word(FYear);
  578.   end;
  579.  
  580.  if ValidDate(mDate) then  {2nd test}
  581.   begin
  582.    FCalendarDate := EncodeDate(Word(FYear), wValue, Word(FDay));
  583.    DecodeDate( FCalendarDate, aY, aM, aD);
  584.    g_CurrDateIndex := ( aD + GetMonthBegin ) - 1;
  585.    FYear := Integer(aY);
  586.    FMonth := Integer(aM);
  587.    FDay := Integer(aD);
  588.    DateChange;
  589.    LoadDateArray;
  590.    Refresh;
  591.   end
  592.  else MessageBeep(MB_ICONEXCLAMATION);
  593.  
  594. end;
  595.  
  596. procedure TCalenPnl.SetDay(Value: Integer);
  597. var
  598.  dDate : TDateType;
  599.  wValue, aY, aM, aD: Word;
  600. begin
  601.  if (Value < 1) or (Value > DaysInMonth(FMonth, FYear)) then
  602.   begin    {first test}
  603.    MessageBeep(MB_ICONEXCLAMATION);
  604.    Exit;
  605.   end;
  606.  wValue := Word(Value);
  607.  with dDate do
  608.   begin
  609.    aMonth := Word(FMonth); aDay := wValue; aYear := Word(FYear);
  610.   end;
  611.  if ValidDate(dDate) then  {2nd test}
  612.   begin
  613.    FCalendarDate := EncodeDate(Word(FYear), Word(FMonth), Value);
  614.    DecodeDate( FCalendarDate, aY, aM, aD);
  615.    g_CurrDateIndex := ( FDay + GetMonthBegin ) - 1;
  616.    FYear := Integer(aY);
  617.    FMonth := Integer(aM);
  618.    FDay := Integer(aD);
  619.    DateChange;
  620.    LoadDateArray;
  621.    Refresh;
  622.   end
  623.  else MessageBeep(MB_ICONEXCLAMATION);
  624. end;
  625.  
  626. procedure TCalenPnl.SetYear(Value: Integer);
  627. var
  628.  yDate : TDateType;
  629.  iDaysInM, wValue, aY, aM, aD: Word;
  630. begin
  631.  if (Value < 1) or (Value > 9999) then
  632.   begin    {first test}
  633.    MessageBeep(MB_ICONEXCLAMATION);
  634.    Exit;
  635.   end;
  636.  wValue := Word(Value);
  637.  
  638.  iDaysInM := DaysInMonth(FMonth, wValue);
  639.  if iDaysInM < FDay then FDay := iDaysInM;
  640.  
  641.  with yDate do
  642.   begin
  643.    aMonth := Word(FMonth); aDay := Word(FDay); aYear := wValue;
  644.   end;
  645.  if ValidDate(yDate) then  {2nd test}
  646.   begin
  647.    FCalendarDate := EncodeDate(wValue, Word(FMonth), Word(FDay));
  648.    DecodeDate(FCalendarDate, aY, aM, aD);
  649.    g_CurrDateIndex := ( FDay + GetMonthBegin ) - 1;
  650.    FYear := Integer(aY);
  651.    FMonth := Integer(aM);
  652.    FDay := Integer(aD);
  653.    DateChange;
  654.    LoadDateArray;
  655.    Refresh;
  656.   end
  657.  else MessageBeep(MB_ICONEXCLAMATION);
  658. end; 
  659.  
  660. procedure TCalenPnl.DrawFocusFrame( nIndex: Integer);
  661. var
  662.   pDate :PChar;
  663.   TempRect : TRect;
  664. begin
  665.   pDate := StrAlloc( 3 );
  666.   If ( nIndex > 0 ) and ( nIndex < 42 ) then
  667.     //following line works, but may affect DblClick
  668.     //if nIndex = g_PrevDateIndex then exit;
  669.     If g_DateArray[nIndex] <> '  ' then
  670.        begin
  671.         { Erase Previous Date Focus }
  672.         If g_PrevDateIndex > 0 Then
  673.          begin
  674.           case g_PrevDateIndex of
  675.             1, 7, 8, 14, 15, 21, 22, 28, 29, 35, 36, 42:
  676.               Canvas.Font.Color := clRed else Canvas.Font.Color := clBlack;
  677.            end;
  678.            Canvas.Font.Style := [];
  679.            StrPCopy( pDate, g_DateArray[g_PrevDateIndex] );
  680.            Canvas.Brush.Color := clBtnFace;
  681.            TempRect := GetRectFromIndex(g_PrevDateIndex);
  682.            Canvas.FillRect(TempRect);
  683.            DrawText( Canvas.Handle, pDate, Length( g_DateArray[g_PrevDateIndex] ),
  684.                         TempRect, ( DT_CENTER or DT_VCENTER or DT_TOP or DT_SINGLELINE ) );
  685.           end;
  686.           {Draw the Date in Bold font}
  687.            case nIndex of
  688.             1, 7, 8, 14, 15, 21, 22, 28, 29, 35, 36, 42: Canvas.Font.Color := clRed
  689.             else Canvas.Font.Color := clBlack;
  690.            end;
  691.            Canvas.Font.Style := [fsBold];
  692.            TempRect := GetRectFromIndex(nIndex);
  693.            StrPCopy( pDate, g_DateArray[nIndex] );
  694.            DrawText( Canvas.Handle, pDate, Length( g_DateArray[nIndex] ),
  695.                      TempRect, ( DT_CENTER or DT_VCENTER or DT_TOP or DT_SINGLELINE ) );
  696.            { Frame date with Shadow }
  697.            Canvas.Pen.Color := clBtnShadow;   {clGray}
  698.            Canvas.MoveTo( TempRect.Left, TempRect.Bottom - 1 );
  699.            Canvas.LineTo( TempRect.Left, TempRect.Top );
  700.            Canvas.LineTo( TempRect.Right - 1, TempRect.Top );
  701.            { Frame date with Highlight }
  702.            Canvas.Pen.Color := clBtnHighlight;    {clWhite}
  703.            Canvas.LineTo( TempRect.Right - 1, TempRect.Bottom - 1 );
  704.            Canvas.LineTo( TempRect.Left, TempRect.Bottom - 1 );
  705.            { Restore Canvas settings}
  706.            Canvas.Pen.Color := clBlack;
  707.            Canvas.Font.Style := [];
  708.         end;
  709.   StrDispose( pDate );
  710. end;
  711.  
  712. function TCalenPnl.GetRectFromIndex(nIndex : Integer): TRect;  {1}
  713. var
  714.   TempRect: TRect;
  715.   nWeek : Integer;
  716.   nDay : Integer;
  717. begin
  718.   TempRect := CalendarRect;
  719.   with TempRect do
  720.      begin
  721.       nWeek := 1;    //if not initialized bloody Syntax checker returns cursor
  722.       case nIndex of //here after compile, losing ones place!
  723.             1..7 :  nWeek := 1;
  724.             8..14:  nWeek := 2;
  725.             15..21: nWeek := 3;
  726.             22..28: nWeek := 4;
  727.             29..35: nWeek := 5;
  728.             36..42: nWeek := 6;
  729.        end;
  730.        nDay := nIndex - ((nWeek-1) *7);
  731.        Left := Left + (g_Width * (nDay-1));
  732.        Top := Top + (g_RectHeight * (nWeek - 1) );
  733.        Bottom := Top +  g_RectHeight ;
  734.        Right := Left + g_Width;
  735.      end;
  736.   Result := TempRect;
  737. end;
  738.  
  739. function TCalenPnl.GetIndexFromDate : Integer;
  740. begin
  741.  Result := FDay + GetMonthBegin;
  742. end;
  743.  
  744. function TCalenPnl.GetIndexFromPoint(nLeft : Integer ; nTop : Integer) : Integer;
  745. var
  746.   nIndex, nWeek, nDay, iHorizontal, iTopOfCal: Integer;
  747.   TempRect: Trect;
  748. begin
  749.   TempRect := CalendarRect;
  750.   iTopOfCal := TempRect.Top;
  751.   nIndex := -1;
  752.   {Is point in the calendar rectangle?}
  753.   if ( nLeft > TempRect.Left ) and ( nTop > TempRect.Top ) and
  754.       ( nLeft < TempRect.Right ) and ( nTop < TempRect.Bottom ) then
  755.      begin
  756.         iHorizontal := (( nTop - iTopOfCal ) div g_RectHeight) + 1;
  757.         if iHorizontal <= 0 then iHorizontal := 1; {if its in the CalenRect then its valid}
  758.         nWeek := iHorizontal;
  759.         TempRect.Top := TempRect.Top + ( ( nWeek - 1 ) * g_RectHeight );
  760.         TempRect.Bottom := TempRect.Top + g_RectHeight;
  761.         TempRect.Right := TempRect.Left + g_Width;
  762.         { Determine the day number of the selected date }
  763.         for nDay := 1 to 7 do        {Cycle through the days}
  764.            begin
  765.               nIndex := nDay + ( ( nWeek - 1 ) * 7 );
  766.               if ( nLeft >= TempRect.Left ) and ( nLeft <= TempRect.Right ) then
  767.                  break
  768.               else
  769.                  begin
  770.                     TempRect.Left := TempRect.Right;
  771.                     TempRect.Right := TempRect.Left + g_Width;
  772.                  end;
  773.            end;
  774.      end;
  775.   Result := nIndex;
  776. end;
  777.  
  778. procedure TCalenPnl.MouseUp(Button: TMouseButton; Shift: TShiftState;
  779.   X, Y: Integer);
  780. begin
  781.   inherited MouseUp(Button, Shift, X, Y);
  782.   FButtonDown := False;
  783.   if FButton = mbRight then MouseCapture := False;
  784. end;
  785.  
  786. procedure TCalenPnl.DateChange;
  787. begin
  788.  if Assigned(FOnDateChange) then FOnDateChange(Self);
  789. end;
  790.  
  791. procedure TCalenPnl.MouseDown(Button: TMouseButton; Shift: TShiftState;
  792.       X, Y: Integer);
  793. var
  794.   nIndex : Integer;
  795.   Key: Word;
  796. begin
  797.   inherited MouseDown(Button, Shift, X, Y);
  798.   FButton := Button;
  799.   {Check if mouse was pressed in Left button area}
  800.   if PointInRect(GetLeftButtonRect, X, Y) then
  801.    begin
  802.     Key := Vk_Prior;
  803.     KeyDown(Key,Shift);
  804.     DateChange;
  805.    end;
  806.  
  807.   {Check if mouse was pressed in Right button area}
  808.   if PointInRect(GetRightButtonRect, X, Y) then
  809.    begin
  810.     Key := Vk_Next;
  811.     KeyDown(Key,Shift);
  812.     DateChange;
  813.    end;
  814.  
  815.   {Check if mouse was pressed in date area} // ouch!
  816.   if PointInRect(CalendarRect, X, Y) then
  817.    begin
  818.     g_MouseDown := True;
  819.     nIndex := GetIndexFromPoint( X, Y );
  820.     If (nIndex >= GetMonthBegin) and
  821.       (nIndex < (DaysInMonth(FMonth, FYear) + GetMonthBegin)) Then
  822.      begin
  823.       if Not SetDate(nIndex - g_CurrDateIndex) then exit;
  824.       DrawFocusFrame(nIndex);
  825.       DateChange;
  826.      end
  827.     else
  828.      g_MouseDown := False;
  829.    end;
  830. end;
  831.  
  832. function TCalenPnl.GetLeftButtonRect: TRect;
  833. var
  834.   TempRect: TRect;
  835.   iHt: Integer;
  836. begin
  837.    {Define Left Button Rectangle}
  838.    iHt := (HeadingRect.Bottom - HeadingRect.Top) div 15;
  839.    TempRect.Top := HeadingRect.Top + iHt;
  840.    TempRect.Bottom := TempRect.Top + BUTTON_WIDTH;
  841.    iHt := (HeadingRect.Right - HeadingRect.Left) div 30;
  842.    TempRect.Left := HeadingRect.Left + iHt;
  843.    TempRect.Right := TempRect.Left + BUTTON_WIDTH;
  844.    Result := TempRect;
  845. end;
  846.  
  847. function TCalenPnl.GetRightButtonRect: TRect;
  848. var
  849.   TempRect: TRect;
  850.   iHt: Integer;
  851. begin
  852.    {Define Right Button Rectangle}
  853.    iHt := (HeadingRect.Bottom - HeadingRect.Top) div 15;
  854.    TempRect.Top := HeadingRect.Top + iHt;
  855.    TempRect.Bottom := TempRect.Top + BUTTON_WIDTH;
  856.    iHt := (HeadingRect.Right - HeadingRect.Left) div 30;
  857.    TempRect.Left := HeadingRect.Right - (BUTTON_WIDTH + iHt);
  858.    TempRect.Right := TempRect.Left + BUTTON_WIDTH;
  859.    Result := TempRect;
  860. end;
  861.  
  862. procedure TCalenPnl.KeyDown(var Key: Word; Shift: TShiftState);
  863. var
  864.  iDaysIncrM, iDaysToAdd, iIncrM: integer;
  865. begin
  866.     Case key of
  867.      VK_Left : begin  {PrevDay;}
  868.                 if (FMonth = 1) and (FYear = 1) and (FDay = 1) then
  869.                  begin
  870.                   MessageBeep(MB_ICONEXCLAMATION);
  871.                   exit;
  872.                  end;
  873.                 if Not SetDate(-1)then exit;
  874.                 If (FMonth <> g_PrevMonth) or
  875.                    (FYear <> g_PrevYear) Then Refresh
  876.                     else DrawFocusFrame(g_CurrDateIndex);
  877.                 end;
  878.      VK_Right: begin  {NextDay;}
  879.                 if (FMonth = 12) and (FYear = 9999) and (FDay = 31) then
  880.                  begin
  881.                   MessageBeep(MB_ICONEXCLAMATION);
  882.                   exit;
  883.                  end;
  884.                 if Not SetDate(1) then exit;
  885.                 If (FMonth <> g_PrevMonth) or
  886.                    (FYear <> g_PrevYear) Then Refresh
  887.                     else DrawFocusFrame(g_CurrDateIndex);
  888.                 end;
  889.      VK_Up :   begin  {PrevWeek;}
  890.                 if (FMonth = 1) and (FYear = 1) and (FDay < 7) then
  891.                  begin
  892.                   MessageBeep(MB_ICONEXCLAMATION);
  893.                   exit;
  894.                  end;
  895.                 if Not SetDate(-7) then exit;
  896.                 If (FMonth <> g_PrevMonth) or
  897.                    (FYear <> g_PrevYear) Then Refresh
  898.                     else DrawFocusFrame(g_CurrDateIndex);
  899.                 end;
  900.      VK_Down : begin {NextWeek;}
  901.                 if (FMonth = 12) and (FYear = 9999) and (FDay > 24) then
  902.                  begin
  903.                   MessageBeep(MB_ICONEXCLAMATION);
  904.                   exit;
  905.                  end;
  906.                 if Not SetDate(7) then exit;
  907.                 If (FMonth <> g_PrevMonth) or
  908.                    (FYear <> g_PrevYear) Then Refresh
  909.                     else DrawFocusFrame(g_CurrDateIndex);
  910.                end;
  911.      VK_Prior: begin {PrevMonth;}
  912.                 if (FMonth = 1) and (FYear = 1) then
  913.                  begin
  914.                   MessageBeep(MB_ICONEXCLAMATION);
  915.                   exit;
  916.                  end;
  917.                 if FMonth > 1 then iIncrM := FMonth -1 else iIncrM := 12;
  918.                 iDaysIncrM := DaysInMonth(iIncrM, FYear);
  919.                 if (iDaysIncrM < FDay) then
  920.                   iDaysToAdd := DaysInMonth(FMonth, FYear)
  921.                   else iDaysToAdd := iDaysIncrM;
  922.                 try
  923.                  if Not SetDate(-iDaysToAdd) then exit;
  924.                  Refresh;
  925.                 except
  926.                  MessageBeep(MB_ICONEXCLAMATION);
  927.                 end;
  928.                end;
  929.      Vk_Next : begin  {NextMonth;}
  930.                 if (FMonth = 12) and (FYear = 9999) then
  931.                  begin
  932.                   MessageBeep(MB_ICONEXCLAMATION);
  933.                   exit;
  934.                  end;
  935.                 if FMonth = 12 then iIncrM := 1 else iIncrM := FMonth + 1;
  936.                 iDaysIncrM := DaysInMonth(iIncrM, FYear);
  937.                 if (iDaysIncrM < FDay) then iDaysToAdd := iDaysIncrM
  938.                   else iDaysToAdd := DaysInMonth(FMonth, FYear);
  939.                 try
  940.                  if Not SetDate(iDaysToAdd) then exit;
  941.                  Refresh;
  942.                 except
  943.                  MessageBeep(MB_ICONEXCLAMATION);
  944.                 end;
  945.                end;
  946.      VK_Home : begin {NextYear;}
  947. {If the current year is a leap year and the date is before February 29, add 1 day}
  948.                 if FYear = 9999 then
  949.                  begin
  950.                   MessageBeep(MB_ICONEXCLAMATION);
  951.                   exit;
  952.                  end;
  953.                 If IsLeapYear(FYear) and
  954.                   (FMonth < 3) Then if Not SetDate(1) then exit;
  955.                 if Not SetDate(365) then exit;
  956. {If the current year is a leap year and the date is after February 29, add 1 day}
  957.                 If IsLeapYear(FYear) and
  958.                   (FMonth > 3) Then if Not SetDate(1) then exit;
  959.                 Refresh;
  960.                end;
  961.      VK_End :  begin {PrevYear;}
  962.                 if FYear = 1 then
  963.                  begin
  964.                   MessageBeep(MB_ICONEXCLAMATION);
  965.                   exit;
  966.                  end;
  967. {If the current year is a leap year and the date is after February 29, subtract 1 day}
  968.                 If IsLeapYear(FYear) and
  969.                  (FMonth > 3) Then if Not SetDate(-1) then exit;
  970.                 if Not SetDate(-365) then exit;
  971. {If the Previous year is a leap year and the date is before February 29, subtract 1 day}
  972.                 If IsLeapYear(FYear) and
  973.                  (FMonth < 3) Then if Not SetDate(-1) then exit;
  974.                 Refresh;
  975.                end;
  976.     VK_Return: begin
  977.                {TDateEdit( ctlParent ).Date := m_CurrentDateSelected; }
  978.                {maybe you have a use for the Return or Esc keys}
  979.                end;
  980.   {VK_Escape : FormCancel;}
  981.      else
  982.  
  983.      end;
  984. end;
  985.  
  986. procedure TCalenPnl.DrawButtons;
  987. var
  988.   LBtnRect: TRect;
  989.   RBtnRect : TRect;
  990.   OldStyle : TBrushStyle;
  991. begin
  992.   with Canvas do
  993.      begin
  994.         LBtnRect := GetLeftButtonRect;
  995.         RBtnRect := GetRightButtonRect;
  996.  
  997.         { Select Black Pen}
  998.         Pen.Style := psSolid;
  999.         Pen.Width := 1;
  1000.         Pen.Color := clBtnShadow;   {clBlack}
  1001.  
  1002.         { Draw Button Outlines }
  1003.         Rectangle(LBtnRect.Left, LBtnRect.Top, LBtnRect.Right, LBtnRect.Bottom);
  1004.         Rectangle(RBtnRect.Left, RBtnRect.Top, RBtnRect.Right, RBtnRect.Bottom);
  1005.  
  1006.         { Create Embossed effect - Outline left & upper in white}
  1007.         Pen.Color := clBtnHighlight;
  1008.         MoveTo( LBtnRect.Left + 1, LBtnRect.Bottom - 2 );
  1009.         LineTo( LBtnRect.Left + 1, LBtnRect.Top + 1 );
  1010.         LineTo( LBtnRect.Right - 2, LBtnRect.Top + 1 );
  1011.  
  1012.         MoveTo( RBtnRect.Left + 1, RBtnRect.Bottom - 2 );
  1013.         LineTo( RBtnRect.Left + 1, RBtnRect.Top + 1 );
  1014.         LineTo( RBtnRect.Right - 2, RBtnRect.Top + 1 );
  1015.  
  1016.         { Create Embossed effect - Outline right & bottom in shadow }
  1017.         Pen.Color := clBtnShadow;    {clGray}
  1018.         MoveTo( LBtnRect.Right -2, LBtnRect.Top +  1 );
  1019.         LineTo( LBtnRect.Right - 2, LBtnRect.Bottom - 2 );
  1020.         LineTo( LBtnRect.Left + 1, LBtnRect.Bottom - 2 );
  1021.  
  1022.         MoveTo( RBtnRect.Right - 2, RBtnRect.Top + 1 );
  1023.         LineTo( RBtnRect.Right - 2, RBtnRect.Bottom - 2 );
  1024.         LineTo( RBtnRect.Left + 1, RBtnRect.Bottom - 2 );
  1025.  
  1026.         {Draw Arrow}
  1027.         Brush.Color := clBtnShadow;    {clBlack clBtnShadow}
  1028.         OldStyle :=Brush.Style;
  1029.         Brush.Style := bsSolid;
  1030.         Polygon([Point(LBtnRect.Right - 5,LBtnRect.Top + 3),
  1031.                  Point(LBtnRect.Right - 5,LBtnRect.Bottom - 4),
  1032.                  Point(LBtnRect.Left + 3,LBtnRect.Top + 7)]);
  1033.         Polygon([Point(RBtnRect.Left + 4,RBtnRect.Top + 3),
  1034.                  Point(RBtnRect.Left + 4,RBtnRect.Bottom - 4),
  1035.                  Point(RBtnRect.Right - 4,RBtnRect.Top + 7)]);
  1036.  
  1037.         {my turn - white line on arrows}
  1038.         Pen.Color := clBtnHighlight;
  1039.         MoveTo( LBtnRect.Left + 3, LBtnRect.Top + 8 );
  1040.         LineTo( LBtnRect.Right - 5, LBtnRect.Bottom - 3);
  1041.         LineTo( LBtnRect.Right - 5, LBtnRect.Top + 2 );
  1042.         MoveTo( RBtnRect.Left + 4, RBtnRect.Bottom - 4 );
  1043.         LineTo( RBtnRect.Right - 2, RBtnRect.Top + 7 );
  1044.         Brush.Color :=clBtnFace;
  1045.         Brush.Style := OldStyle;
  1046.         Pen.Color := clBlack;
  1047.      end;
  1048. end;
  1049.  
  1050. function TCalenPnl.JulDate1stWeek(JD : TDateTime) : TDateTime;
  1051.   {-Return the Date of the first day in the week of Julian Year}
  1052. var
  1053.   aYear, aMonth, aDay : Word;
  1054.   n : integer;
  1055.   JDate     : TDateTime;
  1056. begin
  1057.   DecodeDate(JD, aYear, aMonth, aDay);
  1058.   JDate := EncodeDate(aYear, 1, 1);
  1059.     if DayOfWeek(JDate) in [6, 7, 1] then n := 1 else n := -1;
  1060.   while DayOfWeek(JDate) <> 2 do JDate := JDate+n;
  1061.   if JD >= JDate then
  1062.     Result := JDate
  1063.   else
  1064.     Result := JulDate1stWeek(JD-7);
  1065. end;
  1066.  
  1067. function TCalenPnl.WeekNo(JDate : TDateTime) : Integer;
  1068. var
  1069.   W         : TDatetime;
  1070. begin
  1071.   W := JulDate1stWeek(JDate+31);
  1072.   if JDate < W then W := JulDate1stWeek(JDate);
  1073.   Result := trunc(7+JDate-W) div 7;
  1074. end;
  1075.  
  1076. function TCalenPnl.GetWeekNumber: Integer;
  1077. begin
  1078.  Result := WeekNo(EncodeDate(FYear, FMonth, FDay));
  1079. end;
  1080.  
  1081. function TCalenPnl.DOY(y, m, d : Word) : Integer;
  1082. var
  1083.  yy, mm, dd, Tmp1 : LongInt;
  1084. begin
  1085.   yy := y;
  1086.   mm := m;
  1087.   dd := d;
  1088.   Tmp1 := (mm + 10) div 13;
  1089.   DOY :=  3055 * (mm + 2) div 100 - Tmp1 * 2 - 91 +
  1090.                   (1 - (yy - yy div 4 * 4 + 3) div 4 +
  1091.                   (yy - yy div 100 * 100 + 99) div 100 -
  1092.                   (yy - yy div 400 * 400 + 399) div 400) * Tmp1 + dd
  1093. end;  { DayOfYear }
  1094.  
  1095. function TCalenPnl.GetDayOfYear: Integer;
  1096. begin
  1097.  result := DOY(FYear, FMonth, FDay);
  1098. end;
  1099.  
  1100. function TCalenPnl.GetDaysInYear: integer;
  1101. begin
  1102.  If IsLeapYear(FYear) then Result := 366 else result := 365;
  1103. end;
  1104.  
  1105. end.
  1106.