Ғылыми жоба тақырыбы: «Мәтінді тануға, аударуға арналған ocr- жүйесін моделдеу және жасау»


Мәтінді тану алгоритмдерін талдау және құрастыру



жүктеу/скачать 2,67 Mb.
бет7/8
Дата12.11.2023
өлшемі2,67 Mb.
#191104
1   2   3   4   5   6   7   8
Байланысты:
Мәтінді тануға, аударуға арналған ОСR-жүйесін моделдеу және жасау
Емтихан сұрақтары Алгоритмдер 2022 (3), 4сын. матем 21-22 сабақтар.Ләззат
2.2 Мәтінді тану алгоритмдерін талдау және құрастыру
Нысанды тану міндеті (нақтырақ, жiктеу) келесі үлгіде қойылады. Нысандарды кодтаудың кейбiр тәсiлдері (мысалы, қол жазба әріптері), алдын ала белгілі түпкі жиындар класына жататын C={C1 ,...,Cq}, және кейбір нысандар жиыны (үйретуші жиын), әр қайсысының қай класқа жататыны белгілі. Кез келген енетін нысан бойынша, үйретуші жиынға жату міндетті емес, нысанның қай класқа жататынын шешетін және оны жақсы жасайтын алгоритм құру керек. Сапалы түрде ақпаратты тану (яғни жиілік)алдын ала белгiлi жауаптары бар нысандардың басқа түпкi жиынындағы жiктеудiң қатесi (тестілік жиынтық).
Бірден бірнеше нақтылау. Жіктеуге қарағанда, жалпы тану барысында, нысандардың сандық сипаттамаларын бағалау керек болады (мысалы, мұнайдың көлемі кең орны сейсмограмме бойынша). Үйренуші және тестілік жиын алдын ала белгілі болмауы мүмкін тану алгоритмінің жұмысы жасау үрдісі барысында толтырылады.






2.3 Мәтінді танитын оптикалық жүйенің қосымшасын жасау
Сканерлеу үшін Active X компоненті қолданылады. TWAIN сканерлеу драйверін шығарады. Содан соң сканерлеу үрдісі басталады. Сканерленген сурет Image компонентіне жіберіледі, қосымша негізгі формада қажеттілігі бойынша сақталады. Сурет сақталған соң, оны ары қарай іс-әрекетте (кадрлау және тану) ашуға болады. Суретті айналдыру тышқанның оң жақ батырмасын шерту арқылы орындалады, егер сурет үлкен болса онда тышқанның сол жақ батырмасын шерту арқылы орындалады. Бағдарламаға жіберген соң тану қажет. Барлық суреттер ақ-қара және қара пикселдердің bitmap түрлендіруден тұратын екі өлшемді жиын. Тану бірінші қара пиксел нүктесін анықтаудан басталады bitmap динамикалық шектеуде және сол қара түсті пикселдер динамикалық жадқа жазылғанға дейін орындалады. Содан соң келесі нүкте табылады да келесі сурет салынады. Сосын суреттер стандартты фиксирленген өлшемге дейін және listbox компоненті тізіміне бөлек сурет түрінде тізіледі. Егер суретте қандайда бір кедергілер немесе кішкентай суреттер болса, олар ерікті әріптер ретінде қабылданады. Тану алгоритмі бағдарлама бойынша қатардан басқа listbox тізімне көшеді және сәйкестендіру алгоритмі бойынша жиындар символында сипатталған, Arial қаріпіне сәйкестігін тексереді. Егер тиімді өлшемге дейін кішірейтілген әріп GetChar процедура жиынтығының тобындағы әріпке ұқсас болса, онда жадтан мәліметтер Мемо өрісіне жіберіледі. Осылай List Box тізімінің аяғына дейін. Мәтінді аудару қолданылады, жобамен жұмыс жасайтын бумада көшірілген сөздермен салыстыру негізінде және List Box компонентіне жүктелген жиын сөзі. Word –қа көшіру Microsoft Word қосымшасына және lines қасиетінен memo мәліметтер көшіріледі. «Binary IMAGE» батырмасы кездесетін барлық түрлі түсті пикселдердітүрлендіреді, қара түс тобының енбейтін, яғни ақ түстен басқалары тексерілмейді. Егер түс немесе нүкте немесе биттерден тұратын болса, онда ол түрлі түсті деп есептеліп қара түске боялады. Төменде бағдарламадан үзінділер және алғашқы кодтары берілген.

