moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2025-01-30 14:50:18 -05:00
Code Issues Releases Wiki Activity

Added 'LoadSystemFont' which allows you to load a font based on one of your system fonts (just like LoadChars2 in scar).

Browse Source
This commit is contained in:
Raymond 2010-04-05 00:35:49 +02:00
parent 6fe68d1267
commit 72539efffd
10 changed files with 297 additions and 240 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
Projects/SAMufasaGUI/testunit.pas
View File

@ -1246,10 +1246,10 @@ begin
begin begin
Self.OCR_Fonts := TMOCR.Create(Thread.Client); Self.OCR_Fonts := TMOCR.Create(Thread.Client);
OCR_Fonts.InitTOCR(fontPath); OCR_Fonts.InitTOCR(fontPath);
Thread.Client.MOCR.SetFonts(OCR_Fonts.GetFonts); Thread.Client.MOCR.Fonts := OCR_Fonts.Fonts
end else end else
if assigned(Self.OCR_Fonts) and loadFontsOnScriptStart then if assigned(Self.OCR_Fonts) and loadFontsOnScriptStart then
Thread.Client.MOCR.SetFonts(OCR_Fonts.GetFonts); Thread.Client.MOCR.Fonts := OCR_Fonts.Fonts;
Se := TMMLSettingsSandbox.Create(SettingsForm.Settings); Se := TMMLSettingsSandbox.Create(SettingsForm.Settings);
Se.Prefix := 'Scripts/'; Se.Prefix := 'Scripts/';

14
Tests/PS/loadsystemfont.simb Normal file
View File

@ -0,0 +1,14 @@
program new;
var
Font : TFont;
begin
Font := TFont.Create;
Font.Name := 'Courier New';
Font.Size := 10;
Font.Style := [];
LoadSystemFont(Font,'test');
DisplayDebugImgWindow(0,0);
DisplayDebugImgWindow(150,50);
DrawBitmapDebugImg(BitmapFromText('BMP[0] has not been freed','test'));
Font.free;
end.

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

@ -1,14 +1,14 @@
function rs_GetUpText: String; extdecl; function ps_rs_GetUpText: String; extdecl;
begin begin
Result := CurrThread.Client.MOCR.GetUpTextAtEx(7, 7, true); Result := CurrThread.Client.MOCR.GetUpTextAtEx(7, 7, true);
end; end;
function rs_GetUpTextAt(x, y : integer): string; extdecl; function ps_rs_GetUpTextAt(x, y : integer): string; extdecl;
begin begin
result := CurrThread.Client.MOCR.GetUpTextAtEx(x,y,true); result := CurrThread.Client.MOCR.GetUpTextAtEx(x,y,true);
end; end;
function BitmapFromText(text, font: String): integer; extdecl; function ps_BitmapFromText(const text, font: String): integer; extdecl;
var var
bmp: TMufasaBitmap; bmp: TMufasaBitmap;
begin begin
@ -16,23 +16,28 @@ begin
Result := CurrThread.Client.MBitmaps.AddBMP(bmp); Result := CurrThread.Client.MBitmaps.AddBMP(bmp);
end; end;
function MaskFromText(text, font: String): TMask; extdecl; function ps_MaskFromText(const text, font: String): TMask; extdecl;
begin begin
Result := CurrThread.Client.MOCR.TextToMask(text,font); Result := CurrThread.Client.MOCR.TextToMask(text,font);
end; end;
procedure TPAFromTextWrap(text, font: String;out w,h : integer;out TPA : TPointArray); extdecl; procedure ps_TPAFromTextWrap(const text, font: String;out w,h : integer;out TPA : TPointArray); extdecl;
begin begin
TPA := CurrThread.Client.MOCR.TextToFontTPA(text, font, w, h); TPA := CurrThread.Client.MOCR.TextToFontTPA(text, font, w, h);
end; end;
function TPAFromText(text, font: String;out w,h : integer): TPointArray; extdecl; function ps_TPAFromText(const text, font: String;out w,h : integer): TPointArray; extdecl;
begin begin
Result := CurrThread.Client.MOCR.TextToFontTPA(text, font, w, h); Result := CurrThread.Client.MOCR.TextToFontTPA(text, font, w, h);
end; end;
function GetTextAt(atX, atY, minvspacing, maxvspacing, hspacing, function ps_GetTextAt(const atX, atY, minvspacing, maxvspacing, hspacing,
color, tol, len: integer; font: string): string; extdecl; color, tol, len: integer;const font: string): string; extdecl;
begin begin
result := CurrThread.Client.MOCR.GetTextAt(atx,aty,minvspacing,maxvspacing,hspacing,color,tol,len,font); result := CurrThread.Client.MOCR.GetTextAt(atx,aty,minvspacing,maxvspacing,hspacing,color,tol,len,font);
end; end;
function ps_LoadSystemFont(const SysFont : TFont; const FontName : string) : boolean;extdecl;
begin
result := CurrThread.Client.MOCR.Fonts.LoadSystemFont(SysFont,FontName);
end;

