2013-06-19 07:48

' v1.0:
' Fixed WndProc (actually, wrote it from scratch ·)
' Two new events, OnGetFocus and OnLoseFocus
' When using the new events, you MUST use the Sender parameter
' Custom events MUST have at least one paramater, haven't found
' a way aroud this yet

' v1.1:
' Fixed a little bug in WndProc(check for assignment)
' Added Property EnterKey

     DECLARE FUNCTION CallWindowProc LIB "User32" ALIAS "CallWindowProcA"(lpPrevWndFunc AS LONG, hWnd AS LONG, uMsg AS LONG, wParam AS LONG, lParam AS LONG) AS LONG
     DECLARE FUNCTION SetWindowLong LIB "User32" ALIAS "SetWindowLongA"(hWnd AS LONG, nIndex AS LONG, dwNewLong AS LONG) AS LONG
     DECLARE FUNCTION GetParent LIB "User32" ALIAS "GetParent" (hWnd AS LONG) AS LONG

     CONST ekNormal = 0
     CONST ekTab = 1

     DECLARE SUB OnGetFocus_EventTemplate(Sender AS QEDIT)
     DECLARE SUB OnLoseFocus_EventTemplate(Sender AS QEDIT)
     DECLARE SUB WndProc_EventTemplate(hWnd AS LONG, uMsg AS LONG, wParam AS LONG, lParam AS LONG)

     TYPE QMAXEDIT EXTENDS QEDIT
      Tmr AS QTIMER
      OldWndProc AS LONG
      EnterKey AS LONG PROPERTY SET Set_EnterKey
      OnGetFocus AS EVENT(OnGetFocus_EventTemplate)
      OnLoseFocus AS EVENT(OnLoseFocus_EventTemplate)
      WndProc AS EVENT(WndProc_EventTemplate)

      WITH This

       PROPERTY SET Set_EnterKey(NewEnterKey AS LONG)
        .EnterKey = NewEnterKey
       END PROPERTY SET

       FUNCTION Proc(hWnd AS LONG, uMsg AS LONG, wParam AS LONG, lParam AS LONG) AS LONG
        IF hWnd = .Handle THEN
         Result = CallWindowProc(.OldWndProc, hWnd, uMsg, wParam, lParam)
         IF uMsg = &H7 THEN
          CALLFUNC(.OnGetFocus, This)
         ELSEIF uMsg = &H8 THEN
          CALLFUNC(.OnLoseFocus, This)
         ELSEIF uMsg = &H100  AND wParam = &HD AND .EnterKey THEN
          KillMessage(GetParent(.Handle), &H102)
          SendMessage(GetParent(.Handle), &H28, 0, 0)
         END IF
         IF .WndProc>0 THEN CALLFUNC(.WndProc, hWnd, uMsg, wParam, lParam)
        END IF
       END FUNCTION

       EVENT Tmr.OnTimer
        .OldWndProc = SetWindowLong(This.Handle, -4, CODEPTR(This.Proc))
        .Tmr.Enabled = 0
       END EVENT

       CONSTRUCTOR
        Tmr.Interval = 1
       END CONSTRUCTOR

      END WITH

     END TYPE

     $UNDEF QEDIT
     $DEFINE QEDIT QMAXEDIT

'========================================================================

     DECLARE SUB GET(Sender AS QEDIT)
     DECLARE SUB Lose(Sender AS QEDIT)
     DECLARE SUB WndProc(hWnd AS LONG, uMsg AS LONG, wParam AS LONG, lParam AS LONG)

     CREATE Form AS QFORM
      Center
      CREATE Edit1 AS QEDIT
       Text = "Edit1"
       OnGetFocus = GET
       OnLoseFocus = Lose
       EnterKey = ekTab
       WndProc = WndProc
       COLOR = &H00FFFF
      END CREATE
      CREATE Edit2 AS QEDIT
       Text = "Edit2"
       Top = 30
       OnGetFocus = GET
       OnLoseFocus = Lose
       EnterKey = ekTab
       WndProc = WndProc
      END CREATE
      CREATE Button AS QBUTTON
       Top = 60
      END CREATE
     END CREATE

     Form.SHOWMODAL

     SUB GET
      Form.CAPTION = "Focused: " + Sender.Text
      Sender.COLOR = &H00FFFF
     END SUB

     SUB Lose
      Form.CAPTION = "Not Focused"
      Sender.COLOR = &HFFFFFF
     END SUB

     SUB WndProc
      IF uMsg = &H100 THEN
       Form.CAPTION = "Key"
      END IF
     END SUB

2013-06-19 07:48