ddhdbled.pas

Delphi高级开发指南是开发程序的好帮手

unit DdhDbLed;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  DdhLed, Db, DbCtrls;

type
  TDdhDbLed = class(TDdhLed)
  private
    // data-aware support
    FDataLink: TFieldDataLink;
    function GetDataField: string;
    procedure SetDataField (Value: string);
    function GetDataSource: TDataSource;
    procedure SetDataSource (Value: TDataSource);
    function GetField: TField;
    // DbCtrlGrid support
    function GetStatus: TDdhLedStatus;
    procedure CmGetDataLink (var Msg: TMessage);
      message cm_GetDataLink;
  protected
    // data link event handler
    procedure DataChange (Sender: TObject);
  public
    constructor Create (AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
    procedure Paint; override;
    property Field: TField read GetField;
  published
    property DataField: string
      read GetDataField write SetDataField;
    property DataSource: TDataSource
      read GetDataSource write SetDataSource;
  end;

procedure Register;

implementation

constructor TDdhDbLed.Create (AOwner: TComponent);
begin
  inherited Create (AOwner);
  // enable use in DBCtrlGrid
  ControlStyle := ControlStyle + [csReplicatable];
  // data link
  FDataLink := TFieldDataLink.Create;
  FDataLink.Control := self;
  FDataLink.OnDataChange := DataChange;
end;

destructor TDdhDbLed.Destroy;
begin
  FDataLink.Free;
  FDataLink := nil;
  inherited Destroy;
end;

procedure TDdhDbLed.Loaded;
begin
  inherited Loaded;
  if (csDesigning in ComponentState) then
    DataChange(Self);
end;

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

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

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

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

function TDdhDbLed.GetField: TField;
begin
  Result := FDataLink.Field;
end;

// data link event handler
procedure TDdhDbLed.DataChange (Sender: TObject);
begin
  Status := GetStatus;
end;

function TDdhDbLed.GetStatus: TDdhLedStatus;
begin
  if (FDataLink.Field <> nil) and
      (FDataLink.Field is TBooleanField) and
      FDataLink.Field.AsBoolean then
    Result := lsOn
  else
    Result := lsOff;
end;

// DBCtrlGrid support methods

procedure TDdhDbLed.CmGetDataLink (var Msg: TMessage);
begin
  Msg.Result := Integer (fDataLink);
end;

procedure TDdhDbLed.Paint;
var
  OldStatus: TDdhLedStatus;
begin
  OldStatus := Status;
  if csPaintCopy in ControlState then
    Status := GetStatus;
  inherited Paint;
  if csPaintCopy in ControlState then
    Status := OldStatus;
end;

procedure Register;
begin
  RegisterComponents('DDHB DB', [TDdhDbLed]);
end;

end.