Static控件

开发平台：
Delphi

pQRDBBarcode.pas：源码内容
							// =============================================================================
//
// Barcode VCL Component for Quick Report
//
// For Delphi 4/5/6/7, C++ Builder 4/5/6, BDS 2005/2005, Turbo Delphi 2006
//
// Copyright (c) 2001, 2007  Han-soft Software, all rights reserved.
//
// $Rev: 44 $   $Id: pQRDBBarcode.pas 44 2007-01-16 01:16:04Z hanjy $
//
// =============================================================================
unit pQRDBBarcode;
interface
uses
  SysUtils, Classes, Controls, ExtCtrls, pBarCode, DBCtrls, DB, Messages,
  {DBTables,} pQRBarcode;
type
  TQRDBBarcode = class(TQRBarCode)
  private
    { Private declarations }
    FDataLink: TFieldDataLink;
    procedure DataChange(Sender: TObject);
    function  GetDataField: string;
    function  GetDataSource: TDataSource;
    function  GetField: TField;
    function  GetReadOnly: Boolean;
    procedure SetDataField(const Value: string);
    procedure SetDataSource(Value: TDataSource);
    procedure SetReadOnly(Value: Boolean);
    procedure UpdateData(Sender: TObject);
    procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
  protected
    { Protected declarations }
    procedure SetBarcode(const Value: string); override;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
  public
    { Public declarations }
    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
    { Published declarations }
    property DataField: string read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
  end;
implementation
constructor TQRDBBarcode.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csReplicatable];
  FDataLink := TFieldDataLink.Create;
  FDataLink.Control := Self;
  FDataLink.OnDataChange := DataChange;
  FDataLink.OnUpdateData := UpdateData;
end;
destructor TQRDBBarcode.Destroy;
begin
  FDataLink.Free;
  FDataLink := nil;
  inherited Destroy;
end;
procedure TQRDBBarcode.DataChange(Sender: TObject);
begin
  if FDataLink.Field <> nil then
    Barcode := FDataLink.Field.Text
  else
    Barcode := '';
end;
procedure TQRDBBarcode.SetBarcode(const Value: string);
begin
  if csDesigning in ComponentState then
    inherited
  else
    if not ((FDataLink.Field = nil) or FDataLink.Field.ReadOnly or
      FDataLink.ReadOnly) then
    begin
      if FDataLink.Field.Text <> Value then FDataLink.Field.Text := Value;
      inherited;
    end;
end;
procedure TQRDBBarcode.UpdateData(Sender: TObject);
begin
  FDataLink.Field.Text := Barcode;
end;
function TQRDBBarcode.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;
procedure TQRDBBarcode.SetDataSource(Value: TDataSource);
begin
  if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
    FDataLink.DataSource := Value;
  if Value <> nil then Value.FreeNotification(Self);
end;
function TQRDBBarcode.GetDataField: string;
begin
  Result := FDataLink.FieldName;
end;
procedure TQRDBBarcode.SetDataField(const Value: string);
begin
  FDataLink.FieldName := Value;
end;
function TQRDBBarcode.GetReadOnly: Boolean;
begin
  Result := FDataLink.ReadOnly;
end;
procedure TQRDBBarcode.SetReadOnly(Value: Boolean);
begin
  FDataLink.ReadOnly := Value;
end;
function TQRDBBarcode.GetField: TField;
begin
  Result := FDataLink.Field;
end;
procedure TQRDBBarcode.CMGetDataLink(var Message: TMessage);
begin
  Message.Result := Integer(FDataLink);
end;
procedure TQRDBBarcode.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (FDataLink <> nil) and
    (AComponent = DataSource) then DataSource := nil;
end;
function TQRDBBarcode.ExecuteAction(Action: TBasicAction): Boolean;
begin
  Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
    FDataLink.ExecuteAction(Action);
end;
function TQRDBBarcode.UpdateAction(Action: TBasicAction): Boolean;
begin
  Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
    FDataLink.UpdateAction(Action);
end;
end.

						