Разработка DB-Aware компонентов

TDataLink = class(TPersistent)
      
  protected
    procedure ActiveChanged; virtual;
    procedure CheckBrowseMode; virtual;
    procedure DataEvent(Event: TDataEvent; Info: Longint); virtual;
    procedure DataSetChanged; virtual;
    procedure DataSetScrolled(Distance: Integer); virtual;
    procedure EditingChanged; virtual;
    procedure FocusControl(Field: TFieldRef); virtual;
    function GetActiveRecord: Integer; virtual;
    function GetBOF: Boolean; virtual;
    function GetBufferCount: Integer; virtual;
    function GetEOF: Boolean; virtual;
    function GetRecordCount: Integer; virtual;
    procedure LayoutChanged; virtual;
    function MoveBy(Distance: Integer): Integer; virtual;
    procedure RecordChanged(Field: TField); virtual;
    procedure SetActiveRecord(Value: Integer); virtual;
    procedure SetBufferCount(Value: Integer); virtual;
    procedure UpdateData; virtual;
    property VisualControl: Boolean read FVisualControl write FVisualControl;
  public
    constructor Create;
    destructor Destroy; override;
    function Edit: Boolean;
    function ExecuteAction(Action: TBasicAction): Boolean; dynamic;
    function UpdateAction(Action: TBasicAction): Boolean; dynamic;
    procedure UpdateRecord;
    property Active: Boolean read FActive;
    property ActiveRecord: Integer read GetActiveRecord write SetActiveRecord;
    property BOF: Boolean read GetBOF;
    property BufferCount: Integer read FBufferCount write SetBufferCount;
    property DataSet: TDataSet read GetDataSet;
    property DataSource: TDataSource read FDataSource write SetDataSource;
    property DataSourceFixed: Boolean read FDataSourceFixed write FDataSourceFixed;
    property Editing: Boolean read FEditing;
    property Eof: Boolean read GetEOF;
    property ReadOnly: Boolean read FReadOnly write SetReadOnly;
    property RecordCount: Integer read GetRecordCount;
  end;

TDBEdit = class(TCustomMaskEdit)
  private
    FDataLink: TFieldDataLink;
    FCanvas: TControlCanvas;
    // вырезано для экономии места

    procedure ActiveChange(Sender: TObject);
    procedure DataChange(Sender: TObject);
    procedure EditingChange(Sender: TObject);
    procedure SetDataField(const Value: string);
    procedure SetDataSource(Value: TDataSource);
    procedure SetFocused(Value: Boolean);
    procedure SetReadOnly(Value: Boolean);
    procedure UpdateData(Sender: TObject);
    procedure WMCut(var Message: TMessage); message WM_CUT;
    procedure WMPaste(var Message: TMessage); message WM_PASTE;
    procedure WMUndo(var Message: TMessage); message WM_UNDO;
    procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
    procedure CMExit(var Message: TCMExit); message CM_EXIT;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;

  protected
    procedure Change; override;
    function EditCanModify: Boolean; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure Reset; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function UseRightToLeftAlignment: Boolean; override;
    property Field: TField read GetField;
    // вырезано для экономии места
  published
    // вырезано для экономии места
    property DataField: string read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
  end;

constructor TDBEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  inherited ReadOnly := True;
  ControlStyle := ControlStyle + [csReplicatable];
  FDataLink := TFieldDataLink.Create;
  FDataLink.Control := Self;
  FDataLink.OnDataChange := DataChange;
  FDataLink.OnEditingChange := EditingChange;
  FDataLink.OnUpdateData := UpdateData;
  FDataLink.OnActiveChange := ActiveChange;
end;

type
  TmmDBListRadioGroup = class;

  TmmRGListDataLink = class(TFieldDataLink)
  private
    FRadioGroup: TmmDBListRadioGroup;
  protected
    procedure ActiveChanged; override;
    procedure RecordChanged(Field: TField); override;
    function ValidListSource: Boolean;
    function ValidListField: Boolean;
  public
    constructor Create(AOwner: TmmDBListRadioGroup); reintroduce; virtual;
  end;

procedure TmmRGListDataLink.ActiveChanged;
begin
  inherited;
  FRadioGroup.RefreshButtons;
end;

constructor TmmRGListDataLink.Create(AOwner: TmmDBListRadioGroup);
begin
  inherited Create;
  FRadioGroup := AOwner;
end;

procedure TmmRGListDataLink.RecordChanged(Field: TField);
begin
  inherited;
  if Assigned(Field) and (Field = DataSet.FindField(FieldName)) then
    FRadioGroup.RefreshButtons;
end;

function TmmRGListDataLink.ValidListField: Boolean;
begin
  Result := ValidListSource and Assigned(DataSet.FindField(FieldName))
end;

function TmmRGListDataLink.ValidListSource: Boolean;
begin
  Result := Assigned(DataSource) and Assigned(DataSet)
