Leere Seite (blank page) filtern bei DelphiTwain

[Schwedenbitter]

Hallo,

ich habe ein sehr kleines Scan-Programm für unser Büro geschrieben - nichts weltbewegendes. Der Scanner scannt duplex. Das wiederum kann man per Voreinstellung in der Software vom Scanner steuern.
Wenn es Seiten gibt, die eine leere Rückseite haben, will man die nicht mit abspeichern. Aktuell "löse" ich das so, dass ich jede zweite Seite einfach nicht abspeichere. Das muss aber der Benutzer im Vorfeld einstellen.

Ich würde das gern so gestalten, dass ich die ankommenden Seiten "untersuche". Wenn sie leer sind, dann sollen sie automatisch verworfen werden. Es gibt Twain-Software, die so etwas anbietet. Bei unserem Scanner gibt es das leider nicht.

Kann mir jemand auf die Sprünge helfen, wie man das am besten angeht?
Nach welchen Suchworten (notfalls auch Englisch) muss ich suchen?

Gruß, Alex

[Sir Rufo]

Ganz brutal geht das mit einer Überprüfung der Pixelfarben. Wenn jeder Pixel im Bild den gleichen Farbwert hat, dann haben wir keine wirkliche Information (Eisbär im Schneesturm, Schwarzer Adler auf schwarzem Grund).

[Perlsau]

Zitat:

Zitat von Schwedenbitter (Beitrag 1313344)

Ich würde das gern so gestalten, dass ich die ankommenden Seiten "untersuche". Wenn sie leer sind, dann sollen sie automatisch verworfen werden. Es gibt Twain-Software, die so etwas anbietet. Bei unserem Scanner gibt es das leider nicht.

Mein Scanner scannt auch kleine Kratzer und Staubteilchen mit ein. Das kann ich zwar ein wenig durch Einstellungen reduzieren, aber ein daraus resultierendes Bitmap kann man nicht mehr als völlig leer bezeichen. Unter Umständen wurde das Original auch schonmal gefaltet oder geknickt, dann sieht man die Falten auch auf dem Scanresultat. Die meisten Scans, vor allem wenn es um eingescannte Dokumente geht, die als PDF oder Ausdruck irgendwelchen Leuten zur Verfügung gestellt werden müssen (Anwalt, Behörden usw.) bearbeite ich kurz mit einer Bildbearbeitung: Kontrast und Helligkeit erhöhen, aber auch gezielte Aktionen wie Staub- und Moiréentfernung, damit erschlägt man schonmal die meisten Staubteilchen und Kratzer. Das brachte mich nun beim Lesen deiner Anfrage, ob es nicht möglich wäre, eine Kopie deines resultierenden Bitmaps mit ein paar Kontrast- und Helligkeitsmethoden zu bearbeiten und erst danach den Test zu machen, ob das Bild leer ist. Soweit ich mich erinnere, kann man aber auch ein Bild von Grau in Schwarz-Weiß umwandeln, indem man die Helligkeitsstufe festlegt, ab welcher das jeweilige Pixel weiß sein soll. Da würde ich mal ansetzen.

[Captnemo]

Mitunter werde auch die Ränder der Löcher des Lochers eingescannt und eine nicht ganz sauber eingelegte Vorlage kann auch am Seitenrand spuren aufweisen. Du könntest aber vielleicht den "inneren" Teil der Seite auswerten du die Farbwerte der Pixel innerhalb einer minimalen Toleranz vergleichen, so dass kleine Unreinheiten dadurch ausgefiltert werden. Bei großen Kratzern wird das aber wohl nicht funktionieren.

Danach würde ich dem Benutzer die gescannten Seiten in einer Miniaturansicht präsentieren und die als leer erkannten Seiten mit einem Tag "Löschen" versehen. Der Benutzer kann jetzt noch in der Miniaturansicht weitere nicht leer erkannte Seiten entfernen, oder als leer erkannte Seiten eben doch als gültig zulassen (ggf. sogar auch noch die Reihenfolge verändern). Erst wenn er dann bestätigt wird das Dokument übernommen.

[haentschman]

Hallo,

Ich habe es nicht gelesen. Der Titel sieht aber erfolgsversprechend aus. :P
http://stackoverflow.com/questions/5...nned-documents

[Schwedenbitter]

