home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 December / Chip_2001-12_cd1.bin / zkuste / delphi / kolekce / d3456 / ALEXSOFT.ZIP / FMCLNDR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-09-29  |  6.0 KB  |  177 lines
  1. (*////////////////////////////////////////////////////////////////////////////
  2. //   Part of AlexSoft VCL/DLL Library.                                      //
  3. //   All rights reserved. (c) Copyright 1998.                               //
  4. //   Created by: Alex Rabichooc                                             //
  5. //**************************************************************************//
  6. //  Users of this unit must accept this disclaimer of warranty:             //
  7. //    "This unit is supplied as is. The author disclaims all warranties,    //
  8. //    expressed or implied, including, without limitation, the warranties   //
  9. //    of merchantability and of fitness for any purpose.                    //
  10. //    The author assumes no liability for damages, direct or                //
  11. //    consequential, which may result from the use of this unit."           //
  12. //                                                                          //
  13. //  This Unit is donated to the public as public domain.                    //
  14. //                                                                          //
  15. //  This Unit can be freely used and distributed in commercial and          //
  16. //  private environments provided this notice is not modified in any way.   //
  17. //                                                                          //
  18. //  If you do find this Unit handy and you feel guilty for using such a     //
  19. //  great product without paying someone - sorry :-)                        //
  20. //                                                                          //
  21. //  Please forward any comments or suggestions to Alex Rabichooc at:        //
  22. //                                                                          //
  23. //  a_rabichooc@yahoo.com or alex@carmez.mldnet.com                         //
  24. /////////////////////////////////////////////////////////////////////////////*)
  25.  
  26. unit fmClndr;
  27.  
  28. interface
  29.  
  30. uses
  31.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  32.   Grids, Calendar, ComCtrls, StdCtrls, ExtCtrls, Buttons, DB;
  33.  
  34. type
  35.   TfmCalendar = class(TForm)
  36.     Panel2: TPanel;
  37.     Calendar: TCalendar;
  38.     udYear: TUpDown;
  39.     laYear: TLabel;
  40.     udMonth: TUpDown;
  41.     Panel1: TPanel;
  42.     laMonth: TLabel;
  43.     procedure SetValues(Sender: TObject);
  44.     procedure SetPositions(Sender: TObject; Button: TUDBtnType);
  45.     procedure FormKeyDown(Sender: TObject; var Key: Word;
  46.       Shift: TShiftState);
  47.     procedure OkClick(Sender: TObject);
  48.     procedure DeactivateForm(Sender: TObject);
  49.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  50.   private
  51.     FCalendarDate: TDate;
  52.     FField: TField;
  53.     FAutoDestroy: Boolean;
  54.   public
  55.     property CalendarDate: TDate read FCalendarDate;
  56.     property Field: TField read FField;
  57.   end;
  58.  
  59. function CreateCalendar(AField: TField; Sender: TWinControl): boolean;
  60.  
  61. var
  62.   fmCalendar: TfmCalendar;
  63.  
  64. implementation
  65. {$IFDEF VER140}
  66. uses Variants;
  67. {$ENDIF}
  68.  
  69. {$R *.DFM}
  70. function CreateCalendar(AField: TField; Sender: TWinControl): boolean;
  71. var ACalendar: TfmCalendar;
  72.     Position: TPoint;
  73.     FieldP: ^TField;
  74. begin
  75.    Result := False;
  76.    if (AField <> nil) and (Sender <> nil) then
  77.    begin
  78.       Position.x := 0;
  79.       Position.y := Sender.Height;
  80.       Position := Sender.ClientToScreen(Position);
  81.       ACalendar := TfmCalendar.Create(Sender);
  82.       ACalendar.Color := clWindow;
  83.       if Position.x + ACalendar.Width > Screen.Width then
  84.          Position.x := Screen.Width-ACalendar.Width;
  85.       if Position.y + ACalendar.Height > Screen.Height then
  86.          Position.y := Screen.Height-ACalendar.Height;
  87.       ACalendar.Left := Position.x;
  88.       ACalendar.Top := Position.y;
  89.       if AField.Value <> Null then
  90.          ACalendar.Calendar.CalendarDate := AField.AsDateTime;
  91.       FieldP := @ACalendar.Field;
  92.       FieldP^ := AField;
  93.       ACalendar.FAutoDestroy := True;
  94.       ACalendar.Show;
  95.       Result := True;
  96.    end;
  97. end;
  98.  
  99. procedure TfmCalendar.SetValues(Sender: TObject);
  100. begin
  101.    laYear.Caption := IntToStr(Calendar.Year);
  102.    laMonth.Caption := LongMonthNames[Calendar.Month];
  103.    udYear.Position := Calendar.Year;
  104.    udMonth.Position := Calendar.Month;
  105.    FCalendarDate := Calendar.CalendarDate;
  106. end;
  107.  
  108. procedure TfmCalendar.SetPositions(Sender: TObject; Button: TUDBtnType);
  109. var AYear, AMonth: Integer;
  110. begin
  111.    AYear := udYear.Position+((udMonth.Position+11) div 12)-1;
  112.    AMonth := ((udMonth.Position+11) mod 12)+1;
  113.    if Calendar.Day > MonthDays[IsLeapYear(AYear), AMonth] then
  114.        Calendar.Day := MonthDays[IsLeapYear(AYear), AMonth];
  115.    Calendar.Month := AMonth;
  116.    Calendar.Year := AYear;
  117. end;
  118.  
  119. procedure TfmCalendar.FormKeyDown(Sender: TObject; var Key: Word;
  120.   Shift: TShiftState);
  121. begin
  122.   case Key of
  123.     VK_ESCAPE:
  124.         begin
  125.            Close;
  126.            ModalResult := mrCancel;
  127.         end;
  128.     VK_RETURN:
  129.         begin
  130.            OkClick(Self);
  131.            ModalResult := mrOk;
  132.         end;
  133.     VK_NEXT, VK_PRIOR:
  134.         begin
  135.            if ssCtrl in Shift then
  136.               udYear.Position :=
  137.                               udYear.Position+(-1)+2*ord(Key = VK_NEXT)
  138.              else
  139.               udMonth.Position :=
  140.                               udMonth.Position+(-1)+2*ord(Key = VK_NEXT);
  141.            SetPositions(Self, btNext);
  142.            Key := 0;
  143.         end;
  144.   end;
  145. end;
  146.  
  147. procedure TfmCalendar.OkClick(Sender: TObject);
  148. begin
  149.    if (FField <> nil) and
  150.       (FField.DataSet <> nil) and
  151.       (FField.DataSet.CanModify) and
  152.       (not FField.ReadOnly) then
  153.    with FField.DataSet do
  154.    begin
  155.       if not (State in [dsEdit, dsInsert]) then
  156.          if IsEmpty then
  157.             Insert
  158.            else
  159.             Edit;
  160.       FField.AsDateTime := FCalendarDate;
  161.    end;
  162.    DeactivateForm(Sender);
  163. end;
  164.  
  165. procedure TfmCalendar.DeactivateForm(Sender: TObject);
  166. begin
  167.    Close;
  168. end;
  169.  
  170. procedure TfmCalendar.FormClose(Sender: TObject; var Action: TCloseAction);
  171. begin
  172.    if FAutoDestroy then
  173.      Action := caFree;
  174. end;
  175.  
  176. end.
  177.