Вaши прогрaммы и игры нa MobPascal 5.04.2013 / 06:35 | | 1JavaMods1 Пользователь Сейчас: Offline
Регистрация: 20.07.2012
| Хрестики Нолики, моя первая игра на MIDlet Pascal
Прикрепленные файлы: kvsn.jar (7.04 кб.) Скачано 180 раз |
5.04.2013 / 07:04 | | 1JavaMods1 Пользователь Сейчас: Offline
Регистрация: 20.07.2012
| как добавить музыку в игру?Код игры: Открыть спойлер Закрыть спойлер program kvns;
procedure CreateMenu;forward;
var _About,_Play,_Exit: integer; cmdOK, cmdContinue, cmdExit, clicked:command; p:array [1..9] of char;//наше поле, будет заполнятся буквами
Ximg,Oimg:image; const About='Про разраба'; CopyRigth='1JavaMods1 (c) 2013';
procedure CreateAbout; var i:integer;//отступ сверху img:image; begin
ShowCanvas; RemoveCommand(cmdExit); AddCommand(cmdOK); SetClip(0, 0, GetWidth, GetHeight); SetColor(255,255,255); FillRect(0,0,GetWidth, GetHeight); SetColor(0,0,0); SetFont(FONT_FACE_SYSTEM,FONT_STYLE_BOLD,FONT_SIZE_LARGE); DrawText(About,(GetWidth - GetStringWidth(About))/2,0); i:=GetStringHeight(About)+5; img:=LoadImage('/logo.png'); DrawImage(img, (GetWidth-getImageWidth(img))/2,i); i:=i+getImageHeight(img)+5; SetFont(FONT_FACE_PROPORTIONAL,FONT_STYLE_PLAIN ,FONT_SIZE_SMALL); DrawText(CopyRigth+chr(10),(GetWidth - GetStringWidth(CopyRigth))/2,i);
repaint;
repeat delay(100); clicked := GetClickedCommand; until clicked <> EmptyCommand; CreateMenu; end;
procedure drawPlace; var i,y:integer; begin SetColor(0,0,0); //рисуем решетку //горизонтальные линии i:=(GetHeight div 2); y:=i div 4; DrawLine(0, (i div 2)+y , GetWidth, (i div 2)+y ); //DrawLine(0, i, GetWidth, i); DrawLine(0, i+(i div 2) - y, GetWidth, i+(i div 2)-y);
//вертикальные линии i:=(GetWidth div 2 ); y:=i div 4; DrawLine((i div 2)+y, 0, (i div 2)+y, GetHeight); //DrawLine(i, 0, i, GetHeight); DrawLine(i+(i div 2)-y, 0, i+(i div 2)-y, GetHeight); end;
{ 123 456 789 } {//печать текста ...проблемы с маштабируемостью на разных телефонах procedure DrawXO(c:char; pos:integer); var x,y:integer; begin x:=GetWidth; y:=GetHeight; SetColor(0,0,0); SetFont(FONT_FACE_SYSTEM,FONT_STYLE_BOLD ,FONT_SIZE_LARGE); if pos=1 then DrawText(c,(x div 4),(y div 4)); if pos=2 then DrawText(c,(x div 2),(y div 4)); if pos=3 then DrawText(c,(x -(x div 4)),(y div 4)); if pos=4 then DrawText(c,(x div 4),(y div 2)); if pos=5 then DrawText(c,(x div 2),(y div 2)); if pos=6 then DrawText(c,(x -(x div 4)),(y div 2)); if pos=7 then DrawText(c,(x div 4),(y - (y div 4))); if pos=8 then DrawText(c,(x div 2),(y - (y div 4))); if pos=9 then DrawText(c,(x -(x div 4)),(y-(y div 4))); end; } procedure DrawXO(c:char; pos:integer); var x,x1,y,y1:integer; img:image;
begin if c='X' then img:=Ximg; if c='O' then img:=Oimg; x:=GetWidth; x1:=GetImageWidth(img)/2; y:=GetHeight;y1:=GetImageHeight(img)/2;
if pos=1 then DrawImage(img,(x div 4)-x1,(y div 4)-y1); if pos=2 then DrawImage(img,(x div 2)-x1,(y div 4)-y1); if pos=3 then DrawImage(img,(x -(x div 4)-x1),(y div 4)-y1); if pos=4 then DrawImage(img,(x div 4)-x1,(y div 2)-y1); if pos=5 then DrawImage(img,(x div 2)-x1,(y div 2)-y1); if pos=6 then DrawImage(img,(x -(x div 4)-x1),(y div 2)-y1); if pos=7 then DrawImage(img,(x div 4)-x1,(y - (y div 4)-y1)); if pos=8 then DrawImage(img,(x div 2)-x1,(y - (y div 4)-y1)); if pos=9 then DrawImage(img,(x -(x div 4)-x1),(y-(y div 4)-y1));
end;
procedure DrawAll; var i:integer; begin for i:=1 to 9 do {if p[i]<>' 'then} DrawXO(p[i],i); end;
function checkWin(c:char):boolean; begin checkWin:=false; //горизонталь if (p[1]=c) and (p[2]=c) and (p[3]=c) then checkWin:=true; if (p[4]=c) and (p[5]=c) and (p[6]=c) then checkWin:=true; if (p[7]=c) and (p[8]=c) and (p[9]=c) then checkWin:=true; //вертикаль if (p[1]=c) and (p[4]=c) and (p[7]=c) then checkWin:=true; if (p[2]=c) and (p[5]=c) and (p[8]=c) then checkWin:=true; if (p[3]=c) and (p[6]=c) and (p[9]=c) then checkWin:=true; //наскось if (p[1]=c) and (p[5]=c) and (p[9]=c) then checkWin:=true; if (p[3]=c) and (p[5]=c) and (p[7]=c) then checkWin:=true; end;
function Step(c:char;pos:integer):boolean; begin Step:=false; if not ((pos<1) or (pos>9)) then if p[pos]=' ' then begin p[pos]:=c; Step:=true; end; end;
procedure CompStep; var tmp:boolean; begin tmp:=false; while not tmp do begin randomize; { i:=0; while i<9 do begin i:=i+1; tmp:=Step('O',9-Random(9)); if tmp then i:=9; end; }
//добавим ему мозгов //смотри вертикальные варианты, например если есть O O то можно поставить нолик посередине if not tmp then //if (p[1]='O') and (p[2]='O') and (p[3]=' ') then tmp:=Step('O',3) else
if (p[1]<>' ') and (p[2]<>' ') and (p[3]=' ') then tmp:=Step('O',3) else if (p[1]<>' ') and (p[2]=' ') and (p[3]<>' ') then tmp:=Step('O',2) else if (p[1]=' ') and (p[2]<>' ') and (p[3]<>' ') then tmp:=Step('O',1) else
if (p[4]<>' ') and (p[5]<>' ') and (p[6]=' ') then tmp:=Step('O',6) else if (p[4]<>' ') and (p[5]=' ') and (p[6]<>' ') then tmp:=Step('O',5) else if (p[4]=' ') and (p[5]<>' ') and (p[6]<>' ') then tmp:=Step('O',4) else
if (p[7]<>' ') and (p[8]<>' ') and (p[9]=' ') then tmp:=Step('O',9) else if (p[7]<>' ') and (p[8]=' ') and (p[9]<>' ') then tmp:=Step('O',8) else if (p[7]=' ') and (p[8]<>' ') and (p[9]<>' ') then tmp:=Step('O',7) else
//горизонтальные варианты if (p[1]<>' ') and (p[4]<>' ') and (p[7]=' ') then tmp:=Step('O',7) else if (p[1]<>' ') and (p[4]=' ') and (p[7]<>' ') then tmp:=Step('O',4) else if (p[1]=' ') and (p[4]<>' ') and (p[7]<>' ') then tmp:=Step('O',1) else
if (p[2]<>' ') and (p[5]<>' ') and (p[8]=' ') then tmp:=Step('O',8) else if (p[2]<>' ') and (p[5]=' ') and (p[8]<>' ') then tmp:=Step('O',5) else if (p[2]=' ') and (p[5]<>' ') and (p[8]<>' ') then tmp:=Step('O',2) else
if (p[3]<>' ') and (p[6]<>' ') and (p[9]=' ') then tmp:=Step('O',9) else if (p[3]<>' ') and (p[6]=' ') and (p[9]<>' ') then tmp:=Step('O',6) else if (p[3]=' ') and (p[6]<>' ') and (p[9]<>' ') then tmp:=Step('O',3) else
tmp:=Step('O',9-Random(9)); end;
end;
procedure ShowMess(s:string); begin
SetClip(0, 0, GetWidth, GetHeight); SetColor(0,0,0); FillRect(0,GetHeight div 2,GetWidth,GetStringHeight(s)); SetColor(255,255,255); SetFont(FONT_FACE_SYSTEM,FONT_STYLE_BOLD,FONT_SIZE_LARGE); DrawText(s, (GetWidth - GetStringWidth(s))/2,GetHeight div 2);
//AddCommand(cmdOK); repaint;
{ repeat delay(100); clicked := GetClickedCommand; until clicked <> EmptyCommand; } end;
function CheckFull:boolean; var i,all:integer; begin CheckFull:=false; all:=0; for i:=1 to 9 do if p[i]<>' ' then all:=all+1; if all=9 then CheckFull:=true; end;
function CheckGameEnd:boolean; begin CheckGameEnd:=false;
//проверка, выиграл ли игрок if checkWin('X') then begin CheckGameEnd:=true; ShowMess('Ты выирал!'); end else
//проверка, выиграл ли компьютер if checkWin('O') then begin CheckGameEnd:=true; ShowMess('You проиграл ...'); end else
if CheckFull then begin CheckGameEnd:=true; ShowMess('Ничья блеа...'); end; end;
procedure CreateGame; var i:integer; UserStep:boolean; GameEnd:boolean; begin
//загружаем заранее чтобы не нагружать VM Ximg:=LoadImage('/Ximg.png'); Oimg:=LoadImage('/Oimg.png');
ShowCanvas; RemoveCommand(cmdOK); AddCommand(cmdExit);
GameEnd:=false; p[1]:=' '; p[2]:=' '; p[3]:=' '; p[4]:=' '; p[5]:=' '; p[6]:=' '; p[7]:=' '; p[8]:=' '; p[9]:=' ';
while not GameEnd do begin
SetColor(255,255,255); FillRect(0,0,GetWidth, GetHeight); drawPlace;//рисуем решетку CompStep;//комп сделал ход DrawAll;//рисуем крестики и нолики delay(300); repaint; delay(300);
GameEnd:=CheckGameEnd;
{ repeat delay(100); //clicked := GetClickedCommand; until GetKeyPressed<>KE_KEY9 ;//clicked <> EmptyCommand;//ждем нажатия клавиши } if {(not CheckFull) or }(not GameEnd) then while not UserStep do while (GetKeyPressed = KE_NONE) do begin delay(100);
if GetClickedCommand=cmdExit then CreateMenu;
if GetKeyPressed=KE_KEY1 then i:=1; if GetKeyPressed=KE_KEY2 then i:=2; if GetKeyPressed=KE_KEY3 then i:=3; if GetKeyPressed=KE_KEY4 then i:=4; if GetKeyPressed=KE_KEY5 then i:=5; if GetKeyPressed=KE_KEY6 then i:=6; if GetKeyPressed=KE_KEY7 then i:=7; if GetKeyPressed=KE_KEY8 then i:=8; if GetKeyPressed=KE_KEY9 then i:=9;
UserStep:=Step('X',i{Random(9)});//шагаем и рисуем крестик игрока i:=0; end; UserStep:=false;
DrawAll;
repaint; GameEnd:=CheckGameEnd; //суммируем результат, чтобы не стереть предыдущее событие //delay(300); //end;
end;//while not GameEnd
AddCommand(cmdContinue); repaint; repeat delay(100); clicked := GetClickedCommand; until clicked <> EmptyCommand; RemoveCommand(cmdContinue); if clicked=cmdContinue then CreateGame;
end;
procedure CreateMenu; begin
ShowMenu('Menu', CH_IMPLICIT); RemoveCommand(cmdExit); AddCommand(cmdOK); _Play := MenuAppendString('Игра'); _About := MenuAppendString('About'); _Exit := MenuAppendString('Выход');
//setSelectCommand(cmdOK); - жаль что нет такой команды
repeat delay(100); clicked := GetClickedCommand; until clicked <> EmptyCommand;
{//жаль что это пока не поддерживается (версия 2.02) case MenuGetSelectedIndex of cmdAbout: ; cmdPlay:; cmdExit:; end; }
if MenuGetSelectedIndex=_Play then CreateGame; if MenuGetSelectedIndex=_About then CreateAbout; if MenuGetSelectedIndex=_Exit then Halt;
end;
begin cmdOK := CreateCommand('OK', CM_OK, 0); //cmdBreak := CreateCommand('Break', CM_BACK, 0); cmdExit := CreateCommand('Exit', CM_BACK, 0); cmdContinue := CreateCommand('Continue', CM_OK, 0); while true do CreateMenu; end. |
5.04.2013 / 10:25 | | Bogdan-G Пользователь Сейчас: Offline
Имя: Богдан Откуда: Москва Регистрация: 13.02.2011
| 1JavaMods1, Вaши прогрaммы и игры нa MobPascal, так то. оговор24, не туда написал.
|
5.04.2013 / 10:29 | | 1JavaMods1 Пользователь Сейчас: Offline
Регистрация: 20.07.2012
| Bogdan-G (05.04.2013/10:25)1JavaMods1, Вaши прогрaммы и игры нa MobPascal, так то.оговор24, не туда написал.MobPascal => MIDletPascal
|
5.04.2013 / 10:36 | | Bogdan-G Пользователь Сейчас: Offline
Имя: Богдан Откуда: Москва Регистрация: 13.02.2011
| Изменено Bogdan-G (5.04 / 10:41) (всего 1 раз) |
5.04.2013 / 10:55 | | 1JavaMods1 Пользователь Сейчас: Offline
Регистрация: 20.07.2012
| упс, звиняйте
|
11.05.2013 / 16:10 | | ovogov24 Пользователь Сейчас: Offline
Имя: Алексей Откуда: Малая Тавра-Екатеринбург(Свердловская область) Регистрация: 21.02.2013
| вот моя первая слабая игра на mobile pascal , здесь практически ничего нет, просто курсор и его можно передвигать
Прикрепленные файлы: Main.jar (14.85 кб.) Скачано 209 раз |
11.05.2013 / 17:08 | | dimonkrut Пользователь Сейчас: Offline
Имя: Dimitro Откуда: Санкт-Петербург Регистрация: 17.10.2012
| Токо что написали как передвигать картинку и ты со своей... С чем? Это не игра?
__________________
No thing is perfecT |
11.05.2013 / 17:54 | | ovogov24 Пользователь Сейчас: Offline
Имя: Алексей Откуда: Малая Тавра-Екатеринбург(Свердловская область) Регистрация: 21.02.2013
| dimonkrut, я твой вопрос не понял, а это я выложил от счастья что все получилось, ато раньше сколько не писал и исправлял ничего на моб паскале не получалось
|
11.05.2013 / 17:57 | | dimonkrut Пользователь Сейчас: Offline
Имя: Dimitro Откуда: Санкт-Петербург Регистрация: 17.10.2012
| Ну как это можно назвать игрой? Каааааааааааак?
__________________
No thing is perfecT |
Всего сообщений: 63 Фильтровать сообщения Поиск по теме Файлы топика (14)
|