Тема: фотки
Показать сообщение отдельно
Старый 01.05.2010, 17:35   #63
im_zorg
Знающий
 
Регистрация: 25.10.2009
Сообщений: 338
Написано 53 полезных сообщений
(для 61 пользователей)
Ответ: фотки

uses canvas;
Var     
x,y, xi, yi,xs, ys, xs1, ys1, state, i,w,h: integer;
ris,newimg: image;
Begin
                ris
:=LoadImage('/icon.png');
                
w:=getwidth;h:=getheight;
                
xi:=GetImageWidth(ris);
                
yi:=GetImageHeight(ris);
                
xs:=GetWidth;
                
ys:=GetHeight;
                
xs1:=GetStringWidth('вверх');
                
ys1:=GetStringHeight('вверх');
                
DrawImage(ris,x,y);Repaint;
repeat
                state
:=GetKeyClicked;
                if 
state=KE_KEY4  then begin x:=x-20; if (x<xs-xi) then x:=xs-xi; end;
                if 
state=KE_KEY6  then begin x:=x+20; if (x>0) then x:=0; end;
                if (
state=KE_KEY2)  or (state=-6) then begin y:=y-20; if (y<ys-yi) then y:=ys-yi; i:=i+1; end
                
if (state=KE_KEY8)  or (state=-7) then begin y:=y+20; if (y>0) then y:=0; end;
                if 
w<h then
                newimg
:=canvas.resize_image(ris,w,trunc((getimageHeight(ris)*w)/getimagewidth(ris)));
                if 
w>h then
                newimg
:=canvas.resize_image(ris,trunc((getimageWidth(ris)*h)/getimageheight(ris)),h);
                if 
w=h then ris:=newimg;
                
DrawImage(newimg,0,0);
                
//DrawImage(ris,x,y); зачем ты рисуешь эту картинку???
                
SetColor(0, 0, 255); 
                
FillRect(xs-xs1,ys-ys1,xs1,ys1); FillRect(0,ys-ys1,xs1,ys1); 
                
SetColor(0, 255, 0); 
                
DrawText('вверх',xs-xs1+5,ys-ys1);
                
DrawText('вниз',0,ys-ys1);
         
Repaint;
         
Delay(20);
    
until false;
End. 
(Offline)
 
Ответить с цитированием