Announcement

Collapse
No announcement yet.

Mousetrap needed

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Mousetrap needed

    I have a dialog full of textboxes, one below the other. With some effort I have managed
    to get both the scroll bar and the cursor keys to respond, but I also need to trap
    a normal mouse left button click so that I can set focus on the box selected. Tried all
    sorts of GetMessage variations, but no joy. What is the simple (:-]) answer?

    The function EditKeyPress below is called by all the textboxes, after sub-classing, by means of -


    ' Subclass the edit controls
    For x& = 5 To QLlines&
    Control Handle CbHndl, x& To hEdit&
    gOldSubClassProc& = SetWindowLong(hEdit&, %GWL_WNDPROC, CodePtr(EditKeyPress))
    Next

    PS: have finally discovered a bookshop where they HAVE ACTUALLY HEARD of the Petzold book!
    '----------------------------------------------------------------------------------------------
    Function EditKeyPress (ByVal hWnd&, ByVal wMsg&, ByVal wParam&, ByVal lParam&) As Long
    Static CurBox&

    Select Case wMsg&
    ' Case %WM_LBUTTONDOWN
    ' GetDlgCtrlID qDlg&, i&
    'MsgBox(Str$(n&))
    Case %WM_CREATE

    Local tm As TEXTMETRIC

    hdc& = GetDC (hWnd&)
    Call GetTextMetrics (hdc&, tm)
    cyChar& = tm.tmHeight + tm.tmExternalLeading 'Line spacing
    ReleaseDC hWnd&, hdc&
    Function = 0

    Case %WM_KEYDOWN
    If WPARAM&=33 Or WPARAM&=34 Or WPARAM&=38 Or WPARAM&=40 Then HideCaret %NULL
    SetWindowText GetParent(hWnd&), "WM_KEYDOWN"

    Case %WM_KEYUP
    SetWindowText GetParent(hWnd&), "WM_KEYUP"
    Control Handle qDlg&, 1006 To hCtl&

    Select Case WPARAM&

    Case 33 'PageUp
    ScrollBy&=0
    If scrPos&>QLlines&-23 Then ScrPos&=QLlines&-23
    If ScrPos&>19 Then
    ScrollBy&=cyChar&*19
    ScrPos&=ScrPos&-19
    Else
    ScrollBy&=ScrPos&*cyChar&
    ScrPos&=0
    End If
    Call ScrollWindow (qDlg&, 0, ScrollBy&, ByVal %NULL, ByVal %NULL)
    Control Set Loc qDlg&, 1006, 392, 0
    Call SetScrollPos (hCtl&, %SB_CTL, ScrPos&, %TRUE)
    Call UpdateWindow (qDlg&)
    CurrLine&=ScrPos&
    ci$=FetchQLetterline(CurrLine&)
    If Qltpe&(CurrLine&)=0 Or _
    Instr(ci$,"Quantity ")>0 And Instr(ci$," Price ")>0 Or _
    Instr(ci$,"Kwantiteit ")>0 And Instr(ci$," Prys ")>0 Or _
    Qltpe&(CurrLine&)=210 Then UpMore
    Control Set Focus qDlg&, CurrLine&
    ShowCaret %NULL

    Case 34 'PageDown
    ScrollBy&=0
    If ScrPos&+19<QLlines&-23 Then
    ScrPos&=ScrPos&+19
    ScrollBy&=0-cyChar&*19
    Else
    ScrollBy&=0-(((QLlines&-23)-ScrPos&)*cyChar&)
    ScrPos&=QLlines&-5
    End If
    Call ScrollWindow (qDlg&, 0, ScrollBy&, ByVal %NULL, ByVal %NULL)
    Control Set Loc qDlg&, 1006, 392, 0
    Call SetScrollPos (hCtl&, %SB_CTL, ScrPos&, %TRUE)
    Call UpdateWindow (qDlg&)
    CurrLine&=ScrPos&
    ci$=FetchQLetterline(CurrLine&)
    If Qltpe&(CurrLine&)=0 Or _
    Instr(ci$,"Quantity ")>0 And Instr(ci$," Price ")>0 Or _
    Instr(ci$,"Kwantiteit ")>0 And Instr(ci$," Prys ")>0 Or _
    Qltpe&(CurrLine&)=210 Then DownMore
    Control Set Focus qDlg&, CurrLine&
    ShowCaret %NULL

    Case 38 'ArrowUp
    UpMore:
    If CurrLine&<5 Then Exit Select
    ScrollBy&=cyChar&
    Decr ScrPos&
    Decr Currline&
    If ScrPos&<0 Then
    ScrollBy&=0
    ScrPos&=0
    Currline&=6
    End If
    n&=GetFocus ()
    n&=GetDlgCtrlID(n&)
    Control Get Loc qDlg&, n& To Hrz&, Vrt&
    If Vrt&<6 Then
    Call ScrollWindow (qDlg&, 0, ScrollBy&, ByVal %NULL, ByVal %NULL)
    End If
    Control Set Loc qDlg&, 1006, 392, 0
    Call SetScrollPos (hCtl&, %SB_CTL, ScrPos&, %TRUE)
    Call UpdateWindow (qDlg&)
    ci$=FetchQLetterline(CurrLine&)
    If Qltpe&(CurrLine&)=0 Or _
    Instr(ci$,"Quantity ")>0 And Instr(ci$," Price ")>0 Or _
    Instr(ci$,"Kwantiteit ")>0 And Instr(ci$," Prys ")>0 Or _
    Qltpe&(CurrLine&)=210 Then UpMore
    Control Set Focus qDlg&, CurrLine&
    SetCaretPos 0,0
    ShowCaret %NULL

    Case 40 'ArrowDown
    DownMore:
    If CurrLine&>QLlines&-1 Then Exit Select
    ScrollBy&=0-cyChar&
    Incr ScrPos&
    Incr CurrLine&
    Control Set Focus qDlg&, CurrLine&
    n&=GetFocus ()
    n&=GetDlgCtrlID(n&)
    If n&=0 Then GoDown
    Control Get Loc qDlg&, n& To Hrz&, Vrt&
    ci$=FetchQLetterline(CurrLine&)
    If ScrPos&>QLlines&-3 Then
    ScrollBy&=0
    ScrPos&=QLlines&-5
    CurrLine&=QLlines&
    End If
    If vrt&>187 Then
    GoDown:
    Call ScrollWindow (qDlg&, 0, ScrollBy&, ByVal %NULL, ByVal %NULL)
    End If
    Control Set Loc qDlg&, 1006, 392, 0
    Call SetScrollPos (hCtl&, %SB_CTL, ScrPos&, %TRUE)
    Call UpdateWindow (qDlg&)
    If Qltpe&(CurrLine&)=0 Or _
    Instr(ci$,"Quantity ")>0 And Instr(ci$," Price ")>0 Or _
    Instr(ci$,"Kwantiteit ")>0 And Instr(ci$," Prys ")>0 Or _
    Qltpe&(CurrLine&)=210 Then DownMore
    Control Set Focus qDlg&, CurrLine&
    ShowCaret %NULL
    End Select
    Case %WM_CHAR
    SetWindowText GetParent(hWnd&), "WM_CHAR"
    Case %WM_DESTROY
    SetWindowLong hWnd&, %GWL_WNDPROC, gOldSubClassProc&
    End Select

    ' Pass the message on to the original window procedure... the DDT engine!
    Function = CallWindowProc(gOldSubClassProc&, hWnd&, wMsg&, wParam&, lParam&)
    End Function
    '----------------------------------------------------------------------------------------------

  • #2
    It is very hard to look at your code "unformatted". If you could edit your post and add a {code} flag at the beginning, and a {/code} flag at the end (with [square] instead of {curly} brackets) it will be much easier for people to troubleshoot. Even better, if possible, could you post a complete, compilable example?

    One thing I did notice... Doing this:

    Code:
    Case 38 'ArrowUp
    UpMore:
    ...and doing a GOTO into the middle of a SELECT structure is considered to be bad practice. Strongly discouraged, perhaps even dangerous. You'd be much better off doing it like this:

    Code:
    Case 38 'ArrowUp
            GOSUB UpMore
    Case (etc.)
    ...and having the other code GOSUB and exit instead of using GOTO.

    -- Eric

    ------------------
    Perfect Sync: Perfect Sync Development Tools
    Email: mailto:[email protected][email protected]</A>

    "Not my circus, not my monkeys."

    Comment


    • #3
      Thank you, Eric. Your point taken about the GOTO.

      The executable code is far too large to post here. However, I think I have put my question badly: I DO trap the mouse by means of --

      Function EditKeyPress (ByVal hWnd&, ByVal wMsg&, ByVal wParam&, ByVal lParam&) As Long
      Static CurBox&

      Select Case wMsg&

      Case %WM_LBUTTONDOWN
      n&=GetDlgItem(qDlg&, lParam&)
      MsgBox(Str$(n&)+Str$(LoWrd(lParam&))+Str$(HiWrd(lParam&)) _
      +Str$(LoWrd(wParam&))+Str$(HiWrd(wParam&)))

      Case %WM_CREATE etc.

      The problem is, having got that far, how to IDENTIFY the text box where the click occurred. That msgbox gives the x and y in the two words of lParam. And, though this is the "proxy" callback function (by virtue of sub-classing) such things as CbCtl and CbCtlMsg are not permissable. The parameters received do not seem to be a substitute set.


      ------------------

      Comment


      • #4
        Silly twit! Try this ---

        Function EditKeyPress (ByVal hWnd&, ByVal wMsg&, ByVal wParam&, ByVal lParam&) As Long
        Static CurBox&

        Select Case wMsg&

        Case %WM_LBUTTONDOWN
        n&=GetDlgCtrlID(hWnd&)
        CurrLine&=n&
        ScrPos&=n&-5
        Control Set Focus qDlg&, n&

        Case %WM_CREATE etc.

        It works. To try, try and try again, add one TRY.

        Thanks for your time and trouble, Eric.


        ------------------

        Comment


        • #5
          There's a 'Noclick' or 'Nofocus' (VB) example on my site.



          ------------------

          Comment


          • #6
            I guess I don't understand why Windows was not automatically giving the focus to the control that you were clicking on, but as long as it's working for you now...

            -- Eric


            ------------------
            Perfect Sync: Perfect Sync Development Tools
            Email: mailto:[email protected][email protected]</A>

            "Not my circus, not my monkeys."

            Comment

            Working...
            X