The following code compiles with Win32 but produces Delphi compiler error E2064 left side cannot be assigned to when compiled with Win64.
type
PRGB24 = ^TRGB24;
TRGB24 = record
B, G, R: Byte;
end;
PRGBArray = ^TRGBArray;
TRGBArray = array [Word] of TRGB24;
procedure TFormCurves.ApplyCurve(Src: TIEBitmap);
var
iRGBArray: PRGBArray;
SFill, X, Y: Integer;
begin
if not AImageLoaded then
Exit;
iRGBArray := PRGBArray(Src.Scanline[0]);
SFill := Integer(Src.Scanline[1]) - Integer(iRGBArray);
for Y := 0 to Src.Height - 1 do
begin
for X := 0 to Src.Width - 1 do
begin
iRGBArray[X].R := ALUT[0, ALUT[1, iRGBArray[X].R]];
iRGBArray[X].G := ALUT[0, ALUT[2, iRGBArray[X].G]];
iRGBArray[X].B := ALUT[0, ALUT[3, iRGBArray[X].B]];
end;
Inc(Integer(iRGBArray), SFill);//compiler error E2064 left side cannot be assigned to
end;
end;
procedure TFormCurves.GetHist;
var
iRGBArray: PRGBArray;
X, Y, SFill: Integer;
iIEBitmap: TIEBitmap;
iRGB: TRGB24;
R, G, B, l: Byte;
begin
if not AImageLoaded then
Exit;
for Y := 0 to 3 do
begin
AMaxHistory[Y] := 0;
for X := 0 to 255 do
AHistory[Y, X] := 0;
end;
iIEBitmap := imgView.IEBitmap;
iRGBArray := PRGBArray(iIEBitmap.Scanline[0]);
SFill := Integer(iIEBitmap.Scanline[1]) - Integer(iRGBArray);
for Y := 0 to iIEBitmap.Height - 1 do
begin
for X := 0 to iIEBitmap.Width - 1 do
begin
iRGB := iRGBArray[X];
R := iRGB.R;
G := iRGB.G;
B := iRGB.B;
l := (R + G + B) div 3;
AHistory[0, l] := AHistory[0, l] + 1;
AHistory[1, R] := AHistory[1, R] + 1;
AHistory[2, G] := AHistory[2, G] + 1;
AHistory[3, B] := AHistory[3, B] + 1;
end;
Inc(Integer(iRGBArray), SFill); //compiler error E2064 left side cannot be assigned to
end;
for Y := 0 to 3 do
for X := 0 to 255 do
if AHistory[Y, X] > AMaxHistory[Y] then
AMaxHistory[Y] := AHistory[Y, X];
end;
How can I eliminate the compiler error with Win64?
On Win64 a pointer is 64 bits wide and an Integer is 32 bits wide. Such a cast requires both sides of the assignment expression to be the same size. Hence the error.
Instead of casting to Integer cast to PByte.
Inc(PByte(iRGBArray), SFill);
All your other Integer casts are wrong. You have to grasp the different size of these types. You might cast to NativeInt to resolve them.
Related
Using: Delphi 10.2 Tokyo
Please link me to an algorithm or code to get all possible combinations of values from multiple sets, with one value per set. The number of sets is not known in advance, nor the number of values in each set.
Example:
1. (1, 2, 3) (A, B)
Desired result:
1 A
1 B
2 A
2 B
3 A
3 B
2. (1, 2, 3, 4) (A, B) (X, Y, Z)
Desired result:
1 A X
1 A Y
1 A Z
2 A X
2 A Y
2 A Z
3 A X
3 A Y
3 A Z
4 A X
4 A Y
4 A Z
1 B X
1 B Y
1 B Z
2 B X
2 B Y
2 B Z
3 B X
3 B Y
3 B Z
4 B X
4 B Y
4 B Z
Thanks in advance!
Recursive and iterative generation (with storage and without storage) of cartesian product of 2d array A elements
var
A: array of array of Integer;
B: array of array of Integer;
i, j: Integer;
s: string;
NN: Integer;
procedure CartesianRec(From: Integer; cs: string);
var
j: integer;
begin
if From = Length(A) then
Memo1.Lines.Add(cs)
else
for j := 0 to High(A[From]) do
CartesianRec(From + 1, cs + IntToStr(A[From, j]) + ' ');
end;
procedure CartesianIter;
var
i, j, k, l, c, N, M: Integer;
begin
NN := 1;
for k := 0 to High(A) do
NN := NN * Length(A[k]);
SetLength(B, NN, Length(A));
N := NN;
M := 1;
for k := 0 to High(A) do begin
N := N div Length(A[k]);
c := 0;
for l := 0 to M - 1 do
for i := 0 to High(A[k]) do
for j := 0 to N - 1 do begin
B[c, k] := A[k, i];
Inc(c);
end;
M := M * Length(A[k]);
end;
end;
procedure CartesianOnline;
var
i, j, k, l, c, N, M, dimA: Integer;
s: string;
begin
NN := 1;
dimA := Length(A);
//SetLength(CartProduct, dimA);
for k := 0 to dimA - 1 do
NN := NN * Length(A[k]);
for i := 0 to NN - 1 do begin
j := i;
s := '';
for k := dimA - 1 downto 0 do begin
l := j mod Length(A[k]);
s := IntToStr(A[k][l]) + ' ' + s;
//we can also put CartProduct[k] := A[k][l];
j := j div Length(A[k]);
end;
Memo1.Lines.Add(s);
//or use CartProduct
end;
end;
begin
nn := 1;
SetLength(A, 3);
for i := 0 to High(A) do begin
SetLength(A[i], 5 - i);
s := '';
for j := 0 to High(A[i]) do begin
A[i, j] := nn;
Inc(nn);
s := s + IntToStr(A[i, j]) + ' ';
end;
Memo1.Lines.Add(s);
end;
Memo1.Lines.Add('------');
CartesianRec(0, '');
Memo1.Lines.Add('------');
CartesianIter;
for i := 0 to NN - 1 do begin
s := '';
for j := 0 to High(A) do
s := s + IntToStr(B[i, j]) + ' ';
Memo1.Lines.Add(s);
end;
Memo1.Lines.Add('------');
CartesianOnline;
A:
1 2 3 4 5
6 7 8 9
10 11 12
Result:
1 6 10
1 6 11
1 6 12
1 7 10
1 7 11
1 7 12
1 8 10
1 8 11
1 8 12
1 9 10
1 9 11
1 9 12
2 6 10
2 6 11
...
5 8 12
5 9 10
5 9 11
5 9 12
I used TLists and Integer arrays and managed to solve the problem. Here is my code:
uses Classes, SysUtils, Generics.Collections;
type
TIntArray = array of integer;
TIntArrayList = TList<TIntArray>;
TCartesianProduct = class
private
FSetList: TIntArrayList;
public
constructor Create;
destructor Destroy; override;
procedure AddSet(ASet: TIntArray);
procedure GetCombinations(var AIntArrayList: TIntArrayList);
end;
implementation
{ TCartesianProduct }
constructor TCartesianProduct.Create;
begin
FSetList := TIntArrayList.Create;
end;
destructor TCartesianProduct.Destroy;
begin
FSetList.Free;
end;
procedure TCartesianProduct.AddSet(ASet: TIntArray);
begin
FSetList.Add(ASet);
end;
procedure TCartesianProduct.GetCombinations(var AIntArrayList: TIntArrayList);
var
WorkList, OuputList: TIntArrayList;
r: TIntArray;
n, c, l: integer;
f: Boolean;
begin
WorkList := TIntArrayList.Create; // Length of each set array, and current iteration index
OuputList := TIntArrayList.Create;
try
n := FSetList.Count;
for c := 0 to n - 1 do
WorkList.Add([Length(FSetList[c]), 0]);
while ((WorkList[0][1] < WorkList[0][0])) do
begin
SetLength(r, n); // result array length is the number of sets
for c := 0 to FSetList.Count - 1 do
begin
r[c] := FSetList[c][WorkList[c][1]];
end;
Inc(WorkList[n - 1][1]); // last work list item (set)
if (WorkList[n - 1][1] = WorkList[n - 1][0]) and (n - 1 <> 0) then // if it equal the length of the set
begin
WorkList[n - 1][1] := 0; // then reset it back to zero
l := n - 1; // make pointer point to previous item up
f := false;
repeat
Dec(l);
if (l >= 0) then
begin
Inc(WorkList[l][1]); // increase index in previous item
if (l <> 0) and (WorkList[l][1] = WorkList[l][0]) then
begin
WorkList[l][1] := 0; // If that items pointer points to the last item, reset it to zero
end
else
f := true;
end
else
f := true;
until f;
end;
OuputList.Add(r);
end;
AIntArrayList.Clear;
for c := 0 to OuputList.Count - 1 do
AIntArrayList.Add(OuputList[c]);
finally
OuputList.Free;
WorkList.Free;
end;
end;
Test it with this code:
procedure TfmMain.btTestClick(Sender: TObject);
var
intset1, intset2, intset3: TIntArray;
outsetlist: TIntArrayList;
CP: TCartesianProduct;
c, d: Integer;
l: string;
begin
SetLength(intset2, 4);
SetLength(intset3, 4);
intset2[0] := 105;
intset2[1] := 106;
intset2[2] := 107;
intset2[3] := 108;
intset3[0] := 109;
intset3[1] := 110;
intset3[2] := 111;
intset3[3] := 112;
outsetlist := TIntArrayList.Create;
CP := TCartesianProduct.Create;
try
CP.AddSet(intset2);
CP.AddSet(intset3);
CP.GetCombinations(outsetlist);
ListBox1.Clear;
for c := 0 to outsetlist.Count - 1 do
begin
l := '';
for d := 0 to high(outsetlist[c]) do
l := l + Format('%d ', [outsetlist[c][d]]);
ListBox1.Items.Add(l);
end;
finally
CP.Free;
outsetlist.Free;
end;
end;
I was trying to implement the following recursive formula to my code
but to my surprise it turns out that after implementing this to DELPHI, I get an error due to division by zero. I am 98% sure that my knot vector is correctly calculated, which in a way means there shouldn't be any divisions by zero. I am 70% sure that the recursive formula is correctly implemented, for that reason I am posting my code here:
program project1;
uses
SysUtils;
Type
TRealPoint = record
x: single;
y: single;
end;
type
TSample = Class(TObject)
public
KnotVector: array of single;
FitPoints: array of TRealPoint;
Degree: integer;
constructor Create; overload;
function Coefficient(i, p: integer; Knot: single): single;
procedure GetKnots;
destructor Destroy; overload;
end;
constructor TSample.Create;
begin
inherited;
end;
function TSample.Coefficient(i, p: integer; Knot: single): single;
var
s1, s2: single;
begin
If (p = 0) then
begin
If (KnotVector[i] <= Knot) And (Knot < KnotVector[i+1]) then Result := 1.0
else Result := 0.0;
end
else
begin
s1 := (Knot - KnotVector[i])*Coefficient(i, p-1, Knot)/(KnotVector[i+p] - KnotVector[i]); //THIS LINE ERRORS due to division by zero ???
s2 := (KnotVector[i+p+1]-Knot)*Coefficient(i+1,p-1,Knot)/(KnotVector[i+p+1]-KnotVector[i+1]);
Result := s1 + s2;
end;
end;
procedure TSample.GetKnots();
var
KnotValue: single;
i, MaxKnot: integer;
begin
// KNOTS
KnotValue:= 0.0;
SetLength(KnotVector, Length(FitPoints) + 1 + Degree);
MaxKnot:= Length(KnotVector) - (2*Degree + 1);
for i := Low(KnotVector) to High(KnotVector) do
begin
if i <= (Degree) then KnotVector[i] := KnotValue / MaxKnot
else if i > Length(FitPoints) then KnotVector[i] := KnotValue / MaxKnot
else
begin
KnotValue := KnotValue + 1.0;
KnotVector[i] := KnotValue / MaxKnot;
end;
end;
end;
destructor TSample.Destroy;
begin
inherited;
end;
var
i, j: integer;
Test: TSample;
N: array of array of single;
begin
Test := TSample.Create;
//define degree
Test.Degree := 3;
//random fit points
j := 15;
SetLength(Test.FitPoints, j + 1 + Test.Degree);
For i := Low(Test.FitPoints) to High(Test.FitPoints) do
begin
Test.FitPoints[i].x := Random()*2000;
Test.FitPoints[i].y := Random()*2000;
end;
//get knot vector
Test.GetKnots;
//get coefficients
SetLength(N, j+1, j+1);
For j := Low(N) to High(N) do
begin
For i := Low(N[j]) to High(N[j]) do
begin
N[j, i] := Test.Coefficient(i,3,Test.KnotVector[j]);
write(floattostrf(N[j,i], ffFixed, 2, 2) + ', ');
end;
writeln();
end;
readln();
Test.Free;
end.
Basically I'm not sure how to continue. I would need the values of matrix N (see this link) of basis coefficients but somehow using the formula from this link leads me to division by zero.
So... Is there a totally different way how to calculate those coefficients or what is the problem here?
UPDATE
Instead of using my own idea i tried to implement the algorithm from here as suggested by Dsm in the comments. As a result, there is no more divison by zero, but the result is totally unexpected anyways.
For n + 1 = 10 random fit points with spline degree 3 the basis matrix N (see link) is singular - as seen from the attached image.
Instead of that I would expect the matrix to be band matrix. Anyway, here is my updated code:
program project1;
uses
SysUtils;
Type
TRealPoint = record
x: single;
y: single;
end;
type
TMatrix = array of array of double;
type
TSample = Class(TObject)
public
KnotVector: array of double;
FitPoints: array of TRealPoint;
SplineDegree: integer;
Temp: array of double;
A: TMatrix;
procedure GetKnots;
function GetBasis(Parameter: double): boolean;
procedure FormBasisMatrix;
end;
procedure TSample.GetKnots();
var
i, j: integer;
begin
// KNOTS
//https://pages.mtu.edu/~shene/COURSES/cs3621/NOTES/INT-APP/PARA-knot-generation.html
SetLength(KnotVector, Length(FitPoints) + SplineDegree + 1);
for i := Low(KnotVector) to High(KnotVector) do
begin
if i <= SplineDegree then KnotVector[i] := 0
else if i <= (High(KnotVector) - SplineDegree - 1) then KnotVector[i] := (i - SplineDegree) / (Length(FitPoints) - SplineDegree)
else KnotVector[i] := 1;
end;
end;
function TSample.GetBasis(Parameter: double): boolean;
var
m, d, k: integer;
FirstTerm, SecondTerm: double;
begin
//http://pages.mtu.edu/~shene/COURSES/cs3621/NOTES/spline/B-spline/bspline-curve-coef.html
Result := False;
//initialize to 0
SetLength(Temp, Length(FitPoints));
For m := Low(Temp) to High(Temp) do Temp[m] := 0.0;
//special cases
If Abs(Parameter - KnotVector[0]) < 1e-8 then
begin
Temp[0] := 1;
end
else if Abs(Parameter - KnotVector[High(KnotVector)]) < 1e-8 then
begin
Temp[High(Temp)] := 1;
end
else
begin
//find knot span [u_k, u_{k+1})
for k := Low(KnotVector) to High(KnotVector) do if Abs(KnotVector[k] - Parameter) < 1e-8 then break;
Temp[k] := 1.0;
for d := 1 to SplineDegree do
begin
Temp[k - d] := (KnotVector[k + 1] - Parameter) * Temp[k - d + 1] / (KnotVector[k + 1] - KnotVector[k - d + 1]);
for m := k - d + 1 to k - 1 do
begin
FirstTerm := (Parameter - KnotVector[m]) / (KnotVector[m + d] - KnotVector[m]);
SecondTerm := (KnotVector[m + d + 1] - Parameter) / (KnotVector[m + d + 1] - KnotVector[m + 1]);
Temp[m] := FirstTerm * Temp[m] + SecondTerm * Temp[m + 1];
end;
Temp[k] := (Parameter - KnotVector[k]) * Temp[k] / (KnotVector[k + d] - KnotVector[k]);
end;
end;
Result := True;
end;
procedure TSample.FormBasisMatrix;
var
i, j: integer;
begin
SetLength(A, Length(FitPoints), Length(FitPoints));
for j := Low(A) to High(A) do
begin
for i := low(A[j]) to High(A[j]) do //j - row, i - column
begin
If GetBasis(KnotVector[j + SplineDegree]) then A[j, i] := Temp[i];
end;
end;
end;
var
i, j, iFitPoints: integer;
Test: TSample;
N: array of array of single;
begin
Test := TSample.Create;
//define degree
Test.SplineDegree := 3;
//random fit points
iFitPoints := 10;
SetLength(Test.FitPoints, iFitPoints);
For i := Low(Test.FitPoints) to High(Test.FitPoints) do
begin
Test.FitPoints[i].x := Random()*200;
Test.FitPoints[i].y := Random()*200;
end;
//get knot vector
Test.GetKnots;
//get B-Spline basis matrix
Test.FormBasisMatrix;
// print matrix
for j := Low(Test.A) to High(Test.A) do
begin
for i := Low(Test.A) to High(Test.A) do write(FloatToStrF(Test.A[j, i], ffFixed, 2, 2) + ', ');
writeln();
end;
readln();
Test.Free;
end.
This does not appear to be the complete answer, but it may help you on your way, and the result is closer to what you expect, but as I say, not completely there.
First of all the knots do not look right to me. The knots appear to form a 'ramp' function (clamped line), and though I can't work out if 'm' has any specific value, I would expect the function to be continuous, which yours is not. Making it continuous gives better results, e.g.
procedure TSample.GetKnots();
var
i, j: integer;
iL : integer;
begin
// KNOTS
//https://pages.mtu.edu/~shene/COURSES/cs3621/NOTES/INT-APP/PARA-knot-generation.html
iL := Length( FitPoints );
SetLength(KnotVector, iL + SplineDegree + 1);
// set outer knot values and sum used to geterate first internal value
for i := 0 to SplineDegree - 1 do
begin
KnotVector[ i ] := 0;
KnotVector[ High(KnotVector)-i] := 1;
end;
// and internal ones
for i := 0 to High(KnotVector) - 2* SplineDegree + 1 do
begin
KnotVector[ SplineDegree + i - 1] := i / (iL - 1);
end;
end;
I introduced iL = Length( Fitpoints ) for convenience - it is not important.
The second issue I spotted is more of a programming one. In the GetBasis routine, you evaluate k by breaking a for loop. The problem with that is that k is not guaranteed to persist outside the loop, so your use of it later is not guaranteed to succeed (although it may)
Finally, in the same place, your range determination is completely wrong in my opinion. You should be looking for parameter to lie in a half open line segment, but instead you are looking for it to lie close to an endpoint of that line.
Putting these two together
for k := Low(KnotVector) to High(KnotVector) do if Abs(KnotVector[k] - Parameter) < 1e-8 then break;
should be replaced by
k1 := 0;
for k1 := High(KnotVector) downto Low(KnotVector) do
begin
if Parameter >= KnotVector[k1] then
begin
k := k1;
break;
end;
end;
where k1 is an integer.
I can't help feeling that there is a plus 1 error somewhere, but I can't spot it.
Anyway, I hope that this helps you get a bit further.
To build recursive pyramid for coefficient calculation at intervals, you have to start top level of recursion (inner loop of calculations) from the first real (not duplicate) knot index:
For i := Test.Degree...
Also check the last loop index.
P.S. You can remove constructor and destructor from class description and implementation if they have nothing but inherited.
source array(4 bytes)
[$80,$80,$80,$80] =integer 0
[$80,$80,$80,$81] = 1
[$80,$80,$80,$FF] = 127
[$80,$80,$81,$01] = 128
need to convert this to integer.
below is my code and its working at the moment.
function convert(b: array of Byte): Integer;
var
i, st, p: Integer;
Negative: Boolean;
begin
result := 0;
st := -1;
for i := 0 to High(b) do
begin
if b[i] = $80 then Continue // skip leading 80
else
begin
st := i;
Negative := b[i] < $80;
b[i] := abs(b[i] - $80);
Break;
end;
end;
if st = -1 then exit;
for i := st to High(b) do
begin
p := round(Power(254, High(b) - i));
result := result + b[i] * p;
result := result - (p div 2);
end;
if Negative then result := -1 * result
end;
i'm looking for a better function?
Update:
file link
https://drive.google.com/file/d/0ByBA4QF-YOggZUdzcXpmOS1aam8/view?usp=sharing
in uploaded file ID field offset is from 5 to 9
NEW:
Now i got into new problem which is decoding date field
Date field hex [$80,$8F,$21,$C1] -> possible date 1995-12-15
* in uploaded file date field offset is from 199 to 203
Just an example of some improvements as outlined by David.
The array is passed by reference as a const.
The array is fixed in size.
The use of floating point calculations are converted directly into a constant array.
Const
MaxRange = 3;
Type
TMySpecial = array[0..MaxRange] of Byte;
function Convert(const b: TMySpecial): Integer;
var
i, j: Integer;
Negative: Boolean;
Const
// Pwr[i] = Round(Power(254,MaxRange-i));
Pwr: array[0..MaxRange] of Cardinal = (16387064,64516,254,1);
begin
for i := 0 to MaxRange do begin
if (b[i] <> $80) then begin
Negative := b[i] < $80;
Result := Abs(b[i] - $80)*Pwr[i] - (Pwr[i] shr 1);
for j := i+1 to MaxRange do
Result := Result + b[j]*Pwr[j] - (Pwr[j] shr 1);
if Negative then
Result := -Result;
Exit;
end;
end;
Result := 0;
end;
Note that less code lines is not always a sign of good performance.
Always measure performance before optimizing the code in order to find real bottlenecks.
Often code readability is better than optimizing over the top.
And for future references, please tell us what the algorithm is supposed to do.
Code for testing:
const
X : array[0..3] of TMySpecial =
(($80,$80,$80,$80), // =integer 0
($80,$80,$80,$81), // = 1
($80,$80,$80,$FF), // = 127
($80,$80,$81,$01)); // = 128
var
i,j: Integer;
sw: TStopWatch;
begin
sw := TStopWatch.StartNew;
for i := 1 to 100000000 do
for j := 0 to 3 do
Convert(X[j]);
WriteLn(sw.ElapsedMilliseconds);
ReadLn;
end.
I'm build an application that reducing the pixels width.
When I'm pressing the button of that application two or three times, Message will appear and say stack overflow.
Here's the Message :
Error Line on my application
Here's my code :
procedure TForm1.cariThin();
var
baris_gbr, kolom_gbr, x, y, a, b, i, j, p1, p2, n : integer;
imgval : array [0..500,0..500] of integer;
mark : array [0..500,0..500] of integer;
nb : array [1..9] of integer;
hasdelete: boolean;
R, G, BL, AB : integer;
begin
Image3.Width := Image1.Width;
Image3.Height := Image1.Height;
baris_gbr := Image1.Picture.Height;
kolom_gbr := Image1.Picture.Width;
For kolom_gbr:= 0 To image1.Width - 1 Do
Begin
For baris_gbr:= 0 To image1.Height - 1 Do
Begin
R:= GetRValue(image1.Canvas.Pixels[kolom_gbr, baris_gbr]);
G:= GetGValue(image1.Canvas.Pixels[kolom_gbr, baris_gbr]);
BL:= GetBValue(image1.Canvas.Pixels[kolom_gbr, baris_gbr]);
AB:= (R + G + BL) Div 3;
if (AB > 200) then
begin
Image1.Canvas.Pixels[kolom_gbr, baris_gbr] := rgb(255,255,255);
end
else
begin
Image1.Canvas.Pixels[kolom_gbr, baris_gbr] := rgb(0,0,0);
end;
End;
End;
for y := 0 to baris_gbr-1 do
begin
for x := 0 to kolom_gbr-1 do
begin
if (Image1.canvas.pixels[x,y] = clBlack) then
begin
imgval[x,y] := 1;
end
else
begin
imgval[x,y] := 0;
end;
end;
end;
hasdelete := True;
while (hasdelete) do
begin
hasdelete := False;
for y := 0 to baris_gbr-1 do
begin
for x := 0 to kolom_gbr-1 do
begin
if (imgval[x,y] = 1) then
begin
for n:=1 to 8 do
begin
nb[n] := 0;
nb[1] := imgval[x,y];
nb[2] := imgval[x,y-1];
nb[3] := imgval[x+1,y-1];
nb[4] := imgval[x+1,y];
nb[5] := imgval[x+1,y+1];
nb[6] := imgval[x,y+1];
nb[7] := imgval[x-1,y+1];
nb[8] := imgval[x-1,y];
nb[9] := imgval[x-1,y-1];
a := 0;
end;
for i:= 2 to 8 do
begin
if ((nb[i] = 0) AND (nb[i+1] = 1)) then
begin
inc(a);
end;
end;
if ((nb[9] = 0) AND (nb[2] = 1)) then
begin
inc(a);
end;
b := nb[2] + nb[3] + nb[4] + nb[5] + nb[6] + nb[7] + nb[8] + nb[9];
p1 := nb[2] * nb[4] * nb[6];
p2 := nb[4] * nb[6] * nb[8];
if ((a = 1) AND ((b>=2) AND (b <= 6)) AND (p1 = 0) AND (p2 = 0)) then
begin
mark[x,y] := 0;
hasdelete := true;
end
else
begin
mark[x,y] := 1;
end
end
else
begin
mark[x,y] := 0;
end;
end;
end;
for y:=0 to baris_gbr-1 do
begin
for x:=0 to kolom_gbr-1 do
begin
imgval[x,y] := mark[x,y];
end;
end;
end;
end;
Why my application keep says overflow? is there any solution to fix it? or can we can exception handler? thanks
EDIT
Now my pplication says access violation.
It raised error in this line : nb[7] := imgval[x-1,y+1];
why it exactly happened?
var
imgval : array [0..500,0..500] of integer;
mark : array [0..500,0..500] of integer;
These variables are located on the stack and are huge. They have size 501*501*4 = 1,004,004. The default stack size is 1MB. These large arrays are the reason for your stack overflow.
You will need to use dynamically allocated arrays instead. Or avoid the need to store 2D arrays that contain information for each pixel and instead process the image in smaller sub-blocks. I've no idea whether or not that is possible because I've no idea what the code is trying to do. That's for you to work out.
Of course, one advantage of using dynamically allocated arrays is that you don't need to run the gauntlet of a buffer overrun, as you currently do. If either dimension of the image exceeds 501 then you have overrun the buffer. I do hope that you have enabled range checking in the compiler options.
for y := 0 to baris_gbr-1 do
and
for x := 0 to kolom_gbr-1 do
cannot be correct. The baris_gbr and kolom_gbr variables are not initialised since they were most recently used as loop variables. So, as well as turning on range checking, you'll want to turn on hints and warnings, and then heed them.
I slept over the answer to question Quicksort drama and wanted to recode it from scratch, implementing your tip with the call-by-reference var. And again: I cannot find any failure I made again. I compare the code to your program one by one and I cannot find the problem. The following code produces an Exception (External:SIGSEV at address 11602) during compilation/run
program quicksort;
var
iArray : array[0..8] of integer;
procedure fillArray(var iArray : array of integer);
begin;
iArray[0] := 3;
iArray[1] := 1;
iArray[2] := 8;
iArray[3] := 4;
iArray[4] := 9;
iArray[5] := 0;
iArray[6] := 8;
iArray[7] := 2;
iArray[8] := 5;
end;
procedure writeArray(iArray : array of integer);
var i:integer;
begin
for i:=low(iArray) to high(iArray) do begin
write(iArray[i]);
end;
writeln('');
end;
procedure quickSort(var iArray : array of integer; links : integer; rechts:integer);
var
l,r,pivot, temp: integer;
begin
if (rechts > links) then begin
l := links;
r := rechts;
pivot := iArray[(rechts+links) div 2];
while (l<r) do begin
while (iArray[l] < pivot) do l:=l+1;
while (iArray[r] > pivot) do r:=r-1;
if (l<=r) then begin
temp := iArray[l];
iArray[l] := iArray[r];
iArray[r] := temp;
end;
end;
if (links < r) then quickSort(iArray, links, r);
if (l < rechts) then quickSort(iArray, l, rechts);
end;
end;
begin
fillArray(iArray);
quickSort(iArray,low(iArray),high(iArray));
writeArray(iArray);
end.
The block of code that swaps, also needs to increment l and decrement r once the swap is complete:
if (l <= r) then
begin
temp := iArray[l];
iArray[l] := iArray[r];
iArray[r] := temp;
inc(l); // <-- this was missing
dec(r); // <-- as was this
end;
The complete program, with some other minor tidy ups:
program quicksort24340509;
var
iArray: array [0 .. 8] of integer;
Procedure fillArray(var iArray: array of integer);
begin;
iArray[0] := 3;
iArray[1] := 1;
iArray[2] := 8;
iArray[3] := 4;
iArray[4] := 9;
iArray[5] := 0;
iArray[6] := 8;
iArray[7] := 2;
iArray[8] := 5;
end;
Procedure writeArray(const iArray: array of integer);
var
i: integer;
begin
for i := low(iArray) to high(iArray) do
begin
write(iArray[i], ' ');
end;
writeln;
end;
Procedure quickSort(var iArray: array of integer; links, rechts: integer);
var
l, r, pivot, temp: integer;
begin
if (rechts > links) then
begin
l := links;
r := rechts;
pivot := iArray[(rechts + links) div 2];
while l < r do
begin
while iArray[l] < pivot do inc(l);
while iArray[r] > pivot do dec(r);
if l <= r then
begin
temp := iArray[l];
iArray[l] := iArray[r];
iArray[r] := temp;
inc(l);
dec(r);
end;
end;
if links < r then
quickSort(iArray, links, r);
if l < rechts then
quickSort(iArray, l, rechts);
end;
end;
begin
fillArray(iArray);
quickSort(iArray, low(iArray), high(iArray));
writeArray(iArray);
readln;
end.
Output
0 1 2 3 4 5 8 8 9
The reason that your version fails, without the missing lines, is that the recursive calls to quickSort operate on the wrong ranges.
For example, Given your input of
3 1 8 4 9 0 8 2 5
the partitioning step pivots on 9 and results in
3 1 8 4 5 0 8 2 9
Now, the recursive step should be to sort all the values to the left of the pivot, and all the values to the right. And we leave the pivot alone because partitioning ensured that it is in its final position.
There are no values to the right of the pivot so we should be making a recursive call for the range 0 to 7. But if you inspect what happens with your code you will find that it does not. Instead it makes a recursive call for the range 0 to 8. That in itself is a little benign, but once the ranges become small, at the stopping condition, it's different. Try asking your program to sort these values:
1 2
The code pivots on 1. At the end of partitioning we have:
links = 0
rechts = 1
l = 0
r = 0
So we recursively call quickSort passing l and rechts as the ranges. But that's exactly the same call as we initially made. And that therefore leads to a stack overflow.
So the point is that we must make sure that when we partition on a pivot, we exclude that pivot from all future recursive calls to quickSort. If we don't do that we don't sub-divide the problem, and the recursion does not terminate.