PDA

View Full Version : Chán quá! Nhờ các pro về pascal - TẠO MENU



langtuhoangthanh
05-12-2009, 08:03
HÔM TRƯỚC POST BÀI NÀY LÊN CÓ MẤY ANH/CHỊ CŨNG GIẢI HỘ EM RỒI NHƯNG...
CHÁN QUÁ PHẢI THI LẠI...
GIỜ LẠI PHAI NHỜ CÁC BÁC GIẢI LẠI HÔH EM .
----------------------------------------------
1. Xây dựng Modul 1 thực hiện các trức năng sau:
- Xác định một số nguyên tố có chính phương hay không?
- In ra màn hình các số chính phương nhỏ hơn giá trị n được nhập từ bàn phím
2. Xây dựng Modul 2 thực hiện các chức năng sau ?
- Giải phương trình bậc nhất ax+b=0 và ghi kết quả vào tệp định kiểu GIAIPTB1.DAT
- Xem tệp GIAIPTB1.DAT vừa ghi ở trên
3. Xây dựng Modil 3 thực hiwnj các chức nămng sau:
- Nhập vào danh sách không quá 20 quyển sách dưới đây . Biết rằngthoong tin của một sách bao gồm: Tên sách , tác giả , năm xuất bản , nhà xuất bản, số lượng sách ,tác giả của mỗi quyển.
Lưu vào file BOOK.DAT
- Tính tổng số đầu sách đã nhập
- Hiển thị danh sách các tác phảm đã xuất bản từ năm 2000 trở lại đây .
4. Xây dưng Menu cho phép chọn 3 Modul trên và chương trình chỉ thoát khi chọn chức năng "Thoát" trong menu chính

nhokdragon94
06-12-2009, 11:14
Bài 1 nè:
Đầu tiên dùng function chinhphuong(n:integer):boolean;
begin
t:=trunc(sqrt(n));
if sqr(t)=n then chinhphuong:=true
else chinhphuong:=false;
end;
Rùi xong
Chương trình chính lôi function ra
Mà cho mình hỏi bạn cái này: số nguyên tố là số chia hết 1 và chính nó thì làm sao là số chính phương đc ^^!

1024KB
06-12-2009, 13:18
Cái này mình viết trong mấy tiếng.


program module;
type sach = record
tensach:string[50];
tacgia:string[50];
namxb:integer;
soluong:integer;
end;
var f:TEXT;
book:sach;
sosach,chon:integer;
bf: File Of sach;

//Chương trình con

//kiểm tra số chính phương

function chinhphuong(n:integer):boolean;
var OK:boolean;
begin
OK:=false;
if (sqr(trunc(sqrt(n)))=n) then
OK:=true;
chinhphuong:=OK;
end;

//kiểm tra số nguyên tố

function nguyento(n:integer):boolean;
var OK:boolean; d,i:integer;
begin
d:=0;
OK:=false;
for i:=1 to n div 2 do
if n mod i = 0 then inc(d);

if d=1 then OK:=true;
nguyento:=OK;
end;

//Chương trình kiểm tra

procedure kiemtra;
var n,i:integer;
begin
write('Moi ban nhap 1 so: ');
readln(n);
if nguyento(n) then
begin
if chinhphuong(n) then
writeln(n,' la so nguyen to chinh phuong.')
else
writeln(n,' la so nguyen to khong chinh phuong.');
end
else
writeln(n,' khong la so nguyen to.');

for i:=1 to n do
if chinhphuong(i) then
write(i:5);
end;

//chương trình bậc nhất

procedure ptbac1;
var a,b:integer; x:real; s:string[50];
begin
write('Nhap a:');readln(a);
write('Nhap b:');readln(b);
assign(f,'GIAIPT1.DAT');
rewrite(f);
if(a<>0) then
begin
s:='Phuong trinh co nghiem: ';
x:=-b/a;
//ghi file
write(f,s,x);
end
else
begin
if(b=0) then
s:='Phuong trinh vo so nghiem'
else
s:='Phuong trinh vo nghiem';
//ghi file
write(f,s);
end;
//đóng file
close(f);
end;

