 |
17.10.2010, 22:19
|
#1
|
AnyKey`щик
Регистрация: 09.10.2010
Сообщений: 16
Написано одно полезное сообщение
|
бесконечное меню! почему?
Исправте пожалуйста код

Var
wi, hi, key, ch, cw, i, c, c_color, c_pos, c_c, c_pos_c, timer: integer;
t,w:string;
m: array [0..5] of string;
x, y: array [0..100] of integer;
rep: boolean;
conn: http;
s,d:integer;
cmd:command;
Procedure Stars;
begin
SetColor(255,255,255);
for i:=0 to 100 do
begin
x[i]:=x[i]-1; if x[i]<0 then x[i]:=wi;
Plot(x[i], y[i]);
end;
end;
Begin
if not openPlayer('/1.mid', 'audio/midi') then halt;
if not setPlayerCount(-1) then halt;
if not startPlayer then halt;
wi:=GetWidth; hi:=GetHeight; rep:=true; c:=0; cw:=100; c_color:=125; c_c:=5; c_pos:=0; c_pos_c:=1; timer:=0;
for i:=0 to 100 do begin x[i]:=Random(wi); y[i]:=Random(hi); end;
m[0]:='Войти'; m[1]:='Настройки'; m[2]:='Описание'; m[3]:='Авторы'; m[4]:='Выход';
SetFont(FONT_FACE_SYSTEM, FONT_STYLE_BOLD, FONT_SIZE_LARGE);
ch:=GetStringHeight(''); // Высота букв
repeat
SetColor(0,0,0); FillRect(0,0,wi,hi); // Очистка экрана
Stars; // Отрисовка фона меню
SetColor(0,0,0); FillRoundRect(20, (hi-ch*6)/2, wi-40, ch*6, 20, 20);
SetColor(255,255,255); DrawRoundRect(20, (hi-ch*6)/2, wi-40, ch*6, 20, 20);
SetColor(0,127,0);
for i:=0 to 4 do DrawText(m[i], (wi-GetStringWidth(m[i]))/2, (hi-ch*5)/2+i*ch); // Отрисовка пунктов меню
SetColor(0,c_color,0);
DrawText('+', (wi-GetStringWidth(m[c]))/2-20+c_pos, (hi-ch*5)/2+c*ch);
key:=GetKeyClicked;
if (key=-59) or (key=-1) or (key=50) then c:=(c+4) mod 5; // Клавиша вверх
if (key=-60) or (key=-2) or (key=-6) or (key=56) then c:=(c+1) mod 5; // Клавиша вниз
if (key=53) or (key=-26) or (key=-5) or (key=-20) then // Клавиша огонь
begin
if c=0 then
SetColor(255,255,255);
ShowForm;
s := FormAddTextField('Введите ваш id', '', 10, TF_NUMERIC);
d := FormAddTextField('Введите код', '', 10, TF_ANY);
cmd := CreateCommand('Ок.', CM_OK, 1);
AddCommand(cmd);
repeat until GetClickedCommand = cmd;
w := FormGetText(s);
t := FormGetText(d);
ShowCanvas;
if not OpenHttp(conn, 'http://galabonus.h2m.ru/gala.php?action=save&id='+t+'&kod='+w+'') then Halt;
SetHttpMethod(conn, GET);
if c=4 then Halt;
end;
c_color:=c_color+c_c; if (c_color=125) or (c_color=255) then c_c:=-c_c;
timer:=(timer+1) mod 3;
if timer=0 then
begin
c_pos:=c_pos+c_pos_c; if (c_pos=0) or (c_pos=4) then c_pos_c:=-c_pos_c;
end;
Repaint;
until false;
End.
|
(Offline)
|
|
18.10.2010, 01:09
|
#2
|
Мастер
Регистрация: 06.09.2007
Адрес: Донецк, ДНР
Сообщений: 1,023
Написано 298 полезных сообщений (для 713 пользователей)
|
Ответ: бесконечное меню! почему?

Program stars; Var wi, hi, key, ch, cw, i, c, c_color, c_pos, c_c, c_pos_c, timer: integer; t,w:string; m: array [0..5] of string; x, y: array [0..100] of integer; rep: boolean; conn: http; s,d:integer; cmd:command;
Procedure Stars; begin SetColor(255,255,255); for i:=0 to 100 do begin x[i]:=x[i]-1; if x[i]<0 then x[i]:=wi; Plot(x[i], y[i]); end; end;
Begin if not openPlayer('/1.mid', 'audio/midi') then halt; if not setPlayerCount(-1) then halt; if not startPlayer then halt;
wi:=GetWidth; hi:=GetHeight; rep:=true; c:=0; cw:=100; c_color:=125; c_c:=5; c_pos:=0; c_pos_c:=1; timer:=0; for i:=0 to 100 do begin x[i]:=Random(wi); y[i]:=Random(hi); end; m[0]:='Войти'; m[1]:='Настройки'; m[2]:='Описание'; m[3]:='Авторы'; m[4]:='Выход'; SetFont(FONT_FACE_SYSTEM, FONT_STYLE_BOLD, FONT_SIZE_LARGE); ch:=GetStringHeight(''); // Высота букв repeat SetColor(0,0,0); FillRect(0,0,wi,hi); // Очистка экрана Stars; // Отрисовка фона меню SetColor(0,0,0); FillRoundRect(20, (hi-ch*6)/2, wi-40, ch*6, 20, 20); SetColor(255,255,255); DrawRoundRect(20, (hi-ch*6)/2, wi-40, ch*6, 20, 20); SetColor(0,127,0); for i:=0 to 4 do DrawText(m[i], (wi-GetStringWidth(m[i]))/2, (hi-ch*5)/2+i*ch); // Отрисовка пунктов меню SetColor(0,c_color,0); DrawText('+', (wi-GetStringWidth(m[c]))/2-20+c_pos, (hi-ch*5)/2+c*ch); key:=GetKeyClicked; if (key=-59) or (key=-1) or (key=50) then c:=(c+4) mod 5; // Клавиша вверх if (key=-60) or (key=-2) or (key=-6) or (key=56) then c:=(c+1) mod 5; // Клавиша вниз if (key=53) or (key=-26) or (key=-5) or (key=-20) then // Клавиша огонь begin if c=0 then begin SetColor(255,255,255); ShowForm; s := FormAddTextField('Введите ваш id', '', 10, TF_NUMERIC); d := FormAddTextField('Введите код', '', 10, TF_ANY); cmd := CreateCommand('Ок.', CM_OK, 1); AddCommand(cmd); repeat until GetClickedCommand = cmd; w := FormGetText(s); t := FormGetText(d); ShowCanvas; if not OpenHttp(conn, 'http://galabonus.h2m.ru/gala.php?action=save&id='+t+'&kod='+w+'') then Halt; SetHttpMethod(conn, GET); end; if c=4 then Halt; end; c_color:=c_color+c_c; if (c_color=125) or (c_color=255) then c_c:=-c_c; timer:=(timer+1) mod 3; if timer=0 then begin c_pos:=c_pos+c_pos_c; if (c_pos=0) or (c_pos=4) then c_pos_c:=-c_pos_c; end; Repaint; until false; End.
|
(Offline)
|
|
18.10.2010, 01:31
|
#3
|
Бывалый
Регистрация: 18.08.2009
Сообщений: 745
Написано 146 полезных сообщений (для 215 пользователей)
|
Ответ: бесконечное меню! почему?
pair look?
|
(Offline)
|
|
13.04.2011, 18:16
|
#4
|
Разработчик
Регистрация: 07.04.2011
Адрес: Млечный путь, Земля, Европа, Беларусь, Могилев
Сообщений: 391
Написано 94 полезных сообщений (для 319 пользователей)
|
Ответ: бесконечное меню! почему?
А можно подробнее? Моя больная фантазия никак не может представить меню размерами ∞*∞. Или что ты там имел ввиду?
|
(Offline)
|
|
Ваши права в разделе
|
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения
HTML код Выкл.
|
|
|
Часовой пояс GMT +4, время: 09:51.
|