diff --git a/Projects/OCRBench/project1.lpi b/Projects/OCRBench/project1.lpi
index 4830942..db6b124 100644
--- a/Projects/OCRBench/project1.lpi
+++ b/Projects/OCRBench/project1.lpi
@@ -31,12 +31,12 @@
-
+
-
+
@@ -44,10 +44,10 @@
-
-
+
+
-
+
@@ -58,7 +58,7 @@
-
+
@@ -68,189 +68,219 @@
-
+
-
-
+
+
-
+
-
-
-
-
+
+
+
+
-
-
-
-
+
+
+
+
-
-
+
+
-
+
-
+
-
-
-
-
+
+
+
+
-
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
+
-
-
+
+
-
+
-
-
+
+
-
+
-
-
+
+
-
+
-
+
-
+
-
+
-
-
+
+
-
+
-
-
+
+
@@ -264,7 +294,15 @@
+
+
+
+
+
+
+
+
@@ -273,7 +311,8 @@
+-dOCRTPA
+-dOCRSAVEBITMAP"/>
diff --git a/Projects/OCRBench/unit1.lfm b/Projects/OCRBench/unit1.lfm
index 6d96f63..7e8ccfe 100644
--- a/Projects/OCRBench/unit1.lfm
+++ b/Projects/OCRBench/unit1.lfm
@@ -48,26 +48,8 @@ object Form1: TForm1
Top = 112
Width = 79
Caption = 'Shadow?'
- OnChange = FShadowChange
TabOrder = 3
end
- object SplitEdit: TEdit
- Left = 512
- Height = 27
- Top = 168
- Width = 88
- TabOrder = 4
- Text = '1'
- end
- object SplitLabel: TLabel
- Left = 512
- Height = 18
- Top = 144
- Width = 88
- AutoSize = False
- Caption = 'Split Spacing:'
- ParentColor = False
- end
object OCRFileOpen: TOpenDialog
Filter = '.bmp'
left = 416
diff --git a/Projects/OCRBench/unit1.pas b/Projects/OCRBench/unit1.pas
index ca9b245..bc0c03d 100644
--- a/Projects/OCRBench/unit1.pas
+++ b/Projects/OCRBench/unit1.pas
@@ -14,8 +14,6 @@ type
TForm1 = class(TForm)
BitmapButton: TButton;
- SplitLabel: TLabel;
- SplitEdit: TEdit;
FShadow: TCheckBox;
PathButton: TButton;
OCRButton: TButton;
@@ -24,12 +22,11 @@ type
UpCharsDialog: TSelectDirectoryDialog;
procedure BitmapButtonClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
- procedure FShadowChange(Sender: TObject);
procedure OCRButtonClick(Sender: TObject);
procedure PathButtonClick(Sender: TObject);
private
BitmapPath: String;
- UpTextPath: String;
+ FontPath: String;
{ private declarations }
public
{ public declarations }
@@ -52,7 +49,7 @@ Var
x,y: integer;
s: string;
Shadow: boolean;
- Spacing: Integer;
+ t: dword;
begin
if not FileExists(BitmapPath) then
@@ -63,12 +60,12 @@ begin
BitmapPath := OCRFileOpen.FileName;
Exit;
end;
- if not DirectoryExists(UpTextPath) then
+ if not DirectoryExists(FontPath) then
begin
- MessageBox(0,pchar('You did not set a UpText Path' ), Pchar('Path Error'),
+ MessageBox(0,pchar('You did not set a FontPath' ), Pchar('Path Error'),
MB_OK);
if UpCharsDialog.Execute then
- UpTextPath := UpCharsDialog.FileName;
+ FontPath := UpCharsDialog.FileName;
Exit;
end;
@@ -83,40 +80,34 @@ begin
Shadow :=FShadow.Checked;
- try
- Spacing := StrToInt(Form1.SplitEdit.Text);
- except
- if shadow then
- begin
- MessageBox(0,pchar('Spacing could not be parsed.' +
- 'Defaulting to 2' ), Pchar('Space Error'), MB_OK);
- Spacing := 2;
- end
- else
- begin
- MessageBox(0,pchar('Spacing could not be parsed.' +
- 'Defaulting to 1' ), Pchar('Space Error'), MB_OK);
- Spacing := 1;
- end;
- end;
-
// DS + .. + DS because InitOCR wants the directory of the Fonts, not UpChars
// only.
- C.MOCR.InitTOCR(UpTextPath + DS + '..' + DS, Shadow);
- s := C.MOCR.GetUpTextAtEx(7,7, Shadow, Spacing);
+ C.MOCR.InitTOCR(FontPath, Shadow);
+
+ t:=gettickcount;
+ s := C.MOCR.GetUpTextAtEx(7, 7, Shadow);
+ writeln(inttostr(gettickcount-t));
// write to debugbmp
+ {$IFDEF OCRDEBUG}
for y := 0 to C.MOCR.debugbmp.Height - 1 do
for x := 0 to C.MOCR.debugbmp.Width -1 do
Form1.Image1.Canvas.Pixels[x,y] := C.MOCR.debugbmp.FastGetPixel(x,y);
-
// print ocr'ed text
+
Form1.Image1.Canvas.Font.Color:=clRed;
Form1.Image1.Canvas.TextOut(0, C.MOCR.debugbmp.Height, s);
+ C.MOCR.debugbmp.Free;
+ {$ELSE}
+ Form1.Image1.Canvas.Font.Color:=clRed;
+ Form1.Image1.Canvas.TextOut(0, 0, s);
+ {$ENDIF}
Form1.Image1.Picture.SaveToFile('/tmp/ocrbench.bmp');
+ bmp.Free;
C.Free;
+ Application.ProcessMessages;
end;
procedure TForm1.BitmapButtonClick(Sender: TObject);
@@ -127,22 +118,14 @@ end;
procedure TForm1.FormCreate(Sender: TObject);
begin
- BitmapPath := '/home/merlijn/Programs/mufasa/pics/uptext2.bmp';
- UpTextPath := '/home/merlijn/Programs/mufasa/Fonts/UpChars';
-end;
-
-procedure TForm1.FShadowChange(Sender: TObject);
-begin
- if Form1.FShadow.Checked then
- Form1.SplitEdit.Text:='2'
- else
- Form1.SplitEdit.Text:='1';
+ BitmapPath := '/home/merlijn/Programs/mufasa/pics/uptext4.bmp';
+ FontPath := '/home/merlijn/Programs/mufasa/Fonts/';
end;
procedure TForm1.PathButtonClick(Sender: TObject);
begin
if UpCharsDialog.Execute then
- UpTextPath := UpCharsDialog.FileName;
+ FontPath := UpCharsDialog.FileName;
end;
initialization
diff --git a/Units/MMLAddon/PSInc/Wrappers/ocr.inc b/Units/MMLAddon/PSInc/Wrappers/ocr.inc
index b486287..9acc605 100644
--- a/Units/MMLAddon/PSInc/Wrappers/ocr.inc
+++ b/Units/MMLAddon/PSInc/Wrappers/ocr.inc
@@ -1,5 +1,5 @@
function rs_GetUpText: String;
begin
- Result := CurrThread.Client.MOCR.GetUpTextAt(7, 7, false);
- {writeln('inside: ' + result);}
+ // why the hell does it still not use shadows?
+ Result := CurrThread.Client.MOCR.GetUpTextAtEx(7, 7, true);
end;
diff --git a/Units/MMLAddon/tpa.pas b/Units/MMLAddon/tpa.pas
index 8ccc30e..7646153 100644
--- a/Units/MMLAddon/tpa.pas
+++ b/Units/MMLAddon/tpa.pas
@@ -1,1648 +1,1648 @@
-{
- This file is part of the Mufasa Macro Library (MML)
- Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer
-
- MML is free software: you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
-
- MML is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with MML. If not, see .
-
- See the file COPYING, included in this distribution,
- for details about the copyright.
-
- TPA functions for the Mufasa Macro Library
-}
-unit tpa;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
- Classes, SysUtils, mufasatypes;
-
-function FastTPASort(TPA: TPointArray; Dists: TIntegerArray; maxDist: Integer; CloseFirst: Boolean): TPointArray;
-
-//Start Wizzyplugin
-procedure tSwap(var a, b: TPoint);
-procedure tpaSwap(var a, b: TPointArray);
-procedure SwapE(var a, b: Extended);
-procedure RAaSTPAEx(var a: TPointArray; const w, h: Integer);
-procedure RAaSTPA(var a: TPointArray; const Dist: Integer);
-function NearbyPointInArrayEx(const P: TPoint; w, h:Integer; a: TPointArray): Boolean;
-function NearbyPointInArray(const P: TPoint; Dist:Integer; a: TPointArray): Boolean;
-function ReArrangeandShortenArrayEx(a: TPointArray; w, h: Integer): TPointArray;
-function ReArrangeandShortenArray(a: TPointArray; Dist: Integer): TPointArray;
-function TPAtoATPAEx(TPA: TPointArray; w, h: Integer): T2DPointArray;
-function TPAtoATPA(TPA: TPointArray; Dist: Integer): T2DPointArray;
-procedure QuickTPASort(var A: TIntegerArray; var B: TPointArray; iLo, iHi: Integer; SortUp: Boolean);
-procedure QuickATPASort(var A: TIntegerArray; var B: T2DPointArray; iLo, iHi: Integer; SortUp: Boolean);
-procedure SortTPAFrom(var a: TPointArray; const From: TPoint);
-procedure SortATPAFrom(var a: T2DPointArray; const From: TPoint);
-procedure SortATPAFromFirstPoint(var a: T2DPointArray; const From: TPoint);
-procedure InvertTPA(var a: TPointArray);
-procedure InvertATPA(var a: T2DPointArray);
-function MiddleTPAEx(TPA: TPointArray; var x, y: Integer): Boolean;
-function MiddleTPA(tpa: TPointArray): TPoint;
-procedure SortATPASize(var a: T2DPointArray; const BigFirst: Boolean);
-procedure SortATPAFromSize(var a: T2DPointArray; const Size: Integer; CloseFirst: Boolean);
-function CombineTPA(Ar1, Ar2: TPointArray): TPointArray;
-function CombineIntArray(Ar1, Ar2: TIntegerArray): TIntegerArray;
-function InIntArrayEx(a: TIntegerArray; var Where: Integer; const Number: Integer): Boolean;
-function InIntArray(a: TIntegerArray; Number: Integer): Boolean;
-procedure ClearSameIntegers(var a: TIntegerArray);
-procedure ClearSameIntegersAndTPA(var a: TIntegerArray; var p: TPointArray);
-function SplitTPAEx(arr: TPointArray; w, h: Integer): T2DPointArray;
-function SplitTPA(arr: TPointArray; Dist: Integer): T2DPointArray;
-procedure FilterPointsPie(var Points: TPointArray; const SD, ED, MinR, MaxR: Extended; Mx, My: Integer);
-function RemoveDistTPointArray(x, y, dist: Integer; ThePoints: TPointArray; RemoveHigher: Boolean): TPointArray;
-function GetATPABounds(ATPA: T2DPointArray): TBox;
-function GetTPABounds(TPA: TPointArray): TBox;
-function FindTPAinTPA(SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean;
-function FindTextTPAinTPA(Height : integer; SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean;
-function FindGapsTPA(TPA: TPointArray; MinPixels: Integer): T2DPointArray;
-procedure SortCircleWise(var tpa: TPointArray; const cx, cy, StartDegree: Integer; SortUp, ClockWise: Boolean);
-procedure LinearSort(var tpa: TPointArray; cx, cy, sd: Integer; SortUp: Boolean);
-Function MergeATPA(ATPA : T2DPointArray) : TPointArray;
-function TPAFromBox(const Box : TBox) : TPointArray;
-Function RotatePoints(Const P: TPointArray; A, cx, cy: Extended): TPointArray ;
-Function RotatePoint(Const p: TPoint; angle, mx, my: Extended): TPoint; inline;
-function FindTPAEdges(p: TPointArray): TPointArray;
-function PointInTPA(p: TPoint; arP: TPointArray): Boolean;
-function ClearTPAFromTPA(arP, ClearPoints: TPointArray): TPointArray;
-procedure ClearDoubleTPA(var TPA: TPointArray);
-Function ReturnPointsNotInTPA(Const TotalTPA: TPointArray; Box: TBox): TPointArray;
-Procedure TPACountSort(Var TPA: TPointArray;const max: TPoint;Const SortOnX : Boolean);
-Procedure TPACountSortBase(Var TPA: TPointArray;const maxx, base: TPoint; const SortOnX : Boolean);
-
-implementation
-
-uses
- math;
-
-
-
-
-{/\
- Very Fast TPA Sort, uses an adepted CountSort algorithm.
-/\}
-
-Function FastTPASort(TPA: TPointArray; Dists: TIntegerArray; maxDist: Integer; CloseFirst: Boolean): TPointArray;
-
-{
- If you want to understand this algorithm, it might be helpful to read about
- CountSort. This algorithm is quite similar to CountSort.
-}
-
-Var
- Oc, D: TIntegerArray;
- I, H, J: Integer;
- ind: array of array of integer;
-
-Begin
- SetLength(Oc, maxDist + 1); // Oc stores the occurances of each distance.
- H := High(Dists); // The amount of values in the given Array of Points...
- // We store it instead of calling High(Dists) each time.
-
- // Get the occurance of each distance, and store it in Oc.
- // We need the occurances of each distance, so we can later on set the 2d Array
- // to it's proper length.
- For I := 0 To H Do
- Oc[Dists[I]] := Oc[Dists[I]] + 1;
-
- // What we are basically going to do now is the following:
- // Sort the points by their distances using countsort.
- // But because (-2, -2) and (2, 2) have the same distance from (0, 0), we also
- // store the index in the array 'TPA', which contains the actual points.
- // This way we can retreive the actuals points.
-
- // D nothing but a counter. It contains the amount of points (indices) stored
- // for EACH distance, so it's length is equal to the amount of Distances.
- // ind is the array that has as first index the Distance. The second depth of
- // the array is the index which is used to retreive the original point.
-
- SetLength(D, maxDist + 1);
- SetLength(ind, maxDist + 1);
- For I := 0 To maxDist Do // set the ind length of each ind[distance] to Oc[distance]
- SetLength(ind[i], Oc[i] + 1);
- For I := 0 To H Do // Performs the actual index sorting
- Begin
- // put an index (of Dists AND TPA) into a distance array.
- ind[Dists[I]][D[Dists[I]]] := I;
- // inc by one, so we won't override previous indexes.
- D[Dists[i]] := D[Dists[i]] + 1;
- End;
-
- // Here we are back to the CountSort style of writing back.
- // Now we are going to write back to the Result.
- // The Result's length is obviously of the same length as 'TPA'.
- SetLength(Result, H + 1);
- H := 0;
-
- // CloseFirst just means: Start writing from dist 0 to maxDist, or
- // start writing from maxDist to dist 0. The first one places the closest points
- // at the start of the result. The higher the index, the more far away the point.
- // Not Closefirst means put the most far away point in Result first.
- If CloseFirst Then
- Begin
- For I := 0 To maxDist Do // Put back to result
- For J := 0 To oC[I] - 1 Do
- Begin
- Result[H] := TPA[ind[I][J]];
- H := H + 1;
- End;
- End
- Else
- For I := maxDist Downto 0 Do // Put back to result
- For J := 0 To oC[I] - 1 Do
- Begin
- Result[H] := TPA[ind[I][J]];
- H := H + 1;
- End;
- // Voila!
-End;
-
-const
- flnC=545947;
- fsqrtA:single=0.5;
-
-{$ASMMODE INTEL}
-function fsqrt(x: Single): Single;
-begin
- asm
- sub dword ptr x, ($3F800000-flnC)
- fild dword ptr x
- fmul fsqrtA
- fistp dword ptr x
- add dword ptr x,($3F800000-flnC)
- fld x
- end;
-end;
-
-procedure tSwap(var a, b: TPoint);
-var
- c: TPoint;
-begin
- c := a;
- a := b;
- b := c;
-end;
-
-procedure tpaSwap(var a, b: TPointArray);
-var
- c: TPointArray;
-begin
- c := a;
- a := b;
- b := c;
-end;
-
-procedure SwapE(var a, b: Extended);
-var
- c: extended;
-begin
- c := a;
- a := b;
- b := c;
-end;
-
-{/\
- Leaves one point per box with side lengths W and H to the TPA.
-/\}
-
-procedure RAaSTPAEx(var a: TPointArray; const w, h: Integer);
-var
- i, c, NoTP, l: Integer;
- t: TPoint;
- b: boolean;
-
-begin
- b:=false;
- NoTP := 0;
- l := High(a);
- for i := 0 to l do
- begin
- for c := 0 to NoTP - 1 do
- if (Abs(a[i].x - a[c].x) <= w) and (Abs(a[i].y - a[c].y) <= h) then
- begin
- b := true;
- Break;
- end;
- if not b then
- begin
- t := a[i];
- a[i] := a[NoTP];
- a[NoTP] := t;
- Inc(NoTP);
- end;
- end;
- SetLength(a, NoTP);
-end;
-
-{/\
- Leaves one point per box with the side length Dist.
-/\}
-
-procedure RAaSTPA(var a: TPointArray; const Dist: Integer);
-var
- i, c, NoTP, l: Integer;
- t: TPoint;
- b: boolean;
-
-begin
- b := false;
- NoTP := 0;
- l := High(a);
- for i := 0 to l do
- begin
- for c := 0 to NoTP - 1 do
- if (Round(fSqrt(Sqr(a[i].x - a[c].x) + Sqr(a[i].y - a[c].y))) <= Dist) then
- begin
- b:=true;
- Break;
- end;
- if (c >= NoTP) then
- begin
- t := a[i];
- a[i] := a[NoTP];
- a[NoTP] := t;
- Inc(NoTP);
- end;
- end;
- SetLength(a, NoTP);
-end;
-
-{/\
- Returns true if the point P is near a point in the TPA a with the max X and Y distances W and H.
-/\}
-
-function NearbyPointInArrayEx(const P: TPoint; w, h:Integer; a: TPointArray): Boolean;
-var
- i, l: Integer;
-begin
- Result := False;
- l := High(a);
- for i := 0 to l do
- if (Abs(P.x - a[i].x) <= w) and (Abs(P.y - a[i].y) <= h) then
- begin
- Result := True;
- Exit;
- end;
-end;
-
-{/\
- Returns true if the point P is near a point in the TPA a with the max distance Dist.
-/\}
-
-function NearbyPointInArray(const P: TPoint; Dist:Integer; a: TPointArray): Boolean;
-var
- i, l: Integer;
-begin
- Result := False;
- l := High(a);
- for i := 0 to l do
- if (Round(fSqrt(Sqr(P.x - a[i].x) + Sqr(P.y - a[i].y))) <= Dist) then
- begin
- Result := True;
- Exit;
- end;
-end;
-
-{/\
- Results the TPointArray a with one point per box with side lengths W and H left.
-/\}
-
-function ReArrangeandShortenArrayEx(a: TPointArray; w, h: Integer): TPointArray;
-var
- i, t, c, l: Integer;
-begin
- l := High(a);
- c := 0;
- SetLength(Result, l + 1);
- for i := 0 to l do
- begin
- for t := 0 to c -1 do
- if (Abs(Result[t].x - a[i].x) <= w) and (Abs(Result[t].y - a[i].y) <= h) then
- Break;
- if (t >= c) then
- begin
- Result[c] := a[i];
- Inc(c);
- end;
- end;
- SetLength(Result, c);
-end;
-
-{/\
- Results the TPointArray a with one point per box with side length Dist left.
-/\}
-
-function ReArrangeandShortenArray(a: TPointArray; Dist: Integer): TPointArray;
-var
- i, t, c, l: Integer;
-begin
- l := High(a);
- c := 0;
- SetLength(Result, l + 1);
- for i := 0 to l do
- begin
- for t := 0 to c -1 do
- if (Round(fSqrt(Sqr(Result[t].x - a[i].x) + Sqr(Result[t].y - a[i].y))) <= Dist) then
- Break;
- if (t >= c) then
- begin
- Result[c] := a[i];
- Inc(c);
- end;
- end;
- SetLength(Result, c);
-end;
-
-{/\
- Splits the TPA to boxes with sidelengths W and H and results them as a T2DPointArray.
-/\}
-
-function TPAtoATPAEx(TPA: TPointArray; w, h: Integer): T2DPointArray;
-var
- a, b, c, l: LongInt;
-begin
- SetLength(Result, 0);
- l := High(TPA);
- c := 0;
- for a := 0 to l do
- begin
- for b := 0 to c -1 do
- if (Abs(TPA[a].X - Result[b][0].X) <= w) and (Abs(TPA[a].Y - Result[b][0].Y) <= h) then
- Break;
- if (b < c) then
- begin
- SetLength(Result[b], Length(Result[b]) + 1);
- Result[b][High(Result[b])] := TPA[a];
- end else
- begin
- SetLength(Result, c + 1);
- SetLength(Result[c], 1);
- Result[c][0] := TPA[a];
- Inc(c);
- end;
- end;
-end;
-
-{/\
- Splits the TPA to boxes with sidelength Dist and results them as a T2DPointArray.
-/\}
-
-function TPAtoATPA(TPA: TPointArray; Dist: Integer): T2DPointArray;
-var
- a, b, c, l: LongInt;
-begin
- SetLength(Result, 0);
- l := High(tpa);
- c := 0;
- for a := 0 to l do
- begin
- for b := 0 to c -1 do
- if (Round(fSqrt(Sqr(TPA[a].X - Result[b][0].X) + Sqr(TPA[a].Y - Result[b][0].Y))) <= Dist) then
- Break;
- if (b < c) then
- begin
- SetLength(Result[b], Length(Result[b]) + 1);
- Result[b][High(Result[b])] := TPA[a];
- end else
- begin
- SetLength(Result, c + 1);
- SetLength(Result[c], 1);
- Result[c][0] := TPA[a];
- Inc(c);
- end;
- end;
-end;
-
-{/\
- Sorts the given TPointArray.
-/\}
-
-procedure QuickTPASort(var A: TIntegerArray; var B: TPointArray; iLo, iHi: Integer; SortUp: Boolean);
-var
- Lo, Hi, Mid, T: Integer;
- TP: TPoint;
-begin
- if (Length(A) <> Length(B)) then Exit;
- Lo := iLo;
- Hi := iHi;
- Mid := A[(Lo + Hi) shr 1];
- repeat
- if SortUp then
- begin
- while (A[Lo] < Mid) do Inc(Lo);
- while (A[Hi] > Mid) do Dec(Hi);
- end else
- begin
- while (A[Lo] > Mid) do Inc(Lo);
- while (A[Hi] < Mid) do Dec(Hi);
- end;
- if (Lo <= Hi) then
- begin
- T := A[Lo];
- A[Lo] := A[Hi];
- A[Hi] := T;
- TP := B[Lo];
- B[Lo] := B[Hi];
- B[Hi] := TP;
- Inc(Lo);
- Dec(Hi);
- end;
- until Lo > Hi;
- if (Hi > iLo) then QuickTPASort(A, B, iLo, Hi, SortUp);
- if (Lo < iHi) then QuickTPASort(A, B, Lo, iHi, SortUp);
-end;
-
-{/\
- Sorts the given T2DPointArray.
-/\}
-
-procedure QuickATPASort(var A: TIntegerArray; var B: T2DPointArray; iLo, iHi: Integer; SortUp: Boolean);
-var
- Lo, Hi, Mid, T: Integer;
- TP: TPointArray;
-begin
- if (Length(A) <> Length(B)) then Exit;
- Lo := iLo;
- Hi := iHi;
- Mid := A[(Lo + Hi) shr 1];
- repeat
- if SortUp then
- begin
- while (A[Lo] < Mid) do Inc(Lo);
- while (A[Hi] > Mid) do Dec(Hi);
- end else
- begin
- while (A[Lo] > Mid) do Inc(Lo);
- while (A[Hi] < Mid) do Dec(Hi);
- end;
- if (Lo <= Hi) then
- begin
- T := A[Lo];
- A[Lo] := A[Hi];
- A[Hi] := T;
- TP := B[Lo];
- B[Lo] := B[Hi];
- B[Hi] := TP;
- Inc(Lo);
- Dec(Hi);
- end;
- until Lo > Hi;
- if (Hi > iLo) then QuickATPASort(A, B, iLo, Hi, SortUp);
- if (Lo < iHi) then QuickATPASort(A, B, Lo, iHi, SortUp);
-end;
-
-{/\
- Sorts the TPointArray a from the point From.
- Closest one to the point is [0], second closest is [1] etc.
-/\}
-
-procedure SortTPAFrom(var a: TPointArray; const From: TPoint);
-var
- i, l: Integer;
- DistArr: TIntegerArray;
-begin
- l := High(a);
- if (l < 0) then Exit;
- SetLength(DistArr, l + 1);
- for i := 0 to l do
- DistArr[i] := Round(Sqr(From.x - a[i].x) + Sqr(From.y - a[i].y));
- QuickTPASort(DistArr, a, 0, l, True);
-end;
-
-{/\
- Sorts the T2DPointArray a from the point From.
-/\}
-
-procedure SortATPAFrom(var a: T2DPointArray; const From: TPoint);
-var
- i, l: Integer;
-begin
- l := High(a);
- if (l < 0) then Exit;
- for i := 0 to l do
- SortTPAFrom(a[i], From);
-end;
-
-{/\
- Sorts the T2DPointArray a from the point From.
-/\}
-
-procedure SortATPAFromFirstPoint(var a: T2DPointArray; const From: TPoint);
-var
- i, l: Integer;
- DistArr: TIntegerArray;
-begin
- writeln('hoi0');
- l := High(a);
- if (l < 0) then Exit;
- writeln('hoi1');
- SetLength(DistArr, l + 1);
- for i := 0 to l do
- DistArr[i] := Round(Sqr(From.x - a[i][0].x) + Sqr(From.y - a[i][0].y));
- writeln('hoi2');
- QuickATPASort(DistArr, a, 0, l, True);
- writeln('hoi3');
-end;
-
-{/\
- Inverts / Reverses the TPointArray a.
-/\}
-
-procedure InvertTPA(var a: TPointArray);
-var
- i, l: Integer;
- b: tpointarray;
-begin
- l := High(a);
- if (l < 0) then Exit;
- b := Copy(a);
- for i := l downto 0 Do
- a[l - i] := b[i];
-end;
-
-{/\
- Inverts / Reverts the T2DPointArray a.
-/\}
-
-procedure InvertATPA(var a: T2DPointArray);
-var
- i, l: Integer;
- b: T2DPointArray;
-begin
- l := High(a);
- if (l < 0) then Exit;
- b := Copy(a);
- for i := l downto 0 do
- a[l - i] := b[i];
-end;
-
-{/\
- Stores the coordinates of the middle of the TPointArray a to X and Y.
-/\}
-
-function MiddleTPAEx(TPA: TPointArray; var x, y: Integer): Boolean;
-var
- i, l: Integer;
-begin
- Result := False;
- l := High(tpa);
- if (l < 0) then Exit;
- x := 0;
- y := 0;
- for i := 0 to l do
- begin
- x := x + tpa[i].x;
- y := y + tpa[i].y;
- end;
- x := x div (l + 1);
- y := y div (l + 1);
- Result := True;
-end;
-
-{/\
- Returns the middle of the TPointArray tpa.
-/\}
-
-function MiddleTPA(tpa: TPointArray): TPoint;
-var
- i, l: Integer;
-begin
- l := High(tpa);
- if (l < 0) then Exit;
- Result.x := 0;
- Result.y := 0;
- for i := 0 to l do
- begin
- Result.x := Result.x + tpa[i].x;
- Result.y := Result.y + tpa[i].y;
- end;
- Result.x := Result.x div (l + 1);
- Result.y := Result.y div (l + 1);
-end;
-
-{/\
- Sorts the T2DPointArray a from either largest or smallest, by the amount of points in the TPAs.
-/\}
-
-procedure SortATPASize(var a: T2DPointArray; const BigFirst: Boolean);
-var
- i, l: Integer;
- SizeArr: TIntegerArray;
-begin
- l := High(a);
- if (l < 0) then Exit;
- SetLength(SizeArr, l + 1);
- for i := 0 to l do
- SizeArr[i] := Length(a[i]);
- QuickATPASort(SizeArr, a, 0, l, not BigFirst);
-end;
-
-{/\
- Combines the TPointArrays Ar1 and Ar2, and results the combination.
-/\}
-
-procedure SortATPAFromSize(var a: T2DPointArray; const Size: Integer; CloseFirst: Boolean);
-var
- i, l: Integer;
- SizeArr: TIntegerArray;
-begin
- l := High(a);
- if (l < 0) then Exit;
- SetLength(SizeArr, l + 1);
- for i := 0 to l do
- SizeArr[i] := Abs(Length(a[i]) - Size);
- QuickATPASort(SizeArr, a, 0, l, CloseFirst);
-end;
-
-{/\
- Combines the TPointArrays Ar1 and Ar2, and results the combination.
-/\}
-
-function CombineTPA(Ar1, Ar2: TPointArray): TPointArray;
-var
- i, l1, l2: Integer;
-begin
- Result := Copy(Ar1);
- l1 := Length(Result);
- l2 := Length(Ar2);
- SetLength(Result, l1 + l2);
- for i := 0 to l2 -1 do
- Result[i + l1] := Ar2[i];
-end;
-
-{/\
- Combines the TIntegerArrays Ar1 and Ar2, and results the combination.
-/\}
-
-function CombineIntArray(Ar1, Ar2: TIntegerArray): TIntegerArray;
-var
- i, l1, l2: Integer;
-begin
- Result := Copy(Ar1);
- l1 := Length(Result);
- l2 := Length(Ar2);
- SetLength(Result, l1 + l2);
- for i := 0 to l2 -1 do
- Result[i + l1] := Ar2[i];
-end;
-
-{/\
- Returns true if the integer Number was found in the integer array a, and stores the index to Where.
-/\}
-
-function InIntArrayEx(a: TIntegerArray; var Where: Integer; const Number: Integer): Boolean;
-var
- i, l: Integer;
-begin
- Result := False;
- l := High(a);
- for i := 0 to l do
- if (a[i] = Number) then
- begin
- Where := i;
- Result := True;
- Exit;
- end;
-end;
-
-{/\
- Returns true if the integer Number was found in the integer array a.
-/\}
-
-function InIntArray(a: TIntegerArray; Number: Integer): Boolean;
-var
- i, l: Integer;
-begin
- Result := False;
- l := High(a);
- for i := 0 to l do
- if (a[i] = Number) then
- begin
- Result := True;
- Exit;
- end;
-end;
-
-{/\
- Clears the duplicates in the integer array a.
-/\}
-
-procedure ClearSameIntegers(var a: TIntegerArray);
-var
- i, t, c, l: Integer;
- b: TIntegerArray;
-begin
- b := Copy(a);
- l := High(b);
- c := 0;
- for i := 0 to l do
- begin
- for t := 0 to c -1 do
- if (b[i] = a[t]) then
- Break;
- if (t >= c) then
- begin
- a[c] := b[i];
- Inc(c);
- end;
- end;
- SetLength(a, c);
-end;
-
-{/\
- Clears the duplicates in the integer array a and the TPointArray p.
-/\}
-
-procedure ClearSameIntegersAndTPA(var a: TIntegerArray; var p: TPointArray);
-var
- i, t, c, l: Integer;
- b: TIntegerArray;
-begin
- b := Copy(a);
- l := High(b);
- c := 0;
- for i := 0 to l do
- begin
- for t := 0 to c -1 do
- if (b[i] = a[t]) then
- Break;
- if (t >= c) then
- begin
- SetLength(a, c +1);
- a[c] := b[i];
- p[c] := p[i];
- Inc(c);
- end;
- end;
- SetLength(p, c);
- SetLength(a, c);
-end;
-
-{/\
- Splits the points with max X and Y distances W and H to their own TPointArrays.
-/\}
-
-function SplitTPAEx(arr: TPointArray; w, h: Integer): T2DPointArray;
-var
- t1, t2, c, ec, tc, l: Integer;
- tpa: TPointArray;
-begin
- tpa := Copy(arr);
- l := High(tpa);
- if (l < 0) then Exit;
- SetLength(Result, l + 1);
- c := 0;
- ec := 0;
- while ((l - ec) >= 0) do
- begin
- SetLength(Result[c], 1);
- Result[c][0] := tpa[0];
- tpa[0] := tpa[l - ec];
- Inc(ec);
- tc := 1;
- t1 := 0;
- while (t1 < tc) do
- begin
- t2 := 0;
- while (t2 <= (l - ec)) do
- begin
- if (Abs(Result[c][t1].x - tpa[t2].x) <= w) and (Abs(Result[c][t1].y - tpa[t2].y) <= h) then
- begin
- SetLength(Result[c], tc +1);
- Result[c][tc] := tpa[t2];
- tpa[t2] := tpa[l - ec];
- Inc(ec);
- Inc(tc);
- Dec(t2);
- end;
- Inc(t2);
- end;
- Inc(t1);
- end;
- Inc(c);
- end;
- SetLength(Result, c);
-end;
-
-{/\
- Splits the points with max distance Dist to their own TPointArrays.
- Dist 1 puts the points that are next to eachother to their own arrays.
-/\}
-
-function SplitTPA(arr: TPointArray; Dist: Integer): T2DPointArray;
-var
- t1, t2, c, ec, tc, l: Integer;
- tpa: TPointArray;
-begin
- tpa := Copy(arr);
- l := High(tpa);
- if (l < 0) then Exit;
- SetLength(Result, l + 1);
- c := 0;
- ec := 0;
- while ((l - ec) >= 0) do
- begin
- SetLength(Result[c], 1);
- Result[c][0] := tpa[0];
- tpa[0] := tpa[l - ec];
- Inc(ec);
- tc := 1;
- t1 := 0;
- while (t1 < tc) do
- begin
- t2 := 0;
- while (t2 <= (l - ec)) do
- begin
- if (Round(fSqrt(Sqr(Result[c][t1].x - tpa[t2].x) + Sqr(Result[c][t1].y - tpa[t2].y))) <= Dist) then
- begin
- SetLength(Result[c], tc +1);
- Result[c][tc] := tpa[t2];
- tpa[t2] := tpa[l - ec];
- Inc(ec);
- Inc(tc);
- Dec(t2);
- end;
- Inc(t2);
- end;
- Inc(t1);
- end;
- Inc(c);
- end;
- SetLength(Result, c);
-end;
-
-{/\
- Removes the points in the TPointArray Points that are not within the degrees
- \\ SD (StartDegree) and ED (EndDegree) and the distances MinR (MinRadius) and
- \\ MaxR (MaxRadius) from the origin (Mx, My).
-/\}
-
-procedure FilterPointsPie(var Points: TPointArray; const SD, ED, MinR, MaxR: Extended; Mx, My: Integer);
-const
- i180Pi = 57.29577951;
-var
- G: TPointArray;
- I, L, T: Integer;
- D, StartD, EndD: Extended;
- cWise: Boolean;
-begin
- T := High(Points);
- if (T < 0) then Exit;
- SetLength(G, T + 1);
- L := 0;
- StartD := SD;
- EndD := ED;
- cWise := StartD > EndD;
- while StartD > 360.0 do
- StartD := StartD - 360.0;
- while EndD > 360.0 do
- EndD := EndD - 360.0;
- while StartD < 0.0 do
- StartD := StartD + 360.0;
- while EndD < 0.0 do
- EndD := EndD + 360.0;
- if StartD > EndD then
- SwapE(StartD, EndD);
- for I := 0 to T do
- begin
- D := fSqrt(Sqr(Points[I].X - Mx) + Sqr(Points[I].Y - My));
- if( D <= MinR) or (D >= MaxR) then
- Continue;
- D := (ArcTan2(Points[I].Y - My, Points[I].X - Mx) * i180Pi) + 90;
- if D < 0.0 then
- D := D + 360.0;
- if (not ((StartD <= D) and (EndD >= D))) xor CWise then
- Continue;
- G[L] := Points[I];
- Inc(L);
- end;
- SetLength(G, L);
- Points := G;
-end;
-
-{/\
- Removes the points that are inside or outside the distance Dist from the point (x, y) from the TPointArray ThePoints.
-/\}
-
-function RemoveDistTPointArray(x, y, dist: Integer; ThePoints: TPointArray; RemoveHigher: Boolean): TPointArray;
-var
- I, L, LL: integer;
-begin;
- L := 0;
- LL := Length(ThePoints) -1;
- SetLength(Result, LL + 1);
- if RemoveHigher then
- begin;
- for I := 0 to LL do
- if not (Round(fSqrt(sqr(ThePoints[i].x - x)+sqr(ThePoints[i].y - y))) > Dist) then
- begin;
- Result[L] := ThePoints[i];
- L := L + 1;
- end;
- end else
- begin;
- for I := 0 to LL do
- if not (Round(fSqrt(sqr(ThePoints[i].x - x)+sqr(ThePoints[i].y - y))) < Dist) then
- begin;
- Result[L] := ThePoints[i];
- L := L + 1;
- end;
- end;
- SetLength(Result,L);
-end;
-
-{/\
- Returns the boundaries of the ATPA as a TBox.
-/\}
-
-function GetATPABounds(ATPA: T2DPointArray): TBox;
-var
- I,II,L2,L : Integer;
-begin;
- L := High(ATPA);
- if (l < 0) then Exit;
- For I := 0 to L do
- if Length(ATPA[I]) > 0 then
- begin;
- Result.x1 := ATPA[I][0].x;
- Result.y1 := ATPA[I][0].y;
- Result.x2 := ATPA[I][0].x;
- Result.y2 := ATPA[I][0].y;
- end;
- for I := 0 to L do
- begin;
- L2 := High(ATPA[I]);
- for II := 0 to L2 do
- begin;
- if ATPA[i][II].x > Result.x2 then
- Result.x2 := ATPA[i][II].x
- else if ATPA[i][II].x < Result.x1 then
- Result.x1 := ATPA[i][II].x;
- if ATPA[i][II].y > Result.y2 then
- Result.y2 := ATPA[i][II].y
- else if ATPA[i][II].y < Result.y1 then
- Result.y1 := ATPA[i][II].y;
- end;
- end;
-end;
-
-{/\
- Returns the boundaries of the TPA as a TBox.
-/\}
-
-function GetTPABounds(TPA: TPointArray): TBox;
-var
- I,L : Integer;
-begin;
- L := High(TPA);
- if (l < 0) then Exit;
- Result.x1 := TPA[0].x;
- Result.y1 := TPA[0].y;
- Result.x2 := TPA[0].x;
- Result.y2 := TPA[0].y;
- for I:= 1 to L do
- begin;
- if TPA[i].x > Result.x2 then
- Result.x2 := TPA[i].x
- else if TPA[i].x < Result.x1 then
- Result.x1 := TPA[i].x;
- if TPA[i].y > Result.y2 then
- Result.y2 := TPA[i].y
- else if TPA[i].y < Result.y1 then
- Result.y1 := TPA[i].y;
- end;
-end;
-
-{/\
- Looks for the TPA SearchTPA in the TPA TotalTPA and returns the matched points
- \\ to the TPA Matches. Returns true if there were atleast one match(es).
-/\}
-
-function FindTPAinTPA(SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean;
-var
- Len, I,II,LenSearch,xOff,yOff : integer;
- tx,ty,MatchCount : integer;
- Screen : Array of Array of Boolean;
- ScreenBox,SearchBox : TBox;
-begin;
- Result := False;
- Len := High(TotalTPA);
- LenSearch := High(SearchTPA);
- if LenSearch < 0 then Exit;
- if Len < LenSearch then Exit;
- MatchCount := 0;
- ScreenBox := GetTPABounds(TotalTPA);
- SearchBox := GetTPABounds(SearchTPA);
- try
- SetLength(Screen,ScreenBox.x2 + 1,ScreenBox.y2 + 1);
- except
- Exit;
- end;
- if (SearchBox.x1 > 0) or (SearchBox.y1 > 0) then
- begin;
- for I := 0 to LenSearch do
- begin;
- SearchTPA[I].x := SearchTPA[I].x - SearchBox.x1;
- SearchTPA[I].y := SearchTPA[I].y - SearchBox.y1;
- end;
- SearchBox.x2 := SearchBox.x2 - SearchBox.x1;
- SearchBox.y2 := SearchBox.y2 - SearchBox.y1;
- SearchBox.x1 := 0;
- SearchBox.y1 := 0;
- end;
- xOff := SearchBox.x2;
- yOff := SearchBox.y2;
- for I := 0 to LenSearch do
- begin;
- if (SearchTPA[I].x = 0) and (SearchTPA[I].y < yOff) then
- yOff := SearchTPA[I].y;
- if (SearchTPA[I].y = 0) and (SearchTPA[I].x < xOff) then
- xOff := SearchTPA[I].x;
- end;
- for I := 0 to Len do
- Screen[TotalTPA[I].x][TotalTPA[I].y] := True;
- for I := 0 to Len do
- begin;
- tx := TotalTPA[I].x - xOff;
- ty := TotalTPA[I].y;// - yOff;
- if tx > 0 then
- if ty > 0 then
- if ((SearchBox.x2 + tx) <= ScreenBox.x2) and ((SearchBox.y2 + ty) <= ScreenBox.y2) then
- begin;
- For II := 0 to LenSearch do
- if Screen[tx + SearchTPA[II].x ][ty + SearchTPA[II].y] = False then
- Break;
- if II > LenSearch then
- begin;
- MatchCount := MatchCount + 1;
- SetLength(Matches,MatchCount);
- Matches[MatchCount - 1].x := TotalTPA[I].x;
- Matches[MatchCount - 1].y := TotalTPA[I].y;
- end;
- end;
- end;
- if (MatchCount > 0) then
- Result := True;
-end;
-
-{/\
- Read the description of FindTPAinTPA. Additional Height parameter.
-/\}
-
-function FindTextTPAinTPA(Height : integer; SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean;
-var
- Len, I,II,LenSearch,LenTPA,xOff,yOff,x,y: integer;
- tx,ty,MatchCount : integer;
- Screen : Array of Array of Boolean;
- ScreenBox,SearchBox : TBox;
- InversedTPA : TPointArray;
-begin;
- Result := False;
- Len := High(TotalTPA);
- LenSearch := High(SearchTPA);
- if LenSearch < 0 then Exit;
- if Len < LenSearch then Exit;
- MatchCount := 0;
- xOff := -5;
- yOff := 0;
- ScreenBox := GetTPABounds(TotalTPA);
- SearchBox := GetTPABounds(SearchTPA);
- if height > SearchBox.y2 then
- Screenbox.y2 := Screenbox.y2 + (height - SearchBox.y2);
- SearchBox.y2 := Height;
- SetLength(Screen, SearchBox.x2 + 1,Searchbox.y2 + 1);
- SetLength(InversedTPA,(SearchBox.x2 + 1) * (Searchbox.y2 + 1));
- for I := 0 to LenSearch do
- Screen[ SearchTPA[I].x,SearchTPA[I].y] := True;
- LenTPA := -1;
- for y := 0 to SearchBox.y2 do
- for x := 0 to SearchBox.x2 do
- if Screen[X][Y] = False then
- begin;
- LenTPA := LenTPA + 1;
- InversedTPA[LenTPA].x := x;
- InversedTPA[LenTPA].y := y;
- end;
- for x := 0 to SearchBox.x2 do
- begin;
- for y := 0 to SearchBox.y2 do
- if Screen[x][y] = True then
- begin;
- xOff := x;
- yOff := y;
- Break;
- end;
- if xOff >= 0 then
- Break;
- end;
- try
- SetLength(Screen,0);
- SetLength(Screen,ScreenBox.x2 + 1,ScreenBox.y2 + 1);
- except
- Exit;
- end;
- for I := 0 to Len do
- Screen[TotalTPA[I].x][TotalTPA[I].y] := True;
- for I := 0 to Len do
- begin;
- tx := TotalTPA[I].x - xOff;
- ty := TotalTPA[I].y - yOff;
- if tx > 0 then
- if ty > 0 then
- if ((SearchBox.x2 + tx) <= ScreenBox.x2) and ((SearchBox.y2 + ty) <= ScreenBox.y2) then
- begin;
- For II := 0 to LenSearch do
- if Screen[tx + SearchTPA[II].x ][ty + SearchTPA[II].y] = False then
- Break;
- if (II > LenSearch) then
- begin;
- For II := 0 to LenTPA do
- if Screen[tx + InversedTPA[II].x ][ty + InversedTPA[II].y] = True then
- Break;
- if (II > LenTPA) then
- begin;
- MatchCount := MatchCount + 1;
- SetLength(Matches,MatchCount);
- Matches[MatchCount - 1].x := TotalTPA[I].x;
- Matches[MatchCount - 1].y := TotalTPA[I].y;
- end;
- end;
- end;
- end;
- if (MatchCount > 0) then
- Result := True;
-end;
-
-{/\
- Finds the possible gaps in the TPointArray TPA and results the gaps as a T2DPointArray.
- \\ Considers as a gap if the gap length is >= MinPixels.
- \\ Only horizontal, sorry folks.
-/\}
-
-function FindGapsTPA(TPA: TPointArray; MinPixels: Integer): T2DPointArray;
-var
- Len,TotalLen,LenRes,I,II,III : integer;
- Screen : Array of Array of Boolean;
- Height,Width : Integer;
- Box : TBox;
-begin;
- Len := High(TPA);
- if Len < 0 then exit;
- Box := GetTPABounds(TPA);
- Height := Box.y2 - Box.y1;
- Width := Box.x2 - Box.x1;
- LenRes := 0;
- III := 0;
- try
- SetLength(Screen,Width + 1,Height + 1);
- except
- Exit;
- end;
- For I := 0 to Len do
- Screen[TPA[I].x - Box.x1][TPA[I].y - Box.y1] := True;
- SetLength(result,1);
- SetLength(Result[0],Len+1);
- TotalLen := 0;
- for I := 0 to Width do
- begin;
- for II := 0 to Height do
- if Screen[I][II]=True then
- begin;
- Result[TotalLen][LenRes].x := I + Box.x1;
- Result[TotalLen][LenRes].y := II + Box.y1;
- LenRes := LenRes + 1;
- III := I;
- end;
- if LenRes = 0 then
- III := I
- else
- if (I - III) > MinPixels then
- begin;
- III := I;
- SetLength(Result[TotalLen],LenRes);
- LenRes := 0;
- TotalLen := TotalLen + 1;
- SetLength(Result,TotalLen + 1);
- SetLength(Result[TotalLen],Len + 1);
- end;
- end;
- SetLength(Result[TotalLen],LenRes);
-end;
-
-
-
-{/\
- Sorts all points in tpa by distance from degree (Deg) and distance from mx and my.
- \\ Sortup will return closest distance to mx and my first.
- \\ Distance will be sorted first (RadialWalk style).
-/\}
-
-procedure SortCircleWise(var tpa: TPointArray; const cx, cy, StartDegree: Integer; SortUp, ClockWise: Boolean);
-const
- i180Pi = 57.29577951;
-var
- i, l, td, sd: Integer;
- Dist, Deg: TIntegerArray;
-begin
- l := Length(tpa);
- if (l = 0) then Exit;
- sd := StartDegree;
- while (sd > 360) do
- sd := (sd - 360);
- sd := (360 - sd);
- SetLength(Dist, l);
- SetLength(Deg, l);
- for i := 0 to l -1 do
- Dist[i] := Round(Hypot(tpa[i].x - cx, tpa[i].y - cy));
- QuickTPASort(Dist, tpa, 0, l -1, SortUp);
- if (l = 1) then Exit;
- for i := 0 to l -1 do
- begin
- td := Round(ArcTan2(tpa[i].y - cy, tpa[i].x - cx) * i180Pi) + 90;
- if (td < 0) then
- td := td + 360;
- if ClockWise then
- Deg[i] := Round(sd + td) mod 360
- else
- Deg[i] := 360 - Round(sd + td) mod 360;
- end;
- i := 1;
- td := 0;
- Dec(l);
- while (i < l) do
- begin
- while (i < l) and (Abs(Dist[td] - Dist[i]) <= 1) do Inc(i);
- QuickTPASort(Deg, tpa, td, i, False);
- Inc(i);
- td := i;
- end;
- if (td < l) then
- QuickTPASort(Deg, tpa, td, l, False);
-end;
-
-{/\
- Sorts all points in tpa by distance from degree (Deg) and distance from mx and my.
- \\ Sortup will return closest distance to mx and my first.
- \\ Degree will be sorted first (LinearWalk style).
-/\}
-
-procedure LinearSort(var tpa: TPointArray; cx, cy, sd: Integer; SortUp: Boolean);
-const
- i180Pi = 57.29577951;
-var
- i, l, td: Integer;
- Dist, Deg: TIntegerArray;
-begin
- l := Length(tpa);
- if (l = 0) then Exit;
- while (sd > 360) do
- sd := (sd - 360);
- SetLength(Dist, l);
- SetLength(Deg, l);
- for i := 0 to l -1 do
- begin
- td := Round(ArcTan2(tpa[i].y - cy, tpa[i].x - cx) * i180Pi) + 90;
- if (td < 0) then
- td := td + 360;
- Deg[i] := Min(Abs(sd - td), Min(Abs(sd - (td + 360)), Abs((sd + 360) - td)))
- end;
- QuickTPASort(Deg, tpa, 0, l -1, True);
- if (l = 1) then Exit;
- for i := 0 to l -1 do
- Dist[i] := Round(Hypot(tpa[i].x - cx, tpa[i].y - cy));
- i := 1;
- td := 0;
- Dec(l);
- while (i < l) do
- begin
- while (i < l) and (Abs(Deg[td] - Deg[i]) <= 3) do Inc(i);
- QuickTPASort(Dist, tpa, td, i, SortUp);
- Inc(i);
- td := i;
- end;
- if (td < l) then
- QuickTPASort(Dist, tpa, td, l, SortUp);
-end;
-
-{/\
- Merges the TPointArrays of the T2DPointArray ATPA in to one TPA.
-/\}
-
-Function MergeATPA(ATPA : T2DPointArray) : TPointArray;
-var
- I,II, Len, TempL,CurrentL : integer;
-begin;
- Len := High(ATPA);
- CurrentL := 0;
- For I:= 0 to Len do
- begin;
- TempL := High(ATPA[I]);
- if TempL < 0 then
- Continue;
- TempL := Templ + CurrentL + 1;
- Setlength(Result, TempL+1);
- For II := CurrentL to TempL do
- Result[II] := ATPA[I][II - CurrentL];
- CurrentL := TempL;
- end;
- SetLength(Result,CurrentL);
-end;
-
-
-{/\
- Returns a TPointArray of a the full given Box.
-/\}
-
-function TPAFromBox(const Box : TBox) : TPointArray;
-var
- x, y: integer;
- l : integer;
-begin;
- SetLength(Result, (Box.x2 - Box.x1 + 1) * (Box.y2 - Box.y1 + 1));
- l := 0;
- For x := box.x1 to Box.x2 do
- for y := box.y1 to box.y2 do
- begin;
- Result[l].x := x;
- Result[l].y := y;
- inc(l);
- end;
-end;
-
-{/\
- Rotate the given TPA with A radians.
-/\}
-
-Function RotatePoints(Const P: TPointArray; A, cx, cy: Extended): TPointArray ;
-
-Var
- I, L: Integer;
-
-Begin
- L := High(P);
- SetLength(Result, L + 1);
- For I := 0 To L Do
- Begin
- Result[I].X := Trunc(cx + cos(A) * (p[i].x - cx) - sin(A) * (p[i].y - cy));
- Result[I].Y := Trunc(cy + sin(A) * (p[i].x - cx) + cos(A) * (p[i].y - cy));
- End;
- // I recon its faster than Point().
-End;
-
-{/\
- Rotate the given Point with A radians.
-/\}
-
-Function RotatePoint(Const p: TPoint; angle, mx, my: Extended): TPoint; inline;
-
-Begin
- Result.X := Trunc(mx + cos(angle) * (p.x - mx) - sin(angle) * (p.y - my));
- Result.Y := Trunc(my + sin(angle) * (p.x - mx) + cos(angle) * (p.y- my));
-End;
-
-{/\
- Returns the edges of the given TPA.
-/\}
-
-function FindTPAEdges(p: TPointArray): TPointArray;
-var
- b: array of array of Boolean;
- i, x, y, l, c: Integer;
- Box: TBox;
-begin
- SetLength(Result, 0);
- l := Length(p);
- if (l = 0) then Exit;
- Box := GetTPABounds(p);
- x := (Box.x2 - Box.x1) + 3;
- y := (Box.y2 - Box.y1) + 3;
- SetLength(b, x);
- for i := 0 to x -1 do
- SetLength(b[i], y);
- for i := 0 to l -1 do
- b[p[i].x +1 - Box.x1][p[i].y +1 - Box.y1] := True;
- SetLength(Result, l);
- c := 0;
- for i := 0 to l -1 do
- begin
- x := -1;
- while (x <= 1) do
- begin
- for y := -1 to 1 do
- try
- if not b[p[i].x + 1 + x - Box.x1][p[i].y + 1 + y - Box.y1] then
- begin
- Result[c] := p[i];
- Inc(c);
- x := 2;
- Break;
- end;
- except end;
- Inc(x);
- end;
- end;
- SetLength(Result, c);
-end;
-
-{/\
- Results true if a point is in a TPointArray.
- Notes: In actuallys means IN the array, not in the box shaped by the array.
-/\}
-
-function PointInTPA(p: TPoint; arP: TPointArray): Boolean;
-var
- i, l: Integer;
-begin
- l := High(arP);
- for i := 0 to l do
- if (arP[i].x = p.x) and (arP[i].y = p.y) then
- Break;
- Result := i <> Length(arP);
-end;
-
-{/\
- Removes the given ClearPoints from arP.
-/\}
-
-function ClearTPAFromTPA(arP, ClearPoints: TPointArray): TPointArray;
-var
- i, j, l, l2: Integer;
-begin
- l := High(arP);
- l2 := High(ClearPoints);
- for i := 0 to l do
- begin
- for j := 0 to l2 do
- if (arP[i].x = ClearPoints[j].x) and (arP[i].y = ClearPoints[j].y) then
- Break;
-
- if (j = l2 + 1) then
- begin
- SetLength(Result, Length(Result) + 1);
- Result[High(Result)] := arP[i];
- end;
- end;
-end;
-
-{/\
- Removes all the doubles point from a TPA.
-/\}
-
-procedure ClearDoubleTPA(var TPA: TPointArray);
-var
- I, II, L: Integer;
- Swappie: TPoint;
-begin
- L := High(TPA);
- for I := 0 To L Do
- for II := I + 1 To L Do
- if ((TPA[I].X = TPA[II].X) And (TPA[I].Y = TPA[II].Y)) then
- begin
- Swappie := TPA[L];
- TPA[L] := TPA[II];
- TPA[II] := Swappie;
- L := L - 1;
- end;
- SetLength(TPA, L + 1);
-end;
-
-{/\
- Uses Box to define an area around TotalTPA.
- Every point that is not in TotalTPA, but is in Box, is added to the Result.
- \\ This can be very handy if you want for example, can get all the colors of the background, but not of the actual object.
- \\ If you pass this all the colors of the background, it will returns the points of the object.
-/\}
-
-Function ReturnPointsNotInTPA(Const TotalTPA: TPointArray; Box: TBox): TPointArray;
-
-Var
- X, Y, I: Integer;
- B: Array Of Array Of Boolean;
-
-Begin
- SetLength(Result, ((Box.X2 - Box.X1 + 1) * (Box.Y2 - Box.Y1 + 1)) - Length(TotalTPA));
-
- SetLength(B, Box.X2 - Box.X1 + 1, Box.Y2 - Box.Y1 + 1);
-
- For I := 0 To High(TotalTPA) Do
- B[TotalTPA[I].X - Box.X1][TotalTPA[I].Y - Box.Y1] := True;
-
- I := 0;
- For X := 0 To Box.X2 - Box.X1 Do
- For Y := 0 To Box.Y2 - Box.Y1 Do
- If Not B[X][Y] Then
- Begin
- Result[I].X := X + Box.X1;
- Result[I].Y := Y + Box.Y1;
- I := I + 1;
- End;
- SetLength(B, 0);
-End;
-
-{/\
- Sorts a TPointArray by either X or Y. You have to define the max Point as well.
-/\}
-
-Procedure TPACountSort(Var TPA: TPointArray;const max: TPoint;Const SortOnX : Boolean);
-Var
- c: Array Of Array Of Integer;
- I, II, III, hTPA, cc: Integer;
-Begin
- hTPA := High(TPA);
- if hTPA < 1 then
- Exit;
- SetLength(c, max.X + 1,max.Y + 1);
- For I := 0 To hTPA Do
- c[TPA[I].x][TPA[I].y] := c[TPA[i].x][TPA[i].y] + 1;
-
- cc := 0;
- if SortOnX then
- begin
- For I := 0 To max.X Do
- For II := 0 To max.Y Do
- Begin
- For III := 0 To c[I][II] - 1 Do
- Begin
- TPA[cc].x := I;
- TPA[cc].y := II;
- cc := cc + 1;
- End;
- End;
- end else
- begin;
- For II := 0 To max.Y Do
- For I := 0 To max.X Do
- Begin
- For III := 0 To c[I][II] - 1 Do
- Begin
- TPA[cc].x := I;
- TPA[cc].y := II;
- cc := cc + 1;
- End;
- End;
- end;
-End;
-
-{/\
- Sorts a TPointArray by either X or Y. Allows one to pass a Base.
-/\}
-
-Procedure TPACountSortBase(Var TPA: TPointArray;const maxx, base: TPoint; const SortOnX : Boolean);
-Var
- c: Array Of Array Of Integer;
- I, II, III, hTPA, cc: Integer;
- Max : TPoint;
-Begin
- hTPA := High(TPA);
- if hTPA < 1 then
- Exit;
- max.X := maxx.X - base.X;
- max.Y := maxx.Y - base.Y;
- SetLength(c, max.X + 1,max.Y + 1);
- hTPA := High(TPA);
- For I := 0 To hTPA Do
- c[TPA[I].x - base.X][TPA[I].y - base.Y] := c[TPA[i].x- base.X][TPA[i].y- base.Y] + 1;
-
- cc := 0;
- if SortOnX then
- begin
- For I := 0 To max.X Do
- For II := 0 To max.Y Do
- Begin
- For III := 0 To c[I][II] - 1 Do
- Begin
- TPA[cc].x := I + base.X;
- TPA[cc].y := II + base.Y;
- cc := cc + 1;
- End;
- End;
- end else
- begin;
- For II := 0 To max.Y Do
- For I := 0 To max.X Do
- Begin
- For III := 0 To c[I][II] - 1 Do
- Begin
- TPA[cc].x := I + base.X;
- TPA[cc].y := II + base.Y;
- cc := cc + 1;
- End;
- End;
- end;
-End;
-
-end.
-
+{
+ This file is part of the Mufasa Macro Library (MML)
+ Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer
+
+ MML is free software: you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ MML is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with MML. If not, see .
+
+ See the file COPYING, included in this distribution,
+ for details about the copyright.
+
+ TPA functions for the Mufasa Macro Library
+}
+unit tpa;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, mufasatypes;
+
+function FastTPASort(TPA: TPointArray; Dists: TIntegerArray; maxDist: Integer; CloseFirst: Boolean): TPointArray;
+
+//Start Wizzyplugin
+procedure tSwap(var a, b: TPoint);
+procedure tpaSwap(var a, b: TPointArray);
+procedure SwapE(var a, b: Extended);
+procedure RAaSTPAEx(var a: TPointArray; const w, h: Integer);
+procedure RAaSTPA(var a: TPointArray; const Dist: Integer);
+function NearbyPointInArrayEx(const P: TPoint; w, h:Integer; a: TPointArray): Boolean;
+function NearbyPointInArray(const P: TPoint; Dist:Integer; a: TPointArray): Boolean;
+function ReArrangeandShortenArrayEx(a: TPointArray; w, h: Integer): TPointArray;
+function ReArrangeandShortenArray(a: TPointArray; Dist: Integer): TPointArray;
+function TPAtoATPAEx(TPA: TPointArray; w, h: Integer): T2DPointArray;
+function TPAtoATPA(TPA: TPointArray; Dist: Integer): T2DPointArray;
+procedure QuickTPASort(var A: TIntegerArray; var B: TPointArray; iLo, iHi: Integer; SortUp: Boolean);
+procedure QuickATPASort(var A: TIntegerArray; var B: T2DPointArray; iLo, iHi: Integer; SortUp: Boolean);
+procedure SortTPAFrom(var a: TPointArray; const From: TPoint);
+procedure SortATPAFrom(var a: T2DPointArray; const From: TPoint);
+procedure SortATPAFromFirstPoint(var a: T2DPointArray; const From: TPoint);
+procedure InvertTPA(var a: TPointArray);
+procedure InvertATPA(var a: T2DPointArray);
+function MiddleTPAEx(TPA: TPointArray; var x, y: Integer): Boolean;
+function MiddleTPA(tpa: TPointArray): TPoint;
+procedure SortATPASize(var a: T2DPointArray; const BigFirst: Boolean);
+procedure SortATPAFromSize(var a: T2DPointArray; const Size: Integer; CloseFirst: Boolean);
+function CombineTPA(Ar1, Ar2: TPointArray): TPointArray;
+function CombineIntArray(Ar1, Ar2: TIntegerArray): TIntegerArray;
+function InIntArrayEx(a: TIntegerArray; var Where: Integer; const Number: Integer): Boolean;
+function InIntArray(a: TIntegerArray; Number: Integer): Boolean;
+procedure ClearSameIntegers(var a: TIntegerArray);
+procedure ClearSameIntegersAndTPA(var a: TIntegerArray; var p: TPointArray);
+function SplitTPAEx(arr: TPointArray; w, h: Integer): T2DPointArray;
+function SplitTPA(arr: TPointArray; Dist: Integer): T2DPointArray;
+procedure FilterPointsPie(var Points: TPointArray; const SD, ED, MinR, MaxR: Extended; Mx, My: Integer);
+function RemoveDistTPointArray(x, y, dist: Integer; ThePoints: TPointArray; RemoveHigher: Boolean): TPointArray;
+function GetATPABounds(ATPA: T2DPointArray): TBox;
+function GetTPABounds(TPA: TPointArray): TBox;
+function FindTPAinTPA(SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean;
+function FindTextTPAinTPA(Height : integer; SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean;
+function FindGapsTPA(TPA: TPointArray; MinPixels: Integer): T2DPointArray;
+procedure SortCircleWise(var tpa: TPointArray; const cx, cy, StartDegree: Integer; SortUp, ClockWise: Boolean);
+procedure LinearSort(var tpa: TPointArray; cx, cy, sd: Integer; SortUp: Boolean);
+Function MergeATPA(ATPA : T2DPointArray) : TPointArray;
+function TPAFromBox(const Box : TBox) : TPointArray;
+Function RotatePoints(Const P: TPointArray; A, cx, cy: Extended): TPointArray ;
+Function RotatePoint(Const p: TPoint; angle, mx, my: Extended): TPoint; inline;
+function FindTPAEdges(p: TPointArray): TPointArray;
+function PointInTPA(p: TPoint; arP: TPointArray): Boolean;
+function ClearTPAFromTPA(arP, ClearPoints: TPointArray): TPointArray;
+procedure ClearDoubleTPA(var TPA: TPointArray);
+Function ReturnPointsNotInTPA(Const TotalTPA: TPointArray; Box: TBox): TPointArray;
+Procedure TPACountSort(Var TPA: TPointArray;const max: TPoint;Const SortOnX : Boolean);
+Procedure TPACountSortBase(Var TPA: TPointArray;const maxx, base: TPoint; const SortOnX : Boolean);
+
+implementation
+
+uses
+ math;
+
+
+
+
+{/\
+ Very Fast TPA Sort, uses an adepted CountSort algorithm.
+/\}
+
+Function FastTPASort(TPA: TPointArray; Dists: TIntegerArray; maxDist: Integer; CloseFirst: Boolean): TPointArray;
+
+{
+ If you want to understand this algorithm, it might be helpful to read about
+ CountSort. This algorithm is quite similar to CountSort.
+}
+
+Var
+ Oc, D: TIntegerArray;
+ I, H, J: Integer;
+ ind: array of array of integer;
+
+Begin
+ SetLength(Oc, maxDist + 1); // Oc stores the occurances of each distance.
+ H := High(Dists); // The amount of values in the given Array of Points...
+ // We store it instead of calling High(Dists) each time.
+
+ // Get the occurance of each distance, and store it in Oc.
+ // We need the occurances of each distance, so we can later on set the 2d Array
+ // to it's proper length.
+ For I := 0 To H Do
+ Oc[Dists[I]] := Oc[Dists[I]] + 1;
+
+ // What we are basically going to do now is the following:
+ // Sort the points by their distances using countsort.
+ // But because (-2, -2) and (2, 2) have the same distance from (0, 0), we also
+ // store the index in the array 'TPA', which contains the actual points.
+ // This way we can retreive the actuals points.
+
+ // D nothing but a counter. It contains the amount of points (indices) stored
+ // for EACH distance, so it's length is equal to the amount of Distances.
+ // ind is the array that has as first index the Distance. The second depth of
+ // the array is the index which is used to retreive the original point.
+
+ SetLength(D, maxDist + 1);
+ SetLength(ind, maxDist + 1);
+ For I := 0 To maxDist Do // set the ind length of each ind[distance] to Oc[distance]
+ SetLength(ind[i], Oc[i] + 1);
+ For I := 0 To H Do // Performs the actual index sorting
+ Begin
+ // put an index (of Dists AND TPA) into a distance array.
+ ind[Dists[I]][D[Dists[I]]] := I;
+ // inc by one, so we won't override previous indexes.
+ D[Dists[i]] := D[Dists[i]] + 1;
+ End;
+
+ // Here we are back to the CountSort style of writing back.
+ // Now we are going to write back to the Result.
+ // The Result's length is obviously of the same length as 'TPA'.
+ SetLength(Result, H + 1);
+ H := 0;
+
+ // CloseFirst just means: Start writing from dist 0 to maxDist, or
+ // start writing from maxDist to dist 0. The first one places the closest points
+ // at the start of the result. The higher the index, the more far away the point.
+ // Not Closefirst means put the most far away point in Result first.
+ If CloseFirst Then
+ Begin
+ For I := 0 To maxDist Do // Put back to result
+ For J := 0 To oC[I] - 1 Do
+ Begin
+ Result[H] := TPA[ind[I][J]];
+ H := H + 1;
+ End;
+ End
+ Else
+ For I := maxDist Downto 0 Do // Put back to result
+ For J := 0 To oC[I] - 1 Do
+ Begin
+ Result[H] := TPA[ind[I][J]];
+ H := H + 1;
+ End;
+ // Voila!
+End;
+
+const
+ flnC=545947;
+ fsqrtA:single=0.5;
+
+{$ASMMODE INTEL}
+function fsqrt(x: Single): Single;
+begin
+ asm
+ sub dword ptr x, ($3F800000-flnC)
+ fild dword ptr x
+ fmul fsqrtA
+ fistp dword ptr x
+ add dword ptr x,($3F800000-flnC)
+ fld x
+ end;
+end;
+
+procedure tSwap(var a, b: TPoint);
+var
+ c: TPoint;
+begin
+ c := a;
+ a := b;
+ b := c;
+end;
+
+procedure tpaSwap(var a, b: TPointArray);
+var
+ c: TPointArray;
+begin
+ c := a;
+ a := b;
+ b := c;
+end;
+
+procedure SwapE(var a, b: Extended);
+var
+ c: extended;
+begin
+ c := a;
+ a := b;
+ b := c;
+end;
+
+{/\
+ Leaves one point per box with side lengths W and H to the TPA.
+/\}
+
+procedure RAaSTPAEx(var a: TPointArray; const w, h: Integer);
+var
+ i, c, NoTP, l: Integer;
+ t: TPoint;
+ b: boolean;
+
+begin
+ b:=false;
+ NoTP := 0;
+ l := High(a);
+ for i := 0 to l do
+ begin
+ for c := 0 to NoTP - 1 do
+ if (Abs(a[i].x - a[c].x) <= w) and (Abs(a[i].y - a[c].y) <= h) then
+ begin
+ b := true;
+ Break;
+ end;
+ if not b then
+ begin
+ t := a[i];
+ a[i] := a[NoTP];
+ a[NoTP] := t;
+ Inc(NoTP);
+ end;
+ end;
+ SetLength(a, NoTP);
+end;
+
+{/\
+ Leaves one point per box with the side length Dist.
+/\}
+
+procedure RAaSTPA(var a: TPointArray; const Dist: Integer);
+var
+ i, c, NoTP, l: Integer;
+ t: TPoint;
+ b: boolean;
+
+begin
+ b := false;
+ NoTP := 0;
+ l := High(a);
+ for i := 0 to l do
+ begin
+ for c := 0 to NoTP - 1 do
+ if (Round(fSqrt(Sqr(a[i].x - a[c].x) + Sqr(a[i].y - a[c].y))) <= Dist) then
+ begin
+ b:=true;
+ Break;
+ end;
+ if (c >= NoTP) then
+ begin
+ t := a[i];
+ a[i] := a[NoTP];
+ a[NoTP] := t;
+ Inc(NoTP);
+ end;
+ end;
+ SetLength(a, NoTP);
+end;
+
+{/\
+ Returns true if the point P is near a point in the TPA a with the max X and Y distances W and H.
+/\}
+
+function NearbyPointInArrayEx(const P: TPoint; w, h:Integer; a: TPointArray): Boolean;
+var
+ i, l: Integer;
+begin
+ Result := False;
+ l := High(a);
+ for i := 0 to l do
+ if (Abs(P.x - a[i].x) <= w) and (Abs(P.y - a[i].y) <= h) then
+ begin
+ Result := True;
+ Exit;
+ end;
+end;
+
+{/\
+ Returns true if the point P is near a point in the TPA a with the max distance Dist.
+/\}
+
+function NearbyPointInArray(const P: TPoint; Dist:Integer; a: TPointArray): Boolean;
+var
+ i, l: Integer;
+begin
+ Result := False;
+ l := High(a);
+ for i := 0 to l do
+ if (Round(fSqrt(Sqr(P.x - a[i].x) + Sqr(P.y - a[i].y))) <= Dist) then
+ begin
+ Result := True;
+ Exit;
+ end;
+end;
+
+{/\
+ Results the TPointArray a with one point per box with side lengths W and H left.
+/\}
+
+function ReArrangeandShortenArrayEx(a: TPointArray; w, h: Integer): TPointArray;
+var
+ i, t, c, l: Integer;
+begin
+ l := High(a);
+ c := 0;
+ SetLength(Result, l + 1);
+ for i := 0 to l do
+ begin
+ for t := 0 to c -1 do
+ if (Abs(Result[t].x - a[i].x) <= w) and (Abs(Result[t].y - a[i].y) <= h) then
+ Break;
+ if (t >= c) then
+ begin
+ Result[c] := a[i];
+ Inc(c);
+ end;
+ end;
+ SetLength(Result, c);
+end;
+
+{/\
+ Results the TPointArray a with one point per box with side length Dist left.
+/\}
+
+function ReArrangeandShortenArray(a: TPointArray; Dist: Integer): TPointArray;
+var
+ i, t, c, l: Integer;
+begin
+ l := High(a);
+ c := 0;
+ SetLength(Result, l + 1);
+ for i := 0 to l do
+ begin
+ for t := 0 to c -1 do
+ if (Round(fSqrt(Sqr(Result[t].x - a[i].x) + Sqr(Result[t].y - a[i].y))) <= Dist) then
+ Break;
+ if (t >= c) then
+ begin
+ Result[c] := a[i];
+ Inc(c);
+ end;
+ end;
+ SetLength(Result, c);
+end;
+
+{/\
+ Splits the TPA to boxes with sidelengths W and H and results them as a T2DPointArray.
+/\}
+
+function TPAtoATPAEx(TPA: TPointArray; w, h: Integer): T2DPointArray;
+var
+ a, b, c, l: LongInt;
+begin
+ SetLength(Result, 0);
+ l := High(TPA);
+ c := 0;
+ for a := 0 to l do
+ begin
+ for b := 0 to c -1 do
+ if (Abs(TPA[a].X - Result[b][0].X) <= w) and (Abs(TPA[a].Y - Result[b][0].Y) <= h) then
+ Break;
+ if (b < c) then
+ begin
+ SetLength(Result[b], Length(Result[b]) + 1);
+ Result[b][High(Result[b])] := TPA[a];
+ end else
+ begin
+ SetLength(Result, c + 1);
+ SetLength(Result[c], 1);
+ Result[c][0] := TPA[a];
+ Inc(c);
+ end;
+ end;
+end;
+
+{/\
+ Splits the TPA to boxes with sidelength Dist and results them as a T2DPointArray.
+/\}
+
+function TPAtoATPA(TPA: TPointArray; Dist: Integer): T2DPointArray;
+var
+ a, b, c, l: LongInt;
+begin
+ SetLength(Result, 0);
+ l := High(tpa);
+ c := 0;
+ for a := 0 to l do
+ begin
+ for b := 0 to c -1 do
+ if (Round(fSqrt(Sqr(TPA[a].X - Result[b][0].X) + Sqr(TPA[a].Y - Result[b][0].Y))) <= Dist) then
+ Break;
+ if (b < c) then
+ begin
+ SetLength(Result[b], Length(Result[b]) + 1);
+ Result[b][High(Result[b])] := TPA[a];
+ end else
+ begin
+ SetLength(Result, c + 1);
+ SetLength(Result[c], 1);
+ Result[c][0] := TPA[a];
+ Inc(c);
+ end;
+ end;
+end;
+
+{/\
+ Sorts the given TPointArray.
+/\}
+
+procedure QuickTPASort(var A: TIntegerArray; var B: TPointArray; iLo, iHi: Integer; SortUp: Boolean);
+var
+ Lo, Hi, Mid, T: Integer;
+ TP: TPoint;
+begin
+ if (Length(A) <> Length(B)) then Exit;
+ Lo := iLo;
+ Hi := iHi;
+ Mid := A[(Lo + Hi) shr 1];
+ repeat
+ if SortUp then
+ begin
+ while (A[Lo] < Mid) do Inc(Lo);
+ while (A[Hi] > Mid) do Dec(Hi);
+ end else
+ begin
+ while (A[Lo] > Mid) do Inc(Lo);
+ while (A[Hi] < Mid) do Dec(Hi);
+ end;
+ if (Lo <= Hi) then
+ begin
+ T := A[Lo];
+ A[Lo] := A[Hi];
+ A[Hi] := T;
+ TP := B[Lo];
+ B[Lo] := B[Hi];
+ B[Hi] := TP;
+ Inc(Lo);
+ Dec(Hi);
+ end;
+ until Lo > Hi;
+ if (Hi > iLo) then QuickTPASort(A, B, iLo, Hi, SortUp);
+ if (Lo < iHi) then QuickTPASort(A, B, Lo, iHi, SortUp);
+end;
+
+{/\
+ Sorts the given T2DPointArray.
+/\}
+
+procedure QuickATPASort(var A: TIntegerArray; var B: T2DPointArray; iLo, iHi: Integer; SortUp: Boolean);
+var
+ Lo, Hi, Mid, T: Integer;
+ TP: TPointArray;
+begin
+ if (Length(A) <> Length(B)) then Exit;
+ Lo := iLo;
+ Hi := iHi;
+ Mid := A[(Lo + Hi) shr 1];
+ repeat
+ if SortUp then
+ begin
+ while (A[Lo] < Mid) do Inc(Lo);
+ while (A[Hi] > Mid) do Dec(Hi);
+ end else
+ begin
+ while (A[Lo] > Mid) do Inc(Lo);
+ while (A[Hi] < Mid) do Dec(Hi);
+ end;
+ if (Lo <= Hi) then
+ begin
+ T := A[Lo];
+ A[Lo] := A[Hi];
+ A[Hi] := T;
+ TP := B[Lo];
+ B[Lo] := B[Hi];
+ B[Hi] := TP;
+ Inc(Lo);
+ Dec(Hi);
+ end;
+ until Lo > Hi;
+ if (Hi > iLo) then QuickATPASort(A, B, iLo, Hi, SortUp);
+ if (Lo < iHi) then QuickATPASort(A, B, Lo, iHi, SortUp);
+end;
+
+{/\
+ Sorts the TPointArray a from the point From.
+ Closest one to the point is [0], second closest is [1] etc.
+/\}
+
+procedure SortTPAFrom(var a: TPointArray; const From: TPoint);
+var
+ i, l: Integer;
+ DistArr: TIntegerArray;
+begin
+ l := High(a);
+ if (l < 0) then Exit;
+ SetLength(DistArr, l + 1);
+ for i := 0 to l do
+ DistArr[i] := Round(Sqr(From.x - a[i].x) + Sqr(From.y - a[i].y));
+ QuickTPASort(DistArr, a, 0, l, True);
+end;
+
+{/\
+ Sorts the T2DPointArray a from the point From.
+/\}
+
+procedure SortATPAFrom(var a: T2DPointArray; const From: TPoint);
+var
+ i, l: Integer;
+begin
+ l := High(a);
+ if (l < 0) then Exit;
+ for i := 0 to l do
+ SortTPAFrom(a[i], From);
+end;
+
+{/\
+ Sorts the T2DPointArray a from the point From.
+/\}
+
+procedure SortATPAFromFirstPoint(var a: T2DPointArray; const From: TPoint);
+var
+ i, l: Integer;
+ DistArr: TIntegerArray;
+begin
+ //writeln('hoi0');
+ l := High(a);
+ if (l < 0) then Exit;
+ //writeln('hoi1');
+ SetLength(DistArr, l + 1);
+ for i := 0 to l do
+ DistArr[i] := Round(Sqr(From.x - a[i][0].x) + Sqr(From.y - a[i][0].y));
+ //writeln('hoi2');
+ QuickATPASort(DistArr, a, 0, l, True);
+ //writeln('hoi3');
+end;
+
+{/\
+ Inverts / Reverses the TPointArray a.
+/\}
+
+procedure InvertTPA(var a: TPointArray);
+var
+ i, l: Integer;
+ b: tpointarray;
+begin
+ l := High(a);
+ if (l < 0) then Exit;
+ b := Copy(a);
+ for i := l downto 0 Do
+ a[l - i] := b[i];
+end;
+
+{/\
+ Inverts / Reverts the T2DPointArray a.
+/\}
+
+procedure InvertATPA(var a: T2DPointArray);
+var
+ i, l: Integer;
+ b: T2DPointArray;
+begin
+ l := High(a);
+ if (l < 0) then Exit;
+ b := Copy(a);
+ for i := l downto 0 do
+ a[l - i] := b[i];
+end;
+
+{/\
+ Stores the coordinates of the middle of the TPointArray a to X and Y.
+/\}
+
+function MiddleTPAEx(TPA: TPointArray; var x, y: Integer): Boolean;
+var
+ i, l: Integer;
+begin
+ Result := False;
+ l := High(tpa);
+ if (l < 0) then Exit;
+ x := 0;
+ y := 0;
+ for i := 0 to l do
+ begin
+ x := x + tpa[i].x;
+ y := y + tpa[i].y;
+ end;
+ x := x div (l + 1);
+ y := y div (l + 1);
+ Result := True;
+end;
+
+{/\
+ Returns the middle of the TPointArray tpa.
+/\}
+
+function MiddleTPA(tpa: TPointArray): TPoint;
+var
+ i, l: Integer;
+begin
+ l := High(tpa);
+ if (l < 0) then Exit;
+ Result.x := 0;
+ Result.y := 0;
+ for i := 0 to l do
+ begin
+ Result.x := Result.x + tpa[i].x;
+ Result.y := Result.y + tpa[i].y;
+ end;
+ Result.x := Result.x div (l + 1);
+ Result.y := Result.y div (l + 1);
+end;
+
+{/\
+ Sorts the T2DPointArray a from either largest or smallest, by the amount of points in the TPAs.
+/\}
+
+procedure SortATPASize(var a: T2DPointArray; const BigFirst: Boolean);
+var
+ i, l: Integer;
+ SizeArr: TIntegerArray;
+begin
+ l := High(a);
+ if (l < 0) then Exit;
+ SetLength(SizeArr, l + 1);
+ for i := 0 to l do
+ SizeArr[i] := Length(a[i]);
+ QuickATPASort(SizeArr, a, 0, l, not BigFirst);
+end;
+
+{/\
+ Combines the TPointArrays Ar1 and Ar2, and results the combination.
+/\}
+
+procedure SortATPAFromSize(var a: T2DPointArray; const Size: Integer; CloseFirst: Boolean);
+var
+ i, l: Integer;
+ SizeArr: TIntegerArray;
+begin
+ l := High(a);
+ if (l < 0) then Exit;
+ SetLength(SizeArr, l + 1);
+ for i := 0 to l do
+ SizeArr[i] := Abs(Length(a[i]) - Size);
+ QuickATPASort(SizeArr, a, 0, l, CloseFirst);
+end;
+
+{/\
+ Combines the TPointArrays Ar1 and Ar2, and results the combination.
+/\}
+
+function CombineTPA(Ar1, Ar2: TPointArray): TPointArray;
+var
+ i, l1, l2: Integer;
+begin
+ Result := Copy(Ar1);
+ l1 := Length(Result);
+ l2 := Length(Ar2);
+ SetLength(Result, l1 + l2);
+ for i := 0 to l2 -1 do
+ Result[i + l1] := Ar2[i];
+end;
+
+{/\
+ Combines the TIntegerArrays Ar1 and Ar2, and results the combination.
+/\}
+
+function CombineIntArray(Ar1, Ar2: TIntegerArray): TIntegerArray;
+var
+ i, l1, l2: Integer;
+begin
+ Result := Copy(Ar1);
+ l1 := Length(Result);
+ l2 := Length(Ar2);
+ SetLength(Result, l1 + l2);
+ for i := 0 to l2 -1 do
+ Result[i + l1] := Ar2[i];
+end;
+
+{/\
+ Returns true if the integer Number was found in the integer array a, and stores the index to Where.
+/\}
+
+function InIntArrayEx(a: TIntegerArray; var Where: Integer; const Number: Integer): Boolean;
+var
+ i, l: Integer;
+begin
+ Result := False;
+ l := High(a);
+ for i := 0 to l do
+ if (a[i] = Number) then
+ begin
+ Where := i;
+ Result := True;
+ Exit;
+ end;
+end;
+
+{/\
+ Returns true if the integer Number was found in the integer array a.
+/\}
+
+function InIntArray(a: TIntegerArray; Number: Integer): Boolean;
+var
+ i, l: Integer;
+begin
+ Result := False;
+ l := High(a);
+ for i := 0 to l do
+ if (a[i] = Number) then
+ begin
+ Result := True;
+ Exit;
+ end;
+end;
+
+{/\
+ Clears the duplicates in the integer array a.
+/\}
+
+procedure ClearSameIntegers(var a: TIntegerArray);
+var
+ i, t, c, l: Integer;
+ b: TIntegerArray;
+begin
+ b := Copy(a);
+ l := High(b);
+ c := 0;
+ for i := 0 to l do
+ begin
+ for t := 0 to c -1 do
+ if (b[i] = a[t]) then
+ Break;
+ if (t >= c) then
+ begin
+ a[c] := b[i];
+ Inc(c);
+ end;
+ end;
+ SetLength(a, c);
+end;
+
+{/\
+ Clears the duplicates in the integer array a and the TPointArray p.
+/\}
+
+procedure ClearSameIntegersAndTPA(var a: TIntegerArray; var p: TPointArray);
+var
+ i, t, c, l: Integer;
+ b: TIntegerArray;
+begin
+ b := Copy(a);
+ l := High(b);
+ c := 0;
+ for i := 0 to l do
+ begin
+ for t := 0 to c -1 do
+ if (b[i] = a[t]) then
+ Break;
+ if (t >= c) then
+ begin
+ SetLength(a, c +1);
+ a[c] := b[i];
+ p[c] := p[i];
+ Inc(c);
+ end;
+ end;
+ SetLength(p, c);
+ SetLength(a, c);
+end;
+
+{/\
+ Splits the points with max X and Y distances W and H to their own TPointArrays.
+/\}
+
+function SplitTPAEx(arr: TPointArray; w, h: Integer): T2DPointArray;
+var
+ t1, t2, c, ec, tc, l: Integer;
+ tpa: TPointArray;
+begin
+ tpa := Copy(arr);
+ l := High(tpa);
+ if (l < 0) then Exit;
+ SetLength(Result, l + 1);
+ c := 0;
+ ec := 0;
+ while ((l - ec) >= 0) do
+ begin
+ SetLength(Result[c], 1);
+ Result[c][0] := tpa[0];
+ tpa[0] := tpa[l - ec];
+ Inc(ec);
+ tc := 1;
+ t1 := 0;
+ while (t1 < tc) do
+ begin
+ t2 := 0;
+ while (t2 <= (l - ec)) do
+ begin
+ if (Abs(Result[c][t1].x - tpa[t2].x) <= w) and (Abs(Result[c][t1].y - tpa[t2].y) <= h) then
+ begin
+ SetLength(Result[c], tc +1);
+ Result[c][tc] := tpa[t2];
+ tpa[t2] := tpa[l - ec];
+ Inc(ec);
+ Inc(tc);
+ Dec(t2);
+ end;
+ Inc(t2);
+ end;
+ Inc(t1);
+ end;
+ Inc(c);
+ end;
+ SetLength(Result, c);
+end;
+
+{/\
+ Splits the points with max distance Dist to their own TPointArrays.
+ Dist 1 puts the points that are next to eachother to their own arrays.
+/\}
+
+function SplitTPA(arr: TPointArray; Dist: Integer): T2DPointArray;
+var
+ t1, t2, c, ec, tc, l: Integer;
+ tpa: TPointArray;
+begin
+ tpa := Copy(arr);
+ l := High(tpa);
+ if (l < 0) then Exit;
+ SetLength(Result, l + 1);
+ c := 0;
+ ec := 0;
+ while ((l - ec) >= 0) do
+ begin
+ SetLength(Result[c], 1);
+ Result[c][0] := tpa[0];
+ tpa[0] := tpa[l - ec];
+ Inc(ec);
+ tc := 1;
+ t1 := 0;
+ while (t1 < tc) do
+ begin
+ t2 := 0;
+ while (t2 <= (l - ec)) do
+ begin
+ if (Round(Sqrt(Sqr(Result[c][t1].x - tpa[t2].x) + Sqr(Result[c][t1].y - tpa[t2].y))) <= Dist) then
+ begin
+ SetLength(Result[c], tc +1);
+ Result[c][tc] := tpa[t2];
+ tpa[t2] := tpa[l - ec];
+ Inc(ec);
+ Inc(tc);
+ Dec(t2);
+ end;
+ Inc(t2);
+ end;
+ Inc(t1);
+ end;
+ Inc(c);
+ end;
+ SetLength(Result, c);
+end;
+
+{/\
+ Removes the points in the TPointArray Points that are not within the degrees
+ \\ SD (StartDegree) and ED (EndDegree) and the distances MinR (MinRadius) and
+ \\ MaxR (MaxRadius) from the origin (Mx, My).
+/\}
+
+procedure FilterPointsPie(var Points: TPointArray; const SD, ED, MinR, MaxR: Extended; Mx, My: Integer);
+const
+ i180Pi = 57.29577951;
+var
+ G: TPointArray;
+ I, L, T: Integer;
+ D, StartD, EndD: Extended;
+ cWise: Boolean;
+begin
+ T := High(Points);
+ if (T < 0) then Exit;
+ SetLength(G, T + 1);
+ L := 0;
+ StartD := SD;
+ EndD := ED;
+ cWise := StartD > EndD;
+ while StartD > 360.0 do
+ StartD := StartD - 360.0;
+ while EndD > 360.0 do
+ EndD := EndD - 360.0;
+ while StartD < 0.0 do
+ StartD := StartD + 360.0;
+ while EndD < 0.0 do
+ EndD := EndD + 360.0;
+ if StartD > EndD then
+ SwapE(StartD, EndD);
+ for I := 0 to T do
+ begin
+ D := fSqrt(Sqr(Points[I].X - Mx) + Sqr(Points[I].Y - My));
+ if( D <= MinR) or (D >= MaxR) then
+ Continue;
+ D := (ArcTan2(Points[I].Y - My, Points[I].X - Mx) * i180Pi) + 90;
+ if D < 0.0 then
+ D := D + 360.0;
+ if (not ((StartD <= D) and (EndD >= D))) xor CWise then
+ Continue;
+ G[L] := Points[I];
+ Inc(L);
+ end;
+ SetLength(G, L);
+ Points := G;
+end;
+
+{/\
+ Removes the points that are inside or outside the distance Dist from the point (x, y) from the TPointArray ThePoints.
+/\}
+
+function RemoveDistTPointArray(x, y, dist: Integer; ThePoints: TPointArray; RemoveHigher: Boolean): TPointArray;
+var
+ I, L, LL: integer;
+begin;
+ L := 0;
+ LL := Length(ThePoints) -1;
+ SetLength(Result, LL + 1);
+ if RemoveHigher then
+ begin;
+ for I := 0 to LL do
+ if not (Round(fSqrt(sqr(ThePoints[i].x - x)+sqr(ThePoints[i].y - y))) > Dist) then
+ begin;
+ Result[L] := ThePoints[i];
+ L := L + 1;
+ end;
+ end else
+ begin;
+ for I := 0 to LL do
+ if not (Round(fSqrt(sqr(ThePoints[i].x - x)+sqr(ThePoints[i].y - y))) < Dist) then
+ begin;
+ Result[L] := ThePoints[i];
+ L := L + 1;
+ end;
+ end;
+ SetLength(Result,L);
+end;
+
+{/\
+ Returns the boundaries of the ATPA as a TBox.
+/\}
+
+function GetATPABounds(ATPA: T2DPointArray): TBox;
+var
+ I,II,L2,L : Integer;
+begin;
+ L := High(ATPA);
+ if (l < 0) then Exit;
+ For I := 0 to L do
+ if Length(ATPA[I]) > 0 then
+ begin;
+ Result.x1 := ATPA[I][0].x;
+ Result.y1 := ATPA[I][0].y;
+ Result.x2 := ATPA[I][0].x;
+ Result.y2 := ATPA[I][0].y;
+ end;
+ for I := 0 to L do
+ begin;
+ L2 := High(ATPA[I]);
+ for II := 0 to L2 do
+ begin;
+ if ATPA[i][II].x > Result.x2 then
+ Result.x2 := ATPA[i][II].x
+ else if ATPA[i][II].x < Result.x1 then
+ Result.x1 := ATPA[i][II].x;
+ if ATPA[i][II].y > Result.y2 then
+ Result.y2 := ATPA[i][II].y
+ else if ATPA[i][II].y < Result.y1 then
+ Result.y1 := ATPA[i][II].y;
+ end;
+ end;
+end;
+
+{/\
+ Returns the boundaries of the TPA as a TBox.
+/\}
+
+function GetTPABounds(TPA: TPointArray): TBox;
+var
+ I,L : Integer;
+begin;
+ L := High(TPA);
+ if (l < 0) then Exit;
+ Result.x1 := TPA[0].x;
+ Result.y1 := TPA[0].y;
+ Result.x2 := TPA[0].x;
+ Result.y2 := TPA[0].y;
+ for I:= 1 to L do
+ begin;
+ if TPA[i].x > Result.x2 then
+ Result.x2 := TPA[i].x
+ else if TPA[i].x < Result.x1 then
+ Result.x1 := TPA[i].x;
+ if TPA[i].y > Result.y2 then
+ Result.y2 := TPA[i].y
+ else if TPA[i].y < Result.y1 then
+ Result.y1 := TPA[i].y;
+ end;
+end;
+
+{/\
+ Looks for the TPA SearchTPA in the TPA TotalTPA and returns the matched points
+ \\ to the TPA Matches. Returns true if there were atleast one match(es).
+/\}
+
+function FindTPAinTPA(SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean;
+var
+ Len, I,II,LenSearch,xOff,yOff : integer;
+ tx,ty,MatchCount : integer;
+ Screen : Array of Array of Boolean;
+ ScreenBox,SearchBox : TBox;
+begin;
+ Result := False;
+ Len := High(TotalTPA);
+ LenSearch := High(SearchTPA);
+ if LenSearch < 0 then Exit;
+ if Len < LenSearch then Exit;
+ MatchCount := 0;
+ ScreenBox := GetTPABounds(TotalTPA);
+ SearchBox := GetTPABounds(SearchTPA);
+ try
+ SetLength(Screen,ScreenBox.x2 + 1,ScreenBox.y2 + 1);
+ except
+ Exit;
+ end;
+ if (SearchBox.x1 > 0) or (SearchBox.y1 > 0) then
+ begin;
+ for I := 0 to LenSearch do
+ begin;
+ SearchTPA[I].x := SearchTPA[I].x - SearchBox.x1;
+ SearchTPA[I].y := SearchTPA[I].y - SearchBox.y1;
+ end;
+ SearchBox.x2 := SearchBox.x2 - SearchBox.x1;
+ SearchBox.y2 := SearchBox.y2 - SearchBox.y1;
+ SearchBox.x1 := 0;
+ SearchBox.y1 := 0;
+ end;
+ xOff := SearchBox.x2;
+ yOff := SearchBox.y2;
+ for I := 0 to LenSearch do
+ begin;
+ if (SearchTPA[I].x = 0) and (SearchTPA[I].y < yOff) then
+ yOff := SearchTPA[I].y;
+ if (SearchTPA[I].y = 0) and (SearchTPA[I].x < xOff) then
+ xOff := SearchTPA[I].x;
+ end;
+ for I := 0 to Len do
+ Screen[TotalTPA[I].x][TotalTPA[I].y] := True;
+ for I := 0 to Len do
+ begin;
+ tx := TotalTPA[I].x - xOff;
+ ty := TotalTPA[I].y;// - yOff;
+ if tx > 0 then
+ if ty > 0 then
+ if ((SearchBox.x2 + tx) <= ScreenBox.x2) and ((SearchBox.y2 + ty) <= ScreenBox.y2) then
+ begin;
+ For II := 0 to LenSearch do
+ if Screen[tx + SearchTPA[II].x ][ty + SearchTPA[II].y] = False then
+ Break;
+ if II > LenSearch then
+ begin;
+ MatchCount := MatchCount + 1;
+ SetLength(Matches,MatchCount);
+ Matches[MatchCount - 1].x := TotalTPA[I].x;
+ Matches[MatchCount - 1].y := TotalTPA[I].y;
+ end;
+ end;
+ end;
+ if (MatchCount > 0) then
+ Result := True;
+end;
+
+{/\
+ Read the description of FindTPAinTPA. Additional Height parameter.
+/\}
+
+function FindTextTPAinTPA(Height : integer; SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean;
+var
+ Len, I,II,LenSearch,LenTPA,xOff,yOff,x,y: integer;
+ tx,ty,MatchCount : integer;
+ Screen : Array of Array of Boolean;
+ ScreenBox,SearchBox : TBox;
+ InversedTPA : TPointArray;
+begin;
+ Result := False;
+ Len := High(TotalTPA);
+ LenSearch := High(SearchTPA);
+ if LenSearch < 0 then Exit;
+ if Len < LenSearch then Exit;
+ MatchCount := 0;
+ xOff := -5;
+ yOff := 0;
+ ScreenBox := GetTPABounds(TotalTPA);
+ SearchBox := GetTPABounds(SearchTPA);
+ if height > SearchBox.y2 then
+ Screenbox.y2 := Screenbox.y2 + (height - SearchBox.y2);
+ SearchBox.y2 := Height;
+ SetLength(Screen, SearchBox.x2 + 1,Searchbox.y2 + 1);
+ SetLength(InversedTPA,(SearchBox.x2 + 1) * (Searchbox.y2 + 1));
+ for I := 0 to LenSearch do
+ Screen[ SearchTPA[I].x,SearchTPA[I].y] := True;
+ LenTPA := -1;
+ for y := 0 to SearchBox.y2 do
+ for x := 0 to SearchBox.x2 do
+ if Screen[X][Y] = False then
+ begin;
+ LenTPA := LenTPA + 1;
+ InversedTPA[LenTPA].x := x;
+ InversedTPA[LenTPA].y := y;
+ end;
+ for x := 0 to SearchBox.x2 do
+ begin;
+ for y := 0 to SearchBox.y2 do
+ if Screen[x][y] = True then
+ begin;
+ xOff := x;
+ yOff := y;
+ Break;
+ end;
+ if xOff >= 0 then
+ Break;
+ end;
+ try
+ SetLength(Screen,0);
+ SetLength(Screen,ScreenBox.x2 + 1,ScreenBox.y2 + 1);
+ except
+ Exit;
+ end;
+ for I := 0 to Len do
+ Screen[TotalTPA[I].x][TotalTPA[I].y] := True;
+ for I := 0 to Len do
+ begin;
+ tx := TotalTPA[I].x - xOff;
+ ty := TotalTPA[I].y - yOff;
+ if tx > 0 then
+ if ty > 0 then
+ if ((SearchBox.x2 + tx) <= ScreenBox.x2) and ((SearchBox.y2 + ty) <= ScreenBox.y2) then
+ begin;
+ For II := 0 to LenSearch do
+ if Screen[tx + SearchTPA[II].x ][ty + SearchTPA[II].y] = False then
+ Break;
+ if (II > LenSearch) then
+ begin;
+ For II := 0 to LenTPA do
+ if Screen[tx + InversedTPA[II].x ][ty + InversedTPA[II].y] = True then
+ Break;
+ if (II > LenTPA) then
+ begin;
+ MatchCount := MatchCount + 1;
+ SetLength(Matches,MatchCount);
+ Matches[MatchCount - 1].x := TotalTPA[I].x;
+ Matches[MatchCount - 1].y := TotalTPA[I].y;
+ end;
+ end;
+ end;
+ end;
+ if (MatchCount > 0) then
+ Result := True;
+end;
+
+{/\
+ Finds the possible gaps in the TPointArray TPA and results the gaps as a T2DPointArray.
+ \\ Considers as a gap if the gap length is >= MinPixels.
+ \\ Only horizontal, sorry folks.
+/\}
+
+function FindGapsTPA(TPA: TPointArray; MinPixels: Integer): T2DPointArray;
+var
+ Len,TotalLen,LenRes,I,II,III : integer;
+ Screen : Array of Array of Boolean;
+ Height,Width : Integer;
+ Box : TBox;
+begin;
+ Len := High(TPA);
+ if Len < 0 then exit;
+ Box := GetTPABounds(TPA);
+ Height := Box.y2 - Box.y1;
+ Width := Box.x2 - Box.x1;
+ LenRes := 0;
+ III := 0;
+ try
+ SetLength(Screen,Width + 1,Height + 1);
+ except
+ Exit;
+ end;
+ For I := 0 to Len do
+ Screen[TPA[I].x - Box.x1][TPA[I].y - Box.y1] := True;
+ SetLength(result,1);
+ SetLength(Result[0],Len+1);
+ TotalLen := 0;
+ for I := 0 to Width do
+ begin;
+ for II := 0 to Height do
+ if Screen[I][II]=True then
+ begin;
+ Result[TotalLen][LenRes].x := I + Box.x1;
+ Result[TotalLen][LenRes].y := II + Box.y1;
+ LenRes := LenRes + 1;
+ III := I;
+ end;
+ if LenRes = 0 then
+ III := I
+ else
+ if (I - III) > MinPixels then
+ begin;
+ III := I;
+ SetLength(Result[TotalLen],LenRes);
+ LenRes := 0;
+ TotalLen := TotalLen + 1;
+ SetLength(Result,TotalLen + 1);
+ SetLength(Result[TotalLen],Len + 1);
+ end;
+ end;
+ SetLength(Result[TotalLen],LenRes);
+end;
+
+
+
+{/\
+ Sorts all points in tpa by distance from degree (Deg) and distance from mx and my.
+ \\ Sortup will return closest distance to mx and my first.
+ \\ Distance will be sorted first (RadialWalk style).
+/\}
+
+procedure SortCircleWise(var tpa: TPointArray; const cx, cy, StartDegree: Integer; SortUp, ClockWise: Boolean);
+const
+ i180Pi = 57.29577951;
+var
+ i, l, td, sd: Integer;
+ Dist, Deg: TIntegerArray;
+begin
+ l := Length(tpa);
+ if (l = 0) then Exit;
+ sd := StartDegree;
+ while (sd > 360) do
+ sd := (sd - 360);
+ sd := (360 - sd);
+ SetLength(Dist, l);
+ SetLength(Deg, l);
+ for i := 0 to l -1 do
+ Dist[i] := Round(Hypot(tpa[i].x - cx, tpa[i].y - cy));
+ QuickTPASort(Dist, tpa, 0, l -1, SortUp);
+ if (l = 1) then Exit;
+ for i := 0 to l -1 do
+ begin
+ td := Round(ArcTan2(tpa[i].y - cy, tpa[i].x - cx) * i180Pi) + 90;
+ if (td < 0) then
+ td := td + 360;
+ if ClockWise then
+ Deg[i] := Round(sd + td) mod 360
+ else
+ Deg[i] := 360 - Round(sd + td) mod 360;
+ end;
+ i := 1;
+ td := 0;
+ Dec(l);
+ while (i < l) do
+ begin
+ while (i < l) and (Abs(Dist[td] - Dist[i]) <= 1) do Inc(i);
+ QuickTPASort(Deg, tpa, td, i, False);
+ Inc(i);
+ td := i;
+ end;
+ if (td < l) then
+ QuickTPASort(Deg, tpa, td, l, False);
+end;
+
+{/\
+ Sorts all points in tpa by distance from degree (Deg) and distance from mx and my.
+ \\ Sortup will return closest distance to mx and my first.
+ \\ Degree will be sorted first (LinearWalk style).
+/\}
+
+procedure LinearSort(var tpa: TPointArray; cx, cy, sd: Integer; SortUp: Boolean);
+const
+ i180Pi = 57.29577951;
+var
+ i, l, td: Integer;
+ Dist, Deg: TIntegerArray;
+begin
+ l := Length(tpa);
+ if (l = 0) then Exit;
+ while (sd > 360) do
+ sd := (sd - 360);
+ SetLength(Dist, l);
+ SetLength(Deg, l);
+ for i := 0 to l -1 do
+ begin
+ td := Round(ArcTan2(tpa[i].y - cy, tpa[i].x - cx) * i180Pi) + 90;
+ if (td < 0) then
+ td := td + 360;
+ Deg[i] := Min(Abs(sd - td), Min(Abs(sd - (td + 360)), Abs((sd + 360) - td)))
+ end;
+ QuickTPASort(Deg, tpa, 0, l -1, True);
+ if (l = 1) then Exit;
+ for i := 0 to l -1 do
+ Dist[i] := Round(Hypot(tpa[i].x - cx, tpa[i].y - cy));
+ i := 1;
+ td := 0;
+ Dec(l);
+ while (i < l) do
+ begin
+ while (i < l) and (Abs(Deg[td] - Deg[i]) <= 3) do Inc(i);
+ QuickTPASort(Dist, tpa, td, i, SortUp);
+ Inc(i);
+ td := i;
+ end;
+ if (td < l) then
+ QuickTPASort(Dist, tpa, td, l, SortUp);
+end;
+
+{/\
+ Merges the TPointArrays of the T2DPointArray ATPA in to one TPA.
+/\}
+
+Function MergeATPA(ATPA : T2DPointArray) : TPointArray;
+var
+ I,II, Len, TempL,CurrentL : integer;
+begin;
+ Len := High(ATPA);
+ CurrentL := 0;
+ For I:= 0 to Len do
+ begin;
+ TempL := High(ATPA[I]);
+ if TempL < 0 then
+ Continue;
+ TempL := Templ + CurrentL + 1;
+ Setlength(Result, TempL+1);
+ For II := CurrentL to TempL do
+ Result[II] := ATPA[I][II - CurrentL];
+ CurrentL := TempL;
+ end;
+ SetLength(Result,CurrentL);
+end;
+
+
+{/\
+ Returns a TPointArray of a the full given Box.
+/\}
+
+function TPAFromBox(const Box : TBox) : TPointArray;
+var
+ x, y: integer;
+ l : integer;
+begin;
+ SetLength(Result, (Box.x2 - Box.x1 + 1) * (Box.y2 - Box.y1 + 1));
+ l := 0;
+ For x := box.x1 to Box.x2 do
+ for y := box.y1 to box.y2 do
+ begin;
+ Result[l].x := x;
+ Result[l].y := y;
+ inc(l);
+ end;
+end;
+
+{/\
+ Rotate the given TPA with A radians.
+/\}
+
+Function RotatePoints(Const P: TPointArray; A, cx, cy: Extended): TPointArray ;
+
+Var
+ I, L: Integer;
+
+Begin
+ L := High(P);
+ SetLength(Result, L + 1);
+ For I := 0 To L Do
+ Begin
+ Result[I].X := Trunc(cx + cos(A) * (p[i].x - cx) - sin(A) * (p[i].y - cy));
+ Result[I].Y := Trunc(cy + sin(A) * (p[i].x - cx) + cos(A) * (p[i].y - cy));
+ End;
+ // I recon its faster than Point().
+End;
+
+{/\
+ Rotate the given Point with A radians.
+/\}
+
+Function RotatePoint(Const p: TPoint; angle, mx, my: Extended): TPoint; inline;
+
+Begin
+ Result.X := Trunc(mx + cos(angle) * (p.x - mx) - sin(angle) * (p.y - my));
+ Result.Y := Trunc(my + sin(angle) * (p.x - mx) + cos(angle) * (p.y- my));
+End;
+
+{/\
+ Returns the edges of the given TPA.
+/\}
+
+function FindTPAEdges(p: TPointArray): TPointArray;
+var
+ b: array of array of Boolean;
+ i, x, y, l, c: Integer;
+ Box: TBox;
+begin
+ SetLength(Result, 0);
+ l := Length(p);
+ if (l = 0) then Exit;
+ Box := GetTPABounds(p);
+ x := (Box.x2 - Box.x1) + 3;
+ y := (Box.y2 - Box.y1) + 3;
+ SetLength(b, x);
+ for i := 0 to x -1 do
+ SetLength(b[i], y);
+ for i := 0 to l -1 do
+ b[p[i].x +1 - Box.x1][p[i].y +1 - Box.y1] := True;
+ SetLength(Result, l);
+ c := 0;
+ for i := 0 to l -1 do
+ begin
+ x := -1;
+ while (x <= 1) do
+ begin
+ for y := -1 to 1 do
+ try
+ if not b[p[i].x + 1 + x - Box.x1][p[i].y + 1 + y - Box.y1] then
+ begin
+ Result[c] := p[i];
+ Inc(c);
+ x := 2;
+ Break;
+ end;
+ except end;
+ Inc(x);
+ end;
+ end;
+ SetLength(Result, c);
+end;
+
+{/\
+ Results true if a point is in a TPointArray.
+ Notes: In actuallys means IN the array, not in the box shaped by the array.
+/\}
+
+function PointInTPA(p: TPoint; arP: TPointArray): Boolean;
+var
+ i, l: Integer;
+begin
+ l := High(arP);
+ for i := 0 to l do
+ if (arP[i].x = p.x) and (arP[i].y = p.y) then
+ Break;
+ Result := i <> Length(arP);
+end;
+
+{/\
+ Removes the given ClearPoints from arP.
+/\}
+
+function ClearTPAFromTPA(arP, ClearPoints: TPointArray): TPointArray;
+var
+ i, j, l, l2: Integer;
+begin
+ l := High(arP);
+ l2 := High(ClearPoints);
+ for i := 0 to l do
+ begin
+ for j := 0 to l2 do
+ if (arP[i].x = ClearPoints[j].x) and (arP[i].y = ClearPoints[j].y) then
+ Break;
+
+ if (j = l2 + 1) then
+ begin
+ SetLength(Result, Length(Result) + 1);
+ Result[High(Result)] := arP[i];
+ end;
+ end;
+end;
+
+{/\
+ Removes all the doubles point from a TPA.
+/\}
+
+procedure ClearDoubleTPA(var TPA: TPointArray);
+var
+ I, II, L: Integer;
+ Swappie: TPoint;
+begin
+ L := High(TPA);
+ for I := 0 To L Do
+ for II := I + 1 To L Do
+ if ((TPA[I].X = TPA[II].X) And (TPA[I].Y = TPA[II].Y)) then
+ begin
+ Swappie := TPA[L];
+ TPA[L] := TPA[II];
+ TPA[II] := Swappie;
+ L := L - 1;
+ end;
+ SetLength(TPA, L + 1);
+end;
+
+{/\
+ Uses Box to define an area around TotalTPA.
+ Every point that is not in TotalTPA, but is in Box, is added to the Result.
+ \\ This can be very handy if you want for example, can get all the colors of the background, but not of the actual object.
+ \\ If you pass this all the colors of the background, it will returns the points of the object.
+/\}
+
+Function ReturnPointsNotInTPA(Const TotalTPA: TPointArray; Box: TBox): TPointArray;
+
+Var
+ X, Y, I: Integer;
+ B: Array Of Array Of Boolean;
+
+Begin
+ SetLength(Result, ((Box.X2 - Box.X1 + 1) * (Box.Y2 - Box.Y1 + 1)) - Length(TotalTPA));
+
+ SetLength(B, Box.X2 - Box.X1 + 1, Box.Y2 - Box.Y1 + 1);
+
+ For I := 0 To High(TotalTPA) Do
+ B[TotalTPA[I].X - Box.X1][TotalTPA[I].Y - Box.Y1] := True;
+
+ I := 0;
+ For X := 0 To Box.X2 - Box.X1 Do
+ For Y := 0 To Box.Y2 - Box.Y1 Do
+ If Not B[X][Y] Then
+ Begin
+ Result[I].X := X + Box.X1;
+ Result[I].Y := Y + Box.Y1;
+ I := I + 1;
+ End;
+ SetLength(B, 0);
+End;
+
+{/\
+ Sorts a TPointArray by either X or Y. You have to define the max Point as well.
+/\}
+
+Procedure TPACountSort(Var TPA: TPointArray;const max: TPoint;Const SortOnX : Boolean);
+Var
+ c: Array Of Array Of Integer;
+ I, II, III, hTPA, cc: Integer;
+Begin
+ hTPA := High(TPA);
+ if hTPA < 1 then
+ Exit;
+ SetLength(c, max.X + 1,max.Y + 1);
+ For I := 0 To hTPA Do
+ c[TPA[I].x][TPA[I].y] := c[TPA[i].x][TPA[i].y] + 1;
+
+ cc := 0;
+ if SortOnX then
+ begin
+ For I := 0 To max.X Do
+ For II := 0 To max.Y Do
+ Begin
+ For III := 0 To c[I][II] - 1 Do
+ Begin
+ TPA[cc].x := I;
+ TPA[cc].y := II;
+ cc := cc + 1;
+ End;
+ End;
+ end else
+ begin;
+ For II := 0 To max.Y Do
+ For I := 0 To max.X Do
+ Begin
+ For III := 0 To c[I][II] - 1 Do
+ Begin
+ TPA[cc].x := I;
+ TPA[cc].y := II;
+ cc := cc + 1;
+ End;
+ End;
+ end;
+End;
+
+{/\
+ Sorts a TPointArray by either X or Y. Allows one to pass a Base.
+/\}
+
+Procedure TPACountSortBase(Var TPA: TPointArray;const maxx, base: TPoint; const SortOnX : Boolean);
+Var
+ c: Array Of Array Of Integer;
+ I, II, III, hTPA, cc: Integer;
+ Max : TPoint;
+Begin
+ hTPA := High(TPA);
+ if hTPA < 1 then
+ Exit;
+ max.X := maxx.X - base.X;
+ max.Y := maxx.Y - base.Y;
+ SetLength(c, max.X + 1,max.Y + 1);
+ hTPA := High(TPA);
+ For I := 0 To hTPA Do
+ c[TPA[I].x - base.X][TPA[I].y - base.Y] := c[TPA[i].x- base.X][TPA[i].y- base.Y] + 1;
+
+ cc := 0;
+ if SortOnX then
+ begin
+ For I := 0 To max.X Do
+ For II := 0 To max.Y Do
+ Begin
+ For III := 0 To c[I][II] - 1 Do
+ Begin
+ TPA[cc].x := I + base.X;
+ TPA[cc].y := II + base.Y;
+ cc := cc + 1;
+ End;
+ End;
+ end else
+ begin;
+ For II := 0 To max.Y Do
+ For I := 0 To max.X Do
+ Begin
+ For III := 0 To c[I][II] - 1 Do
+ Begin
+ TPA[cc].x := I + base.X;
+ TPA[cc].y := II + base.Y;
+ cc := cc + 1;
+ End;
+ End;
+ end;
+End;
+
+end.
+
diff --git a/Units/MMLCore/bitmaps.pas b/Units/MMLCore/bitmaps.pas
index 6500156..c4584c6 100644
--- a/Units/MMLCore/bitmaps.pas
+++ b/Units/MMLCore/bitmaps.pas
@@ -78,6 +78,7 @@ type
procedure Invert;
procedure Posterize(TargetBitmap : TMufasaBitmap; Po : integer);overload;
procedure Posterize(Po : integer);overload;
+ function Copy: TMufasaBitmap;
function CreateTMask : TMask;
constructor Create;
destructor Destroy;override;
@@ -377,6 +378,13 @@ begin;
Result := BGR.R or BGR.g shl 8 or BGR.b shl 16;
end;
+function TMufasaBitmap.Copy: TMufasaBitmap;
+begin
+ Result := TMufasaBitmap.Create;
+ Result.SetSize(self.Width, self.Height);
+ Move(self.FData[0], Result.FData[0],self.w * self.h * SizeOf(TRGB32));
+end;
+
procedure TMufasaBitmap.FastSetPixel(x, y: integer; Color: TColor);
begin
ValidatePoint(x,y);
diff --git a/Units/MMLCore/files.pas b/Units/MMLCore/files.pas
index b74a6ab..5056feb 100644
--- a/Units/MMLCore/files.pas
+++ b/Units/MMLCore/files.pas
@@ -64,6 +64,7 @@ type
// We don't need one per object. :-)
function GetFiles(Path, Ext: string): TStringArray;
+ function GetDirectories(Path: string): TstringArray;
implementation
uses
@@ -88,6 +89,25 @@ begin
end;
end;
+function GetDirectories(Path: string): TstringArray;
+var
+ SearchRec : TSearchRec;
+ c : integer;
+begin
+ c := 0;
+ if FindFirst(Path + '*', faDirectory, SearchRec) = 0 then
+ begin
+ repeat
+ if SearchRec.Name[1] = '.' then
+ continue;
+ inc(c);
+ SetLength(Result,c);
+ Result[c-1] := SearchRec.Name;
+ until FindNext(SearchRec) <> 0;
+ SysUtils.FindClose(SearchRec);
+ end;
+end;
+
constructor TMFiles.Create;
begin
inherited Create;
diff --git a/Units/MMLCore/mufasatypesutil.pas b/Units/MMLCore/mufasatypesutil.pas
index 1c7966d..b3c2290 100644
--- a/Units/MMLCore/mufasatypesutil.pas
+++ b/Units/MMLCore/mufasatypesutil.pas
@@ -1,51 +1,63 @@
-unit mufasatypesutil;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
- Classes, SysUtils,mufasatypes;
-
-function ConvArr(Arr: array of TPoint): TPointArray; overload;
-function ConvArr(Arr: array of TPointArray): T2DPointArray; overload;
-function ConvArr(Arr: array of Integer): TIntegerArray; overload;
-
-
-implementation
-
-function ConvArr(Arr: array of TPoint): TPointArray; overload;
-var
- Len : Integer;
-begin;
- Len := Length(Arr);
- SetLength(Result, Len);
- Move(Arr[Low(Arr)], Result[0], Len*SizeOf(TPoint));
-end;
-
-function ConvArr(Arr: array of TPointArray): T2DPointArray; overload;
-var
- Len,Len2 : Integer;
- i : integer;
-begin;
- Len := Length(Arr);
- SetLength(Result, Len);
- for i := Len - 1 downto 0 do
- begin
- Len2 := Length(Arr[i]);
- SetLength(result[i],len2);
- Move(Arr[i][0],Result[i][0],Len2*SizeOf(TPoint));
- end;
-end;
-
-function ConvArr(Arr: array of Integer): TIntegerArray; overload;
-var
- Len : Integer;
-begin;
- Len := Length(Arr);
- SetLength(Result, Len);
- Move(Arr[Low(Arr)], Result[0], Len*SizeOf(Integer));
-end;
-
-end.
-
+unit mufasatypesutil;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils,mufasatypes;
+
+function ConvArr(Arr: array of TPoint): TPointArray; overload;
+function ConvArr(Arr: array of TPointArray): T2DPointArray; overload;
+function ConvArr(Arr: array of Integer): TIntegerArray; overload;
+
+function ConvTPAArr(Arr: array of TPoint): TPointArray; overload;
+
+
+implementation
+
+function ConvArr(Arr: array of TPoint): TPointArray; overload;
+var
+ Len : Integer;
+begin;
+ Len := Length(Arr);
+ SetLength(Result, Len);
+ Move(Arr[Low(Arr)], Result[0], Len*SizeOf(TPoint));
+end;
+
+function ConvTPAArr(Arr: array of TPoint): TPointArray; overload;
+var
+ Len : Integer;
+begin;
+ Len := Length(Arr);
+ SetLength(Result, Len);
+ Move(Arr[Low(Arr)], Result[0], Len*SizeOf(TPoint));
+end;
+
+
+function ConvArr(Arr: array of TPointArray): T2DPointArray; overload;
+var
+ Len,Len2 : Integer;
+ i : integer;
+begin;
+ Len := Length(Arr);
+ SetLength(Result, Len);
+ for i := Len - 1 downto 0 do
+ begin
+ Len2 := Length(Arr[i]);
+ SetLength(result[i],len2);
+ Move(Arr[i][0],Result[i][0],Len2*SizeOf(TPoint));
+ end;
+end;
+
+function ConvArr(Arr: array of Integer): TIntegerArray; overload;
+var
+ Len : Integer;
+begin;
+ Len := Length(Arr);
+ SetLength(Result, Len);
+ Move(Arr[Low(Arr)], Result[0], Len*SizeOf(Integer));
+end;
+
+end.
+
diff --git a/Units/MMLCore/ocr.pas b/Units/MMLCore/ocr.pas
index 6fdb113..033b4ee 100644
--- a/Units/MMLCore/ocr.pas
+++ b/Units/MMLCore/ocr.pas
@@ -38,12 +38,25 @@ uses
constructor Create(Owner: TObject);
destructor Destroy; override;
function InitTOCR(path: string; shadow: Boolean): boolean;
- function getTextPointsIn(sx, sy, w, h: Integer; shadow: boolean; spacing: Integer): TNormArray;
- function GetUpTextAtEx(atX, atY: integer; shadow: boolean; Spacing: Integer): string;
+ function GetFontIndex(FontName: string): integer;
+ function GetFont(FontName: string): TocrData;
+
+ function getTextPointsIn(sx, sy, w, h: Integer; shadow: boolean;
+ var _chars, _shadows: T2DPointArray): Boolean;
+ function GetUpTextAtEx(atX, atY: integer; shadow: boolean): string;
function GetUpTextAt(atX, atY: integer; shadow: boolean): string;
+
+ procedure FilterUpTextByColour(bmp: TMufasaBitmap; w,h: integer);
+ procedure FilterUpTextByCharacteristics(bmp: TMufasaBitmap; w,h: integer);
+ procedure FilterShadowBitmap(bmp: TMufasaBitmap);
+ procedure FilterCharsBitmap(bmp: TMufasaBitmap);
+ {$IFDEF OCRDEBUG}
+ procedure DebugToBmp(bmp: TMufasaBitmap; hmod,h: integer);
+ {$ENDIF}
private
Client: TObject;
OCRData: TocrDataArray;
+ OCRNames: Array Of String;
OCRPath: string;
{$IFDEF OCRDEBUG}
public
@@ -104,44 +117,12 @@ We can also just split the chars, and then use their shadow.
Non optimised. ;-)
}
-function TMOCR.getTextPointsIn(sx, sy, w, h: Integer; shadow: boolean; spacing: integer): TNormArray;
+procedure TMOCR.FilterUpTextByColour(bmp: TMufasaBitmap; w,h: integer);
var
- bmp: TMufasaBitmap;
- x,y: integer;
- r,g,b: integer;
- n: TNormArray;
- {$IFDEF OCRDEBUG}
- dx,dy: integer;
- {$ENDIF}
- {$IFDEF OCRTPA}
- t: tpointarray;
- at, atf,att: T2DPointArray;
- pc: integer;
- max_len: integer;
- {$ENDIF}
-
+ x, y,r, g, b: Integer;
begin
- bmp := TMufasaBitmap.Create;
-
- { Increase to create a black horizonal line at the top and at the bottom }
- { This so the crappy algo can do it's work correctly. }
- bmp.SetSize(w{ + 1}, h + 2);
-
- bmp.CopyClientToBitmap(TClient(Client).MWindow, False, {1}0,1, sx, sy, sx + w - 1, sy + h - 1);
-
- {$IFDEF OCRDEBUG}
- debugbmp := TMufasaBitmap.Create;
- debugbmp.SetSize(w, (h + 2) * 5);
- {$ENDIF}
-
- {$IFDEF OCRSAVEBITMAP}
- bmp.SaveToFile('/tmp/ocrinit.bmp');
- {$ENDIF}
- {$IFDEF OCRDEBUG}
- for dy := 0 to bmp.height - 1 do
- for dx := 0 to bmp.width - 1 do
- debugbmp.fastsetpixel(dx,dy,bmp.fastgetpixel(dx,dy));
- {$ENDIF}
+ // We're going to filter the bitmap solely on colours first.
+ // If we found one, we set it to it's `normal' colour.
for y := 0 to bmp.Height - 1 do
for x := 0 to bmp.Width - 1 do
begin
@@ -204,231 +185,302 @@ begin
bmp.fastsetpixel(x,y,0);
end;
+
+ // make outline black for shadow characteristics filter
// first and last horiz line = 0
for x := 0 to bmp.width -1 do
bmp.fastsetpixel(x,0,0);
for x := 0 to bmp.width -1 do
bmp.fastsetpixel(x,bmp.height-1,0);
- { for y := 0 to bmp.Height -1 do
- bmp.fastsetpixel(0, y, 0); }
+ // same for vertical lines
+ for y := 0 to bmp.Height -1 do
+ bmp.fastsetpixel(0, y, 0);
+ for y := 0 to bmp.Height -1 do
+ bmp.fastsetpixel(bmp.Width-1, y, 0);
+end;
- {$IFDEF OCRSAVEBITMAP}
- bmp.SaveToFile('/tmp/ocrcol.bmp');
- {$ENDIF}
- {$IFDEF OCRDEBUG}
- for dy := 0 to bmp.height - 1 do
- for dx := 0 to bmp.width - 1 do
- debugbmp.fastsetpixel(dx,dy+h,bmp.fastgetpixel(dx,dy));
- {$ENDIF}
- for y := 0 to bmp.Height - 2 do
- for x := 0 to bmp.Width - 2 do
+procedure TMOCR.FilterUpTextByCharacteristics(bmp: TMufasaBitmap; w,h: integer);
+var
+ x,y: Integer;
+begin
+ // Filter 2
+ // This performs a `simple' filter.
+ // What we are doing here is simple checking that if Colour[x,y] is part
+ // of the uptext, then so must Colour[x+1,y+1], or Colour[x+1,y+1] is a shadow.
+ // if it is neither, we can safely remove it.
+ for y := 0 to bmp.Height - 2 do
+ for x := 0 to bmp.Width - 2 do
+ begin
+ if bmp.fastgetpixel(x,y) = clPurple then
+ continue;
+ if bmp.fastgetpixel(x,y) = clBlack then
+ continue;
+ if (bmp.fastgetpixel(x,y) <> bmp.fastgetpixel(x+1,y+1)) and (bmp.fastgetpixel(x+1,y+1) <> clpurple) then
+ bmp.fastsetpixel(x,y,{clAqua}0);
+ end;
+
+ // Remove false shadow
+ for y := bmp.Height - 1 downto 1 do
+ for x := bmp.Width - 1 downto 1 do
+ begin
+ if bmp.fastgetpixel(x,y) <> clPurple then
+ continue;
+ if bmp.fastgetpixel(x,y) = bmp.fastgetpixel(x-1,y-1) then
+ begin
+ bmp.fastsetpixel(x,y,clSilver);
+ continue;
+ end;
+ if bmp.fastgetpixel(x-1,y-1) = 0 then
+ bmp.fastsetpixel(x,y,clSilver);
+ end;
+
+ // Now we do another filter like
+ for y := bmp.Height - 2 downto 0 do
+ for x := bmp.Width - 2 downto 0 do
+ begin
+ if bmp.fastgetpixel(x,y) = clPurple then
+ continue;
+ if bmp.fastgetpixel(x,y) = clBlack then
+ continue;
+ if (bmp.fastgetpixel(x,y) = bmp.fastgetpixel(x+1,y+1) ) then
+ continue;
+
+ if bmp.fastgetpixel(x+1,y+1) <> clPurple then
+ begin
+ bmp.fastsetpixel(x,y,clOlive);
+ continue;
+ end;
+ end;
+end;
+
+{$IFDEF OCRDEBUG}
+procedure TMOCR.DebugToBmp(bmp: TMufasaBitmap; hmod, h: integer);
+var
+ x,y: integer;
+begin
+ for y := 0 to bmp.height - 1 do
+ for x := 0 to bmp.width - 1 do
+ debugbmp.fastsetpixel(x,y + hmod *h,bmp.fastgetpixel(x,y));
+end;
+{$ENDIF}
+
+function getshadows(shadowsbmp:TMufasaBitmap; charpoint: tpointarray): tpointarray;
+var
+ i,c:integer;
+begin
+ setlength(result,length(charpoint));
+ c:=0;
+ for i := 0 to high(charpoint) do
+ begin
+ if shadowsbmp.fastgetpixel(charpoint[i].x+1,charpoint[i].y+1) = clPurple then
+ begin
+ result[c]:=point(charpoint[i].x+1, charpoint[i].y+1);
+ inc(c);
+ end;
+ end;
+ setlength(result,c);
+end;
+
+procedure TMOCR.FilterShadowBitmap(bmp: TMufasaBitmap);
+var
+ x,y:integer;
+begin
+ for y := 0 to bmp.Height - 1 do
+ for x := 0 to bmp.Width - 1 do
+ begin
+ if bmp.fastgetpixel(x,y) <> clPurple then
+ begin
+ bmp.FastSetPixel(x,y,0);
+ continue;
+ end;
+ end;
+end;
+
+procedure TMOCR.FilterCharsBitmap(bmp: TMufasaBitmap);
+var
+ x,y: integer;
+begin
+ begin
+ for y := 0 to bmp.Height - 1 do
+ for x := 0 to bmp.Width - 1 do
begin
if bmp.fastgetpixel(x,y) = clPurple then
+ begin
+ bmp.FastSetPixel(x,y,0);
continue;
- if bmp.fastgetpixel(x,y) = clBlack then
+ end;
+ if bmp.fastgetpixel(x,y) = clOlive then
+ begin
+ bmp.FastSetPixel(x,y,0);
continue;
- if (bmp.fastgetpixel(x,y) <> bmp.fastgetpixel(x+1,y+1)) and (bmp.fastgetpixel(x+1,y+1) <> clpurple) then
- bmp.fastsetpixel(x,y,{clAqua}0);
+ end;
+ if bmp.fastgetpixel(x,y) = clSilver then
+ begin
+ bmp.FastSetPixel(x,y,0);
+ continue;
+ end;
end;
+ end;
+end;
- { Optional - remove false shadow }
- for y := bmp.Height - 1 downto 1 do
- for x := bmp.Width - 1 downto 1 do
- begin
- if bmp.fastgetpixel(x,y) <> clPurple then
- continue;
- if bmp.fastgetpixel(x,y) = bmp.fastgetpixel(x-1,y-1) then
- begin
- bmp.fastsetpixel(x,y,clSilver);
- continue;
- end;
- if bmp.fastgetpixel(x-1,y-1) = 0 then
- bmp.fastsetpixel(x,y,clSilver);
- end;
-
- { remove bad points }
- for y := bmp.Height - 2 downto 0 do
- for x := bmp.Width - 2 downto 0 do
- begin
- if bmp.fastgetpixel(x,y) = clPurple then
- continue;
- if bmp.fastgetpixel(x,y) = clBlack then
- continue;
- if (bmp.fastgetpixel(x,y) = bmp.fastgetpixel(x+1,y+1) ) then
- continue;
-
- if bmp.fastgetpixel(x+1,y+1) <> clPurple then
- begin
- bmp.fastsetpixel(x,y,clOlive);
- continue;
- end;
- end;
-
- { may remove some pixels from chars. }
- { for y := bmp.Height - 2 downto 1 do
- for x := bmp.Width - 2 downto 1 do
- begin
- if (bmp.fastgetpixel(x,y) <> bmp.fastgetpixel(x+1,y)) and
- (bmp.fastgetpixel(x,y) <> bmp.fastgetpixel(x-1,y)) and
- (bmp.fastgetpixel(x,y) <> bmp.fastgetpixel(x,y+1)) and
- (bmp.fastgetpixel(x,y) <> bmp.fastgetpixel(x,y-1)) then
- bmp.fastsetpixel(x,y, clOlive);
- end; }
- { remove debug ;) }
+function TMOCR.getTextPointsIn(sx, sy, w, h: Integer; shadow: boolean;
+ var _chars, _shadows: T2DPointArray): Boolean;
+var
+ bmp, shadowsbmp, charsbmp: TMufasaBitmap;
+ x,y: integer;
+ r,g,b: integer;
+ n: TNormArray;
{$IFDEF OCRDEBUG}
- for dy := 0 to bmp.height - 1 do
- for dx := 0 to bmp.width - 1 do
- debugbmp.fastsetpixel(dx,dy+h+h,bmp.fastgetpixel(dx,dy));
- {$ENDIF}
- {$IFDEF OCRSAVEBITMAP}
- bmp.SaveToFile('/tmp/ocrdebug.bmp');
+ dx,dy: integer;
{$ENDIF}
+ shadows: T2DPointArray;
+ helpershadow: TPointArray;
+ chars: TPointArray;
+ charscount: integer;
+ chars_2d, chars_2d_b, finalchars: T2DPointArray;
+ pc: integer;
+ bb: Tbox;
- if shadow then
- begin
- for y := 0 to bmp.Height - 1 do
- for x := 0 to bmp.Width - 1 do
- begin
- if bmp.fastgetpixel(x,y) <> clPurple then
- begin
- bmp.FastSetPixel(x,y,0);
- continue;
- end;
- end;
- end else
- begin
- for y := 0 to bmp.Height - 1 do
- for x := 0 to bmp.Width - 1 do
- begin
- if bmp.fastgetpixel(x,y) = clPurple then
- begin
- bmp.FastSetPixel(x,y,0);
- continue;
- end;
- if bmp.fastgetpixel(x,y) = clOlive then
- begin
- bmp.FastSetPixel(x,y,0);
- continue;
- end;
- if bmp.fastgetpixel(x,y) = clSilver then
- begin
- bmp.FastSetPixel(x,y,0);
- continue;
- end;
- end;
- end;
+begin
+ bmp := TMufasaBitmap.Create;
+ { Increase to create a black horizonal line at the top and at the bottom }
+ { This so the crappy algo can do it's work correctly. }
+ bmp.SetSize(w + 2, h + 2);
- for y := 0 to bmp.Height -1 do
- bmp.fastsetpixel(0, y, 0);
+ // Copy the client to out working bitmap.
+ bmp.CopyClientToBitmap(TClient(Client).MWindow, False, 1{0},1, sx, sy, sx + w - 1, sy + h - 1);
- {$IFDEF OCRTPA}
- pc := 0;
- setlength(t, bmp.Height * bmp.Width);
- {$ENDIF}
+ {$IFDEF OCRSAVEBITMAP}
+ bmp.SaveToFile('/tmp/ocrinit.bmp');
+ {$ENDIF}
- setlength(n, bmp.Height * bmp.Width);
+ {$IFDEF OCRDEBUG}
+ debugbmp := TMufasaBitmap.Create;
+ debugbmp.SetSize(w + 2, (h + 2) * 7);
+ {$ENDIF}
+ {$IFDEF OCRDEBUG}
+ DebugToBmp(bmp,0,h);
+ {$ENDIF}
- for y := 0 to bmp.Height - 1 do
- for x := 0 to bmp.Width - 1 do
- begin
- if bmp.fastgetpixel(x,y) > 0 then
- begin
- n[x + y * bmp.width] := 1;
- {$IFDEF OCRTPA}
- t[pc] := point(x,y);
- inc(pc);
- {$ENDIF}
- end
- else
- n[x
- + y * bmp.width] := 0;
- end;
+ // Filter 1
+ FilterUpTextByColour(bmp,w,h);
+ {$IFDEF OCRSAVEBITMAP}
+ bmp.SaveToFile('/tmp/ocrcol.bmp');
+ {$ENDIF}
- {$IFDEF OCRTPA}
- setlength(t,pc);
- {$ENDIF}
+ {$IFDEF OCRDEBUG}
+ DebugToBmp(bmp,1,h);
+ {$ENDIF}
- result := n;
- {$IFDEF OCRSAVEBITMAP}
- bmp.SaveToFile('/tmp/ocrfinal.bmp');
- {$ENDIF}
- {$IFDEF OCRDEBUG}
- for dy := 0 to bmp.height - 1 do
- for dx := 0 to bmp.width - 1 do
- debugbmp.fastsetpixel(dx,dy+h+h+h,bmp.fastgetpixel(dx,dy));
- {$ENDIF}
+ FilterUpTextByCharacteristics(bmp,w,h);
- {$IFDEF OCRTPA}
- at:=splittpaex(t,spacing,bmp.height);
+ {$IFDEF OCRSAVEBITMAP}
+ bmp.SaveToFile('/tmp/ocrdebug.bmp');
+ {$ENDIF}
+ {$IFDEF OCRDEBUG}
+ DebugToBmp(bmp,2,h);
+ {$ENDIF}
- {
- // this was to split extra large points into smaller ones, but it usually won't help
- if shadow then
- max_len := 30
- else
- max_len := 50;
+ // create a bitmap with only the shadows on it
+ shadowsbmp := bmp.copy;
+ FilterShadowBitmap(shadowsbmp);
+ {$IFDEF OCRDEBUG}
+ DebugToBmp(shadowsbmp,3,h);
+ {$ENDIF}
- for x := 0 to high(at) do
- begin
- if length(at[x]) > max_len then
- begin
- setlength(t,0);
- // t := at[x];
- att := splittpaex(at[x], 1, bmp.height);
- for y := 0 to high(att) do
- begin
- setlength(atf,length(atf)+1);
- atf[high(atf)] := convtpaarr(att[y]);
- end;
- end else
- begin
- setlength(atf,length(atf)+1);
- atf[high(atf)] := convtpaarr(at[x]);
- end;
- end;
+ // create a bitmap with only the chars on it
+ charsbmp := bmp.copy;
+ FilterCharsBitmap(charsbmp);
+ {$IFDEF OCRDEBUG}
+ DebugToBmp(charsbmp,4,h);
+ {$ENDIF}
- for x := 0 to high(atf) do
- begin
- pc := random(clWhite);
- for y := 0 to high(atf[x]) do
- bmp.FastSetPixel(atf[x][y].x, atf[x][y].y, pc);
- end; }
+ // this gets the chars from the bitmap.
- for x := 0 to high(at) do
- begin
- if length(at[x]) > 70 then
- begin
- for y := 0 to high(at[x]) do
- bmp.FastSetPixel(at[x][y].x, at[x][y].y, clOlive);
- end else
- begin
- pc := random(clWhite);
- for y := 0 to high(at[x]) do
- bmp.FastSetPixel(at[x][y].x, at[x][y].y, pc);
- end;
- end;
- {$IFDEF OCRDEBUG}
- for dy := 0 to bmp.height - 1 do
- for dx := 0 to bmp.width - 1 do
- debugbmp.fastsetpixel(dx,dy+h+h+h+h,bmp.fastgetpixel(dx,dy));
- {$ENDIF}
- {$ENDIF}
+ // TODO:
+ // We should make a different TPA
+ // for each colour, rather than put them all in one. Noise can be a of a
+ // differnet colour.
+ setlength(chars, charsbmp.height * charsbmp.width);
+ charscount:=0;
+ for y := 0 to charsbmp.height - 1 do
+ for x := 0 to charsbmp.width - 1 do
+ begin
+ if charsbmp.fastgetpixel(x,y) > 0 then
+ begin
+ chars[charscount]:=point(x,y);
+ inc(charscount);
+ end;
+ end;
+ setlength(chars,charscount);
+
+ chars_2d := SplitTPAEx(chars,1,charsbmp.height);
+ SortATPAFrom(chars_2d, point(0,0));
+ for x := 0 to high(chars_2d) do
+ begin
+ pc := random(clWhite);
+ for y := 0 to high(chars_2d[x]) do
+ charsbmp.FastSetPixel(chars_2d[x][y].x, chars_2d[x][y].y, pc);
+ end;
+ {$IFDEF OCRDEBUG}
+ DebugToBmp(charsbmp,5,h);
+ {$ENDIF}
+
+ for y := 0 to high(chars_2d) do
+ begin
+ bb:=gettpabounds(chars_2d[y]);
+ if (bb.x2 - bb.x1 > 10) or (length(chars_2d[y]) > 70) then
+ begin // more than one char
+ {$IFDEF OCRDEBUG}
+ if length(chars_2d[y]) > 70 then
+ writeln('more than one char at y: ' + inttostr(y));
+ if (bb.x2 - bb.x1 > 10) then
+ writeln('too wide at y: ' + inttostr(y));
+ {$ENDIF}
+ helpershadow:=getshadows(shadowsbmp,chars_2d[y]);
+ chars_2d_b := splittpaex(helpershadow,2,shadowsbmp.height);
+ //writeln('chars_2d_b length: ' + inttostr(length(chars_2d_b)));
+ shadowsbmp.DrawATPA(chars_2d_b);
+ for x := 0 to high(chars_2d_b) do
+ begin
+ setlength(shadows,length(shadows)+1);
+ shadows[high(shadows)] := ConvTPAArr(chars_2d_b[x]);
+ end;
+ end else
+ if length(chars_2d[y]) < 70 then
+ begin
+ setlength(shadows,length(shadows)+1);
+ shadows[high(shadows)] := getshadows(shadowsbmp, chars_2d[y]);
+ end;
+ end;
+
+ SortATPAFromFirstPoint(chars_2d, point(0,0));
+ for y := 0 to high(chars_2d) do
+ begin
+ if length(chars_2d[y]) > 70 then
+ continue;
+ setlength(finalchars,length(finalchars)+1);
+ finalchars[high(finalchars)] := chars_2d[y];
+ end;
- bmp.Free;
- { Dangerous removes all pixels that had no pixels on x-1 or x+1}
- { for y := 0 to bmp.Height - 2 do
- for x := 1 to bmp.Width - 2 do
- begin
- if bmp.fastgetpixel(x,y) = clBlack then continue;
- if bmp.fastgetpixel(x,y) = clPurple then continue;
- if bmp.fastgetpixel(x,y) = clOlive then continue;
- if bmp.fastgetpixel(x,y) = clSilver then continue;
- if bmp.fastgetpixel(x,y) = clLime then continue;
- if (bmp.fastgetpixel(x,y) <> bmp.fastgetpixel(x+1,y) ) and
- (bmp.fastgetpixel(x,y) <> bmp.fastgetpixel(x-1,y) ) then
- bmp.fastsetpixel(x,y,clFuchsia);
- end; }
+ SortATPAFromFirstPoint(shadows, point(0,0));
+ for x := 0 to high(shadows) do
+ begin
+ pc:=0;
+ pc := random(clWhite);
+ //pc := rgbtocolor(integer(round((x+1)*255/length(shadows))), round((x+1)*255/length(shadows)), round((x+1)*255/length(shadows)));
+ for y := 0 to high(shadows[x]) do
+ shadowsbmp.FastSetPixel(shadows[x][y].x, shadows[x][y].y, pc);
+ end;
+ {$IFDEF OCRDEBUG}
+ DebugToBmp(shadowsbmp,6,h);
+ {$ENDIF}
+
+ _chars := finalchars;
+ _shadows := shadows;
+
+ bmp.Free;
end;
constructor TMOCR.Create(Owner: TObject);
@@ -441,9 +493,7 @@ begin
Self.Client := Owner;
SetLength(OCRData, 0);
-
- //files := GetFiles('/home/merlijn/Programs/mufasa/ben/upchars', 'bmp');
-
+ SetLength(OCRNames, 0);
end;
destructor TMOCR.Destroy;
@@ -451,46 +501,144 @@ destructor TMOCR.Destroy;
begin
SetLength(OCRData, 0);
+ SetLength(OCRNames, 0);
inherited Destroy;
end;
function TMOCR.InitTOCR(path: string; shadow: boolean): boolean;
+var
+ dirs: array of string;
+ i: longint;
+ dir: string;
begin
{ This must be dynamic }
+ writeln(path);
- SetLength(OCRData, 2);
- result := true;
- OCRPath := path + DS;
- if DirectoryExists(path + DS + 'UpChars' + DS) then
- OCRData[0] := ocrutil.InitOCR(path + DS + 'UpChars' + DS, shadow)
- else
- result := false;
+ dirs := GetDirectories(path);
- if DirectoryExists(path + DS + 'StatChars' + DS) then
- OCRData[1] := ocrutil.InitOCR(path + DS + 'StatChars' + DS, shadow)
- else
- result := false;
+
+ SetLength(OCRData, length(dirs) * 2);
+ SetLength(OCRNames, length(dirs) * 2);
+
+ for i := 0 to high(dirs) do
+ begin
+ OCRData[i] := ocrutil.InitOCR(path + dirs[i] + DS, false);
+ OCRNames[i] := dirs[i];
+ OCRData[i+length(dirs)] := ocrutil.InitOCR(path + dirs[i] + DS, true);
+ OCRNames[i+length(dirs)] := dirs[i] + '_s';
+ {writeln('Loaded Font ' + OCRNames[i]);
+ writeln('Loaded Font ' + OCRNames[i+1]);}
+ end;
+ Result := (length(OCRData) > 0);
+ OCRPath := path;
end;
-function TMOCR.GetUpTextAtEx(atX, atY: integer; shadow: boolean; spacing: Integer): string;
+function TMOCR.GetFontIndex(FontName: string): integer;
+var
+ i: integer;
+begin
+ if length(OCRNames) <> length(OCRData) then
+ raise Exception.Create('Internal OCR error. Len(OCRData) <> Len(OCRNames)');
+ for i := 0 to high(OCRNames) do
+ if FontName = OCRNames[i] then
+ begin
+ Exit(i);
+ end;
+ raise Exception.Create('Font ' + FontName + ' is not loaded.');
+end;
+
+function TMOCR.GetFont(FontName: string): TocrData;
+var
+ i: integer;
+begin
+ if length(OCRNames) <> length(OCRData) then
+ raise Exception.Create('Internal OCR error. Len(OCRData) <> Len(OCRNames)');
+ for i := 0 to high(OCRNames) do
+ if FontName = OCRNames[i] then
+ begin
+ Exit(OCRData[i]);
+ end;
+ raise Exception.Create('Font ' + FontName + ' is not loaded.');
+end;
+
+function TMOCR.GetUpTextAtEx(atX, atY: integer; shadow: boolean): string;
var
n:Tnormarray;
- ww, hh: integer;
+ ww, hh,i,j: integer;
+ font: TocrData;
+ chars, shadows, thachars: T2DPointArray;
+ t:Tpointarray;
+ b,lb:tbox;
+ lbset: boolean;
+
begin
ww := 400;
hh := 20;
+ getTextPointsIn(atX, atY, ww, hh, shadow, chars, shadows);
- n := getTextPointsIn(atX, atY, ww, hh, shadow, spacing);
- Result := ocrDetect(n, ww, hh, OCRData[0]);
+ // only shadow!
+ //shadow:=true;
+ if shadow then
+ begin
+ font := GetFont('UpChars_s');
+ thachars := shadows;
+ {$IFDEF OCRDEBUG}
+ writeln('using shadows');
+ {$ENDIF}
+ end
+ else
+ begin
+ font := GetFont('UpChars');
+ thachars := chars;
+ {$IFDEF OCRDEBUG}
+ writeln('not using shadows');
+ {$ENDIF}
+ end;
+
+ lbset:=false;
+ //writeln(format('FFont Width/Height: (%d, %d)', [font.width,font.height]));
+ setlength(n, (font.width+1) * (font.height+1));
+ for j := 0 to high(thachars) do
+ begin
+ for i := 0 to high(n) do
+ n[i] := 0;
+
+ t:= thachars[j];
+ b:=gettpabounds(t);
+ if not lbset then
+ begin
+ lb:=b;
+ lbset:=true;
+ end else
+ begin
+ if b.x1 - lb.x2 > 5 then
+ result:=result+' ';
+ lb:=b;
+ end;
+ for i := 0 to high(t) do
+ t[i] := t[i] - point(b.x1,b.y1);
+
+ for i := 0 to high(thachars[j]) do
+ begin
+ n[(thachars[j][i].x) + ((thachars[j][i].y) * font.width)] := 1;
+ end;
+ result := result + GuessGlyph(n, font);
+ //writeln('--'+GuessGlyph(n, font));
+ end;
+
+
+ //Result := ocrDetect(n, ww-1, hh-1, font);
+ //Result:='To do';
+ //Result:='';
end;
function TMOCR.GetUpTextAt(atX, atY: integer; shadow: boolean): string;
begin
if shadow then
- result := GetUpTextAtEx(atX, atY, shadow, 2)
+ result := GetUpTextAtEx(atX, atY, true)
else
- result := GetUpTextAtEx(atX, atY, shadow, 1);
+ result := GetUpTextAtEx(atX, atY, false);
end;
{
function TMOCR.GetUpTextAt(atX, atY: integer): string;