Simple OCR for numbers

program new;

const
  STR_UPPERCASE = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  STR_LOWERCASE = 'abcdefghijklmnopqrstuvwxyz';
  STR_LETTERS   = STR_UPPERCASE + STR_LOWERCASE;
  STR_NUMBERS   = '0123456789';
  STR_SYMBOLS   = '.,-<>?+()/\*';
  STR_EVERYTHING= STR_LETTERS + STR_NUMBERS + STR_SYMBOLS;
  STR_FNUMBERS  = STR_NUMBERS + '.';


function PrepareTPAForOCR(TPA: TPointArray; size:Int32=18): TPointArray;
var
  muf: TMufasaBitmap;
  B: TBox;
begin
  Result := Copy(TPA);
  B := GetTPABounds(Result);
  OffsetTPA(Result, Point(-B.X1,-B.Y1));

  muf := GetMufasaBitmap(CreateBitmap(B.x2-B.x1+2, B.y2-B.y1+2));
  muf.DrawTPA(Result, $FFFFFF);
  //WriteLn(size / muf.GetHeight * muf.GetWidth);
  muf.ResizeEx(RM_Bilinear, Ceil(size / muf.GetHeight * muf.GetWidth), size);
  muf.ThresholdAdaptive(0,255, False, TM_Mean, 0);
  muf.FindColors(Result, 255);
  muf.Free();
end;


function LoadFontFeatures(fontName:String; style:TFontStyles=[]; Chars:String = STR_EVERYTHING): T2DPointArray;
var
  W,H,i,x,y: Int32;
  bmp: TBitmap;
  tmp: TPointArray;
  f: TFont;
begin
  F.Init();
  F.SetName(fontName);
  F.SetSize(20);
  F.setStyle(style);
  F.setQuality(fqNonAntialiased);
  F.setColor($FFFFFF);
  bmp.Init();

  bmp.GetCanvas().GetBrush().SetStyle(bsClear);
  bmp.GetCanvas().SetFont(F);

  for i:=1 to Length(Chars) do
  begin
    bmp.Clear();
    W := bmp.GetCanvas().TextWidth(Chars[i]) + 1;
    H := bmp.GetCanvas().TextHeight(Chars[i]) + 1;
    bmp.SetWidth(W);
    bmp.SetHeight(H);
    bmp.GetCanvas().TextOut(0,0, Chars[i]);

    for y:=0 to H-1 do
      for x:=0 to W-1 do
        if bmp.GetCanvas.GetPixel(x,y) = $FFFFFF then
          tmp += Point(x,y);

    Result += PrepareTPAForOCR(TMP);
    SetLength(tmp, 0);
  end;
  F.Free();
  bmp.Free();
end;


function TPointArray.DistToNearest(p:TPoint): Double;
var
  i:Int32;
  d:Double;
begin
  Result := 9999999;
  for i:=0 to High(self) do
  begin
    d := Hypot(self[i].x-p.x, self[i].y-p.y);
    if d < Result then
    begin
      Result := d;
      if Result = 0 then Exit;
    end;
  end;
end;

function DirtyMatchTPA(A,B:TPointArray): Double;
var
  i:Int32;
begin
  for i:=0 to High(A) do
    Result += B.DistToNearest(A[i]);
  Result /= Length(A);
end;

function DirtyOCR(TPA:TPointArray; chars: T2DPointArray): TIntegerArray;
var
  i, j, charId:Int32;
  best,this:Double;
  ATPA: T2DPointArray;
  B: TBox;
begin
  ATPA := ClusterTPAEx(TPA, 1,2);
  B := GetTPABounds(TPA);
  SortATPAFromMidPoint(ATPA, Point(B.x1,B.y1));

  for i:=0 to High(ATPA) do
    ATPA[i] := PrepareTPAForOCR(ATPA[i]);

  for i:=0 to High(ATPA) do
  begin
    best := $FFFFFF;

    for j:=0 to High(chars) do
    begin
      this := (DirtyMatchTPA(ATPA[i], chars[j]) + DirtyMatchTPA(chars[j], ATPA[i])) / 2;
      if this < best then
      begin
        best := this;
        charId := j;
      end;
    end;
    //if best < 5 then
      Result += charId;
  end;
end;

function IndicesToString(idx:TIntegerArray; Lookup:String): String;
var i:Int32;
begin
  for i:=0 to High(idx) do
    Result += Lookup[idx[i]+1];
end;

function GrabTextArea(Area:TBox; thresh: Int32; Debug:Boolean=True): T2DPointArray;
var
  i:Int32;
  bmp:TMufasaBitmap;
  TPA:TPointArray;
  ATPA:T2DPointArray;
begin
  bmp := GetMufasaBitmap(BitmapFromClient(Area.x1,Area.y1,Area.x2,Area.y2));
  bmp.ThresholdAdaptive(0,255, True, TM_Mean, thresh);

  if debug then
  begin
    DisplayDebugImgWindow(bmp.getWidth, bmp.getHeight);
    DrawBitmapDebugImg(bmp.getIndex);
  end;

  bmp.FindColors(TPA, 255);
  ATPA := ClusterTPAEx(TPA, 10,4);
  for i:=0 to High(ATPA) do
    if True{add some checks perhaps} then
      Result += ATPA[i];

  bmp.Free();
end;


function GrabTextFromColumns(area:TBox; thresh: Int32; borderColor, borderTol:Int32; Debug:Boolean=True): T2DPointArray;
var
  i:Int32;
  bmp:TMufasaBitmap;
  TPA,cols:TPointArray;
  ATPA:T2DPointArray;
begin
  bmp := GetMufasaBitmap(BitmapFromClient(Area.x1,Area.y1,Area.x2,Area.y2));
  bmp.ThresholdAdaptive(0,255, True, TM_Mean, thresh);

  FindColorsTolerance(cols, borderColor, Area.x1,Area.y1,Area.x2,Area.y2, borderTol);
  OffsetTPA(cols, Point(-area.x1, -area.y1));
  bmp.DrawTPA(cols, $FF0000);

  if debug then
  begin
    DisplayDebugImgWindow(bmp.getWidth, bmp.getHeight);
    DrawBitmapDebugImg(bmp.getIndex);
  end;

  bmp.FindColors(TPA, 0);
  ATPA := ClusterTPA(TPA, 1);
  for i:=0 to High(ATPA) do
    Result += ReturnPointsNotInTPA(ATPA[i], GetTPABounds(ATPA[i]));

  bmp.Free();
end;



var
  input, chars:T2DPointArray;
  str: String;
  i,j:Int32;
begin                   {search area, should only inc the columns}
  input := GrabTextFromColumns([140,211, 520,485], -80, $C0C0C0, 50);

  chars := LoadFontFeatures('Tahoma', [], STR_FNUMBERS);

  for i:=0 to High(input) with 3 do //steps of 3
  begin
    str := '';
    for j:=0 to 2 do //proccess the columns
    begin
      if i+j > High(input) then
      begin
        WriteLn(str);
        Break(2); //nothing more to proccess
      end;

      str += IndicesToString(DirtyOCR(input[i+j], chars), STR_FNUMBERS);
      if j <> 2 then
        str += '  |  '
      else
        WriteLn(str);
    end;
  end;
end.