Delphi-PRAXiS
Seite 3 von 4     123 4      

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Multimedia (https://www.delphipraxis.net/16-multimedia/)
-   -   Delphi OCR für Arme, und ich bin noch ärmer (https://www.delphipraxis.net/133378-ocr-fuer-arme-und-ich-bin-noch-aermer.html)

Medium 14. Jul 2009 23:04

Re: OCR für Arme, und ich bin noch ärmer
 
Ich bin letztlich wirklich dazu übergegangen alle Font-Bitmaps an einer X-Koordinate mit der Quelle pixelweise zu vergleichen (die G32 macht's performant genug). Den breitesten 100%igen Match nehm ich dann. Im Falle von "l" und "I" kann ich glücklicherweise davon ausgehen, dass Wortanfänge immer groß geschrieben sind. Finde ich also ein kleines L am Wortanfang, muss es ein großes I sein.
Finde ich an einer Stelle keinen Match, gehts ein Pixel weiter rechts von vorne los. Sobald ich 3 Pixel lang nix gefunden hab, kann ich ein Leerzeichen annehmen - das passte bisher bei allen Strings die mir unter kamen in dem Font. Glücklicherweise sind die Zeilen auch nicht so wahnsinnig lang, so dass ich nicht arg viel "nichts-gefunden"-Freiraum vergleiche.
Die aktuelle Lösung ist daher völlig fern von etwas generischem, da sie genau den Font in genau der Größe voraussetzt, aber für meinen Zweck ist das völlig ausreichend. Danke dir dennoch für den Beitrag!

Laufi 14. Jul 2009 23:57

Re: OCR für Arme, und ich bin noch ärmer
 
Hallo!

Du kannst den Text den du mit OCR lesen willst einfach als präfixfreien code betrachten. Dann sind die Buchstaben die codewörter und die pixelspalten sind das alphabet du kannst sie als integer zahlen betrachten wie jfheins gesagt hat :shock:
Da du ja die schrift und die grösse weisst, kannst du den codebaum ganz einfach bauen am anfang deines programms. Also du schreibst dir z.B. ein A hin, gehst seine Pixelspalten durch und fügst diese in den Baum ein. Damit es sicher präfixfrei ist, musst du halt auch auf leerspalten aufpassen die nach einem Buchstaben folgen. Am schluss fügst du noch in das Blatt ein, welcher Buchstabe es war. Das machst du für alle buchstaben die vorkommen. :roll:

Wenn du den baum dann hast, kannst du den text ganz einfach scannen. Du gehst die pixelspalten durch und folgst damit dem baum von der wurzel bis in die Blätter. Wenn du in einem blatt bist, hast du ein buchstabe fertig und springst wieder zur wurzel. So musst du also jeden pixel nur einmal anschauen genau wie du wolltest :)

Liebe Grüsse
Laufi

Medium 15. Jul 2009 01:31

Re: OCR für Arme, und ich bin noch ärmer
 
DAS klingt doch auch nach einer ausgesprochen eleganten Sache! Ich bin ja fast geneigt mein Progrämmchen nochmal umzubauen jetzt :)

Laufi 15. Jul 2009 02:01

Re: OCR für Arme, und ich bin noch ärmer
 
Hallo!

Das freut mich dass es dir gefällt :o Dafür habe ich rasch was extra für dich geschrieben :-D

Delphi-Quellcode:
unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TSimpleOCR = class
  type
    TPixCol = Cardinal;
    TNode = class
    private
      FPixCol: TPixCol;
      FChildren: array of TNode;
      FLetter: Char;
    public
      destructor Destroy; override;
      function Add(PixCol: TPixCol): TNode;
      function Child(PixCol: TPixCol): TNode;
    end;
  private
    FRoot: TNode;
    FFont: TFont;
  protected
    procedure InsertLetters(Letters: string);
    function BitmapFromText(const S: string): TBitmap;
    class function GetPixCol(x: Integer; Bmp: TBitmap): TPixCol;
  public
    destructor Destroy; override;
    procedure Init(Font: TFont); overload;
    procedure Init(const Alphabet: string; Font: TFont); overload;
    function Scan(Bmp: TBitmap): string;
  end;

type
  TForm2 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form2: TForm2;



implementation

{$R *.dfm}

{ TSimpleOCR }

destructor TSimpleOCR.Destroy;
begin
  FreeAndNil(FRoot);
  inherited;
end;

procedure TSimpleOCR.Init(const Alphabet: string; Font: TFont);
begin
  FFont:= Font;
  FreeAndNil(FRoot);
  FRoot:= TNode.Create;
  InsertLetters(Alphabet);
end;

procedure TSimpleOCR.Init(Font: TFont);
var
  Alphabet: string;
  ch: Char;
begin
  for ch := #32 to #255 do
    Alphabet:= Alphabet + ch;
  Init(Alphabet, Font);
end;

procedure TSimpleOCR.InsertLetters(Letters: string);
var
  Bmp: TBitmap;
  I, X, cx: Integer;
  Node: TNode;
begin
  Bmp:= BitmapFromText(Letters);
  try
    X:= 0;
    for I := 1 to Length(Letters) do
    begin
      Node:= FRoot;
      cx:= Bmp.Canvas.TextWidth(Letters[I]);
      while cx > 0 do
      begin
        Node:= Node.Add(GetPixCol(x, bmp));
        Inc(X);
        Dec(cx);
      end;
      Node.FLetter:= Letters[I];
    end;
  finally
    Bmp.Free;
  end;
end;

function TSimpleOCR.Scan(Bmp: TBitmap): string;
var
  X, Y: Integer;
  PixCol: TPixCol;
  Node: TNode;
  M: Cardinal;
begin
  Node:= FRoot;
  for X := 0 to Pred(Bmp.Width) do
  begin
    Node:= Node.Child(GetPixCol(X, bmp));
    if Node <> nil then
    begin
      if Node.FChildren = nil then
      begin
        Result:= Result + Node.FLetter;
        Node:= FRoot;
      end;
    end else
    begin
      raise Exception.CreateFmt('Fehler: OCR kann nach "%s" nicht weiterlesen!', [Result]);
    end;
  end;
end;

class function TSimpleOCR.GetPixCol(x: Integer; Bmp: TBitmap): TPixCol;
var
  y: Integer;
  M: Cardinal;
begin
  Result:= 0;
  M:= 1;
  for Y := 0 to Pred(Bmp.Height) do
  begin
    if bmp.Canvas.Pixels[x, y] = 0 then
      Result:= Result or M;
    M:= M shl 1;
  end;
end;

function TSimpleOCR.BitmapFromText(const S: string): TBitmap;
begin
  Result:= TBitmap.Create;
  Result.Canvas.Font:= FFont;
  with Result.Canvas.TextExtent(S) do
    Result.SetSize(cx, cy);
  Result.Canvas.TextOut(0, 0, S);
end;

{ TSimpleOCR.TNode }

destructor TSimpleOCR.TNode.Destroy;
var
  I: Integer;
begin
  for I := High(FChildren) downto Low(FChildren) do
    FreeAndNil(FChildren[I]);
  inherited;
end;

function TSimpleOCR.TNode.Add(PixCol: TPixCol): TNode;
begin
  Result:= Child(PixCol);
  if Result = nil then
  begin
    Result:= TNode.Create;
    Result.FPixCol:= PixCol;
    Result.FChildren:= nil;
    SetLength(FChildren, Length(FChildren) + 1);
    FChildren[High(FChildren)]:= Result;
  end;
end;

function TSimpleOCR.TNode.Child(PixCol: TPixCol): TNode;
var
  I: Integer;
begin
  for I := 0 to High(FChildren) do
  begin
    if FChildren[I].FPixCol = PixCol then
    begin
      Result:= FChildren[I];
      Exit;
    end;
  end;
  Result:= nil;
end;

{ Form2 }

procedure TForm2.FormCreate(Sender: TObject);
var
  OCR: TSimpleOCR;
  Bmp: TBitmap;
begin
  OCR:= TSimpleOCR.Create;
  try
    OCR.Init(Canvas.Font);
    bmp:= OCR.BitmapFromText('Hallo das ist ein text der gescannt wird!!');
    try
      Caption:= OCR.Scan(Bmp);
    finally
      FreeAndNil(Bmp);
    end;
  finally
    FreeAndNil(OCR);
  end;
end;

end.
Man kann es natürlich noch schneller machen mit sortiertem einfügen, scanline und so aber das kannst du sicher selber. du kannst auch noch hamming distanz machen damit er toleranter ist :shock:

Liebe Grüsse
Laufi

Medium 15. Jul 2009 07:31

Re: OCR für Arme, und ich bin noch ärmer
 
Bist du des Wahnsinns? :shock: Jetzt hab ich ja nicht mal mehr eine Ausrede (für mich selbst) es auf die extrem lange Bank zu schieben ;).

