Как повернуть bmp картинку на n градусов (wingraph) - Free Pascal
Формулировка задачи:
Собственно как повернуть bmp картинку на n градусов (wingraph) в free pascal?
Решение задачи: «Как повернуть bmp картинку на n градусов (wingraph)»
textual
Листинг программы
uses windows,wingraph,wincrt,math;
type hero=record
x,y,speed,maxspeed,incspeed,redspeed:real;
ugol,povorot:integer;
bp:animattype;
matr:array of array of DWord;
end;
camera=record
x,y:real;
end;
map_record=record
size_x,size_y:integer;
end;
var
map
:map_record;
cam
:camera;
h
:hero;
mode,drive,
i,j
:integer;
tank1
:animattype;
procedure loadbmp;
var f:file;
size:longint;
go:pointer;
begin
assign(f,'sprites\tank1.bmp');
reset(f,1);
size:=filesize(f);
getmem(go,size);
blockread(f,go^,size);
close(f);
putimage(1,1,go^,normalput);
getanim(1,1,135,164,getrgbcolor(0,0,0),tank1);
end;
procedure obrabotka_hero;
procedure hero_move;
var r,a:real;
s, c:extended;
begin
if (getkeystate(ord('W')) and $8000 > 0) then
begin
h.y:=h.y-h.speed;
if h.speed<=h.maxspeed-h.incspeed then h.speed:=h.speed+h.incspeed
else h.speed:=h.maxspeed;
if (h.y>=getmaxy / 2) and (h.y<=map.size_y-getmaxy / 2) then cam.y:=cam.y-h.speed;
end;
if (getkeystate(ord('S')) and $8000 > 0) then
begin
h.y:=h.y+h.speed;
if h.speed<=h.maxspeed-h.incspeed then h.speed:=h.speed+h.incspeed
else h.speed:=h.maxspeed;
if (h.y>=getmaxy / 2) and (h.y<=map.size_y-getmaxy / 2) then cam.y:=cam.y+h.speed;
end;
if (getkeystate(ord('A')) and $8000 > 0) then
begin
h.ugol:=h.ugol+h.povorot;
a := (pi*(h.ugol))/180; // угол поворота в радианах
setactivepage(1);
putanim(1,1,tank1,transput);
for i := 1 to 135 do
for j := 1 to 164 do
begin
r := sqrt(sqr(i - 67.5) + sqr(j - 82));
SinCos(a + arctan2((j - 82), (i - 67.5)), s, c);
h.matr[i,j] := GetPixel(round(67.5 + r * c), round(82 + r * s));
end;
for i := 1 to 135 do
for j := 1 to 164 do
PutPixel(i+500,j+500,h.matr[i,j]);
getanim(500+1,500+1,500+135,500+164,getrgbcolor(0,0,0),h.bp);
end;
if not (getkeystate(ord('W')) and $8000 > 0) and
not (getkeystate(ord('S')) and $8000 > 0) then
begin
if h.speed>=h.redspeed then h.speed:=h.speed-h.redspeed
else h.speed:=0;
end;
setactivepage(0);
end;
begin
hero_move;
end;
procedure obrabotka;
begin
obrabotka_hero;
end;
procedure otrisovka;
var cam_x,cam_y:real;
procedure inform;
var s:string;
begin
settextstyle(51,0,30);
setcolor(getrgbcolor(255,255,255));
str(h.speed:0:4,s);
outtextxy(20,20,'Speed: '+s);
str(h.x:0:4,s);
outtextxy(20,50,'X: '+s);
str(h.y:0:4,s);
outtextxy(20,80,'Y: '+s);
str(h.ugol,s);
outtextxy(20,110,'Ugol: '+s);
str(cam.x:0:4,s);
outtextxy(200,50,'CAM X: '+s);
str(cam.y:0:4,s);
outtextxy(200,80,'CAM Y: '+s);
end;
begin
updategraph(updateoff);
cleardevice;
//
cam_x:=-(cam.x - getmaxx / 2);
cam_y:=-(cam.y - getmaxy / 2);
//
setfillstyle(1,getrgbcolor(180,80,0));
bar(0,0,getmaxx,getmaxy);
//
setcolor(getrgbcolor(0,255,0));
for i:=1 to map.size_x div 200 +1 do
line((i-1)*200+round(cam_x),0+round(cam_y),(i-1)*200+round(cam_x),map.size_y+round(cam_y));
for i:=1 to map.size_y div 200 +1 do
line(0+round(cam_x),(i-1)*200+round(cam_y),map.size_x+round(cam_x),(i-1)*200+round(cam_y));
//
inform;
//
putanim(round(h.x)+round(cam_x),round(h.y+round(cam_y)),h.bp,transput);
updategraph(updatenow);
end;
begin
//
drive:=nopalette;
mode:=mfullscr;
initgraph(drive,mode,'Tanks');
//
loadbmp;
//
h.x:=500;
h.y:=500;
h.maxspeed:=3;
h.speed:=0;
h.incspeed:=0.01;
h.redspeed:=0.02;
h.bp:=tank1;
h.ugol:=0;
h.povorot:=1;
SetLength(h.matr,135*2,164*2);
///
cam.x:=getmaxx / 2;
cam.y:=getmaxy / 2;
///
map.size_x:=1920*3;
map.size_y:=1080*3;
//
repeat
delay(10);
otrisovka;
obrabotka;
until mode<-1000;
//
closegraph;
end.
Объяснение кода листинга программы
- Установка начальных значений переменных:
- h.x, h.y, h.maxspeed, h.speed, h.incspeed, h.redspeed устанавливаются в нужные значения.
- h.bp, h.ugol, h.povorot устанавливаются в начальные значения.
- cam.x, cam.y устанавливаются в центр экрана.
- map.size_x, map.size_y устанавливаются в размер карты.
- Загрузка BMP изображения:
- assign(f, 'sprites\tank1.bmp');
- reset(f, 1);
- size := filesize(f);
- getmem(go, size);
- blockread(f, go^, size);
- close(f);
- putimage(1, 1, go^, normalput);
- getanim(1, 1, 135, 164, getrgbcolor(0, 0, 0), h.bp);
- Основной цикл игры:
- repeat
- delay(10);
- otrisovka;
- obrabotka;
- until mode <- 1000;
- repeat
- Процедура obrabotka_hero:
- hero_move;
- Процедура hero_move:
- if (getkeystate(ord('W')) and $8000 > 0) then
- begin
- if h.speed <= h.maxspeed - h.incspeed then
- begin
- h.speed := h.speed + h.incspeed;
- if (h.y >= getmaxy / 2) and (h.y <= map.size_y - getmaxy / 2) then
- begin
- cam.y := cam.y - h.speed;
- end;
- end;
- end;
- if (getkeystate(ord('S')) and $8000 > 0) then
- begin
- if h.speed <= h.maxspeed - h.incspeed then
- begin
- h.speed := h.speed + h.incspeed;
- if (h.y >= getmaxy / 2) and (h.y <= map.size_y - getmaxy / 2) then
- begin
- cam.y := cam.y + h.speed; \endcode
- if (getkeystate(ord('W')) and $8000 > 0) then