home *** CD-ROM | disk | FTP | other *** search
/ Delphi 5 for Professionals / DELPHI5.iso / AddOns / Components / Essentials / SETUP.EXE / %MAINDIR% / Escal.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-11-28  |  38.9 KB  |  1,439 lines
  1. {*********************************************************}
  2. {*                   ESCAL.PAS 1.05                      *}
  3. {*      Copyright (c) 1997-98 TurboPower Software Co     *}
  4. {*                 All rights reserved.                  *}
  5. {*********************************************************}
  6.  
  7. {$I ES.INC}
  8.  
  9. {$B-} {Complete Boolean Evaluation}
  10. {$I+} {Input/Output-Checking}
  11. {$P+} {Open Parameters}
  12. {$T-} {Typed @ Operator}
  13. {$W-} {Windows Stack Frame}
  14. {$X+} {Extended Syntax}
  15.  
  16. {$IFNDEF Win32}
  17. {$G+} {286 Instructions}
  18. {$N+} {Numeric Coprocessor}
  19.  
  20. {$C MOVEABLE,DEMANDLOAD,DISCARDABLE}
  21. {$ENDIF}
  22.  
  23. unit EsCal;
  24.   {-calendar component}
  25.  
  26. interface
  27.  
  28. uses
  29.   {$IFDEF Win32} Windows, {$ELSE} WinTypes, WinProcs, {$ENDIF}
  30.   Buttons, Classes, Controls, Graphics, Forms, Menus, Messages, SysUtils,
  31.   EsBase, EsData, EsUtil;
  32.  
  33. type
  34.   TEsDateFormat   = (dfShort, dfLong);
  35.   TEsDayNameWidth = 1..3;
  36.   TEsDayType = (dtSunday, dtMonday, dtTuesday, dtWednesday,
  37.                 dtThursday, dtFriday, dtSaturday);
  38.  
  39. const
  40.   {$IFDEF Win32}
  41.   calDefBorderStyle       = bsNone;
  42.   {$ELSE}
  43.   calDefBorderStyle       = bsSingle;
  44.   {$ENDIF Win32}
  45.   calDefColor             = clBtnFace;                                 {!!.01}
  46.   calDefDateFormat        = dfLong;
  47.   calDefDayNameWidth      = 3;
  48.   {$IFDEF Win32}
  49.   calDefHeight            = 140;
  50.   {$ELSE}
  51.   calDefHeight            = 200;
  52.   {$ENDIF Win32}
  53.   calDefShowDate          = True;
  54.   calDefShowInactive      = False;
  55.   calDefShowToday         = True;
  56.   calDefTabStop           = True;
  57.   calDefWeekStarts        = dtSunday;
  58.   {$IFDEF Win32}
  59.   calDefWidth             = 200;
  60.   {$ELSE}
  61.   calDefWidth             = 240;
  62.   {$ENDIF Win32}
  63.   calMargin               = 4;        {left, right, and top margin}
  64.  
  65. type
  66.   TEsCalColorArray = array[0..5] of TColor;
  67.   TEsCalColorScheme = (csCustom, csWindows, csGold, csOcean, csRose);
  68.   TEsCalSchemeArray = array[TEsCalColorScheme] of TEsCalColorArray;
  69.  
  70. const
  71.   {ActiveDay, DayNames, Days, InactiveDays, MonthAndYear, Weekend}
  72.   CalScheme : TEsCalSchemeArray =
  73.     ((0, 0, 0, 0, 0, 0),
  74.      (clRed,   clMaroon, clBlack,   clGray, clBlue,  clRed),
  75.      (clBlack, clBlack,  clYellow,  clGray, clBlack, clTeal),
  76.      (clBlack, clBlack,  clAqua,    clGray, clBlack, clNavy),
  77.      (clRed,   clRed,    clFuchsia, clGray, clBlue,  clTeal)
  78.     );
  79.  
  80. type
  81.   TEsCalColors = class(TPersistent)
  82.   private
  83.     {.Z+}
  84.     {property variables}
  85.     FUpdating     : Boolean;
  86.     FOnChange     : TNotifyEvent;
  87.  
  88.     {internal variables}
  89.     SettingScheme : Boolean;
  90.  
  91.     {internal methods}
  92.     procedure DoOnChange;
  93.  
  94.     {property methods}
  95.     function GetColor(Index : Integer) : TColor;
  96.     procedure SetColor(Index : Integer; Value : TColor);
  97.     procedure SetColorScheme(Value : TEsCalColorScheme);
  98.     {.Z-}
  99.  
  100.   public
  101.     {.Z+}
  102.     {public property variables}
  103.     FCalColors    : TEsCalColorArray;
  104.     FColorScheme  : TEsCalColorScheme;
  105.  
  106.     procedure Assign(Source : TPersistent);
  107.       override;
  108.     procedure BeginUpdate;
  109.     procedure EndUpdate;
  110.  
  111.     property OnChange : TNotifyEvent
  112.       read FOnChange
  113.       write FOnChange;
  114.     {.Z-}
  115.  
  116.   published
  117.     property ActiveDay : TColor index 0
  118.       read GetColor
  119.       write SetColor;
  120.  
  121.     property ColorScheme : TEsCalColorScheme
  122.       read FColorScheme
  123.       write SetColorScheme;
  124.  
  125.     property DayNames : TColor index 1
  126.       read GetColor
  127.       write SetColor;
  128.  
  129.     property Days : TColor index 2
  130.       read GetColor
  131.       write SetColor;
  132.  
  133.     property InactiveDays : TColor index 3
  134.       read GetColor
  135.       write SetColor;
  136.  
  137.     property MonthAndYear : TColor index 4
  138.       read GetColor
  139.       write SetColor;
  140.  
  141.     property Weekend : TColor index 5
  142.       read GetColor
  143.       write SetColor;
  144.   end;
  145.  
  146. type
  147.   TDateChangeEvent = procedure(Sender : TObject; Date : TDateTime)
  148.     of object;
  149.  
  150.   TEsCustomCalendar = class(TEsBase)
  151.   protected {private}
  152.     {.Z+}
  153.     {property variables}
  154.     FBrowsing      : Boolean;                                            {!!.04}
  155.     FColors        : TEsCalColors;
  156.     FDate          : TDateTime;
  157.     FDateFormat    : TEsDateFormat;
  158.     FDayNameWidth  : TEsDayNameWidth;
  159.     FShowDate      : Boolean;        {true to draw day name header}
  160.     FShowInactive  : Boolean;
  161.     FShowToday     : Boolean;
  162.     FBorderStyle   : TBorderStyle;   {border style}
  163.     FWeekStarts    : TEsDayType;     {the day that begins the week}
  164.  
  165.     {event variables}
  166.     FOnChange      : TDateChangeEvent;
  167.  
  168.     {internal variables}
  169.     clBtnLeft      : TSpeedButton;
  170.     clBtnRight     : TSpeedButton;
  171.     clBtnToday     : TSpeedButton;
  172.     clInPopup      : Boolean;                                         {!!.02}
  173.     clBtnNextYear  : TSpeedButton;                                    {!!.02}
  174.     clBtnPrevYear  : TSpeedButton;                                    {!!.02}
  175.  
  176.     clCalendar     : array[1..42] of Byte;        {current month grid}
  177.     clDay          : Word;
  178.     clFirst        : Byte;            {index for first day in current month}
  179.     clLast         : Byte;            {index for last day in current month}
  180.     clMonth        : Word;
  181.     clRowCol       : array[0..7, 0..6] of TRect;  {cell TRect info}
  182.     cSettingScheme : Boolean;
  183.     clYear         : Word;
  184.     clWidth        : Integer;          {client width - margins}
  185.     clPopup        : Boolean;          {true if being created as a popup}
  186.  
  187.     {property methods}
  188.     procedure SetBorderStyle(Value : TBorderStyle);
  189.     procedure SetDate(Value : TDateTime);
  190.     procedure SetDateFormat(Value : TEsDateFormat);
  191.     procedure SetDayNameWidth(Value : TEsDayNameWidth);
  192.     procedure SetShowDate(Value : Boolean);
  193.     procedure SetShowInactive(Value : Boolean);
  194.     procedure SetShowToday(Value : Boolean);
  195.     procedure SetWeekStarts(Value : TEsDayType);
  196.  
  197.     {internal methods}
  198.     procedure calBtnClick(Sender : TObject);
  199.     procedure calChangeMonth(Sender : TObject);
  200.     procedure calColorChange(Sender : TObject);
  201.     function calGetCurrentRectangle : TRect;
  202.     procedure calRebuildCalArray;
  203.     procedure calRecalcSize;
  204.  
  205.     {VCL control methods}
  206.     procedure CMCtl3DChanged(var Msg : TMessage);
  207.       message CM_CTL3DCHANGED;
  208.     procedure CMEnter(var Msg : TMessage);
  209.       message CM_ENTER;
  210.     procedure CMExit(var Msg : TMessage);
  211.       message CM_EXIT;
  212.     procedure CMFontChanged(var Msg : TMessage);
  213.       message CM_FONTCHANGED;
  214.  
  215.     {windows message methods}
  216.     procedure WMEraseBkgnd(var Msg : TWMEraseBkgnd);
  217.       message WM_ERASEBKGND;
  218.     procedure WMGetDlgCode(var Msg : TWMGetDlgCode);
  219.       message WM_GETDLGCODE;
  220.     {.Z-}
  221.  
  222.   protected
  223.     {.Z+}
  224.     procedure CreateParams(var Params : TCreateParams);
  225.       override;
  226.     procedure CreateWnd;
  227.       override;
  228.     procedure DoOnChange(Value : TDateTime);
  229.       dynamic;
  230.     {$IFDEF NeedMouseWheel}                                    {!!.05}
  231.     procedure DoOnMouseWheel(Shift : TShiftState; Delta, XPos, YPos : SmallInt);
  232.       override;
  233.     {$ELSE}                                                    {!!.05}
  234.     {$IFNDEF Windows}                                          {!!.05}
  235.     function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean;
  236.       override;                                                {!!.05}
  237.     {$ENDIF}                                                   {!!.05}
  238.     {$ENDIF}                                                   {!!.05}
  239.     procedure KeyDown(var Key : Word; Shift : TShiftState);
  240.       override;
  241.     procedure KeyPress(var Key : Char);
  242.       override;
  243.     procedure MouseDown(Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
  244.       override;
  245.     procedure MouseUp(Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
  246.       override;
  247.     procedure Paint;
  248.       override;
  249.     {.Z-}
  250.   public
  251.     {.Z+}
  252.     constructor Create(AOwner : TComponent);
  253.       override;
  254.     constructor CreateEx(AOwner : TComponent; AsPopup : Boolean);
  255.       virtual;
  256.     destructor Destroy;
  257.       override;
  258.     procedure SetBounds(ALeft, ATop, AWidth, AHeight : Integer);       {!!.05}
  259.       override;
  260.     {.Z-}
  261.  
  262.     {properties}
  263.     property BorderStyle : TBorderStyle
  264.       read FBorderStyle
  265.       write SetBorderStyle
  266.       default calDefBorderStyle;
  267.  
  268.     {!!.04}
  269.     property Browsing : Boolean
  270.       read FBrowsing;
  271.  
  272.     property Colors : TEsCalColors
  273.       read FColors
  274.       write FColors;
  275.  
  276.     property DayNameWidth : TEsDayNameWidth
  277.       read FDayNameWidth
  278.       write SetDayNameWidth
  279.       default calDefDayNameWidth;
  280.  
  281.     property Date : TDateTime
  282.       read FDate
  283.       write SetDate;
  284.  
  285.     property DateFormat : TEsDateFormat
  286.       read FDateFormat
  287.       write SetDateFormat
  288.       default calDefDateFormat;
  289.  
  290.     property ShowDate : Boolean
  291.       read FShowDate
  292.       write SetShowDate
  293.       default calDefShowDate;
  294.  
  295.     property ShowInactive : Boolean
  296.       read FShowInactive
  297.       write SetShowInactive
  298.       default calDefShowInactive;
  299.  
  300.     property ShowToday : Boolean
  301.       read FShowToday
  302.       write SetShowToday
  303.       default calDefShowToday;
  304.  
  305.     property WeekStarts : TEsDayType
  306.       read FWeekStarts
  307.       write SetWeekStarts
  308.       default calDefWeekStarts;
  309.  
  310.     {events}
  311.     property OnChange : TDateChangeEvent
  312.       read FOnChange
  313.       write FOnChange;
  314.   end;
  315.  
  316.  
  317.   TEsCalendar = class(TEsCustomCalendar)
  318.   published
  319.     {properties}
  320.     property Align;
  321.     property BorderStyle;
  322.     property Colors;
  323.     property Ctl3D;
  324.     property Cursor;
  325.     property DayNameWidth;
  326.     property DateFormat;
  327.     property DragCursor;
  328.     property DragMode;
  329.     property Enabled;
  330.     property EsLabelInfo;
  331.     property Font;
  332.     property ParentCtl3D;
  333.     property ParentFont;
  334.     property ParentShowHint;
  335.     property PopupMenu;
  336.     property ShowDate;
  337.     property ShowHint;
  338.     property ShowInactive;
  339.     property ShowToday;
  340.     property TabOrder;
  341.     property TabStop default calDefTabStop;
  342.     property Version;
  343.     property Visible;
  344.     property WeekStarts;
  345.  
  346.     {events}
  347.     property OnChange;
  348.     property OnDblClick;
  349.     property OnDragDrop;
  350.     property OnDragOver;
  351.     property OnEndDrag;
  352.     property OnEnter;
  353.     property OnExit;
  354.     property OnKeyDown;
  355.     property OnKeyPress;
  356.     property OnKeyUp;
  357.     property OnMouseDown;
  358.     property OnMouseMove;
  359.     property OnMouseUp;
  360.     {$IFNDEF NeedMouseWheel}                                   {!!.05}
  361.     {$IFNDEF Windows}                                          {!!.05}
  362.     property OnMouseWheelDown;                                 {!!.05}
  363.     property OnMouseWheelUp;                                   {!!.05}
  364.     {$ENDIF}                                                   {!!.05}
  365.     {$ENDIF}                                                   {!!.05}
  366.     {$IFDEF Win32}
  367.     property OnStartDrag;
  368.     {$ENDIF Win32}
  369.   end;
  370.  
  371.  
  372. implementation
  373.  
  374.  
  375. {$IFDEF TRIALRUN}
  376. uses
  377.   EsTrial;
  378. {$I ESTRIALF.INC}
  379. {$ENDIF}
  380.  
  381.  
  382. {*** TEsCalColors ***}
  383.  
  384. procedure TEsCalColors.Assign(Source : TPersistent);
  385. begin
  386.   if Source is TEsCalColors then begin
  387.     FCalColors := TEsCalColors(Source).FCalColors;
  388.     FColorScheme := TEsCalColors(Source).FColorScheme;
  389.   end else
  390.     inherited Assign(Source);
  391. end;
  392.  
  393. procedure TEsCalColors.BeginUpdate;
  394. begin
  395.   FUpdating := True;
  396. end;
  397.  
  398. procedure TEsCalColors.EndUpdate;
  399. begin
  400.   FUpdating := False;
  401.   DoOnChange;
  402. end;
  403.  
  404. procedure TEsCalColors.DoOnChange;
  405. begin
  406.   if not FUpdating and Assigned(FOnChange) then
  407.     FOnChange(Self);
  408.  
  409.   if not SettingScheme then
  410.     FColorScheme := csCustom;
  411. end;
  412.  
  413. function TEsCalColors.GetColor(Index : Integer) : TColor;
  414. begin
  415.   Result := FCalColors[Index];
  416. end;
  417.  
  418. procedure TEsCalColors.SetColor(Index : Integer; Value : TColor);
  419. begin
  420.   if Value <> FCalColors[Index] then begin
  421.     FCalColors[Index] := Value;
  422.     DoOnChange;
  423.   end;
  424. end;
  425.  
  426. procedure TEsCalColors.SetColorScheme(Value : TEsCalColorScheme);
  427. begin
  428.   if Value <> FColorScheme then begin
  429.     SettingScheme := True;
  430.     try
  431.       FColorScheme := Value;
  432.       if Value <> csCustom then begin
  433.         FCalColors := CalScheme[Value];
  434.         DoOnChange;
  435.       end;
  436.     finally
  437.       SettingScheme := False;
  438.     end;
  439.   end;
  440. end;
  441.  
  442.  
  443. {*** TEsCustomCalendar ***}
  444.  
  445. procedure TEsCustomCalendar.calBtnClick(Sender : TObject);
  446. var
  447.   Key : Word;
  448. begin
  449.   Key := 0;
  450.   if Sender = clBtnLeft then begin
  451.     Key := VK_PRIOR;
  452.     KeyDown(Key, []);
  453.   end else if Sender = clBtnRight then begin
  454.     Key := VK_NEXT;
  455.     KeyDown(Key, []);
  456.   end else if (Sender = clBtnToday) and (SysUtils.Date <> FDate) then begin
  457.     SetDate(SysUtils.Date);
  458.     DoOnChange(FDate);
  459.   end else if Sender = clBtnNextYear then begin                        {!!.02}
  460.     Key := VK_NEXT;
  461.     KeyDown(Key, [ssCtrl]);
  462.   end else if Sender = clBtnPrevYear then begin                        {!!.02}
  463.     Key := VK_PRIOR;
  464.     KeyDown(Key, [ssCtrl]);
  465.   end;
  466. end;
  467.  
  468. procedure TEsCustomCalendar.calChangeMonth(Sender : TObject);
  469. var
  470.   Y  : Word;
  471.   M  : Word;
  472.   D  : Word;
  473.   MO : Integer;
  474.   MI : TMenuItem;
  475. begin
  476.   MI := (Sender as TMenuItem);
  477.   DecodeDate(FDate, Y, M, D);
  478.   MO := MI.Tag;
  479.   {set month and year}
  480.   if (MO > M) and (MI.HelpContext < 3) then
  481.     Dec(Y)
  482.   else if (MO < M) and (MI.HelpContext > 3) then
  483.     Inc(Y);
  484.   M := M + MO;
  485.   {set day}
  486.   if D > DaysInMonth(Y, MO) then
  487.     D := DaysInMonth(Y, MO);
  488.   SetDate(EncodeDate(Y, MO, D));
  489. end;
  490.  
  491. procedure TEsCustomCalendar.calColorChange(Sender : TObject);
  492. begin
  493.   Invalidate;
  494. end;
  495.  
  496. function TEsCustomCalendar.calGetCurrentRectangle : TRect;
  497.   {-get bounding rectangle for the current date}
  498. var
  499.   Idx  : Integer;
  500.   R, C : Integer;
  501. begin
  502.   {index into the month grid}
  503.   Idx := clFirst + Pred(clDay) + 13;
  504.   R := (Idx div 7);
  505.   C := (Idx mod 7);
  506.   Result := clRowCol[R,C];
  507. end;
  508.  
  509. procedure TEsCustomCalendar.calRebuildCalArray;
  510. var
  511.   Day1 : TEsDayType;
  512.   I, J : Integer;
  513. begin
  514.   HandleNeeded;                                                        {!!.04}
  515.   DecodeDate(FDate, clYear, clMonth, clDay);
  516.  
  517.   {get the first day of the current month and year}
  518.   Day1 := TEsDayType(DayOfWeek(EncodeDate(clYear, clMonth, 1))-1);
  519.  
  520.   {find its index}
  521.   I := Byte(Day1) - Byte(WeekStarts) + 1;
  522.   if I < 1 then
  523.     Inc(I, 7);
  524.   clFirst := I;
  525.  
  526.   {find the index of the last day in the month}
  527.   clLast := clFirst+DaysInMonth(clYear, clMonth) - 1;
  528.  
  529.   {initialize the first part of the calendar}
  530.   if clMonth = 1 then
  531.     J := DaysInMonth(clYear-1, 12)
  532.   else
  533.     J := DaysInMonth(clYear, clMonth-1);
  534.   for I := clFirst-1 downto 1 do begin
  535.     clCalendar[I] := J;
  536.     Dec(J);
  537.   end;
  538.  
  539.   {initialize the rest of the calendar}
  540.   J := 1;
  541.   for I := clFirst to 42 do begin
  542.     clCalendar[I] := J;
  543.     if I = clLast then
  544.       J := 1
  545.     else
  546.       Inc(J);
  547.   end;
  548. end;
  549.  
  550. procedure TEsCustomCalendar.calRecalcSize;
  551.   {-calcualte new sizes for rows and columns}
  552. var
  553.   R   : Integer;
  554.   C   : Integer;
  555.   D1  : Integer;
  556.   D2  : Integer;
  557.   CH  : Integer;
  558.   RH  : Integer;
  559.   Row : array[0..7] of Integer;
  560.   Col : array[0..6] of Integer;
  561.  
  562.   function SumOf(A : array of Integer; First, Last : Integer) : Integer;
  563.   var
  564.     I : Integer;
  565.   begin
  566.     Result := 0;
  567.     for I := First to Last do
  568.       Result := Result  + A[I];
  569.   end;
  570.  
  571. begin
  572.   if not HandleAllocated then
  573.     Exit;
  574.  
  575.   {clear row/col position structure}
  576.   FillChar(clRowCol, SizeOf(clRowCol), #0);
  577.  
  578.   clWidth := ClientWidth - 2*calMargin;
  579.   {store row and column sizes}
  580.   for C := 0 to 6 do
  581.     Col[C] := clWidth div 7;
  582.  
  583.   Canvas.Font := Font;
  584.   Row[0] := Round(1.3 * Canvas.TextHeight('Yy')); {button and date row}
  585.   Row[1] := Round(1.5 * Canvas.TextHeight('Yy'));; {day name row}
  586.   CH := ClientHeight - 2*calMargin - Row[0] - Row[1];
  587.   RH := CH div 6;
  588.   for R := 2 to 7 do
  589.     Row[R] := RH;
  590.  
  591.   {distribute any odd horizontal space equally among the columns}
  592.   for C := 0 to clWidth mod 7 do
  593.     Inc(Col[C]);
  594.  
  595.   {distribute odd vertical space to top 2 rows}
  596.   D1 := 0;
  597.   for R := 0 to 7 do
  598.     D1 := D1 + Row[R];
  599.   D1 := ClientHeight - D1 - 2*calMargin;
  600.   D2 := D1 div 2;
  601.   D1 := D1 - D2;
  602.   Row[0] := Row[0] + D1;
  603.   Row[1] := Row[1] + D2;
  604.  
  605.   {initialize each cells TRect structure using}
  606.   {the row heights from the Row[] array and the}
  607.   {column widths from the Col[] array}
  608.   for R := 0 to 7 do begin
  609.     for C := 0 to 6 do begin
  610.       clRowCol[R,C].Left := SumOf(Col, 0, C-1) + calMargin;
  611.       clRowCol[R,C].Right := SumOf(Col, 0, C) + calMargin;
  612.       clRowCol[R,C].Top := SumOf(Row, 0, R-1) + calMargin;
  613.       clRowCol[R,C].Bottom := SumOf(Row, 0, R) + calMargin;
  614.     end;
  615.   end;
  616.  
  617.   {position and size the left and right month buttons}
  618.   clBtnLeft.Height := Row[0] - calMargin;
  619.   clBtnLeft.Width := Col[0] - calMargin;
  620.   if clBtnLeft.Width < clBtnLeft.Glyph.Width + 3 then
  621.     clBtnLeft.Width := clBtnLeft.Glyph.Width + 3;
  622.   clBtnLeft.Top := calMargin;
  623.   clBtnLeft.Left := calMargin;
  624.  
  625.   clBtnRight.Height := Row[0] - calMargin;
  626.   clBtnRight.Width := Col[6] - calMargin;
  627.   if clBtnRight.Width < clBtnRight.Glyph.Width + 3 then
  628.     clBtnRight.Width := clBtnRight.Glyph.Width + 3;
  629.   clBtnRight.Top := calMargin;
  630.   clBtnRight.Left := ClientWidth - calMargin - clBtnRight.Width;
  631.  
  632.   {!!.02}
  633.   {position and size the next and prev year buttons}
  634.   clBtnNextYear.Height := Row[0] - calMargin;
  635.   clBtnNextYear.Width := Col[1] - calMargin;
  636.   if clBtnNextYear.Width < clBtnNextYear.Glyph.Width + 3 then
  637.     clBtnNextYear.Width := clBtnNextYear.Glyph.Width + 3;
  638.   clBtnNextYear.Top := calMargin;
  639.   clBtnNextYear.Left := clBtnRight.Left - clBtnNextYear.Width;
  640.  
  641.   clBtnPrevYear.Height := Row[0] - calMargin;
  642.   clBtnPrevYear.Width := Col[5] - calMargin;
  643.   if clBtnPrevYear.Width < clBtnPrevYear.Glyph.Width + 3 then
  644.     clBtnPrevYear.Width := clBtnPrevYear.Glyph.Width + 3;
  645.   clBtnPrevYear.Top := calMargin;
  646.   clBtnPrevYear.Left := clBtnLeft.Left + clBtnLeft.Width;
  647.  
  648.   {position and size "today" button}
  649.   if Assigned(clBtnToday) then begin
  650.     clBtnToday.Height := Row[7];
  651.     clBtnToday.Width := Col[5] + Col[6] - calMargin;
  652.     clBtnToday.Top := ClientHeight - calMargin - clBtnToday.Height;
  653.     clBtnToday.Left := ClientWidth - calMargin - clBtnToday.Width;
  654.     clBtnToday.Glyph.Handle := LoadBitmap(HInstance, 'ESTODAY');
  655.   end;
  656. end;
  657.  
  658. procedure TEsCustomCalendar.CMCtl3DChanged(var Msg : TMessage);
  659. begin
  660.   inherited;
  661.  
  662.   if (csLoading in ComponentState) or not HandleAllocated then
  663.     Exit;
  664.  
  665.   {$IFDEF Win32}
  666.   if NewStyleControls and (FBorderStyle = bsSingle) then
  667.     RecreateWnd;
  668.   {$ENDIF}
  669.  
  670.   Invalidate;
  671. end;
  672.  
  673. procedure TEsCustomCalendar.CMEnter(var Msg : TMessage);
  674. var
  675.   R : TRect;
  676. begin
  677.   inherited;
  678.  
  679.   {invalidate the active date to ensure that the focus rect is painted}
  680.   R := calGetCurrentRectangle;
  681.   InvalidateRect(Handle, @R, False);
  682. end;
  683.  
  684. procedure TEsCustomCalendar.CMExit(var Msg : TMessage);
  685. var
  686.   R : TRect;
  687. begin
  688.   inherited;
  689.  
  690.   {invalidate the active date to ensure that the focus rect is painted}
  691.   R := calGetCurrentRectangle;
  692.   InvalidateRect(Handle, @R, False);
  693. end;
  694.  
  695. procedure TEsCustomCalendar.CMFontChanged(var Msg : TMessage);
  696. begin
  697.   inherited;
  698.  
  699.   if csLoading in ComponentState then
  700.     Exit;
  701.  
  702.   calRecalcSize;
  703.   Invalidate;
  704. end;
  705.  
  706. constructor TEsCustomCalendar.Create(AOwner : TComponent);
  707. begin
  708.   inherited Create(AOwner);
  709.  
  710.   ControlStyle := ControlStyle + [csClickEvents, csFramed] - [csCaptureMouse];
  711.  
  712.   Height        := calDefHeight;
  713.   TabStop       := calDefTabStop;
  714.   Width         := calDefWidth;
  715.  
  716.   FBorderStyle  := calDefBorderStyle;
  717.   FDayNameWidth := calDefDayNameWidth;
  718.   FDateFormat   := calDefDateFormat;
  719.   FShowDate     := calDefShowDate;
  720.   FShowInactive := calDefShowInactive;
  721.   FShowToday    := calDefShowToday;
  722.   FWeekStarts   := calDefWeekStarts;
  723.  
  724.   {create navigation buttons}
  725.   clBtnLeft := TSpeedButton.Create(Self);
  726.   clBtnLeft.Parent := Self;
  727.   clBtnLeft.Glyph.Handle := LoadBitmap(HInstance, 'ESLEFTARROW');
  728.   clBtnLeft.OnClick := calBtnClick;
  729.  
  730.   clBtnRight := TSpeedButton.Create(Self);
  731.   clBtnRight.Parent := Self;
  732.   clBtnRight.Glyph.Handle := LoadBitmap(HInstance, 'ESRIGHTARROW');
  733.   clBtnRight.OnClick := calBtnClick;
  734.  
  735.   {!!.02}
  736.   clBtnNextYear := TSpeedButton.Create(Self);
  737.   clBtnNextYear.Parent := Self;
  738.   clBtnNextYear.Glyph.Handle := LoadBitmap(HInstance, 'ESRIGHTARROWS');
  739.   clBtnNextYear.OnClick := calBtnClick;
  740.  
  741.   clBtnPrevYear := TSpeedButton.Create(Self);
  742.   clBtnPrevYear.Parent := Self;
  743.   clBtnPrevYear.Glyph.Handle := LoadBitmap(HInstance, 'ESLEFTARROWS');
  744.   clBtnPrevYear.OnClick := calBtnClick;
  745.  
  746.   FColors := TEsCalColors.Create;
  747.   FColors.OnChange := calColorChange;
  748.  
  749.   if FShowToday then begin
  750.     {create "today" button}
  751.     clBtnToday := TSpeedButton.Create(Self);
  752.     clBtnToday.Parent := Self;
  753.     clBtnToday.OnClick := calBtnClick;
  754.   end;
  755.  
  756.   {assign default color scheme}
  757.   FColors.FCalColors := CalScheme[csWindows];
  758. end;
  759.  
  760. constructor TEsCustomCalendar.CreateEx(AOwner : TComponent; AsPopup : Boolean);
  761. begin
  762.   clPopup := AsPopup;
  763.   Create(AOwner);
  764. end;
  765.  
  766. procedure TEsCustomCalendar.CreateParams(var Params : TCreateParams);
  767. const
  768.   BorderStyles : array[TBorderStyle] of DWord = (0, WS_BORDER);        {!!.05}
  769. begin
  770.   inherited CreateParams(Params);
  771.  
  772.   with Params do begin
  773.     Style := Style or BorderStyles[FBorderStyle];
  774.     {!!.02} {block revised}
  775.     if clPopup then begin
  776.       Style := WS_POPUP or WS_BORDER;
  777.       WindowClass.Style := WindowClass.Style or CS_SAVEBITS;
  778.       {$IFDEF Win32}
  779.       Ctl3D := False;
  780.       if NewStyleControls then
  781.         ExStyle := WS_EX_TOOLWINDOW or WS_EX_CLIENTEDGE;
  782.       {$ENDIF Win32}
  783.     end;
  784.   end;
  785.  
  786.   {$IFDEF Win32}
  787.   if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then begin
  788.     Params.Style := Params.Style and not WS_BORDER;
  789.     Params.ExStyle := Params.ExStyle or WS_EX_CLIENTEDGE;
  790.   end;
  791.   {$ENDIF}
  792. end;
  793.  
  794. procedure TEsCustomCalendar.CreateWnd;
  795. {$IFDEF TRIALRUN}
  796. var
  797.   X : Integer;
  798. {$ENDIF}
  799. begin
  800.   inherited CreateWnd;
  801.  
  802.   calRecalcSize;
  803.  
  804.   {if not set, get current date}
  805.   if FDate = 0 then
  806.     SetDate(SysUtils.Date);
  807.  
  808. {$IFDEF TRIALRUN}
  809.   X := _CC_;
  810.   if (X < ccRangeLow) or (X > ccRangeHigh) then Halt;
  811.   X := _VC_;
  812.   if (X < ccRangeLow) or (X > ccRangeHigh) then Halt;
  813. {$ENDIF}
  814. end;
  815.  
  816. destructor TEsCustomCalendar.Destroy;
  817. begin
  818.   FColors.Free;
  819.   FColors := nil;
  820.  
  821.   inherited Destroy;
  822. end;
  823.  
  824. procedure TEsCustomCalendar.DoOnChange(Value : TDateTime);
  825. begin
  826.   if Assigned(FOnChange) then
  827.     FOnChange(Self, Value);
  828. end;
  829.  
  830. {$IFDEF NeedMouseWheel}                                        {!!.05}
  831. procedure TEsCustomCalendar.DoOnMouseWheel(Shift : TShiftState; Delta, XPos, YPos : SmallInt);
  832. var
  833.   Key : Word;
  834. begin
  835.   inherited DoOnMouseWheel(Shift, Delta, XPos, YPos);
  836.  
  837.   if Abs(Delta) = WHEEL_DELTA then begin
  838.     {inc/dec month}
  839.     if Delta < 0 then
  840.       Key := VK_NEXT
  841.     else
  842.       Key := VK_PRIOR;
  843.     KeyDown(Key, []);
  844.   end else if Abs(Delta) > WHEEL_DELTA then begin
  845.     {inc/dec year}
  846.     if Delta < 0 then
  847.       Key := VK_NEXT
  848.     else
  849.       Key := VK_PRIOR;
  850.     KeyDown(Key, [ssCtrl]);
  851.   end else if Abs(Delta) < WHEEL_DELTA then begin
  852.     {inc/dec Week}
  853.     if Delta < 0 then
  854.       Key := VK_DOWN
  855.     else
  856.       Key := VK_UP;
  857.     KeyDown(Key, []);
  858.   end;
  859. end;
  860. {$ELSE}                                                        {!!.05}
  861. {$IFNDEF Windows}                                              {!!.05}
  862. function TEsCustomCalendar.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean;
  863.                                                      {added for !!.05}
  864. var
  865.   Key : Word;
  866. begin
  867.   // we always return true - if there's an event handler that returns
  868.   // false, we'll do the work; if it returns true, the work has been
  869.   // done, ergo this routine should return true.
  870.   Result := true;
  871.   if not inherited DoMouseWheel(Shift, WheelDelta, MousePos) then begin
  872.     if Abs(WheelDelta) = WHEEL_DELTA then begin
  873.       {inc/dec month}
  874.       if WheelDelta < 0 then
  875.         Key := VK_NEXT
  876.       else
  877.         Key := VK_PRIOR;
  878.       KeyDown(Key, []);
  879.     end else if Abs(WheelDelta) > WHEEL_DELTA then begin
  880.       {inc/dec year}
  881.       if WheelDelta < 0 then
  882.         Key := VK_NEXT
  883.       else
  884.         Key := VK_PRIOR;
  885.       KeyDown(Key, [ssCtrl]);
  886.     end else if Abs(WheelDelta) < WHEEL_DELTA then begin
  887.       {inc/dec Week}
  888.       if WheelDelta < 0 then
  889.         Key := VK_DOWN
  890.       else
  891.         Key := VK_UP;
  892.       KeyDown(Key, []);
  893.     end;
  894.   end;
  895. end;
  896. {$ENDIF}                                                       {!!.05}
  897. {$ENDIF}                                                       {!!.05}
  898.  
  899. procedure TEsCustomCalendar.KeyDown(var Key : Word; Shift : TShiftState);
  900. var
  901.   Y  : Word;
  902.   M  : Word;
  903.   D  : Word;
  904.   HD : TDateTime;                                                      {!!.04}
  905. begin
  906.   inherited KeyDown(Key, Shift);
  907.  
  908.   HD := FDate;                                                         {!!.04}
  909.   case Key of
  910.     VK_LEFT  : if Shift = [] then
  911.                  SetDate(FDate-1);
  912.     VK_RIGHT : if Shift = [] then
  913.                  SetDate(FDate+1);
  914.     VK_UP    : if Shift = [] then
  915.                  SetDate(FDate-7);
  916.     VK_DOWN  : if Shift = [] then
  917.                  SetDate(FDate+7);
  918.     VK_HOME  :
  919.       begin
  920.         if Shift = [] then begin
  921.           DecodeDate(FDate, Y, M, D);
  922.           SetDate(EncodeDate(Y, M, 1));
  923.         end;
  924.       end;
  925.     VK_END   :
  926.       begin
  927.         if Shift = [] then begin
  928.           DecodeDate(FDate, Y, M, D);
  929.           SetDate(EncodeDate(Y, M, DaysInMonth(Y, M)));
  930.         end;
  931.       end;
  932.     VK_PRIOR :
  933.       begin
  934.         DecodeDate(FDate, Y, M, D);
  935.         if ssCtrl in Shift then begin
  936.           DecodeDate(FDate, Y, M, D);
  937.           Dec(Y);
  938.           if D > DaysInMonth(Y, M) then
  939.             D := DaysInMonth(Y, M);
  940.           SetDate(EncodeDate(Y, M, D));
  941.         end else if Shift = [] then begin
  942.           Dec(M);
  943.           if M < 1 then begin
  944.             M := 12;
  945.             Dec(Y);
  946.           end;
  947.           if D > DaysInMonth(Y, M) then
  948.             D := DaysInMonth(Y, M);
  949.           SetDate(EncodeDate(Y, M, D));
  950.         end;
  951.       end;
  952.     VK_NEXT :
  953.       begin
  954.         DecodeDate(FDate, Y, M, D);
  955.         if ssCtrl in Shift then begin
  956.           Inc(Y);
  957.           if D > DaysInMonth(Y, M) then
  958.             D := DaysInMonth(Y, M);
  959.           SetDate(EncodeDate(Y, M, D));
  960.         end else if Shift = [] then begin
  961.           Inc(M);
  962.           if M > 12 then begin
  963.             M := 1;
  964.             Inc(Y);
  965.           end;
  966.           if D > DaysInMonth(Y, M) then
  967.             D := DaysInMonth(Y, M);
  968.           SetDate(EncodeDate(Y, M, D));
  969.         end;
  970.       end;
  971.     VK_BACK :
  972.       begin
  973.         if ssAlt in Shift then
  974.           SetDate(SysUtils.Date);        {return to today's date}
  975.       end;
  976.   end;
  977.  
  978.   {!!.04}
  979.   if HD <> FDate then begin
  980.       FBrowsing := True;
  981.     try
  982.       DoOnChange(FDate);
  983.     finally
  984.       FBrowsing := False;
  985.     end;
  986.   end;
  987. end;
  988.  
  989. procedure TEsCustomCalendar.KeyPress(var Key : Char);
  990. begin
  991.   inherited KeyPress(Key);
  992.  
  993.   case Key of
  994.     #13 : DoOnChange(FDate);       {date selected}
  995.     #32 : DoOnChange(FDate);       {date selected}
  996.     ^Z  : SetDate(SysUtils.Date);  {return to today's date}
  997.   end;
  998. end;
  999.  
  1000. procedure TEsCustomCalendar.MouseDown(Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
  1001. var
  1002.   Yr     : Word;
  1003.   M      : Word;
  1004.   D      : Word;
  1005.   Yr2    : Word;
  1006.   M2     : Word;
  1007.   D2     : Word;
  1008.   R, C   : Integer;
  1009.   OldIdx : Integer;
  1010.   NewIdx : Integer;
  1011.   Re     : TRect;
  1012.   Ignore : Boolean;
  1013. begin
  1014.   {exit if this click happens when the popup menu is active}           {!!.02}
  1015.   if clInPopup then                                                    {!!.02}
  1016.     Exit;                                                              {!!.02}
  1017.  
  1018.   SetFocus;
  1019.  
  1020.   inherited MouseDown(Button, Shift, X, Y);
  1021.  
  1022.   {if we have the mouse captured, see if a button was clicked}
  1023.   if GetCapture = Handle then begin
  1024.     Re := clBtnLeft.ClientRect;
  1025.     Re.TopLeft := ScreenToClient(clBtnLeft.ClientToScreen(Re.TopLeft));
  1026.     Re.BottomRight := ScreenToClient(clBtnLeft.ClientToScreen(Re.BottomRight));
  1027.     if PtInRect(Re, Point(X, Y)) then begin
  1028.       clBtnLeft.Click;
  1029.       Exit;
  1030.     end;
  1031.  
  1032.     Re := clBtnRight.ClientRect;
  1033.     Re.TopLeft := ScreenToClient(clBtnRight.ClientToScreen(Re.TopLeft));
  1034.     Re.BottomRight := ScreenToClient(clBtnRight.ClientToScreen(Re.BottomRight));
  1035.     if PtInRect(Re, Point(X, Y)) then begin
  1036.       clBtnRight.Click;
  1037.       Exit;
  1038.     end;
  1039.  
  1040.     {!!.02}
  1041.     Re := clBtnNextYear.ClientRect;
  1042.     Re.TopLeft := ScreenToClient(clBtnNextYear.ClientToScreen(Re.TopLeft));
  1043.     Re.BottomRight := ScreenToClient(clBtnNextYear.ClientToScreen(Re.BottomRight));
  1044.     if PtInRect(Re, Point(X, Y)) then begin
  1045.       clBtnNextYear.Click;
  1046.       Exit;
  1047.     end;
  1048.  
  1049.     {!!.02}
  1050.     Re := clBtnPrevYear.ClientRect;
  1051.     Re.TopLeft := ScreenToClient(clBtnPrevYear.ClientToScreen(Re.TopLeft));
  1052.     Re.BottomRight := ScreenToClient(clBtnPrevYear.ClientToScreen(Re.BottomRight));
  1053.     if PtInRect(Re, Point(X, Y)) then begin
  1054.       clBtnPrevYear.Click;
  1055.       Exit;
  1056.     end;
  1057.  
  1058.     if Assigned(clBtnToday) then begin
  1059.       Re := clBtnToday.ClientRect;
  1060.       Re.TopLeft := ScreenToClient(clBtnToday.ClientToScreen(Re.TopLeft));
  1061.       Re.BottomRight := ScreenToClient(clBtnToday.ClientToScreen(Re.BottomRight));
  1062.       if PtInRect(Re, Point(X, Y)) then begin
  1063.         clBtnToday.Click;
  1064.         Exit;
  1065.       end;
  1066.     end;
  1067.   end;
  1068.  
  1069.   {save current date}
  1070.   DecodeDate(FDate, Yr, M, D);
  1071.  
  1072.   {calculate the row and column clicked on}
  1073.   for R := 2 to 7 do begin
  1074.     for C := 0 to 6 do begin
  1075.       if PtInRect(clRowCol[R,C], Point(X, Y)) then begin
  1076.         {convert to an index}
  1077.         NewIdx := ((R-2) * 7) + Succ(C);
  1078.         OldIdx := clFirst + Pred(clDay);
  1079.         Ignore := False;
  1080.         if NewIdx <> OldIdx then begin
  1081.           if not FShowInactive then begin
  1082.             DecodeDate(FDate+(NewIdx-OldIdx), Yr2, M2, D2);
  1083.             {will this change the month?}
  1084.             if M2 <> M then
  1085.               Ignore := True;
  1086.           end;
  1087.           {convert to a date and redraw}
  1088.           if not Ignore then
  1089.             SetDate(FDate+(NewIdx-OldIdx));
  1090.         end;
  1091.  
  1092.         if (not Ignore) and (Button = mbLeft) then                     {!!.04}
  1093.           DoOnChange(FDate);
  1094.  
  1095.         Break;
  1096.       end;
  1097.     end;
  1098.   end;
  1099. end;
  1100.  
  1101. procedure TEsCustomCalendar.MouseUp(Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
  1102. var
  1103.   P  : TPoint;
  1104.   M  : TPopUpMenu;
  1105.   MI : TMenuItem;
  1106.   I  : Integer;
  1107.   J  : Integer;
  1108.   K  : Integer;
  1109.   MO : Integer;
  1110.   YR : Word;
  1111.   MM : Word;
  1112.   DA : Word;
  1113.   HC : Boolean;
  1114. begin
  1115.   if not Focused and CanFocus then
  1116.     SetFocus;
  1117.  
  1118.   inherited MouseUp(Button, Shift, X, Y);
  1119.  
  1120.   if (PopUpMenu = nil) and (Button = mbRight) and
  1121.      (Y < clRowCol[1,0].Top) {above day names} and
  1122.      (X > clBtnPrevYear.Left + clBtnNextYear.Width) and                {!!.02}
  1123.      (X < clBtnNextYear.Left) then begin                               {!!.02}
  1124.     M := TPopupMenu.Create(Self);
  1125.     try
  1126.       DecodeDate(FDate, YR, MM, DA);
  1127.       MO := MM; {convert to integer to avoid wrap-around errors with words}
  1128.  
  1129.       {determine the starting month}
  1130.       I := MO - 3;
  1131.       if I < 1 then
  1132.         I := MO - 3 + 12;
  1133.  
  1134.       {determine the ending month + 1}
  1135.       J := MO + 4;
  1136.       if J > 12 then
  1137.         J := MO + 4 - 12;
  1138.  
  1139.       K := 0;
  1140.       {create the menu items}
  1141.       repeat
  1142.         MI := TMenuItem.Create(M);
  1143.         MI.Caption := LongMonthNames[I];
  1144.         MI.Enabled := Enabled;
  1145.         MI.OnClick := calChangeMonth;
  1146.         MI.Tag := I;
  1147.         MI.HelpContext := K;
  1148.         M.Items.Add(MI);
  1149.         Inc(I);
  1150.         Inc(K);
  1151.         if I > 12 then
  1152.           I := 1;
  1153.       until I = J;
  1154.  
  1155.       HC := GetCapture = Handle;
  1156.  
  1157.       P.X := X-20;
  1158.       P.Y := Y - ((GetSystemMetrics(SM_CYMENU)*7) div 2);
  1159.       P := ClientToScreen(P);
  1160.       {move the mouse to cause the menu item to highlight}
  1161.       PostMessage(Handle, WM_MOUSEMOVE, 0, MAKELONG(P.X,P.Y+1));
  1162.  
  1163.       clInPopup := True;                                               {!!.02}
  1164.       try                                                              {!!.02}
  1165.         M.PopUp(P.X, P.Y);
  1166.  
  1167.         Application.ProcessMessages;
  1168.  
  1169.         {capture the mouse again}
  1170.         if clPopup and HC then
  1171.           SetCapture(Handle);
  1172.       finally                                                          {!!.02}
  1173.         clInPopup := false;                                            {!!.02}
  1174.       end;                                                             {!!.02}
  1175.     finally
  1176.       M.Free;
  1177.     end;
  1178.   end;
  1179. end;
  1180.  
  1181. procedure TEsCustomCalendar.Paint;
  1182. var
  1183.   R, C     : Integer;
  1184.   I        : Integer;
  1185.   CurIndex : Integer;
  1186.   SatCol   : Integer;
  1187.   SunCol   : Integer;
  1188.   DOW      : TEsDayType;
  1189.  
  1190.   procedure DrawDate;
  1191.   var
  1192.     R : TRect;
  1193.     S : string;
  1194.   begin
  1195.     if FDateFormat = dfLong then
  1196.       S := FormatDateTime('mmmm yyyy', FDate)
  1197.     else
  1198.       S := FormatDateTime('mmm yyyy', FDate);
  1199.  
  1200.     R := clRowCol[0,1];
  1201.     R.Right := clRowCol[0,6].Left;
  1202.  
  1203.     {switch to short date format if string won't fit}
  1204.     if FDateFormat = dfLong then
  1205.       if Canvas.TextWidth(S) > R.Right-R.Left then
  1206.         S := FormatDateTime('mmm yyyy', FDate);
  1207.  
  1208.     Canvas.Font.Color := FColors.MonthAndYear;
  1209.     DrawText(Canvas.Handle, @S[1], Length(S), R,
  1210.       DT_SINGLELINE or DT_CENTER or DT_VCENTER);
  1211.   end;
  1212.  
  1213.   procedure DrawDayNames;
  1214.   var
  1215.     I : Integer;
  1216.     S : string[3];
  1217.   begin
  1218.     {draw the day name column labels}
  1219.     Canvas.Font.Color := FColors.DayNames;
  1220.     I := 0;
  1221.     DOW := FWeekStarts;
  1222.     repeat
  1223.       {record columns for weekends}
  1224.       if DOW = dtSaturday then
  1225.         SatCol := I;
  1226.       if DOW = dtSunday then
  1227.         SunCol := I;
  1228.  
  1229.       {get the day name}
  1230.       S := Copy(ShortDayNames[Ord(DOW)+1], 1, FDayNameWidth);
  1231.  
  1232.       {draw the day name above each column}
  1233.       DrawText(Canvas.Handle, @S[1], Length(S), clRowCol[1,I],
  1234.         DT_SINGLELINE or DT_CENTER or DT_VCENTER);
  1235.  
  1236.       Inc(I);
  1237.       if DOW < High(DOW) then
  1238.         Inc(DOW)
  1239.       else
  1240.         DOW := Low(DOW);
  1241.     until DOW = WeekStarts;
  1242.   end;
  1243.  
  1244.   procedure DrawLine;
  1245.   begin
  1246.     if Ctl3D then begin
  1247.       Canvas.Pen.Color := clBtnHighlight;
  1248.       Canvas.MoveTo(0, clRowCol[1,0].Bottom-3);
  1249.       Canvas.LineTo(ClientWidth, clRowCol[1,0].Bottom-3);
  1250.       Canvas.Pen.Color := clBtnShadow;
  1251.       Canvas.MoveTo(0,  clRowCol[1,0].Bottom-2);
  1252.       Canvas.LineTo(ClientWidth, clRowCol[1,0].Bottom-2);
  1253.     end else if BorderStyle = bsSingle then begin
  1254.       Canvas.Pen.Color := Font.Color;
  1255.       Canvas.MoveTo(0, clRowCol[1,0].Bottom-3);
  1256.       Canvas.LineTo(ClientWidth, clRowCol[1,0].Bottom-3);
  1257.     end;
  1258.   end;
  1259.  
  1260.   procedure DrawDay(R, C, I : Integer; Grayed, Current : Boolean);
  1261.   var
  1262.     S : string[10];
  1263.   begin
  1264.     {convert to a string and draw it centered in its rectangle}
  1265.     S := IntToStr(clCalendar[I]);
  1266.  
  1267.     if Grayed then
  1268.       Canvas.Font.Color := FColors.InactiveDays;
  1269.  
  1270.     if not Grayed or FShowInactive then
  1271.       DrawText(Canvas.Handle, @S[1], Length(S), clRowCol[R,C],
  1272.         DT_SINGLELINE or DT_CENTER or DT_VCENTER);
  1273.   end;
  1274.  
  1275.   procedure DrawFocusBox;
  1276.   var
  1277.     R       : TRect;
  1278.     S       : string[10];
  1279.   begin
  1280.     S := IntToStr(clDay);
  1281.     if Focused then
  1282.       R := DrawButtonFace(Canvas, calGetCurrentRectangle, 1, bsNew, True, True, False)
  1283.     else
  1284.       R := DrawButtonFace(Canvas, calGetCurrentRectangle, 1, bsNew, True, False, False);
  1285.     DrawText(Canvas.Handle, @S[1], Length(S), R, DT_CENTER or DT_VCENTER or DT_SINGLELINE);
  1286.   end;
  1287.  
  1288. begin
  1289.   Canvas.Font := Font;
  1290.   Canvas.Brush.Color := calDefColor;
  1291.   Canvas.FillRect(ClientRect);
  1292.  
  1293.   {draw the month and year at the top of the calendar}
  1294.   if FShowDate then
  1295.     DrawDate;
  1296.  
  1297.   {draw the days of the week}
  1298.   DrawDayNames;
  1299.  
  1300.   {draw line under day names}
  1301.   DrawLine;
  1302.  
  1303.   {draw each day}
  1304.   CurIndex := clFirst + Pred(clDay);
  1305.   I := 1;
  1306.   for R := 2 to 7 do
  1307.     for C := 0 to 6 do begin
  1308.       if (C = SatCol) or (C = SunCol) then
  1309.         Canvas.Font.Color := FColors.WeekEnd
  1310.       else
  1311.         Canvas.Font.Color := FColors.Days;
  1312.       DrawDay(R, C, I, (I < clFirst) or (I > clLast), I = CurIndex);
  1313.       Inc(I);
  1314.     end;
  1315.  
  1316.   Canvas.Font.Color := FColors.ActiveDay;
  1317.   DrawFocusBox;
  1318. end;
  1319.  
  1320. procedure TEsCustomCalendar.SetBorderStyle(Value : TBorderStyle);
  1321. begin
  1322.   if Value <> FBorderStyle then begin
  1323.     FBorderStyle := Value;
  1324.     RecreateWnd;
  1325.   end;
  1326. end;
  1327.  
  1328. procedure TEsCustomCalendar.SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
  1329. begin
  1330.   inherited Setbounds(ALeft, ATop, AWidth, AHeight);
  1331.  
  1332.   if csLoading in ComponentState then
  1333.     Exit;
  1334.  
  1335.   calRecalcSize;
  1336. end;
  1337.  
  1338. procedure TEsCustomCalendar.SetDate(Value : TDateTime);
  1339. var
  1340.   R : TRect;
  1341.   Y : Word;
  1342.   M : Word;
  1343.   D : Word;
  1344. begin
  1345.   if Value <> FDate then begin
  1346.     {determine if the new date is in the same month}
  1347.     DecodeDate(Value, Y, M, D);
  1348.     if (clYear = Y) and (clMonth = M) then begin
  1349.       {invalidate the old date}
  1350.       R := calGetCurrentRectangle;
  1351.       InvalidateRect(Handle, @R, False);
  1352.     end else
  1353.       Invalidate;
  1354.  
  1355.     DecodeDate(Value, clYear, clMonth, clDay);
  1356.     FDate := Value;
  1357.     calRebuildCalArray;
  1358.  
  1359.     {invalidate the new date}
  1360.     R := calGetCurrentRectangle;
  1361.     InvalidateRect(Handle, @R, False);
  1362.   end;
  1363. end;
  1364.  
  1365. procedure TEsCustomCalendar.SetDateFormat(Value : TEsDateFormat);
  1366. begin
  1367.   if Value <> FDateFormat then begin
  1368.    FDateFormat := Value;
  1369.    Invalidate;
  1370.   end;
  1371. end;
  1372.  
  1373. procedure TEsCustomCalendar.SetDayNameWidth(Value : TEsDayNameWidth);
  1374. begin
  1375.   if Value <> FDayNameWidth then begin
  1376.    FDayNameWidth := Value;
  1377.    Invalidate;
  1378.   end;
  1379. end;
  1380.  
  1381. procedure TEsCustomCalendar.SetShowDate(Value : Boolean);
  1382. begin
  1383.   if Value <> FShowDate then begin
  1384.    FShowDate := Value;
  1385.    Invalidate;
  1386.   end;
  1387. end;
  1388.  
  1389. procedure TEsCustomCalendar.SetShowInactive(Value : Boolean);
  1390. begin
  1391.   if Value <> FShowInactive then begin
  1392.    FShowInactive := Value;
  1393.    Invalidate;
  1394.   end;
  1395. end;
  1396.  
  1397. procedure TEsCustomCalendar.SetShowToday(Value : Boolean);
  1398. begin
  1399.   if Value <> FShowToday then begin
  1400.     FShowToday := Value;
  1401.  
  1402.     if FShowToday then begin
  1403.       {create "today" button}
  1404.       clBtnToday := TSpeedButton.Create(Self);
  1405.       clBtnToday.Parent := Self;
  1406.       clBtnToday.OnClick := calBtnClick;
  1407.     end else begin
  1408.       clBtnToday.Free;
  1409.       clBtnToday := nil;
  1410.     end;
  1411.  
  1412.    calReCalcSize;
  1413.    Invalidate;
  1414.   end;
  1415. end;
  1416.  
  1417. procedure TEsCustomCalendar.SetWeekStarts(Value : TEsDayType);
  1418. begin
  1419.   if Value <> FWeekStarts then begin
  1420.     FWeekStarts := Value;
  1421.     if csLoading in ComponentState then                                {!!.02}
  1422.       Exit;                                                            {!!.02}
  1423.     calRebuildCalArray;
  1424.     Invalidate;
  1425.   end;
  1426. end;
  1427.  
  1428. procedure TEsCustomCalendar.WMEraseBkgnd(var Msg : TWMEraseBkgnd);
  1429. begin
  1430.   Msg.Result := 1;   {don't erase background, just say we did}
  1431. end;
  1432.  
  1433. procedure TEsCustomCalendar.WMGetDlgCode(var Msg : TWMGetDlgCode);
  1434. begin
  1435.   Msg.Result := DLGC_WANTARROWS;
  1436. end;
  1437.  
  1438. end.
  1439.