procedure TForm4.FormMouseDown(Sender: TObject; Button: TMouseButton; // «жабысқақ» қосымша
Shift: TShiftState; X, Y: Integer);
const sc_dragmove=$f013;
begin
releasecapture;
form4.Perform(wm_syscommand,sc_dragmove,0);
end;
var
Form3: TForm3;
draw: boolean=false;
drect: TRect;
jpg: TBitmap;
tmp:TBitmap;
po:Tpoint;
b:boolean;
Pic:TBitMap;
nX,nY:integer;
implementation

uses Unit1;


const
HANDDRAGCURSOR = 3778;


{$R *.dfm}


procedure TForm3.TwainTwainAcquire(Sender: TObject;


const Index: Integer; Image: TBitmap; var Cancel: Boolean);
begin
form3.Image1.Picture.Assign(Image);
Cancel := TRUE; //тек 1-суретке сұраныс
end;

procedure TForm3.Button1Click(Sender: TObject);


var
SelectedSource: Integer;
begin
{It is always recommended to load library dynamically, never forcing}
{final user to have twain installed}
if Twain.LoadLibrary then
begin

{Load source manager}


Twain.SourceManagerLoaded := TRUE;
{Allow user to select source}
SelectedSource := Twain.SelectSource;
if SelectedSource <> -1 then
begin
{Load source, select transference method and enable (display interface)}
Twain.Source[SelectedSource].Loaded := TRUE;
Twain.Source[SelectedSource].TransferMode := ttmMemory;
Twain.Source[SelectedSource].Enabled := TRUE;
end {if SelectedSource <> -1}

end
else


showmessage('TWAIN драйвері орнатылмаған');

end;

procedure TForm3.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ClickPos.x := X;
ClickPos.y := Y;
draw:=true;
drect:=Rect(x,y,x,y);
TImage(Sender).Canvas.DrawFocusRect(drect);
end;

procedure TForm3.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,


Y: Integer);
var
NewPos: TPoint;
begin
if draw then begin
TImage(Sender).Canvas.DrawFocusRect(drect);
drect.Right:=x;
drect.Bottom:=y;
TImage(Sender).Canvas.DrawFocusRect(drect);
end;

begin
// суретті кадрлау


nX:=X;
nY:=Y;
Image1.Canvas.Draw(0,0,Pic);
if nX>Image1.Width-100 then nX:=Image1.Width-100;
if nY>Image1.Height-50 then nY:=Image1.Height-50;
Image1.Canvas.Brush.Style:=bsClear;
Image1.Canvas.Rectangle(nX,nY,nX+100,nY+50);
// суретті кадрлауды аяқтау
end;
{The left button was pressed}
if ssLeft in Shift then
begin
{Calculate new position}
NewPos.X := form3.Image1.Left + x - ClickPos.x;
NewPos.Y := form3.Image1.Top + y - ClickPos.y;
if NewPos.x + form3.Image1.Width < ContainImage.Width then
NewPos.x := ContainImage.Width - form3.Image1.Width;
if NewPos.y + form3.Image1.Height < ContainImage.Height then
NewPos.y := ContainImage.Height - form3.Image1.Height;
if NewPos.X > 0 then NewPos.X := 0;
if NewPos.Y > 0 then NewPos.Y := 0;

form3.Image1.Top := NewPos.Y;


form3.Image1.Left := NewPos.X;
end {if ssLeft in Shift}

// суретті қию


end;

procedure TForm3.ContainImageResize(Sender: TObject);
begin
ClickPos.X := 0; ClickPos.Y := 0;
form3.Image1MouseMove(Self, [ssLeft], 0, 0);
end;

procedure TForm3.Button2Click(Sender: TObject);


begin
form1.image1.Picture:=form3.Image2.Picture;
form1.Show;
end;

procedure TForm3.Button4Click(Sender: TObject);


var
jpg: TJpegImage;
BMP: TBitmap;
begin
if savedialog1.Execute then begin image2.Picture.SaveToFile(savedialog1.FileName);
end;
end;

procedure TForm3.Button3Click(Sender: TObject);


var
jpg: TBitmap;
begin
if opendialog1.Execute then
jpg:=TBitmap.Create;
jpg.LoadFromFile(opendialog1.FileName);
image1.Picture.Bitmap.Assign(jpg); //TImage на форме
jpg.Destroy;

Pic:=TBitMaP.Create;


