Hirdetés
- Luck Dragon: Asszociációs játék. :)
- WireGuard VPN a mindennapokra
- sziku69: Fűzzük össze a szavakat :)
- ldave: New Game Blitz - 2025
- Brogyi: CTEK akkumulátor töltő és másolatai
- GoodSpeed: Haworth Aloha – egy nemcsak szavakban ergonomikus szék
- eBay-es kütyük kis pénzért
- sziku69: Szólánc.
- GoodSpeed: Nem vénnek való vidék - Berettyóújfalu
- Sub-ZeRo: Euro Truck Simulator 2 & American Truck Simulator 1 (esetleg 2 majd, ha lesz) :)
Új hozzászólás Aktív témák
-
Tomi_78
aktív tag
válasz
Fire/SOUL/CD
#2028
üzenetére
Köszi, de sajnos most sem jó.

Ugyanúgy húzzák a csíkot maguk után, sőt, most már a kép nyilakkal történő mozgatása is akadozik. De itt a teljes kód:
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, LCLType, ExtCtrls, Math;
type
{ TForm1 }
TForm1 = class(TForm)
procedure FormClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormPaint(Sender: TObject);
procedure palyafrissites(Sender: TObject);
private
public
end;
type Tpuffancsok = class(TObject)
private
public
xhely,yhely,celx,cely: integer;
iranya: double;
kepe: TBitmap;
mitcsinal: string;
sebessege: byte;
end;
var
Form1: TForm1;
palyakep: TBitmap;
palyafrissito: TTimer;
palyakepx,palyakepy,puffancsdb: integer;
puffancskep: array [0..7] of TBitmap;
puffancs: array of Tpuffancsok;
implementation
{$R *.lfm}
{ TForm1 }
function ponttav(var x1: integer; var y1: integer; var x2: integer; var y2: integer): double;
begin
result:=sqr((x2-x1)*(x2-x1)+(y2-y1)*(y2-y1));
end;
function pontirany(var x1: integer; var y1: integer; var x2: integer; var y2: integer): double;
var szam: double;
begin
szam:=arctan2(y2-y1,x2-x1);
if szam<0 then szam:=szam+2*pi;
result:=360-(szam*180)/pi;
end;
procedure TForm1.palyafrissites(Sender: TObject);
var kovx,kovy,i: integer;
begin
for i:=0 to puffancsdb-1 do
begin
case puffancs[i].mitcsinal of
'megy': begin
if puffancs[i].celx>puffancs[i].xhely then
kovx:=puffancs[i].xhely+puffancs[i].sebessege
else if puffancs[i].celx<puffancs[i].xhely then
kovx:=puffancs[i].xhely-puffancs[i].sebessege
else
kovx:=puffancs[i].xhely;
if puffancs[i].cely>puffancs[i].yhely then
kovy:=puffancs[i].yhely+puffancs[i].sebessege
else if puffancs[i].cely<puffancs[i].yhely then
kovy:=puffancs[i].yhely-puffancs[i].sebessege
else
kovy:=puffancs[i].yhely;
if ponttav(puffancs[i].xhely,puffancs[i].yhely,kovx,kovy)<=puffancs[i].sebessege then
puffancs[i].mitcsinal:='semmit'
else
begin
puffancs[i].iranya:=pontirany(puffancs[i].xhely,puffancs[i].yhely,kovx,kovy);
puffancs[i].xhely:=kovx;
puffancs[i].yhely:=kovy;
end;
end;
end;
canvas.copyrect(Rect(0,0,width,height),palyakep.canvas,Rect(palyakepx,palyakepy,width,height));
//invalidate;
//with palyakep.canvas do invalidate;
end;
end;
procedure TForm1.FormClick(Sender: TObject);
var i: integer;
begin
for i:=0 to puffancsdb-1 do
begin
puffancs[i].celx:=mouse.cursorpos.X+abs(palyakepx);
puffancs[i].cely:=mouse.cursorpos.Y+abs(palyakepy);
puffancs[i].mitcsinal:='megy';
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var i,j: byte;
begin
randomize;
width:=Screen.width;
height:=Screen.height;
left:=0;
top:=0;
palyakep:=TBitmap.Create;
palyakep.SetSize(width*2,height*2);
palyakep.canvas.brush.color:=clblue;
palyakep.canvas.fillrect(0,0,width*2,height*2);
palyakepx:=0;
palyakepy:=0;
for i:=0 to 7 do
begin
puffancskep[i]:=TBitmap.Create;
puffancskep[i].LoadFromFile('puffancs\puff'+inttostr(i)+'.bmp');
puffancskep[i].transparent:=true;
end;
puffancsdb:=0;
for j:=0 to 2 do
begin
setlength(puffancs,puffancsdb+1);
puffancs[puffancsdb]:=Tpuffancsok.create;
puffancs[puffancsdb].xhely:=random(500)+1;
puffancs[puffancsdb].yhely:=random(500)+1;
puffancs[puffancsdb].iranya:=0;
puffancs[puffancsdb].sebessege:=2;
puffancs[puffancsdb].mitcsinal:='semmit';
inc(puffancsdb,1)
end;
palyafrissito:=TTimer.Create(nil);
palyafrissito.interval:=10;
palyafrissito.ontimer:=@palyafrissites;
end;
procedure TForm1.FormDestroy(Sender: TObject);
var i: byte;
begin
palyakep.Free;
for i:=0 to 7 do
puffancskep[i].free;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
);
begin
if Key=VK_LEFT then
begin
if (palyakepx+palyakep.canvas.width)-4>=width then
begin
dec(palyakepx,4);
end;
end;
if Key=VK_RIGHT then
begin
if palyakepx+4<=0 then
begin
inc(palyakepx,4);
end;
end;
end;
procedure TForm1.FormPaint(Sender: TObject);
var puffalkepe: byte;
i: integer;
begin
canvas.draw(palyakepx,palyakepy,palyakep);
for i:=0 to puffancsdb-1 do
begin
puffalkepe:=trunc(puffancs[i].iranya*8/360);
if puffalkepe>7 then puffalkepe:=0;
palyakep.canvas.draw(puffancs[i].xhely,puffancs[i].yhely,puffancskep[puffalkepe]);
end;
end;
end.
Új hozzászólás Aktív témák
- Milyen asztali médialejátszót?
- A legújabb iPhone kiegészítő egy zokni, amit magunkra akaszthatunk
- Vége a dalnak: leállt az iPhone Air gyártása
- Alma inspirálja ezt az olcsó ZTE-t is
- Milyen notebookot vegyek?
- Milyen monitort vegyek?
- Arc Raiders
- Lakáshitel, lakásvásárlás
- Vírusirtó topic
- EA Sports WRC '23
- További aktív témák...
- -ÚJ,2 ÉV GAR- GAMER PC: RYZEN 7 5700/5800X +RX 6600/6700XT +16-64GB DDR4! SZÁMLA! 70 féle ház!
- Eladó többfajta rig keret! + tartozékok!!!!!!!
- HP 2400 WAT szervertáp - HASZNÁLATLAN
- Samsung Galaxy S25 Ultra 256Gb új!
- -ÚJ,2 ÉV GAR- GAMER PC: RYZEN 5 4500-5600X +RX 6600/6700XT +16-64GB DDR4! SZÁMLA! 70 féle ház!
- Telefon felvásárlás!! iPhone 16/iPhone 16 Plus/iPhone 16 Pro/iPhone 16 Pro Max
- GYÖNYÖRŰ iPhone 11 Pro Max 64GB Midnight Green -1 ÉV GARANCIA - Kártyafüggetlen, MS3253, 100% Akksi
- Eredeti Lenovo 90W szögleges laptop táp + kerek átalakító egyben eladó
- Apple iPhone 14 Pro Max 256GB, Kártyafüggetlen, 1 Év Garanciával
- REFURBISHED - DELL Precision Dual USB-C Thunderbolt Dock - TB18DC
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Cég: NetGo.hu Kft.
Város: Gödöllő


