Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- {$loadlib pumbaa.dll}
- procedure pp_TPAControlSegment(var TPA: TPointArray; kind: TControlKind; segment: TPointArray; accuracy: Extended);
- var
- w, h, k, l, i, j, x, y, v, c, t, n: Integer;
- o: TPoint;
- b, s: TBox;
- m, q: T2DBoolArray;
- f, p: TPointArray;
- z: TBoxArray;
- a: Extended;
- begin
- t := 0;
- k := High(TPA);
- l := High(segment);
- if ((k > -1) and (l > -1) and (accuracy > 0) and not (accuracy > 1)) then
- begin
- s := pp_TPABounds(segment);
- b := pp_TPABounds(TPA);
- w := (b.X2 - b.X1);
- h := (b.Y2 - b.Y1);
- z := pp_BoxPositions(s, b);
- v := High(z);
- if (v > -1) then
- begin
- n := Ceil(pp_Percentage((accuracy * 100), (l + 1)));
- WriteLn('N: ' + IntToStr(n));
- p := pp_Clone(segment);
- o := pp_GetOffset(Point(s.X1, s.Y1), Point(0, 0));
- pp_TPAOffset(p, o);
- o := pp_GetOffset(Point(z[0].X1, z[0].Y1), Point(0, 0));
- pp_TBAOffset(z, o);
- m := pp_Create(False, ((b.X2 - b.X1) + 1), ((b.Y2 - b.Y1) + 1));
- for i := 0 to k do
- m[(TPA[i].X - b.X1)][(TPA[i].Y - b.Y1)] := True;
- SetLength(f, (l + 1));
- q := pp_Create(False, ((b.X2 - b.X1) + 1), ((b.Y2 - b.Y1) + 1));
- for i := 0 to v do
- begin
- c := 0;
- for j := 0 to l do
- begin
- x := (p[j].X + z[i].X1);
- y := (p[j].Y + z[i].Y1);
- if m[x][y] then
- begin
- f[c].X := x;
- f[c].Y := y;
- c := (c + 1);
- end;
- end;
- if not (c < n) then
- begin
- c := (c - 1);
- for j := 0 to c do
- q[f[j].X][f[j].Y] := True;
- end;
- end;
- case kind of
- ckExtract:
- for i := 0 to k do
- if q[(TPA[i].X - b.X1)][(TPA[i].Y - b.Y1)] then
- begin
- TPA[t] := TPA[i];
- t := (t + 1);
- end;
- ckFilter:
- for i := 0 to k do
- if not q[(TPA[i].X - b.X1)][(TPA[i].Y - b.Y1)] then
- begin
- TPA[t] := TPA[i];
- t := (t + 1);
- end;
- end;
- end;
- end;
- SetLength(TPA, t);
- end;
- procedure DebugBitmap(bmp: Integer);
- var
- w, h: Integer;
- begin
- GetBitmapSize(bmp, w, h);
- DisplayDebugImgWindow(w, h);
- DrawBitmapDebugImg(bmp);
- end;
- var
- segment, TPA: TPointArray;
- b: TBox;
- o: TPoint;
- bmp, w, h: Integer;
- begin
- segment := [Point(5, 2), Point(5, 2), Point(1, 6), Point(4, 3), Point(4, 1)];
- TPA := pp_TPAFromBox(IntToBox(10, 10, 20, 20));
- b := pp_TPABounds(TPA);
- pp_TPADimensions(TPA, w, h);
- pp_TPAControlSegment(TPA, ckExtract, segment, 0.9);
- bmp := CreateBitmap((w + (b.X1 * 2)), (h + (b.Y1 * 2)));
- DrawTPABitmap(bmp, TPA, 255);
- DrawTPABitmap(bmp, segment, 16777215);
- DebugBitmap(bmp);
- FreeBitmap(bmp);
- end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement