Usando TOCR y Transym Duda

deliriun · #1 28-04-2015

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

Código Delphi [-]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

Casimiro Notevi · #2 28-04-2015

Cita:

Empezado por deliriun

a mí me gustaría que se extraiga el texto directamente de un Image

deliriun · #3 28-04-2015

El programa convierte a Texto los caracteres de una imagen... Pero para sacar esos caracteres debemos indicar la direccion en la cual esta la imagen ejemplo.... C:/Imagenes/prueba.bmp

A mi me gustaría saber si el programa pueda extraer el texto directamente desde un. Image1.picture

alquimista · #4 05-05-2015

No seria más fácil guardar tu Image a un archivo temporal y usar la ruta de dicho archivo.
Y asi no tendras que cambiar mucho el código.

deliriun · #5 06-05-2015

Cita:

Empezado por alquimista

No seria más fácil guardar tu Image a un archivo temporal y usar la ruta de dicho archivo.
Y asi no tendras que cambiar mucho el código.

Pues sí pero los timer que uso me requieren que los haga directamente desde la image .. en el mismo form

zeeshan002 · #6 09-05-2015

No seria más fácil guardar tu Image a un archivo temporal y usar la ruta de dicho archivo.

__________________________
aliiii

Temas Similares
Tema	Autor	Foro	Respuestas	Último mensaje
c ++ usando for	luisito2011	C++ Builder	19	30-10-2011 00:20:05
conectarme usando el bde	federicorl	Conexión con bases de datos	2	06-06-2007 04:18:09
Usando INNER JOIN	alcides	SQL	9	07-03-2005 10:29:49
Duda Usando datapump interbase-paradox	gescoto99	Tablas planas	1	02-03-2004 21:27:59
BDE usando ODBC !!!	vpepen	Conexión con bases de datos	2	27-11-2003 13:27:57