Pic.Height:=Image1.Height;
Pic.Width:=Image1.Width;
Pic.Canvas.Draw(0,0,Image1.Picture.Bitmap);
Form3.DoubleBuffered:=true;

end;

procedure TForm3.Button5Click(Sender: TObject);
var
jpg:Tbitmap;
begin
{jpg:=TBitmap.Create;
jpg.Assign(image1.Picture.Bitmap);
Image2.Canvas.CopyRect(Image1.Canvas.ClipRect,jpg.Canvas,drect);
{Image2.Canvas.Draw(0,0, jpg);}
image2.Width:=strtoint(edit1.Text);
image2.Height:=strtoint(edit2.Text);
end;

procedure TForm3.Image1MouseUp(Sender: TObject; Button: TMouseButton;


Shift: TShiftState; X, Y: Integer);
begin
draw:=false;
TImage(Sender).Canvas.DrawFocusRect(drect);
end;

procedure TForm3.N901Click(Sender: TObject);


var
bmp,bmp1 : Graphics.TBitmap;
i,j, w,h: integer;
begin
Bmp := Graphics.TBitmap.Create;
Bmp.Assign(Image1.Picture.Bitmap);
bmp1 := Graphics.TBitmap.Create;
bmp1.Height:=bmp.Width;
bmp1.Width:=bmp.Height;
h:=bmp1.Height;

for i:=0 to bmp.Width do begin


dec(h); w:=0;
for j:=0 to bmp.Height do begin
bmp1.Canvas.Pixels[w,h] := bmp.Canvas.Pixels[i,j]; // поворот по ЧС на 90 градусов
inc(w);
end;
end;

Form3.Image1.Canvas.Draw(0, 0, bmp1);


bmp.Destroy;


bmp1.Destroy;
end;

procedure TForm3.N902Click(Sender: TObject);


var
bmp,bmp1 : Graphics.TBitmap;
i,j, w,h: integer;
begin
Bmp := Graphics.TBitmap.Create;
Bmp.Assign(Image1.Picture.Bitmap);

bmp1 := Graphics.TBitmap.Create;


bmp1.Height:=bmp.Width;
bmp1.Width:=bmp.Height;

h:=bmp1.Height;


for i:=0 to bmp.Width do begin


dec(h); w:=0;
for j:=0 to bmp.Height do begin
bmp1.Canvas.Pixels[h,w] := bmp.Canvas.Pixels[j,i]; // сағат тіліне қарсы 90 градусқа
inc(w);
end;
end;

Form3.Image1.Canvas.Draw(0, 0, bmp1);


bmp.Destroy;


bmp1.Destroy;
end;

procedure TForm3.N2Click(Sender: TObject);


var
bmp,bmp1 : Graphics.TBitmap;
i,j, w,h: integer;
begin
Bmp := Graphics.TBitmap.Create;
Bmp.Assign(Image1.Picture.Bitmap);

bmp1 := Graphics.TBitmap.Create;


bmp1.Height:=bmp.Width;
bmp1.Width:=bmp.Height;

h:=bmp1.Height;


for i:=0 to bmp.Width do begin


dec(h); w:=0;
for j:=0 to bmp.Height do begin
bmp1.Canvas.Pixels[h,w] := bmp.Canvas.Pixels[i,j]; // көлденең бойынша
inc(w);
end;
end;

Form3.Image1.Canvas.Draw(0, 0, bmp1);


bmp.Destroy;


bmp1.Destroy;

end;

procedure TForm3.FormDestroy(Sender: TObject);
begin
Pic.Free;
end;

procedure TForm3.Image1Click(Sender: TObject);


var R:TRect;
begin
R.Left:=nX;
R.Top:=nY;
R.Right:=nX+100;
R.Bottom:=nY+50;
Image2.Canvas.CopyRect(Image2.ClientRect,Pic.Canvas,R);

end;

end.

var
Form1: TForm1;
Letters: array of TBitmap; //әріптер жиыны
LikeBlack: TColor; //шартты қара түс
NovSlovo, NovPerevod: String;
i, p, j, h1, h2: integer;
implementation

uses Unit2, Unit3;


$R *.dfm}


// суретті бинарлау

procedure dsBinarizeBMP(BMP: TBitmap; const aMid: Byte = 200);