Reinhard Kern 15. Jul 2009 12:09

Re: OCR für Arme, und ich bin noch ärmer
 
Hallo,

wenn es sich nur um eine begrenzte Anzahl messages handelt, könnte man ja einen "holistischen" Ansatz versuchen: über das ganze Fenster eine Art Prüfsumme bilden und testen, ob verschiedene Messages (Bilder) sich unterscheiden lassen. Im Endeffekt ist das ein Ähnlichkeitsvergleich für Bilder, dafür sollte man Software finden können, es gibt ja Bildsuchprogramme, die im Internet ähnliche Bilder aufspüren.

Gruss Reinhard

Medium 15. Jul 2009 23:37

Re: OCR für Arme, und ich bin noch ärmer
 
Das ist in diesem Fall keine wirkliche Option, da insbesondere auch beliebig zusammengesetzte Zahlenkolonnen dabei sind. Bei nur ein paar zig möglichen Texten wäre das sicherlich erheblich einfacher.

dmdjt 20. Jul 2009 17:51

Re: OCR für Arme, und ich bin noch ärmer
 
Hab eine Idee dazu:

Der erste Schritt ist, für alle Zeichen eine Vektorsumme zu erstellen. Dh. alle Koordinaten der schwarzen Pixel zu addieren. Das Ergebnis ist eine Koordinate, die einem Buchstaben zugeordnet werden kann. Diese werden dann in einer Tabelle abgelegt.

