немогу просто скомпилирывать его....
unit alex;
interface
uses crt,objects,app,drivers,menus,views,dos,dialogs,graph;
const
cmwork=100;
cmfon=101;
cmfile_create=201;
cmtabl=202;
cmread_spisok=203;
cmsort=204;
type
spisok=record
naim:string[25];
opisanie:string[25];
cena:string[5];
end;
type
tnotebook=object(tapplication)
procedure initmenubar;virtual;
procedure HandleEvent(var Event: TEvent); virtual;
procedure InitStatusLine;virtual;
end;
implementation
{*********************************************************}
{ ЊҐо }
{*********************************************************}
procedure Tnotebook.initmenubar;
var
r:trect;
begin
getExtent®;
r.b.y:=succ(r.a.y);
menubar:=new(pmenubar,init(r,
newmenu(
newsubmenu('~F~/" ©"',hcnocontext,
newmenu(
{/////////////////////////////////////////////////////////////////}
newitem('~1~/'®§¤ вм д ©"','F2',kbF3,cmfile_create,hcnocontext,
newline(
{/////////////////////////////////////////////////////////////////}
newitem('~2~/‚ўҐбвЁ ¤ лҐ ў д ©"','F3',kbF2,cmtabl,hcnocontext,
newline(
{****************************************************************}
newitem('~3~/'ЇЁб®Є','F4',kbF3,cmread_spisok,hcnocontext,
{********************************************************************}
newline(
newitem('~4~/'®авЁа®ў вм бЇЁб®Є','F5',kbF3,cmsort,hcnocontext,
{**************************************************************}
newline(
{******************************************************************}
{///////////////////////////////////////////////////////////////}
newitem('~5~/‚л室','Alt+X',kbF9,cmquit,hcnocontext,nil)))))))))),
{**************************************************************}
newsubmenu('~E~/‚л室',hcnocontext,
newmenu(
newitem('~1~/Ќ...'','',0,cmwork,hcnocontext,
newitem('~2~/"Ђ','',0,cmquit,hcnocontext,nil))),
{**************************************************************}
nil)))));
end;
{*********************************************************}
{ ‚Є"о票Ґ/®вЄ"о票Ґ Єгаб®а }
{*********************************************************}
PROCEDURE CURSOROFF;
ASSEMBLER;
ASM
MOV AH,1
MOV CX,2020H {‚›Љ‹ћ-...Ќ?... Љ"ђ'ЋђЂ}
INT 10H
END;
{ЏђЋ-...""ђЂ ‚›‚..."...Ќ?џ Љ"ђ'ЋђЂ}
PROCEDURE CURSORON;
ASSEMBLER;
ASM
MOV AH,1
MOV CX,0607H {‚Љ‹ћ-...Ќ?... Љ"ђ'ЋђЂ}
INT 10H
END;
{*********************************************************}
{ ‡ Єа иЁў ЁҐ д® }
{*********************************************************}
procedure fon;
var
ir,jr:byte;
begin
textbackground(white);
textcolor(blue);
for ir:=2 to 24 do
begin
gotoxy (1,ir);
write(& #39;°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°
°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°
°°');
end;
end;
{*********************************************************}
{ '®§¤ ЁҐ д ©" }
{*********************************************************}
procedure file_create;
var
f:file of spisok;
begin
assign(f,'C:\spisok.spk');
rewrite(f);
textbackground(1);
textcolor(white);
gotoxy(20,12);
write('ЙНННННННННННННННННННННННННННННННННННН"');
gotoxy(20,13);
write('є " ©" б®§¤ ! є');
gotoxy(20,14);
write(& #39;ИННННННННННННННННННННННННННННННННННННј
');
textbackground(white);
gotoxy(20,15);
write(' Ќ ¦¬ЁвҐ "оЎго Є" ўЁиг ');
readkey;
fon;
end;
procedure podsvetca(xpt,ypt,zpt:byte);
var
ipt:byte;
begin
textbackground(green);
for ipt:=1 to zpt do
begin
gotoxy(xpt+ipt,ypt);
write(' ');
end;
textbackground(1);
end;
procedure soob_tabl_1;
begin
textbackground(white);
gotoxy(9,9);
textcolor(red);
write('Enter ');
gotoxy(14,9);
textcolor(white);
write(' - ЏҐаҐе®¤ б"Ґ¤гойго бва®Єг ');
gotoxy(9,10);
write('‚ў®¤ агббЄ®¬ п§лЄҐ ');
end;
{******************************************************************}
procedure soob_tabl_2;
begin
textbackground(white);
gotoxy(9,9);
textcolor(red);
write('Enter ');
gotoxy(14,9);
textcolor(white);
write(' - Ќ з вм § Ї®"ҐЁҐ ');
textcolor(red);
gotoxy(38,9);
write('Esc ');
textcolor(white);
gotoxy(42,9);
write('- ЋвЄ § вмбп ®в § Ї®"ҐЁп');
end;
procedure tabl;
var
c:char;
a:spisok;
f:file of spisok;
begin
textbackground(blue);
textcolor(white);
gotoxy(9,2);
write('ЙННННННННННННННННННННННН['®ў а]ННННННННННННННННННННННННННН"');
gotoxy(9,3);
write('єЌ Ё¬Ґ®ў ЁҐ в®ў а : є');
gotoxy(9,4);
write('є є');
gotoxy(9,5);
write('єЋЇЁб ЁҐ: є');
gotoxy(9,6);
write('є є');
gotoxy(9,7);
write('є-Ґ : є');
gotoxy(9,8);
write(& #39;ИННННННННННННННННННННННННННННННННННННН
ННННННННННННННННННННј');
soob_tabl_2;
c:=readkey;
if c=#13 then
begin
podsvetca(30,3,25); podsvetca(19,5,25);podsvetca(15,7,5);
soob_tabl_1;
cursoron;
textbackground(green);
gotoxy(31,3);
readln(a.naim);
gotoxy(20,5);
readln(a.opisanie);
gotoxy(16,7);
readln(a.cena);
cursoroff;
assign(f,'C:\spisok.spk');
reset(f);
seek(f,filesize(f));
write(f,a);
close(f);
end;
{else
begin
textbackground(white);
gotoxy(9,9);
write(' Ќ ¦¬ЁвҐ "оЎго Є" ўЁиг ');
end;}
fon;
end;
procedure spisok_tab;
begin
textbackground(1);
textcolor(white);
gotoxy(10,3);
write(& #39;ЙННННННННННННННННННННННННННННННННННННН
ННННННННННННННННННН"');
gotoxy(10,4);
write('є '®ў а є');
gotoxy(10,5);
write(& #39;МНННННННННННННННННННЛННННННННННННННННН
ННННННННННЛНННННННН№');
gotoxy(10,6);
write('єЌ Ё¬Ґ®ў ЁҐ в®ў а є ЋЇЁб ЁҐ є -Ґ є');
gotoxy(10,7);
write(& #39;МНННННННННННННННННННОННННННННННННННННН
ННННННННННОНННННННН№');
end;
procedure read_spisok;
var f:file of spisok;
a:spisok;i,k,j:integer;
begin
spisok_tab;
i:=0;
assign(f,'C:\spisok.spk');
reset(f);
while not eof(f) do
begin
read(f,a);
gotoxy(10,8+i);
write('є є є є');
gotoxy(11,8+i);
write(a.naim);
gotoxy(31,8+i);
write(a.opisanie);
gotoxy(59,8+i);
write(a.cena);
i:=i+1;
k:=k+1;
if i=15 then
begin
textcolor(white);
gotoxy(10,8+i);
write(& #39;ИНННННННННННННННННННКННННННННННННННННН
ННННННННННКННННННННј');
readkey;
i:=0
end
else
if k>15 then
for j:=i to 14 do
begin
textcolor(white);
gotoxy(10,8+j);
write('є є є є');
end
else;
if k<16 then
begin
textcolor(white);
gotoxy(10,8+i);
write(& #39;ИНННННННННННННННННННКННННННННННННННННН
ННННННННННКННННННННј');
end
else;
end;
readkey;
fon;
end;
{*********************************************************}
{ '®авЁа®ўЄ }
{*********************************************************}
procedure sort;
var
i,j:integer;
a:array[1..100]of string[25];
s:string[25];
f,f1:file of spisok;
b:spisok;
function prov:boolean;
var k:integer;
z:boolean;
begin
k:=1;
z:=true;
while (z<>false)and(k<=j)do
begin
if a[k]=b.naim then
z:=false
else
z:=true;
k:=k+1;
end;
if z then
prov:=true
else
prov:=false;
end;
begin
assign(f,'C:\spisok.spk');
reset(f);
read(f,b);
a[1]:=b.naim;
s:=b.naim;
j:=1;
while not eof(f)do
begin
read(f,b);
for i:=1 to j do
if prov then
begin
a[j+1]:=b.naim;
j:=j+1;
s:=b.naim;
end
else;
end;
close(f);
assign(f1,'C:\spisok1.spk');
rewrite(f1);
for i:=1 to j do
begin
reset(f);
while not eof(f)do
begin
read(f,b);
if a[i]=b.naim then
begin
seek(f1,filesize(f1));
write(f1,b);
end;
end;
end;
close(f1);
erase(f);
rename(f1,'C:\spisok.spk');
textbackground(1);
textcolor(white);
gotoxy(20,12);
write('ЙНННННННННННННННННННННННННННННННННННН"');
gotoxy(20,13);
write('є 'ЇЁб®Є ®вб авЁа®ў ! є');
gotoxy(20,14);
write(& #39;ИННННННННННННННННННННННННННННННННННННј
');
textbackground(white);
gotoxy(20,15);
write(' Ќ ¦¬ЁвҐ "оЎго Є" ўЁиг ');
readkey;
fon;
end;
{*********************************************************}
{ ЋЎа Ў®взЁЄ }
{*********************************************************}
procedure tnotebook.HandleEvent(var Event: TEvent);
begin
inherited HandleEvent(Event);
case Event.What of
evCommand:
case Event.Command of
cmfon:fon;
cmfile_create:file_create;
cmtabl:tabl;
cmread_spisok:read_spisok;
cmsort:sort
else
Exit;
end;
else
Exit;
end;
ClearEvent(Event);
end;
{*********************************************************}
{ 'ва®Є б®бв®пЁп }
{*********************************************************}
procedure tnotebook.InitStatusLine;
var
r:trect;
begin
GetExtent®;
R.A.Y:=pred(R.B.Y);
StatusLine:=new(PStatusline,init(r,
NewStatusDef(0,0,
NewStatusKey('~F2~ '®§¤ вм д Ё"',kbF2,cmfile_create,
NewStatusKey('~F3~ ‚ўҐбвЁ ¤ лҐ',kbF3,cmtabl,
NewStatusKey('~F4~ 'ЇЁб®Є',kbF4,cmread_spisok,
NewStatusKey('~F5~ '®авЁа®ў вм',kbF5,cmsort,
NewStatusKey('~F10~ ЊҐо',kbF10,cmMenu,
NewStatusKey('~Alt-X~ ‚л室',kbAltx,cmquit,nil)))))),
nil)));
end;
begin
end.
помогите плиз
Сообщение отредактировано: klem4 -