type
T3b = array[0..2] of byte;
P3b = ^T3b;
var
i, j: Integer;
f3b: P3b;
begin
BMP.PixelFormat := pf24bit;
for i:=0 to pred(BMP.Height) do
begin
f3b := BMP.ScanLine[i];
for j := 0 to pred(BMP.Width) do
begin
if (((f3b^[0]+f3b^[1]+f3b^[2]) div 3)> aMid) then f3b^[0]:= 255
else
f3b^[0] := 0;
f3b^[1] := f3b^[0];
f3b^[2] := f3b^[0];
if (j < pred(BMP.Width)) then
inc(f3b);
end;
end;
end;

// суретті бинарлаудың соңы


// басқа жобадан


procedure Mono(Bmp:TBitmap);


type
TRGB=record
B,G,R:Byte;
end;
pRGB=^TRGB;
var
x,x1,y,y1:Word;
Dest:pRGB;
begin
for y:=Bmp.Height-1 downto 0 do
begin
Dest:=Bmp.ScanLine[y];
for x:=Bmp.Width-1 downto 0 do
begin
with Dest^ do
begin
if (r+g+b)/3>254 then
begin
r:=255;
g:=255;
b:=255;
end else
begin
r:=0;
g:=0;
b:=0;
end;
end;
Inc(Dest);
end;
end;
end;4

function Max(x,y:Integer):Integer;


begin
if x>y then Max:=x else Max:=y;
end;

function GetDifferents(Bmp1,Bmp2:TBitmap):Integer;


var
c1,c2:PByte;
x,y,x1,y1,i,Diff:Integer;
begin
Bmp1.PixelFormat:=pf24bit;
Bmp2.PixelFormat:=pf24bit;
Diff:=0;
x1:=Max(Bmp1.Width,Bmp2.Width);
y1:=Max(Bmp1.Height,Bmp2.Height);
for y:=0 to y1-1 do
begin
if Bmp1.Height>y then c1:=Bmp1.Scanline[y];
if Bmp2.Height>y then c2:=Bmp2.Scanline[y];
for x:=0 to x1-1 do
for i:=0 to 2 do
begin
Inc(Diff,Integer(c1^<>c2^));
Inc(c1);
Inc(c2);
end;
end;
Result:=Round(10000*(Diff/(x1*y1)));
end;

procedure RemoveBreak(Bmp:TBitmap);


var
x,y,y1:Integer;
Arr:array of Boolean;
Arr1:array of Boolean;
Temp,Max,TempStart,Start:Integer;
begin
SetLength(Arr,Bmp.Height);
for y:=0 to Bmp.Height-1 do
begin
Arr[y]:=False;
for x:=0 to Bmp.Width-1 do if Bmp.Canvas.Pixels[x,y]<>$FFFFFF then
begin
Arr[y]:=True;
Break;
end;
end;
Max:=0;
Temp:=0;
for y:=0 to Length(Arr)-1 do
begin
if Arr[y] then
begin
if Temp=0 then TempStart:=y;
inc(Temp);
end else
begin
if Temp>Max then
begin
Max:=Temp;
Start:=TempStart;
end;
Temp:=0;
end;
end;
if Temp>Max then
begin
Max:=Temp;
Start:=TempStart;
end;
Bmp.Canvas.Draw(0,-Start,Bmp);
Bmp.Height:=Max;

SetLength(Arr,Bmp.Width);


for x:=0 to Length(Arr)-1 do
begin
Arr[x]:=False;
for y:=0 to Bmp.Height-1 do if Bmp.Canvas.Pixels[x,y]<>$FFFFFF then
begin
Arr[x]:=True;
Break;
end;
end;
Max:=0;
Temp:=0;
for x:=0 to Length(Arr)-1 do
begin
if Arr[x] then
begin
if Temp=0 then TempStart:=x;
inc(Temp);
end else
begin
if Temp>Max then
begin
Max:=Temp;
Start:=TempStart;
end;
Temp:=0;
end;
end;
if Temp>Max then
begin
Max:=Temp;
Start:=TempStart;
end;
Bmp.Canvas.Draw(-Start,0,Bmp);
Bmp.Width:=Max;
end;

function GetChar(Bmp:TBitmap):Char;


const
CharList='ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789АБВГДЕЖЗИКЛМНИОПРСТФУХЧШЩЭЮЯЪЬЫабвгдежзиклмнопрстуфхчшщэюяъьы0123456789';
var
SizeBegin,SizeEnd:Integer;
CharBmp:TBitmap;
i:Integer;
c:Byte;
Min:Integer;
Temp:Integer;
begin
Result:=#0;
SizeBegin:=Round(Bmp.Height*0.90);
SizeEnd:=Round(bmp.Height*1.10);
Min:=10000;
CharBmp:=TBitmap.Create;
CharBmp:=TBitmap.Create;
CharBmp.PixelFormat:=pf24Bit;
for i:=SizeBegin to SizeEnd do
for c:=1 to Length(CharList) do

