pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fix work with variant types on rxmemdataset

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1261 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
alexs75
2010-07-20 16:08:40 +00:00
parent 7f8f0aade3
commit a5c4deabef
2 changed files with 100 additions and 160 deletions
Download Patch File Download Diff File Expand all files Collapse all files

159
components/rx/Demos/RxDBGrid/RxDBGridDemo.lpi
View File

@@ -1,7 +1,7 @@
<?xml version="1.0"?> <?xml version="1.0"?>
<CONFIG> <CONFIG>
<ProjectOptions> <ProjectOptions>
<Version Value="7"/> <Version Value="8"/>
<General> <General>
<Flags> <Flags>
<AlwaysBuild Value="False"/> <AlwaysBuild Value="False"/>
@@ -53,7 +53,7 @@
<MinVersion Major="1" Release="18" Build="56" Valid="True"/> <MinVersion Major="1" Release="18" Build="56" Valid="True"/>
</Item4> </Item4>
</RequiredPackages> </RequiredPackages>
<Units Count="60"> <Units Count="62">
<Unit0> <Unit0>
<Filename Value="RxDBGridDemo.lpr"/> <Filename Value="RxDBGridDemo.lpr"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
@@ -72,10 +72,11 @@
<IsVisibleTab Value="True"/> <IsVisibleTab Value="True"/>
<EditorIndex Value="0"/> <EditorIndex Value="0"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="148"/> <TopLine Value="1"/>
<CursorPos X="12" Y="157"/> <CursorPos X="73" Y="8"/>
<UsageCount Value="53"/> <UsageCount Value="53"/>
<Loaded Value="True"/> <Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit1> </Unit1>
<Unit2> <Unit2>
<Filename Value="../../../../fpcsrc/fcl/db/db.pp"/> <Filename Value="../../../../fpcsrc/fcl/db/db.pp"/>
@@ -304,12 +305,10 @@
</Unit33> </Unit33>
<Unit34> <Unit34>
<Filename Value="../../../../../../install/fpcsrc/rtl/objpas/classes/classesh.inc"/> <Filename Value="../../../../../../install/fpcsrc/rtl/objpas/classes/classesh.inc"/>
<EditorIndex Value="5"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="426"/> <TopLine Value="426"/>
<CursorPos X="17" Y="448"/> <CursorPos X="17" Y="448"/>
<UsageCount Value="16"/> <UsageCount Value="16"/>
<Loaded Value="True"/>
</Unit34> </Unit34>
<Unit35> <Unit35>
<Filename Value="../../../../../smsprog/sms_send_deamon/smsSendGui/smssendaboutunit.pas"/> <Filename Value="../../../../../smsprog/sms_send_deamon/smsSendGui/smssendaboutunit.pas"/>
@@ -379,12 +378,10 @@
<Unit43> <Unit43>
<Filename Value="/usr/local/share/lazarus/lcl/dbgrids.pas"/> <Filename Value="/usr/local/share/lazarus/lcl/dbgrids.pas"/>
<UnitName Value="DBGrids"/> <UnitName Value="DBGrids"/>
<EditorIndex Value="2"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="3153"/> <TopLine Value="3153"/>
<CursorPos X="18" Y="3171"/> <CursorPos X="18" Y="3171"/>
<UsageCount Value="14"/> <UsageCount Value="14"/>
<Loaded Value="True"/>
</Unit43> </Unit43>
<Unit44> <Unit44>
<Filename Value="/usr/local/share/lazarus/components/rxnew/registerrxdb.pas"/> <Filename Value="/usr/local/share/lazarus/components/rxnew/registerrxdb.pas"/>
@@ -396,7 +393,6 @@
<Unit45> <Unit45>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/> <Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<UnitName Value="rxdbgrid"/> <UnitName Value="rxdbgrid"/>
<EditorIndex Value="1"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="1895"/> <TopLine Value="1895"/>
<CursorPos X="32" Y="1920"/> <CursorPos X="32" Y="1920"/>
@@ -406,7 +402,6 @@
<Item1 X="13" Y="1203" ID="1"/> <Item1 X="13" Y="1203" ID="1"/>
<Item2 X="11" Y="1606" ID="2"/> <Item2 X="11" Y="1606" ID="2"/>
</Bookmarks> </Bookmarks>
<Loaded Value="True"/>
</Unit45> </Unit45>
<Unit46> <Unit46>
<Filename Value="/usr/local/share/lazarus/ideintf/dbpropedits.pas"/> <Filename Value="/usr/local/share/lazarus/ideintf/dbpropedits.pas"/>
@@ -453,12 +448,10 @@
<Unit51> <Unit51>
<Filename Value="/usr/local/share/lazarus/components/synedit/synedit.pp"/> <Filename Value="/usr/local/share/lazarus/components/synedit/synedit.pp"/>
<UnitName Value="SynEdit"/> <UnitName Value="SynEdit"/>
<EditorIndex Value="4"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="5699"/> <TopLine Value="5699"/>
<CursorPos X="1" Y="5702"/> <CursorPos X="1" Y="5702"/>
<UsageCount Value="16"/> <UsageCount Value="16"/>
<Loaded Value="True"/>
</Unit51> </Unit51>
<Unit52> <Unit52>
<Filename Value="/usr/local/share/lazarus/components/synedit/syneditkeycmds.pp"/> <Filename Value="/usr/local/share/lazarus/components/synedit/syneditkeycmds.pp"/>
@@ -518,145 +511,45 @@
</Unit57> </Unit57>
<Unit58> <Unit58>
<Filename Value="../../../../../../install/fpcsrc/rtl/objpas/classes/collect.inc"/> <Filename Value="../../../../../../install/fpcsrc/rtl/objpas/classes/collect.inc"/>
<EditorIndex Value="6"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="286"/> <TopLine Value="286"/>
<CursorPos X="1" Y="288"/> <CursorPos X="1" Y="288"/>
<UsageCount Value="15"/> <UsageCount Value="15"/>
<Loaded Value="True"/>
</Unit58> </Unit58>
<Unit59> <Unit59>
<Filename Value="/usr/local/share/lazarus/lcl/grids.pas"/> <Filename Value="/usr/local/share/lazarus/lcl/grids.pas"/>
<UnitName Value="Grids"/> <UnitName Value="Grids"/>
<EditorIndex Value="3"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="3153"/> <TopLine Value="3153"/>
<CursorPos X="27" Y="3167"/> <CursorPos X="27" Y="3167"/>
<UsageCount Value="13"/> <UsageCount Value="13"/>
<Loaded Value="True"/>
</Unit59> </Unit59>
<Unit60>
<Filename Value="../../../../../../wine/1/1/rx.diff"/>
<WindowIndex Value="0"/>
<TopLine Value="1"/>
<CursorPos X="1" Y="9"/>
<UsageCount Value="10"/>
<DefaultSyntaxHighlighter Value="Diff"/>
</Unit60>
<Unit61>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxmemds.pas"/>
<UnitName Value="rxmemds"/>
<WindowIndex Value="0"/>
<TopLine Value="1088"/>
<CursorPos X="1" Y="1113"/>
<UsageCount Value="10"/>
</Unit61>
</Units> </Units>
<JumpHistory Count="30" HistoryIndex="29"> <JumpHistory Count="2" HistoryIndex="1">
<Position1> <Position1>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/> <Filename Value="rxdbgridmainunit.pas"/>
<Caret Line="1220" Column="1" TopLine="1194"/> <Caret Line="161" Column="14" TopLine="148"/>
</Position1> </Position1>
<Position2> <Position2>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/> <Filename Value="rxdbgridmainunit.pas"/>
<Caret Line="1222" Column="1" TopLine="1194"/> <Caret Line="8" Column="73" TopLine="1"/>
</Position2> </Position2>
<Position3>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="1223" Column="1" TopLine="1206"/>
</Position3>
<Position4>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="1224" Column="1" TopLine="1206"/>
</Position4>
<Position5>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="1226" Column="1" TopLine="1206"/>
</Position5>
<Position6>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="1227" Column="1" TopLine="1206"/>
</Position6>
<Position7>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="1228" Column="1" TopLine="1206"/>
</Position7>
<Position8>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="1230" Column="1" TopLine="1206"/>
</Position8>
<Position9>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="1231" Column="1" TopLine="1206"/>
</Position9>
<Position10>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="1230" Column="1" TopLine="1206"/>
</Position10>
<Position11>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="1231" Column="1" TopLine="1206"/>
</Position11>
<Position12>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="1233" Column="1" TopLine="1206"/>
</Position12>
<Position13>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="1234" Column="1" TopLine="1206"/>
</Position13>
<Position14>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="1235" Column="1" TopLine="1206"/>
</Position14>
<Position15>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="1239" Column="1" TopLine="1207"/>
</Position15>
<Position16>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="391" Column="35" TopLine="364"/>
</Position16>
<Position17>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="1366" Column="41" TopLine="1347"/>
</Position17>
<Position18>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="1596" Column="30" TopLine="1566"/>
</Position18>
<Position19>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="1597" Column="24" TopLine="1576"/>
</Position19>
<Position20>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="1588" Column="53" TopLine="1549"/>
</Position20>
<Position21>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="3052" Column="24" TopLine="3033"/>
</Position21>
<Position22>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="3017" Column="18" TopLine="3015"/>
</Position22>
<Position23>
<Filename Value="/usr/local/share/lazarus/lcl/dbgrids.pas"/>
<Caret Line="3460" Column="18" TopLine="3456"/>
</Position23>
<Position24>
<Filename Value="/usr/local/share/lazarus/lcl/grids.pas"/>
<Caret Line="10083" Column="16" TopLine="10081"/>
</Position24>
<Position25>
<Filename Value="/usr/local/share/lazarus/lcl/grids.pas"/>
<Caret Line="504" Column="29" TopLine="488"/>
</Position25>
<Position26>
<Filename Value="/usr/local/share/lazarus/lcl/dbgrids.pas"/>
<Caret Line="3366" Column="21" TopLine="3360"/>
</Position26>
<Position27>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="276" Column="15" TopLine="257"/>
</Position27>
<Position28>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="1282" Column="17" TopLine="1272"/>
</Position28>
<Position29>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="1220" Column="13" TopLine="1205"/>
</Position29>
<Position30>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="1254" Column="7" TopLine="1218"/>
</Position30>
</JumpHistory> </JumpHistory>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>

