Найти в опр области экрана розовый пиксель и навестись на него.
=============================================

Задача такая:

В квадратном радиусе 24пикселя от текущей позиции мышки
на экране нужно найти розовый пиксель и навести на него указатель мышки.

Цитата

квадратном радиусе

Эх, программисты 8)...

а) Процедуры копирования области экрана

Код

unit ScrnCap; interface uses WinTypes, WinProcs, Forms, Classes, Graphics, Controls; { Копирует прямоугольную область экрана } function CaptureScreenRect(ARect : TRect) : TBitmap; { Копирование всего экрана } function CaptureScreen : TBitmap; { Копирование клиентской области формы или элемента } function CaptureClientImage(Control : TControl) : TBitmap; { Копирование всей формы элемента } function CaptureControlImage(Control : TControl) : TBitmap; {===============================================================} implementation function GetSystemPalette : HPalette; var PaletteSize  : integer; LogSize      : integer; LogPalette   : PLogPalette; DC           : HDC; Focus        : HWND; begin result:=0; Focus:=GetFocus; DC:=GetDC(Focus); try   PaletteSize:=GetDeviceCaps(DC, SIZEPALETTE);   LogSize:=SizeOf(TLogPalette)+(PaletteSize-1)*SizeOf(TPaletteEntry);   GetMem(LogPalette, LogSize);   try     with LogPalette^ do     begin       palVersion:=$0300;       palNumEntries:=PaletteSize;       GetSystemPaletteEntries(DC, 0, PaletteSize, palPalEntry);     end;     result:=CreatePalette(LogPalette^);   finally     FreeMem(LogPalette, LogSize);   end; finally   ReleaseDC(Focus, DC); end; end; function CaptureScreenRect(ARect : TRect) : TBitmap; var ScreenDC : HDC; begin Result:=TBitmap.Create; with result, ARect do begin  Width:=Right-Left;  Height:=Bottom-Top;  ScreenDC:=GetDC(0);  try    BitBlt(Canvas.Handle, 0,0,Width,Height,ScreenDC, Left, Top, SRCCOPY   );  finally    ReleaseDC(0, ScreenDC);  end;  Palette:=GetSystemPalette; end; end; function CaptureScreen : TBitmap; begin with Screen do  Result:=CaptureScreenRect(Rect(0,0,Width,Height)); end; function CaptureClientImage(Control : TControl) : TBitmap; begin with Control, Control.ClientOrigin do  result:=CaptureScreenRect(Bounds(X,Y,ClientWidth,ClientHeight)); end; function CaptureControlImage(Control : TControl) : TBitmap; begin with Control do  if Parent=Nil then    result:=CaptureScreenRect(Bounds(Left,Top,Width,Height))  else   with Parent.ClientToScreen(Point(Left, Top)) do    result:=CaptureScreenRect(Bounds(X,Y,Width,Height)); end; end.

Взято из FAQ.

б)
ты получил битмапку, теперь просто сканишь массив pixels на предмет цвета $AAAAFF (или какой у тебя розовый?) и потом пеерводишь полученное значение х и у в экранные координаты и SetCursorPos(Point(х,у)).
Чтобы быстрее сканить нужно что-то вроде этого:

Код

TRGB=record  b,g,r : byte; Type    ARGB=array [0..1] of TRGB;    PARGB=^ARGB; ..... var i,j,a,b : integer; p:pargb; begin a:=-1; b:=-1; for i:=0 to bitmap.height-1 do begin p:=bitmap.scanline[i]; for j:=0 to bitmap.width-1 do if RGB(p[j].r,p[j].g,p[j].b)=$AAAAFF then begin a:=i; b:=j; break; end; end; end;

a & b - координаты (но не на экране! нужно перевести - преобразования есть в школьком учебнике за 10-й класс... а может и раньше)
Надеюсь, что идея понятна. Если была ошибка синтаксическая, то не ругайте сильно - писал просто по памяти. А чтобы получить текущую координату курсора: GetCursorPos(p:Tpoint);
P.S. задай только bitmap.pixelformat=pf24bit перед сканированием.
P.P.S. А почему именно розовый? 8) А то после конференции одного человека разные мысли лезут в голову про поиск розовых кофточек (извиняюсь за оффтоп 8))))

Это сообщение отредактировал(а) Illusion Dolphin - 25.7.2004, 18:55

RAdmin GetPixel, но это функция очень медленная, как и SetPixel, поэтому иди на "Мастера Дельфи" и качай там класс QuickPixels - это класс для прямого доступа к видеопамяти(там большая часть на асме, насколько я помню).
"Навести" мышку можешь при помощи SetCursorPos

Это сообщение отредактировал(а) <Spawn> - 25.7.2004, 19:33

Огромное вам всем спасибо.
вот только небольшое затруднение с
опредилением TRect для процедуры CaptureScreenRect

Мне нужно чтоб Границы прямоугольника были
вокруг текущей позиции мышки на растоянии 24 пикселя.

Я вот так сделал, но мне кажется что это не прямоугольник а ромб.

Windows.GetCursorPos(Pz);

With RC do
begin
TopLeft.X:=Pz.x-24;
TopLeft.Y:=Pz.Y-24;
BottomRight.X:=Pz.x+24;
BottomRight.Y:=Pz.Y+24;
end;