World Of Goo Cursor

09.11.2009
665
1
#1
Ну сабж вот курсор из очень известной, а может быть и не очень известной, игры World Of Goo, но
Одна проблема, отрисовка происходит на канве(под компонентамы его не видно), а хочется что бы это был курсор.

Код:
unit Unit1;

interface

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

type
TForm1 = class(TForm)
Timer1: TTimer;
procedure Timer1Timer(Sender: TObject);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

const trail=10;		 //кол-во "костей"
diametr=18;		//диаметр
scale=0.5;		 //diametr*scale = радиус последнего шарика
outline=3;		 //ширина обводки
outlinecolor=clwhite; //цвет обведеи
linecolor=clblack;	//цвет заливки

var
Form1: TForm1;
index:integer=0;	 //номер последней "кисти"
list:TStringList;	//список "костей"
ismove:boolean=false;//переменная (двигаем мішь или нет)
hag:real;			//Шагодной кости

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
list:=TStringList.create;
ismove:=true;
hag:=(diametr-diametr*scale)/trail;  //получаем шаг
form1.Cursor:=crnone; //скрываем курсор
timer1.Interval:=1;
timer1.Enabled:=true;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
ismove:=true;
inc(index);
list.Add(inttostr(x)+'@'+inttostr(y)); //добавляем координаті

if index>trail then
begin
index:=trail;
list.Delete(0);
end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var i,x,y,rad,x2,y2:integer;
begin
canvas.FillRect(form1.ClientRect);  //очистка канвы
if index<=0 then exit;

if (not ismove)and(index>1) then //уменшаем номер последней кисти на один
begin
index:=index-1;
list.Delete(0); //и удаляем первую
if index<=0 then index:=0;

end;

if index=1 then			//рисуем если одна кисть
begin

x:=strtoint(copy(list[0],1,pos('@',list[0])-1));
y:=strtoint(copy(list[0],pos('@',list[0])+1,length(list[0])-pos('@',list[0])));
rad:=round(diametr);
canvas.Pen.Width:=rad+outline*2;
canvas.Pen.Color:=outlinecolor;
canvas.moveto(x,y);
canvas.LineTo(x,y);
canvas.Pen.Width:=rad;
canvas.Pen.Color:=linecolor;
canvas.moveto(x,y);
canvas.LineTo(x,y);
end
else  //если >1 то
begin
for i:=1 to index-1 do //рисуем обводку
begin
x:=strtoint(copy(list[i],1,pos('@',list[i])-1));
y:=strtoint(copy(list[i],pos('@',list[i])+1,length(list[i])-pos('@',list[i])));
rad:=round(diametr-(index-i)*hag);
x2:=strtoint(copy(list[i-1],1,pos('@',list[i-1])-1));
y2:=strtoint(copy(list[i-1],pos('@',list[i-1])+1,length(list[i-1])-pos('@',list[i-1])));
canvas.Pen.Width:=rad+outline*2;
canvas.Pen.Color:=outlinecolor;
canvas.moveto(x2,y2);
canvas.LineTo(x,y);
end;
for i:=1 to index-1 do	//рисуем заливку
begin
x:=strtoint(copy(list[i],1,pos('@',list[i])-1));
y:=strtoint(copy(list[i],pos('@',list[i])+1,length(list[i])-pos('@',list[i])));
rad:=round(diametr-(index-i)*hag);
x2:=strtoint(copy(list[i-1],1,pos('@',list[i-1])-1));
y2:=strtoint(copy(list[i-1],pos('@',list[i-1])+1,length(list[i-1])-pos('@',list[i-1])));
canvas.Pen.Width:=rad;
canvas.Pen.Color:=linecolor;
canvas.moveto(x2,y2);
canvas.LineTo(x,y);
end;
end;
ismove:=false;
end;

end.
ЗЫ за код не ругайте, у кого есть вариант по лучше пусть выкладывает.
ЗЫ ЗЫ не забудьте на форму кинуть таймер с именем TIMER1 задать ему собітие on Timer, и форме собітия onCreate OnMouseMove
ЗЫ ЗЫ ЗЫ Могу долго не отвечать
 

vital

Больной Компом Детектед
29.01.2006
2 432
34
#4
Почему? Всякие шейфы и прочие анимации можно делать просто в курсоре..
Посмотри че-нить типа Microangelo или ArtCursors.