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
Self.OCR_Fonts := TMOCR.Create(Thread.Client);
OCR_Fonts.InitTOCR(fontPath);
Thread.Client.MOCR.SetFonts(OCR_Fonts.GetFonts);
Thread.Client.MOCR.Fonts := OCR_Fonts.Fonts
end else
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.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
Result := CurrThread.Client.MOCR.GetUpTextAtEx(7, 7, true);
end;
function rs_GetUpTextAt(x, y : integer): string; extdecl;
function ps_rs_GetUpTextAt(x, y : integer): string; extdecl;
begin
result := CurrThread.Client.MOCR.GetUpTextAtEx(x,y,true);
end;
function BitmapFromText(text, font: String): integer; extdecl;
function ps_BitmapFromText(const text, font: String): integer; extdecl;
var
bmp: TMufasaBitmap;
begin
@ -16,23 +16,28 @@ begin
Result := CurrThread.Client.MBitmaps.AddBMP(bmp);
end;
function MaskFromText(text, font: String): TMask; extdecl;
function ps_MaskFromText(const text, font: String): TMask; extdecl;
begin
Result := CurrThread.Client.MOCR.TextToMask(text,font);
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
TPA := CurrThread.Client.MOCR.TextToFontTPA(text, font, w, h);
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
Result := CurrThread.Client.MOCR.TextToFontTPA(text, font, w, h);
end;
function GetTextAt(atX, atY, minvspacing, maxvspacing, hspacing,
color, tol, len: integer; font: string): string; extdecl;
function ps_GetTextAt(const atX, atY, minvspacing, maxvspacing, hspacing,
color, tol, len: integer;const font: string): string; extdecl;
begin
result := CurrThread.Client.MOCR.GetTextAt(atx,aty,minvspacing,maxvspacing,hspacing,color,tol,len,font);
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}
SetCurrSection('OCR');
AddFunction(@rs_GetUpText, 'function rs_GetUpText: string;');
AddFunction(@rs_GetUpTextAt, 'function rs_GetUpTextAt(x, y : integer): string;');
AddFunction(@BitmapFromText, 'function BitmapFromText(text, font: String): integer;');
AddFunction(@TPAFromText, 'function TPAFromText(text, font: String;var w,h : integer): TPointArray;');
AddFunction(@TPAFromTextWrap,'procedure TPAFromTextWrap(text, font: String;var w,h : integer;var TPA : TPointArray);');
AddFunction(@MaskFromText, 'function MaskFromText(text, font: String): TMask;');
AddFunction(@GetTextAt,'function GetTextAt(atX, atY, minvspacing, maxvspacing, hspacing,color, tol, len: integer; font: string): string;');
AddFunction(@ps_rs_GetUpText, 'function rs_GetUpText: string;');
AddFunction(@ps_rs_GetUpTextAt, 'function rs_GetUpTextAt(x, y : integer): string;');
AddFunction(@ps_BitmapFromText, 'function BitmapFromText(const text, font: String): integer;');
AddFunction(@ps_TPAFromText, 'function TPAFromText(const text, font: String;var w,h : integer): TPointArray;');
AddFunction(@ps_TPAFromTextWrap,'procedure TPAFromTextWrap(const text, font: String;var w,h : integer;var TPA : TPointArray);');
AddFunction(@ps_MaskFromText, 'function MaskFromText(const text, font: String): TMask;');
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}
SetCurrSection('Bitmaps');

2
Units/MMLAddon/mmlpsthread.pas
View File

@ -572,7 +572,7 @@ var
Fonts : TMFonts;
begin
{$I PSInc/pscompile.inc}
Fonts := Client.MOCR.GetFonts;
Fonts := Client.MOCR.Fonts;
for i := fonts.count - 1 downto 0 do
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);
begin
bmp.BeginUpdate();
// bmp.BeginUpdate();
LoadFromRawImage(bmp.RawImage);
bmp.EndUpdate();
// bmp.EndUpdate();
end;
procedure TMufasaBitmap.FastSetPixel(x, y: integer; Color: TColor);

