deliriun
28-04-2015, 05:30:37
Muy bien las librerias mencionadas funcionan bien si hablamos de OCR pero el ejemplo que tienen en su pagina web.. para delphi el cual es el siguiente me da un problema... ya que solo permite cargar la imagen con su dirección en un Edit ... Pues a mí me gustaría que se extraiga el texto directamente de un Image y no sé como hacerlo si alguien me puede ayudar muchas gracias
El codigo es el siguiente
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
{ Private declarations }
OCRJobNr: LongInt;
Procedure AMsg(Value: String; DoAbort: Boolean= True);
Public
{ Public declarations }
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
// Initialize variables
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);
// Set error mode
If CheckBoxNoDLLErrMsg.Checked Then
FuncResult := OCRSetErrorMode(TOCRDefErrorMode, TOCRErrorMode_Silent)
Else
FuncResult:=OCRSetErrorMode(TOCRDefErrorMode, TOCRErrorMode_MsgBox);
If FuncResult<>TOCR_Ok Then
Else
Begin
// Initialize OCR engine
FuncResult:=OCRInitialise(OCRJobNr);
If FuncResult<>TOCR_Ok Then
Else
Try
AMsg('TOCRInitialise JobNr is '+IntToStr(OCRJobNr), False);
// Initialize job structure
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;
// Set options specified
// Rotation options
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;
// Unvantaed prcess options
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];
// Characters to ignore when comparing
For C:=0 To 255 Do
OCRJobInfo.ProcessOptions.DisableCharacter[C]:=CheckListBoxCharacters.Checked[C];
// Start job execution
FuncResult:=OCRDoJob(OCRJobNr, OCRJobInfo);
If FuncResult<>TOCR_Ok Then
Else
Begin
Application.ProcessMessages;
AMsg('TOCRDoJob went Ok!', False);
// Wait for the job to finish
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);
// Get the required size of the job
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
// Make sure that at least the header is filled !
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);
//GetMem(OCRResults, OCRJobResultsInf+1);
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);
// Check to see if the average confiedence is lower than wanted
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
//FreeMem(OCRResults);
AMsg('Allocated memory released', False);
End;
End;
End;
End;
Finally
// Shut down the OCR engine
FuncResult:=OCRShutdown(OCRJobNr); // This will shut down the applied job
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.
Gracias por leer todo
El codigo es el siguiente
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
{ Private declarations }
OCRJobNr: LongInt;
Procedure AMsg(Value: String; DoAbort: Boolean= True);
Public
{ Public declarations }
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
// Initialize variables
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);
// Set error mode
If CheckBoxNoDLLErrMsg.Checked Then
FuncResult := OCRSetErrorMode(TOCRDefErrorMode, TOCRErrorMode_Silent)
Else
FuncResult:=OCRSetErrorMode(TOCRDefErrorMode, TOCRErrorMode_MsgBox);
If FuncResult<>TOCR_Ok Then
Else
Begin
// Initialize OCR engine
FuncResult:=OCRInitialise(OCRJobNr);
If FuncResult<>TOCR_Ok Then
Else
Try
AMsg('TOCRInitialise JobNr is '+IntToStr(OCRJobNr), False);
// Initialize job structure
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;
// Set options specified
// Rotation options
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;
// Unvantaed prcess options
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];
// Characters to ignore when comparing
For C:=0 To 255 Do
OCRJobInfo.ProcessOptions.DisableCharacter[C]:=CheckListBoxCharacters.Checked[C];
// Start job execution
FuncResult:=OCRDoJob(OCRJobNr, OCRJobInfo);
If FuncResult<>TOCR_Ok Then
Else
Begin
Application.ProcessMessages;
AMsg('TOCRDoJob went Ok!', False);
// Wait for the job to finish
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);
// Get the required size of the job
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
// Make sure that at least the header is filled !
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);
//GetMem(OCRResults, OCRJobResultsInf+1);
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);
// Check to see if the average confiedence is lower than wanted
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
//FreeMem(OCRResults);
AMsg('Allocated memory released', False);
End;
End;
End;
End;
Finally
// Shut down the OCR engine
FuncResult:=OCRShutdown(OCRJobNr); // This will shut down the applied job
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.
Gracias por leer todo