SetWindowCallback

Window ››
Parent Previous Next

SetWindowCallback

Синтаксис

Function SetWindowCallback(ByVal Address_Function As Integer,ByVal flag As Integer=0) As Integer

Описание

Функция позволяет создать функцию для отлова сообщений, как если бы напрямую работали с оконной процедурой или с циклом, в котором размещены важнейшие функции (GetMessage , TranslateMessage , DispatchMessage). В отличии от SetClassLong, заменяющую оконную процедуру, функция SetWindowCallback оставляет основной цикл работоспособным. Просто все события в первую очередь проходят через вашу созданную функцию, которую вы укажете в параметре SetWindowCallback. Есть возможность установить две процедуры в программе с помощью SetWindowCallback , но с разными флагами . Есть возможность отключать установленные SetWindowCallback функции, делается это с помощью функции FreeCallback

Примерная обработка сообщений:

Параметры

Address_Function - адрес функции, которая будет отлавливать сообщения

flag - флаг, может быть:

    0 - сообщения из оконной процедуры . Функция должна иметь прототип: (hwnd As HWND,msg As UINT,wParam As WPARAM,lParam As LPARAM)
    1 - сообщения будут отлавливаться напрямую из цикла в котором основные функции: GetMessage , TranslateMessage , DispatchMessage . Функция должна иметь прототип: (ByVal As HWND,ByVal As UINT,ByVal As WPARAM,ByVal As LPARAM,ByVal As Integer,ByVal As POINT)

Платформы

Windows

Пример

' Самодельный SysLink Controls
#Include "window9.bi"
Dim Shared text As Hwnd
Function windowproc(hwnd As HWND,msg As UINT,wParam As WPARAM,lParam As LPARAM) As Integer
  Static a As Integer
  If msg= WM_MOUSEMOVE Then
     If IsMouseOver(text)  Then
        SetCursor(LoadCursor(0,IDC_HAND))
        If a=0 then
           SetGadgetColor(1,0,255,2)
           invalidaterect(text,0,1)
           a=1
        EndIf
     Else
        If a=1 Then
           SetGadgetColor(1,0,&hff0000,2)
           invalidaterect(text,0,1)
           a=0
        endif
     EndIf
  EndIf
  Return 0
End Function
Var hwnd=OpenWindow("Hyperlink Test",100,100,200,100)
text=TextGadget(1,10,10,100,30,"Visit on forum Freebasic",SS_CENTER OR SS_NOTIFY)
SetGadgetColor(1,0,&hff0000,2)
SetWindowCallback(CInt(@windowproc()),1)
Do
  Var ev=WaitEvent
  If ev =EventGadget Then
     If EventNumber=1 Then
        RunProgram("E:\opera.exe","http://www.freebasic.net/forum/")
     EndIf
  ElseIf ev= EventClose Then end
  endif
Loop

Результат

Created with the Personal Edition of HelpNDoc: Single source CHM, PDF, DOC and HTML Help creation