Не изменяется форма курсора

[anian]

Суть такая: на форме есть пикчербокс, в нем всякие разные штуки рисуются апишными функциями. По таймеру определяютмя координаты мыша над пикчером, и ежели они лежат в одной области, то курсор мыша должен изменить форму (на size NS), ежели в другой - область меняет цвет и так далее...Но: курсор форму меняет, да тока на какую-то долю секунды, потом опять становится стандартным...немного мыша двинул - опять изменил форму ненадолго и так без конца

[Oxygen]

А можно код в студию? Так не совсем понятно.

[Шурик]

Private Sub Timer1.Timer()
..........
полюбому ошибка тута
..........
End

[anian]

Да ради Бога...вот этот кусочек:

Код: Выделить всё

Private Sub tmrHeader_Timer()
    Dim j&, hBr&
   
'mTCols() - свойства и координаты областей
'mTSplits() as RECT - области-разделители, где курсор должен менять форму

    GetCursorPos ptM
    ScreenToClient UserControl.hwnd, ptM
   
    For j = 1 To m_iCols
   
    hBr = CreateSolidBrush(TranslateColor(vbWhite))
    FillRect hdc, mTSplits(j), hBr
    DeleteObject hBr
   
    If PtInRect(mTCols(j).tCR, ptM.x, ptM.y) <> 0 Then
        MousePointer = 0
        SetTextColor hdc, TranslateColor(vbHighlight)
        pDrawHText mTCols(j)
    ElseIf PtInRect(mTSplits(j), ptM.x, ptM.y) <> 0 Then
        MousePointer = 5
    Else
        MousePointer = 0
        SetTextColor hdc, TranslateColor(vbButtonText)
        pDrawHText mTCols(j)
    End If
   
    Next
    Refresh 'можно и не рефрешь...погоды не делает
End Sub


[Ennor]

Хм. Я бы вместо таймера использовал MouseMove(). Туда и координаты мыши передаются...

[anian]

Мда-с...год прошел...вспомнил я про это дело, решил до логического конца довести...

Проблема та же...убрал я таймер, отрисовку всего и вся...просто хочу курсор поменять номально - не дает, сабака сутулая...может у меня в генах ошибка?

Код: Выделить всё

'где-то в районе Form_Load
...
Dim bCur as Boolean
bCur = False
...
'пикчер бокс
Private Sub pBox_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
               
        If Not bCur Then
            hCurs = LoadCursor(0, IDC_SIZEWE)
            bCur = True
            'SetCursor hCurs - если здесь стоит, то курсор форму вообще не меняет
        End If
            SetCursor hCurs
       
End Sub


пока мыша не двигается - держит форму, как двигать начинаешь - мерцает впремешку с обычным курсором-указателем

[tyomitch]

Проблема та же...убрал я таймер, отрисовку всего и вся...просто хочу курсор поменять номально - не дает, сабака сутулая...может у меня в генах ошибка?

Стопудово. Нет бы, как все люди, pBox.MousePointer менять, - полез в API

[Konst_One]

если у тебя слишком тонкая граница, где курсор должен меняться, то задай допуск +-1или2px на его изменение и еще перед сменой вида курсора проверяй, может он у тебя уже и так нужного тебе вида, то зачем его опять менять

[anian]

Блин, ребяты...это минимальный код, упрощенный до предела...пусть хотя бы при попадании в область пикчера форму меняет...

Стопудово. Нет бы, как все люди, pBox.MousePointer менять, - полез в API

В этом все и дело...меняться он должен лишь в определенных облястях пикчера...

Вставьте код в форму, киньте пикчер с соответствующим именем, запустите и все увидите...

[d3drm]

просто поставь picturebox с именем picture1 на форму и вставь туда код:

Код: Выделить всё

