?? rxmemds.pas
字號(hào):
begin
if FieldDefs.Count = 0 then begin
for I := 0 to FieldCount - 1 do begin
with Fields[I] do
if (FieldKind in fkStoredFields) and not (DataType in ftSupported) then
ErrorFmt(SUnknownFieldType, [DisplayName]);
end;
FreeIndexList;
end;
Offset := 0;
{$IFDEF RX_D4}
inherited InitFieldDefsFromFields;
{ Calculate fields offsets }
ReallocMem(FOffsets, FieldDefList.Count * SizeOf(Word));
for I := 0 to FieldDefList.Count - 1 do begin
FOffsets^[I] := Offset;
with FieldDefList[I] do begin
if (DataType in ftSupported - ftBlobTypes) then
Inc(Offset, CalcFieldLen(DataType, Size) + 1);
end;
end;
{$ELSE}
{ Create FieldDefs from persistent fields if needed }
if FieldDefs.Count = 0 then
for I := 0 to FieldCount - 1 do begin
with Fields[I] do
if (FieldKind = fkData) then
FieldDefs.Add(FieldName, DataType, Size, Required);
end;
{ Calculate fields offsets }
ReallocMem(FOffsets, FieldDefs.Count * SizeOf(Word));
for I := 0 to FieldDefs.Count - 1 do begin
FOffsets^[I] := Offset;
with FieldDefs[I] do begin
if (DataType in ftSupported - ftBlobTypes) then
Inc(Offset, CalcFieldLen(DataType, Size) + 1);
end;
end;
{$ENDIF}
end;
function TRxMemoryData.FindFieldData(Buffer: Pointer; Field: TField): Pointer;
var
Index: Integer;
begin
{$IFDEF RX_D4}
Index := FieldDefList.IndexOf(Field.FullName);
{$ELSE}
Index := FieldDefs.IndexOf(Field.FieldName);
{$ENDIF}
if (Index >= 0) and (Buffer <> nil) and
{$IFDEF RX_D4}
(FieldDefList[Index].DataType in ftSupported - ftBlobTypes) then
{$ELSE}
(FieldDefs[Index].DataType in ftSupported - ftBlobTypes) then
{$ENDIF}
Result := (PChar(Buffer) + FOffsets[Index])
else Result := nil;
end;
{ Buffer Manipulation }
function TRxMemoryData.CalcRecordSize: Integer;
var
I: Integer;
begin
Result := 0;
for I := 0 to FieldDefs.Count - 1 do
CalcDataSize(FieldDefs[I], Result);
end;
procedure TRxMemoryData.InitBufferPointers(GetProps: Boolean);
begin
if GetProps then FRecordSize := CalcRecordSize;
FBookmarkOfs := FRecordSize + CalcFieldsSize;
FBlobOfs := FBookmarkOfs + SizeOf(TMemBookmarkInfo);
FRecBufSize := FBlobOfs + BlobFieldCount * SizeOf(Pointer);
end;
procedure TRxMemoryData.ClearRecords;
begin
while FRecords.Count > 0 do TObject(FRecords.Last).Free;
FLastID := Low(Integer);
FRecordPos := -1;
end;
function TRxMemoryData.AllocRecordBuffer: PChar;
begin
Result := StrAlloc(FRecBufSize);
if BlobFieldCount > 0 then
Initialize(PMemBlobArray(Result + FBlobOfs)[0], BlobFieldCount);
end;
procedure TRxMemoryData.FreeRecordBuffer(var Buffer: PChar);
begin
if BlobFieldCount > 0 then
Finalize(PMemBlobArray(Buffer + FBlobOfs)[0], BlobFieldCount);
StrDispose(Buffer);
Buffer := nil;
end;
procedure TRxMemoryData.ClearCalcFields(Buffer: PChar);
begin
FillChar(Buffer[FRecordSize], CalcFieldsSize, 0);
end;
procedure TRxMemoryData.InternalInitRecord(Buffer: PChar);
var
I: Integer;
begin
FillChar(Buffer^, FBlobOfs, 0);
for I := 0 to BlobFieldCount - 1 do
PMemBlobArray(Buffer + FBlobOfs)[I] := '';
end;
procedure TRxMemoryData.InitRecord(Buffer: PChar);
begin
inherited InitRecord(Buffer);
with PMemBookmarkInfo(Buffer + FBookmarkOfs)^ do begin
BookmarkData := Low(Integer);
BookmarkFlag := bfInserted;
end;
end;
function TRxMemoryData.GetCurrentRecord(Buffer: PChar): Boolean;
begin
Result := False;
if not IsEmpty and (GetBookmarkFlag(ActiveBuffer) = bfCurrent) then begin
UpdateCursorPos;
if (FRecordPos >= 0) and (FRecordPos < RecordCount) then begin
Move(Records[FRecordPos].Data^, Buffer^, FRecordSize);
Result := True;
end;
end;
end;
procedure TRxMemoryData.RecordToBuffer(Rec: TMemoryRecord; Buffer: PChar);
var
I: Integer;
begin
Move(Rec.Data^, Buffer^, FRecordSize);
with PMemBookmarkInfo(Buffer + FBookmarkOfs)^ do begin
BookmarkData := Rec.ID;
BookmarkFlag := bfCurrent;
end;
for I := 0 to BlobFieldCount - 1 do
PMemBlobArray(Buffer + FBlobOfs)[I] := PMemBlobArray(Rec.FBlobs)[I];
GetCalcFields(Buffer);
end;
function TRxMemoryData.GetRecord(Buffer: PChar; GetMode: TGetMode;
DoCheck: Boolean): TGetResult;
var
Accept: Boolean;
begin
Result := grOk;
Accept := True;
case GetMode of
gmPrior:
if FRecordPos <= 0 then begin
Result := grBOF;
FRecordPos := -1;
end
else begin
repeat
Dec(FRecordPos);
if Filtered then Accept := RecordFilter;
until Accept or (FRecordPos < 0);
if not Accept then begin
Result := grBOF;
FRecordPos := -1;
end;
end;
gmCurrent:
if (FRecordPos < 0) or (FRecordPos >= RecordCount) then
Result := grError
else if Filtered then begin
if not RecordFilter then Result := grError;
end;
gmNext:
if FRecordPos >= RecordCount - 1 then Result := grEOF
else begin
repeat
Inc(FRecordPos);
if Filtered then Accept := RecordFilter;
until Accept or (FRecordPos > RecordCount - 1);
if not Accept then begin
Result := grEOF;
FRecordPos := RecordCount - 1;
end;
end;
end;
if Result = grOk then RecordToBuffer(Records[FRecordPos], Buffer)
else if (Result = grError) and DoCheck then Error(SMemNoRecords);
end;
function TRxMemoryData.GetRecordSize: Word;
begin
Result := FRecordSize;
end;
function TRxMemoryData.GetActiveRecBuf(var RecBuf: PChar): Boolean;
begin
case State of
dsBrowse:
if IsEmpty then RecBuf := nil
else RecBuf := ActiveBuffer;
dsEdit, dsInsert: RecBuf := ActiveBuffer;
dsCalcFields: RecBuf := CalcBuffer;
dsFilter: RecBuf := TempBuffer;
else RecBuf := nil;
end;
Result := RecBuf <> nil;
end;
function TRxMemoryData.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
var
RecBuf, Data: PChar;
{$IFDEF RX_D5}
VarData: Variant;
{$ENDIF}
begin
Result := False;
if not GetActiveRecBuf(RecBuf) then Exit;
if Field.FieldNo > 0 then begin
Data := FindFieldData(RecBuf, Field);
if Data <> nil then begin
Result := Boolean(Data[0]);
Inc(Data);
if Field.DataType in [ftString {$IFDEF RX_D4}, ftFixedChar,
ftWideString {$ENDIF} {$IFDEF RX_D5}, ftGuid {$ENDIF}] then
Result := Result and (StrLen(Data) > 0);
if Result and (Buffer <> nil) then
{$IFDEF RX_D5}
if Field.DataType = ftVariant then begin
VarData := PVariant(Data)^;
PVariant(Buffer)^ := VarData;
end else
{$ENDIF}
Move(Data^, Buffer^, CalcFieldLen(Field.DataType, Field.Size));
end;
end
else begin
if State in [dsBrowse, dsEdit, dsInsert, dsCalcFields] then begin
Inc(RecBuf, FRecordSize + Field.Offset);
Result := Boolean(RecBuf[0]);
if Result and (Buffer <> nil) then
Move(RecBuf[1], Buffer^, Field.DataSize);
end;
end;
end;
procedure TRxMemoryData.SetFieldData(Field: TField; Buffer: Pointer);
var
RecBuf, Data: PChar;
{$IFDEF RX_D5}
VarData: Variant;
{$ENDIF}
begin
if not (State in dsWriteModes) then Error(SNotEditing);
GetActiveRecBuf(RecBuf);
with Field do begin
if FieldNo > 0 then
begin
if State in [dsCalcFields, dsFilter] then Error(SNotEditing);
if ReadOnly and not (State in [dsSetKey, dsFilter]) then
ErrorFmt(SFieldReadOnly, [DisplayName]);
Validate(Buffer);
if FieldKind <> fkInternalCalc then begin
Data := FindFieldData(RecBuf, Field);
if Data <> nil then begin
{$IFDEF RX_D5}
if DataType = ftVariant then begin
if Buffer <> nil then
VarData := PVariant(Buffer)^
else
VarData := EmptyParam;
Boolean(Data[0]) := LongBool(Buffer) and not
(VarIsNull(VarData) or VarIsEmpty(VarData));
if Boolean(Data[0]) then begin
Inc(Data);
PVariant(Data)^ := VarData;
end
else FillChar(Data^, CalcFieldLen(DataType, Size), 0);
end else
{$ENDIF}
begin
Boolean(Data[0]) := LongBool(Buffer);
Inc(Data);
if LongBool(Buffer) then
Move(Buffer^, Data^, CalcFieldLen(DataType, Size))
else FillChar(Data^, CalcFieldLen(DataType, Size), 0);
end;
end;
end;
end else {fkCalculated, fkLookup}
begin
Inc(RecBuf, FRecordSize + Offset);
Boolean(RecBuf[0]) := LongBool(Buffer);
if Boolean(RecBuf[0]) then Move(Buffer^, RecBuf[1], DataSize);
end;
if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
DataEvent(deFieldChange, Longint(Field));
end;
end;
{ Filter }
procedure TRxMemoryData.SetFiltered(Value: Boolean);
begin
if Active then begin
CheckBrowseMode;
if Filtered <> Value then begin
inherited SetFiltered(Value);
First;
end;
end
else inherited SetFiltered(Value);
end;
procedure TRxMemoryData.SetOnFilterRecord(const Value: TFilterRecordEvent);
begin
if Active then begin
CheckBrowseMode;
inherited SetOnFilterRecord(Value);
if Filtered then First;
end
else inherited SetOnFilterRecord(Value);
end;
function TRxMemoryData.RecordFilter: Boolean;
var
SaveState: TDataSetState;
begin
Result := True;
if Assigned(OnFilterRecord) then begin
if (FRecordPos >= 0) and (FRecordPos < RecordCount) then begin
SaveState := SetTempState(dsFilter);
try
RecordToBuffer(Records[FRecordPos], TempBuffer);
OnFilterRecord(Self, Result);
except
Application.HandleException(Self);
end;
RestoreState(SaveState);
end
else Result := False;
end;
end;
{ Blobs }
function TRxMemoryData.GetBlobData(Field: TField; Buffer: PChar): TMemBlobData;
begin
Result := PMemBlobArray(Buffer + FBlobOfs)[Field.Offset];
end;
procedure TRxMemoryData.SetBlobData(Field: TField; Buffer: PChar;
Value: TMemBlobData);
begin
if (Buffer = ActiveBuffer) then begin
if State = dsFilter then Error(SNotEditing);
PMemBlobArray(Buffer + FBlobOfs)[Field.Offset] := Value;
end;
end;
procedure TRxMemoryData.CloseBlob(Field: TField);
begin
if (FRecordPos >= 0) and (FRecordPos < FRecords.Count) and
(State = dsEdit) then
PMemBlobArray(ActiveBuffer + FBlobOfs)[Field.Offset] :=
PMemBlobArray(Records[FRecordPos].FBlobs)[Field.Offset]
else PMemBlobArray(ActiveBuffer + FBlobOfs)[Field.Offset] := '';
end;
function TRxMemoryData.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
begin
Result := TMemBlobStream.Create(Field as TBlobField, Mode);
end;
{ Bookmarks }
function TRxMemoryData.BookmarkValid(Bookmark: TBookmark): Boolean;
begin
Result := FActive and (TBookmarkData(Bookmark^) > Low(Integer)) and
(TBookmarkData(Bookmark^) <= FLastID);
end;
function TRxMemoryData.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer;
begin
if (Bookmark1 = nil) and (Bookmark2 = nil) then Result := 0
else if (Bookmark1 <> nil) and (Bookmark2 = nil) then Result := 1
else if (Bookmark1 = nil) and (Bookmark2 <> nil) then Result := -1
else if TBookmarkData(Bookmark1^) > TBookmarkData(Bookmark2^) then
Result := 1
else if TBookmarkData(Bookmark1^) < TBookmarkData(Bookmark2^) then
Result := -1
else Result := 0;
end;
procedure TRxMemoryData.GetBookmarkData(Buffer: PChar; Data: Pointer);
begin
Move(PMemBookmarkInfo(Buffer + FBookmarkOfs)^.BookmarkData, Data^,
SizeOf(TBookmarkData));
end;
procedure TRxMemoryData.SetBookmarkData(Buffer: PChar; Data: Pointer);
begin
Move(Data^, PMemBookmarkInfo(Buffer + FBookmarkOfs)^.BookmarkData,
SizeOf(TBookmarkData));
end;
function TRxMemoryData.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
begin
Result := PMemBookmarkInfo(Buffer + FBookmarkOfs)^.BookmarkFlag;
end;
procedure TRxMemoryData.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
begin
PMemBookmarkInfo(Buffer + FBookmarkOfs)^.BookmarkFlag := Value;
end;
procedure TRxMemoryData.InternalGotoBookmark(Bookmark: TBookmark);
var
Rec: TMemoryRecord;
SavePos: Integer;
Accept: Boolean;
begin
Rec := FindRecordID(TBookmarkData(Bookmark^));
if Rec <> nil then begin
Accept := True;
SavePos := FRecordPos;
try
FRecordPos := Rec.Index;
if Filtered then Accept := RecordFilter;
finally
if not Accept then FRecordPos := SavePos;
end;
end;
end;
{ Navigation }
procedure TRxMemoryData.InternalSetToRecord(Buffer: PChar);
begin
InternalGotoBookmark(@PMemBookmarkInfo(Buffer + FBookmarkOfs)^.BookmarkData);
end;
procedure TRxMemoryData.InternalFirst;
begin
FRecordPos := -1;
end;
procedure TRxMemoryData.InternalLast;
begin
FRecordPos := FRecords.Count;
end;
{ Data Manipulation }
procedure TRxMemoryData.AssignMemoryRecord(Rec: TMemoryRecord; Buffer: PChar);
var
I: Integer;
begin
Move(Buffer^, Rec.Data^, FRecordSize);
for I := 0 to BlobFieldCount - 1 do
PMemBlobArray(Rec.FBlobs)[I] := PMemBlobArray(Buffer + FBlobOfs)[I];
end;
procedure TRxMemoryData.SetMemoryRecordData(Buffer: PChar; Pos: Integer);
var
Rec: TMemoryRecord;
begin
if State = dsFilter then Error(SNotEditing);
Rec := Records[Pos];
AssignMemoryRecord(Rec, Buffer);
end;
procedure TRxMemoryData.SetAutoIncFields(Buffer: PChar);
var
I, Count: Integer;
Data: PChar;
begin
Count := 0;
for I := 0 to FieldCount - 1 do
if (Fields[I].FieldKind in fkStoredFields) and
(Fields[I].DataType = ftAutoInc) then
begin
Data := FindFieldData(Buffer, Fields[I]);
if Data <> nil then begin
Boolean(Data[0]) := True;
Inc(Data);
Move(FAutoInc, Data^, SizeOf(Longint));
Inc(Count);
end;
end;
if Count > 0 then Inc(FAutoInc);
end;
procedure TRxMemoryData.InternalAddRecord(Buffer: Pointer; Append: Boolean);
var
RecPos: Integer;
Rec: TMemoryRecord;
begin
if Append then begin
Rec := AddRecord;
FRecordPos := FRecords.Count - 1;
end
else begin
if FRecordPos = -1 then RecPos := 0
else RecPos := FRecordPos;
Rec := InsertRecord(RecPos);
FRecordPos := RecPos;
end;
?? 快捷鍵說(shuō)明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -