home *** CD-ROM | disk | FTP | other *** search
/ DOS/V Power Report 1996 August / VPR9608A.BIN / del20try / install / data.z / DBCAL.PAS < prev    next >
Pascal/Delphi Source File  |  1996-05-08  |  2KB  |  100 lines
  1. unit DBCal;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   Grids, CalSamp, DB, DBTables;
  8.  
  9. type
  10.   TDBCalendar = class(TSampleCalendar)
  11.   private
  12.     FDataLink: TFieldDataLink;
  13.     FReadOnly: Boolean;
  14.     FUpdating: Boolean;
  15.     procedure DataChange(Sender: TObject);
  16.     function GetDataField: string;
  17.     function GetDataSource: TDataSource;
  18.     procedure SetDataField(const Value: string);
  19.     procedure SetDataSource(Value: TDataSource);
  20.   protected
  21.     function SelectCell(ACol, ARow: Longint): Boolean; override;
  22.   public
  23.     constructor Create(AOwner: TComponent); override;
  24.     destructor Destroy; override;
  25.     procedure UpdateCalendar; override;
  26.   published
  27.     property DataField: string  read GetDataField write SetDataField;
  28.     property DataSource: TDataSource  read GetDataSource write SetDataSource;
  29.     property ReadOnly: Boolean  read FReadOnly write FReadOnly default True;
  30.   end;
  31.  
  32. procedure Register;
  33.  
  34. implementation
  35.  
  36. constructor TDBCalendar.Create(AOwner: TComponent);
  37. begin
  38.   inherited Create(AOwner);
  39.   FReadOnly := True;
  40.   FDataLink := TFieldDataLink.Create;
  41.   FDataLink.OnDataChange := DataChange;
  42. end;
  43.  
  44. destructor TDBCalendar.Destroy;
  45. begin
  46.   FDataLink.OnDataChange := nil;
  47.   FDataLink.Free;
  48.   inherited Destroy;
  49. end;
  50.  
  51. procedure TDBCalendar.DataChange(Sender: TObject);
  52. begin
  53.   if FDataLink.FIeld = nil then
  54.     CalendarDate := 0
  55.   else CalendarDate := FDataLink.Field.AsDateTime;
  56. end;
  57.  
  58. function TDBCalendar.GetDataField: string;
  59. begin
  60.   Result := FDataLink.FieldName;
  61. end;
  62.  
  63. function TDBCalendar.GetDataSource: TDataSource;
  64. begin
  65.   Result := FDataLink.DataSource;
  66. end;
  67.  
  68. function TDBCalendar.SelectCell(ACol, ARow: Longint): Boolean;
  69. begin
  70.   if (not FUpdating) and FReadOnly then Result := False
  71.   else Result := inherited SelectCell(ACol, ARow);
  72. end;
  73.  
  74. procedure TDBCalendar.SetDataField(const Value: string);
  75. begin
  76.   FDataLink.FieldName := Value;
  77. end;
  78.  
  79. procedure TDBCalendar.SetDataSource(Value: TDataSource);
  80. begin
  81.   FDataLink.DataSource := Value;
  82. end;
  83.  
  84. procedure TDBCalendar.UpdateCalendar;
  85. begin
  86.   FUpdating := True;
  87.   try
  88.     inherited UpdateCalendar;
  89.   finally
  90.     FUpdating := False;
  91.   end;
  92. end;
  93.  
  94. procedure Register;
  95. begin
  96.   RegisterComponents('Samples', [TDBCalendar]);
  97. end;
  98.  
  99. end.
  100.