git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.DevExpressVCL@31 05c56307-c608-d34a-929d-697000501d7a
874 lines
24 KiB
ObjectPascal
874 lines
24 KiB
ObjectPascal
|
|
{********************************************************************}
|
|
{ }
|
|
{ Developer Express Visual Component Library }
|
|
{ ExpressDataController }
|
|
{ }
|
|
{ Copyright (c) 1998-2008 Developer Express Inc. }
|
|
{ ALL RIGHTS RESERVED }
|
|
{ }
|
|
{ The entire contents of this file is protected by U.S. and }
|
|
{ International Copyright Laws. Unauthorized reproduction, }
|
|
{ reverse-engineering, and distribution of all or any portion of }
|
|
{ the code contained in this file is strictly prohibited and may }
|
|
{ result in severe civil and criminal penalties and will be }
|
|
{ prosecuted to the maximum extent possible under the law. }
|
|
{ }
|
|
{ RESTRICTIONS }
|
|
{ }
|
|
{ THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES }
|
|
{ (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE }
|
|
{ SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS }
|
|
{ LICENSED TO DISTRIBUTE THE EXPRESSDATACONTROLLER AND ALL }
|
|
{ ACCOMPANYING VCL CONTROLS AS PART OF AN EXECUTABLE PROGRAM ONLY. }
|
|
{ }
|
|
{ THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED }
|
|
{ FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE }
|
|
{ COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE }
|
|
{ AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT }
|
|
{ AND PERMISSION FROM DEVELOPER EXPRESS INC. }
|
|
{ }
|
|
{ CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON }
|
|
{ ADDITIONAL RESTRICTIONS. }
|
|
{ }
|
|
{********************************************************************}
|
|
|
|
unit cxDB;
|
|
|
|
{$I cxVer.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, {$IFDEF DELPHI6}Variants, {$ENDIF} DB,
|
|
cxDataUtils;
|
|
|
|
type
|
|
{ TcxDBAdapterList }
|
|
|
|
TDataSetClass = class of TDataSet;
|
|
|
|
TcxDBAdapterItem = class
|
|
private
|
|
FDataSetClass: TDataSetClass;
|
|
public
|
|
constructor Create(ADataSetClass: TDataSetClass); virtual;
|
|
property DataSetClass: TDataSetClass read FDataSetClass;
|
|
end;
|
|
|
|
TcxDBAdapterItemClass = class of TcxDBAdapterItem;
|
|
|
|
TcxDBAdapterList = class
|
|
private
|
|
FItems: TList;
|
|
function GetItem(Index: Integer): TcxDBAdapterItem;
|
|
function GetItemCount: Integer;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure Clear;
|
|
function FindAdapter(ADataSetClass: TDataSetClass; var AIndex: Integer): Boolean; virtual;
|
|
procedure RegisterAdapter(ADataSetClass: TDataSetClass; AItemClass: TcxDBAdapterItemClass); virtual;
|
|
procedure UnregisterAdapter(ADataSetClass: TDataSetClass; AItemClass: TcxDBAdapterItemClass); virtual;
|
|
property ItemCount: Integer read GetItemCount;
|
|
property Items[Index: Integer]: TcxDBAdapterItem read GetItem; default;
|
|
end;
|
|
|
|
{ TcxCustomFieldDataLink }
|
|
|
|
TcxCustomDBDataBinding = class;
|
|
|
|
TcxCustomFieldDataLink = class(TDataLink)
|
|
private
|
|
FField: TField;
|
|
FFieldName: string;
|
|
FEditing: Boolean;
|
|
FModified: Boolean;
|
|
function GetCanModify: Boolean;
|
|
function GetDataComponent: TComponent;
|
|
procedure SetEditing(Value: Boolean);
|
|
procedure SetField(Value: TField);
|
|
procedure SetFieldName(const Value: string);
|
|
procedure UpdateField;
|
|
protected
|
|
FDataBinding: TcxCustomDBDataBinding;
|
|
procedure ActiveChanged; override;
|
|
procedure DataEvent(Event: TDataEvent; Info: Longint); override;
|
|
procedure EditingChanged; override;
|
|
procedure LayoutChanged; override;
|
|
procedure RecordChanged(Field: TField); override;
|
|
procedure UpdateData; override;
|
|
procedure DataComponentChanged; virtual;
|
|
procedure UpdateRightToLeft; virtual;
|
|
procedure VisualControlChanged; virtual;
|
|
property DataBinding: TcxCustomDBDataBinding read FDataBinding;
|
|
property DataComponent: TComponent read GetDataComponent;
|
|
public
|
|
constructor Create(ADataBinding: TcxCustomDBDataBinding); virtual;
|
|
function Edit: Boolean;
|
|
procedure Modified;
|
|
procedure Reset;
|
|
property CanModify: Boolean read GetCanModify;
|
|
property Editing: Boolean read FEditing;
|
|
property Field: TField read FField;
|
|
property FieldName: string read FFieldName write SetFieldName;
|
|
end;
|
|
|
|
TcxCustomFieldDataLinkClass = class of TcxCustomFieldDataLink;
|
|
|
|
{ TcxCustomDBDataBinding }
|
|
|
|
TcxCustomDBDataBinding = class(TcxCustomDataBinding)
|
|
private
|
|
FRefreshCount: Integer;
|
|
function GetDataField: string;
|
|
function GetDataSource: TDataSource;
|
|
function GetField: TField;
|
|
procedure InternalDataChange;
|
|
procedure SetDataField(const Value: string);
|
|
procedure SetDataSource(Value: TDataSource);
|
|
protected
|
|
FDataLink: TcxCustomFieldDataLink;
|
|
function GetModified: Boolean; override;
|
|
function GetReadOnly: Boolean; override;
|
|
procedure SetReadOnly(Value: Boolean); override;
|
|
procedure VisualControlChanged; override;
|
|
procedure DisableRefresh;
|
|
procedure EnableRefresh;
|
|
function GetDataLinkClass: TcxCustomFieldDataLinkClass; virtual;
|
|
function IsRefreshDisabled: Boolean;
|
|
public
|
|
constructor Create(AOwner, ADataComponent: TComponent); override;
|
|
destructor Destroy; override;
|
|
function CanModify: Boolean; override;
|
|
function ExecuteAction(Action: TBasicAction): Boolean; override;
|
|
function GetStoredValue(AValueSource: TcxDataEditValueSource; AFocused: Boolean): Variant; override;
|
|
function IsControlReadOnly: Boolean; override;
|
|
function IsDataSourceLive: Boolean; override;
|
|
function IsDataStorage: Boolean; override;
|
|
procedure Reset; override;
|
|
function SetEditMode: Boolean; override;
|
|
procedure SetStoredValue(AValueSource: TcxDataEditValueSource; const Value: Variant); override;
|
|
function UpdateAction(Action: TBasicAction): Boolean; override;
|
|
procedure UpdateDataSource; override;
|
|
property Field: TField read GetField;
|
|
property DataSource: TDataSource read GetDataSource write SetDataSource;
|
|
property DataField: string read GetDataField write SetDataField;
|
|
property DataLink: TcxCustomFieldDataLink read FDataLink;
|
|
end;
|
|
|
|
function CanModifyLookupField(AField: TField): Boolean;
|
|
procedure CheckFilterFieldName(var AFieldName: string);
|
|
function GetDataSetValues(ADataSet: TDataSet; AFields: TList): Variant;
|
|
function GetFilterFieldName(AField: TField; AIgnoreOrigin: Boolean): string;
|
|
function IsEqualFieldNames(const AFieldName1, AFieldName2: string): Boolean;
|
|
function IsFieldCanModify(AField: TField; AIsValueSource: Boolean): Boolean;
|
|
function IsFieldFormatted(AField: TField; AIsTextEdit: Boolean): Boolean;
|
|
function IsMultipleFieldNames(const AFieldNames: string): Boolean;
|
|
function IsSimpleCurrencyField(AField: TField): Boolean;
|
|
function GetFieldNamesCount(const AFieldNames: string): Integer;
|
|
procedure GetFieldNames(const AFieldNames: string; AList: TStrings);
|
|
function GetFieldValue(AField: TField): Variant;
|
|
procedure SetDataSetValues(ADataSet: TDataSet; AFields: TList; const AValues: Variant);
|
|
procedure SetFieldValue(AField: TField; const AValue: Variant);
|
|
|
|
implementation
|
|
|
|
uses
|
|
cxVariants;
|
|
|
|
function CanModifyLookupField(AField: TField): Boolean;
|
|
var
|
|
AMasterFields: TList;
|
|
I: Integer;
|
|
begin
|
|
Result := False;
|
|
if Assigned(AField.DataSet) then
|
|
begin
|
|
AMasterFields := TList.Create;
|
|
try
|
|
AField.DataSet.GetFieldList(AMasterFields, AField.KeyFields);
|
|
Result := AMasterFields.Count > 0;
|
|
for I := 0 to AMasterFields.Count - 1 do
|
|
Result := Result and TField(AMasterFields[I]).CanModify;
|
|
finally
|
|
AMasterFields.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure CheckFilterFieldName(var AFieldName: string);
|
|
begin
|
|
if not IsValidIdent(AFieldName) then
|
|
AFieldName := '[' + AFieldName + ']';
|
|
end;
|
|
|
|
function GetDataSetValues(ADataSet: TDataSet; AFields: TList): Variant;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if AFields.Count > 0 then
|
|
begin
|
|
if AFields.Count > 1 then
|
|
begin
|
|
Result := VarArrayCreate([0, AFields.Count - 1], varVariant);
|
|
for I := 0 to AFields.Count - 1 do
|
|
Result[I] := TField(AFields[I]).Value;
|
|
end
|
|
else
|
|
Result := TField(AFields[0]).Value;
|
|
end
|
|
else
|
|
Result := Null;
|
|
end;
|
|
|
|
function GetFilterFieldName(AField: TField; AIgnoreOrigin: Boolean): string;
|
|
begin
|
|
Result := '';
|
|
if Assigned(AField) then
|
|
begin
|
|
if not AIgnoreOrigin then
|
|
Result := AField.Origin;
|
|
if Result = '' then
|
|
begin
|
|
Result := AField.FieldName;
|
|
CheckFilterFieldName(Result);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function IsEqualFieldNames(const AFieldName1, AFieldName2: string): Boolean;
|
|
begin
|
|
Result := AnsiUpperCase(AFieldName1) = AnsiUpperCase(AFieldName2);
|
|
end;
|
|
|
|
function IsFieldCanModify(AField: TField; AIsValueSource: Boolean): Boolean;
|
|
begin
|
|
Result := AField.CanModify and
|
|
(AIsValueSource or not (AField.DataType in ftNonTextTypes) or Assigned(AField.OnSetText));
|
|
end;
|
|
|
|
function IsFieldFormatted(AField: TField; AIsTextEdit: Boolean): Boolean;
|
|
begin
|
|
Result := Assigned(AField.OnGetText) or (AField.EditMask <> '');
|
|
if not Result then
|
|
begin
|
|
if AField.DataType in ftNonTextTypes then
|
|
Result := AIsTextEdit // Field.DisplayText!
|
|
else
|
|
if AField is TBooleanField then
|
|
Result := AIsTextEdit // TODO: compare DisplayValues
|
|
else
|
|
if AField is TNumericField then
|
|
begin
|
|
Result := ((AField as TNumericField).DisplayFormat <> '') or
|
|
((AField as TNumericField).EditFormat <> '');
|
|
if not Result then
|
|
begin
|
|
if AField is TFloatField then
|
|
Result := (AField as TFloatField).Currency
|
|
else
|
|
if AField is TBCDField then
|
|
Result := (AField as TBCDField).Currency
|
|
{$IFDEF DELPHI6}
|
|
else
|
|
if AField is TFMTBCDField then
|
|
Result := (AField as TFMTBCDField).Currency
|
|
{$ENDIF}
|
|
end;
|
|
end
|
|
else
|
|
if AField is TDateTimeField then
|
|
Result := (AField as TDateTimeField).DisplayFormat <> ''
|
|
else
|
|
{$IFDEF DELPHI5}
|
|
if AField is TAggregateField then
|
|
Result := ((AField as TAggregateField).DisplayFormat <> '') or
|
|
(AField as TAggregateField).Currency
|
|
else
|
|
{$IFDEF DELPHI6}
|
|
if AField is TSQLTimeStampField then
|
|
Result := (AField as TSQLTimeStampField).DisplayFormat <> '';
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
function IsMultipleFieldNames(const AFieldNames: string): Boolean;
|
|
var
|
|
APos: Integer;
|
|
begin
|
|
APos := 1;
|
|
{$WARNINGS OFF}
|
|
ExtractFieldName(AFieldNames, APos);
|
|
{$WARNINGS ON}
|
|
Result := APos <= Length(AFieldNames);
|
|
end;
|
|
|
|
function IsSimpleCurrencyField(AField: TField): Boolean;
|
|
begin
|
|
Result := False;
|
|
if AField is TNumericField then
|
|
begin
|
|
if AField is TFloatField then
|
|
Result := (AField as TFloatField).Currency
|
|
else
|
|
begin
|
|
if AField is TBCDField then
|
|
Result := (AField as TBCDField).Currency
|
|
{$IFDEF DELPHI6}
|
|
else
|
|
if AField is TFMTBCDField then
|
|
Result := (AField as TFMTBCDField).Currency;
|
|
{$ENDIF}
|
|
end;
|
|
if Result then
|
|
begin
|
|
if ((AField as TNumericField).DisplayFormat <> '') or Assigned(AField.OnGetText) then
|
|
Result := False;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function GetFieldNamesCount(const AFieldNames: string): Integer;
|
|
var
|
|
APos: Integer;
|
|
begin
|
|
Result := 0; // TODO: use GetFieldNames?
|
|
APos := 1;
|
|
while APos <= Length(AFieldNames) do
|
|
begin
|
|
Inc(Result);
|
|
{$WARNINGS OFF}
|
|
ExtractFieldName(AFieldNames, APos);
|
|
{$WARNINGS ON}
|
|
end;
|
|
end;
|
|
|
|
procedure GetFieldNames(const AFieldNames: string; AList: TStrings);
|
|
var
|
|
APos: Integer;
|
|
begin
|
|
AList.Clear;
|
|
APos := 1;
|
|
while APos <= Length(AFieldNames) do
|
|
{$WARNINGS OFF}
|
|
AList.Add(ExtractFieldName(AFieldNames, APos))
|
|
{$WARNINGS ON}
|
|
end;
|
|
|
|
function GetFieldValue(AField: TField): Variant;
|
|
begin
|
|
if AField is TAggregateField then // bug in Delphi (IsNull = True!)
|
|
Result := AField.Value
|
|
else
|
|
if AField.IsNull then
|
|
Result := Null
|
|
else
|
|
begin
|
|
{$IFDEF DELPHI5}
|
|
if AField is TWideStringField then // bug in Delphi
|
|
Result := TWideStringField(AField).Value
|
|
else
|
|
{$ENDIF}
|
|
Result := AField.Value;
|
|
end;
|
|
end;
|
|
|
|
procedure SetDataSetValues(ADataSet: TDataSet; AFields: TList;
|
|
const AValues: Variant);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if AFields.Count > 0 then
|
|
begin
|
|
if AFields.Count > 1 then
|
|
begin
|
|
for I := 0 to AFields.Count - 1 do
|
|
TField(AFields[I]).Value := AValues[I];
|
|
end
|
|
else
|
|
TField(AFields[0]).Value := AValues;
|
|
end;
|
|
end;
|
|
|
|
procedure SetFieldValue(AField: TField; const AValue: Variant);
|
|
begin
|
|
if (AField is TDateTimeField) and (VarType(AValue) = varDouble) then // bug in Delphi
|
|
TDateTimeField(AField).Value := AValue
|
|
else
|
|
AField.Value := AValue;
|
|
end;
|
|
|
|
{ TcxDBAdapterItem }
|
|
|
|
constructor TcxDBAdapterItem.Create(ADataSetClass: TDataSetClass);
|
|
begin
|
|
inherited Create;
|
|
FDataSetClass := ADataSetClass;
|
|
end;
|
|
|
|
{ TcxDBAdapterList }
|
|
|
|
constructor TcxDBAdapterList.Create;
|
|
begin
|
|
inherited Create;
|
|
FItems := TList.Create;
|
|
end;
|
|
|
|
destructor TcxDBAdapterList.Destroy;
|
|
begin
|
|
Clear;
|
|
FItems.Free;
|
|
FItems := nil;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TcxDBAdapterList.Clear;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := 0 to FItems.Count - 1 do
|
|
TObject(FItems[I]).Free;
|
|
FItems.Clear;
|
|
end;
|
|
|
|
function TcxDBAdapterList.FindAdapter(ADataSetClass: TDataSetClass;
|
|
var AIndex: Integer): Boolean;
|
|
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.
|