moparisthebest
/
Simba
mirror of https://github.com/moparisthebest/Simba
1
0
Fork 0
Code Issues Releases Wiki Activity

Fix for Windows compilation 

git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@327 3f818213-9676-44b0-a9b4-5e4c4e03d09d
This commit is contained in:
Wizzup? 2009-12-23 20:06:22 +00:00
parent 7a779be7ca
commit edfce61a25
1 changed files with 169 additions and 169 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

338
Projects/OCRBench/unit1.pas
View File

@ -1,169 +1,169 @@
unit Unit1; unit Unit1;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
interface interface
uses uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls, ExtCtrls, Client, MufasaTypes, Bitmaps, ocr, windowselector,window; StdCtrls, ExtCtrls, Client, MufasaTypes, Bitmaps, ocr, windowselector,window;
type type
{ TForm1 } { TForm1 }
TForm1 = class(TForm) TForm1 = class(TForm)
BitmapButton: TButton; BitmapButton: TButton;
FShadow: TCheckBox; FShadow: TCheckBox;
PathButton: TButton; PathButton: TButton;
OCRButton: TButton; OCRButton: TButton;
Image1: TImage; Image1: TImage;
OCRFileOpen: TOpenDialog; OCRFileOpen: TOpenDialog;
ClientButton: TToggleBox; ClientButton: TToggleBox;
UpCharsDialog: TSelectDirectoryDialog; UpCharsDialog: TSelectDirectoryDialog;
procedure BitmapButtonClick(Sender: TObject); procedure BitmapButtonClick(Sender: TObject);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure OCRButtonClick(Sender: TObject); procedure OCRButtonClick(Sender: TObject);
procedure PathButtonClick(Sender: TObject); procedure PathButtonClick(Sender: TObject);
procedure SelectClient(Sender: TObject; Button: TMouseButton; procedure SelectClient(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer); Shift: TShiftState; X, Y: Integer);
private private
BitmapPath: String; BitmapPath: String;
FontPath: String; FontPath: String;
CliW: TMWindow; CliW: TMWindow;
UseClient: Boolean; UseClient: Boolean;
{ private declarations } { private declarations }
public public
{ public declarations } { public declarations }
end; end;
var var
Form1: TForm1; Form1: TForm1;
implementation implementation
uses uses
lclintf, lcltype; lclintf, lcltype;
{ TForm1 } { TForm1 }
procedure TForm1.OCRButtonClick(Sender: TObject); procedure TForm1.OCRButtonClick(Sender: TObject);
Var Var
C: TClient; C: TClient;
bmp: TMufasaBitmap; bmp: TMufasaBitmap;
x,y: integer; x,y: integer;
s: string; s: string;
Shadow: boolean; Shadow: boolean;
t: dword; t: dword;
begin begin
if not FileExists(BitmapPath) and not UseClient then if not FileExists(BitmapPath) and not UseClient then
begin begin
MessageBox(0,pchar('You did not set a valid bitmap'), Pchar('Bitmap Error'), MessageBox(0,pchar('You did not set a valid bitmap'), Pchar('Bitmap Error'),
MB_OK); MB_OK);
if OCRFileOpen.Execute then if OCRFileOpen.Execute then
BitmapPath := OCRFileOpen.FileName; BitmapPath := OCRFileOpen.FileName;
Exit; Exit;
end; end;
if not DirectoryExists(FontPath) then if not DirectoryExists(FontPath) then
begin begin
MessageBox(0,pchar('You did not set a FontPath' ), Pchar('Path Error'), MessageBox(0,pchar('You did not set a FontPath' ), Pchar('Path Error'),
MB_OK); MB_OK);
if UpCharsDialog.Execute then if UpCharsDialog.Execute then
FontPath := UpCharsDialog.FileName; FontPath := UpCharsDialog.FileName;
Exit; Exit;
end; end;
Form1.Image1.Canvas.Brush.Color := 0; Form1.Image1.Canvas.Brush.Color := 0;
Form1.Image1.Canvas.Rectangle(0, 0, Form1.Image1.Canvas.Width, Form1.Image1.Canvas.Height); Form1.Image1.Canvas.Rectangle(0, 0, Form1.Image1.Canvas.Width, Form1.Image1.Canvas.Height);
// create and init client // create and init client
C := TClient.Create; C := TClient.Create;
bmp := TMufasaBitmap.Create; bmp := TMufasaBitmap.Create;
if UseClient then if UseClient then
C.MWindow.SetWindow(CliW) C.MWindow.SetWindow(CliW)
else else
begin begin
bmp.LoadFromFile(BitmapPath); bmp.LoadFromFile(BitmapPath);
C.MWindow.SetTarget(bmp); C.MWindow.SetTarget(bmp);
end; end;
Shadow :=FShadow.Checked; Shadow :=FShadow.Checked;
// DS + .. + DS because InitOCR wants the directory of the Fonts, not UpChars // DS + .. + DS because InitOCR wants the directory of the Fonts, not UpChars
// only. // only.
C.MOCR.InitTOCR(FontPath + DS, Shadow); C.MOCR.InitTOCR(FontPath + DS, Shadow);
t:=gettickcount; t:=gettickcount;
s := C.MOCR.GetUpTextAtEx(7, 7, Shadow); s := C.MOCR.GetUpTextAtEx(7, 7, Shadow);
writeln(inttostr(gettickcount-t)); writeln(inttostr(gettickcount-t));
// write to debugbmp // write to debugbmp
{$IFDEF OCRDEBUG} {$IFDEF OCRDEBUG}
for y := 0 to C.MOCR.debugbmp.Height - 1 do for y := 0 to C.MOCR.debugbmp.Height - 1 do
for x := 0 to C.MOCR.debugbmp.Width -1 do for x := 0 to C.MOCR.debugbmp.Width -1 do
Form1.Image1.Canvas.Pixels[x,y] := C.MOCR.debugbmp.FastGetPixel(x,y); Form1.Image1.Canvas.Pixels[x,y] := C.MOCR.debugbmp.FastGetPixel(x,y);
// print ocr'ed text // print ocr'ed text
Form1.Image1.Canvas.Font.Color:=clRed; Form1.Image1.Canvas.Font.Color:=clRed;
Form1.Image1.Canvas.TextOut(0, C.MOCR.debugbmp.Height, s); Form1.Image1.Canvas.TextOut(0, C.MOCR.debugbmp.Height, s);
C.MOCR.debugbmp.Free; C.MOCR.debugbmp.Free;
{$ELSE} {$ELSE}
Form1.Image1.Canvas.Font.Color:=clRed; Form1.Image1.Canvas.Font.Color:=clRed;
Form1.Image1.Canvas.TextOut(0, 0, s); Form1.Image1.Canvas.TextOut(0, 0, s);
{$ENDIF} {$ENDIF}
{$IFDEF OCRDEBUG} {$IFDEF OCRDEBUG}
Form1.Image1.Picture.SaveToFile(OCRDebugPath + 'ocrbench.bmp'); Form1.Image1.Picture.SaveToFile(OCRDebugPath + 'ocrbench.bmp');
{$ENDIF} {$ENDIF}
bmp.Free; bmp.Free;
C.Free; C.Free;
Application.ProcessMessages; Application.ProcessMessages;
end; end;
procedure TForm1.BitmapButtonClick(Sender: TObject); procedure TForm1.BitmapButtonClick(Sender: TObject);
begin begin
if OCRFileOpen.Execute then if OCRFileOpen.Execute then
begin begin
BitmapPath := OCRFileOpen.FileName; BitmapPath := OCRFileOpen.FileName;
UseClient:=False; UseClient:=False;
end; end;
end; end;
procedure TForm1.FormCreate(Sender: TObject); procedure TForm1.FormCreate(Sender: TObject);
begin begin
UseClient := False; UseClient := False;
{BitmapPath := '/home/merlijn/Programs/mufasa/pics/uptext4.bmp'; } {BitmapPath := '/home/merlijn/Programs/mufasa/pics/uptext4.bmp'; }
FontPath := '/home/merlijn/Programs/mufasa/Fonts/'; FontPath := '/home/merlijn/Programs/mufasa/Fonts/';
end; end;
procedure TForm1.PathButtonClick(Sender: TObject); procedure TForm1.PathButtonClick(Sender: TObject);
begin begin
if UpCharsDialog.Execute then if UpCharsDialog.Execute then
FontPath := UpCharsDialog.FileName; FontPath := UpCharsDialog.FileName;
end; end;
procedure TForm1.SelectClient(Sender: TObject; Button: TMouseButton; procedure TForm1.SelectClient(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer); Shift: TShiftState; X, Y: Integer);
Var Var
WS: TMWindowSelector; WS: TMWindowSelector;
begin begin
UseClient := True; UseClient := True;
if not assigned(CliW) then if not assigned(CliW) then
CliW := TMWindow.Create; CliW := TMWindow.Create;
WS := TMWindowSelector.Create(CliW); WS := TMWindowSelector.Create(CliW);
CliW.SetTarget(WS.Drag); CliW.SetTarget(WS.Drag{$IFDEF WINDOWS},w_Window{$ENDIF});
end; end;
initialization initialization
{$I unit1.lrs} {$I unit1.lrs}
end. end.