moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2025-02-07 10:40:19 -05:00
Code Issues Releases Wiki Activity

Big OCR update. Also added redundant ConvTPAArr to mufasatypesutil,

Browse Source 
added Copy() to TMufasaBitmap, and added GetDirectories to files.



git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@318 3f818213-9676-44b0-a9b4-5e4c4e03d09d
This commit is contained in:
Wizzup? 2009-12-22 22:52:02 +00:00
parent 36d0cc2f9c
commit 20a66b3854
9 changed files with 2286 additions and 2094 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

201
Projects/OCRBench/project1.lpi
View File

@ -31,12 +31,12 @@
<PackageName Value="LCL"/> <PackageName Value="LCL"/>
</Item1> </Item1>
</RequiredPackages> </RequiredPackages>
<Units Count="11"> <Units Count="15">
<Unit0> <Unit0>
<Filename Value="project1.lpr"/> <Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="project1"/> <UnitName Value="project1"/>
<UsageCount Value="28"/> <UsageCount Value="49"/>
</Unit0> </Unit0>
<Unit1> <Unit1>
<Filename Value="unit1.pas"/> <Filename Value="unit1.pas"/>
@ -44,10 +44,10 @@
<ComponentName Value="Form1"/> <ComponentName Value="Form1"/>
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/> <UnitName Value="Unit1"/>
<CursorPos X="1" Y="102"/> <CursorPos X="77" Y="89"/>
<TopLine Value="90"/> <TopLine Value="62"/>
<EditorIndex Value="0"/> <EditorIndex Value="0"/>
<UsageCount Value="28"/> <UsageCount Value="49"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit1> </Unit1>
<Unit2> <Unit2>
@ -58,7 +58,7 @@
<UnitName Value="colourhistory"/> <UnitName Value="colourhistory"/>
<CursorPos X="10" Y="457"/> <CursorPos X="10" Y="457"/>
<TopLine Value="437"/> <TopLine Value="437"/>
<UsageCount Value="13"/> <UsageCount Value="11"/>
</Unit2> </Unit2>
<Unit3> <Unit3>
<Filename Value="../SAMufasaGUI/testunit.pas"/> <Filename Value="../SAMufasaGUI/testunit.pas"/>
@ -68,189 +68,219 @@
<UnitName Value="TestUnit"/> <UnitName Value="TestUnit"/>
<CursorPos X="38" Y="405"/> <CursorPos X="38" Y="405"/>
<TopLine Value="382"/> <TopLine Value="382"/>
<UsageCount Value="10"/> <UsageCount Value="8"/>
</Unit3> </Unit3>
<Unit4> <Unit4>
<Filename Value="../../Units/MMLCore/client.pas"/> <Filename Value="../../Units/MMLCore/client.pas"/>
<UnitName Value="Client"/> <UnitName Value="Client"/>
<CursorPos X="21" Y="52"/> <CursorPos X="25" Y="50"/>
<TopLine Value="32"/> <TopLine Value="31"/>
<EditorIndex Value="2"/> <EditorIndex Value="2"/>
<UsageCount Value="15"/> <UsageCount Value="25"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit4> </Unit4>
<Unit5> <Unit5>
<Filename Value="../../Units/MMLCore/ocr.pas"/> <Filename Value="../../Units/MMLCore/ocr.pas"/>
<UnitName Value="ocr"/> <UnitName Value="ocr"/>
<CursorPos X="77" Y="93"/> <CursorPos X="18" Y="467"/>
<TopLine Value="153"/> <TopLine Value="448"/>
<EditorIndex Value="3"/> <EditorIndex Value="4"/>
<UsageCount Value="15"/> <UsageCount Value="25"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit5> </Unit5>
<Unit6> <Unit6>
<Filename Value="../../Units/MMLCore/bitmaps.pas"/> <Filename Value="../../Units/MMLCore/bitmaps.pas"/>
<UnitName Value="bitmaps"/> <UnitName Value="bitmaps"/>
<CursorPos X="25" Y="436"/> <CursorPos X="18" Y="81"/>
<TopLine Value="416"/> <TopLine Value="47"/>
<EditorIndex Value="6"/> <EditorIndex Value="8"/>
<UsageCount Value="14"/> <UsageCount Value="24"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit6> </Unit6>
<Unit7> <Unit7>
<Filename Value="../../Units/MMLCore/ocrutil.pas"/> <Filename Value="../../Units/MMLCore/ocrutil.pas"/>
<UnitName Value="ocrutil"/> <UnitName Value="ocrutil"/>
<CursorPos X="20" Y="267"/> <CursorPos X="54" Y="198"/>
<TopLine Value="1"/> <TopLine Value="115"/>
<EditorIndex Value="1"/> <EditorIndex Value="1"/>
<UsageCount Value="14"/> <UsageCount Value="24"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit7> </Unit7>
<Unit8> <Unit8>
<Filename Value="../../../../Documents/lazarus/lcl/interfaces/gtk/gtkwidgetset.inc"/> <Filename Value="../../../../Documents/lazarus/lcl/interfaces/gtk/gtkwidgetset.inc"/>
<CursorPos X="41" Y="1226"/> <CursorPos X="41" Y="1226"/>
<TopLine Value="1205"/> <TopLine Value="1205"/>
<UsageCount Value="10"/> <UsageCount Value="8"/>
</Unit8> </Unit8>
<Unit9> <Unit9>
<Filename Value="../../Units/MMLAddon/tpa.pas"/> <Filename Value="../../Units/MMLAddon/tpa.pas"/>
<UnitName Value="tpa"/> <UnitName Value="tpa"/>
<CursorPos X="68" Y="798"/> <CursorPos X="5" Y="557"/>
<TopLine Value="779"/> <TopLine Value="535"/>
<EditorIndex Value="5"/> <EditorIndex Value="7"/>
<UsageCount Value="12"/> <UsageCount Value="22"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit9> </Unit9>
<Unit10> <Unit10>
<Filename Value="../../Units/MMLCore/mufasatypesutil.pas"/> <Filename Value="../../Units/MMLCore/mufasatypesutil.pas"/>
<UnitName Value="mufasatypesutil"/> <UnitName Value="mufasatypesutil"/>
<CursorPos X="1" Y="1"/> <CursorPos X="23" Y="23"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<EditorIndex Value="4"/> <EditorIndex Value="6"/>
<UsageCount Value="11"/> <UsageCount Value="21"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit10> </Unit10>
<Unit11>
<Filename Value="../../Units/MMLCore/finder.pas"/>
<UnitName Value="finder"/>
<CursorPos X="78" Y="455"/>
<TopLine Value="432"/>
<EditorIndex Value="3"/>
<UsageCount Value="18"/>
<Loaded Value="True"/>
</Unit11>
<Unit12>
<Filename Value="../../../../Documents/fpc/rtl/inc/objpash.inc"/>
<CursorPos X="48" Y="193"/>
<TopLine Value="1"/>
<UsageCount Value="8"/>
</Unit12>
<Unit13>
<Filename Value="../../../../Documents/fpc/rtl/objpas/sysutils/finah.inc"/>
<CursorPos X="17" Y="40"/>
<TopLine Value="4"/>
<UsageCount Value="9"/>
</Unit13>
<Unit14>
<Filename Value="../../Units/MMLCore/files.pas"/>
<UnitName Value="files"/>
<CursorPos X="7" Y="103"/>
<TopLine Value="73"/>
<EditorIndex Value="5"/>
<UsageCount Value="15"/>
<Loaded Value="True"/>
</Unit14>
</Units> </Units>
<JumpHistory Count="30" HistoryIndex="29"> <JumpHistory Count="30" HistoryIndex="29">
<Position1> <Position1>
<Filename Value="unit1.pas"/> <Filename Value="../../Units/MMLCore/ocr.pas"/>
<Caret Line="87" Column="27" TopLine="56"/> <Caret Line="571" Column="25" TopLine="551"/>
</Position1> </Position1>
<Position2> <Position2>
<Filename Value="unit1.pas"/> <Filename Value="../../Units/MMLCore/ocr.pas"/>
<Caret Line="72" Column="4" TopLine="56"/> <Caret Line="581" Column="4" TopLine="550"/>
</Position2> </Position2>
<Position3> <Position3>
<Filename Value="unit1.pas"/> <Filename Value="../../Units/MMLCore/ocr.pas"/>
<Caret Line="70" Column="70" TopLine="56"/> <Caret Line="575" Column="3" TopLine="555"/>
</Position3> </Position3>
<Position4> <Position4>
<Filename Value="../../Units/MMLCore/ocrutil.pas"/> <Filename Value="../../Units/MMLCore/ocr.pas"/>
<Caret Line="169" Column="23" TopLine="156"/> <Caret Line="458" Column="25" TopLine="425"/>
</Position4> </Position4>
<Position5> <Position5>
<Filename Value="unit1.pas"/> <Filename Value="../../Units/MMLCore/ocr.pas"/>
<Caret Line="71" Column="29" TopLine="44"/> <Caret Line="459" Column="121" TopLine="440"/>
</Position5> </Position5>
<Position6> <Position6>
<Filename Value="../../Units/MMLCore/ocrutil.pas"/> <Filename Value="../../Units/MMLCore/ocr.pas"/>
<Caret Line="184" Column="58" TopLine="160"/> <Caret Line="588" Column="39" TopLine="560"/>
</Position6> </Position6>
<Position7> <Position7>
<Filename Value="unit1.pas"/> <Filename Value="../../Units/MMLCore/ocr.pas"/>
<Caret Line="74" Column="107" TopLine="58"/> <Caret Line="593" Column="5" TopLine="563"/>
</Position7> </Position7>
<Position8> <Position8>
<Filename Value="../../Units/MMLCore/ocr.pas"/> <Filename Value="../../Units/MMLCore/ocr.pas"/>
<Caret Line="57" Column="33" TopLine="37"/> <Caret Line="588" Column="7" TopLine="575"/>
</Position8> </Position8>
<Position9> <Position9>
<Filename Value="../../Units/MMLAddon/tpa.pas"/> <Filename Value="../../Units/MMLCore/ocr.pas"/>
<Caret Line="30" Column="64" TopLine="25"/> <Caret Line="585" Column="7" TopLine="563"/>
</Position9> </Position9>
<Position10> <Position10>
<Filename Value="../../Units/MMLAddon/tpa.pas"/> <Filename Value="../../Units/MMLCore/finder.pas"/>
<Caret Line="63" Column="20" TopLine="44"/> <Caret Line="64" Column="27" TopLine="49"/>
</Position10> </Position10>
<Position11> <Position11>
<Filename Value="../../Units/MMLCore/ocr.pas"/> <Filename Value="../../Units/MMLCore/finder.pas"/>
<Caret Line="89" Column="20" TopLine="70"/> <Caret Line="65" Column="27" TopLine="49"/>
</Position11> </Position11>
<Position12> <Position12>
<Filename Value="unit1.pas"/> <Filename Value="../../Units/MMLCore/ocr.pas"/>
<Caret Line="94" Column="57" TopLine="71"/> <Caret Line="583" Column="67" TopLine="551"/>
</Position12> </Position12>
<Position13> <Position13>
<Filename Value="unit1.pas"/> <Filename Value="../../Units/MMLCore/ocr.pas"/>
<Caret Line="96" Column="57" TopLine="71"/> <Caret Line="597" Column="18" TopLine="576"/>
</Position13> </Position13>
<Position14> <Position14>
<Filename Value="unit1.pas"/> <Filename Value="../../Units/MMLCore/ocr.pas"/>
<Caret Line="98" Column="61" TopLine="82"/> <Caret Line="601" Column="7" TopLine="576"/>
</Position14> </Position14>
<Position15> <Position15>
<Filename Value="unit1.pas"/> <Filename Value="../../Units/MMLCore/ocr.pas"/>
<Caret Line="114" Column="13" TopLine="88"/> <Caret Line="581" Column="39" TopLine="564"/>
</Position15> </Position15>
<Position16> <Position16>
<Filename Value="unit1.pas"/> <Filename Value="../../Units/MMLCore/ocr.pas"/>
<Caret Line="96" Column="61" TopLine="77"/> <Caret Line="594" Column="7" TopLine="574"/>
</Position16> </Position16>
<Position17> <Position17>
<Filename Value="unit1.pas"/> <Filename Value="../../Units/MMLCore/ocr.pas"/>
<Caret Line="103" Column="10" TopLine="77"/> <Caret Line="622" Column="79" TopLine="588"/>
</Position17> </Position17>
<Position18> <Position18>
<Filename Value="unit1.pas"/> <Filename Value="unit1.pas"/>
<Caret Line="102" Column="8" TopLine="84"/> <Caret Line="54" Column="20" TopLine="1"/>
</Position18> </Position18>
<Position19> <Position19>
<Filename Value="../../Units/MMLCore/ocr.pas"/> <Filename Value="unit1.pas"/>
<Caret Line="42" Column="36" TopLine="25"/> <Caret Line="53" Column="20" TopLine="15"/>
</Position19> </Position19>
<Position20> <Position20>
<Filename Value="unit1.pas"/> <Filename Value="unit1.pas"/>
<Caret Line="108" Column="47" TopLine="84"/> <Caret Line="45" Column="65" TopLine="39"/>
</Position20> </Position20>
<Position21> <Position21>
<Filename Value="../../Units/MMLCore/ocr.pas"/> <Filename Value="unit1.pas"/>
<Caret Line="333" Column="23" TopLine="301"/> <Caret Line="119" Column="5" TopLine="93"/>
</Position21> </Position21>
<Position22> <Position22>
<Filename Value="unit1.pas"/> <Filename Value="unit1.pas"/>
<Caret Line="109" Column="28" TopLine="89"/> <Caret Line="30" Column="68" TopLine="6"/>
</Position22> </Position22>
<Position23> <Position23>
<Filename Value="../../Units/MMLCore/ocr.pas"/> <Filename Value="unit1.pas"/>
<Caret Line="356" Column="43" TopLine="325"/> <Caret Line="105" Column="3" TopLine="73"/>
</Position23> </Position23>
<Position24> <Position24>
<Filename Value="../../Units/MMLCore/ocr.pas"/> <Filename Value="../../Units/MMLCore/ocr.pas"/>
<Caret Line="343" Column="17" TopLine="324"/> <Caret Line="12" Column="77" TopLine="1"/>
</Position24> </Position24>
<Position25> <Position25>
<Filename Value="../../Units/MMLCore/ocr.pas"/> <Filename Value="../../Units/MMLCore/ocr.pas"/>
<Caret Line="346" Column="11" TopLine="331"/> <Caret Line="37" Column="77" TopLine="26"/>
</Position25> </Position25>
<Position26> <Position26>
<Filename Value="../../Units/MMLCore/ocr.pas"/> <Filename Value="../../Units/MMLCore/ocr.pas"/>
<Caret Line="355" Column="37" TopLine="331"/> <Caret Line="619" Column="28" TopLine="592"/>
</Position26> </Position26>
<Position27> <Position27>
<Filename Value="../../Units/MMLCore/ocr.pas"/> <Filename Value="../../Units/MMLCore/ocr.pas"/>
<Caret Line="351" Column="33" TopLine="332"/> <Caret Line="527" Column="41" TopLine="496"/>
</Position27> </Position27>
<Position28> <Position28>
<Filename Value="../../Units/MMLCore/bitmaps.pas"/> <Filename Value="../../Units/MMLCore/ocrutil.pas"/>
<Caret Line="368" Column="49" TopLine="337"/> <Caret Line="57" Column="21" TopLine="37"/>
</Position28> </Position28>
<Position29> <Position29>
<Filename Value="../../Units/MMLCore/ocr.pas"/> <Filename Value="../../Units/MMLCore/ocr.pas"/>
<Caret Line="351" Column="37" TopLine="332"/> <Caret Line="467" Column="18" TopLine="448"/>
</Position29> </Position29>
<Position30> <Position30>
<Filename Value="../../Units/MMLCore/ocr.pas"/> <Filename Value="../../Units/MMLAddon/tpa.pas"/>
<Caret Line="377" Column="57" TopLine="347"/> <Caret Line="50" Column="33" TopLine="30"/>
</Position30> </Position30>
</JumpHistory> </JumpHistory>
</ProjectOptions> </ProjectOptions>
@ -264,7 +294,15 @@
<OtherUnitFiles Value="$(ProjPath)../../Units/MMLCore/;$(ProjPath)../../Units/MMLAddon/;$(ProjPath)../../Units/PascalScript/;$(ProjPath)../../Units/Misc/;$(ProjPath)../../Units/MMLAddon/PSInc/;$(ProjPath)../../Units/Linux/;$(LazarusDir)/components/mouseandkeyinput/"/> <OtherUnitFiles Value="$(ProjPath)../../Units/MMLCore/;$(ProjPath)../../Units/MMLAddon/;$(ProjPath)../../Units/PascalScript/;$(ProjPath)../../Units/Misc/;$(ProjPath)../../Units/MMLAddon/PSInc/;$(ProjPath)../../Units/Linux/;$(LazarusDir)/components/mouseandkeyinput/"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths> </SearchPaths>
<CodeGeneration>
<Optimizations>
<OptimizationLevel Value="3"/>
</Optimizations>
</CodeGeneration>
<Linking> <Linking>
<Debugging>
<GenerateDebugInfo Value="True"/>
</Debugging>
<Options> <Options>
<Win32> <Win32>
<GraphicApplication Value="True"/> <GraphicApplication Value="True"/>
@ -273,7 +311,8 @@
</Linking> </Linking>
<Other> <Other>
<CustomOptions Value="-dOCRDEBUG <CustomOptions Value="-dOCRDEBUG
-dOCRTPA"/> -dOCRTPA
-dOCRSAVEBITMAP"/>
<CompilerPath Value="$(CompPath)"/> <CompilerPath Value="$(CompPath)"/>
</Other> </Other>
</CompilerOptions> </CompilerOptions>