15
Units/MMLAddon/PSInc/psexportedmethods.inc
View File

@ -230,13 +230,14 @@ AddFunction(@GetKeyCode,'function GetKeyCode(c : char) : integer;');
{ OCR} { OCR}
SetCurrSection('OCR'); SetCurrSection('OCR');
AddFunction(@rs_GetUpText, 'function rs_GetUpText: string;'); AddFunction(@ps_rs_GetUpText, 'function rs_GetUpText: string;');
AddFunction(@rs_GetUpTextAt, 'function rs_GetUpTextAt(x, y : integer): string;'); AddFunction(@ps_rs_GetUpTextAt, 'function rs_GetUpTextAt(x, y : integer): string;');
AddFunction(@BitmapFromText, 'function BitmapFromText(text, font: String): integer;'); AddFunction(@ps_BitmapFromText, 'function BitmapFromText(const text, font: String): integer;');
AddFunction(@TPAFromText, 'function TPAFromText(text, font: String;var w,h : integer): TPointArray;'); AddFunction(@ps_TPAFromText, 'function TPAFromText(const text, font: String;var w,h : integer): TPointArray;');
AddFunction(@TPAFromTextWrap,'procedure TPAFromTextWrap(text, font: String;var w,h : integer;var TPA : TPointArray);'); AddFunction(@ps_TPAFromTextWrap,'procedure TPAFromTextWrap(const text, font: String;var w,h : integer;var TPA : TPointArray);');
AddFunction(@MaskFromText, 'function MaskFromText(text, font: String): TMask;'); AddFunction(@ps_MaskFromText, 'function MaskFromText(const text, font: String): TMask;');
AddFunction(@GetTextAt,'function GetTextAt(atX, atY, minvspacing, maxvspacing, hspacing,color, tol, len: integer; font: string): string;'); AddFunction(@ps_GetTextAt,'function GetTextAt(const atX, atY, minvspacing, maxvspacing, hspacing,color, tol, len: integer;const font: string): string;');
AddFunction(@ps_LoadSystemFont,'function LoadSystemFont(const SysFont : TFont; const FontName : string) : boolean;');
{Bitmaps} {Bitmaps}
SetCurrSection('Bitmaps'); SetCurrSection('Bitmaps');

2
Units/MMLAddon/mmlpsthread.pas
View File

@ -572,7 +572,7 @@ var
Fonts : TMFonts; Fonts : TMFonts;
begin begin
{$I PSInc/pscompile.inc} {$I PSInc/pscompile.inc}
Fonts := Client.MOCR.GetFonts; Fonts := Client.MOCR.Fonts;
for i := fonts.count - 1 downto 0 do for i := fonts.count - 1 downto 0 do
Sender.Comp.AddConstantN(Fonts[i].Name,'string').SetString(Fonts[i].Name); Sender.Comp.AddConstantN(Fonts[i].Name,'string').SetString(Fonts[i].Name);

4
Units/MMLCore/bitmaps.pas
View File

@ -580,9 +580,9 @@ end;
procedure TMufasaBitmap.LoadFromTBitmap(bmp: TBitmap); procedure TMufasaBitmap.LoadFromTBitmap(bmp: TBitmap);
begin begin
bmp.BeginUpdate(); // bmp.BeginUpdate();
LoadFromRawImage(bmp.RawImage); LoadFromRawImage(bmp.RawImage);
bmp.EndUpdate(); // bmp.EndUpdate();
end; end;
procedure TMufasaBitmap.FastSetPixel(x, y: integer; Color: TColor); procedure TMufasaBitmap.FastSetPixel(x, y: integer; Color: TColor);

126
Units/MMLCore/fontloader.pas
View File

