adbmaker.pas

来自「delphi编程控件」· PAS 代码 · 共 386 行

unit adbmaker;
(*
 COPYRIGHT (c) RSD Software 1997 - 98
 All Rights Reserved.
*)

interface
{$I aclver.inc}
uses Classes, Controls, Windows, Messages, TypInfo, afilter, DB, DBTables
 {$IFDEF DELPHI3_0}, dbctrls{$ENDIF};

type
TCustomAutoDBMaker = class(TComponent)
private
  FControl : TWinControl;
  FPropName : String;
  ObjectInstance : Pointer;
  FControlWndProcAdd : Pointer;
  FPropInfo : PPropInfo;
  FUpdateData : Boolean;
  FOldValue : Variant;
  FWndProcBuzyFlag : Boolean;

  procedure SetControl(Value : TWinControl);
  procedure SetPropName(Value : String);
  procedure SetPropInfo;
protected
  function GetPropValue : Variant;
  procedure SetPropValue(Value : Variant);
  procedure ControlWndProc(var Message: TMessage);
  procedure ControlChanged; virtual;  
  procedure PropertyChanged; virtual;

  property PropName : String read FPropName write SetPropName;
public
  constructor Create(AOwner : TComponent); override;
  destructor Destroy; override;
  procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  procedure Refresh;

  property Control : TWinControl read FControl write SetControl;
end;

TFilterMaker = class(TCustomAutoDBMaker)
private
  FAutoFilter : TAutoFilter;

  function GetOnBeforeFilterChange : TNotifyEvent;
  function GetOnAfterFilterChange : TNotifyEvent;
  procedure SetOnBeforeFilterChange(Value : TNotifyEvent);
  procedure SetOnAfterFilterChange(Value : TNotifyEvent);
  procedure PropertyChanged; override;
protected
  procedure Loaded; override;
public
  constructor Create(AOwner : TComponent); override;
  destructor Destroy; override;
published
  property AutoFilter : TAutoFilter read FAutoFilter write FAutoFilter;
  property Control;
  property PropName;
  property OnBeforeFilterChange: TNotifyEvent read GetOnBeforeFilterChange write SetOnBeforeFilterChange;
  property OnAfterFilterChange: TNotifyEvent read GetOnAfterFilterChange write SetOnAfterFilterChange;
end;

TAutoDBControlMaker = class(TCustomAutoDBMaker)
private
  FDataLink: TFieldDataLink;

  procedure DataChange(Sender: TObject);
  procedure UpdateData(Sender: TObject);
  function GetDataField: string;
  function GetDataSource: TDataSource;
  function GetField: TField;
  procedure SetDataField(const Value: string);
  procedure SetDataSource(Value: TDataSource);
protected
  procedure ControlChanged; override;
  procedure PropertyChanged; override;
public
  constructor Create(AOwner: TComponent); override;
  destructor Destroy; override;
  procedure Notification(AComponent: TComponent;
    Operation: TOperation); override;
  property Field: TField read GetField;
published
  property DataField: string read GetDataField write SetDataField;
  property DataSource: TDataSource read GetDataSource write SetDataSource;
  property Control;
  property PropName;
end;

implementation
uses Forms;

{TCustomAutoDBMaker}
constructor TCustomAutoDBMaker.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  FWndProcBuzyFlag := False;
  ObjectInstance := MakeObjectInstance(ControlWndProc);
  FPropInfo := Nil;
  FUpdateData := False;
  FOldValue := varNull;  
end;

destructor TCustomAutoDBMaker.Destroy;
begin
  Control := Nil;
  if (ObjectInstance <> Nil) then
    FreeObjectInstance(ObjectInstance);

  inherited Destroy;
end;

procedure TCustomAutoDBMaker.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if(AComponent = Control) And (Operation = opRemove) then
    Control := Nil;
end;

procedure TCustomAutoDBMaker.Refresh;
begin
  SetControl(FControl);
end;

