|
Знающий
Регистрация: 16.09.2008
Сообщений: 299
Написано 71 полезных сообщений
(для 123 пользователей)
|
Ответ: алгоритмы j2me для рисованного интерфейса
Эмуляция некоторых функций модуля CRT для TurboPascal.
Реализованы функции вывода текста, управление EGA цветом символов и цветом заднего фона, установка курсора и получение его координат, получение кода нажатой клавиши, ввод строк и чисел.
__
getkey предлагает набор стандартных скан-кодов клавиш, также при вызове этой подпрограммы может осуществляться прокрутка экрана по клавишим влево-вправо. При отсутствии нажатых клавиш возвращает chr(0)
________
iodos.mpsrc
 //DOS - IO emulation.
//programming by arT (c). e-mail: [email protected]
unit iodos;
interface
var
textAttr : integer; //установить текущий DOS-цвет
lenLine : integer; //length of line of symbols
procedure clrscr; //очистка экрана текущим цветом и установка курсора в начало
procedure update(p1,p2 : integer); //обновить участок экрана c позиции p1 по p2
function wherex : integer; //текущая позиция по X
function wherey : integer; //текущая позиция по Y
procedure gotoxy(x,y : integer); //установить курсор в позицию X,Y
function getkey : char; //получить код клавиши, а также прокрутка экрана, иначе chr(0)
function readlnstr : string; //получить введенную строку
function readlnnum : integer; //получить введенный номер
procedure textOut(x,y : integer; s : string); //прямой вывод текста в координаты [0..w,0..h]
procedure write(s : string); //вывод текста с текущей позиции, символы меньше chr(14) не отображаются, кроме chr(10)
procedure writeln(s : string);
function win2utf(s : string) : string; //конвертирование русских символов из WIN в UTF
function utf2win(s : string) : string; //конвертирование русских символов из UTF в WIN
function utf2dos(s : string) : string; //конвертирование русских символов из UTF в DOS
implementation
var
f : array[0..511] of integer; //битовый образ шрифта 0..255,8x8
r,g,b : array[0..15] of integer; //EGA - palette
data : string; //DOS - data text
pos,yscroll : integer; //cursor
w,h : integer; //screen size
fill : char; //clrScr default color
////////////////////////////////////////////
procedure init;
var
s : string;
c : char;
i,j,k : integer;
bool : boolean;
begin
// standard EGA - palette
r[0] := 0; g[0] := 0; b[0] := 0;
r[1] := 0; g[1] := 0; b[1] := 168;
r[2] := 0; g[2] := 168; b[2] := 0;
r[3] := 84; g[3] := 252; b[3] := 252;
r[4] := 168; g[4] := 0; b[4] := 0;
r[5] := 168; g[5] := 0; b[5] := 168;
r[6] := 168; g[6] := 168; b[6] := 0;
r[7] := 168; g[7] := 168; b[7] := 168;
r[8] := 84; g[8] := 84; b[8] := 84;
r[9] := 84; g[9] := 84; b[9] := 252;
r[10] := 84; g[10] := 252; b[10] := 84;
r[11] := 0; g[11] := 168; b[11] := 168;
r[12] := 252; g[12] := 84; b[12] := 84;
r[13] := 252; g[13] := 84; b[13] := 252;
r[14] := 252; g[14] := 252; b[14] := 84;
r[15] := 252; g[15] := 252; b[15] := 252;
//BIOS font 8x8
{CP866} s:='0,0,2122425729,-1114013314,2130697215,-1008205954,1828650750,2084048896,272137470,2084048896,947665150,-19525576,272137470,-25423816,272137470,-25423816,272137470,-25423816,3958338,1113996288,3958338,1113996288,252120957,-858993544,1013343846,1008238104,1013343846,1008238104,2137227107,1667753664,417021159,-415442152,-2132739842,-119504896,34488062,1041105408,406617624,410926104,1717986918,1711302144,2145115003,454761216,1046559846,1715242620,0,2122219008,406617624,2117867775,406617624,404232192,404232216,2117867520,1576190,202899456,3170558,1613758464,49344,-1057095680,2385663,1713635328,1588350,-65536,16777086,1008205824,0,0,406600728,402659328,1717969920,0,1819082348,-26448896,406741052,108795904,13028376,812041728,946616438,-590580224,404238336,0,202911792,806882304,806882316,202911744,6700287,1013317632,1579134,404226048,0,1579056,126,0,0,1579008,101455920,1623228416,2093403862,-423199744,406329368,404258304,2093352476,812056064,2093352508,113671168,473722060,-32760320,-20922116,113671168,945864956,-960070656,-20575208,808464384,2093401724,-960070656,2093401726,101480448,1579008,1579008,1579008,1579056,101455920,403441152,32256,8257536,1613764620,405823488,2093354008,402659328,2093407966,-557811712,946652926,-960051712,-60397956,1718025216,1013366976,-1067041792,-127113626,1718417408,-27105160,1751318016,-27105160,1751183360,1013366976,-832161280,-960051458,-960051712,1008211992,404241408,504105996,-859015168,-429495176,1818682880,-262119328,1650916864,-957415682,-691616256,-957942050,-825833984,2093401798,-960070656,-60397956,1616965632,2093401798,-959546354,-60397956,1818682880,2093375544,214334464,2122209816,404241408,-960051514,-960070656,-960051514,-965986304,-960051498,-687969280,-960074696,1824966144,1717986876,404241408,-20542440,845610496,1009791024,808467456,-1067438056,201720320,1007422476,202128384,272133318,0,0,255,806882304,0,30732,2093774336,-530547610,1718017024,31942,-1060733952,470580428,-859015680,31942,-20939776,1013342456,1616965632,30412,-864285448,-530551690,1718019584,402667544,404241408,100664838,107374140,-530553236,2020402688,941103128,404241408,60670,-690563584,56422,1717986816,31942,-960070656,56422,1719427312,30412,-864285666,56438,1616965632,32448,2080832512,808516656,808852480,52428,-859015680,50886,-965986304,50902,-687969280,50796,946652672,50886,-964819204,32332,405962240,236460144,404229632,404232216,404232192,1880627214,404254720,1994129408,0,1063020,-960037376,1046922950,-20527616,-26845060,1718025216,-60397956,1718025216,-26845088,1616965632,506881638,1718026179,-27105160,1751318016,-690586568,2094454272,2093352508,113671168,-960049442,-152648192,952553182,-152648192,-429495176,1818682880,506881638,1718011392,-957415682,-691616256,-960051458,-960051712,2093401798,-960070656,-20527418,-960051712,-60397978,2086727680,2093400256,-1060733952,2119833624,404241408,-960051586,113671168,2094454486,2081437696,-960074696,1824966144,-858993460,-858980858,-960051586,101058048,-690563370,-690553344,-690563370,-690553085,-252661700,909523968,-960051466,-555813376,-262119300,1717992448,2022442558,109869056,-589900042,-690562048,2126956230,2120664576,30732,2093774336,108839036,-960070656,64614,2087123968,65126,1616965632,15468,1819082438,31942,-20939776,54908,947705344,31942,482769920,50894,-554244608,3720910,-554244608,58988,2020402688,15974,1718019584,50942,-19479040,50886,-20527616,31942,-960070656,65222,-960051712,289673540,289673540,1437226410,1437226410,-579347081,-579347081,404232216,404232216,404232440,404232216,418912504,404232216,909522678,909522486,254,909522486,16259320,404232216,922093302,909522486,909522486,909522486,16647926,909522486,922093310,0,909522686,0,418912504,0,248,404232216,404232223,0,404232447,0,255,404232216,404232223,404232216,255,0,404232447,404232216,404690975,404232216,909522487,909522486,909586495,0,4141111,909522486,922157311,0,16711927,909522486,909586487,909522486,16711935,0,922157303,909522486,419365119,0,909522687,0,16711935,404232216,255,909522486,909522495,0,404690975,0,2037791,404232216,63,909522486,909522687,909522486,419371263,404232216,404232440,0,31,404232216,-1,-1,255,-1,-252645136,-252645136,252645135,252645135,-256,0,64614,1719427312,31942,-1060733952,32346,404241408,50886,-964819332,31958,-696512456,50796,946652672,52428,-858980858,50886,2114323968,54998,-690553344,54998,-690553085,61616,1010187264,50886,-153160192,61536,2087123968,31942,516324352,56534,-153691136,32454,2120664576,1828610680,1617100288,1811971270,-20939776,1013367032,-1067041792,15971,2019769856,1215836208,808482816,-872402896,808482816,952551038,113671168,1815660230,-964819332,946629688,0,24,402653184,0,402653184,235670540,1815878656,-1882329092,-590558208,13008070,-964901376,15420,1010565120,0,0,';
//{CP1251} s:='0,0,2122425729,-1114013314,2130697215,-1008205954,1828650750,2084048896,272137470,2084048896,947665150,-19525576,272137470,-25423816,272137470,-25423816,272137470,-25423816,3958338,1113996288,3958338,1113996288,252120957,-858993544,1013343846,1008238104,1013343846,1008238104,2137227107,1667753664,417021159,-415442152,-2132739842,-119504896,34488062,1041105408,406617624,410926104,1717986918,1711302144,2145115003,454761216,1046559846,1715242620,0,2122219008,406617624,2117867775,406617624,404232192,404232216,2117867520,1576190,202899456,3170558,1613758464,49344,-1057095680,2385663,1713635328,1588350,-65536,16777086,1008205824,0,0,406600728,402659328,1717969920,0,1819082348,-26448896,406741052,108795904,13028376,812041728,946616438,-590580224,404238336,0,202911792,806882304,806882316,202911744,6700287,1013317632,1579134,404226048,0,1579056,126,0,0,1579008,101455920,1623228416,2093403862,-423199744,406329368,404258304,2093352476,812056064,2093352508,113671168,473722060,-32760320,-20922116,113671168,945864956,-960070656,-20575208,808464384,2093401724,-960070656,2093401726,101480448,1579008,1579008,1579008,1579056,101455920,403441152,32256,8257536,1613764620,405823488,2093354008,402659328,2093407966,-557811712,946652926,-960051712,-60397956,1718025216,1013366976,-1067041792,-127113626,1718417408,-27105160,1751318016,-27105160,1751183360,1013366976,-832161280,-960051458,-960051712,1008211992,404241408,504105996,-859015168,-429495176,1818682880,-262119328,1650916864,-957415682,-691616256,-957942050,-825833984,2093401798,-960070656,-60397956,1616965632,2093401798,-959546354,-60397956,1818682880,2093375544,214334464,2122209816,404241408,-960051514,-960070656,-960051514,-965986304,-960051498,-687969280,-960074696,1824966144,1717986876,404241408,-20542440,845610496,1009791024,808467456,-1067438056,201720320,1007422476,202128384,272133318,0,0,255,806882304,0,30732,2093774336,-530547610,1718017024,31942,-1060733952,470580428,-859015680,31942,-20939776,1013342456,1616965632,30412,-864285448,-530551690,1718019584,402667544,404241408,100664838,107374140,-530553236,2020402688,941103128,404241408,60670,-690563584,56422,1717986816,31942,-960070656,56422,1719427312,30412,-864285666,56438,1616965632,32448,2080832512,808516656,808852480,52428,-859015680,50886,-965986304,50902,-687969280,50796,946652672,50886,-964819204,32332,405962240,236460144,404229632,404232216,404232192,1880627214,404254720,1994129408,0,1063020,-960037376,1046922950,-20527616,-26845060,1718025216,-60397956,1718025216,-26845088,1616965632,506881638,1718026179,-27105160,1751318016,-690586568,2094454272,2093352508,113671168,-960049442,-152648192,952553182,-152648192,-429495176,1818682880,506881638,1718011392,-957415682,-691616256,-960051458,-960051712,2093401798,-960070656,-20527418,-960051712,-60397978,2086727680,2093400256,-1060733952,2119833624,404241408,-960051586,113671168,2094454486,2081437696,-960074696,1824966144,-858993460,-858980858,-960051586,101058048,-690563370,-690553344,-690563370,-690553085,-252661700,909523968,-960051466,-555813376,-262119300,1717992448,2022442558,109869056,-589900042,-690562048,2126956230,2120664576,30732,2093774336,108839036,-960070656,64614,2087123968,65126,1616965632,15468,1819082438,31942,-20939776,54908,947705344,31942,482769920,1828610680,1617100288,3720910,-554244608,58988,2020402688,15974,1718019584,50942,-19479040,50886,-20527616,31942,-960070656,65222,-960051712,289673540,289673540,1437226410,1437226410,-579347081,-579347081,404232216,404232216,404232440,404232216,418912504,404232216,909522678,909522486,254,909522486,1811971270,-20939776,922093302,909522486,909522486,909522486,16647926,909522486,922093310,0,909522686,0,418912504,0,248,404232216,1046922950,-20527616,-26845060,1718025216,-60397956,1718025216,-26845088,1616965632,506881638,1718026179,-27105160,1751318016,-690586568,2094454272,2093352508,113671168,-960049442,-152648192,952553182,-152648192,-429495176,1818682880,506881638,1718011392,-957415682,-691616256,-960051458,-960051712,2093401798,-960070656,-20527418,-960051712,-60397978,2086727680,2093400256,-1060733952,2119833624,404241408,-960051586,113671168,2094454486,2081437696,-960074696,1824966144,-858993460,-858980858,-960051586,101058048,-690563370,-690553344,-690563370,-690553085,-252661700,909523968,-960051466,-555813376,-262119300,1717992448,2022442558,109869056,-589900042,-690562048,2126956230,2120664576,30732,2093774336,108839036,-960070656,64614,2087123968,65126,1616965632,15468,1819082438,31942,-20939776,54908,947705344,31942,482769920,50894,-554244608,3720910,-554244608,58988,2020402688,15974,1718019584,50942,-19479040,50886,-20527616,31942,-960070656,65222,-960051712,64614,1719427312,31942,-1060733952,32346,404241408,50886,-964819332,31958,-696512456,50796,946652672,52428,-858980858,50886,2114323968,54998,-690553344,54998,-690553085,61616,1010187264,50886,-153160192,61536,2087123968,31942,516324352,56534,-153691136,32454,2120664576,';
j:=0;
for i:=0 to 511 do
begin
bool:=false;
repeat
c:=getChar(s,j);
if (c='-') then bool:=true;
j:=j+1;
until (c>='0') and (c<='9');
k:=0;
repeat
k:=k*10+(ord(c)-ord('0'));
c:=getChar(s,j);
j:=j+1;
until (c<'0') or (c>'9');
if bool=true then k:=-k;
f[i]:=k;
end;
end;
procedure textOut(x,y : integer; s : string);
// вывод шрифта 8x8 из битового образа f[0..511]
var
c,i,j,p,len : integer;
begin
len:=length(s)-1;
for i:=0 to len do
begin
p:=(ord(getChar(s,i)) and 255)*2;
for j:=0 to 1 do
begin
c:=f[p+j];
if ((c and 2147483648)<>0) or (c<0) then plot(x,y);
if ((c and 1073741824)<>0) then plot(x+1,y);
if ((c and 536870912)<>0) then plot(x+2,y);
if ((c and 268435456)<>0) then plot(x+3,y);
if ((c and 134217728)<>0) then plot(x+4,y);
if ((c and 67108864)<>0) then plot(x+5,y);
if ((c and 33554432)<>0) then plot(x+6,y);
if ((c and 16777216)<>0) then plot(x+7,y);
y:=y+1;
if ((c and 8388608)<>0) then plot(x,y);
if ((c and 4194304)<>0) then plot(x+1,y);
if ((c and 2097152)<>0) then plot(x+2,y);
if ((c and 1048576)<>0) then plot(x+3,y);
if ((c and 524288)<>0) then plot(x+4,y);
if ((c and 262144)<>0) then plot(x+5,y);
if ((c and 131072)<>0) then plot(x+6,y);
if ((c and 65536)<>0) then plot(x+7,y);
y:=y+1;
if ((c and 32768)<>0) then plot(x,y);
if ((c and 16384)<>0) then plot(x+1,y);
if ((c and 8192)<>0) then plot(x+2,y);
if ((c and 4096)<>0) then plot(x+3,y);
if ((c and 2048)<>0) then plot(x+4,y);
if ((c and 1024)<>0) then plot(x+5,y);
if ((c and 512)<>0) then plot(x+6,y);
if ((c and 256)<>0) then plot(x+7,y);
y:=y+1;
if ((c and 128)<>0) then plot(x,y);
if ((c and 64)<>0) then plot(x+1,y);
if ((c and 32)<>0) then plot(x+2,y);
if ((c and 16)<>0) then plot(x+3,y);
if ((c and 8)<>0) then plot(x+4,y);
if ((c and 4)<>0) then plot(x+5,y);
if ((c and 2)<>0) then plot(x+6,y);
if ((c and 1)<>0) then plot(x+7,y);
y:=y+1;
end;
y:=y-8;
x:=x+8;
end;
end;
procedure update(p1,p2 : integer);
//обновить участок экрана c позиции p1 по p2
var
x,y,b0,b1,b2,old,c1,c2 : integer;
begin
x:=(p1 mod lenLine)*8;
y:=((p1 div lenLine)-yscroll)*8;
while (p1<p2) do
begin
if (y>=0) and (y+8<=h) then
begin
b0:=ord(getChar(data,p1));
b1:=(b0 and $00FF);
b2:=(b0 and $FF00);
if (b2<>old) then
begin
c1:=(b2 div $0100) and $0F;
c2:=(b2 div $1000) and $0F;
old:=b2;
end;
setColor(r[c2],g[c2],b[c2]);
fillRect(x,y,8,8);
setColor(r[c1],g[c1],b[c1]);
textOut(x,y,chr(b1));
end;
x:=x+8;
if (x+8>w) then
begin
x:=0;
y:=y+8;
end;
p1:=p1+1;
end;
//очистить остаток экрана
c2:=((ord(fill) and $FF00) div $1000) and $0F;
setColor(r[c2],g[c2],b[c2]);
b0:=length(data);
x:=(b0 mod lenLine)*8;
y:=((b0 div lenLine)-yscroll)*8;
fillRect(x,y,w-x,8);
fillRect(0,y+8,w,h);
repaint;
end;
procedure write(s : string);
//вывод текста с текущей позиции, символы меньше chr(14) не отображаются, кроме chr(10)
var
pos2,i,len,b : integer;
c : char;
begin
pos2:=pos;
if length(data)<pos then
begin
pos:=length(data);
while (length(data)<pos2) do data:=data+fill;
end;
len:=length(s)-1;
for i:=0 to len do
begin
b:=ord(getChar(s,i));
if (b>13) then
begin
c:=chr((textAttr*$100) + (b and $FF));
if pos2>=length(data) then data:=data+c;
else data:=setChar(data,c,pos2);
pos2:=pos2+1;
end
else if (b=10) then
begin
//c:=chr((textAttr*$100) + 32);
repeat
if pos2>=length(data) then data:=data+fill;
{ else data:=setChar(data,c,pos2);}
pos2:=pos2+1;
until (pos2 mod lenLine=0);
end;
end;
update(pos,pos2);
pos:=pos2;
end;
procedure writeln(s : string);
begin
write(s+chr(10));
end;
function win2utf(s : string) : string;
var {rus_ansi to unicode}
i,c : integer;
begin
for i:=length(s)-1 downto 0 do
begin
c:=ord(getChar(s,i)) and 255;
if (c>=192) then s:=setChar(s,chr(c+848),i);
if (c=168) then s:=setChar(s,chr($0401),i); {Ё}
if (c=184) then s:=setChar(s,chr($0451),i); {ё}
end;
win2utf := s;
end;
function utf2win(s : string) : string;
var
i,c : integer;
begin
for i:=length(s)-1 downto 0 do
begin
c:=ord(getChar(s,i));
if (c>255) then s:=setChar(s,chr(c-848),i);
if (c=$0401) then s:=setChar(s,chr(168),i); {Ё}
if (c=$0451) then s:=setChar(s,chr(184),i); {ё}
end;
utf2win := s;
end;
function utf2dos(s : string) : string;
var
i,c : integer;
begin
for i:=length(s)-1 downto 0 do
begin
c:=ord(getChar(s,i));
if c>255 then
begin
if c=$0401 then s:=setChar(s,chr(240),i)
else if c=$0451 then s:=setChar(s,chr(184),i)
else
begin
c:=c-848;
if (c>=192) then
begin
if (c>=224) then
begin
if (c>=240) then s:=setChar(s,chr(c-16),i);
else s:=setChar(s,chr(c-64),i);
end
else s:=setChar(s,chr(c-64),i);
end;
end;
end;
end;
utf2dos := s;
end;
function win2dos(c : char) : char;
begin {перекодировка из ANSI в ASCII кодировку}
if (c>=chr(192)) then
begin
if (c>=chr(224)) then
begin
if (c>=chr(240)) then win2dos:=chr(ord(c)-240+224)
else win2dos:=chr(ord(c)-224+160)
end
else win2dos:=chr(ord(c)-192+128)
end
else if c=chr(168) then win2dos:=chr(240)
else if c=chr(184) then win2dos:=chr(241)
else win2dos:=c;
end;
////////////////////////////////////////////
function getkey : char;
//получить код клавиши, а также прокрутка экрана, иначе chr(0)
var
k,k2,keyn,keyp,lasttime : integer;
s : string;
c : char;
begin
c:=chr(0);
s:=' ';
keyn:=KE_NONE;
lasttime:=getRelativeTimeMs;
repeat
k:=getKeyPressed;
if k<>KE_NONE then
begin
if (k<>keyn) then
begin
if (k=KE_KEY1) then s:='1,.:;"''!?+-*/\|^=<>(){}[]_`@#$%&~' //Chars...
else if (k=KE_KEY2) then s:='2abcабвгABCАБВГ' //Key2...
else if (k=KE_KEY3) then s:='3defдежзDEFДЕЖЗ' //Key3...
else if (k=KE_KEY4) then s:='4ghiийклGHIИЙКЛ' //Key4...
else if (k=KE_KEY5) then s:='5jklмнопJKLМНОП' //Key5...
else if (k=KE_KEY6) then s:='6mnoрстуMNOРСТУ' //Key6...
else if (k=KE_KEY7) then s:='7pqrsфхцчPQRSФХЦЧ' //Key7...
else if (k=KE_KEY8) then s:='8tuvшщыьъTUVШЩЫЬЪ' //Key8...
else if (k=KE_KEY9) then s:='9wxyzэюяWXYZЭЮЯ' //Key9...
else if (k=KE_KEY0) then s:='0 ' //Key0 / Space
else if (k=KE_STAR) then s:='*'+chr(72)+chr(80)+chr(77)+chr(75) //Cursor
else if (k=KE_POUND) then s:='#'+chr(8)+chr(13)+chr(27); //BackSpace / Enter / Esc
else
begin //иначе допольнительные клавиши, но не цифровые
k2:=keyToAction(k);
if k2=GA_UP then begin s:=chr(72); end;
if k2=GA_DOWN then begin s:=chr(80); end;
if k2=GA_LEFT then begin s:=chr(75); if yscroll>0 then begin yscroll:=yscroll-(h div 8)+1; update(0,length(data)); end; end;
if k2=GA_RIGHT then begin s:=chr(77); if yscroll<length(data) div lenLine then begin yscroll:=yscroll+(h div 8)-1; update(0,length(data)); end; end;
if k2=GA_FIRE then begin s:=chr(13); end;
if k2=GA_GAMEA then begin end;
if k2=GA_GAMEB then begin end;
if k2=GA_GAMEC then begin end;
if k2=GA_GAMED then begin end;
end;
s:=utf2dos(s);
keyp:=-1;
keyn:=k;
end;
keyp:=keyp+1;
if (keyp>=length(s)) then keyp:=0;
c:=getChar(copy(s,keyp,keyp+1),0);
setColor(0,0,0);
fillRect(w-8,h-8,8,8);
setColor(255,255,255);
textOut(w-8,h-8,c); //отобразим где-нить текущий выбранный код клавиши
repaint;
lasttime:=getRelativeTimeMs;
repeat until (getKeyPressed=KE_NONE) or (((getRelativeTimeMs-lasttime)>300) or (getRelativeTimeMs<lasttime));
delay(20);
end;
until ((getRelativeTimeMs-lasttime)>400) or (getRelativeTimeMs<lasttime) or (keyn=KE_NONE);
getkey:=c;
end;
function getstr(start_,end_ : char) : string;
//ввод диапазона символов с chr(start_) по chr(end_). Enter - завершить ввод
var
l : integer;
s : string;
c : char;
begin
l:=0;
s:='';
write('>');
repeat c:=getkey; until c=chr(0);
repeat
if (c<>chr(0)) then
begin
if (c>=start_) and (c<=end_) then
begin
l:=l+1;
s:=s+c;
pos:=pos-1; //back 1 char
write(c+'>'); //rewrite screen
end
else if (c=chr(8)) and (l>0) then
begin
l:=l-1;
s:=copy(s,0,l);
pos:=pos-2; //back 2 chars
write('> '); //rewrite screen
pos:=pos-1;
end;
end;
c:=getkey;
until (c=chr(13));
getStr:=s;
end;
function readlnstr : string;
//получить введенную строку
begin
readlnstr:=getStr(chr(32),chr(255));
end;
function readlnnum : integer;
//получить введенный номер
begin
readlnnum:=stringToInteger(getStr('0','9'));
end;
////////////////////////////////////////////
procedure clrscr;
//очистка экрана текущим цветом и установка курсора в начало
var
i : integer;
begin
pos:=0;
yscroll:=0;
data:='';
fill:=chr((textAttr*$100) + 32);
i:=(textAttr div $10) and $0F;
setColor(r[i],g[i],b[i]);
fillRect(0,0,w,h);
repaint;
end;
function wherex : integer;
//текущая позиция по X
begin
wherex:=(pos mod lenLine)+1;
end;
function wherey : integer;
//текущая позиция по Y
begin
wherey:=(pos div lenLine)+1;
end;
procedure gotoxy(xx,yy : integer);
//установить курсор в позицию X,Y
begin
pos:=((yy-1)*lenLine)+(xx-1);
end;
initialization
init;
w:=getWidth;
h:=getHeight;
lenLine:=w div 8;
textAttr:=$07;
clrScr;
end.
___________
demo.mpsrc
uses IOdos;
var
n : integer;
key : char;
s : string;
begin
for n:=0 to 24 do write('ironwoodcutter_bk.ru '+n+' ');
writeln('ironwoodcutter_bk.ru 25');
writeln('ironwoodcutter_bk.ru 26');
writeln('ironwoodcutter_bk.ru 27');
writeln('ironwoodcutter_bk.ru 28');
writeln('ironwoodcutter_bk.ru 29');
writeln('ironwoodcutter_bk.ru 30');
gotoxy(1,100);
writeln('--------');
gotoxy(1,1);
repeat
textAttr:=random(8)*16+(random(8)+8);
key:=getkey;
write(key);
delay(100);
until key=chr(13);
textAttr:=$1E;
clrScr;
write('*');
gotoxy(2,4);
writeln('cursor:'+wherex+','+wherey);
s:=readlnstr;
write('['+s+']'+chr(10)+chr(10));
textAttr:=$1F;
n:=readlnnum;
write('['+n+']'+chr(10)+'END.');
delay(2000);
end.
Последний раз редактировалось abcdef, 24.11.2009 в 16:06.
Причина: доработка кода
|