begin
CharBmp.Width:=i*2;


CharBmp.Height:=i*2;
CharBmp.Canvas.FillRect(Rect(0,0,CharBmp.Width,CharBmp.Height));
CharBmp.Canvas.Font.Name:='Arial';
CharBmp.Canvas.Font.Size:=i;
CharBmp.Canvas.TextOut(0,0,CharList[c]);
Mono(CharBmp);
RemoveBreak(CharBmp);
Temp:=GetDifferents(form1.Image2.Picture.Bitmap,CharBmp);
if Tempbegin
Min:=Temp;
Result:=CharList[c];
end;
end;
CharBmp.Free;
end;

procedure Prepare(Bmp:TBitmap);


var
BmpArr:array of array of Byte;
i,j,k:Integer;
Size,Max:Integer;
ArrSize:array of array[0..100] of Integer;

procedure f(x1,y1:Integer);


begin
inc(Size);
BmpArr[x1][y1]:=5;
{if BmpArr[x1+1][y1]=1 then f(x1+1,y1);
if BmpArr[x1-1][y1]=1 then f(x1-1,y1);
if BmpArr[x1][y1+1]=1 then f(x1,y1+1);
if BmpArr[x1][y1-1]=1 then f(x1,y1-1);}

if BmpArr[x1][y1]=1 then f(x1+1,y1);


if BmpArr[x1][y1]=1 then f(x1-1,y1);

end;

procedure d(x1,y1:Integer);
begin
BmpArr[x1][y1]:=0;
{ if BmpArr[x1+1][y1]=2 then d(x1+1,y1);
if BmpArr[x1-1][y1]=2 then d(x1-1,y1);
if BmpArr[x1][y1+1]=2 then d(x1,y1+1);
if BmpArr[x1][y1-1]=2 then d(x1,y1-1); }

if BmpArr[x1][y1]=1 then d(x1+1,y1);


if BmpArr[x1][y1]=1 then d(x1-1,y1);

end;

begin
SetLength(BmpArr,Bmp.Width);
for i:=0 to Length(BmpArr)-1 do
begin
SetLength(BmpArr[i],Bmp.Height);
for j:=0 to Bmp.Height-1 do if Bmp.Canvas.Pixels[i,j]=$FFFFFF then BmpArr[i][j]:=0 else BmpArr[i][j]:=1;
end;

for i:=0 to Bmp.Width-1 do


for j:=0 to Bmp.Height-1 do
begin
if BmpArr[i][j]=1 then
begin
Size:=0;
f(i,j);
SetLength(ArrSize,Length(ArrSize)+1);
ArrSize[Length(ArrSize)-1][0]:=Size;
ArrSize[Length(ArrSize)-1][1]:=i;
ArrSize[Length(ArrSize)-1][2]:=j;
end;
end;

Max:=ArrSize[0][0];


for k:=0 to Length(ArrSize)-1 do if ArrSize[k][0]>Max then Max:=ArrSize[k][0];
Max:=Round(Max/10);
for k:=0 to Length(ArrSize)-1 do if ArrSize[k][0]for i:=0 to Bmp.Width-1 do
for j:=0 to Bmp.Height-1 do if BmpArr[i][j]=0 then Bmp.Canvas.Pixels[i,j]:=$FFFFFF else Bmp.Canvas.Pixels[i,j]:=$000000;
end;

function GetImageChars(Bmp:TBitmap):String;


var
i,j,m,n:Integer;
BmpArrX:array of Boolean;
ok:Boolean;
CharPos:array of array of Integer;
TmpBmp:TBitmap;
c:Char;
q, w: TRect;
left_, top_, right_, bottom_: Integer;
bit: TBitmap;
begin
Form1.Memo1.Text:='';
{ Form1.Edit1.Text:='';}
Result:='';
Bmp.PixelFormat:=pf24Bit;
Mono(Bmp);
Prepare(Bmp);
Application.ProcessMessages;
SetLength(BmpArrX,Bmp.Width);
for i:=0 to Bmp.Width-1 do
begin
BmpArrX[i]:=False;
for j:=0 to Bmp.Height-1 do
if Bmp.Canvas.Pixels[i,j]=0 then
begin
BmpArrX[i]:=True;
Break;
end;
end;

