Poll

Theo bạn logo nào thích hợp cho diễn đàn

67% 67% [ 8 ]
33% 33% [ 4 ]

Tổng số bầu chọn : 12


Từ điển bằng Pascal

Xem chủ đề cũ hơn Xem chủ đề mới hơn Go down

Từ điển bằng Pascal

Bài gửi by lananh on 16/5/2010, 4:13 pm

Chương trình ứng dụng sử dụng ngôn ngữ lập trình Pascal để tạo một từ điển nhỏ Anh-Việt. Tuy còn hạn chế nhưng đây là thành quả lao động vất vả của thầy trò mình trong hơn một tháng.Bạn nào muốn tìm hiểu thêm thì liên hệ mình qua Y!M
Program Mouse;
Uses crt,dos,graph;
Var
regs : Registers; {50}
Grdriver,GrMode:integer;
a,b,c,d,ok:boolean;
vtx,vty:integer;
s:string[12];
s1,s2:string[33];
f:text;
Procedure InitMouse;
Begin
Regs.Ax := $00;
Intr($33, Regs);
End;
Procedure MouseShow;
Begin
Regs.AX := $01;
Intr($33, Regs);
End;
Procedure MouseHide;
Begin
Regs.AX := $02;
Intr($33, Regs);
End;
Procedure MouseGetPosition(var x, y: Integer);
Begin
Regs.AX := $03;
Intr($33, Regs);
x:= Regs.CX;
y:= Regs.DX;
End;
Function MouseLPress(var x, y : Integer): Boolean;
Begin
Regs.AX := $03;
Intr($33, Regs);
x := Regs.CX;
y := Regs.DX;
If Regs.BX=1 then MouseLPress:=True
else MouseLPress:= False;
End;
Function MouseLPress1: Boolean;
Begin
Regs.AX := $03;
Intr($33, Regs);
If Regs.BX=1 then
begin
MouseLPress1:=True;
end
else
begin
MouseLPress1:= False;
end;
End;
Function MouseRPress(var x, y : Integer): Boolean;
Begin
Regs.AX := $03;
Intr($33, Regs);
If Regs.BX = 2 then MouseRPress :=True
else MouseRPress:= False;
x := Regs.CX; y := Regs.DX;
End;
Procedure MouseSetPosition(x,y: integer);
begin
Regs.AX := $03;
Intr($33, Regs);
Regs.CX:=x;
Regs.DX:=y;
end;
Procedure MouseLimit(xt, yt, xd, yd: Integer);
Begin
Regs.AX := 07;
Regs.CX := xt;
Regs.DX := xd;
Intr($33, Regs);
Regs.AX := 08;
Regs.CX := yt;
Regs.DX := yd;
Intr($33, Regs);
End;
Function PointInBar(x,y,x1,y1,x2,y2:integer):boolean;
begin
MouseGetPosition(x,y);
if (x>=x1) and (y>=y1) and (x<=x2) and (y<=y2) then
PointInBar:=true
else
PointInBar:=false;
end;
Procedure CreateBar(x1,y1,x2,y2,x3,y3,color:integer;name:string);
begin
bar(x1,y1,x2,y2);
setcolor(color);
Outtextxy(x3,y3,name);
end;
Procedure DoiMauNut(color:integer);
begin
setcolor(color);
setfillStyle(1,color);
end;
Procedure Kiemtra(a,b,c:boolean);
begin
if (a=false) and (b=false) and (c=false) then
begin
DoiMauNut(4);
CreateBar(10,30,80,90,15,50,2,'Nhap tu');
CreateBar(85,30,165,90,87,50,2,'Tim kiem');
CreateBar(170,30,260,90,175,50,2,'ReFresh');
CreateBar(265,30,350,90,275,50,2,'Ket thuc');
end
else
if (a=true) and (b=false) and (c=false) then
begin
DoiMauNut(2);
CreateBar(10,30,80,90,15,50,4,'Nhap tu');
DoiMauNut(4);
CreateBar(85,30,165,90,87,50,2,'Tim kiem');
CreateBar(170,30,260,90,175,50,2,'ReFresh');
CreateBar(265,30,350,90,275,50,2,'Ket thuc');
end
else
if (a=false) and (b=true) and (c=false) then
begin
DoiMauNut(2);
CreateBar(85,30,165,90,87,50,4,'Tim kiem');
DoiMauNut(4);
CreateBar(10,30,80,90,15,50,2,'Nhap tu');
CreateBar(170,30,260,90,175,50,2,'ReFresh');
CreateBar(265,30,350,90,275,50,2,'Ket thuc');
end;
end;
function nhapchu(s:string):string;
begin
if(KeyPressed) then
begin
Case ord(readkey) of {lay ma Asscii cua ki tu doc tu readkey}
97:Insert('a',S,length(s)+1);
98:Insert('b',S,length(s)+1);
99:Insert('c',S,length(S)+1);
100:Insert('d',S,length(S)+1);
101:Insert('e',S,length(S)+1);
102:Insert('f',S,length(S)+1);
103:Insert('g',S,length(S)+1);
104:Insert('h',S,length(S)+1);
105:Insert('i',S,length(S)+1);
106:Insert('j',S,length(S)+1);
107:Insert('k',S,length(S)+1);
108:Insert('l',S,length(S)+1);
109:Insert('m',S,length(S)+1);
110:Insert('n',S,length(S)+1);
111:Insert('o',S,length(S)+1);
112:Insert('p',S,length(S)+1);
113:Insert('q',S,length(S)+1);
114:Insert('r',S,length(S)+1);
115:Insert('s',S,length(S)+1);
116:Insert('t',S,length(S)+1);
117:Insert('u',S,length(S)+1);
118:Insert('v',S,length(S)+1);
119:Insert('w',S,length(S)+1);
120:Insert('x',S,length(S)+1);
121:Insert('y',S,length(S)+1);
122:Insert('z',S,length(S)+1);
32:Insert(' ',S,length(S)+1);{ma Accii khoang trang la 32}
44:Insert(',',S,length(S)+1);{ma Accii , la 44}
end;
end;
nhapchu:=s;
end;
Procedure vekhung;
begin
setcolor(4);
Rectangle(10,160,100,450);
Rectangle(12,162,102,452);
Rectangle(103,160,273,450);
Rectangle(105,162,275,452);
Rectangle(275,160,470,450);
Rectangle(277,162,470,452);
Outtextxy(10,150,'Tu Tieng Anh');
Outtextxy(140,150,'Nghia Cua Tu');
Outtextxy(350,150,'Vi Du');
end;
Procedure vekhungkhinhap;
begin
setcolor(4);
Rectangle(10,300,100,450);
Rectangle(12,302,102,452);
Rectangle(103,300,273,450);
Rectangle(105,302,275,452);
Rectangle(275,300,470,450);
Rectangle(277,302,470,452);
Outtextxy(10,290,'Tu Tieng Anh');
Outtextxy(140,290,'Nghia Cua Tu');
Outtextxy(350,290,'Vi Du');
end;
Procedure nhapfileTuDien;
var tienganh,tiengviet,vidu:string;
dem:integer;
begin
dem:=10;
reset(f);
while not Eof(f) do
begin
readln(f,tienganh);
readln(f,tiengviet);
readln(f,vidu);
setcolor(15);
outtextxy(15,160+dem,tienganh);{ xuat tu tieng anh len khung}
Outtextxy(110,160+dem,tiengviet);{ xuat nghia tu len khung}
Outtextxy(280,160+dem,vidu);{ xuat vi du len khung}
dem:=dem+10;
if (dem= 300) then
exit;
end;
close(f);
end;
Procedure nhapfileTuDienNhapTu;
var tienganh,tiengviet,vidu:string;
dem:integer;
begin
dem:=0;
reset(f);
while not Eof(f) do
begin
readln(f,tienganh);
readln(f,tiengviet);
readln(f,vidu);
setcolor(15);
outtextxy(15,310+dem,tienganh);{ xuat tu tieng anh len khung}
Outtextxy(110,310+dem,tiengviet);{ xuat nghia tu len khung}
Outtextxy(280,310+dem,vidu);{ xuat vi du len khung}
dem:=dem+10;
if (dem=100) then
exit;
end;
close(f);
end;
Procedure themtu(a,b,c:string);
begin
append(f);
writeln(f,a);
writeln(f,b);
writeln(f,c);
close(f);
end;
Procedure Refresh;
begin
a:=false;
b:=false;
c:=false;
d:=false;
s:='';
s1:='';
s2:='';
end;
Procedure timkiem(a:string;kt:integer);
var tienganh,tiengviet,vidu:string;
dem:integer;
begin
reset(f);
dem:=0;
while not eof(f) do
begin
readln(f,tienganh);
readln(f,tiengviet);
readln(f,vidu);
if pos(a,tienganh)=1 then
begin
if kt=0 then
begin
outtextxy(15,170+dem,tienganh);{ xuat tu tieng anh len khung}
Outtextxy(110,170+dem,tiengviet);{ xuat nghia tu len khung}
Outtextxy(280,170+dem,vidu);{ xuat vi du len khung}
dem:=dem+10;
end
else
begin
outtextxy(15,170,tienganh);{ xuat tu tieng anh len khung}
Outtextxy(110,170,tiengviet);{ xuat nghia tu len khung}
Outtextxy(280,170,vidu);{ xuat vi du len khung}
exit;
end;
end;
end;
end;
Procedure timkiemchinhxac(a:string);
var tienganh,tiengviet,vidu:string;
begin
reset(f);
while not eof(f) do
begin
readln(f,tienganh);
readln(f,tiengviet);
readln(f,vidu);
if a=tienganh then
begin
outtextxy(15,170,tienganh);{ xuat tu tieng anh len khung}
Outtextxy(110,170,tiengviet);{ xuat nghia tu len khung}
Outtextxy(280,170,vidu);{ xuat vi du len khung}
exit;
end;
end;
outtextxy(15,170,'khong co');{ xuat tu tieng anh len khung}
Outtextxy(110,170,'khong co');{ xuat nghia tu len khung}
Outtextxy(280,170,'khong co');{ xuat vi du len khung}
end;
Begin
clrscr;
assign(f,'D:\tudien.txt');
{$I-}
Reset(f);
{$I+}
if IOResult <>0 then
begin
assign(f,'D:\tudien.txt');
rewrite(f);
end;
grDriver:=Detect;
Initgraph(grDriver,grMode,'..\BGI');
a:=false;
b:=false;
c:=false;
d:=false;
S:='';
Repeat
mouseshow;
mouselimit(0,0,640,480);
MouseSetPosition(0,0);
if d=true then
begin
timkiemchinhxac(S);
end;
if (a=false) and (b=false) and (c=false) then
begin
kiemtra(false,false,false);
vekhung;
nhapfileTudien;
end
else
if (a=true) and (b=false) and (c=false) then
begin
Vekhungkhinhap;
d:=false;
NhapfileTuDienNhapTu;
kiemtra(true,false,false);
Outtextxy(10,130,'Go tu can nhap:');
Rectangle(140,120,250,140);
Outtextxy(10,160,'Nhap nghia tu:');
Rectangle(140,150,400,190);
Outtextxy(10,210,'Nhap vi du:');
Rectangle(140,200,400,240);
Doimaunut(2);
CreateBar(255,120,290,140,265,130,4,'OK');
CreateBar(295,120,350,140,305,130,4,'<--');
CreateBar(410,150,460,170,420,160,4,'<--');
CreateBar(410,220,460,240,420,230,4,'<--');
{ khi con tro nam trong khung go tu can nhap }
if PointInBar(vtx,vty,140,120,250,140)=true then
begin
setcolor(15);
S:=nhapchu(s);
end
else
{ khi con tro nam trong khung nhap nghia tu }
if PointInBar(vtx,vty,140,150,400,190)=true then
begin
setcolor(15);
S1:=nhapchu(s1);
end
else
{ khi con tro nam trong khung vi du }
if PointInBar(vtx,vty,140,200,400,240)=true then
begin
setcolor(15);
S2:=nhapchu(s2);
end;
Outtextxy(150,130,S);
Outtextxy(140,160,S1);
Outtextxy(140,220,S2);
{khi nhan nut <--}
if (PointInBar(vtx,vty,295,120,350,140)=true) and (MouseLPress1=true) then
Delete(S,length(s),1);
{khi nhan nut <--}
if (PointInBar(vtx,vty,410,150,460,170)=true) and (MouseLPress1=true) then
Delete(S1,length(s1),1);
{khi nhan nut <--}
if (PointInBar(vtx,vty,410,220,460,240)=true) and (MouseLPress1=true) then
Delete(S2,length(s2),1);
{ khi nhan nut OK}
if (PointInBar(vtx,vty,255,120,290,140)=true) and (MouseLPress1=true) then
begin
themtu(S,S1,S2);
end;
{khi nhan nut <-- tren phim
if PointInBar(vtx,vty,140,120,250,140)=true then
if keypressed then
if ord(readkey) = 8 then
Delete(S,length(s),1);
{khi nhan nut <-- tren phim
if PointInBar(vtx,vty,140,150,400,190)=true then
if keypressed then
if ord(readkey) = 8 then
Delete(S1,length(s1),1);
{khi nhan nut <-- tren phim
if PointInBar(vtx,vty,140,200,400,240)=true then
if keypressed then
if ord(readkey) = 8 then
Delete(S2,length(s2),1);
{ khi nhan nut OK}
end
else
begin
Vekhung;
kiemtra (false,true,false);
{tao khung cac nut can tim kiem}
Outtextxy(10,130,'Go tu can tim:');
Rectangle(140,120,250,140);
Doimaunut(2);
CreateBar(255,120,290,140,265,130,4,'OK');
CreateBar(295,120,350,140,305,130,4,'<--');
S:=nhapchu(s);
setcolor(15);
Outtextxy(150,130,S);
if d=false then
timkiem(S,0);
{nhap nut <-- de xoa tung ki tu tu}
if (PointInBar(vtx,vty,295,120,350,140)=true)
and (MouseLPress1=true) then
begin
Delete(S,length(s),1);
d:=false;
end;
{khi nhap nut Ok bat dau tim}
if (PointInBar(vtx,vty,255,120,290,140)=true)
and (MouseLPress1=true) then
begin
timkiemchinhxac(s);
d:=true;
end
end;
{khi nhap chuot trai vao nut nhap tu}
if (PointInBar(vtx,vty,10,30,80,90)=true)
and (MouseLPress1=true) then
begin
a:=true; b:=false;c:=false;
kiemtra(a,b,c);
end;
{khi nhap chuot trai vao o tim kiem}
if (PointInBar(vtx,vty,85,30,165,90)=true)
and (MouseLPress1=true) then
begin
a:=false; b:=true;c:=false;
kiemtra(a,b,c);
end;
{khi nhap chuot trai vao nut ReFresh}
if (PointInBar(vtx,vty,170,30,260,90)=true)
and (MouseLPress1=true) then
Refresh;
{nhap nut ESC thoat ra}
if keypressed then
if ord(readkey)=27 then exit;
{khi nhap chuot trai vao nut Exit}
if (PointInBar(vtx,vty,265,30,350,90)=true)
and (MouseLPress1=true) then
begin
exit;
end;
delay(100);
cleardevice;
until false;
readln;
closeGraph;
end.

_________________

jiao sư tóc quăn

lananh
Lớp phó học tập
Lớp phó học tập

Tổng số bài gửi : 164
Điểm tích cực : 178
Điểm danh vọng : 15
Registration date : 04/01/2009
Age : 23
Đến từ : THPT Long Cang

Xem lý lịch thành viên http://www.hocmai.com.vn

Về Đầu Trang Go down

Re: Từ điển bằng Pascal

Bài gửi by smsinfo on 24/5/2010, 10:32 am

Oài, thế dữ liệu đâu bạn ới

smsinfo
Mới lọt lòng
Mới lọt lòng

Tổng số bài gửi : 4
Điểm tích cực : 4
Điểm danh vọng : 0
Registration date : 24/05/2010
Age : 21
Đến từ : VietNam

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Từ điển bằng Pascal

Bài gửi by lananh on 2/6/2010, 11:15 am

Dữ liệu là một file text có dạng:

dinosaur
loai khung long
dinosaur is extint about 65 millions years ago
extint
su tuyet chung
what do you know about the dinosaur's extint ?
universe
vu tru
the original of our universe is still a secret
planet
hanh tinh
the earth is the third plannet from the sun
america
nuoc my, hoa ky
america is discoveried by a greek, isn't it ?
continent
chau luc
we have six continents
water
nuoc
water holds three-fourth of earth surface area

Cứ ba dòng ta dc một từ can tìm .Máy sẽ chạy từ đầu đến cuối trúng từ tiếng anh nào thì nó sẽ lôi từ tiếng việt và ví dụ tương ứng.

_________________

jiao sư tóc quăn

lananh
Lớp phó học tập
Lớp phó học tập

Tổng số bài gửi : 164
Điểm tích cực : 178
Điểm danh vọng : 15
Registration date : 04/01/2009
Age : 23
Đến từ : THPT Long Cang

Xem lý lịch thành viên http://www.hocmai.com.vn

Về Đầu Trang Go down

Re: Từ điển bằng Pascal

Bài gửi by Sponsored content Today at 2:21 am


Sponsored content


Về Đầu Trang Go down

Xem chủ đề cũ hơn Xem chủ đề mới hơn Về Đầu Trang


 
Permissions in this forum:
Bạn không có quyền trả lời bài viết