?? rxmemds.pas
字號:
SetAutoIncFields(Buffer);
SetMemoryRecordData(Buffer, Rec.Index);
end;
procedure TRxMemoryData.InternalDelete;
var
Accept: Boolean;
begin
Records[FRecordPos].Free;
if FRecordPos >= FRecords.Count then Dec(FRecordPos);
Accept := True;
repeat
if Filtered then Accept := RecordFilter;
if not Accept then Dec(FRecordPos);
until Accept or (FRecordPos < 0);
if FRecords.Count = 0 then FLastID := Low(Integer);
end;
procedure TRxMemoryData.InternalPost;
var
RecPos: Integer;
begin
if State = dsEdit then
SetMemoryRecordData(ActiveBuffer, FRecordPos)
else begin
if State in [dsInsert] then SetAutoIncFields(ActiveBuffer);
if FRecordPos >= FRecords.Count then begin
SetMemoryRecordData(ActiveBuffer, AddRecord.Index);
FRecordPos := FRecords.Count - 1;
end
else begin
if FRecordPos = -1 then RecPos := 0
else RecPos := FRecordPos;
SetMemoryRecordData(ActiveBuffer, InsertRecord(RecPos).Index);
FRecordPos := RecPos;
end;
end;
end;
procedure TRxMemoryData.OpenCursor(InfoQuery: Boolean);
begin
if not InfoQuery then begin
if FieldCount > 0 then FieldDefs.Clear;
InitFieldDefsFromFields;
end;
FActive := True;
inherited OpenCursor(InfoQuery);
end;
procedure TRxMemoryData.InternalOpen;
begin
BookmarkSize := SizeOf(TBookmarkData);
{$IFDEF RX_D4}
if DefaultFields then CreateFields;
{$ELSE}
if DefaultFields then Error(SInvalidFields);
{$ENDIF}
BindFields(True);
InitBufferPointers(True);
InternalFirst;
end;
procedure TRxMemoryData.InternalClose;
begin
ClearRecords;
FAutoInc := 1;
BindFields(False);
{$IFDEF RX_D4}
if DefaultFields then DestroyFields;
{$ENDIF}
FreeIndexList;
FActive := False;
end;
procedure TRxMemoryData.InternalHandleException;
begin
Application.HandleException(Self);
end;
procedure TRxMemoryData.InternalInitFieldDefs;
begin
end;
function TRxMemoryData.IsCursorOpen: Boolean;
begin
Result := FActive;
end;
{ Informational }
function TRxMemoryData.GetRecordCount: Integer;
begin
Result := FRecords.Count;
end;
function TRxMemoryData.GetRecNo: Integer;
begin
CheckActive;
UpdateCursorPos;
if (FRecordPos = -1) and (RecordCount > 0) then Result := 1
else Result := FRecordPos + 1;
end;
procedure TRxMemoryData.SetRecNo(Value: Integer);
begin
if (Value > 0) and (Value <= FRecords.Count) then begin
FRecordPos := Value - 1;
Resync([]);
end;
end;
function TRxMemoryData.IsSequenced: Boolean;
begin
Result := not Filtered;
end;
function TRxMemoryData.Locate(const KeyFields: string;
const KeyValues: Variant; Options: TLocateOptions): Boolean;
begin
DoBeforeScroll;
Result := DataSetLocateThrough(Self, KeyFields, KeyValues, Options);
if Result then begin
DataEvent(deDataSetChange, 0);
DoAfterScroll;
end;
end;
{ Table Manipulation }
procedure TRxMemoryData.EmptyTable;
begin
if Active then begin
CheckBrowseMode;
ClearRecords;
ClearBuffers;
DataEvent(deDataSetChange, 0);
end;
end;
procedure TRxMemoryData.CopyStructure(Source: TDataSet);
procedure CheckDataTypes(FieldDefs: TFieldDefs);
var
I: Integer;
begin
for I := FieldDefs.Count - 1 downto 0 do begin
if not (FieldDefs.Items[I].DataType in ftSupported) then
FieldDefs.Items[I].Free
{$IFDEF RX_D4}
else CheckDataTypes(FieldDefs[I].ChildDefs);
{$ENDIF}
end;
end;
var
I: Integer;
begin
CheckInactive;
for I := FieldCount - 1 downto 0 do Fields[I].Free;
if (Source = nil) then Exit;
Source.FieldDefs.Update;
FieldDefs := Source.FieldDefs;
CheckDataTypes(FieldDefs);
{$IFDEF RX_D4}
CreateFields;
{$ELSE}
for I := 0 to FieldDefs.Count - 1 do begin
if (csDesigning in ComponentState) and (Owner <> nil) then
FieldDefs.Items[I].CreateField(Owner)
else
FieldDefs.Items[I].CreateField(Self);
end;
{$ENDIF}
end;
function TRxMemoryData.LoadFromDataSet(Source: TDataSet; RecordCount: Integer;
Mode: TLoadMode): Integer;
var
SourceActive: Boolean;
MovedCount: Integer;
begin
Result := 0;
if Source = Self then Exit;
SourceActive := Source.Active;
Source.DisableControls;
try
DisableControls;
try
Filtered := False;
with Source do begin
Open;
CheckBrowseMode;
UpdateCursorPos;
end;
if Mode = lmCopy then begin
Close;
CopyStructure(Source);
end;
FreeIndexList;
if not Active then Open;
CheckBrowseMode;
if RecordCount > 0 then MovedCount := RecordCount
else begin
Source.First;
MovedCount := MaxInt;
end;
try
while not Source.EOF do begin
Append;
AssignRecord(Source, Self, True);
Post;
Inc(Result);
if Result >= MovedCount then Break;
Source.Next;
end;
finally
First;
end;
finally
EnableControls;
end;
finally
if not SourceActive then Source.Close;
Source.EnableControls;
end;
end;
function TRxMemoryData.SaveToDataSet(Dest: TDataSet; RecordCount: Integer): Integer;
var
MovedCount: Integer;
begin
Result := 0;
if Dest = Self then Exit;
CheckBrowseMode;
UpdateCursorPos;
Dest.DisableControls;
try
DisableControls;
try
if not Dest.Active then Dest.Open
else Dest.CheckBrowseMode;
if RecordCount > 0 then MovedCount := RecordCount
else begin
First;
MovedCount := MaxInt;
end;
try
while not EOF do begin
Dest.Append;
AssignRecord(Self, Dest, True);
Dest.Post;
Inc(Result);
if Result >= MovedCount then Break;
Next;
end;
finally
Dest.First;
end;
finally
EnableControls;
end;
finally
Dest.EnableControls;
end;
end;
{ Index Related }
procedure TRxMemoryData.SortOnFields(const FieldNames: string;
{$IFDEF RX_D4}
CaseInsensitive: Boolean = True; Descending: Boolean = False);
{$ELSE}
CaseInsensitive, Descending: Boolean);
{$ENDIF}
begin
CreateIndexList(FieldNames);
FCaseInsensitiveSort := CaseInsensitive;
FDescendingSort := Descending;
try
Sort;
except
FreeIndexList;
raise;
end;
end;
procedure TRxMemoryData.Sort;
var
Pos: TBookmarkStr;
begin
if Active and (FRecords <> nil) and (FRecords.Count > 0) then begin
Pos := Bookmark;
try
QuickSort(0, FRecords.Count - 1, CompareRecords);
SetBufListSize(0);
InitBufferPointers(False);
try
SetBufListSize(BufferCount + 1);
except
SetState(dsInactive);
CloseCursor;
raise;
end;
finally
Bookmark := Pos;
end;
Resync([]);
end;
end;
procedure TRxMemoryData.QuickSort(L, R: Integer; Compare: TCompareRecords);
var
I, J: Integer;
P: TMemoryRecord;
begin
repeat
I := L;
J := R;
P := Records[(L + R) shr 1];
repeat
while Compare(Records[I], P) < 0 do Inc(I);
while Compare(Records[J], P) > 0 do Dec(J);
if I <= J then begin
FRecords.Exchange(I, J);
Inc(I);
Dec(J);
end;
until I > J;
if L < J then QuickSort(L, J, Compare);
L := I;
until I >= R;
end;
function TRxMemoryData.CompareRecords(Item1, Item2: TMemoryRecord): Integer;
var
Data1, Data2: PChar;
F: TField;
I: Integer;
begin
Result := 0;
if FIndexList <> nil then begin
for I := 0 to FIndexList.Count - 1 do begin
F := TField(FIndexList[I]);
Data1 := FindFieldData(Item1.Data, F);
if Data1 <> nil then begin
Data2 := FindFieldData(Item2.Data, F);
if Data2 <> nil then begin
if Boolean(Data1[0]) and Boolean(Data2[0]) then begin
Inc(Data1);
Inc(Data2);
Result := CompareFields(Data1, Data2, F.DataType,
FCaseInsensitiveSort);
end
else if Boolean(Data1[0]) then Result := 1
else if Boolean(Data2[0]) then Result := -1;
if FDescendingSort then Result := -Result;
end;
end;
if Result <> 0 then Exit;
end;
end;
if (Result = 0) then begin
if Item1.ID > Item2.ID then Result := 1
else if Item1.ID < Item2.ID then Result := -1;
if FDescendingSort then Result := -Result;
end;
end;
function TRxMemoryData.GetIsIndexField(Field: TField): Boolean;
begin
if FIndexList <> nil then
Result := FIndexList.IndexOf(Field) >= 0
else Result := False;
end;
procedure TRxMemoryData.CreateIndexList(const FieldNames: string);
var
Pos: Integer;
F: TField;
begin
if FIndexList = nil then FIndexList := TList.Create
else FIndexList.Clear;
Pos := 1;
while Pos <= Length(FieldNames) do begin
F := FieldByName(ExtractFieldName(FieldNames, Pos));
if (F.FieldKind = fkData) and
(F.DataType in ftSupported - ftBlobTypes) then
FIndexList.Add(F)
else ErrorFmt(SFieldTypeMismatch, [F.DisplayName]);
end;
end;
procedure TRxMemoryData.FreeIndexList;
begin
FIndexList.Free;
FIndexList := nil;
end;
{ TMemBlobStream }
constructor TMemBlobStream.Create(Field: TBlobField; Mode: TBlobStreamMode);
begin
FMode := Mode;
FField := Field;
FDataSet := FField.DataSet as TRxMemoryData;
if not FDataSet.GetActiveRecBuf(FBuffer) then Exit;
if not FField.Modified and (Mode <> bmRead) then begin
if FField.ReadOnly then ErrorFmt(SFieldReadOnly, [FField.DisplayName]);
if not (FDataSet.State in [dsEdit, dsInsert]) then Error(SNotEditing);
FCached := True;
end
else FCached := (FBuffer = FDataSet.ActiveBuffer);
FOpened := True;
if Mode = bmWrite then Truncate;
end;
destructor TMemBlobStream.Destroy;
begin
if FOpened and FModified then FField.Modified := True;
if FModified then
try
FDataSet.DataEvent(deFieldChange, Longint(FField));
except
Application.HandleException(Self);
end;
end;
function TMemBlobStream.GetBlobFromRecord(Field: TField): TMemBlobData;
var
Rec: TMemoryRecord;
Pos: Integer;
begin
Result := '';
Pos := FDataSet.FRecordPos;
if (Pos < 0) and (FDataSet.RecordCount > 0) then Pos := 0
else if Pos >= FDataSet.RecordCount then Pos := FDataSet.RecordCount - 1;
if (Pos >= 0) and (Pos < FDataSet.RecordCount) then begin
Rec := FDataSet.Records[Pos];
if Rec <> nil then
Result := PMemBlobArray(Rec.FBlobs)[FField.Offset];
end;
end;
function TMemBlobStream.Read(var Buffer; Count: Longint): Longint;
begin
Result := 0;
if FOpened then begin
if Count > Size - FPosition then Result := Size - FPosition
else Result := Count;
if Result > 0 then begin
if FCached then begin
Move(PChar(FDataSet.GetBlobData(FField, FBuffer))[FPosition], Buffer,
Result);
Inc(FPosition, Result);
end
else begin
Move(PChar(GetBlobFromRecord(FField))[FPosition], Buffer,
Result);
Inc(FPosition, Result);
end;
end;
end;
end;
function TMemBlobStream.Write(const Buffer; Count: Longint): Longint;
var
Temp: TMemBlobData;
begin
Result := 0;
if FOpened and FCached and (FMode <> bmRead) then begin
Temp := FDataSet.GetBlobData(FField, FBuffer);
if Length(Temp) < FPosition + Count then
SetLength(Temp, FPosition + Count);
Move(Buffer, PChar(Temp)[FPosition], Count);
FDataSet.SetBlobData(FField, FBuffer, Temp);
Inc(FPosition, Count);
Result := Count;
FModified := True;
end;
end;
function TMemBlobStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
case Origin of
0: FPosition := Offset;
1: Inc(FPosition, Offset);
2: FPosition := GetBlobSize + Offset;
end;
Result := FPosition;
end;
procedure TMemBlobStream.Truncate;
begin
if FOpened and FCached and (FMode <> bmRead) then begin
FDataSet.SetBlobData(FField, FBuffer, '');
FModified := True;
end;
end;
function TMemBlobStream.GetBlobSize: Longint;
begin
Result := 0;
if FOpened then
if FCached then
Result := Length(FDataSet.GetBlobData(FField, FBuffer))
else
Result := Length(GetBlobFromRecord(FField))
end;
{$ENDIF RX_D3}
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -