Словарь с графической оболочкой
Категория: Delphi/Pascal
2012-01-05 15:17:18
Для компиляции нужны файлы EGAVGA.BGI и GRAPH.TPU. Они должны лежать в папке с компилируемым файлом.
code: #pascal
uses crt,graph; const N=10000; h=5; type slovo=record rus:string; perevod:string; end; Data=array[1..n] of ^slovo; var a:data; f:text; gd,gm:integer; DataCount,poz:integer; FileName,DCount,naity:string; simv,vybor:char; MaxRus:integer; poisk,y,y2:integer; function Rus(mes:string):string; var i:integer; BEGIN for i:=1 to Length(mes) do case mes[i] of 'а'..'п': mes[i]:=Chr(Ord(mes[i])-64); 'р'..'я': mes[i]:=Chr(Ord(mes[i])-16); end; rus:=mes; END; function Prepare(path:string):boolean; begin Prepare:=true; assign(f,path); {$I-} reset(f); {$I+} if IOResult<>0 then begin rewrite(f); Prepare:=false; end; close(f); end; function Fill(var max_length:integer):integer; var tmp,max_str:string; k:integer; begin k:=0; reset(f); while not eof(f) do begin readln(f,tmp); if length(tmp)>0 then begin inc(k); new(a[k]); a[k]^.rus:=copy(tmp,1,pos(' ',tmp)-1); if k>1 then begin if Length(max_str)<Length((a[k]^.rus)) then begin max_str:=a[k]^.rus; max_length:=length(a[k]^.rus); end; end else begin max_str:=a[1]^.rus; max_length:=length(a[1]^.rus); end; a[k]^.perevod:=copy(tmp,pos(' ',tmp)+1,length(tmp)-pos(' ',tmp)); end; end; close(f); Fill:=k; end; procedure Clear; var k:integer; begin for k:=1 to DataCount do Dispose(a[k]); end; procedure LexSort(count:integer; var item:Data); {leksikograficheskoe uporiadochivanie} procedure QuickSort(l,r:integer; var it:Data); var i,j:integer; x:string; y:slovo; begin i:=l; j:=r; x:=it[(l+r) div 2]^.rus; repeat while it[i]^.rus<x do inc(i); while x<it[j]^.rus do dec(j); if i<=j then begin y:=it[i]^; it[i]^:=it[j]^; it[j]^:=y; inc(i); dec(j); end; until i>j; if l<j then QuickSort(l,j,it); if l<r then QuickSort(i,r,it); end; begin QuickSort(1,count,item); end; function BynarSearch(Search:string):integer; {dvoichnyi poisk} var left,right,middle:integer; first,last:integer; begin left:=1; right:=DataCount; repeat middle:=left+(right-left) div 2; if A[middle]^.rus>Search then right:=middle else left:=middle; until right-left<=1; if Search=A[left]^.rus then BynarSearch:=left else if Search=A[right]^.rus then BynarSearch:=right else BynarSearch:=0; end; procedure PaintWindow; begin SetFillStyle(1,White); Bar(8,28,622,452); SetColor(LightBlue); Rectangle(8,28,622,452); Line(311,28,311,452); end; procedure TheEnd; begin Clear; Halt; end; procedure Wait(x_,y_:integer); begin repeat Delay(30000); SetFillStyle(1,LightRed); Bar(x_,y_,x_+5,y_+2); Delay(30000); SetFillStyle(1,White); Bar(x_,y_,x_+5,y_+2); until keypressed; end; function InTextXY(x_,y_:integer; kol_simv:byte; msg:string):string; var tmp:string; ch:char; fl:boolean; begin tmp:=''; InTextXY:='Slovar.txt'; fl:=false; Wait(x_,y_+TextHeight(' ')-4); repeat ch:=readkey; if fl=true then begin Bar(x_,y_,x_+TextWidth(msg)+TextWidth(' '),y_+TextHeight(msg)); fl:=false; end; if ch=#27 then TheEnd; if ch<>#13 then if (ch<>#8) and (length(tmp)<=kol_simv) then tmp:=tmp+ch else if length(tmp)>0 then delete(tmp,length(tmp),1); if length(tmp)<=kol_simv then begin Bar(x_,y_,x_+TextWidth(tmp)+TextWidth(' '),y_+TextHeight(tmp)); OutTextXY(x_,y_,tmp); end; if (ch=#13) and ((length(tmp)=0) or (tmp=' ')) then begin Bar(x_,y_,x_+TextWidth(tmp)+TextWidth(' '),y_+TextHeight(Tmp)); SetColor(LightRed); OutTextXY(x_,y_,msg); SetColor(LightBlue); fl:=true; end; until (ch=#13) and (length(tmp)>0) and (tmp<>' '); InTextXY:=tmp; end; procedure Add(x_,y_:integer; kol_simv:byte; msg:string); var tmp:string; begin x_:=x_+TextWidth(' '); Bar(x_,y_,x_+TextWidth(' ')*kol_simv,y_+TextHeight(' ')); tmp:=InTextXY(x_+8,y_,kol_simv,msg); inc(DataCount); new(a[DataCount]); a[DataCount]^.rus:=naity; a[DataCount]^.perevod:=tmp; append(f); writeln(f,a[DataCount]^.rus,' ',a[DataCount]^.perevod); Close(f); if length(naity)>MaxRus then MaxRus:=length(naity); Bar(312,y_,x_+TextWidth(' ')*kol_simv,y_+TextHeight(' ')); SetColor(Blue); OutTextXY(316,y_,': '+tmp); end; function ChooseSlovar:string; var tmp:string; begin SetFillStyle(1,Yellow); Bar(150,146,472,160); Rectangle(150,146,472,160); SetColor(LightBlue); OutTextXY(254,150,'VYBOR SLOVARIA'); SetFillStyle(1,White); Bar(150,160,472,190); Rectangle(150,160,472,190); FileName:=InTextXY(172,170,35,'Vvedite imia faila-slovaria!'); OutTextXY(171,10,'| File://'+FileName); end; begin DataCount:=0; gd:=detect; initgraph(gd,gm,''); if graphresult<>grok then begin writeln('Oshibka pri zapuske graficheskogo rezhima!'); readln; halt; end else begin SetBkColor(LightCyan); HighVideo; ClearDevice; SetFillStyle(1,Yellow); Bar(8,5,622,21); SetColor(LightBlue); OutTextXY(14,10,'PROGRAMMA "SLOV@R"'); Rectangle(8,5,622,21); SetColor(Blue); OutTextXY(280,460,'ESC-EXIT'); SetColor(LightBlue); ChooseSlovar; PaintWindow; repeat poisk:=0; repeat if Prepare(FileName) then begin DataCount:=Fill(MaxRus); LexSort(DataCount,a); end; SetFillStyle(1,Yellow); Bar(510,9,620,17); SetColor(LightBlue); if DataCount>0 then begin Str(DataCount,DCount); OutTextXY(510,10,DCount+' slov'); end else OutTextXY(510,10,'slovar pust'); y:=h*2*poisk; OutTextXY(12,36+y,'> '); naity:=InTextXY(28,36+y,35,'Vvedite slovo!'); if length(naity)<=MaxRus then begin poz:=0; if DataCount>0 then poz:=BynarSearch(naity); if poz>0 then begin SetColor(Blue); OutTextXY(316,36+y,': '+a[poz]^.perevod); end else begin SetColor(Red); OutTextXY(316,36+y,': Net v slovare. Dobavit? [y/n]'); Wait(572,40+y); vybor:=upcase(readkey); if vybor='Y' then Add(316,36+y,35,'Vvedite perevod slova!') else begin Bar(316,36+y,316+TextWidth(' ')*35,36+y+TextHeight(' ')); OutTextXY(316,36+y,': Net v slovare.'); end; end; end else begin SetColor(Red); OutTextXY(316,36+y,': Net v slovare. Dobavit? [y/n]'); Wait(572,40+y); vybor:=upcase(readkey); if vybor='Y' then Add(316,36+y,35,'Vvedite perevod slova') else begin Bar(316,36+y,316+TextWidth(' ')*35,36+y+TextHeight(' ')); OutTextXY(316,36+y,': Net v slovare.'); end; end; inc(poisk); if poisk=41 then readkey; until poisk=41; poisk:=0; PaintWindow; until h=11; end; TheEnd; end.
автор: delpas
Поделиться: