Форум: "Основная";
Текущий архив: 2004.10.03;
Скачать: [xml.tar.bz2];
Вниз
как прицепить к купсору какую-нибудь картинку? Найти похожие ветки
← →
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;
Скачать: [xml.tar.bz2];
Память: 0.49 MB
Время: 0.043 c
