delphi手写字符识别

var

Form1: TForm1;

myNet: CNeuronet;

maxneur: integer;

implementation

{$R *.DFM}

procedure TForm1.ocrbuttons_freigeben();

begin

ButAnalyse.Enabled:=true;

ButSavLet.Enabled:=true;

ButAddLet.Enabled:=true;

LetNr.Enabled:=true;

end;

procedure TForm1.ocrbuttons_sperren();

begin

ButAnalyse.Enabled:=false;

ButSavLet.Enabled:=false;

ButAddLet.Enabled:=false;

LetNr.Enabled:=false;

end;

procedure TForm1.plainbuttons_freigeben();

begin

ImagePat.Enabled:=true;

PatNr.Enabled:=true;

ButAddPat.Enabled:=true;

ButSavPat.Enabled:=true;

end;

procedure TForm1.plainbuttons_sperren();

begin

ImagePat.Enabled:=false;

PatNr.Enabled:=false;

ButAddPat.Enabled:=false;

ButSavPat.Enabled:=false;

end;

procedure TForm1.B1ErstellenClick(Sender: TObject);

var i,rowanz:integer;

begin

GrNetSpec.Enabled:=true; GrNetSpec.Visible:=true;

GrLern.Enabled:=false;

plainbuttons_sperren; ocrbuttons_sperren;

GrOCRLearn.Visible:=false; GrOCRLearn.Visible:=false;

GrSimpleLearn.Visible:=false; GrSimpleLearn.Visible:=false;

GrError.Visible:=false;

ButSavNet.Enabled:=false; ButReset.Enabled:=false;

ImagePat.clientWidth:=250;

GrOCRTest.Visible:=false; Image.Visible:=false;

rowanz:=Rows.Value+1;

AnzGrid.RowCount:=rowanz;

AnzGrid.Cells[1,1]:=floattostr(225); AnzGrid.Cells[0,1]:='Input';

AnzGrid.Cells[1,rowanz-1]:=floattostr(26); AnzGrid.Cells[0,rowanz-1]:='Output';

for i:=2 to rowanz-2 do begin

AnzGrid.Cells[0,i]:=inttostr(i);

AnzGrid.Cells[1,i]:=floattostr(1);

end;

end;

procedure TForm1.drawnet();

begin

Image.Canvas.Pen.color:=clWhite;

Image.Canvas.Rectangle(Image.ClientRect);

myNet.calc_forward();

myNet.zeichne(Image.Canvas); {netz zeichnen}

end;

procedure TForm1.B2beginClick(Sender: TObject);

var i,rowanz,layanz:integer;

nanz: array of integer;

art: char;

begin

rowanz:=Rows.Value+1;

layanz:=rowanz-1;

if (RadioGroup1.ItemIndex=0) then begin

art:='P';

end

else begin

art:='O';

AnzGrid.Cells[1,1]:=floattostr(225);

AnzGrid.Cells[1,AnzGrid.RowCount-1]:=floattostr(26);

end;

{anz neuronen pro schicht aus dem grid auslesen }

maxneur:=0; { f黵dimension der gewichtsmatrix das maximum merken }

SetLength(nanz,layanz);

for i:=0 to layanz-1 do begin

nanz[i]:=strtoint(AnzGrid.Cells[1,i+1]); {anzahl der neuronen je schicht}

if nanz[i]>maxneur then maxneur:=nanz[i];

end;

inc(maxneur); {wegen dem bias}

myNet.Free; {evtl. vorhandenes Netz l鰏chen }

myNet:=CNeuronet.Create(layanz,nanz,art); {netz erstellen}

myNet.w.Free;