SetLength(CharPos,2);


ok:=False;
for i:=0 to Bmp.Width-1 do
if BmpArrX[i] then
begin
if not ok then
begin
ok:=True;
SetLength(CharPos[0],Length(CharPos[0])+1);
CharPos[0][Length(CharPos[0])-1]:=i;
end;
end else if ok then
begin
ok:=False;
SetLength(CharPos[1],Length(CharPos[1])+1);
CharPos[1][Length(CharPos[1])-1]:=i;
end;

Form1.ProgressBar1.Max:=Length(CharPos[0]);


Form1.ProgressBar1.Position:=0;

TmpBmp:=TBitmap.Create;


for i:=0 to Length(CharPos[0])-1 do
begin
TmpBmp.Height:=Bmp.Height;
{TmpBmp.Width:=CharPos[1][i]-CharPos[0][i];}
TmpBmp.Width:=Bmp.Width;

{TmpBmp.Canvas.CopyRect(Rect(0,0,CharPos[1][i]-CharPos[0][i],Bmp.Height-1),


Bmp.Canvas,Rect(CharPos[0][i],0,CharPos[1][i],Bmp.Height-1));}

{ еще один вариант //TmpBmp.Canvas.CopyRect(Form1.Canvas.ClipRect, bmp.Canvas, BMP.Canvas.ClipRect);}


//соңғы нұсқа 11.11.12


q := Rect(300, 200, 300, 200);


w := Rect(0, 0, 500 - 200, 500 - 200);
TmpBmp.Canvas.CopyRect(q, form1.Image2.Picture.Bitmap.Canvas, w);
{ RemoveBreak(TmpBmp);}
{ Form1.Canvas.Rectangle(Rect(80,500,150,400));}
form1.Canvas.Brush.Style:=bsClear;
Form1.Canvas.FrameRect(Rect(80,500,150,400));
Form1.Canvas.Draw(104,400,TmpBmp);
c:=GetChar(TmpBmp);
Result:=Result+c;
Form1.Memo1.Text:=Form1.Memo1.Text+c;
Form1.ProgressBar1.Position:=Form1.ProgressBar1.Position+1;
Application.ProcessMessages;
end;

TmpBmp.Free;


end;

// жобаның соңы


procedure TForm1.NewLetter(x: integer; y: integer; var img: TBitmap; var letter: TBitmap; xlet:integer=8; ylet:integer=8);


//пискелдерден әріптерді құру процедурасы
begin
//Процедураны бірінші қосы барысында ( Button1Click-тан,рекурсиядан емес) xlet и ylet қордағы ақ пикселдердісол жаққа анықтайды (xlet) және жоғарға (ylet)
//Писелге біздің әріпті жазамыз
letter.Canvas.Pixels[xlet,ylet]:=img.Canvas.Pixels[x,y];
//Егер әріптерді түгелдей қара қылу керек болса, онда орнына
//letter.Canvas.Pixels[xlet,ylet]:=img.Canvas.Pixels[x,y];
//қолдану қажет
//letter.Canvas.Pixels[xlet,ylet]:=clBlack;

//алғашқыдан пикселді жоямыз


img.Canvas.Pixels[x,y]:=clWhite;

//Көрші пикселдер бойынша рекурсия, егер онда "шартты қара"


if img.Canvas.Pixels[x+1,y]if img.Canvas.Pixels[x-1,y]if img.Canvas.Pixels[x,y+1]if img.Canvas.Pixels[x,y-1]end;

procedure TForm1.CropLetter(letter: TBitmap); //Әріптің ақ шеттерін қию процедруасы


var
x,y:integer;
function RowIsWhite(letter: TBitmap; y: integer):boolean; //Пикселдер қатары ақ па соны тексереміз
var i: integer;
begin
result:=true;
//ақ түстерді іздеп пикселдерді қарастыру
for i:=0 to letter.Width-1 do if letter.Canvas.Pixels[i,y]<>clWhite then result:=false;
end;

function ColIsWhite(letter: TBitmap; x: integer):boolean; //Пикселдер бағаны ақ па соны тексеру


var i: integer;
begin
result:=true;
//Перебираем пиксели в поисках не белого
for i:=0 to letter.height-1 do if letter.Canvas.Pixels[x,i]<>clWhite then result:=false;
end;

begin
//Убираем белые строки снизы


while RowIsWhite(letter, letter.Height-1) do letter.Height:=letter.Height-1;

//Убираем белые столбцы справа


while ColIsWhite(letter, letter.Width-1) do letter.Width:=letter.Width-1;

//Убираем белые строки сверху


while RowIsWhite(letter,0) do begin
for x:=0 to letter.Width-1 do
for y:=0 to letter.Height-2 do letter.Canvas.Pixels[x,y]:=letter.Canvas.Pixels[x,y+1];
letter.Height:=letter.Height-1;
end;

//Убираем белые столбцы слева


while ColIsWhite(letter,0) do begin
for x:=0 to letter.Width-2 do
for y:=0 to letter.Height-1 do letter.Canvas.Pixels[x,y]:=letter.Canvas.Pixels[x+1,y];
letter.Width:=letter.Width-1;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);