18
Projects/OCRBench/unit1.lfm
View File

@ -48,26 +48,8 @@ object Form1: TForm1
Top = 112 Top = 112
Width = 79 Width = 79
Caption = 'Shadow?' Caption = 'Shadow?'
OnChange = FShadowChange
TabOrder = 3 TabOrder = 3
end 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 object OCRFileOpen: TOpenDialog
Filter = '.bmp' Filter = '.bmp'
left = 416 left = 416

61
Projects/OCRBench/unit1.pas
View File

@ -14,8 +14,6 @@ type
TForm1 = class(TForm) TForm1 = class(TForm)
BitmapButton: TButton; BitmapButton: TButton;
SplitLabel: TLabel;
SplitEdit: TEdit;
FShadow: TCheckBox; FShadow: TCheckBox;
PathButton: TButton; PathButton: TButton;
OCRButton: TButton; OCRButton: TButton;
@ -24,12 +22,11 @@ type
UpCharsDialog: TSelectDirectoryDialog; UpCharsDialog: TSelectDirectoryDialog;
procedure BitmapButtonClick(Sender: TObject); procedure BitmapButtonClick(Sender: TObject);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure FShadowChange(Sender: TObject);
procedure OCRButtonClick(Sender: TObject); procedure OCRButtonClick(Sender: TObject);
procedure PathButtonClick(Sender: TObject); procedure PathButtonClick(Sender: TObject);
private private
BitmapPath: String; BitmapPath: String;
UpTextPath: String; FontPath: String;
{ private declarations } { private declarations }
public public
{ public declarations } { public declarations }
@ -52,7 +49,7 @@ Var
x,y: integer; x,y: integer;
s: string; s: string;
Shadow: boolean; Shadow: boolean;
Spacing: Integer; t: dword;
begin begin
if not FileExists(BitmapPath) then if not FileExists(BitmapPath) then
@ -63,12 +60,12 @@ begin
BitmapPath := OCRFileOpen.FileName; BitmapPath := OCRFileOpen.FileName;
Exit; Exit;
end; end;
if not DirectoryExists(UpTextPath) then if not DirectoryExists(FontPath) then
begin 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); MB_OK);
if UpCharsDialog.Execute then if UpCharsDialog.Execute then
UpTextPath := UpCharsDialog.FileName; FontPath := UpCharsDialog.FileName;
Exit; Exit;
end; end;
@ -83,40 +80,34 @@ begin
Shadow :=FShadow.Checked; 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 // DS + .. + DS because InitOCR wants the directory of the Fonts, not UpChars
// only. // only.
C.MOCR.InitTOCR(UpTextPath + DS + '..' + DS, Shadow); C.MOCR.InitTOCR(FontPath, Shadow);
s := C.MOCR.GetUpTextAtEx(7,7, Shadow, Spacing);
t:=gettickcount;
s := C.MOCR.GetUpTextAtEx(7, 7, Shadow);
writeln(inttostr(gettickcount-t));
// write to debugbmp // write to debugbmp
{$IFDEF OCRDEBUG}
for y := 0 to C.MOCR.debugbmp.Height - 1 do for y := 0 to C.MOCR.debugbmp.Height - 1 do
for x := 0 to C.MOCR.debugbmp.Width -1 do for x := 0 to C.MOCR.debugbmp.Width -1 do
Form1.Image1.Canvas.Pixels[x,y] := C.MOCR.debugbmp.FastGetPixel(x,y); Form1.Image1.Canvas.Pixels[x,y] := C.MOCR.debugbmp.FastGetPixel(x,y);
// print ocr'ed text // print ocr'ed text
Form1.Image1.Canvas.Font.Color:=clRed; Form1.Image1.Canvas.Font.Color:=clRed;
Form1.Image1.Canvas.TextOut(0, C.MOCR.debugbmp.Height, s); 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'); Form1.Image1.Picture.SaveToFile('/tmp/ocrbench.bmp');
bmp.Free;
C.Free; C.Free;
Application.ProcessMessages;
end; end;
procedure TForm1.BitmapButtonClick(Sender: TObject); procedure TForm1.BitmapButtonClick(Sender: TObject);
@ -127,22 +118,14 @@ end;
procedure TForm1.FormCreate(Sender: TObject); procedure TForm1.FormCreate(Sender: TObject);
begin begin
BitmapPath := '/home/merlijn/Programs/mufasa/pics/uptext2.bmp'; BitmapPath := '/home/merlijn/Programs/mufasa/pics/uptext4.bmp';
UpTextPath := '/home/merlijn/Programs/mufasa/Fonts/UpChars'; FontPath := '/home/merlijn/Programs/mufasa/Fonts/';
end;
procedure TForm1.FShadowChange(Sender: TObject);
begin
if Form1.FShadow.Checked then
Form1.SplitEdit.Text:='2'
else
Form1.SplitEdit.Text:='1';
end; end;
procedure TForm1.PathButtonClick(Sender: TObject); procedure TForm1.PathButtonClick(Sender: TObject);
begin begin
if UpCharsDialog.Execute then if UpCharsDialog.Execute then
UpTextPath := UpCharsDialog.FileName; FontPath := UpCharsDialog.FileName;
end; end;
initialization initialization