126
Units/MMLCore/fontloader.pas
View File

@ -28,7 +28,7 @@ unit fontloader;
interface
uses
Classes, SysUtils,
Classes, SysUtils,Graphics,bitmaps,
ocrutil,lclintf; // contains the actual `loading'
{
@ -36,42 +36,36 @@ uses
}
type
TMFont = class(TObject)
constructor Create;
destructor Destroy; override;
TMFont = class(TObject)
public
Name: String;
Data: TOcrData;
constructor Create;
destructor Destroy; override;
function Copy: TMFont;
end;
{ TMFonts }
function Copy: TMFont;
public
Name: String;
Data: TOcrData;
end;
type
{ TMFonts }
TMFonts = class(TObject)
private
function GetFontIndex(Name: String): Integer;
function GetFontByIndex(Index : integer): TMfont;
private
Fonts: TList;
Path: String;
Client : TObject;
public
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;
TMFonts = class(TObject)
private
Fonts: TList;
Path: String;
Client : TObject;
function GetFontIndex(const Name: String): Integer;
function GetFontByIndex(Index : integer): TMfont;
public
constructor Create(Owner : TObject);
destructor Destroy; override;
function GetFont(const Name: String): TOcrData;
function FreeFont(const Name: String): Boolean;
function LoadFont(const Name: String; Shadow: Boolean): boolean;
function LoadSystemFont(const SysFont : TFont; const FontName : string) : boolean;
procedure SetPath(const aPath: String);
function GetPath: String;
function Copy(Owner : TObject): TMFonts;
function Count : integer;
property Font[Index : integer]: TMfont read GetFontByIndex; default;
end;
implementation
@ -159,7 +153,7 @@ begin
inherited;
end;
procedure TMFonts.SetPath(aPath: String);
procedure TMFonts.SetPath(const aPath: String);
begin
Path := aPath;
end;
@ -169,20 +163,20 @@ begin
Exit(Path);
end;
function TMFonts.GetFontIndex(Name: String): Integer;
function TMFonts.GetFontIndex(const Name: String): Integer;
var
i: integer;
begin
for i := 0 to Fonts.Count - 1 do
begin
if Name = TMFont(Fonts.Items[i]).Name then
if lowercase(Name) = lowercase(TMFont(Fonts.Items[i]).Name) then
Exit(i);
end;
raise Exception.Create('Font [' + Name + '] not found.');
Exit(-1);
end;
function TMFonts.GetFont(Name: String): TOcrData;
function TMFonts.GetFont(const Name: String): TOcrData;
var
i: integer;
begin
@ -190,7 +184,7 @@ begin
Exit(TMFont(Fonts.Items[i]).Data);
end;
function TMFonts.FreeFont(Name: String): boolean;
function TMFonts.FreeFont(const Name: String): boolean;
var
i: integer;
begin
@ -203,7 +197,7 @@ begin
end;
end;
function TMFonts.LoadFont(Name: String; Shadow: Boolean): boolean;
function TMFonts.LoadFont(const Name: String; Shadow: Boolean): boolean;
var
f: TMFont;
begin
@ -217,13 +211,59 @@ begin
f.Name := Name;
if Shadow then
F.Name := F.Name + '_s';
f.Data := InitOCR(Path + Name + DS, Shadow);
f.Data := InitOCR( LoadGlyphMasks(Path + Name + DS, Shadow));
Fonts.Add(f);
{$IFDEF FONTDEBUG}
TClient(Client).Writeln('Loaded Font ' + f.Name);
{$ENDIF}
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;
var

1
Units/MMLCore/mufasatypes.pas
View File

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

108
Units/MMLCore/ocr.pas
View File

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

242
Units/MMLCore/ocrutil.pas
View File

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