//Chương trình sách

procedure nhapds;
var ans:char; //ans = answer ^^!
begin
assign(bf,'BOOK.DAT');
rewrite(bf);
sosach:=0;
writeln('Nhap danh sach thong tin: ');
repeat
write('Ten sach: ');readln(book.tensach);
write('Tac gia: ');readln(book.tacgia);
write('Nam xuat ban: ');readln(book.namxb);
write('So luong: ');readln(book.soluong);
sosach:=sosach+1;
//ghi file
write(bf,book);
write('So tiep tuc nhap khong? (Y/N)');
readln(ans);
until upcase(ans)='N';
//đóng file
close(bf);

writeln('So sach da nhap: ',sosach);
end;

//Module xem sách

procedure xemds;
begin
assign(bf,'BOOK.DAT');
reset(bf);
writeln('Ten sach Tac gia Nam XB So luong');
while not eof(bf) do
begin
read(bf,book);
if(book.namxb > 2000) then
write(book.tensach,' ',book.tacgia,' ',book.namxb,' ',book.soluong);
end;
//đóng file
close(bf);
end;

//Module MENU

procedure thucdon(var chon:integer);
begin
writeln('--- MENU CHUONG TRINH ---');
writeln('1.Kiem tra so nguyen to chinh phuong?');
writeln('2.Giai phuong trinh bac nhat.');
writeln('3.Nhap danh sach.');
writeln('4.Thoat');
write('Moi ban chon: ');readln(chon);
end;

//Chương trình chính

Begin
repeat
thucdon(chon);
case chon of
1: kiemtra;
2: ptbac1;
3: begin
nhapds;
xemds;
end;
end;
until chon=4;
readln;
end.

Định gửi kèm file nhưng dd không cho gửi :D

nhokdragon94
06-12-2009, 14:35
Ơ pác nói câu trả lời nào hoàn hảo zậy. Nếu pác nói em thì sao pác lại đưa code như thía này:
procedure kiemtra;
var n,i:integer;
begin
write('Moi ban nhap 1 so: ');
readln(n);
if nguyento(n) then
begin
if chinhphuong(n) then
writeln(n,' la so nguyen to chinh phuong.')
else
writeln(n,' la so nguyen to khong chinh phuong.');
end
else
writeln(n,' khong la so nguyen to.');

for i:=1 to n do
if chinhphuong(i) then
write(i:5);
end;

===>>Là số ng/tố chính phương :-?

1024KB
06-12-2009, 17:00
Hờ hờ. Số nguyên tố thì không là số chính phương được. Không đọc kỹ :D. Chỉ làm theo đề bài. Có thể đề bài là: kiểm tra số có phải là nguyên tố, chính phương không? Chỉ chỉnh lại code chút xíu thôi. Chủ topic kiểm tra lại đề bài đi nhé. Khả năng không chép kỹ đề bài đấy.


program module;
type sach = record
tensach:string[50];
tacgia:string[50];
namxb:integer;
soluong:integer;
end;
var f:TEXT;
book:sach;
sosach,chon:integer;
bf: File Of sach;

//Chương trình con

//kiểm tra số chính phương

function chinhphuong(n:integer):boolean;
var OK:boolean;
begin
OK:=false;
if (sqr(trunc(sqrt(n)))=n) then
OK:=true;
chinhphuong:=OK;
end;

//kiểm tra số nguyên tố

function nguyento(n:integer):boolean;
var OK:boolean; d,i:integer;
begin
d:=0;
OK:=false;
for i:=1 to n div 2 do
if n mod i = 0 then inc(d);

if d=1 then OK:=true;
nguyento:=OK;
end;

//Chương trình kiểm tra

procedure kiemtra;
var n,i:integer;
begin
write('Moi ban nhap 1 so: ');
readln(n);
if nguyento(n) then
writeln(n,' la so nguyen to.')
else
writeln(n,' khong la so nguyen to.');
if chinhphuong(n) then
writeln(n,' la so chinh phuong.')
else
writeln(n,' ko la so chinh phuong.');

for i:=1 to n do
if chinhphuong(i) then
write(i:5);
end;

//chương trình bậc nhất

procedure ptbac1;
var a,b:integer; x:real; s:string[50];
begin
write('Nhap a:');readln(a);
write('Nhap b:');readln(b);
assign(f,'GIAIPT1.DAT');
rewrite(f);
if(a<>0) then
begin
s:='Phuong trinh co nghiem: ';
x:=-b/a;
//ghi file
write(f,s,x);
end
else
begin
if(b=0) then
s:='Phuong trinh vo so nghiem'
else
s:='Phuong trinh vo nghiem';
//ghi file
write(f,s);
end;
//đóng file
close(f);
end;

//Chương trình sách

procedure nhapds;
var ans:char; //ans = answer ^^!
begin
assign(bf,'BOOK.DAT');
rewrite(bf);
sosach:=0;
writeln('Nhap danh sach thong tin: ');
repeat
write('Ten sach: ');readln(book.tensach);
write('Tac gia: ');readln(book.tacgia);
write('Nam xuat ban: ');readln(book.namxb);
write('So luong: ');readln(book.soluong);
sosach:=sosach+1;
//ghi file
write(bf,book);
write('So tiep tuc nhap khong? (Y/N)');
readln(ans);
until upcase(ans)='N';
//đóng file
close(bf);

writeln('So sach da nhap: ',sosach);
end;

//Module xem sách

procedure xemds;
begin
assign(bf,'BOOK.DAT');
reset(bf);
writeln('Ten sach Tac gia Nam XB So luong');
while not eof(bf) do
begin
read(bf,book);
if(book.namxb > 2000) then
write(book.tensach,' ',book.tacgia,' ',book.namxb,' ',book.soluong);
end;
//đóng file
close(bf);
end;

//Module MENU

procedure thucdon(var chon:integer);
begin
writeln('--- MENU CHUONG TRINH ---');
writeln('1.Kiem tra so nguyen to chinh phuong?');
writeln('2.Giai phuong trinh bac nhat.');
writeln('3.Nhap danh sach.');
writeln('4.Thoat');
write('Moi ban chon: ');readln(chon);
end;

//Chương trình chính

Begin
repeat
thucdon(chon);
case chon of
1: kiemtra;
2: ptbac1;
3: begin
nhapds;
xemds;
end;
end;
until chon=4;
readln;
end.

lamthithom
07-12-2009, 13:23
Giúp em với
Em mới học pascal mà thầy cho bài tập khó quá
--->>>>> KISS .....KISSS
1.Xây dụng module 1 thực hiện chức năng sau.
-Nhập vào 2 số nguyên dương bất kỳ
-Tìm và in ra ÚCLN của 2 số đó
2.Xây dưng module 2 thức hiện các chức năng sau
-Nhập vào dãy số nguyên, ghi các số vừa đọc vàp têp SNGUYEN5.DAT
-Tìm các phẩn tử là số chính phương trong các số đã cho và in ra mang hình số chính phương đó.
3.Xây dụng module 3 thực hiện các chức năng sau
-Viết phương trình tạo tệp, mỗi phần tử là một bản ghi biểu diễn thông tin của học sinh gồm:
+Họ tên
+Ngày tháng năm sinh
+lớp
+xếp loại văn hoá
-Chương trình làm nhiệm vụ quản lý một danh sách thông qua các menu sau:
a.Nhập học sinh mới
b.Xem danh sách
c.Tìm theo tên học sinh
d.Tìm theo ngày tháng năm sinh
e.Thoát khỏi chương trình
4.Xây dựng module cho phép lựa chọn 3 module trên và trương trình chỉ thoát khi chọn chức năng thoát trong menu chính

[=========> Bổ sung bài viết <=========]

Ai giúp em thì send file vào mail cho em với em đang cần gấp

[=========> Bổ sung bài viết <=========]

lamthom2010@yahoo.com.vn

