Ñòóäåíòàì > Êóðñîâûå > Ïðîãðàììàòîð ÏÇÓ
Ïðîãðàììàòîð ÏÇÓÑòðàíèöà: 8/9
$4B: begin if (p>0)or(l1<>0)then dec(p); if
p<0 then begin dec(l1,16); p:=15; goto RePaINt; end; end;
$49: begin if (l1>319) then begin dec(l1,320) end
else l1:=0; goto RePaint; end;
$51: begin inc(l1,320); if l1>size-336 then
l1:=size-336; goto RePaint; end;
end;
Until (key=chr(13))or(Key=chr(27));
If flag Then
Begin
color(7,4);
MorPhL(24,7,50,14);
WindowL('Save Changed Data?');
Menu(36,9,3,2,$4b,'YES','NO','','','',6);
If MenuP=0 Then
Begin
Seek(f,lpos);
blockwrite(f,buffer^,readsize);
End;
End;
close(f);
End;
Function LowCase(s : string) : string;
Var
x : integer;
Begin
LowCase:=s;
For x:=1 To length(s) Do
Begin
If (s[x]>='A')And(s[x]<='Z') Then
LowCase[x]:=char((byte(s[x])-byte('A'))+byte('a'));
End;
End;
Procedure FFile(var s : string);
Var
i : searchrec;
name : string;
x,y,z: integer;
curp : integer;
curps: integer;
maxp : integer;
mask : string;
zs : string;
fz,dz: integer;
f : file of byte;
pos : longint;
Label Repaint;
Begin
s:='';
RePaint:
For y:=1 To 17 Do
Begin
Loc(23,3+y);
Wrt(' ');
End;
z :=0;
fz :=0;
dz :=1;
curp :=1;
curps:=1;
mask :='*.*';
FindFirst(mask,Directory,i);
Repeat
If (i.attr)And(Directory)=Directory Then
Begin
filx^[dz]:=i.name;
If i.name<>'.' Then inc(dz);
End
Else
Begin
dirx^[fz+1]:=LowCase(i.name);
inc(fz);
End;
FindNext(i);
Until DOSERROR<>0;
z:=dz+fz;
x:=1;
For y:=dz To z Do
Begin
filx^[y]:=dirx^[x];
inc(x);
End;
Repeat
maxp:=curp+17;
If maxp>(z-1) Then maxp:=(z-1);
For y:=curp To maxp Do
Begin
Loc(23,3+y-curp);
name:=filx^[curp+(y-curp)];
For x:=17 DownTo length(filx^[curp+(y-curp)])
Do name:=name+' ';
If curps=(y-curp+1) Then color(1,2) Else
color(7,1);
Wrt(' '+name);
End;
Repeat
WaitKey;
Until
(Key=chr(13))or(ScanCode=$48)or(ScanCode=$50)or(Key=chr(27))or(ScanCode=82);
Case ScanCode Of
$50: inc(curps);
$48: dec(curps);
82:
Begin
MOrPhL(10,10,40,15);
WindowL('Input File Name .ROM');
y :=1;
zs:=' ';
Loc(22,12);
Wrt('-');
Repeat
WaitKey;
Loc(21+y,12);
If (Key<>chr(13))And(Key<>chr(27)) Then
If (Key<>chr(08)) Then
Begin
If y<>9 Then
Begin
zs[y]:=Key;
Wrt(key+'-');
inc(y);
End;
End
Else
If y<>1 Then
Begin
dec(y);
Loc(21+y,12);
zs[y]:=' ';
Wrt('- ');
End;
Until (Key=Chr(13))or(Key=chr(27));
MorPhL(20,8,50,12);
Color(7,4);
WindowL('!!!!!!!!!!!!');
Loc(30,10);
Wrt('Æäè äàâàé!'+chr(208));
Map;
Assign(f,zs+'.ROM');
Rewrite(f);
y:=$FF;
For pos:=1 To romsize Do Write(f,byte(y));
close(f);
Key:=chr(255);
ScanCode:=0;
color(7,1);
MorPhL(20,2,50,22);
WindowL('Âûáåðèòå ôàéë');
s:='';
Goto RePaint;
End;
End;
If curps>(z-1) Then curps:=(z-1);
If (curps>18) Then
Begin
curps:=18;
If curp<z-18 Then inc(curp);
End;
If (curps<1) Then
Begin
curps:=1;
If curp>1 Then dec(curp);
End;
Until (Key=chr(13))or(Key=chr(27));
Color(7,1);
If Key=chr(13) Then
Begin
FindFirst(filx^[curp+curps-1],00,i);
If DOSERROR<>0 Then
Begin chdir(filx^[curp+curps-1]);
Goto RePaint;
End;
s:=filx^[curp+curps-1];
End;
End;
Procedure ReadROM(addr : longint);
Var
x : word;
y : byte;
Begin
x:=addr;
port[$378]:=x and 65535;
port[$379]:=x shr 16;
y:=port[$380];
fake^[x and 65535]:=y;
End;
Var
x : byte;
s : string;
l : LONGINT;
y : longint;
zs : string;
rsz : longint;
fi,fo : file;
Label OpenF;
Begin
New(buffer);
New(filx);
New(dirx);
New(fake);
ofsscr:=ofs(screen);
segscr:=seg(screen);
LoadFont;
MakeMans;
GetDir(0,curd);
romsize:=0;
color(7,5);
Window(1,1,26,12,'Ãëàâíîå ìåíþ');
Repeat
MorPhL(1,1,26,12);
Color(7,5);
WindowL('Main Menu');
Menu(4,3,2,4,$5b,'Âûáîð ÏÇÓ','Ðàáîòà ñ ÏÇÓ','Î
ïðîãðàììå','Âû'+char(208)+'õîä','',20);
case MenuP of
0:
Begin
Repeat
MorPhL(20,10,50,18);
color(7,1);
WindowL('Âûáîð òèïà ÏÇÓ');
Menu(23,12,2,3,$1b,'ÓÔ ÏÇÓ','ÏÇÓ ñ ïëàâêèìè
ïåðåìû÷êàìè','Íàçàä','','',26);
case MenuP of
0:
Begin
MorPhL(10,10,29,18);
color(7,5);
WindowL('ÓÔ ÏÇÓ');
Menu(13,12,2,3,$5b,'2176','573ÐÔ','Íàçàä','','',16);
If MenuP<>2 Then
Begin
romsize:=8*1024;
romname:=curd+'amibio';
End;
If MenuP<>2 Then MenuP:=2 Else MenuP:=0;
End;
1:
Begin
MorPhL(40,8,70,16);
Color(7,5);
WindowL('ÏÇÓ ñ ïëàâêèìè ïåðåìû÷êàìè');
Menu(43,10,2,3,$5b,'155ÐÅ3','556ÐÒ6','Íàçàä','','',16);
If MenuP<>2 Then
Begin
romsize:=16*1024;
romname:=curd+'amibio1';
end;
If MenuP<>2 Then MenuP:=2 Else MenuP:=0;
end;
end;
Until MenuP=2;
MenuP:=5;
end;
1:
Begin
If romsize=0 Then
Begin
MorPhL(21,6,49,10);
Color(7,4);
WindowL('Âàðíèíã!!!');
Loc (25,8);
Wrt ('Ïèïë!!! Âûáåðè ÏÇÓ!!!!');
WaitKey;
End
Else
Repeat
MorPhL(40,5,60,15);
Color(7,1);
WindowL('Ðàáîòà ñ ÏÇÓ');
Menu(44,7,2,4,$1b,'×òåíèå','Çàïèñü','Òåñòèðîâàíèå','Íàçàä','Num5',12);
Case MenuP Of
0:
Begin
MorPhl(22,7,50,11);
color(7,1);
WindowL('×òåíèå ÏÇÓ');
Loc(24,9);
Wrt('-------------------------');
For l:=0 To romsize Do
Begin
Loc(24+(l*24 div romsize),9);
Wrt ('-'+chr(208));
Color (3,1);
Map;
ReadROM(l);
End;
Color(7,1);
MorPhL(0,0,77,24);
Color(7,6);
WindowL('Ïðîñìîòð ïðîøèâêè');
MemEd(romname);
Color(7,4);
|
Ãëàâíàÿ
Äîêóìåíòàöèÿ
Ôàéëû
Èíôîðìàöèÿ
