Текущий архив: 2004.10.03;
Скачать: CL | DM;

Вниз

как прицепить к купсору какую-нибудь картинку?   Найти похожие ветки 

← →
zokzok   (2004-09-16 20:27) [0]

чтобы вслед за курсором бежал какой-нибудь граф. объект, это я сделал, а как сделать, чтобы он не оставлял за собой следа??

---

← →
Defunct ©   (2004-09-16 23:23) [1]

CopyRect

---

← →
Gero ©   (2004-09-17 00:44) [2]

InvalidateRect

---

← →
zokzok   (2004-09-18 09:01) [3]

всё равно след оставляет

---

← →
Alx2 ©   (2004-09-18 10:05) [4]

Под картинку (под граф. объект) отдельное окошко сделать попробуй. ОС тогда самостоятельно будет заботиться о "заметании следов".

---

← →
Gero ©   (2004-09-18 17:26) [5]

Если дашь код, то может тебе и помогут.

---

← →
Mihey_temporary ©   (2004-09-18 17:59) [6]

> Под картинку (под граф. объект) отдельное окошко сделать
> попробуй. ОС тогда самостоятельно будет заботиться о "заметании
> следов".


Тогда и хук нужен.

---

← →
Alx2 ©   (2004-09-18 18:18) [7]

>Mihey_temporary ©   (18.09.04 17:59) [6]
Почему в первом случае не нужен, а во втором (с окном) - нужен?

---

← →
Alx2 ©   (2004-09-18 18:26) [8]

>Mihey_temporary ©   (18.09.04 17:59) [6]
Кликни на Button1 и таскай форму за заголовок (как обычно), если нащупаешь его. И никаких хуков ;-)

procedure TForm1.Button1Click(Sender: TObject);
Var Rgn1,Rgn2 : HRgn;
begin
Rgn1 := CreateEllipticRgn(0,0,50,50);
Rgn2 := CreateEllipticRgn(10,10,40,40);
CombineRgn(Rgn1,Rgn1,Rgn2,RGN_XOR);
SetWindowRgn(Handle,Rgn1,true);
DeleteObject(Rgn1);
DeleteObject(Rgn2);
end;


---

← →
zokzok   (2004-09-18 21:56) [9]

> Gero ©   (18.09.04 17:26) [5]

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
 Y: Integer);
var R1,R2:Trect;
begin
with R1 do
begin
 Bottom:=Y;
 Right:=X;
 Left:=x+MyBitmap.Width;
 Top:=y+MyBitmap.Height;
end;
with R2 do
begin
 Top:=0;
 Left:=0;
 Right:=MyBitmap.Width;
 Bottom:=MyBitmap.Height;
end;
with Form1.canvas do
begin
 Brush.Style:=bsSolid;
 FillRect(ClientRect);
end;
Form1.Canvas.CopyRect(R1, MyBitmap.Canvas, R2)
end;

---

← →
Defunct ©   (2004-09-18 22:22) [10]

При перемещении мышки:

1. Вернуть на место запомненный Rect (если есть).
2. Сохранить Rect куда будем выводить рисунок
3. Вывести рисунок.

У вас в коде [9] пункты 1,2 отсутствуют вообще.

---

← →
Mihey_temporary ©   (2004-09-18 23:29) [11]

> Кликни на Button1 и таскай форму за заголовок (как обычно),
> если нащупаешь его. И никаких хуков ;-)
>
> procedure TForm1.Button1Click(Sender: TObject);
> Var Rgn1,Rgn2 : HRgn;
> begin
> Rgn1 := CreateEllipticRgn(0,0,50,50);
> Rgn2 := CreateEllipticRgn(10,10,40,40);
> CombineRgn(Rgn1,Rgn1,Rgn2,RGN_XOR);
> SetWindowRgn(Handle,Rgn1,true);
> DeleteObject(Rgn1);
> DeleteObject(Rgn2);
> end;


Собственно и графический объект в данном случае - не окно, а рамка окна :))))) а хук действительно нужен в обоих случаях, чё-то не подумал.

---

← →
Defunct ©   (2004-09-18 23:41) [12]