procedure TCustomAutoDBMaker.SetPropInfo;
Var
  APropInfo : PPropInfo;
begin
  APropInfo := Nil;
  if(FControl <> Nil) And (FPropName <> '') then
    APropInfo := GetPropInfo(FControl.ClassInfo, FPropName);
  if(FPropInfo <> APropInfo) then begin
    FPropInfo := APropInfo;
    FOldValue := GetPropValue;
  end; 
end;

function TCustomAutoDBMaker.GetPropValue : Variant;
begin
  if(FPropInfo = Nil) Or (FPropInfo^.PropType = Nil)
  Or (FControl = Nil) Or (csDestroying in FControl.ComponentState) then
    Result := VarNull
  else
     case FPropInfo^.PropType^.Kind of
       tkInteger, tkChar, tkEnumeration, tkSet, tkWChar:
         Result := GetOrdProp(FControl, FPropInfo);
       tkFloat: Result := GetFloatProp(FControl, FPropInfo);
       tkString, tkLString{$IFNDEF DELPHI3_0}, tkLWString {$ENDIF}:
         Result := GetStrProp(FControl, FPropInfo);
       tkVariant: Result := GetVariantProp(FControl, FPropInfo);
     end;
end;

procedure TCustomAutoDBMaker.SetPropValue(Value : Variant);
begin
  if(FPropInfo <> Nil) then
    case FPropInfo^.PropType^.Kind of
      tkInteger, tkChar, tkEnumeration, tkSet, tkWChar:
        begin
          if(Value = Null) then Value := 0;
          SetOrdProp(Control, FPropInfo, Integer(Value));
        end;
      tkFloat:
        begin
          if(Value = Null) then Value := 0;
          SetFloatProp(Control, FPropInfo, Extended(Value));
        end;
      tkString, tkLString{$IFNDEF DELPHI3_0}, tkLWString {$ENDIF}:
        begin
          if(Value = Null) then Value := '';
          SetStrProp(Control, FPropInfo, VarToStr(Value));
        end;
      tkVariant: SetVariantProp(Control, FPropInfo, Value);
    end;
end;

procedure TCustomAutoDBMaker.PropertyChanged;
begin
end;

procedure TCustomAutoDBMaker.ControlChanged;
begin
end;

procedure TCustomAutoDBMaker.ControlWndProc(var Message: TMessage);
Var
  AValue : Variant;
begin
  with Message do
    Result := CallWindowProc(FControlWndProcAdd, FControl.Handle, Msg, WParam, LParam);
  if(FPropInfo <> Nil) And Not FUpdateData
  And Not FWndProcBuzyFlag then begin
    FWndProcBuzyFlag := True;
    AValue := GetPropValue;
    if(FOldValue <> AValue) then begin
      FOldValue := AValue;
      PropertyChanged;
    end;
    FWndProcBuzyFlag := False;
  end;
  if (Message.Msg = WM_DESTROY) then begin
    SetWindowLong(FControl.Handle, GWL_WNDPROC, LongInt(FControlWndProcAdd));  
    FControlWndProcAdd := Nil;
  end;  
end;

procedure TCustomAutoDBMaker.SetControl(Value : TWinControl);
begin
  if(FControl = Value) And (FControlWndProcAdd <> Nil) then exit;

  if(FControl <> Nil) And (FControlWndProcAdd <> Nil)
  And Not (csDestroying in Control.ComponentState)
  And (Control.HandleAllocated) then begin
    SetWindowLong(FControl.Handle, GWL_WNDPROC, LongInt(FControlWndProcAdd));
    FControlWndProcAdd := Nil;
  end;
  FControl := Value;
  if(FControl <> Nil) And  Not (csDesigning in FControl.ComponentState) then begin
    FControlWndProcAdd := Pointer(GetWindowLong(FControl.Handle, GWL_WNDPROC));
    SetWindowLong(FControl.Handle, GWL_WNDPROC, LongInt(ObjectInstance));
  end;
  SetPropInfo;
  ControlChanged;  