myNet.w:=Cwmatrix.Create(https://www.360docs.net/doc/1011567130.html,nz,maxneur); {gewichtsmatrix erz}

ButSavNet.Enabled:=true;

ButReset.Enabled:=true;

if (art='P') then begin { wenn plain }

GrOCRLearn.Visible:=false; GrOCRLearn.Visible:=false;

GrSimpleLearn.Visible:=true; GrSimpleLearn.Enabled:=true;

clearI(ImagePat);

Image.Visible:=true;

drawnet();

end

else if (art='O') then begin { wenn ocr }

GrOCRLearn.Visible:=true; GrOCRLearn.Enabled:=true;

GrSimpleLearn.Visible:=false; GrSimpleLearn.Enabled:=false;

GrError.Visible:=true;GrOCRTest.Visible:=true; GrOCRTest.Enabled:=true;

ClearI(ImOCRTestDraw);

ClearI(Imgezoomt);

ClearI(ImZNeur);

end;

GrNetSpec.Visible:=false; GrError.Visible:=true;

end;

procedure TForm1.ImageMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

var nr: integer;

n: ^CNeuron;

begin

nr:=0;

if ((Y>0) and (Y<20)) then begin

nr:= ( (X-10+(myNet.L[0].abst div 2)) div myNet.L[0].abst);

end;

if ((nr>0 )and (nr

n:=@myNet.L[0].N[nr];

n.activity:=1.0-n.activity;

myNet.calc_forward();

myNet.zeichne(Image.Canvas);

end; //myNet.zeichne(Image.Canvas);

end;

procedure TForm1.Akt();

begin

ErrorLabel.Caption:=floattostrf(myNet.qerror,ffFixed,7,7)+ ' finished!';

myNet.calc_forward(); myNet.zeichne(Image.Canvas);

end;

procedure TForm1.vorbereiten();

begin

myNet.stop:=false;

try

myNet.eta:=strtofloat(etaedit.Text);

except

myNet.eta:=0.2; etaedit.Text:=floattostr(0.2);

end;

try

myNet.mom:=strtofloat(momedit.Text);

except

myNet.mom:=0; momedit.Text:=floattostr(0);

end;

ErrorLabel.Caption:='calculating...'; ErrorLabel.Update;

end;

function TForm1.getnoise():double;

var noise:double;

begin

try

noise:=strtofloat(EditNoise.Text);

except

noise:=0.02;

end;

if (noise<0) then noise:=0 else if (noise>1.0) then noise:=1.0;

EditNoise.text:=floattostr(noise);

getnoise:=noise;

end;

procedure TForm1.Button6Click(Sender: TObject);

begin

vorbereiten;

myNet.lerne_schritte(Application,getsolle(),1,getnoise(),ErrorLabel,ErrorImage);

Akt();

end;

function TForm1.getsolle:double;

var solle:double;

begin

try

solle:=strtofloat(sollerror.Text);

except

solle:=0.01;

end;

getsolle:=solle;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

vorbereiten;

myNet.lerne_schritte(Application,getsolle(),10,getnoise(),ErrorLabel,ErrorImage);

Akt();

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

vorbereiten;

myNet.lerne_schritte(Application,getsolle(),100,getnoise(),ErrorLabel,ErrorImage);

Akt();

end;

procedure TForm1.Button3Click(Sender: TObject);

begin

myNet.lerne_schritte(Application,getsolle(),1000,getnoise(),ErrorLabel,ErrorImage);

Akt();

end;

procedure TForm1.Button4Click(Sender: TObject);

begin

vorbereiten;

myNet.lerne_schritte(Application,getsolle(),10000,getnoise(),ErrorLabel,ErrorImage);

Akt();

end;

procedure TForm1.Button7Click(Sender: TObject);

begin

vorbereiten;

myNet.lerne_schritte(Application,getsolle(),100000,getnoise(),ErrorLabel,ErrorImage);

Akt();

end;

procedure TForm1.ImOCRLernDrawMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

zeichne:=true;

ax:=x;

ay:=y;

with ImOCRLernDraw.Canvas.Pen do begin

color:=clRed;

width:=6;

end;

end;

procedure TForm1.ImOCRLernDrawMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

zeichne:=false;

end;

procedure TForm1.ImOCRLernDrawMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

begin

if zeichne then begin

ImOCRLernDraw.Canvas.MoveTo(ax,ay);

ImOCRLernDraw.Canvas.LineTo(x,y);

ax:=x;

ay:=y;

end;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

zeichne:=false;

erkenne:=false;

ax:=0; ay:=0;

ButClearClick(Sender);

ButReset.Caption:='R';

end;

procedure TForm1.ButClearClick(Sender: TObject);

begin

ClearI(ImOCRLernNeur);

ClearI(ImOCRLernDraw);

ClearI(ImOCRLernZoom);

end;

procedure TForm1.ButAnalyseClick(Sender: TObject);

var sx,sy,dx,dy,x,y,nr:integer;

minx,maxx,miny,maxy,maxh,maxb,maxhb: double;

altx,alty,mittel: double;

feld: array of double;

begin

minx:=1000; maxx:=0; miny:=1000; maxy:=0;

SetLength(feld,225);

{ Grenzen im Paint-Image feststellen }

for sx:=0 to 63 do begin

for sy:=0 to 63 do begin

if (ImOCRLernDraw.Canvas.Pixels[sx,sy]=clRed) then begin

if sx < minx then minx:=sx; if sx > maxx then maxx:=sx;

if sy < miny then miny:=sy; if sy > maxy then maxy:=sy;

end;

end;

end;

{aspect-ratio beibehalten }

maxh:=maxy-miny; maxb:=maxx-minx;

if (maxh>maxb) then begin { breite < h鰄e -> maxx u minx anpassen }

maxhb:=maxh;

minx:=round( ((maxx-minx)/2+minx)-(1/2*(maxhb)));

maxx:=round( ((maxx-minx)/2+minx)+(1/2*(maxhb)));

end

else begin { h鰄e < breite -> maxy u miny anpassen }

maxhb:=maxb;

miny:=round( ((maxy-miny)/2+miny)-(1/2*(maxhb)));

maxy:=round( ((maxy-miny)/2+miny)+(1/2*(maxhb)));

end;

{ projezieren }

if ((maxy>miny) and (maxx>minx)) then begin

for dx:=0 to 63 do begin

for dy:=0 to 63 do begin

altx:=dx/64*(maxx-minx)+minx;

alty:=dy/64*(maxy-miny)+miny;

sx:=round(altx);

sy:=round(alty);

if ((sx<0) or (sx>63) or (sy<0) or (sy>63)) then

ImOCRLernZoom.Canvas.Pixels[dx,dy]:=clWhite

else

ImOCRLernZoom.Canvas.Pixels[dx,dy]:=ImOCRLernDraw.Canvas.Pixels[sx,sy];

end;

end;

end;

// neuronenbelegung durch mittelwertbildung erzeugen

for dx:=0 to 14 do begin

for dy:=0 to 14 do begin

mittel:=0;

for x:=0 to 5 do begin

for y:=0 to 5 do begin

if ImOCRLernZoom.Canvas.Pixels[2+dx*4+x,2+dy*4+y]=clRed then begin

mittel:=mittel+1;

end;

end;

end;

mittel:=mittel/36;

feld[dy*15+dx]:=mittel;

end;

end;

nr:=Letnr.Value;

{neuronenbelegung anzeigen und in Mustersatz 黚ertragen}

for dx:=0 to 14 do begin

for dy:=0 to 14 do begin

myNet.myPatterns.M[nr].input[dy*15+dx]:=feld[dy*15+dx];

ImOCRLernNeur.Canvas.brush.color:=round(myNet.myPatterns.M[nr].input[dy*15+dx]*255);

ImOCRLernNeur.Canvas.fillrect(Rect(dx*5,dy*5,dx*5+4,dy*5+4));

end;

end;

{hier noch die Muster in "myletters" zum abspeichern 黚ertragen }

if ((nr>=0) and (nr

for dx:=0 to 63 do begin

for dy:=0 to 63 do begin

if (ImOCRLernZoom.Canvas.Pixels[dx,dy]=clred) then

myNet.myLetters.B[nr].input[dy*64+dx]:=1.0

else

myNet.myLetters.B[nr].input[dy*64+dx]:=0.0;

end;

end;

myNet.myLetters.B[nr].buchst:=upcase(sollchar.text[1]);

end;

{output-neuronen auf 0 ausser eines}

for dx:=0 to myNet.L[https://www.360docs.net/doc/1011567130.html,nz-1].Nanz-2 do begin

if ( dx= (ord(myNet.myLetters.B[nr].buchst)-ord('A'))

) then myNet.myPatterns.M[nr].output[dx]:=1

else myNet.myPatterns.M[nr].output[dx]:=0;

end;

feld:=nil;

end;

procedure TForm1.ButSavPatClick(Sender: TObject);

var filename: string;

datei: file of double;

temp: double;

i,a,b: integer;

begin

if SaveDialogPat.Execute then begin

filename:=SaveDialogPat.FileName;

try

AssignFile(datei,filename);

Rewrite(datei);

temp:=myNet.myPatterns.Manz; Write(datei,temp);

temp:=myNet.myPatterns.ilen; Write(datei,temp);

temp:=myNet.myPatterns.olen; Write(datei,temp);

for i:=0 to myNet.myPatterns.Manz-1 do begin

for a:=0 to myNet.myPatterns.ilen-1 do begin

temp:=myNet.myPatterns.M[i].input[a];

Write(datei,temp);

end;

for b:=0 to myNet.myPatterns.olen-1 do begin

temp:=myNet.myPatterns.M[i].output[b];

Write(datei,temp);

end;

end;

finally

CloseFile(datei);

end;

end;

end;

procedure TForm1.ClearI(wo: TImage);

var cx,cy:integer;

begin

for cx:=0 to wo.clientwidth-1 do begin

for cy:=0 to wo.clientheight-1 do begin

wo.Canvas.Pixels[cx,cy]:=0;

end;

end;

end;

procedure TForm1.drawPatterns(welches:integer);

var x,breite,hoehe: integer;

begin

LabAnzPat.Caption:='0-'+inttostr(myNet.myPatterns.Manz-1);

breite:=round(ImagePat.clientWidth/(myNet.myPatterns.ilen+myNet.myPatterns.olen));

ImagePat.clientWidth:=breite*(myNet.myPatterns.ilen+myNet.myPatterns.olen);

hoehe:=ImagePat.clientHeight;

for x:=0 to myNet.myPatterns.ilen-1 do begin

if (myNet.myPatterns.M[welches].input[x]<0.5) then ImagePat.Canvas.brush.color:=clwhite

else ImagePat.Canvas.brush.color:=clblack;

ImagePat.Canvas.FillRect(Rect(x*breite,0,(x+1)*breite-1,hoehe));

ImagePat.Canvas.Pen.color:=clblue;

ImagePat.Canvas.MoveTo(x*breite,0);

ImagePat.Canvas.LineTo(x*breite,ImagePat.clientHeight);

end;

for x:=0 to myNet.myPatterns.olen-1 do begin

if (myNet.myPatterns.M[welches].output[x]<0.5) then ImagePat.Canvas.brush.color:=clwhite

else ImagePat.Canvas.brush.color:=clblack;

ImagePat.Canvas.FillRect(Rect((myNet.myPatterns.ilen+x)*breite,0,(myNet.myPatterns.ilen+x+1)*breite-1,hoehe ));

ImagePat.Canvas.Pen.color:=clblue;

ImagePat.Canvas.MoveTo((myNet.myPatterns.ilen+x)*breite,0);

ImagePat.Canvas.LineTo((myNet.myPatterns.ilen+x)*breite,ImagePat.clientHeight);

end;

ImagePat.Canvas.Pen.color:=clred;

ImagePat.Canvas.MoveTo(myNet.myPatterns.ilen*breite,0);

ImagePat.Canvas.LineTo(myNet.myPatterns.ilen*breite,ImagePat.clientHeight);

end;

procedure TForm1.drawletter(welches: integer);

var x,y: integer;

begin

LabAnzLet.Caption:='0-'+inttostr(myNet.myLetters.Banz-1);

for x:=0 to 63 do begin

for y:=0 to 63 do begin

ImOCRLernZoom.Canvas.Pixels[x,y]:=round(myNet.myLetters.B[welches].input[y*64+x]*255);

end;

end;

end;

procedure TForm1.ButOpenClick(Sender: TObject);

var filename: string;

datei: file of double;

temp: double;

i,a,b,Mx,Ix,Ox: integer;

iar,oar: array of double;

tm: CMusterPaar;

begin

if OpenDialogPat.Execute then begin

filename:=OpenDialogPat.FileName;

AssignFile(datei,filename);

try

Reset(datei);

Read(datei,temp); Mx:=round(temp);

Read(datei,temp); Ix:=round(temp);

Read(datei,temp); Ox:=round(temp);

if ((Ix=(myNet.L[0].Nanz-1)) and ((Ox=(myNet.L[https://www.360docs.net/doc/1011567130.html,nz-1].Nanz-1)))) then begin myNet.myPatterns.Free;

myNet.myPatterns:=CMusterSatz.Create(Mx,Ix,Ox);

SetLength(iar,Ix); SetLength(oar,Ox);

for i:=0 to Mx-1 do begin

for a:=0 to Ix-1 do begin

Read(datei,temp); iar[a]:=temp;

end;

for b:=0 to Ox-1 do begin

Read(datei,temp); oar[b]:=temp;

end;

tm:=CMusterPaar.Create(Ix,Ox,iar,oar);

myNet.myPatterns.M[i]:=@tm;

tm.free;

end;

end

else begin {muster passt nicht zum Netz}

MessageBox(0,'Illegal Patternset! Creating a new one...', 'caption',1);

myNet.myPatterns.Free;

myNet.myPatterns:=CMustersatz.Create(1,myNet.L[0].Nanz-1,myNet.L[https://www.360docs.net/doc/1011567130.html,nz-1].Nanz-1);

end;

GrLern.Enabled:=true;

plainbuttons_freigeben();

finally

CloseFile(datei);

iar:=nil; oar:=nil;

end;

PatNr.Text:=inttostr(0);

drawPatterns(0);

end;

end;

procedure TForm1.ButSavNetClick(Sender: TObject);

var

datei: file of double;

temp: double;

a,vonl,y1,y2: integer;

begin

if SaveDialogNet.Execute then begin

try

AssignFile(datei,SaveDialogNet.Filename);

Rewrite(datei);

if (myNet.art='P') then temp:=0 else temp:=1; Write(datei,temp);

temp:=https://www.360docs.net/doc/1011567130.html,nz; Write(datei,temp);

for a:=0 to https://www.360docs.net/doc/1011567130.html,nz-1 do begin

temp:=myNet.L[a].Nanz; Write(datei,temp);

end;

for vonl:=0 to https://www.360docs.net/doc/1011567130.html,nz-2 do begin

for y1:=0 to myNet.L[vonl].Nanz-1 do begin

for y2:=1 to myNet.L[vonl+1].Nanz-1 do begin

temp:=myNet.w.w[vonl,y1,y2]; Write(datei,temp);

end;

end;

end;

finally

CloseFile(datei);

end;

end;

end;

procedure TForm1.Button10Click(Sender: TObject);

var

datei: file of double;

temp: double;

maxanz,a,vonl,y1,y2,Lx: integer;

LA: array of integer;

art: char;

begin

if OpenDialogNet.Execute then begin

GrNetSpec.Enabled:=false;

GrNetSpec.Visible:=false;

GrOCRLearn.Visible:=false; GrError.Visible:=true; GrOCRTest.Visible:=false;

GrSimpleLearn.Visible:=false; Image.Visible:=false;

ocrbuttons_sperren; plainbuttons_sperren;

AssignFile(datei,OpenDialogNet.FileName);

maxanz:=0;

try

Reset(datei);

Read(datei,temp); if (temp=0) then art:='P' else art:='O';

Read(datei,temp); Lx:=round(temp);

SetLength(LA,Lx);

for a:=0 to Lx-1 do begin

Read(datei,temp); LA[a]:=round(temp-1); // -1 , weil bias wird bei layer.create automatisch addiert

if LA[a]>maxanz then maxanz:=LA[a];

end;

myNet.Free;

myNet:=CNeuroNet.Create(Lx,LA,art);

myNet.w:=Cwmatrix.Create(Lx,maxanz+1); // +1 wegen bias

for vonl:=0 to Lx-2 do begin

for y1:=0 to LA[vonl] do begin

for y2:=1 to LA[vonl+1] do begin

Read(datei,temp); myNet.w.w[vonl,y1,y2]:=temp;

end;

end;

end;

drawnet();

GrLern.Enabled:=false;

ButSavNet.Enabled:=true;

ButReset.Enabled:=true;

if ( myNet.art='P') then begin

GrSimpleLearn.Visible:=true;

GrSimpleLearn.Enabled:=true;

Image.Visible:=true;

end

else if (myNet.art='O') then begin

GrOCRLearn.Visible:=true;

GrOCRLearn.Enabled:=true;

GrOCRTest.Visible:=true;

GrError.Visible:=true;

ClearI(ImOCRTestDraw);

ClearI(Imgezoomt);

clearI(ImZNeur);

end;

finally

CloseFile(datei);

ImagePat.clientWidth:=400;

LA:=nil;

end;

end;

end;

procedure TForm1.ButAddPatClick(Sender: TObject);

begin

myNet.myPatterns.addPat();

drawpatterns(PatNr.Value);

end;

procedure TForm1.ButPatternsSetNewClick(Sender: TObject);

begin

myNet.myPatterns.Free;

myNet.myLetters.Free;

plainbuttons_freigeben();

myNet.myPatterns:=CMustersatz.Create(1,myNet.L[0].Nanz-1,myNet.L[https://www.360docs.net/doc/1011567130.html,nz-1].Nanz-1);

GrLern.Enabled:=true;

PatNr.Value:=0;

drawpatterns(0);

end;

procedure TForm1.ImagePatMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

var dx: integer;

isoutput:boolean;

pm: PMusterPaar;

begin

isoutput:=false;

dx:=trunc(X /(ImagePat.clientWidth/(myNet.myPatterns.ilen+myNet.myPatterns.olen)));

if dx>=myNet.myPatterns.ilen then begin

isoutput:=true;

dec(dx,myNet.myPatterns.ilen);

end;

pm:=myNet.myPatterns.M[PatNr.Value];

if isoutput then begin

if (pm.output[dx]<0.5) then begin

pm.output[dx]:=1.0

end

else begin

pm.output[dx]:=0.0;

end

end

else begin

if (pm.input[dx]<0.5) then begin

pm.input[dx]:=1.0

end

else begin

pm.input[dx]:=0.0;

end;

end;

drawpatterns(PatNr.Value);

end;

procedure TForm1.PatNrChange(Sender: TObject);

begin

try

if (myNet.myPatterns.Manz>0) then begin

if (PatNr.Value<0) then PatNr.Value:=0

else if (PatNr.Value>=myNet.myPatterns.Manz) then PatNr.Value:=myNet.myPatterns.Manz-1;

drawPatterns(PatNr.Value);

end;

except

PatNr.Value:=0;

end;

end;

procedure TForm1.Button14Click(Sender: TObject);

begin

myNet.myPatterns.Free;

myNet.myLetters.Free;

myNet.myLetters:=CLetterSet.Create(1);

myNet.myPatterns:=CMusterSatz.Create(1,256,26);

LabAnzLet.Caption:='0-'+inttostr(myNet.myLetters.Banz-1);

GrLern.Enabled:=true;

LetNr.Value:=0;

drawletter(0);

ocrbuttons_freigeben();

end;

procedure TForm1.ButAddLetClick(Sender: TObject);

begin

myNet.myLetters.addLet();

myNet.myPatterns.addPat();

drawletter(LetNr.Value);

end;

procedure TForm1.LetNrChange(Sender: TObject);

var

nr: integer;

begin

ClearI(ImOCRLernDraw); ClearI(ImOCRLernNeur);

try

nr:=LetNr.Value;

except

nr:=0;

end;

if (myNet.myLetters.Banz>0) then begin

if (nr<0) then begin

nr:=0; LetNr.Value:=0

end

else if (nr>=myNet.myLetters.Banz) then begin

nr:=myNet.myLetters.Banz-1;

LetNr.Value:=nr;

end;

drawletter(nr);

sollchar.Text:=upcase(myNet.myLetters.B[nr].buchst);

end;

end;

procedure TForm1.ButOpeLetClick(Sender: TObject);

var datei: file of double;

temp,mittel: double;

Mx,Ix,i,a,dx,dy,x,y: integer;

iar,feld: array of double;

tL: CLetter;

sc: char;

begin

if OpenDialogOCR.Execute then begin

try

AssignFile(datei,OpenDialogOCR.FileName);

Reset(datei);

Read(datei,temp); Mx:=round(temp);

Ix:=4096;

myNet.myLetters.Free;

myNet.myPatterns.Free;

myNet.myLetters:=CLetterSet.Create(Mx);

myNet.myPatterns:=CMusterSatz.Create(Mx,225,26);

SetLength(feld,225);

SetLength(iar,4096);

for i:=0 to Mx-1 do begin

Read(datei,temp); sc:=chr(round(temp));

for a:=0 to Ix-1 do begin

Read(datei,temp); iar[a]:=temp;

end;

tL:=CLetter.Create(iar);

myNet.myLetters.B[i]:=@tL;

myNet.myLetters.B[i].buchst:=sc;

tL.free;

// in das muster f黵die neuronen eintragen

for dx:=0 to 14 do begin

for dy:=0 to 14 do begin

mittel:=0;

for x:=0 to 5 do begin

for y:=0 to 5 do begin

mittel:=mittel+myNet.myLetters.B[i].input[(2+dx*4+x)+(2+dy*4+y)*64];

end;

end;

mittel:=mittel/36;

feld[dy*15+dx]:=mittel;

end;

end;

for x:=0 to 224 do begin

myNet.myPatterns.M[i].input[x]:=feld[x];

end;

for dx:=0 to myNet.L[https://www.360docs.net/doc/1011567130.html,nz-1].Nanz-2 do begin

if (dx= (ord(myNet.myLetters.B[i].buchst)-ord('A'))

) then myNet.myPatterns.M[i].output[dx]:=1

else myNet.myPatterns.M[i].output[dx]:=0;

end;

end;

GrLern.Enabled:=true;

GrOCRTest.Visible:=true; GrError.Visible:=true;

ClearI(ImOCRTestDraw);

ClearI(Imgezoomt);

iar:=nil;

feld:=nil;

finally

Closefile(datei);

end;

ocrbuttons_freigeben();

LetNr.Text:=inttostr(0);

drawletter(0);

end;

end;

procedure TForm1.ButSavLetClick(Sender: TObject);

var datei: file of double;

i,a: integer;

temp:double;

begin

if SaveDialogOCR.Execute then begin

try

AssignFile(datei,SaveDialogOCR.FileName);

Rewrite(datei);

temp:=myNet.myLetters.Banz;

Write(datei,temp);

for i:=0 to myNet.myLetters.Banz-1 do begin

temp:=ord(myNet.myLetters.B[i].buchst); Write(datei,temp);

for a:=0 to 4095 do begin

temp:=myNet.myLetters.B[i].input[a];

Write(datei,temp);

end;

end;

finally

CloseFile(datei);

end;

end;

end;

procedure TForm1.ImOCRTestDrawMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

erkenne:=true;

ax:=x;

ay:=y;

with ImOCRTestDraw.Canvas.Pen do begin

color:=clRed;

width:=6;

end;

end;

procedure TForm1.ImOCRTestDrawMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

begin

if erkenne then begin

ImOCRTestDraw.Canvas.MoveTo(ax,ay);

ImOCRTestDraw.Canvas.LineTo(x,y);

ax:=x;

ay:=y;

end;

end;

procedure TForm1.ImOCRTestDrawMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

erkenne:=false;

end;

procedure TForm1.Button16Click(Sender: TObject);

var zumneur: array of double;

sx,sy,maxx,maxy,maxhb,minx,miny,maxh,maxb,dx,dy,x,y:integer;

mittel,altx,alty:double;

begin

maxx:=0; minx:=1000;

maxy:=0; miny:=1000;

SetLength(zumneur,225);

//=============================================================== { Grenzen im Paint-Image feststellen }

for sx:=0 to 63 do begin

for sy:=0 to 63 do begin

if (ImOCRTestDraw.Canvas.Pixels[sx,sy]=clRed) then begin

if sx < minx then minx:=sx; if sx > maxx then maxx:=sx;

if sy < miny then miny:=sy; if sy > maxy then maxy:=sy;

end;

end;

end;

{aspect-ratio beibehalten }

maxh:=maxy-miny; maxb:=maxx-minx;

if (maxh>maxb) then begin { breite < h鰄e -> maxx u minx anpassen }

maxhb:=maxh;

minx:=round( ((maxx-minx)/2+minx)-(1/2*(maxhb)));

maxx:=round( ((maxx-minx)/2+minx)+(1/2*(maxhb)));

end

else begin { h鰄e < breite -> maxy u miny anpassen }

maxhb:=maxb;

miny:=round( ((maxy-miny)/2+miny)-(1/2*(maxhb)));

maxy:=round( ((maxy-miny)/2+miny)+(1/2*(maxhb)));

end;

{ zoomen }

if ((maxy>miny) and (maxx>minx)) then begin

for dx:=0 to 63 do begin

for dy:=0 to 63 do begin

altx:=dx/64*(maxx-minx)+minx;

alty:=dy/64*(maxy-miny)+miny;

sx:=round(altx);

sy:=round(alty);

if ((sx<0) or (sx>63) or (sy<0) or (sy>63)) then

ImGezoomt.Canvas.Pixels[dx,dy]:=clWhite

else

Imgezoomt.Canvas.Pixels[dx,dy]:=ImOCRTestDraw.Canvas.Pixels[sx,sy];

end;

end;

end;

{ auf ein Muster 6*6-Patches die sich 黚erlappen interpolieren }

{ daher auf ein Feld von 10*10 (256 Neuronen) }

for dx:=0 to 14 do begin

for dy:=0 to 14 do begin

mittel:=0;

for x:=0 to 5 do begin

for y:=0 to 5 do begin

if Imgezoomt.Canvas.Pixels[2+dx*4+x,2+dy*4+y]=clRed then begin

mittel:=mittel+1;

end;

end;

end;

mittel:=mittel/36;

zumneur[dy*15+dx]:=mittel;

end;

end;

{ zeichnen und ans netz anlegen}

for dx:=0 to 14 do begin

for dy:=0 to 14 do begin

ImZNeur.Canvas.brush.color:=round(zumneur[dy*15+dx]*255);

ImZNeur.Canvas.fillrect(Rect(dx*5,dy*5,dx*5+4,dy*5+4));

myNet.L[0].N[dy*15+dx].activity:=zumneur[dy*15+dx];

end;

end;

myNet.calc_forward();

show_ocr_result();

zumneur:=nil;

end;

procedure TForm1.ButTestClearClick(Sender: TObject);

begin

clearI(ImOCRTestDraw);

clearI(Imgezoomt);

clearI(ImZNeur);

end;

procedure TForm1.Button17Click(Sender: TObject);

begin

Close;

end;

procedure TForm1.Button8Click(Sender: TObject);

var solle,noise: double;

begin

vorbereiten;

try

solle:=strtofloat(sollerror.Text);

except

solle:=0.01;

end;

noise:=getnoise();

myNet.lerne_bis(Application,solle,ErrorLabel,noise,ErrorImage);

Akt();

end;

procedure TForm1.RadioGroup1Click(Sender: TObject);

begin

if (RadioGroup1.ItemIndex=1) then begin

AnzGrid.Cells[1,1]:=floattostr(225);

AnzGrid.Cells[1,AnzGrid.RowCount-1]:=floattostr(26);

end;

end;

procedure TForm1.AusQuelleClick(Sender: TObject);

var

mittel:double;

zumneur: array of array of integer;

dx,dy,x,y: integer;

begin

clearI(ImOCRTestDraw);

for dx:=0 to 14 do begin

for dy:=0 to 14 do begin

mittel:=0;

for x:=0 to 5 do begin

for y:=0 to 5 do begin

if ImOCRLernZoom.Canvas.Pixels[2+dx*4+x,2+dy*4+y]=clRed then begin

mittel:=mittel+1;

end;

end;

end;

mittel:=mittel/36;

myNet.L[0].N[dy*15+dx].activity:=mittel;

end;