end;

  mmDBListRadioGroup = class(TCustomRadioGroup)
  private
    FListLink: TmmRGListDataLink;
    FListField: string;
    procedure SetListField(const Value: string);
    procedure SetListSource(const Value: TDataSource);
    function GetListSource: TDataSource;
  protected
    procedure RefreshButtons; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Items;
  published
    property ListSource: TDataSource read GetListSource write SetListSource;
    property ListField: string read FListField write SetListField;
    // published props
    property Align;
    property Anchors;
    property BiDiMode;
    property Caption;
    property Color;
    property Columns;
    property Ctl3D;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property ItemIndex;
    property Constraints;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnClick;
    property OnContextPopup;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnStartDock;
    property OnStartDrag;
  end;

constructor TmmDBListRadioGroup.Create(AOwner: TComponent);
begin
  inherited;
  FListLink := TmmRGListDataLink.Create(Self);
end;

destructor TmmDBListRadioGroup.Destroy;
begin
  FListLink.Free;
  inherited;
end;

function TmmDBListRadioGroup.GetListSource: TDataSource;
begin
  Result := FListLink.DataSource;
end;

procedure TmmDBListRadioGroup.RefreshButtons;
var
  VOldPlace: TBookmark;
begin
  if FListLink.ValidListSource and FListLink.DataSet.Active
    then
    with FListLink.DataSet do
    begin
      DisableControls;
      FListLink.FieldName := FListField;
      if FListLink.ValidListField then
      begin
        VOldPlace := FListLink.DataSet.GetBookmark;
        Items.Clear;
        First;
        while not Eof do
        begin
          Items.Add(FieldValues[ListField]);
          Next;
        end;
        FListLink.DataSet.GotoBookmark(VOldPlace);
      end;
      EnableControls;
    end
else
  begin
   Enabled := False;
   Items.Clear;
  end;
end;

procedure TmmDBListRadioGroup.SetListField(const Value: string);
begin
  if FListField <> Value then
  begin
    FListField := Value;
    RefreshButtons;
  end;
end;

procedure TmmDBListRadioGroup.SetListSource(const Value: TDataSource);
begin
  FListLink.DataSource := Value;
  RefreshButtons;
end;

  TmmDBLookUpRadioGroup = class;

  TmmRGWriteDataLink = class(TFieldDataLink)
  private
    FRadioGroup: TmmDBLookUpRadioGroup;
  protected
    procedure DataSetScrolled(Distance: Integer); override;
    procedure EditingChanged; override;
    function EditState: Boolean;
    function ValidDataSource: Boolean;
    function ValidDataField: Boolean;
  public
    constructor Create(AOwner: TmmDBLookUpRadioGroup); reintroduce; virtual;
  end;

{ TmmRGWriteDataLink }


constructor TmmRGWriteDataLink.Create(AOwner: TmmDBLookUpRadioGroup);
begin
  inherited Create;
  FRadioGroup := AOwner;
  EditingChanged;
end;


procedure TmmRGWriteDataLink.DataSetScrolled(Distance: Integer);
begin
  inherited;
  if ValidDataField then
    with FRadioGroup do
      ItemIndex := Items.IndexOf(DataSet.FieldByName(FieldName).AsString);
end;

procedure TmmRGWriteDataLink.EditingChanged;
begin
  inherited;
  FRadioGroup.Enabled:=EditState;
end;

function TmmRGWriteDataLink.EditState: Boolean;
begin
  Result := ValidDataField and (DataSet.State in [DsEdit, dsInsert])
end;

function TmmRGWriteDataLink.ValidDataField: Boolean;
begin
  Result := ValidDataSource and Assigned(DataSet.FindField(FieldName));
end;

function TmmRGWriteDataLink.ValidDataSource: Boolean;
begin
  Result := Assigned(DataSource) and Assigned(DataSet);
end;

  TmmDBLookUpRadioGroup = class(TmmDBListRadioGroup)
  private
    FDataLink: TmmRGWriteDataLink;
    procedure SetDataField(const Value: string);
    procedure SetDataSource(const Value: TDataSource);
    function GetDataField: string;
    function GetDataSource: TDataSource;
  protected
    procedure Click; override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property DataField: string read GetDataField write SetDataField;
  end;


  TmmDBLookUpRadioGroup = class(TmmDBListRadioGroup)
  private
    FDataLink: TmmRGWriteDataLink;
    procedure SetDataField(const Value: string);
    procedure SetDataSource(const Value: TDataSource);
    function GetDataField: string;
    function GetDataSource: TDataSource;
  protected
    procedure Click; override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property DataField: string read GetDataField write SetDataField;
  end;


{ TmmDBLookUpRadioGroup }

procedure TmmDBLookUpRadioGroup.Click;
begin
  inherited;
  if FDataLink.EditState then
    with FDataLink do
          Field.Value := Items[ItemIndex];
end;

constructor TmmDBLookUpRadioGroup.Create(Aowner: TComponent);
begin
  inherited;
  FDataLink := TmmRGWriteDataLink.Create(Self);
  Enabled:=False;
end;

function TmmDBLookUpRadioGroup.GetDataField: string;
begin
  Result := FDataLink.FieldName;
end;

function TmmDBLookUpRadioGroup.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;

procedure TmmDBLookUpRadioGroup.SetDataField(const Value: string);
begin
  FDataLink.FieldName := Value;
end;

procedure TmmDBLookUpRadioGroup.SetDataSource(const Value: TDataSource);
begin
  FDataLink.DataSource := Value;
end;