var
SourceImage: TBitmap;
x, y: integer;
begin
LikeBlack:=rgb(150,150,150); //Назначаем условно черный цвет (для краёв букв, где они серые)

//Пишем Image1 в нашу переменную, чтобы сама картинка на форме не пострадала


SourceImage:=TBitmap.Create;
SourceImage.Width:=Image1.Picture.Bitmap.Width;
SourceImage.Height:=Image1.Picture.Bitmap.Height;
for x:=0 to Image1.Picture.Bitmap.Width-1 do
for y:=0 to Image1.Picture.Bitmap.Height-1 do SourceImage.Canvas.Pixels[x,y]:=Image1.Canvas.Pixels[x,y];

//Перебор пикселей


for y:=0 to SourceImage.Height-1 do
for x:=0 to SourceImage.Width-1 do
//Нашли условно черный
if SourceImage.Canvas.Pixels[x,y]begin
//Добавили место для буквы и создали её
SetLength(Letters, Length(Letters)+1);
Letters[Length(Letters)-1]:=TBitmap.Create;
Letters[Length(Letters)-1].Width:=30; //Устанавливаем начальные размеры буквы
Letters[Length(Letters)-1].Height:=30; //Можно установить любые, которые наверняка больше её размеров (если слишком большие - замедлит скорость работы на обрезке белых полей
//Запустили выдиратель буквы
NewLetter(x, y, SourceImage, Letters[Length(Letters)-1]);
//Убираем белые поля
CropLetter(Letters[Length(Letters)-1]);
//Добавляем сообщение-ссылку в листбокс
ListBox1.Items.Add('Буква №'+IntToStr(Length(Letters)));
ListBox1.ItemIndex:=0;
ListBox1.OnClick(ListBox1);
end;
SourceImage.Free;
end;

procedure TForm1.ListBox1DblClick(Sender: TObject);


begin
Form1:=TForm1.Create(Application);
Form1.Caption:=ListBox1.Items[ListBox1.ItemIndex];
Form1.Image1.Width:=Letters[ListBox1.ItemIndex].Width;
Form1.Image1.Height:=Letters[ListBox1.ItemIndex].Height;
Form1.Image1.Picture.Bitmap:=Letters[ListBox1.ItemIndex];
Form1.Show;
end;

procedure TForm1.ListBox1Click(Sender: TObject);


begin
if ListBox1.ItemIndex=-1 then Image2.Visible:=false else
begin
Image2.Visible:=false;
Image2.Width:=Letters[ListBox1.ItemIndex].Width;
Image2.Height:=Letters[ListBox1.ItemIndex].Height;
Image2.Picture.Bitmap:=Letters[ListBox1.ItemIndex];
Image2.Visible:=true;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);