4
Units/MMLAddon/PSInc/Wrappers/ocr.inc
View File

@ -1,5 +1,5 @@
function rs_GetUpText: String; function rs_GetUpText: String;
begin begin
Result := CurrThread.Client.MOCR.GetUpTextAt(7, 7, false); // why the hell does it still not use shadows?
{writeln('inside: ' + result);} Result := CurrThread.Client.MOCR.GetUpTextAtEx(7, 7, true);
end; end;

3296
Units/MMLAddon/tpa.pas
View File

File diff suppressed because it is too large Load Diff

8
Units/MMLCore/bitmaps.pas
View File

@ -78,6 +78,7 @@ type
procedure Invert; procedure Invert;
procedure Posterize(TargetBitmap : TMufasaBitmap; Po : integer);overload; procedure Posterize(TargetBitmap : TMufasaBitmap; Po : integer);overload;
procedure Posterize(Po : integer);overload; procedure Posterize(Po : integer);overload;
function Copy: TMufasaBitmap;
function CreateTMask : TMask; function CreateTMask : TMask;
constructor Create; constructor Create;
destructor Destroy;override; destructor Destroy;override;
@ -377,6 +378,13 @@ begin;
Result := BGR.R or BGR.g shl 8 or BGR.b shl 16; Result := BGR.R or BGR.g shl 8 or BGR.b shl 16;
end; 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); procedure TMufasaBitmap.FastSetPixel(x, y: integer; Color: TColor);
begin begin
ValidatePoint(x,y); ValidatePoint(x,y);

