_abdb.pas

著名的虚拟仪表控件,包含全部源码, 可以在,delphi2007 下安装运行

unit _AbDB;

{******************************************************************************}
{ Abakus VCL                                                                   }
{                          Class TAbFieldDataLink                              }
{                                                                              }
{******************************************************************************}
{        e-Mail: [e-mail] , Web: http://www.abaecker.com            }
{------------------------------------------------------------------------------}
{          (c) Copyright 1998..2000 A.Baecker, All rights Reserved             }
{******************************************************************************}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  dbctrls, dB;

type
  TDType = (dtInteger, dtSingle, dtBoolean, dtUnSupported);

  TAbFieldDataLink = class(TFieldDataLink)
  private
    FOnDataRead: TNotifyEvent;
    Writing: Boolean;
    function DbWrite: Boolean;
  protected
    procedure ActiveChanged; override;
    procedure EditingChanged; override;
    procedure UpdateData; override;
    procedure DataChange(Sender: TObject);
    procedure SetDTyp;
  public
    DType: TDType;
    ValueSingle: Single;
    ValueInt: Integer;
    ValueBool: Boolean;
    constructor Create;
    destructor Destroy; override;

    function DbWriteSingle(Value: Single): Boolean;
    function DbWriteInteger(Value: Integer): Boolean;
    function DbWriteBoolean(Value: Boolean): Boolean;
  published
    property OnDataRead: TNotifyEvent read FOnDataRead write FOnDataRead;
  end;

implementation

constructor TAbFieldDataLink.Create;
begin
  inherited Create;
  DType := dtUnSupported;
  Writing := false;
  OnDataChange := DataChange;
end;


destructor TAbFieldDataLink.Destroy;
begin
  inherited;
end;


procedure TAbFieldDataLink.SetDTyp;
begin
  if Field <> nil then
  begin

    case Field.DataType of
      ftSmallint, ftInteger, ftWord:
        DType := dtInteger;
      ftFloat:
        DType := dtSingle;
      ftBoolean:
        DType := dtBoolean;
    else
      DType := dtUnSupported;
      FieldName := '';
    end;
  end
  else
    DType := dtUnSupported;
end;

procedure TAbFieldDataLink.UpdateData;
begin
  inherited;
end;

procedure TAbFieldDataLink.ActiveChanged;
begin
  inherited;
end;

procedure TAbFieldDataLink.EditingChanged;
begin
  inherited;

end;

procedure TAbFieldDataLink.DataChange(Sender: TObject);
begin
  if (not Assigned(DataSource)) or Writing then Exit;
  if Field <> nil then
  begin
    SetDTyp;
    case DType of
      dtInteger:
        if (ValueInt <> Field.AsInteger) then
        begin
          ValueInt := Field.AsInteger;
          ValueSingle := ValueInt;
          ValueBool := (ValueInt = 1);
          if Assigned(FOnDataRead) then FOnDataRead(self);
        end;
      dtSingle:
        if (ValueSingle <> Field.AsFloat) then
        begin
          ValueSingle := Field.AsFloat;
          ValueInt := Trunc(ValueSingle);
          ValueBool := (ValueInt = 1);
          if Assigned(FOnDataRead) then FOnDataRead(self);
        end;
      dtBoolean:
        if (ValueBool <> Field.AsBoolean) then
        begin
          ValueBool := Field.AsBoolean;
          ValueInt := ord(ValueBool);
          ValueSingle := ValueInt;
          if Assigned(FOnDataRead) then FOnDataRead(self);
        end;
    else
      Exit;
    end;
  end;
end;

function TAbFieldDataLink.DbWrite: Boolean;
begin
  result := false;

  if (not Assigned(DataSet)) or
    (not Assigned(Field)) or
    (not Assigned(DataSource)) then Exit;

  if (DataSource.State in [dsInactive]) then Exit;
  if Field.IsIndexField then Exit;

  SetDTyp;
  try
    if edit then
    begin
      Writing := true;
      result := true;
      case DType of
        dtSingle:
          Field.AsFloat := ValueSingle;
        dtInteger:
          Field.AsInteger := ValueInt;
        dtBoolean:
          Field.AsBoolean := ValueBool;
      else
        result := false;
      end;
    end;
    Modified;
    UpdateRecord;
  except
    on EDatabaseError do ReadOnly := true;
  end;
  Writing := false;
end;

function TAbFieldDataLink.DbWriteSingle(Value: Single): Boolean;
begin
  result := false;

  if not CanModify then Exit;
  if Field.IsIndexField then Exit;

  if Value <> ValueSingle then
  begin
    edit;                               // try to change in edit-mode
    ValueSingle := Value;
    ValueInt := Trunc(ValueSingle);
    ValueBool := (ValueInt = 1);
  end
  else
    Exit;

  result := DbWrite;

end;

function TAbFieldDataLink.DbWriteInteger(Value: Integer): Boolean;
begin
  result := false;
  if Field.IsIndexField then Exit;

  if Value <> ValueInt then
  begin
    edit;                               // try to change in edit-mode
    ValueInt := Value;
    ValueSingle := ValueInt;
    ValueBool := (ValueInt = 1);
  end
  else
    Exit;

  result := DbWrite;
end;

function TAbFieldDataLink.DbWriteBoolean(Value: Boolean): Boolean;
begin
  result := false;
  if Field.IsIndexField then Exit;

  if Value <> ValueBool then
  begin
    edit;                               // try to change in edit-mode
    ValueBool := Value;
    ValueInt := ord(Value);
    ValueSingle := ValueInt;
  end
  else
    Exit;

  result := DbWrite;

end;



end.