home *** CD-ROM | disk | FTP | other *** search
/ PC Format Collection 48 / SENT14D.ISO / tech / delphi / disk15 / dataedit.pak / DATAEDIT.PAS
Encoding:
Pascal/Delphi Source File  |  1995-08-24  |  4.5 KB  |  153 lines
  1. unit DataEdit;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms,
  7.   Dialogs, Grids, Calendar, DB, DBTables;
  8.  
  9. type
  10.   TDBCalendar = class(TCalendar)
  11.   private
  12.     { Private declarations }
  13.     FDataLink: TFieldDataLink;  { field for data link }
  14.     procedure DataChange(Sender: TObject); { called when data changes }
  15.     function GetDataField: string;
  16.     function GetDataSource: TDataSource;
  17.     procedure SetDataField(const Value: string);
  18.     procedure SetDataSource(Value: TDataSource);
  19.     procedure UpdateData(Sender: TObject); { called when control changes }
  20.     procedure CMExit(var Message: TCMExit); message CM_EXIT; { called to update data }
  21.   protected
  22.     { Protected declarations }
  23.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  24.       X, Y: Integer); override;
  25.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  26.     procedure Change; override;
  27.   public
  28.     { Public declarations }
  29.     constructor Create(AOwner: TComponent); override;
  30.     destructor Destroy; override;
  31.   published
  32.     { Published declarations }
  33.     property DataField: string  read GetDataField write SetDataField;
  34.     property DataSource: TDataSource  read GetDataSource write SetDataSource;
  35.   end;
  36.  
  37. procedure Register;
  38.  
  39. implementation
  40.  
  41. procedure Register;
  42. begin
  43.   RegisterComponents('Samples', [TDBCalendar]);
  44. end;
  45.  
  46. constructor TDBCalendar.Create(AOwner: TComponent);
  47. begin
  48.   inherited Create(AOwner); { Always call the inherited constructor }
  49.   FDataLink := TFieldDataLink.Create; { construct data-link object }
  50.   FDataLink.OnDataChange := DataChange; { attach method to event }
  51.   FDataLink.OnUpdateData := UpdateData; { attach method to event }
  52. end;
  53.  
  54. destructor TDBCalendar.Destroy;
  55. begin
  56.   FDataLink.Free; { dispose of data-link object }
  57.   inherited Destroy; { then call inherited destructor }
  58. end;
  59.  
  60. procedure TDBCalendar.DataChange(Sender: TObject);
  61. begin
  62.   if FDataLink.Field = nil then { if there is no field assigned... }
  63.     CalendarDate := 0 { ...set to invalid date }
  64.   else CalendarDate := FDataLink.Field.AsDateTime; { otherwise, set to new data }
  65. end;
  66.  
  67. function TDBCalendar.GetDataField: string;
  68. begin
  69.   Result := FDataLink.FieldName; { pass through field name from data link }
  70. end;
  71.  
  72. function TDBCalendar.GetDataSource: TDataSource;
  73. begin
  74.   Result := FDataLink.DataSource; { pass through data source from data link }
  75. end;
  76.  
  77. procedure TDBCalendar.SetDataField(const Value: string);
  78. begin
  79.   FDataLink.FieldName := Value; { pass through field name to data link }
  80. end;
  81.  
  82. procedure TDBCalendar.SetDataSource(Value: TDataSource);
  83. begin
  84.   FDataLink.DataSource := Value; { pass through data source to data link }
  85. end;
  86.  
  87. { UpdateData
  88.  
  89.   UpdateData is only called after calls to both FDataLink.Modified and
  90.   FDataLink.UpdateRecord. }
  91.  
  92. procedure TDBCalendar.UpdateData(Sender: TObject);
  93. begin
  94.   FDataLink.Field.AsDateTime := CalendarDate; { set field data to calendar date }
  95. end;
  96.  
  97. { MouseDown
  98.  
  99.   Only process the mouse-down if the data link can edit the data. Otherwise,
  100.   just call the event handler to let the user handle the mouse-down event. }
  101.  
  102. procedure TDBCalendar.MouseDown(Button: TMouseButton; Shift: TShiftState;
  103.   X, Y: Integer);
  104. var
  105.   MyMouseDown: TMouseEvent;
  106. begin
  107.   if not ReadOnly and FDataLink.Edit then
  108.     inherited MouseDown(Button, Shift, X, Y)
  109.   else
  110.   begin
  111.     MyMouseDown := OnMouseDown;
  112.     if Assigned(MyMouseDown) then MyMouseDown(Self, Button, Shift, X, Y);
  113.   end;
  114. end;
  115.  
  116. { KeyDown
  117.  
  118.   Only process the key-down if the data link can edit the data. Otherwise,
  119.   just call the event handler to let the user handle the key-down event. }
  120.  
  121. procedure TDBCalendar.KeyDown(var Key: Word; Shift: TShiftState);
  122. var
  123.   MyKeyDown: TKeyEvent;
  124. begin
  125.   if not ReadOnly and (Key in [VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT, VK_END,
  126.     VK_HOME, VK_PRIOR, VK_NEXT]) and FDataLink.Edit then
  127.     inherited KeyDown(Key, Shift)
  128.   else
  129.   begin
  130.     MyKeyDown := OnKeyDown;
  131.     if Assigned(MyKeyDown) then MyKeyDown(Self, Key, Shift);
  132.   end;
  133. end;
  134.  
  135. procedure TDBCalendar.Change;
  136. begin
  137.   FDataLink.Modified; { tell data link that data changed }
  138.   inherited Change; { and call inherited, which calls event handler }
  139. end;
  140.  
  141. procedure TDBCalendar.CMExit(var Message: TCMExit);
  142. begin
  143.   try
  144.     FDataLink.UpdateRecord; { tell data link to update database }
  145.   except
  146.     SetFocus; { if it failed, don't let focus leave }
  147.     raise;
  148.   end;
  149.   inherited;
  150. end;
  151.  
  152. end.
  153.