home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kolekce / d456 / DCSLIB25.ZIP / DCCalendar.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-02-15  |  25.1 KB  |  942 lines
  1. {
  2.  BUSINESS CONSULTING
  3.  s a i n t - p e t e r s b u r g
  4.  
  5.          Components Library for Borland Delphi 4.x, 5.x
  6.          Copyright (c) 1998-2000 Alex'EM
  7.  
  8. }
  9. unit DCCalendar;
  10.  
  11. interface
  12.  
  13. uses
  14.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  15.   ExtCtrls, DCEditButton, DCEditTools, DCPopupWindow, DCConst;
  16.  
  17. type
  18.   TDCCustomCalendar = class(TDCPopupWindow)
  19.   private
  20.     { Private declarations }
  21.     FBtnNextYear, FBtnPrevYear  : TDCEditButton;
  22.     FBtnNextMonth, FBtnPrevMonth: TDCEditButton;
  23.     FBtnToday, FBtnCancel: TDCEditButton;
  24.     FMouseDown: boolean;
  25.     { calendar grid property}
  26.     FFirstDay: integer;
  27.     FDate: TDateTime;
  28.     FPoint: TPoint;
  29.     FDatePoint: TPoint;
  30.     FCloseUp: TCloseUpEvent;
  31.     FCloseState: byte;
  32.     FTimer: TTimer;
  33.     FOnTimer: boolean;
  34.     FBorderSize: integer;
  35.     FBrushColor: TColor;
  36.     FHeaderHeight: integer;
  37.     FFooterHeight: integer;
  38.     { Private methods }
  39.     procedure GetFirstDate;
  40.     function DaysThisMonth: Integer;
  41.     function GetDateElement(Index: Integer): Integer;
  42.     { Date functions }
  43.     procedure ChangeDay(Delta: Integer);
  44.     procedure ChangeMonth(Delta: Integer);
  45.     procedure ChangeYear(Delta: Integer);
  46.     { Component Size functions}
  47.     function GetGridSize: TPoint;
  48.     { Draw functions}
  49.     procedure DrawCalendarGrid;
  50.     procedure DrawMonthYear;
  51.     procedure DrawDaysOfWeek;
  52.     procedure DrawButtons;
  53.     procedure DrawCellBorder(ACol,ARow: integer; BorderStyle: TEdgeStyle);
  54.     procedure DrawCell(ARect: TRect; ACol, ARow: integer; BorderStyle: TEdgeStyle);
  55.     procedure UpdateDatePos;
  56.     procedure PaintButtons;
  57.  
  58.     function GetTextCell(ACol,ARow: integer): integer;
  59.     function GetRectCell(ACol,ARow: integer): TRect;
  60.     function GetCellForPoint(X,Y: integer): TPoint;
  61.     function GetCellForDay(Day: integer): TPoint;
  62.     function GetCellForDate(dDate: TDateTime): TPoint;
  63.     //function GetTextForPoint(X,Y: integer): integer;
  64.     {Mouse functions}
  65.     procedure MouseCellMove(APoint, BPoint: TPoint);
  66.     {}
  67.     procedure NextMonthClick(Sender: TObject);
  68.     procedure NextYearClick(Sender: TObject);
  69.     procedure PrevMonthClick(Sender: TObject);
  70.     procedure PrevYearClick(Sender: TObject);
  71.     procedure TodayClick(Sender: TObject);
  72.     procedure CancelClick(Sender: TObject);
  73.  
  74.     {HideCalendar}
  75.     procedure CloseUp(State: Byte); virtual;
  76.     procedure UpdateEditButtonsState(X, Y: integer; lMove: boolean);
  77.     procedure TimerEvent(Sender: TObject);
  78.  
  79.     procedure SetColor(const Value: TColor);
  80.     procedure UpdateSize;
  81.   protected
  82.     procedure CreateButtons;
  83.     function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
  84.     function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
  85.     procedure WMSize(var Message: TWMSize);
  86.     procedure WMPaint (var Message: TMessage); message WM_PAINT;
  87.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  88.     procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
  89.     procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
  90.     procedure WMLButtonDblClk(var Message: TWMLButtonDown); message WM_LBUTTONDBLCLK;
  91.     procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
  92.     procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;
  93.     procedure WndProc(var Message: TMessage); override;
  94.     procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
  95.     procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  96.   public
  97.     constructor Create(AOwner: TComponent); override;
  98.     destructor Destroy; override;
  99.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  100.   published
  101.     { Published declarations }
  102.     property OnCloseUp: TCloseUpEvent read FCloseUp write FCloseUp;
  103.     property Date: TDateTime read FDate write FDate;
  104.     property BrushColor: TColor read FBrushColor write SetColor;
  105.   end;
  106.  
  107. function PointInRect(const P: TPoint; const R: TRect): boolean;
  108.  
  109. implementation
  110. uses DCResource;
  111.  
  112. function PointInRect(const P: TPoint; const R: TRect): boolean;
  113. begin
  114.   with R do
  115.     Result := (Left <= P.X) and (Top <= P.Y) and
  116.       (Right >= P.X) and (Bottom >= P.Y);
  117. end;
  118.  
  119. function ZerroInPoint(const P: TPoint): boolean;
  120. begin
  121.   Result := ( P.X = 0 ) or ( P.Y = 0 );
  122. end;
  123.  
  124. function EquPoints(APoint, BPoint: TPoint): boolean;
  125. begin
  126.   Result := ( APoint.X = BPoint.X ) and ( APoint.Y = BPoint.Y );
  127. end;
  128.  
  129. constructor TDCCustomCalendar.Create(AOwner: TComponent);
  130. begin
  131.   inherited Create(AOwner);
  132.  
  133.   FBrushColor :=  $00EFFFFF;
  134.   Parent := TWinControl(AOwner);
  135.   PopupAlignment := wpBottomRight;
  136.   Color  := FBrushColor;
  137.   Canvas.Font := Font;
  138.  
  139.   FDate := SysUtils.Date;
  140.   FMouseDown := False;
  141.  
  142.   FBorderSize := 2;
  143.  
  144.   UpdateSize;
  145.   
  146.   GetFirstDate;
  147.   CreateButtons;
  148.   DrawButtons;
  149.  
  150.   FCloseState := 100;
  151.   FOnTimer := False;
  152.  
  153.   ShowHint       := False;
  154.   ParentShowHint := False;
  155. end;
  156.  
  157. procedure TDCCustomCalendar.WMPaint (var Message: TMessage);
  158.  var
  159.   R: TRect;
  160.   xDate:string;
  161. begin
  162.   inherited;
  163.   R := Rect(0,0,ClientWidth,ClientHeight);
  164.  
  165.   DrawEdge(Canvas.Handle, R, BDR_RAISEDOUTER, BF_RECT);
  166.   InflateRect(R, -1, -1);
  167.   DrawEdge(Canvas.Handle, R, BDR_RAISEDINNER, BF_RECT);
  168. {
  169.   DrawEdge(Canvas.Handle, R, BDR_RAISEDOUTER, BF_TOPLEFT);
  170.   DrawEdge(Canvas.Handle, R, BDR_RAISEDINNER, BF_BOTTOMRIGHT);
  171.   InflateRect(R, -1, -1);
  172.   DrawEdge(Canvas.Handle, R, BDR_RAISEDINNER, BF_TOPLEFT);
  173.   DrawEdge(Canvas.Handle, R, BDR_SUNKENINNER, BF_BOTTOMRIGHT);
  174. }
  175.  
  176.   DateToStrY2K( SysUtils.Date, xDate);
  177.   FBtnToday.Font := Font;
  178.   FBtnToday.Caption := Format(LoadStr(RES_CALC_FMT_TODAY),[xDate]);
  179.  
  180.   DrawDaysOfWeek;
  181.   DrawMonthYear;
  182.   PaintButtons;
  183.   DrawCalendarGrid;
  184.   UpdateDatePos;
  185. end;
  186.  
  187. procedure TDCCustomCalendar.CreateButtons;
  188. begin
  189.  
  190.   Canvas.Font := Font;
  191.   FBtnNextYear:= TDCEditButton.Create(Self);
  192.   with FBtnNextYear do
  193.   begin
  194.     Enabled:= Self.Enabled;
  195.     Width  := CALC_BTN_WIDTH;
  196.     Height := CALC_BTN_WIDTH;
  197.     Style  := stFlat;
  198.     Glyph.LoadFromResourceName(HInstance, 'DC_BTNNEXT_2');
  199.     BrushColor := clBtnFace;
  200.     OnClick := NextYearClick;
  201.   end;
  202.  
  203.   FBtnPrevYear:= TDCEditButton.Create(Self);
  204.   with FBtnPrevYear do
  205.   begin
  206.     Enabled:= Self.Enabled;
  207.     Width  := CALC_BTN_WIDTH;
  208.     Height := CALC_BTN_WIDTH;
  209.     Style  := stFlat;
  210.     Glyph.LoadFromResourceName(HInstance, 'DC_BTNPREV_2');
  211.     BrushColor := clBtnFace;
  212.     OnClick := PrevYearClick;
  213.   end;
  214.  
  215.   FBtnNextMonth:= TDCEditButton.Create(Self);
  216.   with FBtnNextMonth do
  217.   begin
  218.     Enabled:= Self.Enabled;
  219.     Width  := CALC_BTN_WIDTH;
  220.     Height := CALC_BTN_WIDTH;
  221.     Style  := stFlat;
  222.     Glyph.LoadFromResourceName(HInstance, 'DC_BTNNEXT_1');
  223.     BrushColor := clBtnFace;
  224.     OnClick := NextMonthClick;
  225.   end;
  226.  
  227.   FBtnPrevMonth:= TDCEditButton.Create(Self);
  228.   with FBtnPrevMonth do
  229.   begin
  230.     Enabled:= Self.Enabled;
  231.     Width  := CALC_BTN_WIDTH;
  232.     Height := CALC_BTN_WIDTH;
  233.     Style  := stFlat;
  234.     Glyph.LoadFromResourceName(HInstance, 'DC_BTNPREV_1');
  235.     BrushColor := clBtnFace;
  236.     OnClick := PrevMonthClick;
  237.   end;
  238.  
  239.   FBtnCancel:= TDCEditButton.Create(Self);
  240.   with FBtnCancel do
  241.   begin
  242.     Enabled:= Self.Enabled;
  243.     Width  := CALC_BTN_WIDTH+3;
  244.     Height := Self.Canvas.TextHeight('Wg')+2;
  245.     Style  := stFlat;
  246.     Glyph.LoadFromResourceName(HInstance, 'DC_BTNCANCEL');
  247.     BrushColor := clBtnFace;
  248.     OnClick := CancelClick;
  249.   end;
  250.  
  251.   FBtnToday:= TDCEditButton.Create(Self);
  252.   with FBtnToday do
  253.   begin
  254.     Allignment := abLeft;
  255.     Enabled:= Self.Enabled;
  256.     Style  := stFlat;
  257.     Glyph.LoadFromResourceName(HInstance, 'DC_BTNTODAY');
  258.     Caption := Format(LoadStr(RES_CALC_FMT_TODAY),[DateToStr(SysUtils.Date)]);
  259.     Width := Self.Width-2*FBorderSize-FBtnCancel.Width;
  260.     Height:= Self.Canvas.TextHeight('Wg')+2;
  261.     BrushColor := clBtnFace;
  262.     OnClick := TodayClick;
  263.   end;
  264.  
  265. end;
  266.  
  267. procedure TDCCustomCalendar.KeyDown(var Key: Word; Shift: TShiftState);
  268.  var
  269.   AYear, AMonth, ADay: Word;
  270.   NYear, NMonth, NDay: Word;
  271. begin
  272.   DecodeDate(FDate, AYear, AMonth, ADay);
  273.  
  274.   case Key of
  275.     VK_LEFT : ChangeDay(-1);
  276.     VK_RIGHT: ChangeDay(+1);
  277.     VK_UP   : ChangeDay(-7);
  278.     VK_DOWN : ChangeDay(+7);
  279.     {Month change}
  280.     VK_PRIOR: ChangeMonth(-1);
  281.     VK_NEXT : ChangeMonth(+1);
  282.     {Year chabge}
  283.     VK_HOME : ChangeYear(-1);
  284.     VK_END  : ChangeYear(+1);
  285.   end;
  286.  
  287.   DecodeDate(FDate, NYear, NMonth, NDay);
  288.   if (NYear <> AYear) or (NMonth <> AMonth) then
  289.   begin
  290.     DrawMonthYear;
  291.     DrawCalendarGrid;
  292.   end
  293.   else
  294.     DrawCellBorder(FDatePoint.X,FDatePoint.Y, esNone);
  295.   UpdateDatePos;
  296. end;
  297.  
  298. function TDCCustomCalendar.GetDateElement(Index: Integer): Integer;
  299. var
  300.   AYear, AMonth, ADay: Word;
  301. begin
  302.   DecodeDate(FDate, AYear, AMonth, ADay);
  303.   case Index of
  304.     1: Result := AYear;
  305.     2: Result := AMonth;
  306.     3: Result := ADay;
  307.     else Result := -1;
  308.   end;
  309. end;
  310.  
  311. function TDCCustomCalendar.DaysThisMonth: Integer;
  312. begin
  313.   Result := DaysPerMonth(GetDateElement(1), GetDateElement(2));
  314. end;
  315.  
  316. procedure TDCCustomCalendar.GetFirstDate;
  317. var
  318.   AYear, AMonth, ADay: Word;
  319.   FirstDate: TDateTime;
  320. begin
  321.   try
  322.     DecodeDate(FDate, AYear, AMonth, ADay);
  323.     FirstDate := EncodeDate(AYear, AMonth, 1);
  324.     FFirstDay := ((DayOfWeek(FirstDate) +6) mod 7);
  325.     if FFirstDay = 0 then FFirstDay := 7;
  326.   finally
  327.   end;
  328. end;
  329.  
  330. procedure TDCCustomCalendar.ChangeDay(Delta: Integer);
  331. begin
  332.   FDate := FDate + Delta;
  333. end;
  334.  
  335. procedure TDCCustomCalendar.ChangeMonth(Delta: Integer);
  336. var
  337.   AYear, AMonth, ADay: Word;
  338.   NewDate: TDateTime;
  339.   CurDay: Integer;
  340. begin
  341.   DecodeDate(FDate, AYear, AMonth, ADay);
  342.   CurDay := ADay;
  343.   if Delta > 0 then ADay := DaysPerMonth(AYear, AMonth)
  344.   else ADay := 1;
  345.   NewDate := EncodeDate(AYear, AMonth, ADay);
  346.   NewDate := NewDate + Delta;
  347.   DecodeDate(NewDate, AYear, AMonth, ADay);
  348.   if DaysPerMonth(AYear, AMonth) > CurDay then ADay := CurDay
  349.   else ADay := DaysPerMonth(AYear, AMonth);
  350.   FDate := EncodeDate(AYear, AMonth, ADay);
  351. end;
  352.  
  353. procedure TDCCustomCalendar.ChangeYear(Delta: Integer);
  354.  var
  355.   AYear, AMonth, ADay: Word;
  356. begin
  357.   DecodeDate(FDate, AYear, AMonth, ADay);
  358.   AYear := AYear + Delta;
  359.   FDate := EncodeDate(AYear, AMonth, ADay);
  360. end;
  361.  
  362.  
  363. function TDCCustomCalendar.GetGridSize: TPoint;
  364. begin
  365.   Canvas.Font := Font;
  366.   Result.X := (2 * Canvas.TextWidth('99')) * 7;
  367.   Result.Y := Canvas.TextHeight('99') * 6;
  368. end;
  369.  
  370. procedure TDCCustomCalendar.DrawButtons;
  371. begin
  372.   with FBtnNextYear do
  373.   begin
  374.     Top := 1+FBorderSize; Left := Self.Width-FBorderSize-Width;
  375.   end;
  376.   with FBtnPrevYear do
  377.   begin
  378.     Top := 1+FBorderSize; Left := FBorderSize;
  379.   end;
  380.   with FBtnNextMonth do
  381.   begin
  382.     Top := 1+FBorderSize; Left:= FBtnNextYear.Left-Width;
  383.   end;
  384.   with FBtnPrevMonth do
  385.   begin
  386.     Top := 1+FBorderSize; Left := FBorderSize+FBtnPrevYear.Width;
  387.   end;
  388.   with FBtnToday do
  389.   begin
  390.     Top := Self.Height-Height-FBorderSize; Left := FBorderSize;
  391.   end;
  392.   with FBtnCancel do
  393.   begin
  394.     Top := Self.Height-Height-FBorderSize; Left := Self.Left+Self.Width-FBorderSize-Width;
  395.   end;
  396. end;
  397.  
  398. procedure TDCCustomCalendar.DrawCalendarGrid;
  399.  var
  400.   i,j: integer;
  401.   ARect: TRect;
  402.   Top,Left: Integer;
  403.   AYear, AMonth, ADay: Word;
  404. begin
  405.   GetFirstDate;
  406.   Canvas.Font := Font;
  407.   Canvas.Brush.Color := FBrushColor;
  408.   DecodeDate(FDate, AYear, AMonth, ADay);
  409.   Top := Canvas.TextHeight('Wg')+FHeaderHeight+3+FBorderSize;
  410.   for i := 1 to 6 do
  411.   begin
  412.     Left:= FBorderSize;
  413.     for j:= 1 to 7 do
  414.     begin
  415.       ARect := Rect(Left+(j-1)*2*Canvas.TextWidth('99'),Top,
  416.                     Left+j*2*Canvas.TextWidth('99'), Top+Canvas.TextHeight('99'));
  417.       Canvas.FillRect(ARect);
  418.       DrawCellBorder(j,i,esNone);
  419.     end;
  420.     Top := Top+Canvas.TextHeight('99');
  421.   end;
  422.  
  423. end;
  424.  
  425. procedure TDCCustomCalendar.DrawMonthYear;
  426.  var
  427.   AYear, AMonth, ADay: Word;
  428.   ARect, LRect, RRect: TRect;
  429.   Text: String;
  430.   Top,Left,Right: integer;
  431. begin
  432.   Canvas.Font := Font;
  433.   Canvas.Brush.Color := clBtnFace;
  434.   Canvas.Pen.Color   := clBtnFace;
  435.  
  436.   DecodeDate(FDate, AYear, AMonth, ADay);
  437.   Top  := FBorderSize;
  438.   Left := FBorderSize+FBtnPrevMonth.Left+FBtnPrevMonth.Width-2;
  439.   Right:= FBtnNextMonth.Left;
  440.   Text := Format('%s %d',[LongMonthNames[AMonth],AYear]);
  441.   ARect:= Rect(Left,Top, Right,Top+FHeaderHeight);
  442.  
  443.   Canvas.FillRect(ARect);
  444.   Canvas.MoveTo(FBorderSize, FBorderSize);
  445.   Canvas.LineTo(ClientWidth-FBorderSize, FBorderSize);
  446.  
  447.   LRect := Rect(FBorderSize, FBtnNextMonth.Top + FBtnNextMonth.Height,
  448.                 ARect.Left, ARect.Bottom);
  449.   RRect := Rect(ARect.Right, FBtnNextMonth.Top + FBtnNextMonth.Height,
  450.                 ClientWidth-FBorderSize, ARect.Bottom);
  451.   Canvas.FillRect(LRect);
  452.   Canvas.FillRect(RRect);
  453.   ARect.Top := ARect.Top + 1;
  454.  
  455.   DrawText(Canvas.Handle, PChar(Text), Length(Text), ARect,
  456.            DT_CENTER or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX);
  457.  
  458. end;
  459.  
  460. procedure TDCCustomCalendar.DrawDaysOfWeek;
  461.  var
  462.   i: integer;
  463.   ARect: TRect;
  464.   Text: String;
  465.   Top,Left: integer;
  466. begin
  467.   Canvas.Font := Font;
  468.   Canvas.Brush.Color := FBrushColor;
  469.  
  470.   Top := 1+FBorderSize+FHeaderHeight;
  471.   Left:= FBorderSize;
  472.   for i:= 1 to 7 do
  473.   begin
  474.     ARect := Rect(Left+(i-1)*2*Canvas.TextWidth('99'),Top,
  475.                   Left+i*2*Canvas.TextWidth('99'), Top+Canvas.TextHeight('Wg'));
  476.  
  477.     Canvas.FillRect(ARect);
  478.     if i <> 7 then Text := ShortDayNames[i+1] else Text := ShortDayNames[1];
  479.  
  480.     DrawText(Canvas.Handle, PChar(Text), Length(Text), ARect,
  481.              DT_CENTER or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX);
  482.   end;
  483.   Top := Top+Canvas.TextHeight('Wg');
  484.   ARect := Rect(Left,Top-1,Width-Left,Top+1);
  485.   DrawEdge(Canvas.Handle, ARect, BDR_SUNKENOUTER, BF_RECT);
  486. end;
  487.  
  488. procedure TDCCustomCalendar.DrawCellBorder(ACol,ARow: integer; BorderStyle: TEdgeStyle);
  489.  var
  490.   ARect: TRect;
  491. begin
  492.   ARect := GetRectCell(ACol,ARow);
  493.   DrawCell(ARect, ACol, ARow, BorderStyle);
  494.   case BorderStyle of
  495.     esNone   :
  496.       begin
  497.         Canvas.Brush.Color := FBrushColor;
  498.         Canvas.FrameRect(ARect);
  499.       end;
  500.     esRaised :
  501.       begin
  502.         Canvas.Brush.Color := clBlack;
  503.         Canvas.FrameRect(ARect);
  504.       end;
  505.     esSunken :
  506.       begin
  507.         Canvas.Brush.Color := clBtnFace;
  508.         Canvas.FrameRect(ARect);
  509.       end;
  510.   end;
  511. end;
  512.  
  513. procedure TDCCustomCalendar.PaintButtons;
  514. begin
  515.   FBtnNextYear.Paint;
  516.   FBtnPrevYear.Paint;
  517.   FBtnNextMonth.Paint;
  518.   FBtnPrevMonth.Paint;
  519.   FBtnCancel.Paint;
  520.   FBtnToday.Paint;
  521.  
  522.   Canvas.Pen.Color := clBtnFace;
  523.   Canvas.MoveTo(FBorderSize, FBtnCancel.Top-1);
  524.   Canvas.LineTo(ClientWidth-FBorderSize, FBtnCancel.Top-1);
  525. end;
  526.  
  527.  
  528. procedure TDCCustomCalendar.UpdateDatePos;
  529.  var
  530.   APoint: TPoint;
  531. begin
  532.   GetCursorPos(APoint);
  533.   APoint.X := APoint.X - Self.Left;
  534.   APoint.Y := APoint.Y - Self.Top;
  535.   APoint:= GetCellForPoint(APoint.X,APoint.Y);
  536.   if not ZerroInPoint(APoint) then FPoint := APoint;
  537.  
  538.   FDatePoint:= GetCellForDate(FDate);
  539.   DrawCellBorder(FDatePoint.X,FDatePoint.Y,esSunken);
  540.   if FMouseDown
  541.      then FPoint := FDatePoint
  542.      else begin
  543.        if GetTextCell(FPoint.X,FPoint.Y) <= 0 then FPoint := Point(0,0);
  544.        MouseCellMove(FDatePoint, FPoint);
  545.      end;
  546. end;
  547.  
  548. procedure TDCCustomCalendar.WMSize(var Message: TWMSize);
  549. begin
  550.   inherited;
  551.   {}
  552. end;
  553.  
  554. function TDCCustomCalendar.GetTextCell(ACol,ARow: integer): integer;
  555. var
  556.   DayNum: Integer;
  557. begin
  558.   DayNum := ACol + (ARow - 1) * 7-(FFirstDay-1);
  559.   if (DayNum < 1) or (DayNum > DaysThisMonth)
  560.     then Result := -1
  561.     else Result := DayNum;
  562. end;
  563.  
  564. function TDCCustomCalendar.GetRectCell(ACol,ARow: integer): TRect;
  565.  var
  566.   ARect: TRect;
  567. begin
  568.   Canvas.Font := Font;
  569.   with ARect do
  570.   begin
  571.     Left  := FBorderSize+2*(ACol-1)*Canvas.TextWidth('99');
  572.     Top   := Canvas.TextHeight('Wg')+FHeaderHeight+3+FBorderSize+(ARow-1)*Canvas.TextHeight('99');
  573.     Right := Left+2*Canvas.TextWidth('99');
  574.     Bottom:= Top+Canvas.TextHeight('99');
  575.   end;
  576.   Result := ARect;
  577. end;
  578.  
  579. function TDCCustomCalendar.GetCellForPoint(X,Y: integer): TPoint;
  580.  var
  581.   i,j: integer;
  582. begin
  583.   Result := Point(0,0);
  584.   for i := 1 to 7 do
  585.     for j := 1 to 6 do
  586.       if PointInRect(Point(X,Y),GetRectCell(i,j)) then
  587.       begin
  588.         if GetTextCell(i,j) > 0 then
  589.            Result := Point(i,j);
  590.         Break;
  591.       end;
  592. end;
  593.  
  594. {
  595. function TDCCustomCalendar.GetTextForPoint(X,Y: integer): integer;
  596.  var
  597.   i,j: integer;
  598. begin
  599.   Result := -1;
  600.   for i := 1 to 7 do
  601.     for j := 1 to 6 do
  602.       if PointInRect(Point(X,Y),GetRectCell(i,j)) then
  603.       begin
  604.         Result := GetTextCell(i,j);
  605.         Break;
  606.       end;
  607. end;
  608. }
  609.  
  610. function TDCCustomCalendar.GetCellForDay(Day: integer): TPoint;
  611. begin
  612.   Inc(Day,FFirstDay-1);
  613.   Result.X := Day - ((Day-1) div 7)*7;
  614.   Result.Y := (Day-1) div 7+1
  615. end;
  616.  
  617. function TDCCustomCalendar.GetCellForDate(dDate: TDateTime): TPoint;
  618.  var
  619.   AYear, AMonth, ADay: Word;
  620. begin
  621.   DecodeDate(dDate, AYear, AMonth, ADay);
  622.   Result := GetCellForDay(ADay);
  623. end;
  624.  
  625. procedure TDCCustomCalendar.MouseCellMove(APoint, BPoint: TPoint);
  626.  const
  627.    CellBorder : array[boolean] of TEdgeStyle = (esRaised, esSunken);
  628. begin
  629.   if EquPoints(APoint, FDatePoint)
  630.   then
  631.     if FMouseDown
  632.     then DrawCellBorder(APoint.X,APoint.Y,esNone)
  633.     else DrawCellBorder(APoint.X,APoint.Y,esSunken)
  634.   else
  635.     if not ZerroInPoint(APoint)
  636.     then DrawCellBorder(APoint.X,APoint.Y,esNone);
  637.  
  638.   if not ZerroInPoint(BPoint)
  639.   then
  640.     if EquPoints(BPoint, FDatePoint)
  641.     then DrawCellBorder(BPoint.X,BPoint.Y,esSunken)
  642.     else DrawCellBorder(BPoint.X,BPoint.Y,CellBorder[FMouseDown])
  643. end;
  644.  
  645. procedure TDCCustomCalendar.NextMonthClick(Sender: TObject);
  646. begin
  647.   ChangeMonth(+1);
  648.   DrawMonthYear;
  649.   DrawCalendarGrid;
  650.   UpdateDatePos;
  651. end;
  652.  
  653. procedure TDCCustomCalendar.NextYearClick(Sender: TObject);
  654. begin
  655.   ChangeYear(+1);
  656.   DrawMonthYear;
  657.   DrawCalendarGrid;
  658.   UpdateDatePos;
  659. end;
  660.  
  661. procedure TDCCustomCalendar.PrevMonthClick(Sender: TObject);
  662. begin
  663.   ChangeMonth(-1);
  664.   DrawMonthYear;
  665.   DrawCalendarGrid;
  666.   UpdateDatePos;
  667. end;
  668.  
  669. procedure TDCCustomCalendar.PrevYearClick(Sender: TObject);
  670. begin
  671.   ChangeYear(-1);
  672.   DrawMonthYear;
  673.   DrawCalendarGrid;
  674.   UpdateDatePos;
  675. end;
  676.  
  677. procedure TDCCustomCalendar.TodayClick(Sender: TObject);
  678. begin
  679.   FDate := SysUtils.Date;
  680.   DrawMonthYear;
  681.   DrawCalendarGrid;
  682.   UpdateDatePos;
  683.   FCloseState := 1;
  684. end;
  685.  
  686. procedure TDCCustomCalendar.CancelClick(Sender: TObject);
  687. begin
  688.   FCloseState := 0;
  689. end;
  690.  
  691. procedure TDCCustomCalendar.CloseUp(State: Byte);
  692. begin
  693.   if Assigned(FCloseUp) then FCloseUp(State);
  694. end;
  695.  
  696. destructor TDCCustomCalendar.Destroy;
  697. begin
  698.   FBtnNextYear.Destroy;
  699.   FBtnPrevYear.Destroy;
  700.   FBtnNextMonth.Destroy;
  701.   FBtnPrevMonth.Destroy;
  702.   FBtnCancel.Destroy;
  703.   FBtnToday.Destroy;
  704.   inherited;
  705. end;
  706.  
  707. procedure TDCCustomCalendar.CMFontChanged(var Message: TMessage);
  708. begin
  709.   inherited;
  710.   UpdateSize;
  711.   Invalidate;
  712. end;
  713.  
  714. procedure TDCCustomCalendar.UpdateEditButtonsState(X, Y: integer; lMove: boolean);
  715. begin
  716.   FBtnNextYear.UpdateButtonState(X, Y, FMouseDown, lMove);
  717.   FBtnPrevYear.UpdateButtonState(X, Y, FMouseDown, lMove);
  718.   FBtnNextMonth.UpdateButtonState(X, Y, FMouseDown, lMove);
  719.   FBtnPrevMonth.UpdateButtonState(X, Y, FMouseDown, lMove);
  720.   FBtnCancel.UpdateButtonState(X, Y, FMouseDown, lMove);
  721.   FBtnToday.UpdateButtonState(X, Y, FMouseDown, lMove);
  722. end;
  723.  
  724. procedure TDCCustomCalendar.WMLButtonDown(var Message: TWMLButtonDown);
  725.  var
  726.   ADay: integer;
  727.   APoint: TPoint;
  728. begin
  729.   inherited;
  730.   FMouseDown := True;
  731.   UpdateEditButtonsState(Message.Pos.X, Message.Pos.Y, False);
  732.  
  733.   APoint:= GetCellForPoint(Message.Pos.X, Message.Pos.Y);
  734.   ADay  := GetTextCell(APoint.X,APoint.Y);
  735.   if (ADay > 0) then
  736.   begin
  737.     FDate := EncodeDate(GetDateElement(1),GetDateElement(2),ADay);
  738.     FPoint     := FDatePoint;
  739.     FDatePoint := APoint;
  740.     MouseCellMove(FPoint, FDatePoint);
  741.   end;
  742.  
  743.   if (FBtnNextYear.ButtonState  = btDownMouseInRect) or
  744.      (FBtnPrevYear.ButtonState  = btDownMouseInRect) or
  745.      (FBtnNextMonth.ButtonState = btDownMouseInRect) or
  746.      (FBtnPrevMonth.ButtonState = btDownMouseInRect)
  747.   then begin
  748.     FTimer := TTimer.Create(self);
  749.     with FTimer do
  750.     begin
  751.       Interval := 250;
  752.       OnTimer  := TimerEvent;
  753.     end;
  754.   end;
  755. end;
  756.  
  757. procedure TDCCustomCalendar.WMLButtonDblClk(var Message: TWMLButtonDown);
  758. begin
  759.   FMouseDown := True;
  760.   UpdateEditButtonsState(Message.Pos.X, Message.Pos.Y, False);
  761.  
  762.   FTimer := TTimer.Create(self);
  763.   with FTimer do
  764.   begin
  765.     Interval := 700;
  766.     OnTimer  := TimerEvent;
  767.   end;
  768. end;
  769.  
  770. procedure TDCCustomCalendar.WMLButtonUp(var Message: TWMLButtonUp);
  771.  var
  772.   ADay: integer;
  773.   APoint: TPoint;
  774. begin
  775.   inherited;
  776.   FMouseDown := False;
  777.   UpdateEditButtonsState(Message.Pos.X, Message.Pos.Y, False);
  778.   APoint:= GetCellForPoint(Message.Pos.X, Message.Pos.Y);
  779.   ADay  := GetTextCell(APoint.X,APoint.Y);
  780.  
  781.   if ((FDatePoint.X = APoint.X) and (FDatePoint.Y = APoint.Y) and
  782.       (ADay > 0)) and (FCloseState = 100) then FCloseState := 1;
  783.  
  784.   if Assigned(FTimer) then begin
  785.      FOnTimer := False;
  786.      FTimer.Free;
  787.      FTimer := nil;
  788.   end;
  789.  
  790.   if FCloseState <> 100 then
  791.   begin
  792.     CloseUp(FCloseState);
  793.   end;
  794. end;
  795.  
  796. procedure TDCCustomCalendar.WMMouseMove(var Message: TWMMouseMove);
  797.  var
  798.   APoint: TPoint;
  799. begin
  800.   inherited;
  801.   UpdateEditButtonsState(Message.Pos.X, Message.Pos.Y, True);
  802.  
  803.   APoint := GetCellForPoint(Message.Pos.X, Message.Pos.Y);
  804.   if not EquPoints(APoint, FPoint) and
  805.     ((FMouseDown and not ZerroInPoint(APoint)) or not FMouseDown) then
  806.   begin
  807.     if ZerroInPoint(FPoint) then FPoint := FDatePoint;
  808.     MouseCellMove(FPoint,APoint);
  809.     FPoint := APoint;
  810.     if FMouseDown then FDatePoint := APoint;
  811.   end;
  812. end;
  813.  
  814. procedure TDCCustomCalendar.TimerEvent(Sender: TObject);
  815. begin
  816.   FTimer.Interval := 400;
  817.   FOnTimer := True;
  818.   if FBtnNextYear.ButtonState  = btDownMouseInRect then NextYearClick(Self);
  819.   if FBtnPrevYear.ButtonState  = btDownMouseInRect then PrevYearClick(Self);
  820.   if FBtnNextMonth.ButtonState = btDownMouseInRect then NextMonthClick(Self);
  821.   if FBtnPrevMonth.ButtonState = btDownMouseInRect then PrevMOnthClick(Self);
  822. end;
  823.  
  824.  
  825. procedure TDCCustomCalendar.WndProc(var Message: TMessage);
  826. begin
  827.   inherited;
  828. end;
  829.  
  830. procedure TDCCustomCalendar.SetColor(const Value: TColor);
  831. begin
  832.   FBrushColor := Value;
  833. end;
  834.  
  835. procedure TDCCustomCalendar.UpdateSize;
  836.  var
  837.   Point: TPoint;
  838. begin
  839.   Point := GetGridSize;
  840.   FHeaderHeight := Canvas.TextHeight('Wg')+2;
  841.   if FHeaderHeight <= (CALC_BTN_WIDTH + 1) then FHeaderHeight := CALC_BTN_WIDTH + 2;
  842.   FFooterHeight := Canvas.TextHeight('Wg')+2;
  843.   Width := Point.X+2*FBorderSize;
  844.   Height:= Point.Y+Canvas.TextHeight('Wg')+FHeaderHeight+FFooterHeight+5+2*FBorderSize;
  845. end;
  846.  
  847. procedure TDCCustomCalendar.DrawCell(ARect: TRect; ACol, ARow: integer;
  848.   BorderStyle: TEdgeStyle);
  849.  var
  850.   CellValue: integer;
  851.   Text: string;
  852.   dDate: TDateTime;
  853.   AYear, AMonth, ADay: WORD;
  854. begin
  855.   DecodeDate(FDate, AYear, AMonth, ADay);
  856.   CellValue := GetTextCell(ACol,ARow);
  857.   InflateRect(ARect, -1, -1);
  858.   case BorderStyle of
  859.     esNone   :
  860.       begin
  861.         Canvas.Brush.Color := FBrushColor;
  862.         Canvas.Pen.Color   := Font.Color;
  863.       end;
  864.     esRaised :
  865.       begin
  866.         Canvas.Brush.Color := FBrushColor;
  867.         Canvas.Pen.Color   := Font.Color;
  868.       end;
  869.     esSunken :
  870.       begin
  871.         Canvas.Brush.Color := clBtnFace;
  872.         Canvas.Pen.Color   := clCaptionText;
  873.       end;
  874.   end;
  875.   Canvas.FillRect(ARect);
  876.   if CellValue > 0 then
  877.   begin
  878.     Text := IntToStr(CellValue);
  879.     dDate := EncodeDate(AYear, AMonth, CellValue);
  880.     if dDate = SysUtils.Date then Canvas.Font.Color := clSelectedRed;
  881.     ARect.Top := ARect.Top - 1;
  882.     DrawText(Canvas.Handle, PChar(Text), Length(Text), ARect,
  883.              DT_CENTER or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX or DT_VCENTER);
  884.   end;
  885.  
  886. end;
  887.  
  888. procedure TDCCustomCalendar.CMMouseEnter(var Message: TMessage);
  889.  var
  890.   APoint: TPoint;
  891.   XPos, YPos: LongInt;
  892. begin
  893.   if IsExistDragging then Exit;
  894.   GetCursorPos(APoint);
  895.   APoint := Self.ScreenToClient(APoint);
  896.   XPos := APoint.X;
  897.   YPos := APoint.Y;
  898.   if FMouseDown then
  899.   begin
  900.     FMouseDown := GetAsyncKeyState(VK_LBUTTON)<0;
  901.     if not FMouseDown then UpdateEditButtonsState(XPos, YPos, True);
  902.   end;
  903.   inherited;
  904. end;
  905.  
  906. procedure TDCCustomCalendar.CMMouseLeave(var Message: TMessage);
  907. begin
  908.   UpdateEditButtonsState(-1, -1, True);
  909.   inherited;
  910. end;
  911.  
  912. function TDCCustomCalendar.DoMouseWheelDown(Shift: TShiftState;
  913.   MousePos: TPoint): Boolean;
  914. begin
  915.   Result := inherited DoMouseWheelDown(Shift, MousePos);
  916.   ChangeDay(1);
  917. end;
  918.  
  919. function TDCCustomCalendar.DoMouseWheelUp(Shift: TShiftState;
  920.   MousePos: TPoint): Boolean;
  921. begin
  922.   Result := inherited DoMouseWheelUp(Shift, MousePos);
  923.   ChangeDay(-1);
  924. end;
  925.  
  926. procedure TDCCustomCalendar.CMDialogChar(var Message: TCMDialogChar);
  927. begin
  928.   if IsAccel(Message.CharCode, '&Today' ) then
  929.   begin
  930.     FBtnToday.Click;
  931.     CloseUp(FCloseState);
  932.   end;
  933.   if IsAccel(Message.CharCode, '&Cancel') then
  934.   begin
  935.     FBtnCancel.Click;
  936.     CloseUp(FCloseState);
  937.   end;
  938.   inherited;
  939. end;
  940.  
  941. end.
  942.