Mega Code Archive
StaticText link to a DB ressource
<![CDATA[
Title: StaticText link to a DB ressource
Question: Here is a little cute DB ressource component
Answer:
unit RVDBStaticText;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, DBCtrls, Db;
type
TRVDBStaticText = class(TCustomStaticText)
private
FDataLink: TFieldDataLink;
procedure DataChange(Sender: TObject);
function GetDataField: string;
function GetDataSource: TDataSource;
function GetField: TField;
function GetFieldText: string;
procedure SetDataField(const Value: string);
procedure SetDataSource(Value: TDataSource);
procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
protected
function GetLabelText: string;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function ExecuteAction(Action: TBasicAction): Boolean; override;
function UpdateAction(Action: TBasicAction): Boolean; override;
property Field: TField read GetField;
published
property Align;
property Alignment;
property Anchors;
property AutoSize;
property BiDiMode;
property BorderStyle;
property Color;
property Constraints;
property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write SetDataSource;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property FocusControl;
property Font;
property ParentBiDiMode;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowAccelChar;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Rendez-vous (DB)', [TRVDBStaticText]);
end;
{ TRVDBStaticText }
procedure TRVDBStaticText.CMGetDataLink(var Message: TMessage);
begin
Message.Result := Integer(FDataLink);
end;
constructor TRVDBStaticText.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle+[csReplicatable];
Height := 17;
AutoSize := True;
ShowAccelChar := False;
FDataLink := TFieldDataLink.Create;
FDataLink.Control := Self;
FDataLink.OnDataChange := DataChange;
end;
procedure TRVDBStaticText.DataChange(Sender: TObject);
begin
Caption := GetFieldText;
end;
destructor TRVDBStaticText.Destroy;
begin
FDataLink.Free;
FDataLink := Nil;
inherited Destroy;
end;
function TRVDBStaticText.ExecuteAction(Action: TBasicAction): Boolean;
begin
Result := inherited ExecuteAction(Action) or (FDataLinkNil) and
FDataLink.ExecuteAction(Action);
end;
function TRVDBStaticText.GetDataField: string;
begin
Result := FDataLink.FieldName;
end;
function TRVDBStaticText.GetDataSource: TDataSource;
begin
Result := FDataLink.DataSource;
end;
function TRVDBStaticText.GetField: TField;
begin
Result := FDataLink.Field;
end;
function TRVDBStaticText.GetFieldText: string;
begin
if FDataLink.Field Nil then
Result := FDataLink.Field.DisplayText
else
if csDesigning in ComponentState then Result := Name else Result := '';
end;
function TRVDBStaticText.GetLabelText: string;
begin
if csPaintCopy in ControlState then
Result := GetFieldText
else
Result := Caption;
end;
procedure TRVDBStaticText.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation=opRemove) and (FDataLinkNil) and
(AComponent=DataSource) then DataSource := Nil;
end;
procedure TRVDBStaticText.SetDataField(const Value: string);
begin
FDataLink.FieldName := Value;
end;
procedure TRVDBStaticText.SetDataSource(Value: TDataSource);
begin
if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
FDataLink.DataSource := Value;
if ValueNil then Value.FreeNotification(Self);
end;
function TRVDBStaticText.UpdateAction(Action: TBasicAction): Boolean;
begin
Result := inherited UpdateAction(Action) or (FDataLinkNil) and
FDataLink.UpdateAction(Action);
end;
end.
]]>