Danke für Eure Antworten!

Zitat:

Zitat von Perlsau (Beitrag 1313359)

... Soweit ich mich erinnere, kann man aber auch ein Bild von Grau in Schwarz-Weiß umwandeln, indem man die Helligkeitsstufe festlegt, ab welcher das jeweilige Pixel weiß sein soll. Da würde ich mal ansetzen.

Dieser letzte Satz hat mich auf die - aus meiner Sicht - richtige Fährte geschickt. Für mich habe ich das Problem gelöst.

Zunächst habe ich das Bild nach schwarz/weiß umgewandelt. Mein nächster Ansatz war es dann, die schwarzen Pixel zu zählen. Anschließend habe ich diese mit den weißen ins Verhältnis gesetzt und ab einem Wert von 3 ‰ (Promille) das Bild als Bild mit Inhalt deklariert. Allerdings war das sehr fehlerbehaftet. Denn es gibt nicht nur Staub, Falten etc., sondern dann auch schwarze Ränder und - überholter Beitrag - schwarze Löscher.
Also schneide ich jetzt die Ränder innerhalb bestimmter Grenzen ab. Anschließend zähle ich die Anzahl der schwarzen Pixel. Wenn diese einen absoluten Wert überschreiten, ist es kein leeres Bild mehr. Das beschleunigt sogar die Suche, weil ich dann die Procedure verlassen kann.

Hier mein Code fürs Protokoll:

Delphi-Quellcode:

// Leeres Bild erkennen --------------------------------------------------------
// MaxBlack ist die Anzahl maximal zulässiger schwarzer Pixel.
// Beim Scannen können schwarze Ränder, Staubkörner etc. auftreten. Um ein
// möglichst genaues Ergebnis zu erzielen werden zuerst die Ränder abge-
// schnitten und dann die Anzahl der dunkeln/schwarzen Pixel ermittelt.
// Der Wert selbst dürfte hardwareabhängig sein und kann deshalb als Variable
// übergeben werden.
Function TScanForm.PictureIsEmpty(Const BitMap: TBitmap;
   Const MaxBlack: Integer = 75): Boolean;
Const
   lMargin         = 12;                              // linker Rand
   rMargin         = 8;                              // rechter Rand
   bMargin         = 4;                              // unterer Rand
   tMargin         = 8;                              // oberer Rand
   Tolerance      = 118;                           // guter Schwarz-Wert
Var
   lWidth         : Integer;
   lHeight         : Integer;
   lBlack         : Int64;
   I, J            : Integer;
   lLine            :^TRGBTriple;
Begin
   Result:=True;                                    // ausgehen von leerem Bild
   lWidth:= BitMap.Width  - lMargin - rMargin;      // maximale Breite
   lHeight:=BitMap.Height - tMargin - bMargin;      // maximale Höhe
   BitBlt(Bitmap.Canvas.Handle, 0, 0, lWidth, lHeight,
      Bitmap.Canvas.Handle, lMargin, tMargin, SRCCOPY);
   BitMap.Width :=lWidth;
   BitMap.Height:=lHeight;
   If (Bitmap.PixelFormat <> pf24bit) Then
       Bitmap.PixelFormat := pf24bit;               // wegen Scanline
   lBlack:=0;                                       // schwarze Pixel

   For I:=0 To Pred(Bitmap.Height) Do               // alle Zeilen durchgehen
   Begin
      lLine:=Bitmap.Scanline[I];                     // Zeile zuweisen
      For J:=0 To Pred(Bitmap.Width) Do            // Zeile abarbeiten
      Begin
         If (lLine^.rgbtred + lLine^.rgbtBlue +
               lLine^.rgbtgreen) Div 3 < Tolerance Then
            Inc(lBlack);                           // = dunkler Wert -> schwarz
         If (lBlack >= MaxBlack) Then               // viele schwarze Pixel
         Begin
            Result:=False;                           // = Bild mit Inhalt
//         Exit;                                    // Zeit sparen!!!
         End;
         Inc(lLine);                                 // nächste Zeile durchsuchen
      End;
   End;

// TEST TEST TEST TEST TEST TEST TEST TEST TEST TEST TEST TEST TEST TEST TEST TE
   fList.Append(IntToStr(fCount) + ';' + IntToStr(BitMap.Height * BitMap.Width) +
      ';' + IntToStr(lBlack));
// TEST TEST TEST TEST TEST TEST TEST TEST TEST TEST TEST TEST TEST TEST TEST TE
End;

[Jens01]

Delphi-Quellcode:

         
If (lLine^.rgbtred + lLine^.rgbtBlue + lLine^.rgbtgreen) Div 3 < Tolerance Then
begin
  Inc(lBlack);                           // = dunkler Wert -> schwarz
  If (lBlack >= MaxBlack) Then               // viele schwarze Pixel
  Begin
    Result:=False;                           // = Bild mit Inhalt
//  Exit;                                    // Zeit sparen!!!
  End;
End;

Noch schneller...

[Perlsau]

Zitat:

Zitat von Schwedenbitter (Beitrag 1313470)

Zunächst habe ich das Bild nach schwarz/weiß umgewandelt. Mein nächster Ansatz war es dann, die schwarzen Pixel zu zählen. Anschließend habe ich diese mit den weißen ins Verhältnis gesetzt und ab einem Wert von 3 ‰ (Promille) das Bild als Bild mit Inhalt deklariert. Allerdings war das sehr fehlerbehaftet. Denn es gibt nicht nur Staub, Falten etc., sondern dann auch schwarze Ränder und - überholter Beitrag - schwarze Löscher. Also schneide ich jetzt die Ränder innerhalb bestimmter Grenzen ab. Anschließend zähle ich die Anzahl der schwarzen Pixel. Wenn diese einen absoluten Wert überschreiten, ist es kein leeres Bild mehr. Das beschleunigt sogar die Suche, weil ich dann die Procedure verlassen kann.

Diese beiden Werte – 3 Promille und deinen absoluten Wert an schwarzen Pixeln – kannst du, wenn du es komfortabler gestalten möchtest, dem Anwender als einstellbar überlassen, da ja nicht alle Scanner gleich gut oder schlecht scannen und die Verkratzungs- und/oder Verschmutzungsrate des Scanglases auch unterschiedlich sein kann. So könnte der Anwender dann Dokumente mit wenig sehr kleiner Schrift, die sonst vielleicht als leer gekennzeichnet würden, ebenfalls einstellen. Noch komfortabler wäre dann das Abspeichern diverser benutzerdefinierter Konfigurationen.

Bei dem Ganzen sehe ich aber noch ein Problem: Es kann durchaus vorkommen, daß auf einem Din-A-4-Blatt nur ganz ganz wenig Text steht oder nur ein klitzekleines Logo eingescannt werden soll. In diesem Fall könnte es sein, daß ein daraus resultierendes Bitmap ebenfalls als leer interpretiert würde. Daher sollte man vielleicht noch überprüfen, ob soundsoviele Pixel nebeneinander schwarz sind und bei einer – wiederum durch den Anwender einstellbaren – Größe das Bild durchgehen lassen. Sicher kennst du dieses Prinzip aus Tracing-Programmen, die Pixelbilder in Vektorgrafiken umwandeln wie z.B. Corel Trace.

[Schwedenbitter]

Danke für die weiteren Anmerkungen!

@Jens01
Ich bin natürlich immer an noch schnellerem Code interessiert; auch weil Büro-PC in der Regel keine Höllenmaschinen sind und die Bildbearbeitung die Dinger nicht aufhalten sollte.
Ich muss aber gestehen, dass ich die Beschleunigung am Code selbst nicht auf den ersten Blick erkennen kann. Ich interpretiere das so, dass die Abfrage immer nur dann durchgeführt wird, wenn er einen schwarzen Pixel findet und sonst nicht. Wenn das Bild aber weiß ist, "scannt" er sowieso das gesamte Bild. Und wenn er schwarz ist, fliegt er spätestens einen Zyklus später raus? Kann man die Beschleunigung messen?

@Perlsau
Das habe ich schon gebastelt. Meine Leute haben jetzt die Möglichkeit, über das Menü genau diese Werte zu manipulieren. Ich habe etliche Tests gemacht. Im Rahmen dessen habe ich festgestellt, dass ich immer von Farbbildern ausgegangen bin. Bei Grau- oder Schwarzweiß-Bildern passen diese Wert nur sehr bedingt. Ich habe daher mal ein Screenshot angehängt, was aus meiner sich sinnvolle Einstellungen sind.
Ich habe bei meinen Tests auch mit den extremen gespielt :lol:. Ich habe also "leere" Seiten mit eingeschmuggelt, auf denen mit immer dünner werdenden Bleistiftstrichen Smileys gemalt sind, die man kaum mit dem bloßen Auge erkennen kann. Diese wurden gefunden und als "nicht leer" identifiziert. Es kann aber wirklich am guten Seitenscanner liegen - obwohl dieser nach 5 Jahren auch schon einen Rotstich hat...

:dp: Aber dass ich so schnell zum Ziel gekommen bin, hatte ich auch selten. Danke für Eure qualifizierte Hilfe!

[Perlsau]

Zitat:

Zitat von Schwedenbitter (Beitrag 1313509)

:dp: Aber dass ich so schnell zum Ziel gekommen bin, hatte ich auch selten. Danke für Eure qualifizierte Hilfe!

Genau dafür ist dieses Forum da, denke ich: Sich gegenseitig behilflich zu sein und damit Zeit, Arbeitsaufwand, Sackgassen und Fehler zu sparen. Freut mich, daß ich helfen konnte :-D

[Jens01]

Zitat:

Ich interpretiere das so, dass die Abfrage immer nur dann durchgeführt wird, wenn er einen schwarzen Pixel findet und sonst nicht. Wenn das Bild aber weiß ist, "scannt" er sowieso das gesamte Bild. Und wenn er schwarz ist, fliegt er spätestens einen Zyklus später raus? Kann man die Beschleunigung messen?

Du zählst dies lBlack hoch und prüfst es gegen eine Konstante. Du brauchst es aber nur prüfen, wenn es sich verändert hat (Inc(lBlack)). Ansonsten ist das Ergebnis der Prüfung (if lBlack >= MaxBlack then) gleich mit dem des vorherigen Schleifendurchlauf.
Wenn die Hauptschleifen oft durchlaufen wird, kann sich des schon zeitlich auswirken.

[Schwedenbitter]

Zitat:

Zitat von Jens01 (Beitrag 1313542)

...
Wenn die Hauptschleifen oft durchlaufen wird, kann sich des schon zeitlich auswirken.

OK. Das überzeugt mich. Ich habe es geändert.

Wenn ich Zeit und Lust habe, kann ich ja mal testen, wie es sich auswirkt. Vermutlich muss ich dazu aber ein festes Bitmap nutzen. Denn selbst beim selben Rohmaterial (=Papierseiten) kommen jedes Mal andere Bilder über den Scanner.

[Sir Rufo]

So als Verbesserungsvorschlag:

Verkleinere die Bitmaps, die du durchsuchen willst z.B. auf 300x300 Pixel. Durch das Zusammengematsche fallen einzeln stehende Punkte (Staub, kleine Kratzer) schon dabei raus und die Stellen mit Text tauchen als schwarze Balken auf. (jetzt mal Schwarz-Weiß betrachtet)

[Schwedenbitter]

Zitat:

Zitat von Sir Rufo (Beitrag 1313552)

So als Verbesserungsvorschlag:

Verkleinere die Bitmaps ...

Auch das hört sich überzeugend an,
ABER
manchmal schreibt auch ein Staatsanwalt nur mit sehr dünnem und spitzen Bleistift. Dann müsste ich vor dem Verkleinern am Kontrast schrauben, weil mir sonst die Striche durch die Lappen gehen und das Bild als leer identifiziert wird. Ich hatte irgendwo mal angemerkt, dass ich schon umfangreiche Tests gerade mit Bleistift gemacht hatte.
Das wiederum (erst Kontrast, dann BitBlt, dann Pixelsuche) führt am Ende vermutlich nicht mehr zu einer weiteren Beschleunigung. Ich fürchte, das macht es eher fehleranfällig.

Außerdem arbeiten wir im Moment mit Singlecore Celerons. Da läuft das schon flott. Wir stellen aber auf Windows 10 und zugleich auf Quadcore-Rechner um. Die sollen mal schön rechnen. Die Mitarbeiter müssen sich ja auch mal einen Kaffee holen können. Das schaffen die sowieso schon nicht mehr :lol:

[Jens01]

"Staatsanwalt" :shock: :shock: :shock:

Vielleicht solltest Du die "leeren" Seiten nicht verwerfen, sondern nur extra ablegen.

[hanvas]

Eines vorweg, die meisten besseren Dokumentenscanner unterstützen dieses Feature in der Hardware oder im Treiber.

Falls ein solcher zum Einsatz kommt wäre es klüger die dort implementierten Verfahren zu verwenden. Das entsprechende Feature nennt sich ICAP_AUTODISCARDBLANKPAGES und ist ab der Revision 2.1 des Standards vorhanden, die meisten TWAIN Delphi Implementierungen basieren aber auf TWAIN 2.0 und haben deswegen die entsprechenden Konstanten nicht definiert.

Zitat:

Zitat von Schwedenbitter (Beitrag 1313573)

Auch das hört sich überzeugend an,

ABER

manchmal schreibt auch ein Staatsanwalt nur mit sehr dünnem und spitzen Bleistift.

Der in diesem Fall einfachste - und dennch relativ zuverlässigste Weg wäre - ein leistungsfähiges globales oder lokales Verfahren zur Wandlung des Graustufenbildes in ein Schwarzweissbild zu verwenden. Das hat den Vorteil das der Vordergrund und der Hintergrund des Bildes relativ sauber getrennt wird, selbst dann wenn es über die Seite verteilt Unterschiede in der Helligkeit gibt. Normalerweise sollte auch der dünne Strich Deines Staatsanwaltes erhalten bleiben.

Ich habe Dir ein paar Beispiele dazu hingeschrieben.

Die Verwendung meiner Beispiele wäre :

Code:

 var x : Integer;

 x := TreshXXXX(Image);
 newImage := BinarizeThrsh(Image,x);

Aber Du kannst den Code ohnehin nicht 1:1 verwenden. ThreshOtuDisc wäre der Klassiker, ThreshEntropy ist aber schneller ich verwende in einer ähnlichen Situation :

Code:

     t := TOcrImage.CreateFromBitmap(Image.Bitmap);
     case isBW of
      0 : o := t; // wir sind sw ->
      1 : try
           thrsh := ThreshEntropy(t);
           if ( thrsh < 0 ) then
               thrsh := ThrshOptimum(t);
           if ((thrsh) < 0) then
             begin
             result := False;
             exit;
            end;
           o     := BinarizeThresh(t, thrsh);
          finally
           t.free;
          end; 
     ......
     end;

Da Du anschließend ein Schwarweißbild hast führst Du eine Analyse der verbundenen Regionen durch - mit anderen Worten du arbeitest dich rekursiv bei einem Pixel in Schwarz zum nächsten Pixel vor das an das erste Pixel angrenzt dann zum nächsten usw. bis Du eine komplette zusammenhängende Region hast und speicherst diese Regionen und deren Eigenschaften in einer Liste.

Du kannst davon ausgehen das einzelne Pixel, oder Verbunde von Pixeln unterhalb eines gewissen Größe Dreck, Staub etc. sind. Diese Elemente kannst Du löschen. Anschließend stellt Du fest ob Du große zusammenhängende Regionen hast deren Bounding Box sehr schmal ist aber dafür nahezu die gesamte Höhe des gescannten Blattes einimmst. Dabei handelt es sich um horizontale Linien die normalerweise durch Dreck oder Kratzer auf dem Scannerglas entstanden sind. Auch die kannst Du löschen (aber nur wenn die Box wirklich relativ schmal ist)

Wenn Du auf diese Art alle unerwünschten Einflüsse eleminiert hast rekonstriest Du das Bild anhand der noch vorhandenen Elemente in der Liste. Anschließend bildest Du die Bounding Box über das gesamte Bild - ich würde übrigens beim Scannen den Rand in einer Breite von 5 - 15 Pixel noch vor der Erstellung der Liste löschen bzw. auf Weiss setzen.

Nun betrachtest Du nur den Inhalt in der Box und nimmst einen Wert zwischen 1% und 5% an - ist die Anzahl der gesetzten Pixel darunter kannst Du von einem leeren Bild ausgehen. Anpassungen an spezielle Problemstellungen sind natürlich möglich.

Im nachfolgenden Beispiel habe ich die Klasse TOcrImage nicht definiert - die einzelnen Zeilen eines Bildes sind aber nichts anderes als Arrays bzw. Zeiger auf Arrays deren einzelne Elemente Bytes sind - im Fall eines Graustufenbildes von 0-255 im S/W Fall eben 0/1.

Die Implementierungen sind entweder eine Umsetzung bekannter Verfahren oder ich habe Sie dem Buch "Practical Algorithms for Image Analysis" entnommen und von C nach Pascal umgesetzt.

Code:

type     TOcrIntegerHistogram = array of Integer;
         TOcrDoubleHistogram  = array of Double;

procedure TOcrImage.Histogram  ( var Hist : TOcrIntegerHistogram );
var i   : Integer;
    y,x : Integer;
begin
 SetLength ( Hist, 256 );
 for i := 0 to 255 do Hist[i] := 0;
 for y := 0 to pred ( Nr ) do
     for x := 0 to pred ( Nc ) do
               inc ( Hist[Data[y,x]] );
end;

procedure  TOcrImage.RelativeHistogramm ( var hist : TOcrDoubleHistogram );
var histI   : TOcrIntegerHistogram;
    pixels  : LongInt;
    counter : Integer;
begin
 pixels := Nr * Nc;
 SetLength ( hist, 256 );
 if ( pixels <= 0 ) then
 begin
  for counter := 0 to 255 do
      hist[counter] := 0;
  exit;
 end;
 Histogram ( histI );
 for counter := 0 to 255 do
     hist[counter] := histI[counter] / pixels;
 SetLength ( histI, 0 );
end;

function BinarizeThresh ( const ImgIn : TOcrImage; Thresh : Integer ) : TOcrImage;
var i,j   : Integer;
    pS,pT : pByte;
begin
  result := TOcrImage.Create ( ImgIn.Nr, ImgIn.Nc );
  for j := 0 to pred ( imgIn.Nr ) do
  begin
   i  := 0;
   pS := imgIn.GetLinePointer ( j, 0 );
   pT := result.GetLinePointer ( j, 0 );
   while (i < imgIn.Nc ) do
    begin
       if ( pS^ < thresh ) then pT^ := _ON
                           else pT^ := _OFF;
       inc(pS);
       inc(pT);
       inc(i);
    end;
  end;
end;


function ThreshEntropy ( const ImgIn : TOcrImage ) : Integer;
var  width, height : Integer;           (* image size *)
     Hn, Ps, Hs    : Double;
     psi, psiMax   : Double;
     x, y,                    (* image coordinates *)
     i, j, n       : Integer;
     iHist : array [0..NHIST-1] of integer;            (* hist. of intensities *)
     prob  : array [0..NHIST-1] of Double;
begin
 result  := -1;
(* allocate input and output image memory *)
  height := imgIn.Nr;
  width  := imgIn.Nc;
(* compile histogram *)
  for i := 0 to pred ( NHIST ) do iHist[i] := 0;

  n := 0;
  for y := 0 to pred ( height ) do
    for x := 0 to pred ( width ) do
     begin
      inc(iHist[imgIn.Data[y,x]]);
      inc(n);
     end;

  if ( n <= 0 ) then begin
                       result := -1;
                       exit;
                     end;
  (* compute probabilities *)
  for i := 0 to pred ( NHIST ) do
      prob[i] := iHist[i] / n;

(* find threshold *)
  hn := 0;
  for i := 0 to pred ( NHIST ) do
    if (prob[i] <> 0.0) then
      Hn := hn - ( prob[i] * ln (prob[i]) );
  psiMax := 0.0;
  for i := 1 to pred ( NHIST ) do
   begin
     ps := 0;
     hs := 0;
     for j := 0 to pred ( i ) do
       begin
        Ps := ps + prob[j];
        if (prob[j] > 0.0) then
          Hs := hs - ( prob[j] * ln (prob[j]) );
    end;
    if (Ps > 0.0) and (Ps < 1.0) then
    begin
      psi := ln (Ps - Ps * Ps) + Hs / Ps + (Hn - Hs) / (1.0 - Ps);
      if (psi > psiMax) then
      begin
       psiMax := psi;
       result := i;
     end;
    end;
  end;
end;

function ThrshOptimum         ( const ImgIn : TOcrImage ) : Integer;
var x,y,Flag,j : Integer;
    hist       : TOcrDoubleHistogram;
    Sum        : Double;
begin
 ImgIn.RelativeHistogramm ( hist );
 for y := 0 to 255 do
  begin
   sum := 0;
   for x := -15 to 15 do
    begin
     j := y-x;
     if  ( ( j ) >= 0  ) and
         ( ( j < 255 ) ) then Sum := Sum + Hist[j];
    end;
   Hist[y] := SUM / 31 ; 
  end;
  Y      := 2;
  FLAG   := 0;
  result := 0;
  while ( Flag = 0 ) and ( y < 254 ) do
   begin
    if ( ( HIST [Y-1] >= HIST[y  ] )   and
         ( HIST [Y]   <  HIST[y+1] ) ) then
           begin
            Flag   := 1;
            result := Y;
           end;
    inc ( y );
   end;
 SetLength ( hist, 0 );
end;

function ThrshMovingAvarage (const imgIn : TOcrImage ) : TOcrImage;
var    NC, row, col, _inc : Integer ;
       mean, s, sum       : Double;
       N, i               : Integer;
      im                 : TOcrImage;
begin
  im   := TOcrImage.CopyCreate ( imgIn ); 
   N   := im.nc * im.nr;
   NC  := im.nc;
   s   := (NC/Navg);
   sum := 127*s;
   row := 0;
  col := 0;
   _inc := 1;

   for i:= 0 to pred ( N-1 ) do
   begin
     if (col >= NC) then   begin
       col := NC-1;
      inc(row);
       _inc := -1;
      end
    else
     if (col < 0) then
      begin
         col := 0;
        inc(row);
        _inc := 1;
       end;

   // Estimate the mean of the last NC/8 pixels.
     sum  := sum - sum/s + im.Data[row,col];
     mean := sum/s;
     if ( im.Data[row,col] < mean*(100-pct)/100.0) then im.Data[row,col] := 0
                                                  else im.Data[row,col] := 255;
     col := col + _inc;
   end;
  im.Invert;
  result := im;
end;

function ThreshOtuDisc ( const ImgIn : TOcrImage ) : Integer;
var
  width, height,           (* image size *)
  nHistM1,
  x, y,                    (* image coordinates *)
  i, j, n : Integer;
  m0Low, m0High, m1Low, m1High, varLow, varHigh,
  varWithin, varWMin : Double;
  prob  : array [0..NHIST-1] of double;
  iHist : array [0..NHIST-1] of integer;      (* hist. of intensities *)
begin
 (* allocate input and output image memory *)
  height := imgIn.Nr;
  width  := imgIn.Nc;
 (* compile histogram *)
 FillChar ( iHist[0], NHIST * SizeOf(Integer), 0 );
 // for i := 0 to pred ( NHIST ) do iHist[i] := 0;
  n := 0;
  for y := 0 to pred ( height ) do
    for x := 0 to pred ( width ) do
     begin
      inc(iHist[imgIn.Data[y,x]]);
      inc(n);
     end;
(* compute probabilities *)
  for i := 0 to pred ( NHIST ) do prob[i] := iHist[i] / n;

(* find best threshold by computing moments for all thresholds *)
  nHistM1 := NHIST - 1;
  result  := 0;
  varWMin := 100000000.0;
  for   i := 1 to pred ( nHistM1 ) do
   begin
    m0Low   := 0.0;
    m0High  := 0.0;
    m1Low   := 0.0;
    m1High  := 0.0;
    varLow  := 0.0;
    varHigh := 0.0;
    for j := 0 to i do
     begin
      m0Low := m0Low + prob[j];
      m1Low := m1Low + j * prob[j];
     end;
    if ( m0Low <> 0.0 ) then m1Low := m1Low / m0Low
                        else m1Low := i;
    for j := i + 1 to pred ( NHIST ) do
     begin
      m0High := m0High + prob[j];
      m1High := m1High + j * prob[j];
     end;
    if ( m0High <> 0 ) then m1High := m1High / m0High
                       else m1High := 1;
    for j := 0 to i do
        varLow := varLow + ( (j - m1Low) * (j - m1Low) * prob[j] );
    for j := i + 1 to pred ( NHIST ) do
        varHigh := varHigh + ( (j - m1High) * (j - m1High) * prob[j] );

    varWithin := m0Low * varLow + m0High * varHigh;
    if (varWithin < varWMin) then
     begin
      varWMin := varWithin;
      result  := i;
    end;
  end;
end;

cu Ha-Jö