cxdb.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 874 行 · 第 1/2 页

var
  I: Integer;
  AItem: TcxDBAdapterItem;
begin
  Result := False;
  for I := FItems.Count - 1 downto 0 do
  begin
    AItem := TcxDBAdapterItem(FItems[I]);
    if ADataSetClass.InheritsFrom(AItem.DataSetClass) then
    begin           
      AIndex := I;
      Result := True;
      Break;
    end
    else
      if AItem.DataSetClass.InheritsFrom(ADataSetClass) then
        AIndex := I;
  end;
end;

procedure TcxDBAdapterList.RegisterAdapter(ADataSetClass: TDataSetClass;
  AItemClass: TcxDBAdapterItemClass);
var
  AIndex: Integer;
begin
  AIndex := -1;
  if FindAdapter(ADataSetClass, AIndex) then
    FItems.Insert(AIndex + 1, AItemClass.Create(ADataSetClass))
  else
    if AIndex <> -1 then
      FItems.Insert(AIndex, AItemClass.Create(ADataSetClass))
    else
      FItems.Add(AItemClass.Create(ADataSetClass));
end;

procedure TcxDBAdapterList.UnregisterAdapter(ADataSetClass: TDataSetClass;
  AItemClass: TcxDBAdapterItemClass);
var
  I: Integer;
  AItem: TcxDBAdapterItem;
begin
  for I := FItems.Count - 1 downto 0 do
  begin
    AItem := TcxDBAdapterItem(FItems[I]);
    if (AItem.DataSetClass = ADataSetClass) and (AItem.ClassType = AItemClass) then
    begin
      AItem.Free;
      FItems.Delete(I);
    end;
  end;
end;

function TcxDBAdapterList.GetItem(Index: Integer): TcxDBAdapterItem;
begin
  Result := TcxDBAdapterItem(FItems[Index]);
end;

function TcxDBAdapterList.GetItemCount: Integer;
begin
  Result := FItems.Count;
end;

{ TcxCustomFieldDataLink }

constructor TcxCustomFieldDataLink.Create(ADataBinding: TcxCustomDBDataBinding);
begin
  inherited Create;
  VisualControl := False;
  FDataBinding := ADataBinding;
end;

function TcxCustomFieldDataLink.Edit: Boolean;
begin
  if CanModify then
    inherited Edit;
  Result := FEditing;
end;

procedure TcxCustomFieldDataLink.Modified;
begin
  FModified := True;
end;

procedure TcxCustomFieldDataLink.Reset;
begin
  RecordChanged(nil);
end;

procedure TcxCustomFieldDataLink.ActiveChanged;
begin
  UpdateField;
  FDataBinding.DataSetChange;
end;

procedure TcxCustomFieldDataLink.DataEvent(Event: TDataEvent;
  Info: Longint);
begin
  if Event = deDataSetChange then
    UpdateField;
  inherited DataEvent(Event, Info);
  if Event = deDataSetChange then
    FDataBinding.DataSetChange;
end;

procedure TcxCustomFieldDataLink.EditingChanged;
begin
  SetEditing(inherited Editing and CanModify);
end;

(*procedure TcxCustomFieldDataLink.FocusControl(Field: TFieldRef);
begin
  if (Field^ <> nil) and (Field^ = FField) and (FDataComponent is TWinControl) then
    if TWinControl(FDataComponent).CanFocus then
    begin
      Field^ := nil;
      TWinControl(FDataComponent).SetFocus;
    end;
end;*)

procedure TcxCustomFieldDataLink.LayoutChanged;
begin
  UpdateField;
end;

procedure TcxCustomFieldDataLink.RecordChanged(Field: TField);
begin
  if (Field = nil) or (Field = FField) then
  begin
    FDataBinding.InternalDataChange;
    if not FDataBinding.IsRefreshDisabled then
      FModified := False;
  end;
end;

procedure TcxCustomFieldDataLink.UpdateData;
begin
  if FModified then
  begin
    if Field <> nil then
      FDataBinding.UpdateData;
    if not FDataBinding.IsRefreshDisabled then
      FModified := False;
  end;
