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    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=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    begin inc(stran); Ekran end;
    if ((curs=20))
    or ((Schet    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    Rewrite(f);
    Sortirovka(1);
    for i: =0 to Schet-1 do Write(f, List[i]);
    close(f);
    end.

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