Изменить курсор вне модальной формы

← →
Laguna © (2011-11-13 00:57) [0]

На форме есть кнопка, по нажатию на которую открывается другое модальное окно(приложение-пример Zoom). Каким образом изменить курсор вне этой модальной формы, а когда она получает фокус - возвращать на дефолтовый? Пытался менять через SetSystemCursor(CurLupaID, OCR_NORMAL); - безрезультатно.

← →
KilkennyCat © (2011-11-13 01:27) [1]

> а когда она получает фокус

а как это она теряет фокус, если она - модальная?

← →
_Юрий (2011-11-13 12:20) [2]

А что будет, если то же самое в то же самое время решит сделать еще одна программа ?

← →
Laguna © (2011-11-13 16:05) [3]

> KilkennyCat © (13.11.11 01:27) [1]

> а когда она получает фокуса как это она теряет фокус,
> если она - модальная?

Наверное я не совсем коррекктно выразился. Вторая вызываемая модальная форма служит экраном, представляющим увеличенную картинку, в тот момент, когда курсор находится на экране вне этой формы. Стоит мышку перевести обратно на эту форму, появляется окно настроек. Т.е. я хотел бы менять курсор на изображение лупы, когда курсор находится над исследуемой поверхностью, вне модальной формы.

← →
Laguna © (2011-11-13 18:25) [4]

Дополню, речь идет об этой программе http://delphi.about.com/od/graphics/l/aa120198.htm

← →
KilkennyCat © (2011-11-13 19:01) [5]

> SetSystemCursor(CurLupaID, OCR_NORMAL); - безрезультатно.

CurLupaID - это что?

← →
Laguna © (2011-11-13 19:33) [6]

> CurLupaID - это что?

Var CurLupaID : TCursor; ... CurLupaID := DefineCursor(HInstance,"LUPA");

← →
KilkennyCat © (2011-11-13 19:58) [7]

