Componentes.Terceros.RemObj.../internal/5.0.29.665/1/Data Abstract for Delphi/Source/uDAMemDataTable.pas

451 lines
12 KiB
ObjectPascal

unit uDAMemDataTable;
{----------------------------------------------------------------------------}
{ Data Abstract Library - Core Library }
{ }
{ compiler: Delphi 6 and up, Kylix 3 and up }
{ platform: Win32, Linux }
{ }
{ (c)opyright RemObjects Software. all rights reserved. }
{ }
{ Using this code requires a valid license of the Data Abstract }
{ which can be obtained at http://www.remobjects.com. }
{----------------------------------------------------------------------------}
{$I DataAbstract.inc}
interface
uses
Classes,DB, uDAInterfaces,
uDADataTable, uDAMemDataset;
type
{ TDAADODataset }
TDAMemDataset = class(TDAMemoryDataset, IDADataTableDataset)
private
FRecIDOffset: cardinal;
protected
function GetDataTable: TDADataTable; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
procedure InternalRefresh; override;
procedure InternalInitFieldDefs; override;
procedure InternalOpen; override;
function GetStateFieldValue(State: TDataSetState;Field: TField): Variant; override;
public
constructor Create(AOwner: TComponent); override;
end;
TDAMemDataTable = class(TDADataTable,IDAMemDatasetBatchAdding,IDARangeController)
private
fMemDataset: TDAMemDataset;
fWasReadonly: Boolean;
function GetIndexDefs: TIndexDefs;
function GetIndexName: string;
procedure SetIndexDefs(const Value: TIndexDefs);
procedure SetIndexName(const Value: string);
function GetIndexFieldNames: string;
procedure SetIndexFieldNames(const Value: string);
protected
// IDAMemDatasetBatchAdding
function AllocRecordBuffer: PChar;
procedure FreeRecordBuffer(var Buffer: PChar);
function GetFieldNativeBuffer(Buffer: PChar; Field: TField): Pointer;
function MakeBlobFromString(Blob:String):pointer;
procedure SetNullMask(Buffer: PChar; Field: TField; const Value: boolean);
procedure SetAnsiString(NativeBuf: Pointer; Field: TField; const Value: Ansistring);
procedure SetWideString(NativeBuf: Pointer; Field: TField; const Value: Widestring);
procedure AddRecordsfromList(AList: TList);
protected
function GetDatasetClass: TDatasetClass; override;
procedure CreateInternalFields(aDataset: TDataset; someFieldDefinitions: TDAFieldCollection); override;
// procedure DoAfterCloseDataset; override;
procedure DoSort(const FieldNames: array of string; const Directions: array of TDASortDirection); override;
procedure SetMasterSource(const Value: TDADataSource); override;
function GetMasterSource: TDADataSource; override;
procedure SetDetailsFields(const Value: string); override;
procedure SetMasterFields(const Value: string); override;
function GetDetailFields: string; override;
function GetMasterFields: string; override;
function GetFilter: string; override;
function GetFiltered: boolean; override;
procedure SetFilter(const Value: string); override;
procedure SetFiltered(const Value: boolean); override;
function GetReadOnly: boolean; override;
procedure SetReadOnly(const Value: boolean); override;
public
constructor Create(aOwner: TComponent); override;
procedure EnableConstraints; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
procedure DisableConstraints; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
procedure CloneCursor(Source: TDADataTable); override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
{ IDARangeController }
procedure ApplyRange; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
procedure CancelRange; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
procedure SetRange(const StartValues, EndValues: array of const); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
procedure EditRangeEnd; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
procedure EditRangeStart; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
procedure SetRangeEnd; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
procedure SetRangeStart; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
//
procedure SetKey;
procedure EditKey;
function FindKey(const KeyValues: array of const): Boolean;
procedure FindNearest(const KeyValues: array of const);
function GotoKey: Boolean;
procedure GotoNearest;
published
property IndexDefs: TIndexDefs read GetIndexDefs write SetIndexDefs;
property IndexName: string read GetIndexName write SetIndexName;
property IndexFieldNames: string read GetIndexFieldNames write SetIndexFieldNames;
end;
implementation
uses SysUtils;
{ TDAMemDataset }
constructor TDAMemDataset.Create(AOwner: TComponent);
begin
inherited;
FRecIDOffset := 0;
end;
function TDAMemDataset.GetDataTable: TDADataTable;
begin
result := TDADataTable(Owner);
end;
function TDAMemDataset.GetStateFieldValue(State: TDataSetState;
Field: TField): Variant;
begin
if (State = dsOldValue) and (Self.State in [dsEdit, dsInsert]) then
Result := TDAMemDataTable(Owner).fOldValues[Field.Index]
else
result := Inherited GetStateFieldValue(State, Field);
end;
procedure TDAMemDataset.InternalInitFieldDefs;
begin
inherited;
end;
procedure TDAMemDataset.InternalOpen;
begin
inherited;
FRecIDOffset := GetFieldOffset(0);
end;
procedure TDAMemDataset.InternalRefresh;
begin
inherited;
end;
{ TDAMemDataTable }
procedure TDAMemDataTable.AddRecordsfromList(AList: TList);
var
i: integer;
Buffer: PChar;
begin
// setup RecID
For i:=0 to AList.Count-1 do begin
buffer:=AList[i];
PCardinal(Buffer+fMemDataset.FRecIDOffset)^:=CurrRecId;
fMemDataset.SetNullMask(Buffer,0,False); //RECID
CurrRecId:=CurrRecId+1;
end;
fMemDataset.AddRecordsfromList(AList);
fMemDataset.ProcessFilter;
end;
function TDAMemDataTable.AllocRecordBuffer: PChar;
begin
Result:= fMemDataset.IntCreateBuffer(True);
end;
procedure TDAMemDataTable.ApplyRange;
begin
fMemDataset.ApplyRange;
end;
procedure TDAMemDataTable.CancelRange;
begin
fMemDataset.CancelRange;
end;
procedure TDAMemDataTable.CloneCursor(Source: TDADataTable);
begin
if Source = nil then Exception.Create('CloneCursor. Source should be specified.');
if not (Source is TDAMemDataTable) then Exception.Create('Can''t clone cursor from ' + Source.ClassName);
if Active then raise Exception.Create('Datatable is already open');
try
fCloneSource := Source;
Fields.Clear;
Fields.Assign(Source.Fields);
// Proceeds
fMemDataset.CloneCursor(Source.Dataset as TDAMemDataset, False);
RecIDField := fMemDataset.FieldByName(RecIDFieldName) as TIntegerField;
RecIDField.Visible := FALSE;
Fields.Bind(fMemDataset);
// Prepares the delta
Delta := Source.Delta;
// Finishes to prepare the internal dataset (descendant might need additional customization and might not be open)
DoBeforeOpenDataset;
if not Dataset.Active then Dataset.Open;
DoAfterOpenDataset;
except
// Restores the previous state
fCloneSource := NIL;
Delta := NIL;
raise;
end;
end;
constructor TDAMemDataTable.Create(aOwner: TComponent);
begin
inherited;
fMemDataset := TDAMemDataset(Dataset);
end;
procedure TDAMemDataTable.CreateInternalFields(aDataset: TDataset;
someFieldDefinitions: TDAFieldCollection);
begin
inherited;
fMemDataset.Open;
end;
procedure TDAMemDataTable.DisableConstraints;
begin
fWasReadonly := ReadOnly;
ReadOnly := False;
// fMemDataset.DisableConstraints;
end;
procedure TDAMemDataTable.DoSort(const FieldNames: array of string;
const Directions: array of TDASortDirection);
var
i: integer;
s,s1: string;
begin
if Length(FieldNames) <> Length(Directions) then DatabaseError('Can''t perform sorting: FieldNames and Directions should have same dimension.');
s := '';
s1:='';
for i := Low(FieldNames) to High(FieldNames) do begin
s := s + FieldNames[i] + ';';
if Directions[i] = sdDescending then
s1 := s1 + FieldNames[i] + ';';
end;
fMemDataset.SortOnFields(s,'',s1);
end;
procedure TDAMemDataTable.EditKey;
begin
fMemDataset.EditKey;
end;
procedure TDAMemDataTable.EditRangeEnd;
begin
fMemDataset.EditRangeEnd;
end;
procedure TDAMemDataTable.EditRangeStart;
begin
fMemDataset.EditRangeStart;
end;
procedure TDAMemDataTable.EnableConstraints;
begin
//fMemDataset.EnableConstraints;
ReadOnly := fWasReadonly;
end;
function TDAMemDataTable.FindKey(const KeyValues: array of const): Boolean;
begin
Result := fMemDataset.FindKey(KeyValues);
end;
procedure TDAMemDataTable.FindNearest(const KeyValues: array of const);
begin
fMemDataset.FindNearest(KeyValues);
end;
procedure TDAMemDataTable.FreeRecordBuffer(var Buffer: PChar);
begin
fMemDataset.FreeRecordBuffer(Buffer);
end;
function TDAMemDataTable.GetDatasetClass: TDatasetClass;
begin
Result := TDAMemDataset;
end;
function TDAMemDataTable.GetDetailFields: string;
begin
result := fMemDataset.DetailFields;
end;
function TDAMemDataTable.GetFieldNativeBuffer(Buffer: PChar;
Field: TField): Pointer;
begin
Result:= fMemDataset.IntFindFieldData(Buffer,Field);
end;
function TDAMemDataTable.GetFilter: string;
begin
Result := fMemDataset.Filter;
end;
function TDAMemDataTable.GetFiltered: boolean;
begin
Result := fMemDataset.Filtered;
end;
function TDAMemDataTable.GetIndexDefs: TIndexDefs;
begin
result := fMemDataset.IndexDefs;
end;
function TDAMemDataTable.GetIndexFieldNames: string;
begin
Result := fMemDataset.IndexFieldNames;
end;
function TDAMemDataTable.GetIndexName: string;
begin
result := fMemDataset.IndexName;
end;
function TDAMemDataTable.GetMasterFields: string;
begin
result := fMemDataset.MasterFields
end;
function TDAMemDataTable.GetMasterSource: TDADataSource;
begin
result := TDADataSource(fMemDataset.DataSource);
end;
function TDAMemDataTable.GetReadOnly: boolean;
begin
Result := fMemDataset.ReadOnly;
end;
function TDAMemDataTable.GotoKey: Boolean;
begin
Result := fMemDataset.GotoKey;
end;
procedure TDAMemDataTable.GotoNearest;
begin
fMemDataset.GotoNearest;
end;
function TDAMemDataTable.MakeBlobFromString(Blob: String): pointer;
begin
Result:= fMemDataset.MakeBlobFromString(Blob);
end;
procedure TDAMemDataTable.SetAnsiString(NativeBuf: Pointer; Field: TField;
const Value: Ansistring);
begin
fMemDataset.SetAnsiString(NativeBuf,Field, Value);
end;
procedure TDAMemDataTable.SetDetailsFields(const Value: string);
begin
fMemDataset.DetailFields := Value
end;
procedure TDAMemDataTable.SetFilter(const Value: string);
begin
fMemDataset.Filter := Value;
end;
procedure TDAMemDataTable.SetFiltered(const Value: boolean);
begin
fMemDataset.Filtered := Value;
end;
procedure TDAMemDataTable.SetIndexDefs(const Value: TIndexDefs);
begin
fMemDataset.IndexDefs.Assign(Value);
end;
procedure TDAMemDataTable.SetIndexFieldNames(const Value: string);
begin
fMemDataset.IndexFieldNames := Value;
end;
procedure TDAMemDataTable.SetIndexName(const Value: string);
begin
fMemDataset.IndexName:=Value;
end;
procedure TDAMemDataTable.SetKey;
begin
fMemDataset.SetKey;
end;
procedure TDAMemDataTable.SetMasterFields(const Value: string);
begin
inherited;
fMemDataset.MasterFields := Value
end;
procedure TDAMemDataTable.SetMasterSource(const Value: TDADataSource);
begin
inherited;
fMemDataset.MasterSource := Value
end;
procedure TDAMemDataTable.SetNullMask(Buffer: PChar; Field: TField;
const Value: boolean);
begin
fMemDataset.SetNullMask(Buffer,Field.Index,Value);
end;
procedure TDAMemDataTable.SetRange(const StartValues,
EndValues: array of const);
begin
fMemDataset.SetRange(StartValues, EndValues);
end;
procedure TDAMemDataTable.SetRangeEnd;
begin
fMemDataset.SetRangeEnd;
end;
procedure TDAMemDataTable.SetRangeStart;
begin
fMemDataset.SetRangeStart;
end;
procedure TDAMemDataTable.SetReadOnly(const Value: boolean);
begin
fMemDataset.ReadOnly := Value;
end;
procedure TDAMemDataTable.SetWideString(NativeBuf: Pointer; Field: TField;
const Value: Widestring);
begin
fMemDataset.SetWideString(NativeBuf,Field, Value);
end;
end.