Home

Реклама

Настроить

17 Ноя, 2008

porche

бегущая строка

Еду утром в автобусе. Смотрю на бегущую строку. (По ней обычно проходят названия остановок и т.д. и т.п) Но потом по ней прогнали объявление. Оно было примерно таким: УВОЖАЕМЫЕ ПОССОЖЫРЫ! ПРОСИМ ВАС ОСВОБОЖДАТЬ МИСТА ДЛЯ ИНВАЛИДОВ И ПОССОЖЫРОВ С ДЕТЬМИ! ))

15 Апр, 2008

porche

ДА ЧТО ЖЕ ЭТО ЗА 3DS

Пожалуйста, напишите кто-нить плз код загрузчика 3ds. (Delphi 7)

12 Мар, 2008

porche

(без темы)

ХАХА

люди напишите в delphi на FormCreate следующее

while true do
ShowMessage('XAXAXA');

21 Фев, 2008

porche

(без темы)

ГЫГЫ.

Читал русскую газету.

Классная статья про российские самолёты. Прикол в том, что российские самолёты 4 поколения щёлкают как орешки американские самолёты 5 поколения! Американцы, видимо, думают, что самолёт должен быть как в фантастических фильмах, соответственно выглядеть круто. В результате получается полная фигня.

14 Фев, 2008

porche

(без темы)

Я просто в недоумении от Google карты.

Почему на улицах Нью-Йорка видны даже машины, а в Подмосковье при приближении больше 1 км вообще изображения нет!!!!

1 Фев, 2008

porche

(без темы)

Кто-нибудь пытался подключить джойстик от PS к компу, припаяв к нему пару диодов и соединив  с COM разъёмом? ОБЪЯСНИТЕ, почему не работает.
porche

(без темы)

ВНИМАНИЕ!
Существует сайт http://www.pentagon.narod.ru! Сайт просто улёт!
porche

(без темы)

Программеры всех стран, объединяйтесь! Входите в сообщество programmers.
porche

ПМ

Люди! Кто читал последний номер "Популярная Механика?". Предлагаю обсудить статью "Человек пещерный и четырёхмерный. Нафиг проецировать какого-то там чела, если можно на платформе этой вещи сделать как бы "Монитор" для какой нибудь крутой игровой приставки. Это же будет полное погружение в атмосферу игры! 
porche

(без темы)

Люди, какой ужас! Закрылся сайт www.oka-tuning.ru!!!
Там такие крутые модификации оки были!

9 Дек, 2006

porche

(без темы)

Создание игры "Тир" в Delphi 7.

Тир, который будет описываться в данной статье, является полностью графическим, что обеспечивает его стабильную работу.

Цель данного тира - попасть в мишени и заработать очки.Мишени двигаются быстро, поэтому попасть в них будет трудно. Вид данной игры показан на рис. 1.

Рис. 1


Сперва нам нужно создать тип, описывающий мишень, для большего удобства работы с кодом программы. В типе мишени должна содержаться информация о ее координатах и передвижении:

type THitObj = record
x,y:integer;
dx,dy:integer;
end;

Далее создаем процедуру, упрощаюю создание мишени. В ней используется динамический массив и переменная типа integer, показывающая количество элементов массива, помещенные в раздел var после описания класса формы (названия - HitObjects и CHitObjects):

procedure TForm1.CreateHitObj(fx, fy: integer);
begin
//создание новой мишени
CHitObjects:=CHitObjects+1;
SetLength(HitObjects,CHitObjects);
HitObjects[CHitObjects-1].x:=fx;
HitObjects[CHitObjects-1].y:=fy;
end;

Также нам потребуется функция, возвращающая значения типа boolean, проверяющая некоторые области на пересечение:

function TForm1.RectsOverlap(x, y, w, h, x1, y1:integer): boolean;
begin
if
(x1 >= x) and (x1 <= (x+w)) and (y1 >=y) and (y1 <= (y+h)) then
result:=true else result:=false;
end;

Последняя процедура, которая потребуется нам для удобства написания кода, удаляет все объекты из памяти:

procedure TForm1.DelAll;
begin
//уничтожение объектов
CHitObjects:=0;
SetLength(HitObjects,CHitObjects);
Image1.Free;
Image2.Free;
end;

