From 80ce9744c6691bff3187ea7f9616bedf69d02e52 Mon Sep 17 00:00:00 2001 From: Wizzup? Date: Tue, 22 Dec 2009 01:19:29 +0000 Subject: [PATCH] More OCR changes, but mainly OCRBench changes. git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@314 3f818213-9676-44b0-a9b4-5e4c4e03d09d --- Projects/OCRBench/project1.lpi | 159 ++++++++++++++++++--------------- Projects/OCRBench/unit1.lfm | 35 ++++++-- Projects/OCRBench/unit1.pas | 46 +++++++++- Units/MMLAddon/mmlpsthread.pas | 3 +- Units/MMLCore/ocr.pas | 115 ++++++++++++++++++++---- 5 files changed, 259 insertions(+), 99 deletions(-) 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;