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".
Related
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.
I have written a program in Delphi to compute, display and save a Pascals' triangle for a user-defined number of rows. It works fine (displays the triangle, and allows me to save it), except that it comes up with an access violation at the end! Here is the message:
Access violation at address 004031DB in module 'Project1.exe'. Read of address 00000000.
I have a 2D dynamic array in the procedure but I release the memory at the end (:= nil). Why is it still giving me an access violation? Very frustrating!
I searched the archives for an answer but could not find an appropriate answer. Any help will be greatly appreciated.
Here is the code (I was a little hesitant as there is a bit of code:
procedure TForm1.btnPTClick(Sender: TObject);
var
I, J, K, N, MidCol: integer;
PT: array of array of integer;
Row: string;
begin
K := StrToInt(lblNumRows.Text);
N := StrToInt(lblNumRows.Text);//# values in row = row number
try
//initiatlize the array
SetLength(PT, K, (N*2)-1);
for I := 0 to K-1 do
for J := 0 to (N*2-1) do
PT[I,J] := 0;
MidCol := (N*2 div 2)-1;//MidCol already 0-based
for I := 0 to K-1 do
begin
if (I = 0) then
PT[I,MidCol] := 1//first row gets 1 in the middle column
else if I = 1 then
begin
PT[I,MidCol-1] := 1;
PT[I,MidCol+1] := 1; //first and last value in second = 1
end
else //if any other row
begin
//Middle column
PT[I, MidCol] := PT[I-1,MidCol-1] + PT[I-1,MidCol+1];
//right triangle
for J := MidCol+1 to (N*2-1) do
begin
if (PT[I-1, J-1]=1) then//if already at the end of prev row
begin
PT[I,J] := 1;
break;
end
else
PT[I,J] := PT[I-1,J-1] + PT[I-1,J+1];
end;
//left triangle
for J := MidCol-1 downto 0 do
begin
if (PT[I-1, J+1] = 1) then //if already at the end of prev row
begin
PT[I,J] := 1;
break;
end
else
PT[I,J] := PT[I-1,J-1] + PT[I-1,J+1];
end;
end;
end;
//now add the pyramid to the memo
Application.ProcessMessages;
for I := 0 to K-1 do
begin
Row := '';
for J := 0 to N*2-1 do
begin
if (PT[I,J] = 0) then Row := Row + ' '
else Row := Row + IntToStr(PT[I,J]);
end;
Memo.Lines.Add(Row);
end;
finally
SetLength(PT, 0, 0);
end;
end;
Read of address 00000000
This indicates that you are trying to access memory using a pointer that is nil. To know why that is so one would need code. At present only you have code, and so only you can explain.
Run the program in the debugger. Enable Debug DCUs in case the error is raised in RTL/VCL code. Ensure that the debugger is configured to break on exceptions. The run your program and trigger the error. The debugger will show you which nil object is being de-referenced. Then you have to work out why that reference is nil.
The code you have added to the answer has a buffer overrun which could certainly explain the problem. Your SetLength is incorrect and should read:
SetLength(PT, K, N*2);
Your code writes to memory out-of-bounds and so corrupts the heap. You should ask the compiler to produce runtime checks on your array bounds. Enable the compiler's range checking option. Had you done so, you would have found this error yourself.
For what it is worth you do not need that try/finally block since the compiler will automatically insert a hidden block. There's no need for two when one suffices. A dynamic array is a managed type whose memory is disposed when the variable leaves scope.
Press F7, to start the project in the debugger.
Look in the main menu for the "Find Error..." option (in Delphi 7 it was under the Search menu)
then enter the address from the exception: 004031DB.
This will show you the exact line where the exception occurred.
Read of address 00000000 generally indicates you are using a pointer that has a nil value.
I have a DBGrid and use it to get data into a Array. But as soon as I press the button to do this procedure I get a StackOverFlow error ? Here is the Code I use :
iRy := 0;
iCol := DBGrid.Columns.Count;
sTest := DBGrid.Columns[0].Field.AsString;
While sTest <> '' do
begin
for k := 1 to iCol do
begin
arrData[iRy+1,iCol] := DBGrid.Columns[iCol].Field.AsString;
end;
Inc(iRy);
DBGrid.DataSource.DataSet.Next;
sToets := DBGrid.Columns[0].Field.AsString;
end;
I am using Delphi 7 .
When does sTest change?
A stackoverflow is caused by running out of memory on the stack. This While loop will go forever. You need to set sTest to something other than '' in the loop, or perhaps you meant to use an if statement.
You have a couple of issues:
You never assign anything else to sTest after you initialize it (before the loop)
You're continually looping over the same record, because there's no Next, and no change to sTest. Once you start the loop, you stay there.
You're going past the end of the Columns, because you're going to Column.Count, and the last valid index is Column.Count - 1
Try this instead, to see if it's more what you're after:
iRy := 0;
sCol := DBGrid.Columns.Count - 1;
// I'm not sure why you're not putting this in the first (0 index) element
// of arrData - is that intentional?
sTest := DBGrid.Columns[0].Field.AsString;
while (sTest <> '') and (not DBGrid.DataSource.DataSet.Eof) do
begin
for k := 1 to iCol do
arrData[iRy, iCol] := DBGrid.Columns[iCol].Field.AsString;
DBGrid.DataSource.DataSet.Next;
Inc(iRy);
sTest := DBGrid.Columns[0].Field.AsString;
end;
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);
I'm using the code from: http://www.swissdelphicenter.ch/torry/showcode.php?id=1103
to sort my TListView, which works GREAT on everything but numbers with decimals.
So I tried to do this myself, and I created a new Custom Sort called: cssFloat
Created a new function
function CompareFloat(AInt1, AInt2: extended): Integer;
begin
if AInt1 > AInt2 then Result := 1
else
if AInt1 = AInt2 then Result := 0
else
Result := -1;
end;
Added of the case statement telling it what type the column is..
cssFloat : begin
Result := CompareFloat(i2, i1);
end;
And I changed the Column click event to have the right type selected for the column.
case column.Index of
0: LvSortStyle := cssNumeric;
1: LvSortStyle := cssFloat;
2: LvSortStyle := cssAlphaNum;
else LvSortStyle := cssNumeric;
And The ListView Sort type is currently set to stBoth.
It doesn't sort correctly. And Ideas on how to fix this?
Thank you
-Brad
I fixed it... after 3 hours of struggling with this.. not understanding why.. I finally saw the light.. CompareFloat was asking if two integers were greater or less than each other.
cssFloat : begin
r1 := IsValidFloat(s1, e1);
r2 := IsValidFloat(s2, e2);
Result := ord(r1 or r2);
if Result <> 0 then
Result := CompareFloat(e2, e1);
end;
(Copied and modified from EFG's Delphi site)
FUNCTION isValidFloat(CONST s: STRING; var e:extended): BOOLEAN;
BEGIN
RESULT := TRUE;
TRY
e:= StrToFloat(s)
EXCEPT
ON EConvertError DO begin e:=0; RESULT := FALSE; end;
END
END {isValidFloat};
While I don't know what is the problem which you faced perhaps is useful for you...
function CompareFloat(AStr1, AStr2: string): Integer;
const
_MAGIC = -1; //or ANY number IMPOSSIBLE to reach
var
nInt1, nInt2: extended;
begin
nInt1:=StrToFloatDef(AStr1, _MAGIC);
nInt2:=StrToFloatDef(AStr2, _MAGIC);
if nInt1 > nInt2 then Result := 1
else
if nInt1 = nInt2 then Result := 0
else
Result := -1;
end;
..and another snippet (perhaps much better):
function CompareFloat(aInt1, aInt2: extended): integer;
begin
Result:=CompareValue(aInt1, aInt2); // :-) (see the Math unit) - also you can add a tolerance here (see the 'Epsilon' parameter)
end;
Besides the rounding which can cause you problems you can see what the format settings are in conversion between string and numbers (you know, the Decimal Point, Thousands Separator aso.) - see TFormatSettings structure in StringToFloat functions. (There are two - overloaded).
HTH,