Option Explicit

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Picture1.Line (50, 50)-(50, 100)
    Picture1.Line (50, 100)-(100, 100)
    Picture1.Line (100, 100)-(100, 50)
    Picture1.Line (100, 50)-(50, 50)
   
    If X > 50 And X < 100 And Y > 50 And Y < 100 Then
        Picture1.MousePointer = 3
    Else
        Picture1.MousePointer = 0
    End If
   
End Sub

разве не просто?

[GSerg]

Не просто.

Непросто понять, что такое 0 и что такое 3. Есть, к примеру, vbDefault, vbIbeam... Но это так, к слову...

[SHURUP]

Код: Выделить всё

Option Explicit

Private Const limit = 5
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Caption = setSizeCursor(Picture1, X, Y)
End Sub

Public Function setSizeCursor(pb As PictureBox, X As Single, Y As Single) As Byte
Dim Xc As Byte, Yc As Byte
Dim Cur As MousePointerConstants
    Select Case X
        Case 0 To limit: Xc = 1
        Case pb.ScaleWidth - limit - 1 To pb.ScaleWidth: Xc = 4
    End Select
    Select Case Y
        Case 0 To limit: Yc = 2
        Case pb.ScaleHeight - limit - 1 To pb.ScaleHeight: Yc = 8
    End Select
    Select Case (Xc Or Yc)
        Case 1, 4: Cur = vbSizeWE
        Case 2, 8: Cur = vbSizeNS
        Case 3, 12: Cur = vbSizeNWSE
        Case 6, 9: Cur = vbSizeNESW
    End Select
    If Not (pb.MousePointer = Cur) Then pb.MousePointer = Cur
    setSizeCursor = (Xc Or Yc)
End Function

' функция setSizeCursor возвращает значение, соотв. стороне в которой курсор
' (это может быть полезно, если собираешься в дальнейшем изменять размеры пикчурбокса перетаскиванием за край)

' 3     2      6
'   \ - + - /
'   |       |
' 1 +   0   + 4
'   |       |
'   / - + - \
' 9     8     12


[Konst_One]

SHURUP
молодец
воплотил как раз то, о чем я ранее написал

[anian]

Вариант с таймером и MousePointer'ом весьма хорош, учитывая малую область "горячего квадрата"...почти не мерцает...а если область больше, то финиш...а таймер должен быть _обязательно_...

[SHURUP]

… и еще перед сменой вида курсора проверяй, может он у тебя уже и так нужного тебе вида, то зачем его опять менять

Если это делать - то мерцать не должно.

[anian]

to SHURUP:
Блин, я об этом еще и не заикался...так, в планах было...Спасибо!

[anian]

… и еще перед сменой вида курсора проверяй, может он у тебя уже и так нужного тебе вида, то зачем его опять менять

Если это делать - то мерцать не должно.

А как же...проверка первым делом...тут даже с моими генами все понятно

[Kovu]

Мда-с...год прошел...вспомнил я про это дело, решил до логического конца довести...

Проблема та же...убрал я таймер, отрисовку всего и вся...просто хочу курсор поменять номально - не дает, сабака сутулая...может у меня в генах ошибка?

Код: Выделить всё

'где-то в районе Form_Load
...
Dim bCur as Boolean
bCur = False
...
'пикчер бокс
Private Sub pBox_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
               
        If Not bCur Then
            hCurs = LoadCursor(0, IDC_SIZEWE)
            bCur = True
            'SetCursor hCurs - если здесь стоит, то курсор форму вообще не меняет
        End If
            SetCursor hCurs
       
End Sub


пока мыша не двигается - держит форму, как двигать начинаешь - мерцает впремешку с обычным курсором-указателем

А ты MSDN читаешь? Там для Умственно Одарённых(у.о.) написано что в VB так курсор менять нельзя

[tyomitch]

Kovu, няп - проблема уже решена...

[anian]

А ты MSDN читаешь? Там для Умственно Одарённых(у.о.) написано что в VB так курсор менять нельзя

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