Bài 17: Chương trình con và phân loại

hacker
Program Piano; uses crt,graph; const SoPhim = 14; Phim: array[1..SoPhim] of char = ('a','s','d','f','g','h','j', '1','2','3','4','5','6','7'); TenNot: array[1..SoPhim] of string[3] = ('Do','Re','Mi','Fa', 'Sol','La','Si','Do"','Re"','Mi"','Fa"','Sol"','La"','Si"'); AmThanh: array[1..SoPhim] of integer = (131,147,165,175,196,220, 247,262,294,330,349,392,440,494); CRong = 30; Cdai = 100; KCNgang = 80; KCDoc = 150; _MauPhim = LightGreen; var gd,gm: integer; MauPhim: array[1..SoPhim] of integer; k: char; TgPhat: integer; f: text; GA,Playing: Boolean; Procedure InPhimDan(i: integer); Begin if MauPhim[i] = _MauPhim then SetFillStyle(1,_MauPhim) else SetFillStyle(1,White); bar(KCNgang+i*CRong,KCDoc,KCNgang+(i+1)*CRong,KCDoc + CDai); SetFillStyle(1,8); bar(KCNgang+i*CRong,KCdoc + CDai,KCNgang+(i+1)*CRong, KCDoc + CDai + 5); SetFillStyle(1,LightGray); bar(KCNgang+i*CRong,KCdoc + CDai+5,KCNgang+(i+1)*CRong, KCDoc + CDai + 10); SetColor(Black); Rectangle(KCNgang+i*CRong,KCDoc,KCNgang+(i+1)*CRong,KCDoc + CDai+10); SetColor(Blue); OutTextXY(KCNgang+i*30+15,KCDoc+70,Phim[i]); OutTextXY(KCNgang+i*30+5,KCDoc+20,TenNot[i]); End; Procedure TaoDan; var i: integer; Begin SetFillStyle(1,Cyan); Bar(KCNgang + CRong - 10,KCDoc - 10,KCNgang + CRong*(SoPhim+1)+10,KCDoc+CDai+20); for i := 1 to SoPhim do InPhimDan(i); Setcolor(Brown); SetTextStyle(DefaultFont, HorizDir,3); OutTextXy(200,100,'P I A N O'); SetTextStyle(DefaultFont, HorizDir,1); OutTextXy(200,320,'Turn off VietKey before hitting.'); End; Procedure ShowDan; var trdo: string; Begin SetfillStyle(1,LightGreen); Bar(KCNgang+CRong,KCDoc+Cdai+20,KCNgang + (SoPhim+1)*Crong,KCDoc+CDai+60); {--Record--} SetFillStyle(1,Red); Bar(KCNgang+CRong+20,KCdoc + CDai+25,KCNgang+CRong+80,KCDoc+CDai+55); Setcolor(Black); if not GA then OutTextXy(KCNgang+CRong+25,KCdoc + CDai+30,'Record') else OutTextXy(KCNgang+CRong+25,KCdoc + CDai+30,'Rec...'); OutTextXy(KCNgang+CRong+30,KCdoc + CDai+45,'( R )'); {--Truong Do--} SetFillStyle(1,Blue); Bar(KCNgang+CRong*(SoPhim+1)-80,KCdoc + CDai+25, KCNgang+CRong*(SoPhim+1)-10,KCDoc+CDai+55); Setcolor(Black); OutTextXy(KCNgang+CRong*(SoPhim+1)-70,KCdoc + CDai+35,'T: '); Str(TgPhat,trDo); OutTextXy(KCNgang+CRong*(SoPhim+1)-50,KCdoc + CDai+35,trdo); {--Play--} SetFillStyle(1,Yellow); Bar(KCNgang+CRong+170,KCdoc + CDai+25,KCNgang+CRong+230,KCDoc+CDai+55); Setcolor(Black); if not Playing then OutTextXy(KCNgang+CRong+185,KCdoc + CDai+30,'Play') else OutTextXy(KCNgang+CRong+185,KCdoc + CDai+30,'Stop'); OutTextXy(KCNgang+CRong+180,KCdoc + CDai+45,'( P )'); End; Procedure GhiAm(kt:string;Am: integer); var s: array[1..3000] of string[4]; i,j: integer; Begin reset(f); i := 0; repeat inc(i); Readln(f,s[i]); until s[i] = ''; rewrite(f); for j := 1 to i-1 do writeln(f,s[j]); if kt = '' then Writeln(f,Am) else Writeln(f,kt,Am); Close(f); End; Procedure Play; var s: string; i,c,j:integer; Begin reset(f); repeat readln(f,s); Val(s,i,c); if c = 0 then begin Sound(AmThanh[i]); for j := 1 to SoPhim do if i = j then begin MauPhim[j] := _MauPhim; InPhimDan(j); end else if MauPhim[j] = _MauPhim then begin MauPhim[j] := White; InPhimDan(j); end; end else begin Val(Copy(s,2,Length(s)),i,c); Delay(i); NoSound; end; k := #0; if keypressed then k := readkey; until (s = '') or (k = 'p'); Playing := False; ShowDan; End; Procedure TruongDo; Begin if (k = #72) or (k = #80) then begin if (k = #72) and (TgPhat < 400) then inc(TgPhat,50) else if (k = #80) and (TgPhat > 50) then inc(TgPhat,-50); ShowDan; end; End; Procedure BatGhiAm; Begin if k = 'r' then begin if not GA then ReWrite(f); GA := not GA; ShowDan; end else if k = 'p' then begin Playing := True;ShowDan;Play;end; End; Procedure DanhDan; var i: integer; Begin k := #0; if keypressed then begin k := readkey;TruongDo;BatGhiAm;end; for i := 1 to SoPhim do begin if k = Phim[i] then begin MauPhim[i] := _MauPhim; Sound(AmThanh[i]); InPhimDan(i); if GA then begin GhiAm('',i); GhiAm('d',tgPhat); end; end else if MauPhim[i] = _MauPhim then begin MauPhim[i] := White; InPhimDan(i); end; end; if k <> #0 then delay(tgPhat); NoSound; End; BEGIN gd := EGA; gm := EGAHI; InitGraph(gd,gm,''); SetBkColor(Black); Assign(f,'GhiAm.txt'); {ReWrite(f);} { Bo dau ngoac trong lan chay dau tien, sau do dong lai} TaoDan; TgPhat := 200; GA := False; Playing := False; ShowDan; repeat DanhDan; if GA then ghiAm('d',23); until k = #27; CloseGraph; END.Program Piano; uses crt,graph; const SoPhim = 14; Phim: array[1..SoPhim] of char = ('a','s','d','f','g','h','j', '1','2','3','4','5','6','7'); TenNot: array[1..SoPhim] of string[3] = ('Do','Re','Mi','Fa', 'Sol','La','Si','Do"','Re"','Mi"','Fa"','Sol"','La"','Si"'); AmThanh: array[1..SoPhim] of integer = (131,147,165,175,196,220, 247,262,294,330,349,392,440,494); CRong = 30; Cdai = 100; KCNgang = 80; KCDoc = 150; _MauPhim = LightGreen; var gd,gm: integer; MauPhim: array[1..SoPhim] of integer; k: char; TgPhat: integer; f: text; GA,Playing: Boolean; Procedure InPhimDan(i: integer); Begin if MauPhim[i] = _MauPhim then SetFillStyle(1,_MauPhim) else SetFillStyle(1,White); bar(KCNgang+i*CRong,KCDoc,KCNgang+(i+1)*CRong,KCDoc + CDai); SetFillStyle(1,8); bar(KCNgang+i*CRong,KCdoc + CDai,KCNgang+(i+1)*CRong, KCDoc + CDai + 5); SetFillStyle(1,LightGray); bar(KCNgang+i*CRong,KCdoc + CDai+5,KCNgang+(i+1)*CRong, KCDoc + CDai + 10); SetColor(Black); Rectangle(KCNgang+i*CRong,KCDoc,KCNgang+(i+1)*CRong,KCDoc + CDai+10); SetColor(Blue); OutTextXY(KCNgang+i*30+15,KCDoc+70,Phim[i]); OutTextXY(KCNgang+i*30+5,KCDoc+20,TenNot[i]); End; Procedure TaoDan; var i: integer; Begin SetFillStyle(1,Cyan); Bar(KCNgang + CRong - 10,KCDoc - 10,KCNgang + CRong*(SoPhim+1)+10,KCDoc+CDai+20); for i := 1 to SoPhim do InPhimDan(i); Setcolor(Brown); SetTextStyle(DefaultFont, HorizDir,3); OutTextXy(200,100,'P I A N O'); SetTextStyle(DefaultFont, HorizDir,1); OutTextXy(200,320,'Turn off VietKey before hitting.'); End; Procedure ShowDan; var trdo: string; Begin SetfillStyle(1,LightGreen); Bar(KCNgang+CRong,KCDoc+Cdai+20,KCNgang + (SoPhim+1)*Crong,KCDoc+CDai+60); {--Record--} SetFillStyle(1,Red); Bar(KCNgang+CRong+20,KCdoc + CDai+25,KCNgang+CRong+80,KCDoc+CDai+55); Setcolor(Black); if not GA then OutTextXy(KCNgang+CRong+25,KCdoc + CDai+30,'Record') else OutTextXy(KCNgang+CRong+25,KCdoc + CDai+30,'Rec...'); OutTextXy(KCNgang+CRong+30,KCdoc + CDai+45,'( R )'); {--Truong Do--} SetFillStyle(1,Blue); Bar(KCNgang+CRong*(SoPhim+1)-80,KCdoc + CDai+25, KCNgang+CRong*(SoPhim+1)-10,KCDoc+CDai+55); Setcolor(Black); OutTextXy(KCNgang+CRong*(SoPhim+1)-70,KCdoc + CDai+35,'T: '); Str(TgPhat,trDo); OutTextXy(KCNgang+CRong*(SoPhim+1)-50,KCdoc + CDai+35,trdo); {--Play--} SetFillStyle(1,Yellow); Bar(KCNgang+CRong+170,KCdoc + CDai+25,KCNgang+CRong+230,KCDoc+CDai+55); Setcolor(Black); if not Playing then OutTextXy(KCNgang+CRong+185,KCdoc + CDai+30,'Play') else OutTextXy(KCNgang+CRong+185,KCdoc + CDai+30,'Stop'); OutTextXy(KCNgang+CRong+180,KCdoc + CDai+45,'( P )'); End; Procedure GhiAm(kt:string;Am: integer); var s: array[1..3000] of string[4]; i,j: integer; Begin reset(f); i := 0; repeat inc(i); Readln(f,s[i]); until s[i] = ''; rewrite(f); for j := 1 to i-1 do writeln(f,s[j]); if kt = '' then Writeln(f,Am) else Writeln(f,kt,Am); Close(f); End; Procedure Play; var s: string; i,c,j:integer; Begin reset(f); repeat readln(f,s); Val(s,i,c); if c = 0 then begin Sound(AmThanh[i]); for j := 1 to SoPhim do if i = j then begin MauPhim[j] := _MauPhim; InPhimDan(j); end else if MauPhim[j] = _MauPhim then begin MauPhim[j] := White; InPhimDan(j); end; end else begin Val(Copy(s,2,Length(s)),i,c); Delay(i); NoSound; end; k := #0; if keypressed then k := readkey; until (s = '') or (k = 'p'); Playing := False; ShowDan; End; Procedure TruongDo; Begin if (k = #72) or (k = #80) then begin if (k = #72) and (TgPhat < 400) then inc(TgPhat,50) else if (k = #80) and (TgPhat > 50) then inc(TgPhat,-50); ShowDan; end; End; Procedure BatGhiAm; Begin if k = 'r' then begin if not GA then ReWrite(f); GA := not GA; ShowDan; end else if k = 'p' then begin Playing := True;ShowDan;Play;end; End; Procedure DanhDan; var i: integer; Begin k := #0; if keypressed then begin k := readkey;TruongDo;BatGhiAm;end; for i := 1 to SoPhim do begin if k = Phim[i] then begin MauPhim[i] := _MauPhim; Sound(AmThanh[i]); InPhimDan(i); if GA then begin GhiAm('',i); GhiAm('d',tgPhat); end; end else if MauPhim[i] = _MauPhim then begin MauPhim[i] := White; InPhimDan(i); end; end; if k <> #0 then delay(tgPhat); NoSound; End; BEGIN gd := EGA; gm := EGAHI; InitGraph(gd,gm,''); SetBkColor(Black); Assign(f,'GhiAm.txt'); {ReWrite(f);} { Bo dau ngoac trong lan chay dau tien, sau do dong lai} TaoDan; TgPhat := 200; GA := False; Playing := False; ShowDan; repeat DanhDan; if GA then ghiAm('d',23); until k = #27; CloseGraph; END.
hacker
18 tháng 12 2020 lúc 19:00

sửa lỗi giúp mình nhé

 

Bình luận (2)
Nguyễn Lê Phước Thịnh
Thiếu tướng -
3 tháng 7 2020 lúc 19:36

Bài 1:

uses crt;

var a:array[1..300]of integer;

n,i,t:integer;

begin

clrscr;

write('Nhap so phan tu:'); readln(n);

for i:=1 to n do

begin

write('A[',i,']='); readln(a[i]);

end;

t:=0;

for i:=1 to n do

if (a[i] mod 2<>0) and (i mod 2=0) then t:=t+a[i];

writeln('Tong cac phan tu le o vi tri chan la: ',t);

readln;

end.

Bài 2:

uses crt;

var a,b:integer;

{---------------------chuong-trinh-con--------------------------}

function tong(var x,y:integer):integer;

begin

tong:=x+y;

end;

{-------------------chuong-trinh-chinh----------------------}

begin

clrscr;

write('Nhap so thu nhat:'); readln(a);

write('Nhap so thu hai:'); readln(a);

writeln('Tong cua hai so la: ',tong(a,b));

readln;

end.

Bình luận (0)
Nguyễn Lê Phước Thịnh
Thiếu tướng -
1 tháng 7 2020 lúc 20:08

Câu 1:

uses crt; var a,b,c,d,t:integer; {------------------------chuong-trinh-con-tinh-tong-cua-hai-so-----------------} function tong(var x,y:integer):integer; begin tong:=x+y; end; {------------------------chuong-trinh-chinh----------------------} begin clrscr; write('Nhap so thu nhat: '); readln(a); write('Nhap so thu hai: '); readln(b); write('Nhap so thu ba: '); readln(c); write('Nhap so thu tu: '); readln(d); t:=tong(a,b)+tong(c,d); writeln('Tong cua bon so la: ',t); readln; end.

