|
27.08.2009, 17:47
|
#1
|
Знающий
Регистрация: 16.09.2008
Сообщений: 299
Написано 71 полезных сообщений (для 123 пользователей)
|
алгоритмы j2me для рисованного интерфейса
Давайте складывать сюда свои оптимизированные алгоритмы и примеры для создания графических интерфейсов, меню, и т.д.
___
Вот моя реализация собственного шрифта с минимальными потребностями в памяти и без использования png-картинок.
//Raster font 8x8 form PC BIOS.
//programming by arT (c). e-mail: [email protected]
//
//Пример создания и работы с собственным растровым шрифтом в MidletPascal
//каждый символ занимает 64 bit (два числах типа integer).
//в примере заготовлены две кодовые таблицы: оригинальная CP866 (dos) и конвертированная в CP1251 (win).
//Исходный шрифт взят из знакогенератора BIOS.
//
//Используемые подпрограммы:
//procedure text(x,y : integer; s : string); - вывод текста "s" в позиции "x,y"
//function win2utf(s : string) : string; - конвертироание из win в utf8 кодировку
//function utf2win(s : string) : string; - конвертироание из utf8 в win кодировку
var
f : array[0..511] of integer; //битовый образ шрифта 0..255,8x8
s : string;
c : char;
i,j,k,h,w : integer;
bool : boolean;
procedure text(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;
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;
begin
//{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;
w:=getWidth;
h:=getHeight;
setColor(0,0,0);
fillRect(0,0,w,h);
setColor(0,255,0);
//{test} drawText(win2utf(utf2win('АБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯабвгдежзийклмнопрстуфхцчшщъыьэюя')),0,20);
text(0,0,utf2win('PC BIOS code page'));
setColor(0,255,255);
text(0,8,utf2win('Привет мир!'));
repaint;
repeat delay(1000); until false;
end.
Последний раз редактировалось abcdef, 27.08.2009 в 17:56.
|
(Offline)
|
|
Эти 7 пользователя(ей) сказали Спасибо abcdef за это полезное сообщение:
|
|
31.08.2009, 12:50
|
#2
|
Знающий
Регистрация: 16.09.2008
Сообщений: 299
Написано 71 полезных сообщений (для 123 пользователей)
|
Ответ: алгоритмы j2me для рисованного интерфейса
Аналогичный алгоритм собственного шрифта размер 5x6 (русификация моя), занимающий массив integer (32 bit) всего из 256 элементов.
Образы шрифтов загружены с http://www.ticalc.org/archives/files...260/26014.html и где-то отсюда: http://www.menuetos.net/
В архиве найденные шрифты в текстовом формате и моя программа для конвертирования в массив longInt (32 bit) на TurboPascal7.1
p.s.: выкладывайте если улучшите отображение символов, заранее спасибо!
//Raster font 5x6.
//programming by arT (c). e-mail: [email protected]
//
//Пример создания и работы с собственным растровым шрифтом в MidletPascal
//каждый символ занимает 30 bit (число типа integer). Оставшиеся 2 bit'а (0011 bin = 04 dec) + 1
//можно использовать под ширину символа, если делать не моноширинный шрифт
//
//Используемые подпрограммы:
//procedure text(x,y : integer; s : string); - вывод текста "s" в позиции "x,y"
//function win2utf(s : string) : string; - конвертироание из win в utf8 кодировку
//function utf2win(s : string) : string; - конвертироание из utf8 в win кодировку
var
f : array[0..255] of integer; //битовый образ шрифта 0..255,5x6
s : string;
c : char;
i,j,k,h,w : integer;
bool : boolean;
procedure text(x,y : integer; s : string);
// вывод шрифта 5x6 из битового образа f[0..255]
var
c,i,len : integer;
begin
len:=length(s)-1;
for i:=0 to len do
begin
c:=f[ord(getChar(s,i)) and 255];
if ((c and 536870912)<>0) then plot(x,y);
if ((c and 268435456)<>0) then plot(x+1,y);
if ((c and 134217728)<>0) then plot(x+2,y);
if ((c and 67108864)<>0) then plot(x+3,y);
if ((c and 33554432)<>0) then plot(x+4,y);
y:=y+1;
if ((c and 16777216)<>0) then plot(x,y);
if ((c and 8388608)<>0) then plot(x+1,y);
if ((c and 4194304)<>0) then plot(x+2,y);
if ((c and 2097152)<>0) then plot(x+3,y);
if ((c and 1048576)<>0) then plot(x+4,y);
y:=y+1;
if ((c and 524288)<>0) then plot(x,y);
if ((c and 262144)<>0) then plot(x+1,y);
if ((c and 131072)<>0) then plot(x+2,y);
if ((c and 65536)<>0) then plot(x+3,y);
if ((c and 32768)<>0) then plot(x+4,y);
y:=y+1;
if ((c and 16384)<>0) then plot(x,y);
if ((c and 8192)<>0) then plot(x+1,y);
if ((c and 4096)<>0) then plot(x+2,y);
if ((c and 2048)<>0) then plot(x+3,y);
if ((c and 1024)<>0) then plot(x+4,y);
y:=y+1;
if ((c and 512)<>0) then plot(x,y);
if ((c and 256)<>0) then plot(x+1,y);
if ((c and 128)<>0) then plot(x+2,y);
if ((c and 64)<>0) then plot(x+3,y);
if ((c and 32)<>0) then plot(x+4,y);
y:=y+1;
if ((c and 16)<>0) then plot(x,y);
if ((c and 8)<>0) then plot(x+1,y);
if ((c and 4)<>0) then plot(x+2,y);
if ((c and 2)<>0) then plot(x+3,y);
if ((c and 1)<>0) then plot(x+4,y);
y:=y-5;
x:=x+5;
end;
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;
begin
s:='0,33408703,33226623,29342148,4685252,15579278,15710350,473088,33081343,0,0,4477576,9053064,0,12921670,22506965,8796552,2308290,4657604,10823690,32319818,4665796,1023,4657631,4657284,4329924,97344,294144,556032,359744,146400,1030272,0,8658952,10813440,21976020,149297604,10625344,14825920,8650752,4464900,8523912,10627072,145536,132,458752,128,2232584,4532548,12718212,12652814,12652620,10827842,14954572,4469060,14749832,6623564,4528204,4100,131204,2236546,14694400,8521864,12652548,13195790,6633802,12923212,6562054,12921164,12857612,12857608,6564166,10828106,14815374,14832268,10826058,8659214,32467538,19749458,13191756,12923144,4532614,12923210,6557772,14815364,10824006,10823812,19491806,10817866,10817668,14749966,12853516,17309828,12718220,270976,14,8519680,414348,17584776,139524,4608652,291340,4469000,13250712,17584788,4198532,4198536,17457812,4329604,555986,807572,283272,25842448,13259140,401672,401548,8790276,676492,676104,617436,664212,21635344,397580,4481284,4329604,17051920,14016,0,0,0,136,12874000,660,672,9314568,9315208,9043968,27930967,281551000,16896,15358606,4539716,15400622,11191620,149935246,17301504,17301504,21626880,21626880,25344,448,992,448512,12582912,403054732,16896,351887,70424,9064724,20992648,0,16794128,4673988,6582558,17967249,21898120,17302032,428484812,350499086,15259182,13250560,21120,900,24576,15259182,29360128,9052160,9315200,8937472,25452544,8912896,21648272,15558986,16384,2585100,17301504,9052188,21120,19542358,19542358,28193238,8397324,6633802,14954828,12923212,14950664,15018993,14954766,22723253,12660812,19487570,153705298,10826058,6629722,30370386,10828106,13191756,15018314,12923144,6562054,14815364,10817672,15390148,10817866,10824130,10827842,22730720,22730721,25442638,18413245,8665422,29440092,24835767,6625610,414348,942748,17592984,467208,207313,487948,703157,464972,613202,4807506,680596,207194,555986,676756,283272,938644,938896,139524,462980,676112,4675012,664212,676740,684164,710624,710625,801102,587453,276814,931932,784055,207050,';
j:=0;
for i:=0 to 255 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;
w:=getWidth;
h:=getHeight;
setColor(0,0,0);
fillRect(0,0,w,h);
setColor(0,255,0);
text(0,0,utf2win('Small font 5x6 by arT(c)'));
text(0,7,utf2win('e-mail: [email protected]'));
setColor(0,255,255);
text(0,13,utf2win('Привет мир!'));
repaint;
repeat delay(1000); until false;
end.
Последний раз редактировалось abcdef, 31.08.2009 в 14:41.
|
(Offline)
|
|
Сообщение было полезно следующим пользователям:
|
|
31.08.2009, 12:58
|
#3
|
Элита
Регистрация: 14.06.2008
Адрес: Украина, Киев
Сообщений: 2,273
Написано 754 полезных сообщений (для 1,833 пользователей)
|
Ответ: алгоритмы j2me для рисованного интерфейса
А можно пример рабочего приложение с отображением текста на полный экран таким шрифтом? А то МП не установлен, но тема интересна. Я как-то проводил тесты по отрисовке отдельных точек на канвасе и результаты были удручающими =(
|
(Offline)
|
|
31.08.2009, 15:31
|
#4
|
Знающий
Регистрация: 16.09.2008
Сообщений: 299
Написано 71 полезных сообщений (для 123 пользователей)
|
Ответ: алгоритмы j2me для рисованного интерфейса
средняя скорость трех замеров печати 10000 символов на motorola V3i
стандартный метод drawText: 11256 ms.
собственная подпрограмма text: 20840 ms.
time:=getRelativeTimeMs;
for i:=0 to 9999 do
begin
setColor(random(255),random(255),random(255));
//drawText(chr(random(255)),random(w-7),20+random(h-25));
text(random(w-7),20+random(h-25),chr(random(255)));
end;
setColor(255,255,255);
text(0,0,utf2win(''+(getRelativeTimeMs-time)));
repaint;
исполняемый jar файл выложил в прошлом сообщении
Последний раз редактировалось abcdef, 31.08.2009 в 15:39.
|
(Offline)
|
|
Эти 2 пользователя(ей) сказали Спасибо abcdef за это полезное сообщение:
|
|
22.09.2009, 18:00
|
#5
|
Знающий
Регистрация: 16.09.2008
Сообщений: 299
Написано 71 полезных сообщений (для 123 пользователей)
|
Ответ: алгоритмы j2me для рисованного интерфейса
Пример эмулятор консольного вывода стандартным шрифтом телефона в граф. режиме (реализован перенос и прокрутка)
//console demo. arT(c). e-mail: [email protected]
var
tx,ty : integer; //положение курсора и максимальная высота букв
tw,th : integer; //размеры области вывода
tb,tc : integer; //цвет фона и букв
sleep : integer; //скорость прокрутки
procedure print(s : string);
//консольный вывод, управляющие символы: chr(10)-курсор на новую строку, chr(13)-курсор в начало строки
var
c,i,len,xx : integer;
begin
setColor(((tc div $10000) and $FF),((tc div $100) and $FF),(tc and $FF));
c:=getStringHeight(s);
if c>ty then ty:=c;
len:=length(s)-1;
for i:=0 to len do
begin
c:=ord(getChar(s,i));
if (c>=32) then xx:=tx+getStringWidth(chr(c))+1
else if (c=10) then xx:=tw
else if (c=13) then tx:=0;
if (xx>=tw) then //scroll screen
begin
drawImage(imageFromCanvas(0,ty,tw,th-ty),0,0);
setColor(((tb div $10000) and $FF),((tb div $100) and $FF),(tb and $FF)); //back color
fillRect(0,th-ty,tw,ty);
setColor(((tc div $10000) and $FF),((tc div $100) and $FF),(tc and $FF)); //text color
repaint;
delay(sleep);
ty:=getStringHeight(s);
xx:=xx-tx;
tx:=0;
end;
if (c>=32) then begin drawText(chr(c),tx,th-ty); tx:=xx; end;
end;
repaint;
end;
procedure init;
begin
tw:=getWidth;
th:=96; //getHeight;
tx:=0;
sleep:=200;
tb:=0*$10000+0*$100+20; //backRGB
tc:=230*$10000+230*$100+120; //textRGB
setColor(((tb div $10000) and $FF),((tb div $100) and $FF),(tb and $FF));
fillRect(0,0,tw,th);
end;
var
i : integer;
begin
init;
print('console output demo'+chr(10));
for i:=0 to 18 do
begin
tc:=$10000*i*40+$100*i*40+i*40;
print('text'+chr(13));
delay(150);
end;
print(chr(10));
print('ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'+chr(10));
print('1'+chr(10));
print('2'+chr(10));
print('END');
repeat delay(100); until false;
end.
|
(Offline)
|
|
19.11.2009, 15:25
|
#6
|
Знающий
Регистрация: 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.
Причина: доработка кода
|
(Offline)
|
|
Эти 2 пользователя(ей) сказали Спасибо abcdef за это полезное сообщение:
|
|
20.11.2009, 18:28
|
#7
|
Бывалый
Регистрация: 18.08.2009
Сообщений: 745
Написано 146 полезных сообщений (для 215 пользователей)
|
Ответ: алгоритмы j2me для рисованного интерфейса
abcdef, круто!
доделать бы срт и граф сделать, так этой штуке цены б не было)))
|
(Offline)
|
|
24.11.2009, 16:17
|
#8
|
Знающий
Регистрация: 16.09.2008
Сообщений: 299
Написано 71 полезных сообщений (для 123 пользователей)
|
Ответ: алгоритмы j2me для рисованного интерфейса
Доработал кода функций модуля CRT,
а вот адаптация pascal программ работы с файлами (только для чтения)
type
text = record
f : resource;
eof : boolean;
end;
var
IOres : integer;
procedure assign(f : text; name : string);
begin
f.f:=openResource('/'+name);
f.eof:=false;
end;
procedure reset(f : text);
begin
if (resourceAvailable(f.f)) then IOres:=0
else IOres:=1;
end;
procedure close(f : text);
begin
closeResource(f.f);
end;
function IOresult : integer;
begin
IOresult:=IOres;
IOres:=0;
end;
function eof(r : text) : boolean;
begin
eof:=r.eof;
end;
function system_read(f : text) : char;
var
b : integer;
begin
b:=readByte(f.f) and 255;
if b=0 then f.eof:=true;
system_read:=chr(b);
end;
{========}
var
f : text;
c : char;
begin
assign(f,fname);
reset(f);
if IOresult=0 then
begin
while not eof(f) do
begin
c:=system_read(f);
write(c);
...
end;
close(f);
end;
end;
|
(Offline)
|
|
Ваши права в разделе
|
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения
HTML код Выкл.
|
|
|
Часовой пояс GMT +4, время: 14:25.
|