101
components/rx/rxmemds.pas
View File

@@ -68,6 +68,7 @@ type
FCaseInsensitiveSort: Boolean; FCaseInsensitiveSort: Boolean;
FDescendingSort: Boolean; FDescendingSort: Boolean;
function AddRecord: TMemoryRecord; function AddRecord: TMemoryRecord;
procedure CopyRecord(RecordData, Buffer: PChar);
function GetOnFilterRecordEx: TFilterRecordEvent; function GetOnFilterRecordEx: TFilterRecordEvent;
function InsertRecord(Index: Integer): TMemoryRecord; function InsertRecord(Index: Integer): TMemoryRecord;
function FindRecordID(ID: Integer): TMemoryRecord; function FindRecordID(ID: Integer): TMemoryRecord;
@@ -77,7 +78,8 @@ type
procedure SetOnFilterRecordEx(const AValue: TFilterRecordEvent); procedure SetOnFilterRecordEx(const AValue: TFilterRecordEvent);
procedure Sort; procedure Sort;
function CalcRecordSize: Integer; function CalcRecordSize: Integer;
function FindFieldData(Buffer: Pointer; Field: TField): Pointer; function FindFieldData(Buffer: Pointer; Field: TField): Pointer;overload;
function FindFieldData(Buffer: Pointer; FieldNo:Integer): Pointer;overload;
function GetMemoryRecord(Index: Integer): TMemoryRecord; function GetMemoryRecord(Index: Integer): TMemoryRecord;
function GetCapacity: Integer; function GetCapacity: Integer;
function RecordFilter: Boolean; function RecordFilter: Boolean;
@@ -438,6 +440,7 @@ begin
for I := 0 to Value.FieldDefs.Count - 1 do for I := 0 to Value.FieldDefs.Count - 1 do
CalcDataSize(Value.FieldDefs[I], DataSize); CalcDataSize(Value.FieldDefs[I], DataSize);
ReallocMem(FData, DataSize); ReallocMem(FData, DataSize);
FillChar(FData^, DataSize, 0);
end; end;
end; end;
end; end;
@@ -583,19 +586,15 @@ function TRxMemoryData.FindFieldData(Buffer: Pointer; Field: TField): Pointer;
var var
Index: Integer; Index: Integer;
begin begin
{.$IFDEF RX_D4}
// Index := FieldDefList.IndexOf(Field.FullName);
{.$ELSE}
Index := FieldDefs.IndexOf(Field.FieldName); Index := FieldDefs.IndexOf(Field.FieldName);
{.$ENDIF} Result:=FindFieldData(Buffer, Index);
if (Index >= 0) and (Buffer <> nil) and end;
{.$IFDEF RX_D4}
// (FieldDefList[Index].DataType in ftSupported - ftBlobTypes) then function TRxMemoryData.FindFieldData(Buffer: Pointer; FieldNo: Integer): Pointer;
{.$ELSE} begin
(FieldDefs[Index].DataType in ftSupported - ftBlobTypes) then Result := nil;
{.$ENDIF} if (FieldNo >= 0) and (Buffer <> nil) and (FieldDefs[FieldNo].DataType in ftSupported - ftBlobTypes) then
Result := Pointer(PtrInt(PChar(Buffer)) + FOffsets^[Index]) Result := Pointer(PtrInt(PChar(Buffer)) + FOffsets^[FieldNo]);
else Result := nil;
end; end;
{ Buffer Manipulation } { Buffer Manipulation }
@@ -639,10 +638,26 @@ begin
end; end;
procedure TRxMemoryData.FreeRecordBuffer(var Buffer: PChar); procedure TRxMemoryData.FreeRecordBuffer(var Buffer: PChar);
var
n:integer;
FieldPtr:PChar;
begin begin
if BlobFieldCount > 0 then //correctly release field memory for complex types
for n:=0 to FieldDefs.Count-1 do
if FieldDefs.Items[n].DataType = ftVariant then
begin
FieldPtr:=FindFieldData(Buffer, n);
if FieldPtr <> nil then
begin
PBoolean(FieldPtr)^:=False;
Inc(FieldPtr);
Finalize( PVariant(FieldPtr)^ );
end;
end;
if BlobFieldCount > 0 then
FinalizeBlobFields(PMemBlobArray(Buffer + FBlobOfs), BlobFieldCount); FinalizeBlobFields(PMemBlobArray(Buffer + FBlobOfs), BlobFieldCount);
// Finalize(PMemBlobArray(Buffer + FBlobOfs)^[0]);//, BlobFieldCount)
StrDispose(Buffer); StrDispose(Buffer);
Buffer := nil; Buffer := nil;
end; end;
@@ -674,6 +689,35 @@ begin
end; end;
end; end;
procedure TRxMemoryData.CopyRecord(RecordData, Buffer:PChar);
var
n, FieldSize:Integer;
FieldPtr, BufPtr:PChar;
DataType:TFieldType;
begin
for n:=0 to FieldDefs.Count-1 do
begin
FieldPtr:=FindFieldData(RecordData, n);
BufPtr:=FindFieldData(Buffer, n);
if FieldPtr = nil then Continue;
PBoolean(BufPtr)^:=PBoolean(FieldPtr)^;
Inc(FieldPtr);
Inc(BufPtr);
DataType:=FieldDefs.Items[n].DataType;
if DataType = ftVariant then
begin
PVariant(BufPtr)^:=PVariant(FieldPtr)^;
end
else
begin
FieldSize:=FieldDefs.Items[n].Size;
Move( FieldPtr^, BufPtr^, CalcFieldLen(DataType, FieldSize) );
end;
end;
end;
function TRxMemoryData.GetCurrentRecord(Buffer: PChar): Boolean; function TRxMemoryData.GetCurrentRecord(Buffer: PChar): Boolean;
begin begin
Result := False; Result := False;
@@ -682,7 +726,9 @@ begin
UpdateCursorPos; UpdateCursorPos;
if (FRecordPos >= 0) and (FRecordPos < RecordCount) then if (FRecordPos >= 0) and (FRecordPos < RecordCount) then
begin begin
Move(Records[FRecordPos].Data^, Buffer^, FRecordSize); //Move(Records[FRecordPos].Data^, Buffer^, FRecordSize);
CopyRecord(Records[FRecordPos].Data, Buffer);
Result := True; Result := True;
end; end;
end; end;
@@ -692,7 +738,8 @@ procedure TRxMemoryData.RecordToBuffer(Rec: TMemoryRecord; Buffer: PChar);
var var
I: Integer; I: Integer;
begin begin
Move(Rec.Data^, Buffer^, FRecordSize); //Move(Rec.Data^, Buffer^, FRecordSize);
CopyRecord(Rec.Data, Buffer);
with PMemBookmarkInfo(Buffer + FBookmarkOfs)^ do with PMemBookmarkInfo(Buffer + FBookmarkOfs)^ do
begin begin
BookmarkData := Rec.ID; BookmarkData := Rec.ID;
@@ -851,17 +898,15 @@ begin
begin begin
if DataType = ftVariant then if DataType = ftVariant then
begin begin
if Buffer <> nil then if (Buffer = nil) or VarIsNull(PVariant(Buffer)^) or VarIsEmpty(PVariant(Buffer)^) or
VarData := PVariant(Buffer)^ VarIsEmptyParam(PVariant(Buffer)^) then
FillChar(Data^, CalcFieldLen(DataType, Size), 0)
else else
VarData := EmptyParam; begin
Boolean(Data[0]) := LongBool(Buffer) and not Boolean(Data[0]):=True;
(VarIsNull(VarData) or VarIsEmpty(VarData));
if Boolean(Data[0]) then begin
Inc(Data); Inc(Data);
PVariant(Data)^ := VarData; PVariant(Data)^ := PVariant(Buffer)^;
end end;
else FillChar(Data^, CalcFieldLen(DataType, Size), 0);
end end
else else
begin begin
@@ -1063,7 +1108,9 @@ procedure TRxMemoryData.AssignMemoryRecord(Rec: TMemoryRecord; Buffer: PChar);
var var
I: Integer; I: Integer;
begin begin
Move(Buffer^, Rec.Data^, FRecordSize); //Move(Buffer^, Rec.Data^, FRecordSize);
CopyRecord(Buffer, PChar(Rec.Data));
for I := 0 to BlobFieldCount - 1 do for I := 0 to BlobFieldCount - 1 do
PMemBlobArray(Rec.FBlobs)^[I] := PMemBlobArray(Buffer + FBlobOfs)^[I]; PMemBlobArray(Rec.FBlobs)^[I] := PMemBlobArray(Buffer + FBlobOfs)^[I];
end; end;