@ -28,7 +28,7 @@ unit fontloader;
interface interface
uses uses
Classes, SysUtils, Classes, SysUtils,Graphics,bitmaps,
ocrutil,lclintf; // contains the actual `loading' ocrutil,lclintf; // contains the actual `loading'
{ {
@ -36,42 +36,36 @@ uses
} }
type type
TMFont = class(TObject) TMFont = class(TObject)
constructor Create; public
destructor Destroy; override; Name: String;
Data: TOcrData;
constructor Create;
destructor Destroy; override;
function Copy: TMFont;
end;
{ TMFonts }
function Copy: TMFont; TMFonts = class(TObject)
public private
Name: String; Fonts: TList;
Data: TOcrData; Path: String;
end; Client : TObject;
function GetFontIndex(const Name: String): Integer;
function GetFontByIndex(Index : integer): TMfont;
type public
constructor Create(Owner : TObject);
{ TMFonts } destructor Destroy; override;
function GetFont(const Name: String): TOcrData;
TMFonts = class(TObject) function FreeFont(const Name: String): Boolean;
private function LoadFont(const Name: String; Shadow: Boolean): boolean;
function GetFontIndex(Name: String): Integer; function LoadSystemFont(const SysFont : TFont; const FontName : string) : boolean;
function GetFontByIndex(Index : integer): TMfont; procedure SetPath(const aPath: String);
private function GetPath: String;
Fonts: TList; function Copy(Owner : TObject): TMFonts;
Path: String; function Count : integer;
Client : TObject; property Font[Index : integer]: TMfont read GetFontByIndex; default;
public end;
constructor Create(Owner : TObject);
destructor Destroy; override;
function GetFont(Name: String): TOcrData;
function FreeFont(Name: String): boolean;
function LoadFont(Name: String; Shadow: Boolean): boolean;
procedure SetPath(aPath: String);
function GetPath: String;
function Copy(Owner : TObject): TMFonts;
function Count : integer;
property Font[Index : integer]: TMfont read GetFontByIndex; default;
end;
implementation implementation
@ -159,7 +153,7 @@ begin
inherited; inherited;
end; end;
procedure TMFonts.SetPath(aPath: String); procedure TMFonts.SetPath(const aPath: String);
begin begin
Path := aPath; Path := aPath;
end; end;
@ -169,20 +163,20 @@ begin
Exit(Path); Exit(Path);
end; end;
function TMFonts.GetFontIndex(Name: String): Integer; function TMFonts.GetFontIndex(const Name: String): Integer;
var var
i: integer; i: integer;
begin begin
for i := 0 to Fonts.Count - 1 do for i := 0 to Fonts.Count - 1 do
begin begin
if Name = TMFont(Fonts.Items[i]).Name then if lowercase(Name) = lowercase(TMFont(Fonts.Items[i]).Name) then
Exit(i); Exit(i);
end; end;
raise Exception.Create('Font [' + Name + '] not found.'); raise Exception.Create('Font [' + Name + '] not found.');
Exit(-1); Exit(-1);
end; end;
function TMFonts.GetFont(Name: String): TOcrData; function TMFonts.GetFont(const Name: String): TOcrData;
var var
i: integer; i: integer;
begin begin
@ -190,7 +184,7 @@ begin
Exit(TMFont(Fonts.Items[i]).Data); Exit(TMFont(Fonts.Items[i]).Data);
end; end;
function TMFonts.FreeFont(Name: String): boolean; function TMFonts.FreeFont(const Name: String): boolean;
var var
i: integer; i: integer;
begin begin
@ -203,7 +197,7 @@ begin
end; end;
end; end;
function TMFonts.LoadFont(Name: String; Shadow: Boolean): boolean; function TMFonts.LoadFont(const Name: String; Shadow: Boolean): boolean;
var var
f: TMFont; f: TMFont;
begin begin
@ -217,13 +211,59 @@ begin
f.Name := Name; f.Name := Name;
if Shadow then if Shadow then
F.Name := F.Name + '_s'; F.Name := F.Name + '_s';
f.Data := InitOCR(Path + Name + DS, Shadow); f.Data := InitOCR( LoadGlyphMasks(Path + Name + DS, Shadow));
Fonts.Add(f); Fonts.Add(f);
{$IFDEF FONTDEBUG} {$IFDEF FONTDEBUG}
TClient(Client).Writeln('Loaded Font ' + f.Name); TClient(Client).Writeln('Loaded Font ' + f.Name);
{$ENDIF} {$ENDIF}
end; end;
function TMFonts.LoadSystemFont(const SysFont: TFont; const FontName: string): boolean;
var
Masks : TocrGlyphMaskArray;
i,c : integer;
w,h : integer;
Bmp : TBitmap;
NewFont : TMFont;
MBmp : TMufasaBitmap;
begin
SetLength(Masks,255);
MBmp := TMufasaBitmap.Create;
Bmp := TBitmap.Create;
c := 0;
with Bmp.canvas do
begin
Font := SysFont;
Font.Color:= clWhite;
Font.Quality:= fqNonAntialiased;
Brush.Color:= clBlack;
Pen.Style:= psClear;
for i := 1 to 255 do
begin
GetTextSize(chr(i),w,h);
if (w<=0) or (h<=0) then
Continue;
Bmp.SetSize(w,h);
TextOut(0,0,chr(i));
MBmp.LoadFromTBitmap(bmp);
Masks[c] := LoadGlyphMask(MBmp,false,chr(i));
inc(c);
end;
end;
setlength(masks,c);
if c > 0 then
begin
NewFont := TMFont.Create;
NewFont.Name:= FontName;
NewFont.Data := InitOCR(masks);
Fonts.Add(NewFont);
result := true;
end;
bmp.free;
MBmp.free;
end;
function TMFonts.Copy(Owner : TObject): TMFonts; function TMFonts.Copy(Owner : TObject): TMFonts;
var var

1
Units/MMLCore/mufasatypes.pas
View File

