Реферат: Автоматическое рабочее место для работника склада

III.    
Алгоритм программы.
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.