Câu 2:

const fi='dulieu.dat';

assign(f1,fi); reset(f1);

Bình luận (0)
Nguyễn Lê Phước Thịnh
Thiếu tướng -
7 tháng 7 2020 lúc 9:43

Cái này là tính lũy thừa hay chỉ là phép cộng hai vế vậy bạn?

Bình luận (0)
Nguyễn Ngọc Hà
1 tháng 7 2020 lúc 17:09

Em hãy so sánh điểm giống và khác nhau giữa biến toàn cục và biến cục bộ.

Điểm giống nhau em không biết nha chị vì em mới học lớp 7 thôi á! =.=

* Điểm khác:

- Biến toàn cục:

+ Được khai báo ngoài hàm, có thể được khai báo trong hàm main() nhưng sử dụng chung cho tất cả các hàm có trong hàm main().

+ Giá trị của biến được sử dụng chung cho tất cả các hàm, nếu bạn truyền biến vào hàm bằng cách truyền tham chiếu thì giá trị của biến sẽ thay đổi.

+ Biến không bị hủy sau khi hàm kết thúc, biến chỉ bị hủy khi chương trình đã dừng.

+ Biến được khởi tạo có giá trị mặc định do hệ thống tự động tạo ra.

- Biến cục bộ:

+ Được khai báo trong phạm vi một hàm.

