diff --git a/Projects/OCRBench/project1.lpi b/Projects/OCRBench/project1.lpi
index 13e10c9..faf63c1 100644
--- a/Projects/OCRBench/project1.lpi
+++ b/Projects/OCRBench/project1.lpi
@@ -7,7 +7,7 @@
-
+
@@ -31,12 +31,12 @@
-
+
-
+
@@ -44,10 +44,10 @@
-
-
+
+
-
+
@@ -58,9 +58,7 @@
-
-
-
+
@@ -78,25 +76,25 @@
-
+
-
-
+
+
-
+
-
-
-
-
+
+
+
+
@@ -105,7 +103,7 @@
-
+
@@ -114,127 +112,145 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
-
+
-
+
-
-
+
+
-
+
-
-
+
+
-
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
+
-
-
+
+
-
-
+
+
-
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
@@ -256,7 +272,8 @@
-
+
diff --git a/Projects/OCRBench/unit1.lfm b/Projects/OCRBench/unit1.lfm
index 8f814a2..6d96f63 100644
--- a/Projects/OCRBench/unit1.lfm
+++ b/Projects/OCRBench/unit1.lfm
@@ -1,12 +1,13 @@
object Form1: TForm1
- Left = 493
- Height = 305
- Top = 293
+ Left = 462
+ Height = 306
+ Top = 264
Width = 609
ActiveControl = BitmapButton
Caption = 'Form1'
- ClientHeight = 305
+ ClientHeight = 306
ClientWidth = 609
+ OnCreate = FormCreate
LCLVersion = '0.9.29'
object OCRButton: TButton
Left = 512
@@ -47,15 +48,33 @@ 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 = 528
- top = 192
+ left = 416
+ top = 277
end
object UpCharsDialog: TSelectDirectoryDialog
- left = 528
- top = 160
+ left = 448
+ top = 277
end
end
diff --git a/Projects/OCRBench/unit1.pas b/Projects/OCRBench/unit1.pas
index 2b24ad4..7299cc0 100644
--- a/Projects/OCRBench/unit1.pas
+++ b/Projects/OCRBench/unit1.pas
@@ -14,6 +14,8 @@ type
TForm1 = class(TForm)
BitmapButton: TButton;
+ SplitLabel: TLabel;
+ SplitEdit: TEdit;
FShadow: TCheckBox;
PathButton: TButton;
OCRButton: TButton;
@@ -21,6 +23,8 @@ type
OCRFileOpen: TOpenDialog;
UpCharsDialog: TSelectDirectoryDialog;
procedure BitmapButtonClick(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure FShadowChange(Sender: TObject);
procedure OCRButtonClick(Sender: TObject);
procedure PathButtonClick(Sender: TObject);
private
@@ -48,6 +52,7 @@ Var
x,y: integer;
s: string;
Shadow: boolean;
+ Spacing: Integer;
begin
if not FileExists(BitmapPath) then
@@ -70,6 +75,7 @@ begin
Form1.Image1.Canvas.Brush.Color := 0;
Form1.Image1.Canvas.Rectangle(0, 0, Form1.Image1.Canvas.Width, Form1.Image1.Canvas.Height);
+ // create and init client
C := TClient.Create;
bmp := TMufasaBitmap.Create;
bmp.LoadFromFile(BitmapPath);
@@ -77,15 +83,39 @@ 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;
+ writeln('Spacing: ' + Inttostr(spacing));
+ // DS + .. + DS because InitOCR wants the directory of the Fonts, not UpChars
+ // only.
C.MOCR.InitTOCR(UpTextPath + DS + '..' + DS, Shadow);
- s := C.MOCR.GetUpTextAt(7,7, Shadow);
+ s := C.MOCR.GetUpTextAtEx(7,7, Shadow, Spacing);
+ // write to debugbmp
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);
+ Form1.Image1.Picture.SaveToFile('/tmp/ocrbench.bmp');
+
C.Free;
end;
@@ -95,6 +125,20 @@ begin
BitmapPath := OCRFileOpen.FileName;
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';
+end;
+
procedure TForm1.PathButtonClick(Sender: TObject);
begin
if UpCharsDialog.Execute then
diff --git a/Units/MMLAddon/mmlpsthread.pas b/Units/MMLAddon/mmlpsthread.pas
index de61c4d..7d9cc80 100644
--- a/Units/MMLAddon/mmlpsthread.pas
+++ b/Units/MMLAddon/mmlpsthread.pas
@@ -98,7 +98,7 @@ threadvar
CurrThread : TMMLPSThread;
implementation
uses
- dtmutil,
+ colour_conv,dtmutil,
{$ifdef mswindows}windows,{$endif}
uPSC_std, uPSC_controls,uPSC_classes,uPSC_graphics,uPSC_stdctrls,uPSC_forms,
uPSC_extctrls, //Compile-libs
@@ -108,7 +108,6 @@ uses
Graphics, //For Graphics types
math, //Maths!
strutils,
- colour_conv,
input,
tpa, //Tpa stuff
forms,//Forms
diff --git a/Units/MMLCore/ocr.pas b/Units/MMLCore/ocr.pas
index 67703d3..5023fe8 100644
--- a/Units/MMLCore/ocr.pas
+++ b/Units/MMLCore/ocr.pas
@@ -38,7 +38,8 @@ uses
constructor Create(Owner: TObject);
destructor Destroy; override;
function InitTOCR(path: string; shadow: Boolean): boolean;
- function getTextPointsIn(sx, sy, w, h: Integer; shadow: boolean): TNormArray;
+ function getTextPointsIn(sx, sy, w, h: Integer; shadow: boolean; spacing: Integer): TNormArray;
+ function GetUpTextAtEx(atX, atY: integer; shadow: boolean; Spacing: Integer): string;
function GetUpTextAt(atX, atY: integer; shadow: boolean): string;
private
Client: TObject;
@@ -54,7 +55,7 @@ uses
implementation
uses
- colour_conv, client, files;
+ colour_conv, client, files, tpa, mufasatypesutil;
const
ocr_Limit_High = 190;
@@ -75,7 +76,7 @@ const
Non optimised. ;-)
}
-function TMOCR.getTextPointsIn(sx, sy, w, h: Integer; shadow: boolean): TNormArray;
+function TMOCR.getTextPointsIn(sx, sy, w, h: Integer; shadow: boolean; spacing: integer): TNormArray;
var
bmp: TMufasaBitmap;
x,y: integer;
@@ -84,7 +85,12 @@ var
{$IFDEF OCRDEBUG}
dx,dy: integer;
{$ENDIF}
-
+ {$IFDEF OCRTPA}
+ t: tpointarray;
+ at, atf,att: T2DPointArray;
+ pc: integer;
+ max_len: integer;
+ {$ENDIF}
begin
bmp := TMufasaBitmap.Create;
@@ -97,7 +103,7 @@ begin
{$IFDEF OCRDEBUG}
debugbmp := TMufasaBitmap.Create;
- debugbmp.SetSize(w, (h + 2) * 4);
+ debugbmp.SetSize(w, (h + 2) * 5);
{$ENDIF}
{$IFDEF OCRSAVEBITMAP}
@@ -266,11 +272,6 @@ 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) = clPurple then
begin
bmp.FastSetPixel(x,y,0);
@@ -292,17 +293,33 @@ begin
for y := 0 to bmp.Height -1 do
bmp.fastsetpixel(0, y, 0);
+ {$IFDEF OCRTPA}
+ pc := 0;
+ setlength(t, bmp.Height * bmp.Width);
+ {$ENDIF}
+
setlength(n, bmp.Height * bmp.Width);
for y := 0 to bmp.Height - 1 do
for x := 0 to bmp.Width - 1 do
begin
if bmp.fastgetpixel(x,y) > 0 then
- n[x + y * bmp.width] := 1
+ 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;
+ n[x
+ + y * bmp.width] := 0;
end;
+ {$IFDEF OCRTPA}
+ setlength(t,pc);
+ {$ENDIF}
+
result := n;
{$IFDEF OCRSAVEBITMAP}
bmp.SaveToFile('/tmp/ocrfinal.bmp');
@@ -312,6 +329,64 @@ begin
for dx := 0 to bmp.width - 1 do
debugbmp.fastsetpixel(dx,dy+h+h+h,bmp.fastgetpixel(dx,dy));
{$ENDIF}
+
+ {$IFDEF OCRTPA}
+ at:=splittpaex(t,spacing,bmp.height);
+
+ {
+ // 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;
+
+ 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;
+
+ 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; }
+
+ 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}
+
+
bmp.Free;
{ Dangerous removes all pixels that had no pixels on x-1 or x+1}
{ for y := 0 to bmp.Height - 2 do
@@ -369,19 +444,25 @@ begin
result := false;
end;
-function TMOCR.GetUpTextAt(atX, atY: integer; shadow: boolean): string;
-
+function TMOCR.GetUpTextAtEx(atX, atY: integer; shadow: boolean; spacing: Integer): string;
var
n:Tnormarray;
ww, hh: integer;
-
begin
ww := 400;
hh := 20;
- n := getTextPointsIn(atX, atY, ww, hh, shadow);
+ n := getTextPointsIn(atX, atY, ww, hh, shadow, spacing);
Result := ocrDetect(n, ww, hh, OCRData[0]);
- //writeln(result);
+end;
+
+function TMOCR.GetUpTextAt(atX, atY: integer; shadow: boolean): string;
+
+begin
+ if shadow then
+ result := GetUpTextAtEx(atX, atY, shadow, 2)
+ else
+ result := GetUpTextAtEx(atX, atY, shadow, 1);
end;
{
function TMOCR.GetUpTextAt(atX, atY: integer): string;