20
Units/MMLCore/files.pas
View File

@ -64,6 +64,7 @@ type
// We don't need one per object. :-) // We don't need one per object. :-)
function GetFiles(Path, Ext: string): TStringArray; function GetFiles(Path, Ext: string): TStringArray;
function GetDirectories(Path: string): TstringArray;
implementation implementation
uses uses
@ -88,6 +89,25 @@ begin
end; end;
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; constructor TMFiles.Create;
begin begin
inherited Create; inherited Create;

114
Units/MMLCore/mufasatypesutil.pas
View File

@ -1,51 +1,63 @@
unit mufasatypesutil; unit mufasatypesutil;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
interface interface
uses uses
Classes, SysUtils,mufasatypes; Classes, SysUtils,mufasatypes;
function ConvArr(Arr: array of TPoint): TPointArray; overload; function ConvArr(Arr: array of TPoint): TPointArray; overload;
function ConvArr(Arr: array of TPointArray): T2DPointArray; overload; function ConvArr(Arr: array of TPointArray): T2DPointArray; overload;
function ConvArr(Arr: array of Integer): TIntegerArray; 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; implementation
var
Len : Integer; function ConvArr(Arr: array of TPoint): TPointArray; overload;
begin; var
Len := Length(Arr); Len : Integer;
SetLength(Result, Len); begin;
Move(Arr[Low(Arr)], Result[0], Len*SizeOf(TPoint)); Len := Length(Arr);
end; SetLength(Result, Len);
Move(Arr[Low(Arr)], Result[0], Len*SizeOf(TPoint));
function ConvArr(Arr: array of TPointArray): T2DPointArray; overload; end;
var
Len,Len2 : Integer; function ConvTPAArr(Arr: array of TPoint): TPointArray; overload;
i : integer; var
begin; Len : Integer;
Len := Length(Arr); begin;
SetLength(Result, Len); Len := Length(Arr);
for i := Len - 1 downto 0 do SetLength(Result, Len);
begin Move(Arr[Low(Arr)], Result[0], Len*SizeOf(TPoint));
Len2 := Length(Arr[i]); end;
SetLength(result[i],len2);
Move(Arr[i][0],Result[i][0],Len2*SizeOf(TPoint));
end; function ConvArr(Arr: array of TPointArray): T2DPointArray; overload;
end; var
Len,Len2 : Integer;
function ConvArr(Arr: array of Integer): TIntegerArray; overload; i : integer;
var begin;
Len : Integer; Len := Length(Arr);
begin; SetLength(Result, Len);
Len := Length(Arr); for i := Len - 1 downto 0 do
SetLength(Result, Len); begin
Move(Arr[Low(Arr)], Result[0], Len*SizeOf(Integer)); Len2 := Length(Arr[i]);
end; SetLength(result[i],len2);
Move(Arr[i][0],Result[i][0],Len2*SizeOf(TPoint));
end. 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.

