Ну сабж вот курсор из очень известной, а может быть и не очень известной, игры World Of Goo, но
Одна проблема, отрисовка происходит на канве(под компонентамы его не видно), а хочется что бы это был курсор.
ЗЫ за код не ругайте, у кого есть вариант по лучше пусть выкладывает.
ЗЫ ЗЫ не забудьте на форму кинуть таймер с именем TIMER1 задать ему собітие on Timer, и форме собітия onCreate OnMouseMove
ЗЫ ЗЫ ЗЫ Могу долго не отвечать
Одна проблема, отрисовка происходит на канве(под компонентамы его не видно), а хочется что бы это был курсор.
Код:
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
ЗЫ ЗЫ ЗЫ Могу долго не отвечать