var
c:string;
i,j:integer;
begin
{timer1.Enabled:=true;
timer2.Enabled:=true;}
label1.Caption:=inttostr(ListBox1.Items.Count);
for i:=0 to ListBox1.Items.Count-1 do
begin
j:=j+1;
{while j{SendMessage(ListBox1.Handle, LB_SETCURSEL, i, 0);
Application.ProcessMessages;
Sleep(2000); }
ListBox1.ItemIndex:=i;
Image2.Picture.Bitmap:=Letters[ListBox1.ItemIndex];
{form1.ListBox1Click(Listbox1);}
ListBox1.OnClick(ListBox1);
c:=memo1.Text;
memo1.Text:=GetImageChars(image2.Picture.Bitmap);
memo1.Text:=c+memo1.text;
end;

end;

procedure TForm1.Image2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
Image2.ShowHint:=true;
form1.Image2.Hint:='Ширина= ' + inttostr(form1.Image2.Width) + ' // Высота= ' + inttostr(form1.Image2.Height)
+ ' // Top= ' + inttostr(form1.Image2.Top) + ' // Left= ' + inttostr(form1.Image2.Left);
end;

procedure TForm1.Button3Click(Sender: TObject);


begin
OpenDialog1.InitialDir:=ExtractFilePath(Edit1.Text);
if OpenDialog1.Execute then Edit1.Text:=OpenDialog1.FileName;
end;

procedure TForm1.Edit1Change(Sender: TObject);


begin
if FileExists(Edit1.Text) then Image1.Picture.Bitmap.LoadFromFile(Edit1.Text);
end;

procedure TForm1.Timer1Timer(Sender: TObject);


var
c:string;
i,j,k,m:integer;
begin
for i:=0 to ListBox1.Items.Count-1 do
begin
j:=j+1;
{while j{SendMessage(ListBox1.Handle, LB_SETCURSEL, i, 0);
Application.ProcessMessages;
Sleep(2000); }
ListBox1.ItemIndex:=i;
Image2.Picture.Bitmap:=Letters[ListBox1.ItemIndex];
{form1.ListBox1Click(Listbox1);}
ListBox1.OnClick(ListBox1);
c:=memo1.Text;
memo1.Text:=c+memo1.text;
end;
end;

procedure TForm1.Timer2Timer(Sender: TObject);


begin
button2.Click;
end;

procedure TForm1.Button4Click(Sender: TObject);


var
j, p: integer;
begin
form2.Show;
end;

procedure TForm1.Button5Click(Sender: TObject);


var
WordApp: OleVariant;
begin
WordApp := CreateOLEObject('Word.Application');
WordApp.Documents.Add();
WordApp.Selection.TypeText(Memo1.Text);
WordApp.Visible := true;
end;

procedure TForm1.Button6Click(Sender: TObject);


begin
form1.Close;
form2.Close;
end;

procedure TForm1.Button7Click(Sender: TObject);


begin
dsBinarizeBMP(Image1.Picture.Bitmap);
end;

procedure TForm1.Button8Click(Sender: TObject);


begin
form3.show;
end;
end.


var
Form2: TForm2;
NovSlovo, NovPerevod: String;
i, p, j, h1, h2: integer;
implementation

{$R *.dfm}


procedure TForm2.Button5Click(Sender: TObject);


begin
edit1.PasteFromClipboard;
end;

procedure TForm2.Button2Click(Sender: TObject);


begin
form2.Edit1.clear;
form2.Memo1.Lines.Clear;
j:=-1;
end;

procedure TForm2.FormCreate(Sender: TObject);


begin
form2.ListBox1.Items.LoadFromFile('Slovar.txt');
j:=-1;
h1:=form2.ListBox1.Items.Count;
end;

procedure TForm2.Button1Click(Sender: TObject);


begin
While jbegin
j:=j+1;
p:=Pos(form2.Edit1.Text, form2.ListBox1.Items[j]);
if p>0 then
begin
form2.Memo1.Lines.Clear;
form2.Memo1.Lines.Add(form2.ListBox1.Items[j]);
break;
end;
if j=form2.ListBox1.Items.Count-1 then
begin
if p=0 then
ShowMessage('Не найдено');
end;
end;
form2.ListBox1.ItemIndex:=J;
end;
procedure TForm2.Button3Click(Sender: TObject);
begin
NovPerevod:='';
NovSlovo:='';
i:=-1;
While ibegin
i:=i+1;
NovPerevod:=NovPerevod+form2.Memo1.Lines[i];
end;
NovSlovo:=form2.Edit1.text+' - '+NovPerevod;
form2.ListBox1.Items.Add(NovSlovo);
end;
procedure TForm2.Button4Click(Sender: TObject);
begin
ListBox1.Items.SaveToFile('Slovar.txt');
end;
procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
h2:=form2.ListBox1.Items.Count;
if h2>h1 then
begin
if MessageDlg('Сохранить изменения переводов?', mtConfirmation, [mbYes, mbNo], 0) = mrYes
then
begin
form2.ListBox1.Items.SaveToFile('Slovar.txt');
ShowMessage('Сохранено!');
end;


жүктеу/скачать 2,67 Mb.

Достарыңызбен бөлісу:
1   2   3   4   5   6   7   8



©www.engime.org 2024
әкімшілігінің қараңыз
    Басты бет