658
Units/MMLCore/ocr.pas
View File

@ -38,12 +38,25 @@ uses
constructor Create(Owner: TObject); constructor Create(Owner: TObject);
destructor Destroy; override; destructor Destroy; override;
function InitTOCR(path: string; shadow: Boolean): boolean; function InitTOCR(path: string; shadow: Boolean): boolean;
function getTextPointsIn(sx, sy, w, h: Integer; shadow: boolean; spacing: Integer): TNormArray; function GetFontIndex(FontName: string): integer;
function GetUpTextAtEx(atX, atY: integer; shadow: boolean; Spacing: Integer): string; 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; 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 private
Client: TObject; Client: TObject;
OCRData: TocrDataArray; OCRData: TocrDataArray;
OCRNames: Array Of String;
OCRPath: string; OCRPath: string;
{$IFDEF OCRDEBUG} {$IFDEF OCRDEBUG}
public public
@ -104,44 +117,12 @@ We can also just split the chars, and then use their shadow.
Non optimised. ;-) Non optimised. ;-)
} }
function TMOCR.getTextPointsIn(sx, sy, w, h: Integer; shadow: boolean; spacing: integer): TNormArray; procedure TMOCR.FilterUpTextByColour(bmp: TMufasaBitmap; w,h: integer);
var var
bmp: TMufasaBitmap; x, y,r, g, b: Integer;
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}
begin begin
bmp := TMufasaBitmap.Create; // We're going to filter the bitmap solely on colours first.
// If we found one, we set it to it's `normal' colour.
{ 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}
for y := 0 to bmp.Height - 1 do for y := 0 to bmp.Height - 1 do
for x := 0 to bmp.Width - 1 do for x := 0 to bmp.Width - 1 do
begin begin
@ -204,231 +185,302 @@ begin
bmp.fastsetpixel(x,y,0); bmp.fastsetpixel(x,y,0);
end; end;
// make outline black for shadow characteristics filter
// first and last horiz line = 0 // first and last horiz line = 0
for x := 0 to bmp.width -1 do for x := 0 to bmp.width -1 do
bmp.fastsetpixel(x,0,0); bmp.fastsetpixel(x,0,0);
for x := 0 to bmp.width -1 do for x := 0 to bmp.width -1 do
bmp.fastsetpixel(x,bmp.height-1,0); bmp.fastsetpixel(x,bmp.height-1,0);
{ for y := 0 to bmp.Height -1 do // same for vertical lines
bmp.fastsetpixel(0, y, 0); } 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} procedure TMOCR.FilterUpTextByCharacteristics(bmp: TMufasaBitmap; w,h: integer);
bmp.SaveToFile('/tmp/ocrcol.bmp'); var
{$ENDIF} x,y: Integer;
{$IFDEF OCRDEBUG} begin
for dy := 0 to bmp.height - 1 do // Filter 2
for dx := 0 to bmp.width - 1 do // This performs a `simple' filter.
debugbmp.fastsetpixel(dx,dy+h,bmp.fastgetpixel(dx,dy)); // What we are doing here is simple checking that if Colour[x,y] is part
{$ENDIF} // of the uptext, then so must Colour[x+1,y+1], or Colour[x+1,y+1] is a shadow.
for y := 0 to bmp.Height - 2 do // if it is neither, we can safely remove it.
for x := 0 to bmp.Width - 2 do 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 begin
if bmp.fastgetpixel(x,y) = clPurple then if bmp.fastgetpixel(x,y) = clPurple then
begin
bmp.FastSetPixel(x,y,0);
continue; continue;
if bmp.fastgetpixel(x,y) = clBlack then end;
if bmp.fastgetpixel(x,y) = clOlive then
begin
bmp.FastSetPixel(x,y,0);
continue; continue;
if (bmp.fastgetpixel(x,y) <> bmp.fastgetpixel(x+1,y+1)) and (bmp.fastgetpixel(x+1,y+1) <> clpurple) then end;
bmp.fastsetpixel(x,y,{clAqua}0); if bmp.fastgetpixel(x,y) = clSilver then
begin
bmp.FastSetPixel(x,y,0);
continue;
end;
end; end;
end;
end;
{ Optional - remove false shadow } function TMOCR.getTextPointsIn(sx, sy, w, h: Integer; shadow: boolean;
for y := bmp.Height - 1 downto 1 do var _chars, _shadows: T2DPointArray): Boolean;
for x := bmp.Width - 1 downto 1 do var
begin bmp, shadowsbmp, charsbmp: TMufasaBitmap;
if bmp.fastgetpixel(x,y) <> clPurple then x,y: integer;
continue; r,g,b: integer;
if bmp.fastgetpixel(x,y) = bmp.fastgetpixel(x-1,y-1) then n: TNormArray;
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 ;) }
{$IFDEF OCRDEBUG} {$IFDEF OCRDEBUG}
for dy := 0 to bmp.height - 1 do dx,dy: integer;
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');
{$ENDIF} {$ENDIF}
shadows: T2DPointArray;
helpershadow: TPointArray;
chars: TPointArray;
charscount: integer;
chars_2d, chars_2d_b, finalchars: T2DPointArray;
pc: integer;
bb: Tbox;
if shadow then begin
begin bmp := TMufasaBitmap.Create;
for y := 0 to bmp.Height - 1 do { Increase to create a black horizonal line at the top and at the bottom }
for x := 0 to bmp.Width - 1 do { This so the crappy algo can do it's work correctly. }
begin bmp.SetSize(w + 2, h + 2);
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;
for y := 0 to bmp.Height -1 do // Copy the client to out working bitmap.
bmp.fastsetpixel(0, y, 0); bmp.CopyClientToBitmap(TClient(Client).MWindow, False, 1{0},1, sx, sy, sx + w - 1, sy + h - 1);
{$IFDEF OCRTPA} {$IFDEF OCRSAVEBITMAP}
pc := 0; bmp.SaveToFile('/tmp/ocrinit.bmp');
setlength(t, bmp.Height * bmp.Width); {$ENDIF}
{$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 // Filter 1
for x := 0 to bmp.Width - 1 do FilterUpTextByColour(bmp,w,h);
begin {$IFDEF OCRSAVEBITMAP}
if bmp.fastgetpixel(x,y) > 0 then bmp.SaveToFile('/tmp/ocrcol.bmp');
begin {$ENDIF}
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;
{$IFDEF OCRTPA} {$IFDEF OCRDEBUG}
setlength(t,pc); DebugToBmp(bmp,1,h);
{$ENDIF} {$ENDIF}
result := n; FilterUpTextByCharacteristics(bmp,w,h);
{$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}
{$IFDEF OCRTPA} {$IFDEF OCRSAVEBITMAP}
at:=splittpaex(t,spacing,bmp.height); bmp.SaveToFile('/tmp/ocrdebug.bmp');
{$ENDIF}
{$IFDEF OCRDEBUG}
DebugToBmp(bmp,2,h);
{$ENDIF}
{ // create a bitmap with only the shadows on it
// this was to split extra large points into smaller ones, but it usually won't help shadowsbmp := bmp.copy;
if shadow then FilterShadowBitmap(shadowsbmp);
max_len := 30 {$IFDEF OCRDEBUG}
else DebugToBmp(shadowsbmp,3,h);
max_len := 50; {$ENDIF}
for x := 0 to high(at) do // create a bitmap with only the chars on it
begin charsbmp := bmp.copy;
if length(at[x]) > max_len then FilterCharsBitmap(charsbmp);
begin {$IFDEF OCRDEBUG}
setlength(t,0); DebugToBmp(charsbmp,4,h);
// t := at[x]; {$ENDIF}
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 // this gets the chars from the bitmap.
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 // TODO:
begin // We should make a different TPA
if length(at[x]) > 70 then // for each colour, rather than put them all in one. Noise can be a of a
begin // differnet colour.
for y := 0 to high(at[x]) do setlength(chars, charsbmp.height * charsbmp.width);
bmp.FastSetPixel(at[x][y].x, at[x][y].y, clOlive); charscount:=0;
end else for y := 0 to charsbmp.height - 1 do
begin for x := 0 to charsbmp.width - 1 do
pc := random(clWhite); begin
for y := 0 to high(at[x]) do if charsbmp.fastgetpixel(x,y) > 0 then
bmp.FastSetPixel(at[x][y].x, at[x][y].y, pc); begin
end; chars[charscount]:=point(x,y);
end; inc(charscount);
{$IFDEF OCRDEBUG} end;
for dy := 0 to bmp.height - 1 do end;
for dx := 0 to bmp.width - 1 do setlength(chars,charscount);
debugbmp.fastsetpixel(dx,dy+h+h+h+h,bmp.fastgetpixel(dx,dy));
{$ENDIF} chars_2d := SplitTPAEx(chars,1,charsbmp.height);
{$ENDIF} 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; SortATPAFromFirstPoint(shadows, point(0,0));
{ Dangerous removes all pixels that had no pixels on x-1 or x+1} for x := 0 to high(shadows) do
{ for y := 0 to bmp.Height - 2 do begin
for x := 1 to bmp.Width - 2 do pc:=0;
begin pc := random(clWhite);
if bmp.fastgetpixel(x,y) = clBlack then continue; //pc := rgbtocolor(integer(round((x+1)*255/length(shadows))), round((x+1)*255/length(shadows)), round((x+1)*255/length(shadows)));
if bmp.fastgetpixel(x,y) = clPurple then continue; for y := 0 to high(shadows[x]) do
if bmp.fastgetpixel(x,y) = clOlive then continue; shadowsbmp.FastSetPixel(shadows[x][y].x, shadows[x][y].y, pc);
if bmp.fastgetpixel(x,y) = clSilver then continue; end;
if bmp.fastgetpixel(x,y) = clLime then continue; {$IFDEF OCRDEBUG}
if (bmp.fastgetpixel(x,y) <> bmp.fastgetpixel(x+1,y) ) and DebugToBmp(shadowsbmp,6,h);
(bmp.fastgetpixel(x,y) <> bmp.fastgetpixel(x-1,y) ) then {$ENDIF}
bmp.fastsetpixel(x,y,clFuchsia);
end; } _chars := finalchars;
_shadows := shadows;
bmp.Free;
end; end;
constructor TMOCR.Create(Owner: TObject); constructor TMOCR.Create(Owner: TObject);
@ -441,9 +493,7 @@ begin
Self.Client := Owner; Self.Client := Owner;
SetLength(OCRData, 0); SetLength(OCRData, 0);
SetLength(OCRNames, 0);
//files := GetFiles('/home/merlijn/Programs/mufasa/ben/upchars', 'bmp');
end; end;
destructor TMOCR.Destroy; destructor TMOCR.Destroy;
@ -451,46 +501,144 @@ destructor TMOCR.Destroy;
begin begin
SetLength(OCRData, 0); SetLength(OCRData, 0);
SetLength(OCRNames, 0);
inherited Destroy; inherited Destroy;
end; end;
function TMOCR.InitTOCR(path: string; shadow: boolean): boolean; function TMOCR.InitTOCR(path: string; shadow: boolean): boolean;
var
dirs: array of string;
i: longint;
dir: string;
begin begin
{ This must be dynamic } { This must be dynamic }
writeln(path);
SetLength(OCRData, 2); dirs := GetDirectories(path);
result := true;
OCRPath := path + DS;
if DirectoryExists(path + DS + 'UpChars' + DS) then
OCRData[0] := ocrutil.InitOCR(path + DS + 'UpChars' + DS, shadow)
else
result := false;
if DirectoryExists(path + DS + 'StatChars' + DS) then
OCRData[1] := ocrutil.InitOCR(path + DS + 'StatChars' + DS, shadow) SetLength(OCRData, length(dirs) * 2);
else SetLength(OCRNames, length(dirs) * 2);
result := false;
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; 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 var
n:Tnormarray; n:Tnormarray;
ww, hh: integer; ww, hh,i,j: integer;
font: TocrData;
chars, shadows, thachars: T2DPointArray;
t:Tpointarray;
b,lb:tbox;
lbset: boolean;
begin begin
ww := 400; ww := 400;
hh := 20; hh := 20;
getTextPointsIn(atX, atY, ww, hh, shadow, chars, shadows);
n := getTextPointsIn(atX, atY, ww, hh, shadow, spacing); // only shadow!
Result := ocrDetect(n, ww, hh, OCRData[0]); //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; end;
function TMOCR.GetUpTextAt(atX, atY: integer; shadow: boolean): string; function TMOCR.GetUpTextAt(atX, atY: integer; shadow: boolean): string;
begin begin
if shadow then if shadow then
result := GetUpTextAtEx(atX, atY, shadow, 2) result := GetUpTextAtEx(atX, atY, true)
else else
result := GetUpTextAtEx(atX, atY, shadow, 1); result := GetUpTextAtEx(atX, atY, false);
end; end;
{ {
function TMOCR.GetUpTextAt(atX, atY: integer): string; function TMOCR.GetUpTextAt(atX, atY: integer): string;