« »

www.erudition.ru /
Программирование, базы данных /


АРМ для работы со складом

.

, Pentium. , , , , . : ( ) , , , ; ; ; ( 1 ), .

Borland Pascal, Microsoft Windows 95OSR2, Microsoft Word 97 SR-2 , Borland Pascal Promt, Stylus, Magic Gooddy 98. .. , Bill Gaits , .. , .. , .. , .. , Sting, Queen, .

.

.

:

 

.

;

probel;

.

: , .

: .

Edtext;

:

Enter Esc. , , delete.

: , , , .

: , .

Cifri;

Edtext .

.

Prishlo;

.

: . , .

Ushlo;

Prishlo . .

 

Vvodnov;

, .

: , , , , , 1.

Edzapic;

.

:

: .

Ekran;

, , , , .

: , , , , , .

Vivstr;

.

. . ( , , ), . Probel.

Vivlist;

Ekran, . , ( , , ). : Ekran, , , , Enter, Esc Readkey

Vstroca;

.

, .. . , , Enter . Esc 1 .

Sortirovka;

.

. . . .

.

:\base.dat . . . Vstroka Case . 1 Vstroka , Vivlist. 2 , Prishlo . 3 , Ushlo. 4 Edtext. . . 5 . Sortirovka. Vstroca , .

.


 

 

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.


?
?
?





Copyright © 2003—2005 «» 
    - Hostland.Ru