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