end;

procedure TCustomAutoDBMaker.SetPropName(Value : String);
Var
  OldPropName : String;
  OldPropInfo : PPropInfo;
begin
  if(FPropName <> Value) then begin
    OldPropName := FPropName;
    OldPropInfo := FPropInfo;
    FPropName := Value;
    SetPropInfo;
    if(FPropInfo <> Nil)
    And (FPropInfo^.PropType^.Kind in [tkUnknown, tkClass, tkMethod]) then begin
      FPropInfo := OldPropInfo;
      FPropName := OldPropName;
    end else
      if(FPropInfo = Nil) And (Control <> Nil) then
        FPropName := '';
  end;
end;

{TFilterMaker}
constructor TFilterMaker.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  FAutoFilter := TAutoFilter.Create(self);
end;

destructor TFilterMaker.Destroy;
begin
  FAutoFilter.Free;
  inherited Destroy;
end;

procedure TFilterMaker.Loaded;
begin
  inherited Loaded;
  if(FPropInfo <> Nil) then
    PropertyChanged;
end;

function TFilterMaker.GetOnBeforeFilterChange : TNotifyEvent;
begin
  Result := FAutoFilter.OnBeforeChange;
end;

function TFilterMaker.GetOnAfterFilterChange : TNotifyEvent;
begin
  Result := FAutoFilter.OnAfterChange;
end;

procedure TFilterMaker.SetOnBeforeFilterChange(Value : TNotifyEvent);
begin
  FAutoFilter.OnBeforeChange := Value;
end;

procedure TFilterMaker.SetOnAfterFilterChange(Value : TNotifyEvent);
begin
  FAutoFilter.OnAfterChange := Value;
end;

procedure TFilterMaker.PropertyChanged;
begin
  FAutoFilter.Value := GetPropValue;
end;


{TAutoDBControlMaker}
constructor TAutoDBControlMaker.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDataLink := TFieldDataLink.Create;
  FDataLink.Control := Nil;
  FDataLink.OnDataChange := DataChange;
  FDataLink.OnUpdateData := UpdateData;
end;

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

procedure TAutoDBControlMaker.Notification(AComponent: TComponent;
    Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (FDataLink <> nil) and
    (AComponent = DataSource) then DataSource := nil;
end;

procedure TAutoDBControlMaker.ControlChanged;
begin
  if(Control = Nil) then begin
    FDataLink.Free;
    FDataLink := TFieldDataLink.Create;
    FDataLink.Control := Nil;
    FDataLink.OnDataChange := DataChange;
    FDataLink.OnUpdateData := UpdateData;
  end else FDataLink.Control := Control;
end;

procedure TAutoDBControlMaker.PropertyChanged;
begin
  if Not (csLoading in ComponentState) then
    UpdateData(self);
end;

procedure TAutoDBControlMaker.DataChange(Sender: TObject);
begin
  if (FDataLink.Field <> Nil) And Not FUpdateData then begin
    FUpdateData := True;
    FOldValue := FDataLink.Field.Value;
    SetPropValue(FDataLink.Field.Value);
    FUpdateData := False;
  end;
end;

procedure TAutoDBControlMaker.UpdateData(Sender: TObject);
begin
  if Not FUpdateData then begin
    FUpdateData := True;
    FDataLink.Edit;
    if FDataLink.Editing then
      FDataLink.Field.Value := GetPropValue;
    FUpdateData := False;
  end;  
end;

function TAutoDBControlMaker.GetDataField: String;
begin
  Result := FDataLink.FieldName;
end;

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

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

procedure TAutoDBControlMaker.SetDataField(const Value: String);
begin
  FDataLink.FieldName := Value;
end;

procedure TAutoDBControlMaker.SetDataSource(Value: TDataSource);
begin
  FDataLink.DataSource := Value;
  if Value <> Nil then
    Value.FreeNotification(Self);
end;

end.