Das OCR-System selbst muss dann nur noch von links beginnend ein Kästchen immer weiter nach rechts wachsen lassen und aus diesem Kästchen nach dem selben Schema eine Koordinate berechnen- bis eine Übereinstimmung mit der Tabelle gefunden wurde. Das nächste Kästchen beginnt dann nach dem letzten, bzw dort, wo das nächste schwarze Pixel gefunden wird.

Das sollte nicht besonders CPU zehrend sein und recht einfach zu programmieren.

Vielleicht sollte man das ganze auch aus zwei gegenüber liegenden Ecken machen, weil die am weitesten von der Ecke entfernten Pixel sonst die größte Gewichtung haben.

Was haltest Du davon?

dmdjt 20. Jul 2009 19:31

Re: OCR für Arme, und ich bin noch ärmer
 
Der Punkt von dem aus die Koordinaten berechnet und addiert werden sollte vielleicht doch eher auf halber Höhe liegen um größere Unterschiede zwischen den Zeichen zu bekommen. Ich habs noch nicht ausprobiert, aber meiner Meinung nach sollten dann auch l und I gut Unterscheidbar sein. Der Vorteil dieser Methode ist, dass man sich das aufteilen in Buchstaben spart und die einzelnen Zeichen sehr gut voneinander Unterscheidbar sind.

In der Tabelle könnte man auch Regions um die vorausberechneten Koordinaten legen und die gefundenen Koordinaten mittel PTInRegion überprüfen.

Ich werd mal ein Programm schreiben um zu überprüfen wie weit sich die Zeichen von einander unterscheiden. Das werde ich allerdings heute nicht mehr schaffen... vielleicht Morgen.

Medium 21. Jul 2009 05:57

Re: OCR für Arme, und ich bin noch ärmer
 
Das Problem mit l und I in diesem Font ist leider, dass sie Pixel für Pixel identisch sind. Da kann man sich auf den Kopf stellen und mit den Füßen Fliegen fangen - man wird's nicht ohne Semantik auseinanderhalten können. Ist aber wie gesagt in meinem speziellen Fall jetzt auch nicht weiter schlimm.


Alle Zeitangaben in WEZ +1. Es ist jetzt 19:54 Uhr.
Seite 3 von 4     123 4      

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz