Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Игры";
Текущий архив: 2006.12.10;
Скачать: [xml.tar.bz2];

Вниз

DoCollision B DelphiX   Найти похожие ветки 

 
antonn ©   (2006-01-15 13:55) [120]

Cash ©   (15.01.06 13:47) [119]
Ну, а как можно ошибиться в одной процедуре? Все вроде нормально,
но тыж говорил о нарушении цвета (про белый фон). Я это имел в виду.

вот после приведенного кода (даже без цикла), вместо "прозрачного цвета" - белый фон.


 
Cash ©   (2006-01-15 15:18) [121]

Хм-м-м-м, BrushCopy копирует часть канвы с заменой указанного цвета.
Она не предпологает прозрачности, но помоему, ее можно реализовать
используя в качестве цвета-заменителя clNone.
Я не уверен только.


 
antonn ©   (2006-01-15 16:09) [122]

Cash ©   (15.01.06 15:18) [121]
короче мне лень было эксперементировать, все равно мой код быстрее:)


 
antonn ©   (2006-01-15 16:14) [123]

хо-хо-хо, я выставил св-во браша канваса "приемника" в bsclear, и копирование стало "прозрачным", но и тормознутей:) теперь мой код в 4,39 раза быстрее:)))


 
Cash ©   (2006-01-15 16:35) [124]

antonn ©   (15.01.06 16:09) [122]:
Лады. уболтал... :)))

antonn ©   (15.01.06 16:14) [123]:
Прикольно. 8)

Тык шта Аццкий_рыцарь:), антохину процедуру на вооружение и
дай мыло, я туда флудону двумя хелп-файлами. :)))


 
Cash ©   (2006-01-15 16:48) [125]

А с другой стороны...., зачем мыло, на Help для DelphiX качай с WebFile:
http://webfile.ru/747112


 
Аццкий_рыцарь:)   (2006-01-16 09:08) [126]

2Cash та у мну две книги по делфе:) одна 4 см толщиной, другая 6, но там как всегда нифига нужного нет :( Если можешь то кинь русскую справку, а то с буржуями не сильно дружу


 
Cash ©   (2006-01-16 14:52) [127]

Аццкий_рыцарь:)   (16.01.06 09:08) [126]:
А зря! ;)
Сразу проглядываюся пробклы знаний от недочитанной (или недопонятой)
родной дельфийской справки! :) (эка я завернул :D )
Русский хелп весит 1.4 мега. Я попробую, но гарантировать не смогу.

В близжайшее время дам еще одну ссылку с webfile.


 
Аццкий_рыцарь:)   (2006-01-17 16:38) [128]

Извените, конечно за оффтоп... Но мне стало смешно, когда я посмотрев вновь на свою тему, и прочитав заново все посты тут :) начинали с Collision, а тут уже и канвас попер вовсю, и чего только нет! :)))  

Надобно бы модерам переименовать тему как -то типа : "обсуждение написания аркад" :)))


 
antonn ©   (2006-01-17 17:05) [129]

ненадо ничего менять, канвас рулит:)
а вообще, нормальная ветка, почти по существу:)))


 
Аццкий_рыцарь:)   (2006-01-17 17:18) [130]

Эту ветку можно скопировать в блокнот и назвать FAQ по DelphiX :)


 
antonn ©   (2006-01-17 17:21) [131]

зачем в блокнот, можно в хтмл, там форматирование лучше (а вообще у меня в клиенте она, поэтому пофиг:))


 
Аццкий_рыцарь:)   (2006-01-17 23:49) [132]

ээээ давайте вернемся к нашим (вернее моим) баранам :) что нужно писать в brushcopy??? вот что пишется про него :
canvas.brushcopy(const Dest : TRect; Bitmap : TBitmap ; const source : TRect; color: TColor );

1) const Dest : TRect - (Dest мне кажется это от английского "Destination", тоесть "пункт назначения") наверное сдесь надо показать в какой прямоугольник копировать, но почему-то, когда я там пишу form1.DXImageList1.Items.Items[3].Picture.bitmap (это бекграунд), то пишет:[Error] Unit1.pas(240): Incompatible types: "TRect" and "TBitmap" . а как мне превратить TBitmap B TRect ??

2) Bitmap: TBitmap - это я ваще непонимаю что такое О_о

3) const source: TRect - ( "source" это на буржуйском "источник") это наверное типа в какой прямоугольник копировать всю бадягу, но пишет тоже что типы несовместимы :( тоже незнаю как превратить TBitmap B TRect :(

4) color: TColor - ну, я кажись понял, что это transparent color

снова прошу вашей помощи :)


 
Аццкий_рыцарь:)   (2006-01-18 00:39) [133]

Вот что у меня вышло (вернее не вышло) :

DXImageList1.Items.Items[4].Picture.bitmap - монстр
DXImageList1.Items.Items[3].Picture.bitmap - бэкграунд



procedure TForm1.Button1Click(Sender: TObject);
var P,a: TBITMAP;
begin

a:= DXImageList1.Items.Items[4].Picture.bitmap;

p:= DXImageList1.Items.Items[3].Picture.bitmap;

 with P do begin
 Width := 77;
 Height := 77;
 Canvas.Brush.Color := clBlack;
 Canvas.Pen.Color := clRed;

canvas.BrushCopy(p.Canvas.ClipRect,a,a.Canvas.ClipRect,clWhite );

 end;
 form1.DXImageList1.Items.Items[4].Restore;
 form1.DXImageList1.Items.Items[3].Restore;

end;



когда нажимаю кнопку, то бэкграунд исчезает, а в левом верхнем углу появляется квадрат 77 х 77 белого света (это не тот белый что я выставил в Brush Copy, там хоть какой не напиши всеравно белым стает)

что я тут не так делаю? пробовал убырать строку form1.DXImageList1.Items.Items[4].Restore; - ВАЩЕ НИКАКОГО ЭФФЕКТА :(


 
antonn ©   (2006-01-18 05:33) [134]

Аццкий_рыцарь:)   (18.01.06 0:39) [133]
что я выставил в Brush Copy, там хоть какой не напиши всеравно белым стает)

перед отрисовкой делай у нужного канваса canvas.brush.style:=bsclear;


 
Аццкий_рыцарь:)   (2006-01-18 09:55) [135]

canvas.brush.style:=bsclear;

непомогло :(

я, конечно, понимаю что канвас рулит, но меня он скоро до смерти зарулит :)


 
Cash ©   (2006-01-18 10:30) [136]

Аццкий_рыцарь:)   (18.01.06 09:55) [135]:
А ты у бэкграунда выставил этот атрибут?
В [123] (проикольный номер 8)) antonn написал, что поставил его у
приемника (у бэкграунда тобиш).


 
Cash ©   (2006-01-18 11:04) [137]

Аццкий_рыцарь:)   (18.01.06 00:39) [133]:
ы-ы-ы-ы-ы-ы-ы-ы-ы-ы... :)))
Что я тут увидел.... :)

...vas.BrushCopy(p.Canvas.ClipRect,a,a.Canvas.ClipRect,clWhite );

Практически ты заменяешь весь бэкграунд на картинку из "a"!

...opy(p.Canvas.ClipRect,a...
Это не верно, тебе надо взять так:
Bounds(x,y,a.Width,a.Height)

Это означает, что ты вставляешь картинку с исходными размерами и по
координатам X и Y.

После этой замены должен появляться белый прямоугольник по тем самым
координатам.

гы-гы-гы-гы-гы-гы-гы..., а что я еще увидел!!! 8)

with P do begin
 Width := 77;
 Height := 77;
 Canvas.Brush.Color := clBlack;
 Canvas.Pen.Color := clRed;
 canvas.BrushCopy(p.Canvas.ClipRect,a,a.Canvas.ClipRect,clWhite );
end;

Это ты чтож делаешь то??? 8)
- Береш свой бэкграунд, и внаглую меняешь ему размеры! 8)
Именно по этому бэкграунд у тебя и становится размером 77х77.
У тебяж картинка бэкграунда есть, и рисуется! Дак оставь ее размеры
в покое (Тобиш, картинка уже инициализирована и второй раз это
делать уже не стоит, графику потеряешь)! :)
А вот насчет кисти и ручки - цвета им лучше поставить в clNone,
чтоб лишних всяких штучек не рисовать.

Посмотри сюда:

procedure TForm1.Button1Click(Sender: TObject);
var
 P,a: TBITMAP;
 tc: TColor; // <---=
 br: TRect; // <---=
begin
 a:= DXImageList1.Items.Items[4].Picture.bitmap;
 p:= DXImageList1.Items.Items[3].Picture.bitmap;
 tc := DXImageList1.Items.Items[4].TransparentColor; // <---=
 br := Bounds(82,50,a.Width,a.Height); // <---=
 with P do begin
   Canvas.Brush.Color := clNone; // <---=
   Canvas.Pen.Color := clNone; // <---=
   Canvas.Brush.Style:=bsClear; // <---=
   Canvas.BrushCopy(br,a,a.Canvas.ClipRect,tc); // <---=
 end;
 form1.DXImageList1.Items.Items[3].Restore; // <---=
end;


Символом  // <---= я показал, что я изменил.

(Вот если бы товарищи дизайнеры форума поставилиб тегу code шрифт
"Courier New" с 10-м размером, я думаю код выглядел бы более внятно.)


 
Аццкий_рыцарь:)   (2006-01-18 11:18) [138]

Я вставил твой код и после нажатия на кнопку фон просто пропадает и стает черным  :((


 
Cash ©   (2006-01-18 13:17) [139]

Аццкий_рыцарь:)   (18.01.06 11:18) [138]:
А-а-а-а-а-Р-р-р-р-р-р-р-р-р-р-р-р.... Как же я всетаки ненавижу
DephiX! Блин, ну какой нормальный человек будет орудовать с объектом
TGraphic???! Там же все через эту самую .... TGraphics и делается!
8( 8( 8( 8(
Вот, что мне удалось поправить, выводит на 100%!

procedure TForm1.Button1Click(Sender: TObject);
var
 p,a: TBitMap; //два буфера - бэк и то, что на бэк выводится
 r: TGraphic; // руки бы ему оторвать - это то, куда рисовать будем
 t: TColor; // цвет, которые прозрачный для "a" картинки
 b: TRect; // рамка, куда будем рисовать
begin
 p := TBitMap.Create;
 a := TBitMap.Create;
 r := DXImageList.Items.Items[0].Picture.Graphic; // определяем, куда потом рисовать
 // Задаем размеры буферов (опашливать не сметь! :))
 p.Width := r.Width;
 p.Height := r.Height;
 p.Canvas.Draw(0,0,r);
 with a do begin
   Width := DXImageList.Items.Items[1].Picture.Graphic.Width;
   Height := DXImageList.Items.Items[1].Picture.Graphic.Height;
   Canvas.Draw(0,0,DXImageList.Items.Items[1].Picture.Graphic);
 end;
 // узнаем, какой цвет у нас - transparent
 t := DXImageList.Items.Items[1].TransparentColor;
 // делаем рамочку, куда рисовать
 b := bounds(10,10,32,32);
 // говорим, что transparent будет не рисоваться
 with p.Canvas do begin
   Brush.Style := bsClear;
 end;
 // и наконец, рисуем картинку
 p.Canvas.BrushCopy(b,a,a.Canvas.ClipRect,t);
 // после чего, передаем ее в результат
 r.Assign(p);
 // и обновляем текстуру
 DXImageList.Items.Items[0].Restore;
 // надо не забыть уничтожить буферы
 a.Free;
 p.Free;
end;


код грамоздкий и медленный, поэтому часто его вызывать нельзя.


 
Cash ©   (2006-01-18 13:24) [140]

Забыл!!!
Найди те места, где задаются размеры картинок и поправь их для себя.
Первое - это там, где задается b - рамка, куда рисовать.
Второе - смени индексы картинок в DXImageList,
с моих (0 - бэкграунд, 1 - труп) на свои.


 
Аццкий_рыцарь:)   (2006-01-18 13:24) [141]

я, конечно не любитль copy->paste :) но этот код у меня нет желания сидеть и разбирать :)) так что... copy->paste->смотрим, что вышло :)


 
Cash ©   (2006-01-18 13:26) [142]

Cash ©   (18.01.06 13:24) [140]
Аццкий_рыцарь:)   (18.01.06 13:24) [141]

Они бы еще сотые доли выводилиб!
:D :D :D :D :D :D :D :D :D :D :D :D :D


 
Аццкий_рыцарь:)   (2006-01-18 13:30) [143]

О! рисует, сволочь :)

но, блин, внатуре, тормозит :(

а нельзя что б без тормозов? ты вспомни про битву за производительность выше в этой теме :)

вообще-то, когда я рисовал из dxDIB, то там графа хранится в как TGraphic...

можно как-то с этим сделать и чтоб без глюков?


 
Cash ©   (2006-01-18 13:34) [144]

Аццкий_рыцарь:)   (18.01.06 13:30) [143]:
А ты что, на каждом кадре ее вызываешь???? *)
Эта вещь вызываться должна только один раз, только тогда,
когда приспичило чёнить порисовать на бэк-е.


 
Аццкий_рыцарь:)   (2006-01-18 13:36) [145]

Так я ж хочу, чтоб мертвого монстра там прорисовать :)
а когда их толпа умирает... :(


 
Cash ©   (2006-01-18 13:43) [146]

Аццкий_рыцарь:)   (18.01.06 13:36) [145]:
А я тебе давно уже говорил, типа монстряк твой кгда умирая отрисовывает
свой последний кадр. Тебе на этот случай надо поставить условие, мол
если у монстра AnimIndex равен AnimCount тогда монстру Visible в false и
запустить эту процедуру для отрисовки этого монстра по его координатам.
Только один раз!!! за смерть одного монстра, иначе тормазить будеееет!!!
Толпа сдохнет, да тормоза будут, но это должно быть не слишком долго.
Кадр или два, потом FPS восстанавливается.


 
Аццкий_рыцарь:)   (2006-01-18 13:48) [147]

я так и сделал :) все, тормозов нет :) БОЛЬШОЕ СПАСИБО Cash and antonn :)
сколько раз я вам говорил спасибо ? :) аа, ща буду в игру воплощать это все! седня че-то прорвало писать её :))))


 
Cash ©   (2006-01-18 13:51) [148]

Аццкий_рыцарь:)   (18.01.06 13:48) [147]:
А... я уже и со счета сбился :)))
Если вопросы будут, задавай!


 
Аццкий_рыцарь:)   (2006-01-18 13:53) [149]

ЕЩЕ БУДУТ! :)


 
Аццкий_рыцарь:)   (2006-01-18 14:31) [150]

Вот блин. Я когда поставил в игру, то при убийстве монстра все замедляется, а потом снова идет как и шло нормально :( Что тут можно сделать?


 
Cash ©   (2006-01-18 18:29) [151]

Аццкий_рыцарь:)   (18.01.06 14:31) [150]:
Покажи, место, где обрабатывается анимация смерти и еще - где
осуществляется вызов процедурки этой.


 
Аццкий_рыцарь:)   (2006-01-18 19:21) [152]


// типа, это процедура когда монстр получает повреждения
procedure Tkozel.hit;
var
p,a: TBitMap;
r: TGraphic;
t: TColor;
b: TRect;
xpos,ypos: integer;
begin

xpos:=round(x);
ypos:=round(y);

 AnimCount := Image.PatternCount;
       AnimLooped := false;              
       AnimSpeed := 15 / 1000;
   z:=1 ;
Image := form1.dxImageList3.Items.Find("mdead");
if movego=true then
begin

p := TBitMap.Create;
a := TBitMap.Create;
r := form1.DXImageList1.Items.Items[9].Picture.Graphic;
p.Width := r.Width;
p.Height := r.Height;
p.Canvas.Draw(0,0,r);
with a do begin
  Width := form1.DXImageList3.Items.Items[9].Picture.Graphic.Width;
  Height := form1.DXImageList3.Items.Items[9].Picture.Graphic.Height;
  Canvas.Draw(0,0,form1.DXImageList3.Items.Items[9].Picture.Graphic);
end;

t := form1.DXImageList3.Items.Items[9].TransparentColor;
 b := bounds(xpos,ypos,77,77);

with p.Canvas do begin
  Brush.Style := bsClear;
end;
 p.Canvas.BrushCopy(b,a,a.Canvas.ClipRect,t);
r.Assign(p);
 form1.DXImageList1.Items.Items[9].Restore;

a.Free;
p.Free;

x:=-50000;
y:=-50000;

animlooped:=true;
movego:=true;
end;

 end;

ну, а это, когда  файрбол сталкивается с монстром

procedure Tfireball.DoCollision(Sprite: TSprite; var Done: Boolean);

 var pos :integer;
 begin
  if Sprite is Tkozel then   // see"s if what the bullet collided with was an enemy
   begin

   if (x+15>sprite.x+40)and (x+15<sprite.x+70) then
   begin
      if (y+15>sprite.y+35) and (y+15<sprite.y+80) then
   begin

     if tkozel(sprite).movego= true then
     begin
     frags:=frags+1;
      dead;
     end;
   
   tkozel(sprite).hit;

   end;
   end;



кстати, kozel - это монстряк :) я сначала для монстра брал какого-то козерога из диаблы :)


 
Cash ©   (2006-01-18 20:56) [153]

Бр-р-р-р-р-р-р-р!!!
То,что в Hit направляешь - правилдьно, а вот то, что этот Hit на пустом
месте вызвываешь - это и есть причина твоей тормозни (блин, не твоей,
а твоей проги... во! :) )! 8)

Мне на ум приходит другая реализация:
(Помнишь про IsLive: boolean,? Кажется, что ты ее назвал movego, смотри...)

// здесь я говорю, что этот козел должен сдохнуть, точнее начать дохнуть
procedure Tfireball.DoCollision(Sprite: TSprite; var Done: Boolean);
var
 pos :integer;
begin
 if Sprite is Tkozel then begin
   if ((x+15>sprite.x+40)and(x+15<sprite.x+70))and
      ((y+15>sprite.y+35)and(y+15<sprite.y+80)) then begin
     if tkozel(sprite).movego=true then begin
       frags:=frags+1;
       dead;
       tkozel(sprite).DoDie;
     end;
   end;
 end;
end;
// это - метод козла, как умирать.
// Про DeathImage и LiveImage я тоже говорил уже,
// Сделай эти два поля в классе козла и засунь в них
// картинки мертвого и живого монстряка соответственно.
Procedure TKozel.DoDie;
begin
 Z := 1;
 Image := DeathImage;
 AnimPos:=0;
 AnimCount := Image.PatternCount;
 AnimLooped := false;
 AnimSpeed := 15/1000;
 movego:=false;  
end;
// Типа скорая реанимационная помощь! :)
Procedure TKozel.Reanimate;
begin
 Image := LiveImage;
 AnimPos:=0;
 AnimCount := Image.PatternCount;
 AnimLooped := true;
 AnimSpeed := 15/1000;
 movego:=true;
end;
// Вот так я бы сделал процедурку перемещения монстра.
Procedure TKozel.DoMove(MoveCount: Integer);
begin
 inherited DoMove(MoveCount);
 if movego then begin
   // Здесь стандартное живое состояние монстряка, сюда же
   // я бы всавил Collision, а впрочем вот, прямо щас и вставлю!
   Collision;
 end else begin
   // а здесь обработка его подыхания. Дохнет он дохнет... и под конец
   // берет и оставляет о себе память в виде фотки на бэкграунде. :)))
   if AnimPos >= (AnimCount-1) then begin
     Hit;
     Visible := false;
   end;
 end;
end;

// а теперь и сама Hit!
procedure Tkozel.hit;
var
 p,a: TBitMap;
 r: TGraphic;
 t: TColor;
 b: TRect;
begin
 p := TBitMap.Create;
 a := TBitMap.Create;
 r := Form1.DXImageList1.Items.Items[9].Picture.Graphic;
 p.Width := r.Width;
 p.Height := r.Height;
 p.Canvas.Draw(0,0,r);
 with a do begin
 // при вызове Hit мы на все 100% уверены, что текущая картинка у
 // монстряка - DeathImage, а подругому при текущем раскладе не
 // получится! Поэтому далеко не ходя берем инфу прямо из поля Image
   Width := Image.Picture.Graphic.Width;
   Height := Image.Picture.Graphic.Height;
   Canvas.Draw(0,0,Image.Picture.Graphic); // Ну это типа мы рисуем, это ясно.
   // А вот здесь по моим предположениям должно происходить
   // нахождение последниго кадра смерти. Я это только теоретически
   // просчитал, должно выводить правильно.
   Canvas.CopyRect(Bounds(0,0,77,77),a.Canvas,Bounds((AnimCount-1)*77,0,77,77));
   // А-а-а-а-а... это самое то! Надо же правильные размеры уточнить,
   // а не то тормоза будут не в квадрате, а в кубе!!!
   Width := 77;
   Height := 77;
 end;
 t := Image.TransparentColor;
 // лишние переменные скорости не добавят! я убрал две самые не нужные!
 // Round и Trunc очень похожи, только последняя округляет
 // в меньшую сторону, мне просто так нравится болше.
 b := bounds(Trunc(X),Trunc(Y),77,77);
 p.Canvas.Brush.Style := bsClear;
 p.Canvas.BrushCopy(b,a,a.Canvas.ClipRect,t);
 r.Assign(p);
 Form1.DXImageList1.Items.Items[9].Restore;
 a.Free;
 p.Free;
end;


 
Аццкий_рыцарь:)   (2006-01-18 22:51) [154]

все сделал, но всеравно глючит когда сразу несколько монстряков умирает :(


 
Аццкий_рыцарь:)   (2006-01-18 22:57) [155]

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


 
antonn ©   (2006-01-19 05:17) [156]

Аццкий_рыцарь:)   (18.01.06 22:51) [154]
все сделал, но всеравно глючит когда сразу несколько монстряков умирает :(

а ты побольше используй Canvas.Draw:)


> Items[9].Picture.Graphic

это что за график? там битмап есть?

p := TBitMap.Create;
a := TBitMap.Create;

>p := TBitMap.Create;
>  a := TBitMap.Create;

объяви эти чуда глобально, создавай только при создании формы(или чего там...), а тут используй. Не надо их каждый раз создавать.


> r: TGraphic;

бяка...


> p.Canvas.Draw(0,0,r);

попробуй заменить на CopyTransparentBrush(r,p,0,0,clred); //clred - цвет прозрачности, какой он там у тебя?
из поста [113], вообще все Canvas.Draw позаменяй


>p.Canvas.Brush.Style := bsClear;
>  p.Canvas.BrushCopy(b,a,a.Canvas.ClipRect,t);

CopyTransparentBrush(a,p,b.left,b.top,t);


 
MonoLife   (2006-01-19 06:02) [157]

По всей видимости, Аццкий_рыцарь, ты лишаешься претензии на индивидуальность твоей будующией игрухи, так как содержание листинга постепенно становится коллективным! :) >... кайфа никакого
не получишь! ;)[90]

Поражаюсь терпению Cash, нравится ему все раззжевывать :) Респект ессно...
to Аццкий_рыцарь> Без примеров трудновато. Ты поищи где-нить простые примеры и описание, посмотри реализацию того-сего... Если совсем ничего не найдешь, я посмотрю у себя материал и вышлю тебе на мыло, если ты, конечно, мне его дашь :).
Вопрос к Cash:
b: TRect;
чем отличается
b := bounds(10,10,32,32); от
b := Rect(10,10,32,32); :)


 
Cash ©   (2006-01-19 08:21) [158]

MonoLife   (19.01.06 06:02) [157]:
... чем отличается ...

Отличия там в то, что Bounds возвращает рамку исходя из положения по
X и Y, а так же ширины и длины, которые задаются ы параметрах.
А Rect отдает рамочку, сформированную левой верхней и правой нижней
точками, так же указанными в параметрах.
Применительно к примеру:
bb := bounds(10,10,32,32);
br := Rect(10,10,32,32);
bb = (10,10,42,42);
br = (10,10,32,32);

antonn ©   (19.01.06 05:17) [156]:
... > r: TGraphic;
бяка... ...

И действительно бяка! Там вся работа с графикой через эту самую бяку
налажено!

Ктати точно! Надо бы эти два буфера создавать в конструкторе и
уничтожать через деструктор самого козла. Блин!!!, ну сколько памяти
тогда надо будет!

... это что за график? там битмап есть? ...
Нет там битмапа! Он хоть и присуцтвует, а никакой функции не несет!


 
Cash ©   (2006-01-19 08:47) [159]

Аццкий_рыцарь:)   (18.01.06 22:57) [155]:
Попробуем!
- Для начала перепиши оба буфера в область Private класса формы.
Думается мне, что все классы у тебя находятся в модуле с самой формой.
- Далее, надо сменить носителя процедуры Hit, измени ее название
(DrawDeath или DeathDraw или ... :)), и перепиши в разряд Public класса
формы.
- Момент 3: надо сделать отдельную картинку последнего кадра смерти
этого монстряка. (самый последний кадр размером 77х77)
- Теперь надо поправить процедурку рисования на бэк-е. (приведу в конце)
- Далее, в событии OnCreate и OnDestroy объяви создание и уничтожение
обоих буферов.
- Еще - в OnCreate в буфер кадра смерти сразу загони уже заготовленное
изображенире последнего кадра, предварительно уточнив его размеры.
- А так же, в OnCreate задай сразу размеры буферу бэк-а и помести
в него картинку.
(И так как при проходе нашей процедуры буферы уже созданы, нам нет
нужды создавать их при каждой необходимости)
- И по дконц - надо переписать вызов нашей процедуры из метода DoMove.

Все! Вроде кой какая оптимизация приведена.

А так я бы переписал эту процедуру:

procedure TForm1.DrawKozelDeath(Subj: TKozel);
var
r: TGraphic;
t: TColor;
b: TRect;
begin
r := DXImageList1.Items.Items[9].Picture.Graphic;
t := Subj.Image.TransparentColor;
b := bounds(Trunc(Subj.X),Trunc(Subj.Y),77,77);
p.Canvas.Brush.Style := bsClear;
p.Canvas.BrushCopy(b,a,a.Canvas.ClipRect,t);
r.Assign(p);
Form1.DXImageList1.Items.Items[9].Restore;
end;


Меньше избыточных операторов - больше скорость!

У тебя кстати какой конфиг машины?


 
Cash ©   (2006-01-19 08:51) [160]

А если еще подумать, то можно и еще почикать эту процедурку.

procedure TForm1.DrawKozelDeath(Subj: TKozel);
var
  t: TColor;
  b: TRect;
begin
  t := Subj.Image.TransparentColor;
  b := bounds(Trunc(Subj.X),Trunc(Subj.Y),77,77);
  p.Canvas.Brush.Style := bsClear;
  p.Canvas.BrushCopy(b,a,a.Canvas.ClipRect,t);
  DXImageList1.Items.Items[9]..Assign(p);
  DXImageList1.Items.Items[9].Restore;
end;



Страницы: 1 2 3 4 5 вся ветка

Форум: "Игры";
Текущий архив: 2006.12.10;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.84 MB
Время: 0.051 c
15-1163851830
Виталий___
2006-11-18 15:10
2006.12.10
Анализ свободных ответов


15-1163854834
MsGuns
2006-11-18 16:00
2006.12.10
Поздравляю болельщиков ЦСКА !!!


2-1164489332
kami
2006-11-26 00:15
2006.12.10
Потокобезопасность TStringList


2-1163773206
KyRo
2006-11-17 17:20
2006.12.10
не могу передать файл через TServerSocket


2-1164310772
Kostafey
2006-11-23 22:39
2006.12.10
Экспорт из TBDGridEh в Excel





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский