home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 December / Chip_2001-12_cd1.bin / zkuste / delphi / kolekce / d3456 / ALEXSOFT.ZIP / RUSSIAN / FMCLNDR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-09-04  |  5.9 KB  |  174 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.  
  66. {$R *.DFM}
  67. function CreateCalendar(AField: TField; Sender: TWinControl): boolean;
  68. var ACalendar: TfmCalendar;
  69.     Position: TPoint;
  70.     FieldP: ^TField;
  71. begin
  72.    Result := False;
  73.    if (AField <> nil) and (Sender <> nil) then
  74.    begin
  75.       Position.x := 0;
  76.       Position.y := Sender.Height;
  77.       Position := Sender.ClientToScreen(Position);
  78.       ACalendar := TfmCalendar.Create(Sender);
  79.       ACalendar.Color := clWindow;
  80.       if Position.x + ACalendar.Width > Screen.Width then
  81.          Position.x := Screen.Width-ACalendar.Width;
  82.       if Position.y + ACalendar.Height > Screen.Height then
  83.          Position.y := Screen.Height-ACalendar.Height;
  84.       ACalendar.Left := Position.x;
  85.       ACalendar.Top := Position.y;
  86.       if AField.Value <> Null then
  87.          ACalendar.Calendar.CalendarDate := AField.AsDateTime;
  88.       FieldP := @ACalendar.Field;
  89.       FieldP^ := AField;
  90.       ACalendar.FAutoDestroy := True;
  91.       ACalendar.Show;
  92.       Result := True;
  93.    end;
  94. end;
  95.  
  96. procedure TfmCalendar.SetValues(Sender: TObject);
  97. begin
  98.    laYear.Caption := IntToStr(Calendar.Year);
  99.    laMonth.Caption := LongMonthNames[Calendar.Month];
  100.    udYear.Position := Calendar.Year;
  101.    udMonth.Position := Calendar.Month;
  102.    FCalendarDate := Calendar.CalendarDate;
  103. end;
  104.  
  105. procedure TfmCalendar.SetPositions(Sender: TObject; Button: TUDBtnType);
  106. var AYear, AMonth: Integer;
  107. begin
  108.    AYear := udYear.Position+((udMonth.Position+11) div 12)-1;
  109.    AMonth := ((udMonth.Position+11) mod 12)+1;
  110.    if Calendar.Day > MonthDays[IsLeapYear(AYear), AMonth] then
  111.        Calendar.Day := MonthDays[IsLeapYear(AYear), AMonth];
  112.    Calendar.Month := AMonth;
  113.    Calendar.Year := AYear;
  114. end;
  115.  
  116. procedure TfmCalendar.FormKeyDown(Sender: TObject; var Key: Word;
  117.   Shift: TShiftState);
  118. begin
  119.   case Key of
  120.     VK_ESCAPE:
  121.         begin
  122.            Close;
  123.            ModalResult := mrCancel;
  124.         end;
  125.     VK_RETURN:
  126.         begin
  127.            OkClick(Self);
  128.            ModalResult := mrOk;
  129.         end;
  130.     VK_NEXT, VK_PRIOR:
  131.         begin
  132.            if ssCtrl in Shift then
  133.               udYear.Position :=
  134.                               udYear.Position+(-1)+2*ord(Key = VK_NEXT)
  135.              else
  136.               udMonth.Position :=
  137.                               udMonth.Position+(-1)+2*ord(Key = VK_NEXT);
  138.            SetPositions(Self, btNext);
  139.            Key := 0;
  140.         end;
  141.   end;
  142. end;
  143.  
  144. procedure TfmCalendar.OkClick(Sender: TObject);
  145. begin
  146.    if (FField <> nil) and
  147.       (FField.DataSet <> nil) and
  148.       (FField.DataSet.CanModify) and
  149.       (not FField.ReadOnly) then
  150.    with FField.DataSet do
  151.    begin
  152.       if not (State in [dsEdit, dsInsert]) then
  153.          if IsEmpty then
  154.             Insert
  155.            else
  156.             Edit;
  157.       FField.AsDateTime := FCalendarDate;
  158.    end;
  159.    DeactivateForm(Sender);
  160. end;
  161.  
  162. procedure TfmCalendar.DeactivateForm(Sender: TObject);
  163. begin
  164.    Close;
  165. end;
  166.  
  167. procedure TfmCalendar.FormClose(Sender: TObject; var Action: TCloseAction);
  168. begin
  169.    if FAutoDestroy then
  170.      Action := caFree;
  171. end;
  172.  
  173. end.
  174.