Алгоритм программы.

IV. Текст программы.

Program kursovoi;

uses crt;

type basskl = record

 naim:string[40];

 kol:integer;

 price:single;

 kol_p:integer;

 date_p:string[8];

 kol_r:integer;

 date_r:string[8];

 end;

var f:file of basskl;

 List:array[0..255] of basskl;

 Schet:Integer;

 curs,stran,i,mcurs:integer;

 k:char;

 Res,da,er,seter:Integer;

 Tx,files:String;

 key:boolean;

const

 mnu:array[1..6] of string[13]=(

 ' Ввод ',

 ' Приход ',

 ' Расход ',

 ' Найти ',

 ' Сортировка ',

 ' Выход ');

function Probel(Text:String;Len:Integer):String;

 begin

 While length(Text)<Len do Text:=Text+' ';

 Probel:=copy(Text,1,len)

 end;

function Edtext(x,y:Integer; Text:String;Len:Integer;var key:boolean):String;

 var c:char;

 begin

 key:=true;

 Edtext:='';

 repeat

 gotoxy(x,y);

 write(Text);

 write(Probel('',len));

 gotoxy(x,y);

 write(Text);

 c:=Readkey;

 if c=#8 then delete(Text,length(Text),1);

 if c in ['A'..'z',' ','.','0'..'9','А'..'я','-'] then Text:=Text+c;

 Text:=copy(Text,1,len);

 until (c=#27) or (c=#13);

 if c=#13 then Edtext:=Text else key:=false;

 end;

function Cifri(x,y:Integer; Text:String;Len:Integer;var key:boolean):String;

 var c:char;

 begin

 key:=true;

 Cifri:='';

 repeat

 gotoxy(x,y);

 write(Text);

 write(Probel('',len));

 gotoxy(x,y);

 write(Text);

 c:=Readkey;

 if c=#8 then delete(Text,length(Text),1);

 if c in ['.','0'..'9','-'] then Text:=Text+c;

 Text:=copy(Text,1,len);

 until (c=#27) or (c=#13);

 if c=#13 then Cifri:=Text else key:=false;

 end;

procedure Prishlo(posiz:integer);

var Tx:String;

 er:integer;

 key:Boolean;

 kl:integer;

begin

 clrscr;

 With List[Posiz] do begin

 writeln(' Приход');

 writeln(' Количество ->');

 writeln(' Дата прихода ДД.ММ.ГГ->');

 val(Cifri(25,2,'',6,key),kl,er); if NOT key then exit;

 kol_p:=kol_p+kl; kol:=kol+kl;

 Date_p:=Cifri(25,3,'',8,key); if NOT key then exit;

 end;

end;

procedure Ushlo(posiz:integer);

var er:integer;

 key:Boolean;

 kl:integer;

begin

 clrscr;

 With List[Posiz] do begin

 writeln(' Расход');

 writeln(' Количество ->');

 writeln(' Дата расхода ДД.ММ.ГГ->');

 val(Cifri(25,2,'',6,key),kl,er); if NOT key then exit;

 kol_r:=kol_r+kl; kol:=kol-kl;

 Date_r:=Cifri(25,3,'',8,key); if NOT key then exit;

 end;

end;

procedure Vvodnov;

var Tx:String;

 er:integer;

 key:Boolean;

begin

 clrscr;

 With List[Schet] do begin

 writeln(' Новый товар');

 writeln(' Наименование товара :');

 writeln(' Количество :');

 writeln(' Цена :');

 writeln(' Дата прихода ДД.ММ.ГГ:'); {readln(date_p);}

 Naim:=Edtext(25,2,'',20,key); if NOT key then exit;

 val(Cifri(25,3,'',6,key),kol,er); if NOT key then exit;

 kol_p:=kol;

 val(Cifri(25,4,'',10,key),price,er); if NOT key then exit;

 Date_p:=Cifri(25,5,'',8,key); if NOT key then exit;

 inc(Schet);

 end;

end;

procedure Edzapic(posiz:integer);

var Tx:String;

 er:integer;

 key:Boolean;

begin

 clrscr;

 With List[posiz] do begin

 writeln(' Редактирование товара');

 writeln(' Наименование товара :');

 writeln(' Цена :');

 Tx:=Edtext(25,2,Naim,20,key); if key then Naim:=tx;

 str(price:0:2,tx);

 tx:=Cifri(25,3,tx,10,key); if key then val(tx,price,er);

 end;

end;

 function vstroca(var curs:integer):integer;

 var i:integer;

 begin

 Textbackground(15);

 TextColor(0);

 gotoxy(1,1); write(Probel('',80));

 for i:=0 to 5 do

 begin

 gotoxy(i*13+1,1); write(mnu[i+1]);

 end;

 Textbackground(0);

 TextColor(14);

 gotoxy((curs-1)*13+1,1); write(mnu[curs]);

 repeat

 k:=readkey;

 Textbackground(15);

 TextColor(0);

 gotoxy((curs-1)*13+1,1); write(mnu[curs]);

 if k=#0 then k:=readkey;

 case k of

 #75: if curs>1 then dec(curs) else curs:=6;

 #77: if curs<6 then inc(curs) else curs:=1;

 end;

 Textbackground(0);

 TextColor(14);

 gotoxy((curs-1)*13+1,1); write(mnu[curs]);

 if k=#13 then vstroca:=curs;

 until (k=#27) or (k=#13);

 if k=#27 then vstroca:=-1;

 end;

 function VIVSTR(nstr:integer):String;

 var Skol,sprice,summ,

 Pkol,Rkol:String[10];

 begin

 VIVSTR:='';

 if (nstr<Schet) and (nstr>=0) then

 With List[nstr] do

 begin

 str(kol,skol);

 str(price:9:2,sprice);

 str(price*kol:9:2,summ);

 str(kol_p,pkol);

 str(kol_r,rkol);

 VIVSTR:=Probel(naim,20)+Probel(skol,6)+Probel(sprice,11)+Probel(summ,11)+

 Probel(Pkol,6)+Probel(Date_p,10)+Probel(Rkol,6)+Probel(Date_r,9);

 end;

 end;

 procedure Ekran;

 var i:integer;

 Summ_,Sum_p,Sum_r:Double;

 begin

 Window(1,2,80,25);

 Textbackground(5);

 TextColor(10);

 Clrscr;

 gotoxy(1,1);

 Textbackground(3);

 write(Probel('Наименование',20)+Probel('Кол-во',9)+Probel('Цена',10)+

 Probel('Сумма',7)+Probel('Приход ',7)+Probel('Дата пост',10)+Probel('Расход',6)

 +Probel(' Дата выд',9));

 Textbackground(5);

 TextColor(14);

 for i:=0 to 20 do

 begin

 gotoxy(1,2+i); Write(Vivstr(i+stran));

 end;

 Textbackground(15);

 TextColor(0);

 gotoxy(1,1+curs); write(VIVSTR(curs+stran-1));

 Summ_:=0; Sum_p:=0; Sum_r:=0;

 for i:=0 to Schet-1 do

 begin

 Summ_:=Summ_+(List[i].price*List[i].kol);

 Sum_p:=Sum_p+(List[i].price*List[i].kol_p);

 Sum_r:=Sum_r+(List[i].price*List[i].kol_r);

 end;

 Textbackground(4);

 TextColor(15);

 gotoxy(1,23); write(Probel('',80));

 gotoxy(1,23); write(' Итого: ',

 Summ_:12:2,' руб. Приход: ',Sum_p:0:2,' руб. Расход:',Sum_r:0:2,' руб.');

 gotoxy(15,24); write ('Общее количество наименований товара: ',schet,' шт');

 end;

procedure Sortirovka(num:Integer);

var i,j,k:Integer;

 Bas:Basskl;

begin

 for i:=0 to Schet-1 do

 begin

 Bas:=List[i];

 for j:=i+1 to Schet-1 do

 begin

 case Num of

 1: if Bas.Naim>List[j].naim then begin Bas:=List[j]; k:=j end;

 2: if Bas.kol>List[j].kol then begin Bas:=List[j]; k:=j end;

 3: if Bas.price>List[j].price then begin Bas:=List[j]; k:=j end;

 5: if Bas.kol_p>List[j].kol_p then begin Bas:=List[j]; k:=j end;

 6: if Bas.date_p>List[j].date_p then begin Bas:=List[j]; k:=j end;

 7: if Bas.kol_r>List[j].kol_r then begin Bas:=List[j]; k:=j end;

 8: if Bas.date_r>List[j].date_r then begin Bas:=List[j]; k:=j end;

 end;

 end;

 List[k]:=List[i]; List[i]:=Bas;

 end;

end;

 procedure Vivlist(var seek,curs:integer);

 var c,k:char;

 i:integer;

 begin

 Ekran;

 Textbackground(3);

 gotoxy(1,24); write(Probel(' <- -> - меню | Ins - Добавить | Ctrl+F8 - Удалить | Ctrl+Enter - Изменить',79));

 Textbackground(15);

 TextColor(1);

 gotoxy(1,1+curs); write(VIVSTR(curs+stran-1));

 repeat

 c:=readkey;

 Textbackground(5);

 TextColor(14);

 gotoxy(1,1+curs); write(VIVSTR(curs+stran-1));

 if c=#0 then k:=readkey;

 case k of

 #72: begin {Вверх курсор}

 if (curs=1) and (stran>0) then begin dec(stran); Ekran end;

 if (curs>1) then dec(curs);

 end;

 #80: begin {Вниз курсор}

 if (curs=20) and (stran+20<Schet) then

 begin inc(stran); Ekran end;

 if ((curs<20) and (Schet>=20))

 or ((Schet<20) and (curs<Schet)) then inc(curs);

 end;

 #101: begin{Удалить} {Ctrl+F8}

 if Schet>0 then

 for i:=curs+stran-1 to Schet-1 do

 begin

 List[i]:=List[i+1];

 end;

 dec(Schet);

 dec(curs);

 Ekran;

 end;

 #82: begin {Ins - новая запись}

 Window(12,12,72,17);

 Textbackground(0);

 clrscr;

 Window(10,11,70,16);

 Textbackground(7);

 clrscr;

 {новоя запись}

 Vvodnov;

 Sortirovka(1);

 Window(1,1,80,25);

 Ekran;

 end;

 end;

 if c=#10 then {Ctrl+Enter}

 begin

 Window(12,12,72,17);

 Textbackground(0);

 clrscr;

 Window(10,11,70,16);

 Textbackground(7);

 clrscr;

 {новоя запись}

 Edzapic(Curs+stran-1);

 Sortirovka(1);

 Window(1,1,80,25);

 Ekran;

 end;

 Textbackground(15);

 TextColor(1);

 gotoxy(1,1+curs); write(VIVSTR(curs+stran-1));

 until (k=#27) or (k=#13) or (k=#75)or (k=#77);

 Window(1,1,80,25);

 end;

begin

 clrscr;

 Window(16,12,66,15);

 Textbackground(9);

 textcolor (3);

 clrscr;

 write (' Введите название и полный путь базы');

 gotoxy (3,3);

 readln (files);

 if files='' then files:='c:\base.dat';

 assign(f,files);

 {$I-}

 reset(f);

 {$I+}

 if IOResult<>0 then rewrite(f);

 Schet:=0;

 While not eof(f) do

 begin

 inc(Schet);

 read(f,List[Schet-1]);

 end;

 Textbackground(0);

 clrscr;

 curs:=1; stran:=0; mcurs:=1; seter:=15;

 repeat

 Ekran;

 Window(1,1,80,25);

 res:=vstroca(mcurs);

 case res of

 1:begin

 Vivlist(stran,curs);

 Window(1,1,80,25);

 end;

 2:begin

 Window(16,12,66,15);

 Textbackground(0);

 clrscr;

 Window(14,11,64,14);

 Textbackground(7);

 clrscr;

 {Запуск новой записи}

 Prishlo(Curs+stran-1);

 Window(1,1,80,25);

 end;

 3:begin

 Window(16,12,66,15);

 Textbackground(0);

 clrscr;

 Window(14,11,64,14);

 Textbackground(7);

 clrscr;

 {Запуск новой записи}

 Ushlo(Curs+stran-1);

 Window(1,1,80,25);

 end;

 4:begin {Поиск}

 Window(16,12,66,14);

 Textbackground(7);

 clrscr;

 Window(14,11,64,13);

 Textbackground(8);

 clrscr;

 Gotoxy(2,2); Write('Найти наименование:');

 Tx:=Edtext(25,2,'',20,key);

 for i:=0 to Schet-1 do

 if List[i].naim=tx then begin seter:=1; break; end;

 if i>20 then begin curs:=1; stran:=i end

 else begin curs:=i+1; stran:=0; end;

 if seter<>1 then

 begin

 Window(16,12,66,14);

 Textbackground(7);

 clrscr;

 Window(14,11,64,13);

 Textbackground(8);

 clrscr;

 Gotoxy(2,2); Write('Наименование ненайдено'); readln; stran:=1; curs:=1;

 end;

 Vivlist(stran,curs);

 Window(1,1,80,25);

 end;

 5:begin {Сортировка}

 Window(16,12,66,14);

 Textbackground(0);

 clrscr;

 Window(14,11,64,13);

 Textbackground(7);

 clrscr;

 Gotoxy(2,2); Write('Введите поле для сортировки (1..8):');

 val(Cifri(38,2,'',1,key),da,er);

 if da in [1..8] then Sortirovka(da);

 Window(1,1,80,25);

 end;

 end;

 until (res<1) or (res=6);

 Rewrite(f);

 Sortirovka(1);

 for i:=0 to Schet-1 do Write(f,List[i]);

 close(f);

end.

Страницы: 1, 2