отлично. имеем
CurLupaID : TCursor;
и
SetSystemCursor(CurLupaID
в то время как SetSystemCursor хочет HIcon

а DefineCursor - это что?
и что, так все из тебя клещами вытягивать, что ты из интернета навытягивал?

← →
Laguna © (2011-11-13 22:16) [8]

Немного ошибся
SetSystemCursor(LoadCursor(HInstance, "LUPA"), OCR_NORMAL);
Так загружается нормальльно, только правильно ли я поступаю, изменяяя системный курсор таким способом? Может есть другое решение?

> а DefineCursor - это что?

Это из RX, загружает курсор из ресурсов (unit rxVclutils)
function DefineCursor(Instance: THandle; ResID: PChar): TCursor; var Handle: HCursor; begin Handle := LoadCursor(Instance, ResID); if Handle = 0 then Handle := LoadAniCursor(Instance, ResID); if Handle = 0 then ResourceNotFound(ResID); for Result := 100 to High(TCursor) do { Look for an unassigned cursor index } if (Screen.Cursors[Result] = Screen.Cursors[crDefault]) then begin Screen.Cursors[Result] := Handle; Exit; end; DestroyCursor(Handle); raise EOutOfResources.Create(ResStr(SOutOfResources)); end;

← →
KilkennyCat © (2011-11-13 22:47) [9]

> Это из RX,

ну вот в следующий раз не думай, что это все знают, и у всех стоит какой-то компонент.

> правильно ли я поступаю, изменяяя системный курсор таким
> способом?

правильно. но учти, что его может изменить что-либо другое (другой контрол), и что его надо вернуть взад, когда не нужен. гарантированно вернуть.

← →
Laguna © (2011-11-13 23:04) [10]

Я делал вот так
Var oc,nc : hCursor; ... procedure TZoomFrm.FormCreate(Sender: TObject); begin oc := CopyIcon(LoadCursor(0,IDC_ARROW));//сохраняем текущий курсор end; .... procedure TZoomFrm.Timer1Timer(Sender: TObject); var Srect, Drect, PosForme : TRect; iWidth, iHeight{,DmX,DmY} : Integer; iTmpX, iTmpY : Real; C : TCanvas; Kursor : TPoint; begin if not IsIconic(Application.Handle) then begin SetSystemCursor(LoadCursor(HInstance, "LUPA"), OCR_NORMAL); GetCursorPos(Kursor); PosForme:=Rect(ZoomFrm.Left,ZoomFrm.Top,ZoomFrm.Left+ZoomFrm.Width,ZoomFrm.Top+ZoomFrm.Height); If not PtInRect(PosForme,Kursor) then begin //Screen.Cursor := CurLupaID; If Panel1.Visible=True then Panel1.Visible:=False; If Image1.Visible=False then Image1.Visible:=True; iWidth:=Image1.Width; iHeight:=Image1.Height; Drect:=Rect(0,0,iWidth,iHeight); iTmpX:=iWidth / (Slider.Position * 4); iTmpY:=iHeight / (Slider.Position * 4); Srect:=Rect(Kursor.x,Kursor.y,Kursor.x,Kursor.y); InflateRect(Srect,Round(iTmpX),Round(iTmpY)); // move Srect if outside visible area of the screen If Srect.Left<0 then OffsetRect(Srect,-Srect.Left,0); If Srect.Top<0 then OffsetRect(Srect,0,-Srect.Top); If Srect.Right>Screen.Width then OffsetRect(Srect,-(Srect.Right-Screen.Width),0); If Srect.Bottom>Screen.Height then OffsetRect(Srect,0,-(Srect.Bottom-Screen.Height)); C:=TCanvas.Create; try C.Handle:=GetDC(GetDesktopWindow); Image1.Canvas.CopyRect(Drect,C,Srect); finally ReleaseDC(0,C.Handle); C.Free; end; Application.ProcessMessages; end // Cursor not inside form else begin // cursor inside form SetSystemCursor(oc, OCR_NORMAL);//возвращаем старый If Panel1.Visible=False then Panel1.Visible:=True; If Image1.Visible=True then Image1.Visible:=False; end; end; // IsIconic end; ... procedure TZoomFrm.FormDestroy(Sender: TObject); begin Timer1.Interval:=0; SetSystemCursor(oc, OCR_NORMAL);//возвращаем старый end;

Курсор заменяется на лупу, а вот обратно в первостепенный вид не возвращается.

← →
KilkennyCat © (2011-11-14 00:06) [11]

> Курсор заменяется на лупу, а вот обратно в первостепенный
> вид не возвращается.

ну, раз замена работает, значит, два варианта: не вызывается замена на старый; не сохраняется старый (или сохраняется не так, или сохраненное успевает уничтожится)

← →
Laguna © (2011-11-14 00:18) [12]

Обнаружил, что в этом блоке при вторичном входе не срабатывает замена на старый курсор. Для простоты сделал такую проверку:
procedure TZoomFrm.FormCreate(Sender: TObject); begin oc := CopyIcon(LoadCursor(0,IDC_ARROW));//сохраняем текущий курсор end; procedure TZoomFrm.Button1Click(Sender: TObject); begin oc := CopyIcon(LoadCursor(0,IDC_ARROW));//сохраняем текущий курсор SetSystemCursor(LoadCursor(HInstance, "LUPA"), OCR_NORMAL); end; procedure TZoomFrm.Button2Click(Sender: TObject); begin SetSystemCursor(oc, OCR_NORMAL);//возвращаем старый end;
Нажимая последовательно - все пучком.
Стоит сделать вот так
procedure TZoomFrm.Button1Click(Sender: TObject); begin // oc := CopyIcon(LoadCursor(0,IDC_ARROW));//сохраняем текущий курсор SetSystemCursor(LoadCursor(HInstance, "LUPA"), OCR_NORMAL); end;
Нажимаем Button1, - лупа, Button2 - стрелка, Button1 - лупа, Button2 - лупа.. и больше не меняется. Что такое? Почему oc не запоминает значение или запоминает , но где то меняется. Тогда почему меняется, если на создании формы один раз получает значение?

> Обнаружил, что в этом блоке при вторичном входе не срабатывает
> замена на старый курсор.

Пардон, не вставил блок
... end // Cursor not inside form else begin // cursor inside form SetSystemCursor(oc, OCR_NORMAL);//возвращаем старый ...

> oc := CopyIcon(

Хоть и несущественно, но есть же CopyCursor - намного понятнее будет читать...
SetSystemCursor, CopyIcon, LoadCursor - это все функции, т.е. могут выдать результат ошибки... посмотри. может что-то где-то не так.

CopyCursor - чет компилятор не находит такое.

Ну это как вариант. Но если вникнуть в проблему, то возможно и первый вариант должен работать.

> CopyCursor - чет компилятор не находит такое.

да... а в винапи есть. ну и хрен с ней. в принципе, одно и тоже.

Настараживает вот эта строка из описания функции SetSystemCursor

Система уничтожает hcur, вызывая функцию DestroyCursor. Поэтому, hcur не может быть загруженным курсором, используя функцию LoadCursor. Чтобы установить курсор, загруженный из ресурса, скопируйте курсор, используя функцию CopyCursor, а затем передайте копию в SetSystemCursor.
Может поэтому oc := CopyIcon(LoadCursor(0,IDC_ARROW)) не сохраняется?

Решение найдено. И не нужно предварительно сохранять старый курсор. Может кому пригодится.

end // Cursor not inside form ...... else begin // cursor inside form SystemParametersInfo(SPI_SETCURSORS,0,Nil,WM_SETTINGCHANGE or SPIF_UPDATEINIFILE); .....

Изменить курсор вне модальной формы Найти похожие ветки