langtuhoangthanh
09-12-2009, 08:00
Đề đúng là như vậy mà


Hờ hờ. Số nguyên tố thì không là số chính phương được. Không đọc kỹ :D. Chỉ làm theo đề bài. Có thể đề bài là: kiểm tra số có phải là nguyên tố, chính phương không? Chỉ chỉnh lại code chút xíu thôi. Chủ topic kiểm tra lại đề bài đi nhé. Khả năng không chép kỹ đề bài đấy.


program module;
type sach = record
tensach:string[50];
tacgia:string[50];
namxb:integer;
soluong:integer;
end;
var f:TEXT;
book:sach;
sosach,chon:integer;
bf: File Of sach;

//Chương trình con

//kiểm tra số chính phương

function chinhphuong(n:integer):boolean;
var OK:boolean;
begin
OK:=false;
if (sqr(trunc(sqrt(n)))=n) then
OK:=true;
chinhphuong:=OK;
end;

//kiểm tra số nguyên tố

function nguyento(n:integer):boolean;
var OK:boolean; d,i:integer;
begin
d:=0;
OK:=false;
for i:=1 to n div 2 do
if n mod i = 0 then inc(d);

if d=1 then OK:=true;
nguyento:=OK;
end;

//Chương trình kiểm tra

procedure kiemtra;
var n,i:integer;
begin
write('Moi ban nhap 1 so: ');
readln(n);
if nguyento(n) then
writeln(n,' la so nguyen to.')
else
writeln(n,' khong la so nguyen to.');
if chinhphuong(n) then
writeln(n,' la so chinh phuong.')
else
writeln(n,' ko la so chinh phuong.');

for i:=1 to n do
if chinhphuong(i) then
write(i:5);
end;

//chương trình bậc nhất

procedure ptbac1;
var a,b:integer; x:real; s:string[50];
begin
write('Nhap a:');readln(a);
write('Nhap b:');readln(b);
assign(f,'GIAIPT1.DAT');
rewrite(f);
if(a<>0) then
begin
s:='Phuong trinh co nghiem: ';
x:=-b/a;
//ghi file
write(f,s,x);
end
else
begin
if(b=0) then
s:='Phuong trinh vo so nghiem'
else
s:='Phuong trinh vo nghiem';
//ghi file
write(f,s);
end;
//đóng file
close(f);
end;

//Chương trình sách

procedure nhapds;
var ans:char; //ans = answer ^^!
begin
assign(bf,'BOOK.DAT');
rewrite(bf);
sosach:=0;
writeln('Nhap danh sach thong tin: ');
repeat
write('Ten sach: ');readln(book.tensach);
write('Tac gia: ');readln(book.tacgia);
write('Nam xuat ban: ');readln(book.namxb);
write('So luong: ');readln(book.soluong);
sosach:=sosach+1;
//ghi file
write(bf,book);
write('So tiep tuc nhap khong? (Y/N)');
readln(ans);
until upcase(ans)='N';
//đóng file
close(bf);

writeln('So sach da nhap: ',sosach);
end;

//Module xem sách

procedure xemds;
begin
assign(bf,'BOOK.DAT');
reset(bf);
writeln('Ten sach Tac gia Nam XB So luong');
while not eof(bf) do
begin
read(bf,book);
if(book.namxb > 2000) then
write(book.tensach,' ',book.tacgia,' ',book.namxb,' ',book.soluong);
end;
//đóng file
close(bf);
end;

//Module MENU

procedure thucdon(var chon:integer);
begin
writeln('--- MENU CHUONG TRINH ---');
writeln('1.Kiem tra so nguyen to chinh phuong?');
writeln('2.Giai phuong trinh bac nhat.');
writeln('3.Nhap danh sach.');
writeln('4.Thoat');
write('Moi ban chon: ');readln(chon);
end;

//Chương trình chính

Begin
repeat
thucdon(chon);
case chon of
1: kiemtra;
2: ptbac1;
3: begin
nhapds;
xemds;
end;
end;
until chon=4;
readln;
end.