+ Giá trị của biến chỉ được sử dụng trong phạm vi hàm đó, không thể sử dụng bởi hàm khác.

+ Biến sẽ bị hủy sau khi hàm thực hiện xong công việc của mình.

+ Biến được khởi tạo có giá trị rác, bạn phải tự mình khởi tạo giá trị cho biến.

Chúc bạn học tốt!

#ngocha14092k7

Bình luận (0)
Nguyễn Lê Phước Thịnh
Thiếu tướng -
14 tháng 7 2020 lúc 12:37

uses crt; var a:array[1..100]of integer; i,n,dem,t,dem1,t1:integer; {----------------------chuong-trinh-con-----------------------------} function ktra(var x:integer):boolean; begin if x mod 2=0 then ktra:=true else ktra:=false; end; {---------------------chuong-trinh-chinh----------------------------} begin clrscr; write('Nhap n='); readln(n); for i:=1 to n do begin write('A[',i,']='); readln(a[i]); end; t:=0; dem1:=0; t1:=0; dem:=0; for i:=1 to n do begin if ktra(a[i])=true then begin t:=t+a[i]; inc(dem); end else begin t1:=t1+a[i]; inc(dem1); end; end; writeln('So luong so chan la: ',dem); writeln('So luong so le la: ',dem1); writeln('Tong cac so chan la: ',t); writeln('Tong cac so le la: ',t1); readln; end.

Bình luận (0)
Minh Lệ
12 tháng 6 2020 lúc 11:53

Procedure sapxep( var x,y: integer);

var tg: integer;

begin

if x<y then

begin

tg:=x;

x:=y;

y:=tg;

end;

Bình luận (0)
Minh Lệ
12 tháng 6 2020 lúc 11:50

Program HOC24;

var i,n: integer;

t: longint;

a: array[1..100] of integer;

procedure ip;

begin

write('Nhap n='); readln(n);

for i:=1 to n do

begin

write('a[',i,']='); readln(a[i]);

end;

end;

function chan(x: integer): longint;

var tong: longint;

begin

t:=0;

if x mod 2=0 then tong:=x;

chan:=tong;

end;

begin

ip;

for i:=1 to n do t:=t+chan(a[i]);

write(t);

readln

end.

Bình luận (0)

Khoá học trên OLM của Đại học Sư phạm HN

Loading...

Khoá học trên OLM của Đại học Sư phạm HN