This repository has been archived on 2024-12-25. You can view files and clone it, but cannot push or open issues or pull requests.

230 lines
5.3 KiB
ObjectPascal

{$reference language.dll}
{$reference Reader.dll}
{$reference log.dll}
uses GraphABC, ABCButtons,System.Threading;
var rusl,engl,start,othl,load,buttons1,buttons2,buttons3,buttons4:buttonABC;
var tosay,lang,name,cheatcode,cheatstring:string;
var hero,stella:color;
var pic:picture;
var level,lvler:Thread;
var savefile:text;
var lvl,money,cheatint:int64;
var cheat1,cheat2,cheat3:boolean;
procedure home1sel(); forward;
procedure lvl1(); forward;
procedure saving();
begin
loger('Начинаю сохранятся');
try
Pic:=Picture.Create('Data/Image/system/save.bmp');
Pic.Load('Data/Image/system/save.bmp');
Pic.Draw(1000,10);
assign(savefile,'save.sav');
rewrite(savefile);
Writeln(savefile,name);
Writeln(savefile,lvl);
close(savefile);
loger('Сохранение удачно!');
except
loger('Ошибка при сохранении!');
end;
end;
var save := new Thread(saving);
procedure loading();
begin
loger('Загрузка сохранения!');
try
assign(savefile,'save.sav');
reset(savefile);
Writeln(savefile,name);
Writeln(savefile,lvl);
close(savefile);
loger('Успешно');
except
loger('Ошибка');
end;
loger('Переключение уровня, выбран уровень '+lvl);
if lvl=1 then begin
lvler:= new Thread(lvl1);
end;
lvler.Start;
end;
procedure button1(text:string;colorr:color;proc:procedure);
begin
buttons1:= new Buttonabc(10,420,400,50,text,colorr);
buttons1.OnClick:= proc;
end;
procedure button2(text:string;colorr:color;proc:procedure);
begin
buttons2:= new Buttonabc(410,420,400,50,text,colorr);
buttons2.OnClick:= proc;
end;
procedure button3(text:string;colorr:color;proc:procedure);
begin
buttons3:= new Buttonabc(10,480,400,50,text,colorr);
buttons3.OnClick:= proc;
end;
procedure button4(text:string;colorr:color;proc:procedure);
begin
buttons4:= new Buttonabc(410,480,400,50,text,colorr);
buttons4.OnClick:= proc;
end;
procedure startt();
begin
name:=readd(syslang(lang,1));
loger('Запуск игры!');
loger('Текущий язык: '+lang);
othl.Destroy;
start.Destroy;
ClearWindow(clblack);
setbrushcolor(clblack);
setfontcolor(clred);
textout(300,400,herolang(lang,1));
sleep(5000);
ClearWindow(clblack);
textout(300,400,herolang(lang,2));
sleep(5000);
Clearwindow(clblack);
textout(300,400,herolang(lang,3));
sleep(5000);
Clearwindow(clblack);
textout(300,400,herolang(lang,4)+name+herolang(lang,5));
money:=2500000;
sleep(5000);
Clearwindow(clblack);
textout(300,400,herolang(lang,6)+money+herolang(lang,7));
sleep(5000);
Clearwindow(clblack);
textout(300,400,herolang(lang,8));
sleep(5000);
Clearwindow(clblack);
textout(300,400,herolang(lang,9));
sleep(5000);
Clearwindow(clblack);
textout(300,400,herolang(lang,10));
sleep(5000);
Clearwindow(clblack);
textout(300,400,herolang(lang,11));
button1(herolang(lang,12),clrandom,home1sel);
button2(herolang(lang,12),clrandom,home1sel);
button3(herolang(lang,12),clrandom,home1sel);
button4(herolang(lang,12),clrandom,home1sel);
lvl:=1;
save.Start;
sleep(5000);
logerstop;
end;
procedure lvl1();
begin
Write('lolkek');
end;
procedure home1sel();
begin
end;
procedure nogamemenu();
begin
ClearWindow(clblack);
rusl.Destroy;
engl.Destroy;
start:=new buttonABC(400,200,150,50,'Start!',clred);
tosay:=syslang(lang,2);
load:=new buttonABC(400,300,150,50,tosay,clred);
start.OnClick:= startt;
load.OnClick:= loading;
end;
procedure ru();
begin
lang:='Russian';
level := new Thread(nogamemenu);
level.Start;
end;
procedure ot();
begin
tosay:='Push a language name';
lang:=readd(tosay);
level := new Thread(nogamemenu);
level.Start;
end;
procedure en();
begin
lang:='English';
level := new Thread(nogamemenu);
level.Start;
end;
procedure KeyDown(Key:integer);
begin
if Key=17 then cheat1:=true;
if (cheat1=true) and (key=17) or (key=77) or (key=18) then else cheat1:=false;
if Key=18 then cheat2:=true;
if (cheat2=true) and (key=17) or (key=77) or (key=18) then else cheat2:=false;
if Key=77 then cheat3:=true;
if (cheat3=true) and (key=17) or (key=77) or (key=18) then else cheat3:=false;
if cheat1=true then if cheat2=true then if cheat3=true then
begin
cheatcode:=readd('input code:');
if cheatcode='moneyadd' then
begin
cheatint:=readi('input a count:');
money:=money + cheatint;
Write('Money add to ',money);
save.Start;
end;
if cheatcode='setlevel' then
begin
lvl:=readi('input a level:');
save.Start;
sleep(10000);
lvler:= new Thread(loading);
lvler.Start;
end;
if cheatcode='moneyset' then
begin
money:=readi('Input a new money count:');
Write('Money set to ',money);
save.Start;
end;
cheat1:=false; cheat2:=false; cheat3:=false;
end;
end;
begin
OnKeyDown := KeyDown;
logerstart;
try
setwindowsize(1100,550);
SetWindowIsFixedSize(true);
setwindowtitle('HellAnger');
loger('Настройка экрана = ок');
except
loger('Настройка экрана = Ошибка');
end;
try
ClearWindow(clblack);
setfontcolor(clred);
setbrushcolor(clblack);
setfontsize(20);
textout(440,120,'Select Language');
setbrushcolor(clwhite);
loger('Настройка шрифтов = ок');
except
loger('Настройка шрифтов = Ошибка');
end;
try
rusl:=new ButtonABC(50,160,250,50,'Русский',clBlue);
engl:=new ButtonABC(750,160,250,50,'English',clBlue);
othl:=new ButtonABC(50,490,1000,50,'Другой',clBlue);
rusl.OnClick:= ru;
engl.OnClick:= en;
othl.OnClick:= ot;
loger('Отображение кнопок = ок');
except
loger('Отображение кнопок = Ошибка');
end;
end.