From 72539efffdb21352040aa375f74b5855aaddeb57 Mon Sep 17 00:00:00 2001 From: Raymond Date: Mon, 5 Apr 2010 00:35:49 +0200 Subject: [PATCH] Added 'LoadSystemFont' which allows you to load a font based on one of your system fonts (just like LoadChars2 in scar). --- Projects/SAMufasaGUI/testunit.pas | 4 +- Tests/PS/loadsystemfont.simb | 14 ++ Units/MMLAddon/PSInc/Wrappers/ocr.inc | 21 +- Units/MMLAddon/PSInc/psexportedmethods.inc | 15 +- Units/MMLAddon/mmlpsthread.pas | 2 +- Units/MMLCore/bitmaps.pas | 4 +- Units/MMLCore/fontloader.pas | 126 +++++++---- Units/MMLCore/mufasatypes.pas | 1 + Units/MMLCore/ocr.pas | 108 +++++---- Units/MMLCore/ocrutil.pas | 242 ++++++++++----------- 10 files changed, 297 insertions(+), 240 deletions(-) create mode 100644 Tests/PS/loadsystemfont.simb diff --git a/Projects/SAMufasaGUI/testunit.pas b/Projects/SAMufasaGUI/testunit.pas index 58631b5..eef3fa6 100644 --- a/Projects/SAMufasaGUI/testunit.pas +++ b/Projects/SAMufasaGUI/testunit.pas @@ -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/'; diff --git a/Tests/PS/loadsystemfont.simb b/Tests/PS/loadsystemfont.simb new file mode 100644 index 0000000..828bfdd --- /dev/null +++ b/Tests/PS/loadsystemfont.simb @@ -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. diff --git a/Units/MMLAddon/PSInc/Wrappers/ocr.inc b/Units/MMLAddon/PSInc/Wrappers/ocr.inc index af136df..fcc847b 100644 --- a/Units/MMLAddon/PSInc/Wrappers/ocr.inc +++ b/Units/MMLAddon/PSInc/Wrappers/ocr.inc @@ -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; diff --git a/Units/MMLAddon/PSInc/psexportedmethods.inc b/Units/MMLAddon/PSInc/psexportedmethods.inc index e8d5c16..d836ffa 100644 --- a/Units/MMLAddon/PSInc/psexportedmethods.inc +++ b/Units/MMLAddon/PSInc/psexportedmethods.inc @@ -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'); diff --git a/Units/MMLAddon/mmlpsthread.pas b/Units/MMLAddon/mmlpsthread.pas index c746345..c0d7d03 100644 --- a/Units/MMLAddon/mmlpsthread.pas +++ b/Units/MMLAddon/mmlpsthread.pas @@ -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); diff --git a/Units/MMLCore/bitmaps.pas b/Units/MMLCore/bitmaps.pas index ae98245..b41c8aa 100644 --- a/Units/MMLCore/bitmaps.pas +++ b/Units/MMLCore/bitmaps.pas @@ -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); diff --git a/Units/MMLCore/fontloader.pas b/Units/MMLCore/fontloader.pas index 5dd2d86..b1db0a4 100644 --- a/Units/MMLCore/fontloader.pas +++ b/Units/MMLCore/fontloader.pas @@ -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 diff --git a/Units/MMLCore/mufasatypes.pas b/Units/MMLCore/mufasatypes.pas index 3c92634..5b1c65b 100644 --- a/Units/MMLCore/mufasatypes.pas +++ b/Units/MMLCore/mufasatypes.pas @@ -54,6 +54,7 @@ type B, G, R, A: Byte; end; PRGB32 = ^TRGB32; + TRGB32Array = array of TRGB32; TRetData = record Ptr : PRGB32; diff --git a/Units/MMLCore/ocr.pas b/Units/MMLCore/ocr.pas index 0b1ef32..fec2ef9 100644 --- a/Units/MMLCore/ocr.pas +++ b/Units/MMLCore/ocr.pas @@ -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); diff --git a/Units/MMLCore/ocrutil.pas b/Units/MMLCore/ocrutil.pas index 0896777..2b72c02 100644 --- a/Units/MMLCore/ocrutil.pas +++ b/Units/MMLCore/ocrutil.pas @@ -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;