Unit TOCRMain;
Interface
Uses
Windows, StdCtrls, SysUtils, Forms, Dialogs, Controls, CheckLst, ExtCtrls, Classes, TOCRDLLDYN,
Buttons;
Type
TFrmTOCRMain = Class(TForm)
Label3: TLabel;
EditFileName: TEdit;
MemoStatus: TMemo;
Label4: TLabel;
ButtonExecuteConvertion: TButton;
RadioGroupRotation: TRadioGroup;
Label1: TLabel;
CheckListBoxOptions: TCheckListBox;
CheckListBoxCharacters: TCheckListBox;
Label2: TLabel;
MemoResult: TMemo;
Label5: TLabel;
ButtonOptionsAll: TButton;
ButtonOptionsNone: TButton;
ButtonOptionsInvert: TButton;
ButtonAll: TButton;
ButtonNone: TButton;
ButtonInvert: TButton;
DlgOpen: TOpenDialog;
ButtonSelectFile: TButton;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
EditAvgConfidence: TEdit;
EditChrConfidence: TEdit;
CheckBoxNoDLLErrMsg: TCheckBox;
Timer1: TTimer;
Button1: TButton;
SpeedButton1: TSpeedButton;
Procedure FormCreate(Sender: TObject);
Procedure EditFileNameKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState);
Procedure ButtonOptionsAllClick(Sender: TObject);
Procedure ButtonOptionsNoneClick(Sender: TObject);
Procedure ButtonOptionsInvertClick(Sender: TObject);
Procedure ButtonAllClick(Sender: TObject);
Procedure ButtonNoneClick(Sender: TObject);
Procedure ButtonInvertClick(Sender: TObject);
Procedure ButtonSelectFileClick(Sender: TObject);
Procedure EditAvgConfidenceChange(Sender: TObject);
Procedure EditChrConfidenceChange(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Timer1Timer(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
Private
OCRJobNr: LongInt;
Procedure AMsg(Value: String; DoAbort: Boolean= True);
Public
End;
Var
FrmTOCRMain: TFrmTOCRMain;
Implementation
{$R *.dfm}
Uses
DateUtils, Unit1, Unit2;
procedure TFrmTOCRMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
OCRUnloadLibraries;
end;
Procedure TFrmTOCRMain.FormCreate(Sender: TObject);
Var
C: Integer;
Begin
if not OCRLoadLibraries then begin
ShowMessage('Could not Load OCR Engine');
Application.Terminate;
end;
OCRJobNr:=0;
CheckListBoxCharacters.Items.Add('000 $FF W');
For C:=0 To 255 Do
Case C Of
00..09: CheckListBoxCharacters.Items.Add('00'+IntToStr(C)+' $'+IntToHex(C, 2)+' ');
10..31: CheckListBoxCharacters.Items.Add( '0'+IntToStr(C)+' $'+IntToHex(C, 2)+' ');
32..99: CheckListBoxCharacters.Items.Add( '0'+IntToStr(C)+' $'+IntToHex(C, 2)+' '+Chr(C));
Else CheckListBoxCharacters.Items.Add( IntToStr(C)+' $'+IntToHex(C, 2)+' '+Chr(C));
End;
CheckListBoxCharacters.Items.Delete(0);
CheckListBoxCharacters.Columns:=3;
EditFileName.Text:=ExtractFilePath(Application.ExeName)+'Data\'+ExtractFileName(EditFileName.Text);
End;
Procedure TFrmTOCRMain.EditFileNameKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState);
Begin
If (Key=vk_Return) And (Shift=[ssCtrl]) Then
Begin
Key:=0;
ButtonSelectFile.Click;
End;
End;
Procedure TFrmTOCRMain.ButtonOptionsAllClick(Sender: TObject);
Var
C: Integer;
Begin
For C:=0 To CheckListBoxOptions.Items.Count-1 Do
CheckListBoxOptions.Checked[C]:=True;
End;
Procedure TFrmTOCRMain.ButtonOptionsNoneClick(Sender: TObject);
Var
C: Integer;
Begin
For C:=0 To CheckListBoxOptions.Items.Count-1 Do
CheckListBoxOptions.Checked[C]:=False;
End;
Procedure TFrmTOCRMain.ButtonOptionsInvertClick(Sender: TObject);
Var
C: Integer;
Begin
For C:=0 To CheckListBoxOptions.Items.Count-1 Do
CheckListBoxOptions.Checked[C]:=Not CheckListBoxOptions.Checked[C];
End;
Procedure TFrmTOCRMain.ButtonAllClick(Sender: TObject);
Var
C: Integer;
Begin
For C:=0 To CheckListBoxCharacters.Items.Count-1 Do
CheckListBoxCharacters.Checked[C]:=True;
End;
procedure TFrmTOCRMain.Timer1Timer(Sender: TObject);
Var
DateTimeStart, DateTimeEnd: TDateTime;
FuncResult: LongInt;
OCRJobInfo: TTOCRJobInfo;
OCRJobStatus: Integer;
OCRJobResultsInf: Integer;
C: Integer;
S: String;
A: Array[0..255] Of AnsiChar;
ConfidenceAvg: Single;
ConfidenceChars: Single;
OCRResultsHeader: TTOCRResultsHeader;
OCRResultItems: Array Of TTOCRResultsItem;
OCRResults: T_ByteArray;
Begin
timer1.Enabled:= False;
Form2.Timer1.Enabled := true;
DateTimeStart:=Now;
If FileExists(EditFileName.text) Then
Try
Screen.Cursor:=crHourGlass;
If (ExtractFileExt(UpperCase(EditFileName.text))='.TIF') Or (ExtractFileExt(UpperCase(EditFileName.text))='.BMP') Then
Try
MemoStatus.Clear;
AMsg(FormatDateTime('"Start time:" yy-mm-dd hh:nn:ss:zzz', DateTimeStart), False);
MemoResult.Clear;
OCRJobResultsInf:=0;
OCRJobStatus:=TOCRJobStatus_Busy;
FillChar(OCRJobInfo, SizeOf(TTOCRJobInfo), 0);
FillChar(OCRResultsHeader, SizeOf(TTOCRResultsHeader), 0);
FillChar(A, SizeOf(A), 0);
StrPCopy(A, EditFileName.Text+#0);
If StrToIntDef(EditAvgConfidence.Text, -1)=-1 Then
EditAvgConfidence.Text:='0000000001';
If StrToIntDef(EditChrConfidence.Text, -1)=-1 Then
EditChrConfidence.Text:='0000000001';
ConfidenceAvg:=StrToFloat('0'+DecimalSeparator+EditAvgConfidence.Text);
ConfidenceChars:=StrToFloat('0'+DecimalSeparator+EditChrConfidence.Text);
AMsg('Variable initialization Ok!', False);
AMsg('File: '+EditFileName.text, False);
If CheckBoxNoDLLErrMsg.Checked Then
FuncResult := OCRSetErrorMode(TOCRDefErrorMode, TOCRErrorMode_Silent)
Else
FuncResult:=OCRSetErrorMode(TOCRDefErrorMode, TOCRErrorMode_MsgBox);
If FuncResult<>TOCR_Ok Then
Else
Begin
FuncResult:=OCRInitialise(OCRJobNr);
If FuncResult<>TOCR_Ok Then
Else
Try
AMsg('TOCRInitialise JobNr is '+IntToStr(OCRJobNr), False);
If ExtractFileExt(UpperCase(EditFileName.text))='.TIF' Then
OCRJobInfo.JobType := TOCRJobType_TiffFile
Else
If ExtractFileExt(UpperCase(EditFileName.text))='.BMP' Then
OCRJobInfo.JobType :=TOCRJobType_DibFile;
OCRJobInfo.InputFile :=A;
OCRJobInfo.PageNo :=0;
Case RadioGroupRotation.ItemIndex Of
1: OCRJobInfo.ProcessOptions.Orientation:=TOCRJobOrient_Auto;
2: OCRJobInfo.ProcessOptions.Orientation:=TOCRJobOrient_90 ;
3: OCRJobInfo.ProcessOptions.Orientation:=TOCRJobOrient_180 ;
4: OCRJobInfo.ProcessOptions.Orientation:=TOCRJobOrient_270 ;
Else OCRJobInfo.ProcessOptions.Orientation:=TOCRJobOrient_Off ;
End;
OCRJobInfo.ProcessOptions.InvertWholePage :=CheckListBoxOptions.Checked[ 0];
OCRJobInfo.ProcessOptions.DeskewOff :=CheckListBoxOptions.Checked[ 1];
OCRJobInfo.ProcessOptions.NoiseRemoveOff :=CheckListBoxOptions.Checked[ 2];
OCRJobInfo.ProcessOptions.LineRemoveOff :=CheckListBoxOptions.Checked[ 3];
OCRJobInfo.ProcessOptions.DeshadeOff :=CheckListBoxOptions.Checked[ 4];
OCRJobInfo.ProcessOptions.InvertOff :=CheckListBoxOptions.Checked[ 5];
OCRJobInfo.ProcessOptions.SectioningOn :=CheckListBoxOptions.Checked[ 6];
OCRJobInfo.ProcessOptions.MergeBreakOff :=CheckListBoxOptions.Checked[ 7];
OCRJobInfo.ProcessOptions.LineRejectOff :=CheckListBoxOptions.Checked[ 8];
OCRJobInfo.ProcessOptions.CharacterRejectOff:=CheckListBoxOptions.Checked[ 9];
OCRJobInfo.ProcessOptions.LexOff :=CheckListBoxOptions.Checked[10];
For C:=0 To 255 Do
OCRJobInfo.ProcessOptions.DisableCharacter[C]:=CheckListBoxCharacters.Checked[C];
FuncResult:=OCRDoJob(OCRJobNr, OCRJobInfo);
If FuncResult<>TOCR_Ok Then
Else
Begin
Application.ProcessMessages;
AMsg('TOCRDoJob went Ok!', False);
FuncResult:=OCRWaitForJob(OCRJobNr, OCRJobStatus);
If FuncResult<>TOCR_Ok Then
Else
If (OCRJobStatus <> TOCRJobStatus_Done) Then
AMsg('Waiting for job OK, but the status was wrong : '+IntToStr(OCRJobStatus))
Else
Begin
Application.ProcessMessages;
AMsg('TOCRWaitForJob JobStatus '+IntToStr(OCRJobStatus), False);
FuncResult:=OCRGetJobResults(OCRJobNr, OCRJobResultsInf, Nil);
If FuncResult<>TOCR_Ok Then
Else
If OCRJobResultsInf=TOCRGetResults_NoResults Then
AMsg('No result available in the specified job: '+IntToStr(OCRJobNr))
Else
If OCRJobResultsInf < SizeOf(TTOCRResultsHeader) Then
AMsg('The size of the job result was less than expected: '+IntToStr(OCRJobResultsInf)+'('+IntToStr(SizeOf(TTOCRResultsHeader))+')')
Else
Begin
Application.ProcessMessages;
AMsg('TOCRGetJobResults Structuresize '+IntToStr(OCRJobResultsInf), False);
SetLength(OCRResults, OCRJobResultsInf+1);
Try
AMsg('Memory allocated '+IntToStr(OCRJobResultsInf+1), False);
FuncResult:=OCRGetJobResults(OCRJobNr, OCRJobResultsInf, @OCRResults[0]);
If FuncResult<>TOCR_Ok Then
Else
If OCRJobResultsInf=TOCRGetResults_NoResults Then
AMsg('No result available in the specified job: '+IntToStr(OCRJobNr), False)
Else
If (OCRResults=Nil) Or (Integer(OCRResults)=0) Then
Else
Begin
Application.ProcessMessages;
AMsg('TOCRGetJobResults Ok! ', False);
Move(OCRResults[0], OCRResultsHeader, SizeOf(TTOCRResultsHeader));
AMsg('Result copied into TTOCRResultsHeader structure', False);
AMsg(' StructId'#9#9 +IntToStr(OCRResultsHeader.StructId ), False);
AMsg(' XPixelsPerInch'#9+IntToStr(OCRResultsHeader.XPixelsPerInch), False);
AMsg(' YPixelsPerInch'#9+IntToStr(OCRResultsHeader.YPixelsPerInch), False);
AMsg(' NumItems'#9 +IntToStr(OCRResultsHeader.NumItems ), False);
AMsg(' MeanConfidence'#9+FloatToStr(OCRResultsHeader.MeanConfidence), False);
If OCRResultsHeader.MeanConfidence < ConfidenceAvg Then
AMsg('Average confidence lower than specified, skipping result.', False)
Else
Begin
SetLength(OCRResultItems, OCRResultsHeader.NumItems);
Move(OCRResults[SizeOf(TTOCRResultsHeader)], OCRResultItems[0], SizeOf(TTOCRResultsItem)*OCRResultsHeader.NumItems);
AMsg('Result copied into TTOCRResultsItem x structures', False);
S:='';
For C:=0 To OCRResultsHeader.NumItems-1 Do
If (OCRResultItems[C].Confidence+OCRResultItems[C].XPos+OCRResultItems[C].YPos+OCRResultItems[C].XDim+OCRResultItems[C].YDim=0)
Or (OCRResultItems[C].Confidence > ConfidenceChars) Then
Begin
S:=S+Chr(OCRResultItems[C].OCRCha);
If OCRResultItems[C].OCRCha=13 Then
S:=S+#10;
AMsg(' ItemNr'#9 +IntToStr (C) , False);
AMsg(' StructId'#9#9+IntToStr (OCRResultItems[C].StructId ), False);
AMsg(' OCRCha'#9 +IntToStr (OCRResultItems[C].OCRCha ), False);
AMsg(' Confidence'#9+FloatToStr(OCRResultItems[C].Confidence), False);
AMsg(' XPos'#9#9 +IntToStr (OCRResultItems[C].XPos ), False);
AMsg(' YPos'#9#9 +IntToStr (OCRResultItems[C].YPos ), False);
AMsg(' XDim'#9#9 +IntToStr (OCRResultItems[C].XDim ), False);
AMsg(' YDim'#9#9 +IntToStr (OCRResultItems[C].YDim ), False);
End;
MemoResult.Lines.Add(S);
End;
End;
Finally
AMsg('Allocated memory released', False);
End;
End;
End;
End;
Finally
FuncResult:=OCRShutdown(OCRJobNr); If FuncResult<>TOCR_Ok Then
Else
AMsg('TOCRShutdown Ok!', False);
End;
End;
Finally
End;
Finally
DateTimeEnd:=Now;
AMsg(FormatDateTime('"End time:" yy-mm-dd hh:nn:ss:zzz', DateTimeEnd), False);
AMsg(FormatDateTime('"Time elapsed:" hh:nn:ss:zzz', DateTimeEnd-DateTimeStart), False);
MemoStatus.Lines.SaveToFile(ExtractFilePath(Application.ExeName)+'LastConvStat.txt');
MemoResult.Lines.SaveToFile(ExtractFilePath(Application.ExeName)+'LastConvRes.txt');
Screen.Cursor:=crDefault;
End;
end;
Procedure TFrmTOCRMain.ButtonNoneClick(Sender: TObject);
Var
C: Integer;
Begin
For C:=0 To CheckListBoxCharacters.Items.Count-1 Do
CheckListBoxCharacters.Checked[C]:=False;
End;
Procedure TFrmTOCRMain.ButtonInvertClick(Sender: TObject);
Var
C: Integer;
Begin
For C:=0 To CheckListBoxCharacters.Items.Count-1 Do
CheckListBoxCharacters.Checked[C]:=Not CheckListBoxCharacters.Checked[C];
End;
Procedure TFrmTOCRMain.ButtonSelectFileClick(Sender: TObject);
Begin
If (EditFileName.Text<>'') And FileExists(EditFileName.Text) Then
Begin
DlgOpen.FileName:=EditFileName.Text;
DlgOpen.InitialDir:=ExtractFilePath(EditFileName.Text);
End
Else
Begin
DlgOpen.FileName:='';
DlgOpen.InitialDir:=ExtractFilePath(Application.ExeName)+'Data\';
End;
If DlgOpen.Execute Then
EditFileName.Text:=DlgOpen.FileName;
End;
Procedure TFrmTOCRMain.AMsg(Value: String; DoAbort: Boolean= True);
Begin
If Value<>'' Then
Begin
MemoStatus.Lines.Add(Value);
If DoAbort Then
Begin
MessageDlg(Value, mtError, [mbOk], 0);
Abort;
End;
End;
End;
Procedure TFrmTOCRMain.EditAvgConfidenceChange(Sender: TObject);
Var
C: Integer;
S: String;
Begin
If EditAvgConfidence.Text<>'' Then
Begin
S:=EditAvgConfidence.Text;
For C:=Length(S) DownTo 1 Do
If Not (S[C] In ['0'..'9']) Then
Delete(S, C, 1);
If EditAvgConfidence.Text<>S Then
EditAvgConfidence.Text:=S;
End;
End;
Procedure TFrmTOCRMain.EditChrConfidenceChange(Sender: TObject);
Var
C: Integer;
S: String;
Begin
If EditChrConfidence.Text<>'' Then
Begin
S:=EditChrConfidence.Text;
For C:=Length(S) DownTo 1 Do
If Not (S[C] In ['0'..'9']) Then
Delete(S, C, 1);
If EditChrConfidence.Text<>S Then
EditChrConfidence.Text:=S;
End;
End;
procedure TFrmTOCRMain.Button1Click(Sender: TObject);
begin
form1.Show;
end;
procedure TFrmTOCRMain.SpeedButton1Click(Sender: TObject);
begin
FrmTOCRMain.Hide;
end;
End.
end.