pDBBarcode.pas
上传用户:xdwang_66
上传日期:2016-04-26
资源大小:1726k
文件大小:4k
源码类别:

Static控件

开发平台:

Delphi

  1. // =============================================================================
  2. //
  3. // Barcode VCL Component
  4. //
  5. // For Delphi 4/5/6/7, C++ Builder 4/5/6, BDS 2005/2005, Turbo Delphi 2006
  6. //
  7. // Copyright (c) 2001, 2007  Han-soft Software, all rights reserved.
  8. //
  9. // $Rev: 44 $   $Id: pDBBarcode.pas 44 2007-01-16 01:16:04Z hanjy $
  10. //
  11. // =============================================================================
  12. unit pDBBarcode;
  13. interface
  14. uses
  15.   SysUtils, Classes, Controls, ExtCtrls, pBarCode, DBCtrls, DB, Messages;
  16. type
  17.   TDBBarcode = class(TBarCode)
  18.   private
  19.     { Private declarations }
  20.     FDataLink: TFieldDataLink;
  21.     procedure DataChange(Sender: TObject);
  22.     function  GetDataField: string;
  23.     function  GetDataSource: TDataSource;
  24.     function  GetField: TField;
  25.     function  GetReadOnly: Boolean;
  26.     procedure SetDataField(const Value: string);
  27.     procedure SetDataSource(Value: TDataSource);
  28.     procedure SetReadOnly(Value: Boolean);
  29.     procedure UpdateData(Sender: TObject);
  30.     procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
  31.   protected
  32.     { Protected declarations }
  33.     procedure SetBarcode(const Value: string); override;
  34.     procedure Notification(AComponent: TComponent;
  35.       Operation: TOperation); override;
  36.   public
  37.     { Public declarations }
  38.     constructor Create(AOwner: TComponent); override;
  39.     destructor  Destroy; override;
  40.     function  ExecuteAction(Action: TBasicAction): Boolean; override;
  41.     function  UpdateAction(Action: TBasicAction): Boolean; override;
  42.     property  Field: TField read GetField;
  43.   published
  44.     { Published declarations }
  45.     property DataField: string read GetDataField write SetDataField;
  46.     property DataSource: TDataSource read GetDataSource write SetDataSource;
  47.     property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
  48.   end;
  49. implementation
  50. constructor TDBBarcode.Create(AOwner: TComponent);
  51. begin
  52.   inherited Create(AOwner);
  53.   ControlStyle := ControlStyle + [csReplicatable];
  54.   FDataLink := TFieldDataLink.Create;
  55.   FDataLink.Control := Self;
  56.   FDataLink.OnDataChange := DataChange;
  57.   FDataLink.OnUpdateData := UpdateData;
  58. end;
  59. destructor TDBBarcode.Destroy;
  60. begin
  61.   FDataLink.Free;
  62.   FDataLink := nil;
  63.   inherited Destroy;
  64. end;
  65. procedure TDBBarcode.DataChange(Sender: TObject);
  66. begin
  67.   if FDataLink.Field <> nil then
  68.     Barcode := FDataLink.Field.Text
  69.   else
  70.     Barcode := '';
  71. end;
  72. procedure TDBBarcode.SetBarcode(const Value: string);
  73. begin
  74.   if csDesigning in ComponentState then
  75.     inherited
  76.   else
  77.     if not ((FDataLink.Field = nil) or FDataLink.Field.ReadOnly or
  78.       FDataLink.ReadOnly) then
  79.     begin
  80.       if FDataLink.Field.Text <> Value then FDataLink.Field.Text := Value;
  81.       inherited;
  82.     end;
  83. end;
  84. procedure TDBBarcode.UpdateData(Sender: TObject);
  85. begin
  86.   FDataLink.Field.Text := Barcode;
  87. end;
  88. function TDBBarcode.GetDataSource: TDataSource;
  89. begin
  90.   Result := FDataLink.DataSource;
  91. end;
  92. procedure TDBBarcode.SetDataSource(Value: TDataSource);
  93. begin
  94.   if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
  95.     FDataLink.DataSource := Value;
  96.   if Value <> nil then Value.FreeNotification(Self);
  97. end;
  98. function TDBBarcode.GetDataField: string;
  99. begin
  100.   Result := FDataLink.FieldName;
  101. end;
  102. procedure TDBBarcode.SetDataField(const Value: string);
  103. begin
  104.   FDataLink.FieldName := Value;
  105. end;
  106. function TDBBarcode.GetReadOnly: Boolean;
  107. begin
  108.   Result := FDataLink.ReadOnly;
  109. end;
  110. procedure TDBBarcode.SetReadOnly(Value: Boolean);
  111. begin
  112.   FDataLink.ReadOnly := Value;
  113. end;
  114. function TDBBarcode.GetField: TField;
  115. begin
  116.   Result := FDataLink.Field;
  117. end;
  118. procedure TDBBarcode.CMGetDataLink(var Message: TMessage);
  119. begin
  120.   Message.Result := Integer(FDataLink);
  121. end;
  122. procedure TDBBarcode.Notification(AComponent: TComponent;
  123.   Operation: TOperation);
  124. begin
  125.   inherited Notification(AComponent, Operation);
  126.   if (Operation = opRemove) and (FDataLink <> nil) and
  127.     (AComponent = DataSource) then DataSource := nil;
  128. end;
  129. function TDBBarcode.ExecuteAction(Action: TBasicAction): Boolean;
  130. begin
  131.   Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
  132.     FDataLink.ExecuteAction(Action);
  133. end;
  134. function TDBBarcode.UpdateAction(Action: TBasicAction): Boolean;
  135. begin
  136.   Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
  137.     FDataLink.UpdateAction(Action);
  138. end;
  139. end.