1. Заголовок темы должен быть информативным. В противном случае тема удаляется ... 2. Все тексты программ должны помещаться в теги [code=pas] ... [/code]. 3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали! 4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора). 5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM! 6. Одна тема - один вопрос (задача) 7.Проверяйте программы перед тем, как разместить их на форуме!!! 8.Спрашивайте и отвечайте четко и по существу!!!
uses crt,dos; label na4; const filepath='data.bd'; type data = record nomAt:integer; nomKv:integer; Dat1:string[10]; Dat2:string[10]; FIO:string[21]; vid:string[10]; end;
var f:file of data; bd:array[1..100]of data; num,v:integer;
procedure PrintAll(fio:string); var i,j,kol:integer; s1,s2,s3,s4,s5,s6:string; mass:array[1..100] of integer; print:boolean; begin clrscr; textcolor(5); writeln('At|','Kv|', 'Oformlenie|',' Vida4a |',' FIO |','Tovar'); writeln('____________________________________________________________________'); textcolor(2); kol:=0; if (fio<>'') then for i:=1 to num do begin if bd[i].fio=fio then begin kol:=kol+1; mass[kol]:=i; end; end; for i:=1 to num do begin print:=true; if (fio<>'') then begin print:=false; for j:=1 to kol do if i=mass[j] then print:=true; end; if print then begin str(bd[i].NomAt:2,s1); str(bd[i].NomKv:2,s2); s3:=bd[i].dat1; for j:=1 to 10-length(bd[i].dat1) do s3:=s3+' '; s4:=bd[i].dat2; for j:=1 to 10-length(bd[i].dat2) do s4:=s4+' '; s5:=bd[i].fio; for j:=1 to 21-length(bd[i].fio) do s5:=s5+' '; s6:=bd[i].vid; for j:=1 to 6-length(bd[i].vid) do s6:=s6+' '; writeln(s1,'|',s2,'|',s3,'|',s4,'|',s5,'|',s6); end; end; readln; end;
procedure NewFile; begin assign(f,filepath); rewrite(f); close(f); end;
procedure WriteToFile; var i:integer; begin assign(f,filepath); rewrite(f); for i:=1 to num do write(f,bd[i]); close(f); end;
procedure ReadfromFile; begin assign(f,filepath); reset(f); num:=0; while(not eof(f)) do begin num:=num+1; read(f,bd[num]); end; close(f); end;
procedure NewZap; var zap:data; begin clrscr; gotoxy(10,5); write('Vvedite nomer atelye '); readln(zap.NomAt); gotoxy(10,6); write('Vvedite nomer kvitancii ');readln(zap.Nomkv); gotoxy(10,7); write('Vvedite data oformleniya ');readln(zap.dat1); gotoxy(10,8); write('Vvedite data vida4i ');readln(zap.dat2); gotoxy(10,9); write('Vvedite fio mastera ');readln(zap.fio); gotoxy(10,10); write('Vvedite vid izdeliya ');readln(zap.Vid); num:=num+1; bd[num]:=zap; clrscr; end;
procedure FilterZap; var kol,i,j:integer; fio:string[21]; begin clrscr; gotoxy(10,1); write('Viborka po FIO mastera...'); gotoxy(10,2); write('Vvedite iskomuu FIO: '); readln(fio); PrintAll(fio); clrscr; end;
function find:boolean; var di:string; begin di:=FSearch('data.bd',''); if di='' then find:=false else find:=true; end;
begin if (not find) then NewFile else ReadFromFile; na4: clrscr; gotoxy(15,1); write('Zapisei v BD ',num); gotoxy(15,5); write('Dly dobavleniya zapisi v BD vvedite #1#'); gotoxy(15,6);write('Dly sortirovki BD vvedite #2#'); gotoxy(15,7);write('Dly prosmotra vsey BD vvedite #3#'); gotoxy(15,9);write('Dly VIHODA iz programmi vvedite #4#'); gotoxy(20,11);textcolor(2);write('Vibor: ');readln(v); clrscr; case v of 1:begin NewZap; WriteToFile; goto na4; end; 2:begin FilterZap; goto na4; end; 3:begin PrintAll(''); goto na4; end; 4:begin end;