Объявления всех данные процедур и функций находятся в разделе public класса, описывающего форму:

    { Public declarations }
    procedure CreateHitObj(fx,fy:integer);
    procedure DelAll;
    function RectsOverlap(x,y,w,h,x1,y1:integer):boolean;
  end;

Следующим нашим шагом будет объявление необходимых переменных в разделе var. Нам понадобятся координаты курсора, количество очков, массив для мишеней и переменная, описывающая количество элементов в данном массиве,а также два экземпляра класса TBitmap, в которых хранятся изображения прицела и мишени:

var
  Form1: TForm1;
  cx,cy:integer;
  Image1,Image2:TBitmap;
  HitObjects:array of THitObj; CHitObjects:integer=0;
  Points:integer=0;

Замечу, что удобнее будет инициализировать переменные Points и CHitObjects сразу, что я и сделал.

Создаем событие OnCreate и описываем в нем загрузку рисунков, создание мишеней и некоторые другие действия:

procedure TForm1.FormCreate(Sender: TObject);
var
i:integer;
begin
//скрытие курсора
ShowCursor(false);
//загрузка рисунков
Image1:=TBitmap.Create;
Image1.LoadFromFile('Image1.bmp');
Image1.TransparentColor:=clFuchsia;
Image1.Transparent:=true;

Image2:=TBitmap.Create;
Image2.LoadFromFile('Image2.bmp');
Image2.TransparentColor:=clFuchsia;
Image2.Transparent:=true;

randomize;
//создаем мишени
for i:=0 to 2 do
CreateHitObj(random(700),random(500));
end;

В событие OnDestroy вписываем процедуру DelAll:

procedure TForm1.FormDestroy(Sender: TObject);
begin
DelAll;
end;

Создаем компонент класса TImage, который имеет ширину и высоту формы и даем ему имя Canv. Именно на нем будет производиться основное рисование.

Во время работы программы нам постоянно необходимо знать координаты курсора, поэтому создаем событие OnMouseMove для компонента Canv:

procedure TForm1.CanvMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
cx:=X;
cy:=y;
end;

Затем описываем самый важный момент - прорисовку изображения. Для этого создаем событие OnPaint для формы и описываем в нем передвижение мишеней по экрану (я решил для простоты заменить таймер), очистку экрана, прорисовку мишеней и прицела:

procedure TForm1.FormPaint(Sender: TObject);
var
i,x:integer;
begin
//замена таймера
x:=x+1;
if x > 400 then for i:=0 to CHitObjects-1 do begin
HitObjects[i].x:=HitObjects[i].x+1;
HitObjects[i].y:=HitObjects[i].y+1;
if HitObjects[i].x > 800 then HitObjects[i].x:=0;
if HitObjects[i].y > 600 then HitObjects[i].y:=0;
end;
//очистка экрана
Canv.Canvas.Rectangle(0,0,800,600);

//рисуем объекты
Canv.Canvas.TextOut(0,0,'Очки - '+IntToStr(Points));
for i:=0 to CHitObjects-1 do
Canv.Canvas.Draw(HitObjects[i].x,HitObjects[i].y,Image2);

//рисуем курсор
Canv.Canvas.Draw(cx-25,cy-25,Image1);
end;

Нам необходимо сделать так, чтобы можно было сбивать мишени, иначе игра потеряет всякий смысл. Для этого создаем событие OnMouseDown для компонента Canv. Для того, чтобы мишень была сбита, необходимы два условия: нажатие на компонент Canv и пересечние курсора и мишени:

procedure TForm1.CanvMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
  var
  i:integer;
begin
 for i:=0 to CHitObjects do
 if RectsOverlap(HitObjects[i].x,HitObjects[i].y,50,50,X,Y)
 then begin Points:=Points+1; HitObjects[i].x:=20+random(760); HitObjects[i].y:=20+random(560); end;

end;

 В данном случае мишени не удаляются, а просто перемещаются на другое место. Для того, чтобы мишени не появлялись у краев формы, необходимо к значению функции Random прибавлять определенное число пикселей (в данном случае - 20).

