Today I've stumbled on a problem which causes my array to be corrupted. Here is a reproducible test case:
unit Unit40;
interface
type
TVertex = record
X, Y: Double;
end;
TEdge = record
V1, V2: TVertex;
end;
TEdges = array of TEdge;
type
TBoundryInfo = array of TEdges;
procedure MemoryCorrupt;
implementation
procedure MemoryCorrupt;
var
BoundryInfo: TBoundryInfo;
i, PointIndex, BoundryLength: Integer;
begin
BoundryLength := 57;
PointIndex := 0;
SetLength(BoundryInfo, BoundryLength);
for i := 0 to BoundryLength - 1 do
begin
if i <> 17 then
begin
SetLength(BoundryInfo[i], 1);
BoundryInfo[i][0].V1.X := 1;
BoundryInfo[i][0].V2.X := 1;
BoundryInfo[i][0].V1.Y := 1;
BoundryInfo[i][0].V2.Y := 1;
end else
begin
SetLength(BoundryInfo[i], 2);
BoundryInfo[i][0].V1.X := 1;
BoundryInfo[i][0].V2.X := 1;
BoundryInfo[i][0].V1.Y := 1;
BoundryInfo[i][0].V2.Y := 1;
BoundryInfo[i][1].V1.X := 1;
BoundryInfo[i][1].V2.X := 1;
BoundryInfo[i][1].V1.Y := 1;
BoundryInfo[i][1].V2.Y := 1;
end;
end;
BoundryLength := 9;
SetLength(BoundryInfo, BoundryLength);
Move(BoundryInfo[PointIndex+1], BoundryInfo[PointIndex],
((BoundryLength - 1) - PointIndex) * SizeOf(BoundryInfo[PointIndex]));
Dec(BoundryLength);
Finalize(BoundryInfo[BoundryLength]);
SetLength(BoundryInfo, BoundryLength); //After this, arrays contains garbage
BoundryInfo[0][0].V1.X := 3;
end;
end.
I guess memory corruption after last SetLength is only a symptom of bad usage of Move.
Could someone explain to me what am I doing wrong and how to properly use Move in this case?
In original problem I am removing elements from BoundryInfo in a loop, that is why I am calling Finalize(BoundryInfo[BoundryLength])
In your code,
Move(BoundryInfo[PointIndex+1], BoundryInfo[PointIndex],
((BoundryLength - 1) - PointIndex) * SizeOf(BoundryInfo[PointIndex]));
Will copy the pointer of BoundryInfo[PointIndex+1] to BoundryInfo[PointIndex]. This pointer is another dynamic array, you have to take care of reference counting.
That is:
SetLength(BoundryInfo[PointIndex],0); // release memory
Move(BoundryInfo[PointIndex+1], BoundryInfo[PointIndex],
((BoundryLength - 1) - PointIndex) * SizeOf(BoundryInfo[PointIndex]));
PPointerArray(BoundryInfo)^[BoundryLength-1] := nil; // avoid GPF
In short:
Finalize the item which will be overriden during move();
Write nil to the latest item, which is duplicated by the move().
By using Move and subverting the dynamic array reference counting mechanism you are simply setting a trap for yourself. I would strongly recommend that you stick within the standard mechanisms, and let the compiler worry about the details. It will get them right every time.
for i := 0 to high(BoundaryInfo)-1 do
BoundaryInfo[i] := BoundaryInfo[i+1];
SetLength(BoundaryInfo, Length(BoundaryInfo)-1);
Related
I want to view the records of the database table in the frame being created and run time contains Label to display this data
I do not know what the code is
The data appears duplicate.
procedure TForm3.Button1Click(Sender: TObject);
var
cartRow: TFrm;
lin :SmallInt;
posX,posY : SmallInt;
s , id: string;
i : Integer;
begin
ScrollBox1.DestroyComponents;
s := FDQuery1.FieldByName('CountryAr').AsString;
id:= FDQuery1.FieldByName('CountryID').AsString;
posX := 0;
posY := 0;
for lin := 0 to FDTable1.RecordCount - 1 do
begin
cartRow := TFrm.Create(ScrollBox1);
cartRow.Parent :=ScrollBox1;
cartRow.Name := '';
cartRow.Left := posX -1;
cartRow.Top := posY -1;
cartRow.Label1.Caption := (s);
cartRow.Label2.Caption :=(id);
cartRow.Width := (ScrollBox1.Width) -3;
cartRow.Height := 35;
posY := posY + cartRow.Height +1;
end;
cartRow.Free;`
You have multiple issues in your code. First, you assign the values to s and id once, and then use those same values for every label, ignoring anything in the database after that assignment. Second, you never advance the record pointer in your loop, which means that it will end up in an infinite loop. Third, you're looping through FDTable1 fields, but reading the values from FDQuery1. Fourth, you're unnecessarily using a call to RecordCount instead of a simple while not Eof loop. And finally, you're freeing CartRow when it shouldn't be free'd; you're assigning ScrollBox1 as the owner of the control created, which means the scrollbox will free it when the scrollbox is free'd.
Something like this will work much better for you:
procedure TForm3.Button1Click(Sender: TObject);
var
cartRow: TFrm;
posX,posY : SmallInt;
begin
ScrollBox1.DestroyComponents;
posX := 0;
posY := 0;
FDQuery1.First;
while not FDQuery1.Eof do
begin
cartRow := TFrm.Create(ScrollBox1);
cartRow.Parent := ScrollBox1;
cartRow.Left := posX - 1;
cartRow.Top := posY - 1;
cartRow.Label1.Caption := FDQuery1.FieldByName('CountryAr').AsString;
cartRow.Label2.Caption := FDQuery1.FieldByName('CountryID').AsString;
cartRow.Width := ScrollBox1.Width - 3;
cartRow.Height := 35;
posY := posY + cartRow.Height + 1;
FDQuery1.Next;
end;
end;
Following on from my question on differentiation:
Differentiation of a buffer with Delphi
I'm now looking at doing the integration. I can't quite get my head around this one. The situation is that I receive a buffer of data periodically that contains a number of values that are a fixed distance in time apart. I need to differentiate them. It is soo long since I did calculus at school ....
What I have come up with is this:
procedure IntegrateBuffer(ABuffer: TDoubleDynArray;
var AOutBuffer: TDoubleDynArray;
AVPS: integer);
const
SumSum: double = 0.0;
LastValue: double = NaN;
var
i: integer;
dt, aa, hl, hr: double;
begin
// protect from divide by zero
if (AVPS < 1) then exit;
dt := 1 / AVPS;
for i := 0 to high(ABuffer) do begin
if (i = 0) then begin
if (IsNaN(LastValue)) then begin
hl := ABuffer[0];
hr := ABuffer[0];
end else begin
hl := LastValue;
hr := ABuffer[i];
end;
end else begin
hl := ABuffer[i -1];
hr := ABuffer[i];
end;
aa := 0.5 * dt * (hl + hr);
SumSum := SumSum + aa;
AOutBuffer[i] := SumSum;
end;
// remember the last value for next time
LastValue := ABuffer[high(ABuffer)];
end;
I'm using the trapezium rule, hl and hr ar the left and right heights of the trapezium. dt is the base.
AVPS is values per second. A typical value for this would be between 10 and 100. The length of the buffers would typically be 500 to 1000 values.
I call the buffer time after time with new data which is continuous with the previous block of data, hence keeping the last value of the block for next time.
Is what I have done correct? ie, will it integrate the values properly?
Thank you.
Looks like you need some help with testing the code. Here, as discussed in comments, is a very simple test.
{$APPTYPE CONSOLE}
uses
SysUtils, Math;
type
TDoubleDynArray = array of Double;
var
SumSum: double;
LastValue: double;
procedure Clear;
begin
SumSum := 0.0;
LastValue := NaN;
end;
procedure IntegrateBuffer(
ABuffer: TDoubleDynArray;
var AOutBuffer: TDoubleDynArray;
AVPS: integer
);
var
i: integer;
dt, aa, hl, hr: double;
begin
// protect from divide by zero
if (AVPS < 1) then exit;
dt := 1 / AVPS;
for i := 0 to high(ABuffer) do begin
if (i = 0) then begin
if (IsNaN(LastValue)) then begin
hl := ABuffer[0];
hr := ABuffer[0];
end else begin
hl := LastValue;
hr := ABuffer[i];
end;
end else begin
hl := ABuffer[i -1];
hr := ABuffer[i];
end;
aa := 0.5 * dt * (hl + hr);
SumSum := SumSum + aa;
AOutBuffer[i] := SumSum;
end;
// remember the last value for next time
LastValue := ABuffer[high(ABuffer)];
end;
var
Buffer: TDoubleDynArray;
OutBuffer: TDoubleDynArray;
begin
// test y = 1 for a single call, expected output = 1, actual output = 2
Clear;
Buffer := TDoubleDynArray.Create(1.0, 1.0);
SetLength(OutBuffer, Length(Buffer));
IntegrateBuffer(Buffer, OutBuffer, 1);
Writeln(OutBuffer[high(OutBuffer)]);
Readln;
end.
I'm integrating the function y(x) = 1 over the range [0..1]. So, the expected output is 1. But the actual output is 2.
So, what's wrong? You can work it out in the debugger, but it's easy enough to see by inspecting the code. You are summing a triangle on the very first sample. When IsNaN(LastValue) is true then you should not make a contribution to the integral. At that point you've not covered any distance on the x axis.
So to fix the code, let's try this:
....
if (IsNaN(LastValue)) then begin
hl := 0.0;//no contribution to sum
hr := 0.0;
end else begin
hl := LastValue;
hr := ABuffer[i];
end;
....
That fixes the problem.
Now let's extend the test a little and test y(x) = x:
// test y = x, expected output = 12.5
Clear;
Buffer := TDoubleDynArray.Create(0.0, 1.0, 2.0, 3.0, 4.0, 5.0);
SetLength(OutBuffer, Length(Buffer));
IntegrateBuffer(Buffer, OutBuffer, 1);
Writeln(OutBuffer[high(OutBuffer)]);
So, that looks good.
OK, what about multiple calls:
// test y = x for multiple calls, expected output = 18
Clear;
Buffer := TDoubleDynArray.Create(0.0, 1.0);
SetLength(OutBuffer, Length(Buffer));
IntegrateBuffer(Buffer, OutBuffer, 1);
Buffer := TDoubleDynArray.Create(2.0, 3.0, 4.0, 5.0, 6.0);
SetLength(OutBuffer, Length(Buffer));
IntegrateBuffer(Buffer, OutBuffer, 1);
Writeln(OutBuffer[high(OutBuffer)]);
And how about one value at a time?
// test y = x for multiple calls, one value at a time, expected 0.5
Clear;
Buffer := TDoubleDynArray.Create(0.0);
SetLength(OutBuffer, Length(Buffer));
IntegrateBuffer(Buffer, OutBuffer, 1);
Buffer := TDoubleDynArray.Create(1.0);
SetLength(OutBuffer, Length(Buffer));
IntegrateBuffer(Buffer, OutBuffer, 1);
Writeln(OutBuffer[high(OutBuffer)]);
What about passing an empty array?
// test y = x for multiple calls, some empty arrays, expected 0.5
Clear;
Buffer := TDoubleDynArray.Create(0.0);
SetLength(OutBuffer, Length(Buffer));
IntegrateBuffer(Buffer, OutBuffer, 1);
Buffer := nil;
SetLength(OutBuffer, Length(Buffer));
IntegrateBuffer(Buffer, OutBuffer, 1);
Buffer := TDoubleDynArray.Create(1.0);
SetLength(OutBuffer, Length(Buffer));
IntegrateBuffer(Buffer, OutBuffer, 1);
Writeln(OutBuffer[high(OutBuffer)]);
Uh, oh, access violation. Better protect that by simply skipping the function at the start if the buffer is empty:
if (AVPS < 1) then exit;
if (Length(ABuffer) = 0) then exit;
OK, now that last test passes
Hopefully you get the idea now. I've just used noddy Writeln based testing but that does not scale. Get yourself a unit test framework (I recommend DUnitX) and build proper test cases. This will also force you to factor your code so that it is well designed. One of the often unexpected benefits of making code testable is that it usually results in the design of the interface being improved.
For your next question, I request that you supply an SSCCE with the test code! ;-)
Some comments on the code:
Pass dynamic arrays by const or by var. In your case you want to pass the input buffer by const.
Don't use writeable typed constants. Use either parameters, or some other more sane state management.
Again, as I said in the previous question, write tests to prove code, as well as checking it by eye. The key to writing tests is to start with the very simplest thing you can possibly think of. Something so simple that you know for 100% sure the answer. Then, once you get that to work, expand the testing to more complex cases.
The following code nicely animates adding a new string to the end of a ListBox
procedure TForm6.AddItem(s: string);
var
l : TListBoxItem;
OldHeight : Single;
begin
l := TListBoxItem.Create(Self);
l.Text := s;
OldHeight := l.Height;
l.Height := 0;
l.Parent := ListBox1;
l.Opacity := 0;
l.AnimateFloat('height', OldHeight, 0.5);
l.AnimateFloat('Opacity', 1, 0.5);
end;
The item expands and fades in. However I want to be able to add the string into an arbitrary location in the ListBox - actually at the current ItemIndex.
Does anyone know how to do this?
To work around the fact that ListBox1.InsertObject and ListBox1.Items.Insert don't work you can do the following
procedure TForm1.AddItem(s: string);
var
l : TListBoxItem;
OldHeight : Single;
I: Integer;
index : integer;
begin
l := TListBoxItem.Create(nil);
l.Text := s;
OldHeight := l.Height;
l.Height := 0;
l.Opacity := 0;
l.Index := 0;
l.Parent := ListBox1;
Index := Max(0, ListBox1.ItemIndex);
for I := ListBox1.Count - 1 downto Index + 1 do
begin
ListBox1.Exchange(ListBox1.ItemByIndex(i), ListBox1.ItemByIndex(i-1));
end;
ListBox1.ItemIndex := Index;
l.AnimateFloat('height', OldHeight, 0.5);
l.AnimateFloat('Opacity', 1, 0.5);
end;
but is a bit ridiculous. It (eventually) adds the string in position 0 if there is no item selected, otherwise adds it before the selected item. This solution reminds me too much of Bubble Sort. You will need to add the math unit to your uses clause for the max function to work.
This does indeed seem to be a bug in FireMonkey (check Quality Central #102122), However I suspect a future FireMonkey update will fix this. If anyone can see a better way of doing this....
I've also made a movie about this for those who are interested, which illustrates things more clearly.
This should work, but it does nothing:
l := TListBoxItem.Create(ListBox1);
ListBox1.InsertObject(Max(ListBox1.ItemIndex, 0), l);
If I then call the following, I get an access violation:
ListBox1.Realign;
In fact, even this gives me an AV:
ListBox1.Items.Insert(0, 'hello');
ListBox1.Realign;
But this adds one, of course:
ListBox1.Items.Add('hello');
A bug perhaps?
Instead of
l.Parent := ListBox1;
use
ListBox1.InsertObject(Index, l);
where Index is the insertion position.
(Untested but from reading the sources it should work).
I am working with Delphi and DirectX. I want an dynamic array of IDirect3DVertexBuffer9. Is it possible? If yes then how?
I have written a code for it. But, it seems to be problematic. My code is shown below -
totalBuffer := 4;
SetLength(g_pVB,totalBuffer);
for cnt := 0 to totalBuffer - 1 do begin
if FAILED(g_pd3dDevice.CreateVertexBuffer(1 * SizeOf(TD3DXVector3),
0, D3DFVF_XYZ,
D3DPOOL_DEFAULT, g_pVB[cnt], nil)) then begin
Result := E_FAIL;
Exit;
end;
if FAILED(g_pVB[cnt].Lock(0, 0, Pointer(pVert[cnt]), 0)) then begin
Result := E_FAIL;
Exit;
end;
pVert[cnt] := 0;
end;
here, the problem I am facing is that, once it enter in for loop it continues and not exit the loop when cnt value is 4. And if I write static value 3 in for loop instead of totalBuffer it will exit the loop when value is 4.
You can find samples here. At Cull sample they used "array of IDirect3DVertexBuffer".
I'm sorry if the question looks stupid,but It seems I can't use my head properly in the last hours.
I have a record,
type
TMain = record
Sub:Array of TSubMain; //another record
Button:TsSpeedButton; //this is what we need!
end;
a variable
Main:Array of TMain;
and function:
procedure TFrameSkilLView.CreateButtons(MainBtns,SubMainBtns:byte;title:Array of string);
var i,t,l,w,h:word;
section:string;
begin
l := 41; t:= 57; w := 58; h := 25;
section := 'TOOLBTN_SKILLS_MAIN';
for i := 0 to MainBtns + subMainBtns - 1 do
with TsSpeedButton.Create(nil) do begin
Width := w; Height := h; Top := t; Left := l;
if(i = 0) then SkinData.SkinSection := section + '_C' else skindata.SkinSection := section;
caption := title[i];
Parent := Self;
inc(l,w+4);
if(i = MainBtns - 1) then begin
l := 52; t := 83; w := 64; h := 28;
section := 'TOOLBTN_SKILLS_SUBMAIN';
end;
end;
end;
Lets focus on the loop 'for i := 0 to MainBtns + subMainBtns - 1'.I'd like to add the button created below to the array created above named 'Main:Array of Tmain'.
It should look like this:
for i:=0 to X do
with TsSpeedButton.Create(nil) do begin
Main[i] := this; //where this is the created sSpeedButton.
Howeve,this code can't even be compiled,so I'm asking for a doable way to accomplish what I'm trying to do.
Thank you.
First off, "this" is C++, not Pascal. The Delphi version is "Self". Second, you can't refer to the with-ed object by name. You're better off not using with at all. Try something like this:
for i:=0 to X do
begin
tempButton := TsSpeedButton.Create(nil);
Main[i] := tempButton;
//whatever else
end;