MdTrack.pas
上传用户:fh681027
上传日期:2022-07-23
资源大小:1959k
文件大小:4k
源码类别:

Delphi控件源码

开发平台:

Delphi

  1. unit MdTrack;
  2. interface
  3. uses
  4.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  5.   ComCtrls, DB, DBCtrls;
  6. type
  7.   TMdDbTrack = class(TTrackBar)
  8.   private
  9.     FDataLink: TFieldDataLink;
  10.     function GetDataField: string;
  11.     procedure SetDataField (Value: string);
  12.     function GetDataSource: TDataSource;
  13.     procedure SetDataSource (Value: TDataSource);
  14.     function GetField: TField;
  15.     procedure CNHScroll(var Message: TWMHScroll); message CN_HSCROLL;
  16.     procedure CNVScroll(var Message: TWMVScroll); message CN_VSCROLL;
  17.     procedure CMExit(var Message: TCMExit); message CM_EXIT;
  18.   protected
  19.     // data link event handlers
  20.     procedure DataChange (Sender: TObject);
  21.     procedure UpdateData (Sender: TObject);
  22.     procedure ActiveChange (Sender: TObject);
  23.   public
  24.     constructor Create (AOwner: TComponent); override;
  25.     destructor Destroy; override;
  26.     property Field: TField read GetField;
  27.   published
  28.     property DataField: string
  29.       read GetDataField write SetDataField;
  30.     property DataSource: TDataSource
  31.       read GetDataSource write SetDataSource;
  32.   end;
  33. procedure Register;
  34. implementation
  35. constructor TMdDbTrack.Create (AOwner: TComponent);
  36. begin
  37.   inherited Create (AOwner);
  38.   FDataLink := TFieldDataLink.Create;
  39.   FDataLink.Control := self;
  40.   FDataLink.OnDataChange := DataChange;
  41.   FDataLink.OnUpdateData := UpdateData;
  42.   FDataLink.OnActiveChange := ActiveChange;
  43.   Enabled := False;
  44. end;
  45. destructor TMdDbTrack.Destroy;
  46. begin
  47.   FDataLink.Free;
  48.   FDataLink := nil;
  49.   inherited Destroy;
  50. end;
  51. function TMdDbTrack.GetDataField: string;
  52. begin
  53.   Result := FDataLink.FieldName;
  54. end;
  55. procedure TMdDbTrack.SetDataField (Value: string);
  56. begin
  57.   try
  58.     FDataLink.FieldName := Value;
  59.   finally
  60.     Enabled := FDataLink.Active and
  61.       (FDataLink.Field <> nil) and
  62.       not FDataLink.Field.ReadOnly;
  63.   end;
  64. end;
  65. function TMdDbTrack.GetDataSource: TDataSource;
  66. begin
  67.   Result := FDataLink.DataSource;
  68. end;
  69. procedure TMdDbTrack.SetDataSource (Value: TDataSource);
  70. begin
  71.   FDataLink.DataSource := Value;
  72.   Enabled := FDataLink.Active and
  73.     (FDataLink.Field <> nil) and
  74.     not FDataLink.Field.ReadOnly;
  75. end;
  76. function TMdDbTrack.GetField: TField;
  77. begin
  78.   Result := FDataLink.Field;
  79. end;
  80. // data link event handler
  81. procedure TMdDbTrack.DataChange (Sender: TObject);
  82. begin
  83.   if (FDataLink.Field <> nil) and
  84.       (FDataLink.Field is TNumericField) then
  85.     Position := FDataLink.Field.AsInteger
  86.   else
  87.     Position := Min;
  88. end;
  89. procedure TMdDbTrack.ActiveChange (Sender: TObject);
  90. begin
  91.   Enabled := FDataLink.Active and
  92.     (FDataLink.Field <> nil) and
  93.     not FDataLink.Field.ReadOnly;
  94. end;
  95. // update
  96. procedure TMdDbTrack.CNHScroll(var Message: TWMHScroll);
  97. begin
  98.   // edit mode
  99.   FDataLink.Edit;
  100.   // update data
  101.   inherited;
  102.   // let the system know
  103.   FDataLink.Modified;
  104. end;
  105. procedure TMdDbTrack.CNVScroll(var Message: TWMVScroll);
  106. begin
  107.   // edit mode
  108.   FDataLink.Edit;
  109.   // update data
  110.   inherited;
  111.   // let the system know
  112.   FDataLink.Modified;
  113. end;
  114. procedure TMdDbTrack.CMExit(var Message: TCMExit);
  115. begin
  116.   try
  117.     FDataLink.UpdateRecord;
  118.   except
  119.     SetFocus;
  120.     raise;
  121.   end;
  122.   inherited;
  123. end;
  124. procedure TMdDbTrack.UpdateData (Sender: TObject);
  125. begin
  126.   if (FDataLink.Field <> nil) and
  127.       (FDataLink.Field is TNumericField) then
  128.     FDataLink.Field.AsInteger := Position;
  129. end;
  130. procedure Register;
  131. begin
  132.   RegisterComponents('Md', [TMdDbTrack]);
  133. end;
  134. end.