home *** CD-ROM | disk | FTP | other *** search
/ Mastering Visual Basic 6 / mastvb6.iso / leadtools / ocx32.lt / Ocrmain.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-07-02  |  26.7 KB  |  867 lines
  1. unit OCRMain;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   Menus, LTOCROCX, OleCtrls, LEAD, LEADDEF, LTDLGOCX, LEADOCR, ZONE,
  8.   LEADDlg;
  9.  
  10. type
  11.   TForm1 = class(TForm)
  12.     DPCommDlg: TSaveDialog;
  13.     MainMenu1: TMainMenu;
  14.     File1: TMenuItem;
  15.     Open1: TMenuItem;
  16.     SaveAs1: TMenuItem;
  17.     Exit1: TMenuItem;
  18.     View1: TMenuItem;
  19.     Normal1: TMenuItem;
  20.     FittoWindow1: TMenuItem;
  21.     OCR1: TMenuItem;
  22.     Recognize1: TMenuItem;
  23.     EditDocument1: TMenuItem;
  24.     SetZone1: TMenuItem;
  25.     ClearDocument1: TMenuItem;
  26.     Preferences1: TMenuItem;
  27.     Preprocessing1: TMenuItem;
  28.     None1: TMenuItem;
  29.     Auto1: TMenuItem;
  30.     AlterManuallyGeneratedZones1: TMenuItem;
  31.     RecognitionMode1: TMenuItem;
  32.     Standard1: TMenuItem;
  33.     Degraded1: TMenuItem;
  34.     VerifierMode1: TMenuItem;
  35.     Word1: TMenuItem;
  36.     Character1: TMenuItem;
  37.     VerifierThreshold1: TMenuItem;
  38.     ProcessHeadersandFooters1: TMenuItem;
  39.     Training1: TMenuItem;
  40.     Language1: TMenuItem;
  41.     English1: TMenuItem;
  42.     German1: TMenuItem;
  43.     French1: TMenuItem;
  44.     Spanish1: TMenuItem;
  45.     Italian1: TMenuItem;
  46.     Dutch1: TMenuItem;
  47.     Swedish1: TMenuItem;
  48.     Norwegian1: TMenuItem;
  49.     Finnish1: TMenuItem;
  50.     Danish1: TMenuItem;
  51.     Portuguese1: TMenuItem;
  52.     Russian1: TMenuItem;
  53.     MinPointSize1: TMenuItem;
  54.     MaxPointSize1: TMenuItem;
  55.     N1: TMenuItem;
  56.     DocumentInfo1: TMenuItem;
  57.     PageInfo1: TMenuItem;
  58.     ZoneInfo1: TMenuItem;
  59.     AutowithAutoZones1: TMenuItem;
  60.     About1: TMenuItem;
  61.     LTOCR: TLeadOcrCtrl;
  62.     LTCommDlg: TLeadDlgCtrl;
  63.     LEAD1: TLeadCtrl;
  64.     procedure Exit1Click(Sender: TObject);
  65.     procedure Normal1Click(Sender: TObject);
  66.     procedure FittoWindow1Click(Sender: TObject);
  67.     procedure Open1Click(Sender: TObject);
  68.     procedure SaveAs1Click(Sender: TObject);
  69.     procedure FormCreate(Sender: TObject);
  70.     procedure ClearDocument1Click(Sender: TObject);
  71.     procedure File1Click(Sender: TObject);
  72.     procedure View1Click(Sender: TObject);
  73.     procedure EditDocument1Click(Sender: TObject);
  74.     procedure SetZone1Click(Sender: TObject);
  75.     procedure Recognize1Click(Sender: TObject);
  76.     procedure OCR1Click(Sender: TObject);
  77.     procedure English1Click(Sender: TObject);
  78.     procedure German1Click(Sender: TObject);
  79.     procedure French1Click(Sender: TObject);
  80.     procedure Spanish1Click(Sender: TObject);
  81.     procedure Italian1Click(Sender: TObject);
  82.     procedure Dutch1Click(Sender: TObject);
  83.     procedure Swedish1Click(Sender: TObject);
  84.     procedure Norwegian1Click(Sender: TObject);
  85.     procedure Finnish1Click(Sender: TObject);
  86.     procedure Danish1Click(Sender: TObject);
  87.     procedure Portuguese1Click(Sender: TObject);
  88.     procedure Russian1Click(Sender: TObject);
  89.     procedure None1Click(Sender: TObject);
  90.     procedure Auto1Click(Sender: TObject);
  91.     procedure AlterManuallyGeneratedZones1Click(Sender: TObject);
  92.     procedure Standard1Click(Sender: TObject);
  93.     procedure Degraded1Click(Sender: TObject);
  94.     procedure Word1Click(Sender: TObject);
  95.     procedure Character1Click(Sender: TObject);
  96.     procedure ProcessHeadersandFooters1Click(Sender: TObject);
  97.     procedure Training1Click(Sender: TObject);
  98.     procedure VerifierThreshold1Click(Sender: TObject);
  99.     procedure MinPointSize1Click(Sender: TObject);
  100.     procedure MaxPointSize1Click(Sender: TObject);
  101.     procedure Lead1MouseDown(Sender: TObject; Button: TMouseButton;
  102.       Shift: TShiftState; X, Y: Integer);
  103.     procedure Lead1RubberBand(Sender: TObject);
  104.     procedure DocumentInfo1Click(Sender: TObject);
  105.     procedure PageInfo1Click(Sender: TObject);
  106.     procedure ZoneInfo1Click(Sender: TObject);
  107.     procedure AutowithAutoZones1Click(Sender: TObject);
  108.     procedure About1Click(Sender: TObject);
  109.     procedure LTOcrRecognizeEvent(Sender: TObject; hBitmap: Integer;
  110.       const pszText, pszMask: string; nStatus, nPercent, nWordLeft,
  111.       nWordTop, nWordWidth, nWordHeight, nGroupLeft, nGroupTop,
  112.       nGroupWidth, nGroupHeight: Smallint);
  113.   private
  114.     { Private declarations }
  115.  
  116.   public
  117.     { Public declarations }
  118.     gbDoc: boolean;
  119.     gbSetZone : boolean;
  120.     gnStacking : integer;
  121.     gnZoneIndex : integer;
  122.   end;
  123.  
  124. var
  125.   Form1: TForm1;
  126.  
  127. implementation
  128.  
  129. uses lexicon, About;
  130.  
  131. {$R *.DFM}
  132.  
  133. procedure TForm1.Exit1Click(Sender: TObject);
  134. begin
  135.    if gbDoc = True then
  136.       LTOCR.ClearDoc();
  137.    Close;
  138. end;
  139.  
  140. procedure TForm1.Normal1Click(Sender: TObject);
  141. begin
  142.     Normal1.checked := true;
  143.     FittoWindow1.checked := false;
  144.     Lead1.PaintSizeMode := PAINTSIZEMODE_NORMAL;
  145.     Lead1.ForceRepaint();
  146. end;
  147.  
  148. procedure TForm1.FittoWindow1Click(Sender: TObject);
  149. begin
  150.     FittoWindow1.checked := true;
  151.     Normal1.checked := false;
  152.     Lead1.PaintSizeMode := PAINTSIZEMODE_FIT;
  153.     Lead1.ForceRepaint();
  154. end;
  155.  
  156. procedure TForm1.Open1Click(Sender: TObject);
  157. var
  158.    nRet : integer;
  159. begin
  160.     LTCommDlg.EnableMethodErrors := false;
  161.     LTCommDlg.FileDlgFlags := 0;
  162.     LTCommDlg.DialogTitle := 'Pick a Document Image to OCR';
  163.     LTCommDlg.Filter := 'All |*.*|TIFF|*.tif;*.tiff';
  164.  
  165.     LTCommDlg.Bitmap := 0; {free any existing bitmap reference}
  166.     LTCommDlg.UIFlags := DLG_FO_AUTOPROCESS + DLG_FO_95STYLE + DLG_FO_MULTIPAGE + DLG_FO_FILEINFO + DLG_FO_SHOWSTAMP + DLG_FO_SHOWPREVIEW;
  167.     nRet := LTCommDlg.FileOpen(handle);
  168.  
  169.     If (nRet = 0) Then
  170.     begin
  171.         Lead1.Bitmap := LTCommDlg.Bitmap;{copy the image to LEAD1}
  172.         FittoWindow1Click(Self);
  173.         LTCommDlg.Bitmap := 0; {release the reference}
  174.  
  175.         Ltocr.DocumentName := LTCommDlg.filename;
  176.         If Training1.Checked = True Then
  177.             Ltocr.Training := LTCommDlg.filename + '.train'
  178.         Else
  179.             Ltocr.Training := '';
  180.     end
  181.     Else
  182.     begin
  183.         if (nRet <> ERROR_DLG_CANCELED) then
  184.            MessageDlg('Error: ' + IntToStr(nRet) + ' loading image ' + LTCommDlg.filename + '!', mtError,
  185.                       [mbOk], 0);
  186.     end;
  187. end;
  188.  
  189. procedure TForm1.SaveAs1Click(Sender: TObject);
  190. var
  191.    lRet : longint;
  192.    nFormat : integer;
  193.    savefilter : string;
  194. begin
  195.     savefilter := 'Ami Pro 2.0|*.ami|Ami Pro 3.0|*.ami';
  196.     savefilter := savefilter + '|' + 'ASCII Smart|*.txt|ASCII Standard|*.txt|ASCII Standard (DOS)|*.txt|ASCII Stripped|*.txt';
  197.     savefilter := savefilter + '|' + 'dBase IV v1.0|*.dbf';
  198.     savefilter := savefilter + '|' + 'DCA/RTF|*.rtf';
  199.     savefilter := savefilter + '|' + 'DisplayWrite 5|*.dw5';
  200.     savefilter := savefilter + '|' + 'Excel (Macintosh)|*.xls|Excel 3.0|*.xls|Excel 40|*.xls|Excel 5.0|*.xls|Excel Office 97|*.xls';
  201.     savefilter := savefilter + '|' + 'FrameMaker|*.doc';
  202.     savefilter := savefilter + '|' + 'HTML (2.0 spec)|*.htm|HTML (SoftQuad)|*.htm|HTML (Netscape additions)|*.htm';
  203.     savefilter := savefilter + '|' + 'Interleaf|*.doc';
  204.     savefilter := savefilter + '|' + 'Lotus 1-2-3|*.123';
  205.     savefilter := savefilter + '|' + 'Lotus Word Pro|*.lwp';
  206.     savefilter := savefilter + '|' + 'MultiMate Advantage II|*.mma';
  207.     savefilter := savefilter + '|' + 'Postscript|*.eps';
  208.     savefilter := savefilter + '|' + 'Professional Write 2.0|*.doc|Professional Write 2.2|*.doc';
  209.     savefilter := savefilter + '|' + 'Quattro Pro|*.pro';
  210.     savefilter := savefilter + '|' + 'Rich Text|*.rtf|Rich Text (Macintosh)|*.rtf|Rich Text (Word 6.0)|*.rtf';
  211.     savefilter := savefilter + '|' + 'Windows Write|*.wri';
  212.     savefilter := savefilter + '|' + 'Word for Windows 2.x|*.doc|Word for Windows 6.0|*.doc|Word Office 97|*.doc';
  213.     savefilter := savefilter + '|' + 'WordPerfect 4.2 (DOS)|*.doc|WordPerfect (Windows)|*.doc|WordPerfect 6.0 (Windows)|*.doc';
  214.     savefilter := savefilter + '|' + 'WordPerfect 6.1 (Windows)|*.doc|WordPerfect 7.x (Windows)|*.doc';
  215.     savefilter := savefilter + '|' + 'WordStar 1.x|*.doc';
  216.     savefilter := savefilter + '|' + 'Works|*.doc';
  217.     savefilter := savefilter + '|' + 'Xerox XDOC|*.xdc';
  218.  
  219.     DPCommDlg.Filter := savefilter;
  220.     If(DPCommDlg.Execute() = True) then
  221.     begin
  222.         nFormat := FILE_AMI_PRO_20 + DPCommDlg.FilterIndex - 1;
  223.         lRet := Ltocr.SaveDoc(DPCommDlg.filename, nFormat);
  224.         If lRet <> 0 Then
  225.            MessageDlg('Error: ' + IntToStr(lRet) + ' saving document!', mtError, [mbOk], 0);
  226.     end;
  227. end;
  228.  
  229. procedure TForm1.FormCreate(Sender: TObject);
  230. begin
  231.     Lead1.UnlockSupport(L_SUPPORT_EXPRESS, L_KEY_EXPRESS);
  232.     LTOcr.UnlockSupport(L_SUPPORT_EXPRESS, L_KEY_EXPRESS);
  233.     LTOcr.UnlockSupport(L_SUPPORT_OCR, L_KEY_OCR);
  234.  
  235.     Lead1.BitonalScaling := BITONALSCALING_SCALETOGRAY;
  236.     LTOcr.Visible:=False;
  237.     gbDoc := False;
  238.     gbSetZone := False;
  239.     gnStacking := 1;
  240.     gnZoneIndex := 1;
  241.  
  242.     Normal1.Checked := True;
  243.     FittoWindow1.Checked := False;
  244.  
  245.     Auto1.Checked := True;
  246.     Ltocr.PreprocessingMode := OCRPP_ORIENTATION + OCRPP_TEXT_ORIENTATION + OCRPP_SKEW + OCRPP_AUTO_FAX;
  247.     Standard1.Checked := True;
  248.     Ltocr.VerifierMode := OCRVER_WORD;
  249.     Ltocr.VerifierThreshold := 750;
  250.     Word1.Checked := True;
  251.     Ltocr.SloppyManual := True;
  252.  
  253.     {set minpointsize and maxpointsize}
  254.     Ltocr.MinPointSize := 8;
  255.     Ltocr.MaxPointSize := 72;
  256.  
  257.     {set preprocessor text orientation limit to 500 words}
  258.     Ltocr.TextOrientLimit := 500;
  259.  
  260.     {set the language specific properties}
  261.     Ltocr.Questionable := '';      {the default}
  262.     Ltocr.Unrecognized := '~';     {the default}
  263.     Ltocr.LeftSingleQuote := Chr(39);  {the default, "'"}
  264.     Ltocr.RightSingleQuote := Chr(39); {the default, "'"}
  265.     Ltocr.LeftDoubleQuote := Chr(34);  {the default, """}
  266.     Ltocr.RightDoubleQuote := Chr(34); {the default, """}
  267.  
  268.     Ltocr.Decimal := '.';   {US convention}
  269.     Ltocr.Thousands := ','; {US convention}
  270.  
  271.     Lead1.AutoRepaint := False;
  272.     Lead1.BackErase := False;
  273. end;
  274.  
  275. procedure TForm1.ClearDocument1Click(Sender: TObject);
  276. begin
  277.     Ltocr.ClearDoc();
  278.     gbDoc := False;
  279. end;
  280.  
  281. procedure TForm1.File1Click(Sender: TObject);
  282. begin
  283.     SaveAs1.Enabled := gbDoc;
  284. end;
  285.  
  286. procedure TForm1.View1Click(Sender: TObject);
  287. var
  288.    bEnable : boolean;
  289. begin
  290.     If Lead1.Bitmap > 0 Then
  291.        bEnable := True
  292.     Else
  293.        bEnable := False;
  294.  
  295.     Normal1.Enabled := bEnable;
  296.     FittoWindow1.Enabled := bEnable;
  297. end;
  298.  
  299. procedure TForm1.EditDocument1Click(Sender: TObject);
  300. begin
  301.     Ltocr.EditDoc(); {start the LEADTOOLS OCR Editor}
  302. end;
  303.  
  304. procedure TForm1.SetZone1Click(Sender: TObject);
  305. begin
  306.     gbSetZone := True;
  307.     Lead1.MousePointer := 2;
  308. end;
  309.  
  310. procedure TForm1.Recognize1Click(Sender: TObject);
  311. Var
  312.    lRet : longint;
  313. begin
  314.     {assign the bitmap for OCR}
  315.     Ltocr.Bitmap := Lead1.Bitmap;
  316.  
  317.     Screen.Cursor := crHourglass;
  318.     lRet := Ltocr.RecognizeOCR(OCRFLAG_CALLBACK_AUTO);
  319. //    Ltocr.EnableRecognizeEvent := True;
  320. //    lRet := Ltocr.RecognizeOCR(OCRFLAG_NONE);
  321.     Screen.Cursor := crDefault;
  322.     If (lRet <> 0) Then
  323.     begin
  324.         MessageDlg('Error: ' + IntToStr(lRet) + ' during recognition!', mtError, [mbOk], 0);
  325.         Ltocr.ClearDoc(); {clear the document}
  326.         gbDoc := False;
  327.     end
  328.     Else
  329.         gbDoc := True;
  330. end;
  331.  
  332. procedure TForm1.OCR1Click(Sender: TObject);
  333. var
  334.    bEnable : boolean;
  335. begin
  336.     If Lead1.Bitmap > 0 Then
  337.        bEnable := True
  338.     Else
  339.        bEnable := False;
  340.  
  341.     Recognize1.Enabled := bEnable;
  342.     if AutoWithAutoZones1.Checked = True then
  343.        SetZone1.Enabled := False
  344.     else
  345.        SetZone1.Enabled := bEnable;
  346.     EditDocument1.Enabled := gbDoc;
  347.     ClearDocument1.Enabled := gbDoc;
  348.     DocumentInfo1.Enabled := gbDoc;
  349.     PageInfo1.Enabled := gbDoc;
  350.     ZoneInfo1.Enabled := gbDoc;
  351. end;
  352.  
  353. procedure TForm1.English1Click(Sender: TObject);
  354. begin
  355.     English1.Checked := True;
  356.     German1.Checked := False;
  357.     French1.Checked := False;
  358.     Spanish1.Checked := False;
  359.     Italian1.Checked := False;
  360.     Dutch1.Checked := False;
  361.     Swedish1.Checked := False;
  362.     Norwegian1.Checked := False;
  363.     Finnish1.Checked := False;
  364.     Danish1.Checked := False;
  365.     Portuguese1.Checked := False;
  366.     Russian1.Checked := False;
  367.     Ltocr.Language := OCRLNG_ENGLISH;
  368. end;
  369.  
  370. procedure TForm1.German1Click(Sender: TObject);
  371. begin
  372.     English1.Checked := False;
  373.     German1.Checked := True;
  374.     French1.Checked := False;
  375.     Spanish1.Checked := False;
  376.     Italian1.Checked := False;
  377.     Dutch1.Checked := False;
  378.     Swedish1.Checked := False;
  379.     Norwegian1.Checked := False;
  380.     Finnish1.Checked := False;
  381.     Danish1.Checked := False;
  382.     Portuguese1.Checked := False;
  383.     Russian1.Checked := False;
  384.     Ltocr.Language := OCRLNG_GERMAN;
  385. end;
  386.  
  387. procedure TForm1.French1Click(Sender: TObject);
  388. begin
  389.     English1.Checked := False;
  390.     German1.Checked := False;
  391.     French1.Checked := True;
  392.     Spanish1.Checked := False;
  393.     Italian1.Checked := False;
  394.     Dutch1.Checked := False;
  395.     Swedish1.Checked := False;
  396.     Norwegian1.Checked := False;
  397.     Finnish1.Checked := False;
  398.     Danish1.Checked := False;
  399.     Portuguese1.Checked := False;
  400.     Russian1.Checked := False;
  401.     Ltocr.Language := OCRLNG_FRENCH;
  402. end;
  403.  
  404. procedure TForm1.Spanish1Click(Sender: TObject);
  405. begin
  406.     English1.Checked := False;
  407.     German1.Checked := False;
  408.     French1.Checked := False;
  409.     Spanish1.Checked := True;
  410.     Italian1.Checked := False;
  411.     Dutch1.Checked := False;
  412.     Swedish1.Checked := False;
  413.     Norwegian1.Checked := False;
  414.     Finnish1.Checked := False;
  415.     Danish1.Checked := False;
  416.     Portuguese1.Checked := False;
  417.     Russian1.Checked := False;
  418.     Ltocr.Language := OCRLNG_SPANISH;
  419. end;
  420.  
  421. procedure TForm1.Italian1Click(Sender: TObject);
  422. begin
  423.     English1.Checked := False;
  424.     German1.Checked := False;
  425.     French1.Checked := False;
  426.     Spanish1.Checked := False;
  427.     Italian1.Checked := True;
  428.     Dutch1.Checked := False;
  429.     Swedish1.Checked := False;
  430.     Norwegian1.Checked := False;
  431.     Finnish1.Checked := False;
  432.     Danish1.Checked := False;
  433.     Portuguese1.Checked := False;
  434.     Russian1.Checked := False;
  435.     Ltocr.Language := OCRLNG_ITALIAN;
  436. end;
  437.  
  438. procedure TForm1.Dutch1Click(Sender: TObject);
  439. begin
  440.     English1.Checked := False;
  441.     German1.Checked := False;
  442.     French1.Checked := False;
  443.     Spanish1.Checked := False;
  444.     Italian1.Checked := False;
  445.     Dutch1.Checked := True;
  446.     Swedish1.Checked := False;
  447.     Norwegian1.Checked := False;
  448.     Finnish1.Checked := False;
  449.     Danish1.Checked := False;
  450.     Portuguese1.Checked := False;
  451.     Russian1.Checked := False;
  452.     Ltocr.Language := OCRLNG_DUTCH;
  453. end;
  454.  
  455. procedure TForm1.Swedish1Click(Sender: TObject);
  456. begin
  457.     English1.Checked := False;
  458.     German1.Checked := False;
  459.     French1.Checked := False;
  460.     Spanish1.Checked := False;
  461.     Italian1.Checked := False;
  462.     Dutch1.Checked := False;
  463.     Swedish1.Checked := True;
  464.     Norwegian1.Checked := False;
  465.     Finnish1.Checked := False;
  466.     Danish1.Checked := False;
  467.     Portuguese1.Checked := False;
  468.     Russian1.Checked := False;
  469.     Ltocr.Language := OCRLNG_SWEDISH;
  470. end;
  471.  
  472. procedure TForm1.Norwegian1Click(Sender: TObject);
  473. begin
  474.     English1.Checked := False;
  475.     German1.Checked := False;
  476.     French1.Checked := False;
  477.     Spanish1.Checked := False;
  478.     Italian1.Checked := False;
  479.     Dutch1.Checked := False;
  480.     Swedish1.Checked := False;
  481.     Norwegian1.Checked := True;
  482.     Finnish1.Checked := False;
  483.     Danish1.Checked := False;
  484.     Portuguese1.Checked := False;
  485.     Russian1.Checked := False;
  486.     Ltocr.Language := OCRLNG_NORWEGIAN;
  487. end;
  488.  
  489. procedure TForm1.Finnish1Click(Sender: TObject);
  490. begin
  491.     English1.Checked := False;
  492.     German1.Checked := False;
  493.     French1.Checked := False;
  494.     Spanish1.Checked := False;
  495.     Italian1.Checked := False;
  496.     Dutch1.Checked := False;
  497.     Swedish1.Checked := False;
  498.     Norwegian1.Checked := False;
  499.     Finnish1.Checked := True;
  500.     Danish1.Checked := False;
  501.     Portuguese1.Checked := False;
  502.     Russian1.Checked := False;
  503.     Ltocr.Language := OCRLNG_FINNISH;
  504. end;
  505.  
  506. procedure TForm1.Danish1Click(Sender: TObject);
  507. begin
  508.     English1.Checked := False;
  509.     German1.Checked := False;
  510.     French1.Checked := False;
  511.     Spanish1.Checked := False;
  512.     Italian1.Checked := False;
  513.     Dutch1.Checked := False;
  514.     Swedish1.Checked := False;
  515.     Norwegian1.Checked := False;
  516.     Finnish1.Checked := False;
  517.     Danish1.Checked := True;
  518.     Portuguese1.Checked := False;
  519.     Russian1.Checked := False;
  520.     Ltocr.Language := OCRLNG_DANISH;
  521. end;
  522.  
  523. procedure TForm1.Portuguese1Click(Sender: TObject);
  524. begin
  525.     English1.Checked := False;
  526.     German1.Checked := False;
  527.     French1.Checked := False;
  528.     Spanish1.Checked := False;
  529.     Italian1.Checked := False;
  530.     Dutch1.Checked := False;
  531.     Swedish1.Checked := False;
  532.     Norwegian1.Checked := False;
  533.     Finnish1.Checked := False;
  534.     Danish1.Checked := False;
  535.     Portuguese1.Checked := True;
  536.     Russian1.Checked := False;
  537.     Ltocr.Language := OCRLNG_PORTUGUESE;
  538. end;
  539.  
  540. procedure TForm1.Russian1Click(Sender: TObject);
  541. begin
  542.     English1.Checked := False;
  543.     German1.Checked := False;
  544.     French1.Checked := False;
  545.     Spanish1.Checked := False;
  546.     Italian1.Checked := False;
  547.     Dutch1.Checked := False;
  548.     Swedish1.Checked := False;
  549.     Norwegian1.Checked := False;
  550.     Finnish1.Checked := False;
  551.     Danish1.Checked := False;
  552.     Portuguese1.Checked := False;
  553.     Russian1.Checked := True;
  554.     Ltocr.Language := OCRLNG_RUSSIAN;
  555. end;
  556.  
  557. procedure TForm1.None1Click(Sender: TObject);
  558. begin
  559.     Ltocr.PreprocessingMode := OCRPP_NONE;
  560.     None1.Checked := True;
  561.     Auto1.Checked := False;
  562.     AutoWithAutoZones1.Checked := False;
  563.     SetZone1.Enabled := True;
  564. end;
  565.  
  566. procedure TForm1.Auto1Click(Sender: TObject);
  567. begin
  568.     Ltocr.PreprocessingMode := OCRPP_ORIENTATION + OCRPP_TEXT_ORIENTATION + OCRPP_SKEW + OCRPP_AUTO_FAX;
  569.     None1.Checked := False;
  570.     Auto1.Checked := True;
  571.     Autowithautozones1.checked := False;
  572.     SetZone1.Enabled := True;
  573. end;
  574.  
  575. procedure TForm1.AlterManuallyGeneratedZones1Click(Sender: TObject);
  576. begin
  577.     AlterManuallyGeneratedZones1.Checked := Not AlterManuallyGeneratedZones1.Checked;
  578.     Ltocr.SloppyManual := AlterManuallyGeneratedZones1.Checked;
  579. end;
  580.  
  581. procedure TForm1.Standard1Click(Sender: TObject);
  582. begin
  583.     Ltocr.RecognitionMode := OCRREC_STANDARD;
  584.     Degraded1.Checked := False;
  585.     Standard1.Checked := True;
  586. end;
  587.  
  588. procedure TForm1.Degraded1Click(Sender: TObject);
  589. begin
  590.     Ltocr.RecognitionMode := OCRREC_DEGRADED;
  591.     Degraded1.Checked := True;
  592.     Standard1.Checked := False;
  593. end;
  594.  
  595. procedure TForm1.Word1Click(Sender: TObject);
  596. begin
  597.     Ltocr.VerifierMode := OCRVER_WORD;
  598.     Character1.Checked := False;
  599.     Word1.Checked := True;
  600. end;
  601.  
  602. procedure TForm1.Character1Click(Sender: TObject);
  603. begin
  604.     Ltocr.VerifierMode := OCRVER_CHAR;
  605.     Character1.Checked := True;
  606.     Word1.Checked := False;
  607. end;
  608.  
  609. procedure TForm1.ProcessHeadersandFooters1Click(Sender: TObject);
  610. begin
  611.     ProcessHeadersandFooters1.Checked := Not ProcessHeadersandFooters1.Checked;
  612.     Ltocr.HeaderFooterProcess := ProcessHeadersandFooters1.Checked;
  613. end;
  614.  
  615. procedure TForm1.Training1Click(Sender: TObject);
  616. begin
  617.     Training1.Checked := Not Training1.Checked;
  618.  
  619.     If Training1.Checked = True Then
  620.         Ltocr.Training := LTCommDlg.filename + '.train'
  621.     Else
  622.         Ltocr.Training := '';
  623. end;
  624.  
  625. procedure TForm1.VerifierThreshold1Click(Sender: TObject);
  626. var
  627.    threshold : longint;
  628.    instr : string;
  629. begin
  630.     instr := InputBox('Verifier Threshold', 'Enter Value', IntToStr(LTOCR.VerifierThreshold));
  631.  
  632.     threshold := StrToInt(instr);
  633.     If ((threshold >= 0) And (threshold <= 999)) Then
  634.         Ltocr.VerifierThreshold := threshold;
  635. end;
  636.  
  637. procedure TForm1.MinPointSize1Click(Sender: TObject);
  638. var
  639.    pointsize : longint;
  640.    instr : string;
  641. begin
  642.     instr := InputBox('Minimum PointSize', 'Enter Value', IntToStr(LTOCR.MinPointSize));
  643.  
  644.     pointsize := StrToInt(instr);
  645.     If ((pointsize >= 0) And (pointsize <= 999)) Then
  646.         Ltocr.MinPointSize := pointsize;
  647. end;
  648.  
  649. procedure TForm1.MaxPointSize1Click(Sender: TObject);
  650. var
  651.    pointsize : longint;
  652.    instr : string;
  653. begin
  654.     instr := InputBox('Maximum PointSize', 'Enter Value', IntToStr(LTOCR.MaxPointSize));
  655.  
  656.     pointsize := StrToInt(instr);
  657.     If ((pointsize >= 0) And (pointsize <= 999)) Then
  658.         Ltocr.MaxPointSize := pointsize;
  659. end;
  660.  
  661. procedure TForm1.Lead1MouseDown(Sender: TObject; Button: TMouseButton;
  662.   Shift: TShiftState; X, Y: Integer);
  663. begin
  664.     If gbSetZone = True Then
  665.     begin
  666.        Lead1.MousePointer := 2;
  667.        Lead1.AutoRubberBand := True;
  668.     end;
  669. end;
  670.  
  671. procedure TForm1.Lead1RubberBand(Sender: TObject);
  672. var
  673.    lRet : integer;
  674.    zonetop : single;
  675.    zoneleft : single;
  676.    zonebottom : single;
  677.    zoneright : single;
  678.    nType : integer;
  679.    zoomfactor : real;
  680.    nLexicalClass : longint;
  681.  
  682.    msgstr : string;
  683.  
  684. begin
  685.    gbSetZone := False;
  686.    Lead1.MousePointer := 0;
  687.    Lead1.AutoRubberBand := False;
  688.  
  689.    {first, setup the points that compose the zone's polygon}
  690.    zoomfactor := Lead1.DstWidth / Lead1.BitmapWidth;
  691.    zonetop := Round((Lead1.RubberBandTop - Lead1.DstTop) / zoomfactor);
  692.    zoneleft := Round((Lead1.RubberBandLeft - Lead1.DstLeft) / zoomfactor);
  693.    zonebottom := Round(Lead1.RubberBandHeight / zoomfactor + zonetop);
  694.    zoneright := Round(Lead1.RubberBandWidth / zoomfactor + zoneleft);
  695.  
  696.    msgstr := IntToStr(Round(zoneleft));
  697.    msgstr := msgstr + chr(13) + IntToStr(Round(zonetop));
  698.    msgstr := msgstr + chr(13) + IntToStr(Round(zoneright));
  699.    msgstr := msgstr + chr(13) + IntToStr(Round(zonebottom));
  700.  
  701.    MessageDlg(msgstr, mtInformation, [mbOk], 0);
  702.  
  703.    Ltocr.PolygonSize := 4;
  704.    Ltocr.PolygonX[0] := Round(zoneleft);
  705.    Ltocr.PolygonX[1] := Round(zoneright);
  706.    Ltocr.PolygonX[2] := Round(zoneright);
  707.    Ltocr.PolygonX[3] := Round(zoneleft);
  708.  
  709.    Ltocr.PolygonY[0] := Round(zonetop);
  710.    Ltocr.PolygonY[1] := Round(zonetop);
  711.    Ltocr.PolygonY[2] := Round(zonebottom);
  712.    Ltocr.PolygonY[3] := Round(zonebottom);
  713.  
  714.    {get the zone type}
  715.    ZoneType.ShowModal;
  716.    nType := ZoneType.nType;
  717.  
  718.    {get the lexical class}
  719.    LexClass.ShowModal;
  720.    nLexicalClass := LexClass.nLexicalClass;
  721.  
  722.    {set the OCR Zone}
  723.    lRet := Ltocr.SetZone(gnZoneIndex, nType, Ltocr.Language, nLexicalClass, 0, OCRLEX_ABSOLUTE, gnStacking);
  724. {   lRet := Ltocr.SetZone(gnZoneIndex, nType, Ltocr.Language, 0, 0, OCRLEX_NO_LEXICAL, gnStacking);}
  725.    If (lRet = 0) Then
  726.    begin
  727.        gnStacking := gnStacking + 1;
  728.        gnZoneIndex := gnZoneIndex + 1;
  729.    end;
  730. end;
  731.  
  732. procedure TForm1.DocumentInfo1Click(Sender: TObject);
  733. var
  734.    nNbPages : short;
  735. begin
  736.     {get the number of pages in the document}
  737.     Ltocr.InfoDoc(nNbPages);
  738.     MessageDlg('Document contains ' + IntToStr(nNbPages) + ' pages.', mtInformation, [mbOk], 0);
  739. end;
  740.  
  741. procedure TForm1.PageInfo1Click(Sender: TObject);
  742. var
  743.    npage : short;
  744.    nNbZones : short;
  745.    instr : string;
  746. begin
  747.     instr := InputBox('Page#', 'Enter Value', '1');
  748.     npage := StrToInt(instr);
  749.     Ltocr.InfoPage(npage, nNbZones);
  750.     MessageDlg('Page ' + IntToStr(npage) + ' contains ' + IntToStr(nNbZones) + ' zones.', mtInformation, [mbOk], 0);
  751. end;
  752.  
  753. procedure TForm1.ZoneInfo1Click(Sender: TObject);
  754. var
  755.    npage : short;
  756.    nzone : short;
  757.    zonetype : short;
  758.    zoneleft : short;
  759.    zonetop : short;
  760.    zonewidth : short;
  761.    zoneheight : short;
  762.    instr : string;
  763.    msgstr : string;
  764.    ztypestr : string;
  765.    bcontinue : boolean;
  766. begin
  767.    instr := InputBox('Page#', 'Enter Value', '1');
  768.    npage := StrToInt(instr);
  769.    instr := InputBox('Zone#', 'Enter Value', '1');
  770.    nzone := StrToInt(instr);
  771.    Ltocr.InfoZone(npage, nzone, zonetype, zoneleft, zonetop, zonewidth, zoneheight);
  772.    bcontinue := True;
  773.    Case zonetype of
  774.    DOCZONE_TEXT:
  775.             ztypestr := 'Text';
  776.    DOCZONE_IMAGE:
  777.             ztypestr := 'Image';
  778.    DOCZONE_TABLE:
  779.             ztypestr := 'Table';
  780.    Else bcontinue := False;
  781.    End;
  782.  
  783.    if(bcontinue = True) then
  784.    begin
  785.       msgstr := 'Zone ' + IntToStr(nzone) + ' on page ' + IntToStr(npage) + ' is ' + ztypestr + Chr(13);
  786.       msgstr := msgstr + 'left: ' + IntToStr(zoneleft) + Chr(13);
  787.       msgstr := msgstr + 'top: ' + IntToStr(zonetop) + Chr(13);
  788.       msgstr := msgstr + 'width: ' + IntToStr(zonewidth) + Chr(13);
  789.       msgstr := msgstr + 'height: ' + IntToStr(zoneheight);
  790.       MessageDlg(msgstr, mtInformation, [mbOk], 0);
  791.    end
  792.    else
  793.       MessageDlg('Bad Page or Zone.', mtError, [mbOk], 0);
  794. end;
  795.  
  796. procedure TForm1.AutowithAutoZones1Click(Sender: TObject);
  797. begin
  798.     Ltocr.PreprocessingMode := OCRPP_AUTO_SEGMENTATION + OCRPP_ORIENTATION + OCRPP_TEXT_ORIENTATION + OCRPP_SKEW + OCRPP_AUTO_FAX;
  799.     None1.Checked := False;
  800.     Auto1.Checked := False;
  801.     AutoWithAutoZones1.Checked := True;
  802.     SetZone1.Enabled := False;
  803. end;
  804.  
  805. procedure TForm1.About1Click(Sender: TObject);
  806. begin
  807.    AboutBox.ShowModal;
  808. end;
  809.  
  810. procedure TForm1.LTOcrRecognizeEvent(Sender: TObject; hBitmap: Integer;
  811.   const pszText, pszMask: string; nStatus, nPercent, nWordLeft, nWordTop,
  812.   nWordWidth, nWordHeight, nGroupLeft, nGroupTop, nGroupWidth,
  813.   nGroupHeight: Smallint);
  814. var
  815.   x : Integer;
  816.   nFirst : Integer;
  817.   nLast : Integer;
  818.   val2test : Integer;
  819.   testres : Integer;
  820.   szMask : array[0..180] of Char;
  821.   verstring : string;
  822. label foundfirst, foundlast;
  823. begin
  824.     {'this event simply tests the pszMask and then accepts the pszText accordingly}
  825.     {'to be useful, your event should present pszText to the user for verification}
  826.     {'depending on the char flags in pszMask.}
  827.  
  828.     If (nStatus = OCRSTATUS_QUESTION) Then
  829.     begin
  830.         StrPCopy(szMask, pszMask);
  831.         {first, lets find the first char in the string that needs verification}
  832.         For x := 0 To Length(pszText)-1 Do
  833.         begin
  834.             val2test := integer(szMask[x]);
  835.             testres := val2test;
  836.             testres := testres and (OCRCHAR_CURRENT_WORD or OCRCHAR_CURRENT_GROUP or OCRCHAR_BEGIN_GROUP);
  837.             if(testres = (OCRCHAR_CURRENT_WORD or OCRCHAR_CURRENT_GROUP or OCRCHAR_BEGIN_GROUP)) then
  838.                goto foundfirst;
  839.         end;
  840. foundfirst:
  841.         nFirst := x;
  842.  
  843.         {now, find the last char in the string that needs verification}
  844.         For x := nFirst + 1 to Length(pszText)-1 Do
  845.         begin
  846.             val2test := integer(szMask[x]);
  847.             testres := val2test;
  848.             if (((testres and OCRCHAR_CURRENT_WORD) = 0) or ((testres and OCRCHAR_CURRENT_GROUP) = 0)) then
  849.             begin
  850.                nLast := x - 1;
  851.                GoTo foundlast;
  852.             End;
  853.         end;
  854.         nLast := x;
  855. foundlast:
  856.         nFirst:=nFirst+1;
  857.         nLast:=nLast+1;
  858.         {Finally, fill TextRecognizeEvent property with the original}
  859.         {chars in question (i.e. accept them), and return}
  860.         verstring := Copy(pszText, nFirst, nLast-nFirst+1);
  861.         Ltocr.TextRecognizeEvent := verstring;
  862.         Ltocr.StatusRecognizeEvent := OCRCMD_ACCEPT_WORD;
  863.     End;
  864. end;
  865.  
  866. end.
  867.