end;

procedure TcxCustomFieldDataLink.DataComponentChanged;
begin
end;

procedure TcxCustomFieldDataLink.UpdateRightToLeft;
begin
end;

procedure TcxCustomFieldDataLink.VisualControlChanged;
begin
end;

function TcxCustomFieldDataLink.GetCanModify: Boolean;
begin
  Result := not ReadOnly and (Field <> nil) and (Field.CanModify or
    (Field.Lookup and CanModifyLookupField(Field)));
end;

function TcxCustomFieldDataLink.GetDataComponent: TComponent;
begin
  Result := FDataBinding.DataComponent;
end;

procedure TcxCustomFieldDataLink.SetEditing(Value: Boolean);
begin
  if FEditing <> Value then
  begin
    FEditing := Value;
    if not FDataBinding.IsRefreshDisabled then
      FModified := False;
  end;
end;

procedure TcxCustomFieldDataLink.SetField(Value: TField);
begin
  if FField <> Value then
  begin
    FField := Value;
    FDataBinding.DataSetChange;
    EditingChanged;
    RecordChanged(nil);
    UpdateRightToLeft;
  end;
end;

procedure TcxCustomFieldDataLink.SetFieldName(const Value: string);
begin
  if FFieldName <> Value then
  begin
    FFieldName :=  Value;
    UpdateField;
  end;
end;

procedure TcxCustomFieldDataLink.UpdateField;
begin
  if Active and (FFieldName <> '') then
  begin
    FField := nil;
    if Assigned(DataComponent) then
      SetField(GetFieldProperty(DataSource.DataSet, DataComponent, FFieldName))
    else
      SetField(DataSource.DataSet.FieldByName(FFieldName));
  end
  else
    SetField(nil);
end;

{ TcxCustomDBDataBinding }

constructor TcxCustomDBDataBinding.Create(AOwner, ADataComponent: TComponent);
begin
  inherited Create(AOwner, ADataComponent);
  FDataLink := GetDataLinkClass.Create(Self);
// TODO SetReplicatable
end;

destructor TcxCustomDBDataBinding.Destroy;
begin
  FDataLink.Free;
  inherited Destroy;
end;

function TcxCustomDBDataBinding.CanModify: Boolean;
begin
  Result := IsDataSourceLive and not Field.ReadOnly;
  Result := Result and (Field.CanModify or (Field.Lookup and CanModifyLookupField(Field)));
end;

function TcxCustomDBDataBinding.ExecuteAction(Action: TBasicAction): Boolean;
begin
  Result := FDataLink.ExecuteAction(Action);
end;

function TcxCustomDBDataBinding.IsControlReadOnly: Boolean;
begin
  Result := ReadOnly;
  if not Result and IsDataSourceLive then
    Result := Field.ReadOnly;
end;

function TcxCustomDBDataBinding.IsDataSourceLive: Boolean;
begin
  Result := (FDataLink.FField <> nil) and (FDataLink.FField <> nil) and
    (FDataLink.FField.DataSet.State <> dsInactive);
end;

function TcxCustomDBDataBinding.IsDataStorage: Boolean;
begin
  Result := True;
end;

procedure TcxCustomDBDataBinding.Reset;
begin
  FDataLink.Reset;
end;

function TcxCustomDBDataBinding.SetEditMode: Boolean;
begin
  Result := inherited SetEditMode;
  if not Result then
    Exit;

  DisableRefresh;
  try
    FDatalink.Edit;
    Result := FDatalink.Editing;
    if Result then
      FDatalink.Modified;
  finally
    EnableRefresh;
  end;
end;

procedure TcxCustomDBDataBinding.UpdateDataSource;
begin
  FDataLink.UpdateRecord;
end;

function TcxCustomDBDataBinding.GetModified: Boolean;
begin
  Result := IsDataSourceLive and FDataLink.Editing and FDataLink.FModified;
end;

function TcxCustomDBDataBinding.GetReadOnly: Boolean;
begin
  Result := FDataLink.ReadOnly;
end;

function TcxCustomDBDataBinding.GetStoredValue(AValueSource: TcxDataEditValueSource;
  AFocused: Boolean): Variant;
begin
  if not IsDataSourceLive or (Field.IsNull and (AValueSource <> evsText)) then
    Result := Null
  else
    case AValueSource of
      evsKey:
        if Field.KeyFields <> '' then
          Result := Field.DataSet.FieldValues[Field.KeyFields]
        else
          Result := Field.Value;
      evsText:
        if AFocused and FDataLink.CanModify then
          Result := Field.Text
        else
          Result := Field.DisplayText;
    else {evsValue:}
      Result := Field.Value;
    end;
end;

procedure TcxCustomDBDataBinding.SetReadOnly(Value: Boolean);
begin
  if Value <> ReadOnly then
  begin
    FDataLink.ReadOnly := Value;
    DataSetChange;
  end;
end;

procedure TcxCustomDBDataBinding.VisualControlChanged;
begin
  FDataLink.VisualControlChanged;
end;

procedure TcxCustomDBDataBinding.SetStoredValue(AValueSource: TcxDataEditValueSource;
  const Value: Variant);

  procedure SetFieldValueEx(AField: TField; const AValue: Variant);
  begin
    if VarIsStr(Value) and (Value = '') and not(Field.DataType in [ftString{$IFDEF DELPHI4}, ftWideString{$ENDIF}]) then
      AField.Value := Null
    else
      AField.Value := Value;
  end;

var
  AFieldList: TList;
  I: Integer;
begin
  if IsDataSourceLive then
  begin
    DisableRefresh;
    try
      if FDataLink.Edit then
      begin
        if (*(*)AValueSource = evsText(*) or Assigned(Field.OnSetText)*) then
          Field.Text := VarToStr(Value)
        else
          if (AValueSource = evsKey) and (Field.KeyFields <> '') then
            if Pos(';', Field.KeyFields) = 0 then
              SetFieldValueEx(Field.DataSet.FieldByName(Field.KeyFields), Value)
            else
            begin
              AFieldList := TList.Create;
              try
                Field.DataSet.GetFieldList(AFieldList, Field.KeyFields);
                for I := 0 to AFieldList.Count - 1 do
                  SetFieldValueEx(TField(AFieldList[I]), Value[I]);
              finally
                AFieldList.Free;
              end;
              Field.DataSet.FieldValues[Field.KeyFields] := Value;
            end
          else
            SetFieldValueEx(Field, Value);
      end;
    finally
      EnableRefresh;
    end;
  end;
end;

function TcxCustomDBDataBinding.UpdateAction(Action: TBasicAction): Boolean;
begin
  Result := FDataLink.UpdateAction(Action);
end;

procedure TcxCustomDBDataBinding.DisableRefresh;
begin
  Inc(FRefreshCount);
end;

procedure TcxCustomDBDataBinding.EnableRefresh;
begin
  if FRefreshCount > 0 then
    Dec(FRefreshCount);
end;

function TcxCustomDBDataBinding.GetDataLinkClass: TcxCustomFieldDataLinkClass;
begin
  Result := TcxCustomFieldDataLink;
end;

function TcxCustomDBDataBinding.IsRefreshDisabled: Boolean;
begin
  Result := FRefreshCount > 0;
end;

function TcxCustomDBDataBinding.GetDataField: string;
begin
  Result := FDataLink.FieldName;
end;

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

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

procedure TcxCustomDBDataBinding.InternalDataChange;
begin
  if not IsRefreshDisabled then
    DataChange;
end;

procedure TcxCustomDBDataBinding.SetDataField(const Value: string);
begin
  FDataLink.FieldName := Value;
end;

procedure TcxCustomDBDataBinding.SetDataSource(Value: TDataSource);
begin
  FDataLink.DataSource := Value;
end;

end.