Ver Mensaje Individual
  #1  
Antiguo 28-04-2015
deliriun deliriun is offline
Miembro
 
Registrado: ago 2014
Posts: 51
Reputación: 10
deliriun Va por buen camino
Question Usando TOCR y Transym Duda

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

Última edición por nlsgarcia fecha: 28-04-2015 a las 06:19:47. Razón: Formateo y Sintaxis Delphi
Responder Con Cita