Добавим последний штрих. Кому-нибудь может захотеться увеличить количество мишеней. Предусмотрим и эту возможность. Просто создадим для формы событие OnKeyDown и напишем в нем:

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 if (key = VK_RETURN) and (CHitobjects < 10) then CreateHitObj(random(700),random(500));
end;

Вот, собственно, и все. Игра готова к запуску. Наслаждайтесь! Ниже приведен полный код программы:

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;

type THitObj = record
x,y:integer;
dx,dy:integer;
end;

type
  TForm1 = class(TForm)
    Canv: TImage;
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure CanvMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormDestroy(Sender: TObject);
    procedure CanvMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure CreateHitObj(fx,fy:integer);
    procedure DelAll;
    function RectsOverlap(x,y,w,h,x1,y1:integer):boolean;
  end;

var
  Form1: TForm1;
  cx,cy:integer;
  Image1,Image2:TBitmap;
  HitObjects:array of THitObj; CHitObjects:integer=0;
  Points:integer=0;
implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
i:integer;
begin
//скрытие курсора
ShowCursor(false);
//загрузка рисунков
Image1:=TBitmap.Create;
Image1.LoadFromFile('Image1.bmp');
Image1.TransparentColor:=clFuchsia;
Image1.Transparent:=true;

Image2:=TBitmap.Create;
Image2.LoadFromFile('Image2.bmp');
Image2.TransparentColor:=clFuchsia;
Image2.Transparent:=true;

randomize;
//создаем мишени
for i:=0 to 2 do
CreateHitObj(random(700),random(500));
end;

procedure TForm1.FormPaint(Sender: TObject);
var
i,x:integer;
begin
//замена таймера
x:=x+1;
if x > 400 then for i:=0 to CHitObjects-1 do begin
HitObjects[i].x:=HitObjects[i].x+1;
HitObjects[i].y:=HitObjects[i].y+1;
if HitObjects[i].x > 800 then HitObjects[i].x:=0;
if HitObjects[i].y > 600 then HitObjects[i].y:=0;
end;
//очистка экрана
Canv.Canvas.Rectangle(0,0,800,600);

//рисуем объекты
Canv.Canvas.TextOut(0,0,'Очки - '+IntToStr(Points));
for i:=0 to CHitObjects-1 do
Canv.Canvas.Draw(HitObjects[i].x,HitObjects[i].y,Image2);

//рисуем курсор
Canv.Canvas.Draw(cx-25,cy-25,Image1);
end;

procedure TForm1.CanvMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
cx:=X;
cy:=y;
end;

procedure TForm1.CreateHitObj(fx, fy: integer);
begin
//создание новой мишени
CHitObjects:=CHitObjects+1;
SetLength(HitObjects,CHitObjects);
HitObjects[CHitObjects-1].x:=fx;
HitObjects[CHitObjects-1].y:=fy;
end;


procedure TForm1.DelAll;
begin
//уничтожение объектов
CHitObjects:=0;
SetLength(HitObjects,CHitObjects);
Image1.Free;
Image2.Free;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
DelAll;
end;

function TForm1.RectsOverlap(x, y, w, h, x1, y1:integer): boolean;
begin
if (x1 >= x) and (x1 <= (x+w)) and (y1 >=y) and (y1 <= (y+h)) then
result:=true else result:=false;
end;

procedure TForm1.CanvMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
  var
  i:integer;
begin
 for i:=0 to CHitObjects do
 if RectsOverlap(HitObjects[i].x,HitObjects[i].y,50,50,X,Y)
 then begin Points:=Points+1; HitObjects[i].x:=20+random(760); HitObjects[i].y:=20+random(560); end;

end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 if (key = VK_RETURN) and (CHitobjects < 10) then CreateHitObj(random(700),random(500));
end;

end.
















 

6 Дек, 2006

porche

Совет

Если при компиляции программы в Delphi 7 высвечивается ошибка с названием LA, посмотрите, есть ли какой либо символ или пробел после end. Если таковые существуют, удалите их, и программа откомпилируется нормально.

porche

Ноябрь 2008

Вс Пн Вт Ср Чт Пт Сб
      1
2345678
9101112131415
16171819202122
23242526272829
30      

Трансляция

RSS Atom
Разработано LiveJournal.com

Реклама

Настроить