@ -54,6 +54,7 @@ type
B, G, R, A: Byte; B, G, R, A: Byte;
end; end;
PRGB32 = ^TRGB32; PRGB32 = ^TRGB32;
TRGB32Array = array of TRGB32;
TRetData = record TRetData = record
Ptr : PRGB32; Ptr : PRGB32;

108
Units/MMLCore/ocr.pas
View File

@ -33,53 +33,51 @@ uses
graphtype, intfgraphics,graphics; graphtype, intfgraphics,graphics;
{End To-Remove unit} {End To-Remove unit}
type
{ TMOCR } type
{ TMOCR }
TMOCR = class(TObject) TMOCR = class(TObject)
constructor Create(Owner: TObject); private
destructor Destroy; override; Client: TObject;
function InitTOCR(path: string): boolean; FFonts: TMFonts;
function GetFonts:TMFonts; {$IFDEF OCRDEBUG}
procedure SetFonts(NewFonts: TMFonts); debugbmp: TMufasaBitmap;
{$ENDIF}
function GetFonts:TMFonts;
procedure SetFonts(NewFonts: TMFonts);
public
constructor Create(Owner: TObject);
destructor Destroy; override;
function InitTOCR(const path: string): boolean;
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 getTextPointsIn(sx, sy, w, h: Integer; shadow: boolean; procedure FilterUpTextByColour(bmp: TMufasaBitmap; w,h: integer);
var _chars, _shadows: T2DPointArray): Boolean; procedure FilterUpTextByCharacteristics(bmp: TMufasaBitmap; w,h: integer);
function GetUpTextAtEx(atX, atY: integer; shadow: boolean): string; procedure FilterShadowBitmap(bmp: TMufasaBitmap);
function GetUpTextAt(atX, atY: integer; shadow: boolean): string; procedure FilterCharsBitmap(bmp: TMufasaBitmap);
procedure FilterUpTextByColour(bmp: TMufasaBitmap; w,h: integer); function GetTextAt(atX, atY, minvspacing, maxvspacing, hspacing,
procedure FilterUpTextByCharacteristics(bmp: TMufasaBitmap; w,h: integer); color, tol, len: integer; font: string): string;
procedure FilterShadowBitmap(bmp: TMufasaBitmap); function TextToFontTPA(Text, font: String; out w, h: integer): TPointArray;
procedure FilterCharsBitmap(bmp: TMufasaBitmap); function TextToFontBitmap(Text, font: String): TMufasaBitmap;
function TextToMask(Text, font: String): TMask;
property Fonts : TMFonts read GetFonts write SetFonts;
{$IFDEF OCRDEBUG}
procedure DebugToBmp(bmp: TMufasaBitmap; hmod,h: integer);
{$ENDIF}
end;
function GetTextAt(atX, atY, minvspacing, maxvspacing, hspacing, {$IFDEF OCRDEBUG}
color, tol, len: integer; font: string): string; {$IFDEF LINUX}
function TextToFontTPA(Text, font: String; out w, h: integer): TPointArray; const OCRDebugPath = '/tmp/';
function TextToFontBitmap(Text, font: String): TMufasaBitmap; {$ELSE}
function TextToMask(Text, font: String): TMask; const OCRDebugPath = '';
{$ENDIF}
{$ENDIF}
{$IFDEF OCRDEBUG}
procedure DebugToBmp(bmp: TMufasaBitmap; hmod,h: integer);
{$ENDIF}
private
Client: TObject;
Fonts: TMFonts;
{$IFDEF OCRDEBUG}
public
debugbmp: TMufasaBitmap;
{$ENDIF}
end;
{$IFDEF OCRDEBUG}
{$IFDEF LINUX}
const OCRDebugPath = '/tmp/';
{$ELSE}
const OCRDebugPath = '';
{$ENDIF}
{$ENDIF}
implementation implementation
uses uses
@ -121,15 +119,13 @@ constructor TMOCR.Create(Owner: TObject);
begin begin
inherited Create; inherited Create;
Self.Client := Owner; Self.Client := Owner;
Self.Fonts := TMFonts.Create(Owner); Self.FFonts := TMFonts.Create(Owner);
end; end;
{ Destructor } { Destructor }
destructor TMOCR.Destroy; destructor TMOCR.Destroy;
begin begin
Self.FFonts.Free;
Self.Fonts.Free;
inherited Destroy; inherited Destroy;
end; end;
@ -137,34 +133,34 @@ end;
InitTOCR loads all fonts in path InitTOCR loads all fonts in path
We don't do this in the constructor because we may not yet have the path. We don't do this in the constructor because we may not yet have the path.
} }
function TMOCR.InitTOCR(path: string): boolean; function TMOCR.InitTOCR(const path: string): boolean;
var var
dirs: array of string; dirs: array of string;
i: longint; i: longint;
begin begin
// We're going to load all fonts now // We're going to load all fonts now
Fonts.SetPath(path); FFonts.SetPath(path);
dirs := GetDirectories(path); dirs := GetDirectories(path);
Result := false; Result := false;
for i := 0 to high(dirs) do for i := 0 to high(dirs) do
begin begin
if Fonts.LoadFont(dirs[i], false) then if FFonts.LoadFont(dirs[i], false) then
result := true; result := true;
end; end;
If DirectoryExists(path + 'UpChars') then If DirectoryExists(path + 'UpChars') then
Fonts.LoadFont('UpChars', true); // shadow FFonts.LoadFont('UpChars', true); // shadow
end; end;
{ Get the current pointer to our list of Fonts } { Get the current pointer to our list of Fonts }
function TMOCR.GetFonts:TMFonts; function TMOCR.GetFonts:TMFonts;
begin begin
Exit(Self.Fonts); Exit(Self.FFonts);
end; end;
{ Set new Fonts. We set it to a Copy of NewFonts } { Set new Fonts. We set it to a Copy of NewFonts }
procedure TMOCR.SetFonts(NewFonts: TMFonts); procedure TMOCR.SetFonts(NewFonts: TMFonts);
begin begin
Self.Fonts := NewFonts.Copy(Self.Client); Self.FFonts := NewFonts.Copy(Self.Client);
end; end;
{ {
@ -644,12 +640,12 @@ begin
if shadow then if shadow then
begin begin
font := Fonts.GetFont('UpChars_s'); font := FFonts.GetFont('UpChars_s');
thachars := shadows; thachars := shadows;
end end
else else
begin begin
font := Fonts.GetFont('UpChars'); font := FFonts.GetFont('UpChars');
thachars := chars; thachars := chars;
end; end;
@ -714,7 +710,7 @@ var
STPA: T2DPointArray; STPA: T2DPointArray;
begin begin
fD := Fonts.GetFont(font); fD := FFonts.GetFont(font);
{writeln(format('W, H: %d, %d', [fD.max_width, fd.max_height]));} {writeln(format('W, H: %d, %d', [fD.max_width, fd.max_height]));}
TClient(Client).IOManager.GetDimensions(w, h); TClient(Client).IOManager.GetDimensions(w, h);
@ -827,7 +823,7 @@ var
an: integer; an: integer;
begin begin
fontD := Fonts.GetFont(font); fontD := FFonts.GetFont(font);
c := 0; c := 0;
off := 0; off := 0;
setlength(result, 0); setlength(result, 0);

242
Units/MMLCore/ocrutil.pas
View File

@ -5,7 +5,7 @@ unit ocrutil;
interface interface
uses uses
Classes, SysUtils, MufasaTypes; Classes, SysUtils, MufasaTypes,bitmaps;
type type
TNormArray = array of integer; TNormArray = array of integer;
@ -34,17 +34,10 @@ type
TocrDataArray = array of TocrData; TocrDataArray = array of TocrData;
{ We already have PRGB32 -> To be removed later }
type
tRGB = packed record
B, G, R, A: Byte;
end;
tRGBArray = array of tRGB;
{Begin To be removed} {Begin To be removed}
Tbmp = record Tbmp = record
data: array of tRGB; data: array of TRGB32;
width,height: integer; width,height: integer;
end; end;
{End To be removed} {End To be removed}
@ -54,11 +47,12 @@ type
end; end;
procedure findBounds(glyphs: TocrGlyphMaskArray; out width,height: integer); procedure findBounds(glyphs: TocrGlyphMaskArray; out width,height: integer);
function LoadGlyphMasks(path: string; shadow: boolean): TocrGlyphMaskArray; function LoadGlyphMask(const bmp : TMufasaBitmap; shadow: boolean; const ascii : char): TocrGlyphMask;
function InitOCR(path: string; shadow: boolean): TocrData; function LoadGlyphMasks(const path: string; shadow: boolean): TocrGlyphMaskArray;
function InitOCR(const Masks : TocrGlyphMaskArray): TocrData;
function GuessGlyph(glyph: TNormArray; ocrdata: TocrData): char; function GuessGlyph(glyph: TNormArray; ocrdata: TocrData): char;
function PointsToNorm(points: TpointArray; out w,h: integer): TNormArray; function PointsToNorm(points: TpointArray; out w,h: integer): TNormArray;
function ImageToNorm(src: tRGBArray; w,h: integer): TNormArray; function ImageToNorm(src: TRGB32Array; w,h: integer): TNormArray;
function ocrDetect(txt: TNormArray; w,h: integer; var ocrdata: TocrData): string; function ocrDetect(txt: TNormArray; w,h: integer; var ocrdata: TocrData): string;
function ExtractText(colors: PRGB32;{colors: tRGBArray;} w,h: integer): TNormArray; function ExtractText(colors: PRGB32;{colors: tRGBArray;} w,h: integer): TNormArray;
function MakeTPAString(str: string): TpointArray; function MakeTPAString(str: string): TpointArray;
@ -85,7 +79,7 @@ begin
Result.width := LazIntf.Width; Result.width := LazIntf.Width;
Result.height := LazIntf.Height; Result.height := LazIntf.Height;
SetLength(result.data,LazIntf.Width*LazIntf.Height); SetLength(result.data,LazIntf.Width*LazIntf.Height);
Move(LazIntf.PixelData[0],result.data[0],LazIntf.Width*LazIntf.Height*sizeOf(tRGB)); Move(LazIntf.PixelData[0],result.data[0],LazIntf.Width*LazIntf.Height*sizeOf(TRGB32));
LazIntf.Free; LazIntf.Free;
end; end;
end; end;
@ -152,107 +146,113 @@ begin
end; end;
end; end;
{This Loads the actual data from the .bmp, but does not init all fields} function LoadGlyphMask(const bmp: TMufasaBitmap; shadow: boolean; const ascii : char): TocrGlyphMask;
function LoadGlyphMasks(path: string; shadow: boolean): TocrGlyphMaskArray;
var var
strs: array of string; size,j: integer;
bmp: array of Tbmp; {-> TMufasaBitmap, and why use an array? } color: TRGB32;
len,size,i,j: integer; shadow_i: byte;
color: tRGB;
shadow_i: byte;
begin begin
strs:= GetFiles(path,'bmp'); if shadow then
len:= length(strs); shadow_i := 0
SetLength(result,len); else
SetLength(bmp,len); shadow_i := 255;
if shadow then size:= bmp.Width * bmp.Height;
shadow_i := 0 SetLength(result.mask,size);
for j := 0 to size-1 do
begin
color := bmp.FData[j];
{ if (color.r = 255) and (color.g = 255 and not shadow_i) and
(color.b = 255 and not shadow_i) then}
if (color.r = 255) and (color.g = shadow_i) and (color.b = shadow_i) then
result.mask[j]:= 1
else else
shadow_i := 255; result.mask[j]:= 0;
for i:= 0 to len-1 do end;
begin result.width:= bmp.width;
bmp[i]:= ReadBmp(path + strs[i]); result.height:= bmp.height;
size:= bmp[i].width*bmp[i].height; result.ascii:= ascii;
SetLength(result[i].mask,size); end;
for j:= 0 to size-1 do
begin {This Loads the actual data from the .bmp, but does not init all fields}
color:= bmp[i].data[j]; function LoadGlyphMasks(const path: string; shadow: boolean): TocrGlyphMaskArray;
{ if (color.r = 255) and (color.g = 255 and not shadow_i) and var
(color.b = 255 and not shadow_i) then} strs: array of string;
if (color.r = 255) and (color.g = shadow_i) and (color.b = shadow_i) then bmp : TMufasaBitmap;
result[i].mask[j]:= 1 len,i: integer;
else begin
result[i].mask[j]:= 0; strs:= GetFiles(path,'bmp');
end; len:= length(strs);
result[i].width:= bmp[i].width; SetLength(result,len);
result[i].height:= bmp[i].height; bmp := TMufasaBitmap.Create;
SetLength(strs[i],Length(strs[i])-4); for i:= 0 to len-1 do
result[i].ascii:= chr(strtoint(strs[i])); begin
end; bmp.LoadFromFile(path + strs[i]);
SetLength(strs[i],Length(strs[i])-4);
Result[i] := LoadGlyphMask(bmp,shadow,chr(strtoint(strs[i])));
end;
Bmp.free;
end; end;
{Fully initalizes a TocrData structure, this is LoadFont or whatever, call it first} {Fully initalizes a TocrData structure, this is LoadFont or whatever, call it first}
function InitOCR(path: string; shadow: boolean): TocrData; function InitOCR(const masks : TocrGlyphMaskArray): TocrData;
var var
masks: TocrGlyphMaskArray; t,b,l,r,w,h,mw: integer;
t,b,l,r,w,h,mw: integer; x,y: integer;
x,y: integer; c,i,len,size: integer;
c,i,len,size: integer; pos: integer;
pos: integer; ascii: char;
ascii: char;
begin begin
masks:= LoadGlyphMasks(path, shadow); w:= 0;
w:= 0; h:= 0;
h:= 0; findBounds(masks,w,h);
findBounds(masks,w,h); len:= Length(masks);
len:= Length(masks); result.width:= w;
result.width:= w; result.height:= h;
result.height:= h; result.max_width:=0;
result.max_width:=0; result.max_height:=0;
result.max_height:=0; size:= w * h;
size:= w * h; SetLength(result.pos,len,size);
SetLength(result.pos,len,size); SetLength(result.pos_adj,len);
SetLength(result.pos_adj,len); SetLength(result.neg,len,size);
SetLength(result.neg,len,size); SetLength(result.neg_adj,len);
SetLength(result.neg_adj,len); SetLength(result.map,len);
SetLength(result.map,len); for i:= 0 to len - 1 do
for i:= 0 to len - 1 do begin
ascii:= masks[i].ascii;
pos:= 0;
l:= masks[i].l;
r:= masks[i].r;
b:= masks[i].b;
t:= masks[i].t;
mw:= masks[i].width;
for y:= t to b do
begin begin
ascii:= masks[i].ascii; for x:= l to r do
pos:= 0; begin
l:= masks[i].l; c:= (x-l) + (y-t)*w;
r:= masks[i].r; if masks[i].mask[x+y*mw] <> 0 then
b:= masks[i].b;
t:= masks[i].t;
mw:= masks[i].width;
for y:= t to b do
begin begin
for x:= l to r do result.pos[i][c]:= 1;
begin inc(pos);
c:= (x-l) + (y-t)*w; end else
if masks[i].mask[x+y*mw] <> 0 then result.pos[i][c] := 0;
begin end;
result.pos[i][c]:= 1;
inc(pos);
end else
result.pos[i][c] := 0;
end;
end;
for c:= 0 to size-1 do
result.neg[i][c]:= 1 - result.pos[i][c];
if pos = 0 then result.neg_adj[i]:= 1 else result.neg_adj[i]:= 1 / pos;
if pos = 0 then result.pos_adj[i]:= 0 else result.pos_adj[i]:= 1 / pos;
result.map[i]:= ascii;
result.ascii[ord(ascii)].index:= i;
result.ascii[ord(ascii)].xoff:= masks[i].l;
result.ascii[ord(ascii)].yoff:= masks[i].t;
result.ascii[ord(ascii)].width:= masks[i].width;
result.ascii[ord(ascii)].height:= masks[i].height;
result.max_width := max(result.max_width, masks[i].width);
result.max_height := max(result.max_height, masks[i].height);
end; end;
result.inputs:= size; for c:= 0 to size-1 do
result.outputs:= len; result.neg[i][c]:= 1 - result.pos[i][c];
if pos = 0 then result.neg_adj[i]:= 1 else result.neg_adj[i]:= 1 / pos;
if pos = 0 then result.pos_adj[i]:= 0 else result.pos_adj[i]:= 1 / pos;
result.map[i]:= ascii;
result.ascii[ord(ascii)].index:= i;
result.ascii[ord(ascii)].xoff:= masks[i].l;
result.ascii[ord(ascii)].yoff:= masks[i].t;
result.ascii[ord(ascii)].width:= masks[i].width;
result.ascii[ord(ascii)].height:= masks[i].height;
result.max_width := max(result.max_width, masks[i].width);
result.max_height := max(result.max_height, masks[i].height);
end;
result.inputs:= size;
result.outputs:= len;
end; end;
{guesses a glyph stored in glyph (which is an 1-0 image of the size specified by width and height in ocrdata} {guesses a glyph stored in glyph (which is an 1-0 image of the size specified by width and height in ocrdata}
@ -316,7 +316,7 @@ begin
result:= norm; result:= norm;
end; end;
function ImageToNorm(src: tRGBArray; w,h: integer): TNormArray; function ImageToNorm(src: TRGB32Array; w,h: integer): TNormArray;
var var
norm: TNormArray; norm: TNormArray;
i: integer; i: integer;
@ -417,14 +417,14 @@ begin
end; end;
end; end;
function AvgColors(color1:tRGB; weight1: integer; color2: tRGB; weight2: integer): tRGB; function AvgColors(color1:TRGB32; weight1: integer; color2: TRGB32; weight2: integer): TRGB32;
begin begin
result.r:= (color1.r * weight1 + color2.r * weight2) div (weight1 + weight2); result.r:= (color1.r * weight1 + color2.r * weight2) div (weight1 + weight2);
result.g:= (color1.g * weight1 + color2.g * weight2) div (weight1 + weight2); result.g:= (color1.g * weight1 + color2.g * weight2) div (weight1 + weight2);
result.b:= (color1.b * weight1 + color2.b * weight2) div (weight1 + weight2); result.b:= (color1.b * weight1 + color2.b * weight2) div (weight1 + weight2);
end; end;
procedure RGBtoXYZ(color: tRGB; out X, Y, Z: real); inline; procedure RGBtoXYZ(color: TRGB32; out X, Y, Z: real); inline;
var var
nr,ng,nb: real; nr,ng,nb: real;
begin begin
@ -447,7 +447,7 @@ begin
result:= 7.787037037*i + 0.137931034; result:= 7.787037037*i + 0.137931034;
end; end;
function ColortoLab(c: tRGB): tLab; inline; function ColortoLab(c: TRGB32): tLab; inline;
var var
X,Y,Z,sum,Xn,Yn,Zn: real; X,Y,Z,sum,Xn,Yn,Zn: real;
begin begin
@ -467,7 +467,7 @@ begin
result.b:= 500.0*(labmod(y/yn)-labmod(z/zn)); result.b:= 500.0*(labmod(y/yn)-labmod(z/zn));
end; end;
function colorDistSqr(a,b:tRGB): integer; inline; function colorDistSqr(a,b:TRGB32): integer; inline;
begin begin
result:= (a.r-b.r)*(a.r-b.r)+(a.b-b.b)*(a.b-b.b)+(a.g-b.g)*(a.g-b.g); result:= (a.r-b.r)*(a.r-b.r)+(a.b-b.b)*(a.b-b.b)+(a.g-b.g)*(a.g-b.g);
end; end;
@ -475,20 +475,20 @@ end;
function ExtractText(colors: PRGB32;{colors: tRGBArray;} w,h: integer): TNormArray; function ExtractText(colors: PRGB32;{colors: tRGBArray;} w,h: integer): TNormArray;
const const
GradientMax = 2.0; GradientMax = 2.0;
white: tRGB = ( b: $FF; g: $FF; r: $FF; a: $00 ); white: TRGB32= ( b: $FF; g: $FF; r: $FF; a: $00 );
cyan: tRGB = ( b: $FF; g: $FF; r: $00; a: $00 ); cyan: TRGB32= ( b: $FF; g: $FF; r: $00; a: $00 );
yellow: tRGB = ( b: $00; g: $EF; r: $FF; a: $00 ); yellow: TRGB32= ( b: $00; g: $EF; r: $FF; a: $00 );
red: tRGB = ( b: $00; g: $00; r: $FF; a: $00 ); red: TRGB32= ( b: $00; g: $00; r: $FF; a: $00 );
green: tRGB = ( b: $00; g: $FF; r: $00; a: $00 ); green: TRGB32= ( b: $00; g: $FF; r: $00; a: $00 );
var var
up, left: boolean; up, left: boolean;
len,numblobs,thisblob,lastblob,i,j,used: integer; len,numblobs,thisblob,lastblob,i,j,used: integer;
blobbed,blobcount,stack: array of integer; blobbed,blobcount,stack: array of integer;
labs: array of tLab; labs: array of tLab;
a,b: tLab; a,b: tLab;
blobcolor: tRGBArray; blobcolor: TRGB32Array;
newcolors: array of integer; newcolors: array of integer;
c: tRGB; c: TRGB32;
norm: TNormArray; norm: TNormArray;
begin begin
len:= w*h; len:= w*h;
@ -498,7 +498,7 @@ begin
SetLength(stack,len); SetLength(stack,len);
SetLength(labs,len); SetLength(labs,len);
for i:= 0 to len-1 do for i:= 0 to len-1 do
labs[i]:= ColorToLab(tRGB(colors[i])); labs[i]:= ColorToLab( TRGB32(colors[i]));
numblobs:= 0; numblobs:= 0;
for i:= 0 to len-1 do for i:= 0 to len-1 do
begin begin
@ -519,7 +519,7 @@ begin
begin begin
thisblob:= blobbed[i-w]; thisblob:= blobbed[i-w];
blobbed[i]:= thisblob; blobbed[i]:= thisblob;
blobcolor[thisblob]:= AvgColors(blobcolor[thisblob],blobcount[thisblob],tRGB(colors[i]),1); blobcolor[thisblob]:= AvgColors(blobcolor[thisblob],blobcount[thisblob],tRGB32(colors[i]),1);
blobcount[thisblob]:= blobcount[thisblob] + 1; blobcount[thisblob]:= blobcount[thisblob] + 1;
lastblob:= blobbed[i-1]; lastblob:= blobbed[i-1];
if lastblob <> thisblob then if lastblob <> thisblob then
@ -547,19 +547,19 @@ begin
begin begin
thisblob:= blobbed[i-1]; thisblob:= blobbed[i-1];
blobbed[i]:= thisblob; blobbed[i]:= thisblob;
blobcolor[thisblob]:= AvgColors(blobcolor[thisblob],blobcount[thisblob],tRGB(colors[i]),1); blobcolor[thisblob]:= AvgColors(blobcolor[thisblob],blobcount[thisblob],tRGB32(colors[i]),1);
blobcount[thisblob]:= blobcount[thisblob] + 1; blobcount[thisblob]:= blobcount[thisblob] + 1;
end else if up then end else if up then
begin begin
thisblob:= blobbed[i-w]; thisblob:= blobbed[i-w];
blobbed[i]:= thisblob; blobbed[i]:= thisblob;
blobcolor[thisblob]:= AvgColors(blobcolor[thisblob],blobcount[thisblob],tRGB(colors[i]),1); blobcolor[thisblob]:= AvgColors(blobcolor[thisblob],blobcount[thisblob],tRGB32(colors[i]),1);
blobcount[thisblob]:= blobcount[thisblob] + 1; blobcount[thisblob]:= blobcount[thisblob] + 1;
end else end else
begin begin
blobbed[i]:= numblobs; blobbed[i]:= numblobs;
blobcount[numblobs]:= 1; blobcount[numblobs]:= 1;
blobcolor[numblobs]:= tRGB(colors[i]); blobcolor[numblobs]:= tRGB32(colors[i]);
numblobs:= numblobs + 1; numblobs:= numblobs + 1;
end; end;
end; end;