Mihey_temporary ©   (18.09.04 23:29) [11]

Какой блин еще хук,
Canvas.Handle := GetDC(0) и работаем с экраном

---

← →
Mihey_temporary ©   (2004-09-19 00:29) [13]

> Какой блин еще хук,
> Canvas.Handle := GetDC(0) и работаем с экраном


Соряй, прочитал вопрос, а тему не прочитал и думал, что прицепление к курсору ещё не реализовано.

---

← →
Defunct ©   (2004-09-19 00:29) [14]

Создайте форму, поставьте на форму кнопу и таймер.
Вставьте этот код, изучите как он работает.
Переделайте его под свое приложение.


Implementation

   Var Canvas  : TCanvas;
   Bmp     : TBitmap;
   LastPos : TRect;
   Saved   : Boolean = False;

Procedure Initialize;
Begin
 Canvas := TCanvas.Create;
 Canvas.Handle := GetDC(0);
 Bmp := TBitmap.Create;
End;

Function ZRect(Rect:TRect):TRect;
Begin
 Result.Left   := 0;
 Result.Right  := Rect.Right - Rect.Left;
 Result.Top    := 0;
 Result.Bottom := Rect.Bottom - Rect.Top;
End;

Procedure SaveRect(Rect:TRect);
Begin
 Bmp.Width := Rect.Right - Rect.Left;
 Bmp.Height := Rect.Bottom - Rect.Top;
 LastPos := Rect;
 Bmp.Canvas.CopyRect( ZRect(Rect), Canvas, Rect );
 Saved := True;
End;

Procedure RestoreRect;
Begin
 If Saved Then
    Canvas.CopyRect( LastPos, Bmp.Canvas, ZRect(LastPos) );
End;

Procedure Finalize;
Begin
 If Assigned(Canvas) Then Canvas.Free;
 If Assigned(Bmp) Then Bmp.Free;
End;

Procedure DrawBitmap(Where:TPoint; Bitmap:TBitmap);
Var R:TRect;
Begin
 R.TopLeft := Where;
 R.Right := R.Left + Bitmap.Width;
 R.Bottom := R.Top + Bitmap.Height;
 RestoreRect;
 SaveRect( R );
 Canvas.CopyRect( R, Bitmap.Canvas, ZRect(R));
End;

Var BmpEnabled:Boolean = False;
   Pic: TBitmap;

procedure TForm1.Button1Click(Sender: TObject);
begin
 Pic := TBitmap.Create;
 Initialize;
 Pic.LoadFromFile("1.bmp");
 BmpEnabled := True;
 Timer1.Interval := 10;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 If BmpEnabled Then DrawBitmap( Mouse.CursorPos, Pic);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 RestoreRect;
 Finalize;
end;

---

← →
KSergey ©   (2004-09-19 07:11) [15]

Придирка не по сути:

> Procedure Finalize;
> Begin
>  If Assigned(Canvas) Then Canvas.Free;
>  If Assigned(Bmp) Then Bmp.Free;
> End;

Зачем выделенное? Вообще-то Free по определению сам делает тоже самое. Это раз. А в каком случае, интересно, может быть гарантированное NOT Assigned? (в том числе и для Free)
Если не вызовем Procedure Initialize (не важно почему) - тогда в Canvas и Bmp будет мусор...
Тут надо либо уж Canvas и Bmp внутренними переменными некоего класса (тогда их почистит VCL; правда тогда имена выбраны неудачно), либо написать

> Implementation
>
>    Var Canvas  : TCanvas = nil;
>    Bmp     : TBitmap = nil;
>    LastPos : TRect;
>    Saved   : Boolean = False;

---

← →
Defunct ©   (2004-09-19 14:15) [16]

KSergey ©   (19.09.04 07:11) [15]
На самом деле придирка должна быть не к Assigned а к тому, что Pic не разрушается. Но это все по невнимательности. Пример написал за пару минут.

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
RestoreRect;
Finalize;
Pic.Free
end;

---

Страницы: 1 вся ветка

Текущий архив: 2004.10.03;
Скачать: CL | DM;

Наверх

Память: 0.51 MB
Время: 0.028 c