' Subclassing in a Dialog
$ filename "DlgSubclass.exe"
uses rtl32
'uses rtl64
'% review
uses dialogs
! SetWindowLong Lib "user32.dll" Alias "SetWindowLongA"(hwnd AS INT,nIndex AS INT,dwNewLong AS INT) as INT
! SetWindowLongPtr Lib "user32.dll" Alias "SetWindowLongA"(ByVal hWnd As Int,byVal nIndex As Int, ByVal dwNewLong As Int) As Int
! SetProp Lib "user32.dll" Alias "SetPropA" (ByVal hWnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
! GetProp Lib "user32.dll" Alias "GetPropA" (ByVal hWnd As Long, ByVal lpString As String) As Long
! CallWindowProc Lib "user32.dll" Alias "CallWindowProcA"(lpPrevWndFunc AS INT,hWnd AS INT,Msg AS INT,wParam AS INT,lParam AS INT) as INT
! RemoveProp Lib "user32.dll" Alias "RemovePropA" (ByVal hWnd As Long, ByVal lpString As String) As Long
% GWLP_WNDPROC= -4
% DS_3DLOOK 0x0004L
% DS_NOFAILCREATE 0x0010L
% DS_MODALFRAME 0x80L
% DS_CENTER = 2048
'Equates
% IDC_EDIT = 1001
% IDC_LABEL = 1002
sys hEdit
sys hLabel
int hDlg
'=================================
sub WinMain()
hDlg = Dialog( 0, 0, 302, 160, "Edit Subclass in a Dialog",
WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | WS_CLIPSIBLINGS | WS_VISIBLE | DS_MODALFRAME | DS_3DLOOK | DS_NOFAILCREATE | DS_SETFONT | DS_CENTER,
8, "MS Sans Serif",
WS_EX_CONTROLPARENT | WS_EX_LEFT | WS_EX_LTRREADING | WS_EX_RIGHTSCROLLBAR)
EDITTEXT("", IDC_EDIT, 8, 8, 217, 84,
WS_VSCROLL | WS_HSCROLL | ES_MULTILINE | WS_VISIBLE | ES_WANTRETURN | ES_LEFT | WS_BORDER,
WS_EX_CLIENTEDGE)
LText( "", IDC_LABEL, 8, 110, 120, 24)
CreateModalDialog( null, @DlgProc, 0, 0) '<- missmatch here
'CreateModalDialog( sys hParent, sys *lpDialogProc, dwInitParam, lpdt) as sys
end sub
WinMain()
'=================================
function DlgProc( sys hDlg, uint uMsg, sys wParam, lParam ) as sys callback
hEdit = GetDlgItem(hDlg, IDC_EDIT)
hLabel = GetDlgItem(hDlg, IDC_LABEL)
select case uMsg
case WM_INITDIALOG
SetProp(hEdit, "OldEditProc", SetWindowLongPtr(hEdit, GWLP_WNDPROC, @EditProc))
case WM_CLOSE
'Remove control subclassing
'RemoveProp(hEdit, "OldEditProc", GetWindowLongPtr(hEdit, GWLP_WNDPROC, @EditProc))
RemoveProp( hEdit, "OldEditProc")
EndDialog( hDlg, null )
end select
return 0
end function
'======================================
' Subclass procedure for the Edit control to detect what ASCII values were key in
function EditProc(sys hDlg, uint wMsg, sys wParam, lParam) as sys callback
select case wMsg
case WM_KEYDOWN
SetWindowText (hLabel, "You have entered ASCII " str(wParam))
end select
return CallWindowProc(GetProp(hEdit, "OldEditProc"), hEdit, wMsg, wParam, lParam)
end function
' Subclassing in a Dialog
$ filename "DlgSubclass.exe"
'uses rtl32
'% review
uses dialogs
! SetWindowLong Lib "user32.dll" Alias "SetWindowLongA"
! GetWindowLong lib "user32.dll" alias "GetWindowLongA"
! SetProp Lib "user32.dll" Alias "SetPropA"
! GetProp Lib "user32.dll" Alias "GetPropA"
! CallWindowProc Lib "user32.dll" Alias "CallWindowProcA"
! RemoveProp Lib "user32.dll" Alias "RemovePropA"
% GWLP_WNDPROC= -4
% DS_3DLOOK 0x0004L
% DS_NOFAILCREATE 0x0010L
% DS_MODALFRAME 0x80L
% DS_CENTER = 2048
'Equates
% IDC_EDIT = 1001
% IDC_LABEL = 1002
sys hEdit
sys hLabel
int hDlg
'=================================
sub WinMain()
hDlg = Dialog( 0, 0, 302, 160, "Edit Subclass in a Dialog",
WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | WS_CLIPSIBLINGS | WS_VISIBLE | DS_MODALFRAME | DS_3DLOOK | DS_NOFAILCREATE | DS_SETFONT | DS_CENTER,
8, "MS Sans Serif",
WS_EX_CONTROLPARENT | WS_EX_LEFT | WS_EX_LTRREADING | WS_EX_RIGHTSCROLLBAR)
EDITTEXT("", IDC_EDIT, 8, 8, 217, 84,
WS_VSCROLL | WS_HSCROLL | ES_MULTILINE | WS_VISIBLE | ES_WANTRETURN | ES_LEFT | WS_BORDER,
WS_EX_CLIENTEDGE)
LText( "", IDC_LABEL, 8, 110, 120, 24)
CreateModalDialog( null, @DlgProc, 0)
end sub
WinMain()
'=================================
function DlgProc( sys hDlg, uint uMsg, sys wParam, lParam ) as sys callback
hEdit = GetDlgItem(hDlg, IDC_EDIT)
hLabel = GetDlgItem(hDlg, IDC_LABEL)
select case uMsg
case WM_INITDIALOG
SetProp(hEdit, "OldEditProc", SetWindowLongPtr(hEdit, GWLP_WNDPROC, @EditProc))
case WM_CLOSE
'Remove control subclassing
RemoveProp(hEdit, "OldEditProc", GetWindowLongPtr(hEdit, GWLP_WNDPROC, @EditProc))
'RemoveProp( hEdit, "OldEditProc")
EndDialog( hDlg, null )
end select
return 0
end function
'======================================
' Subclass procedure for the Edit control to detect what ASCII values were key in
function EditProc(sys hDlg, uint wMsg, sys wParam, lParam) as sys callback
select case wMsg
case WM_KEYDOWN
SetWindowText (hLabel, "You have entered ASCII " str(wParam))
end select
return CallWindowProc(GetProp(hEdit, "OldEditProc"), hEdit, wMsg, wParam, lParam)
end function
Way back in the dark ages, when comctl32.dll version 4.72 shipped with Windows 98 and Internet Explorer 4.01, Microsoft slipped an absolute gem of a tool into it. They provided a native means of subclassing windows that automatically handled the issues related to improper teardown. But, I hate to say, they played the typical Microsoft games, and didn't document these fabulous calls. It wasn't until they shipped Windows XP, many years later, that these four functions were actually documented. Until then, they were only exported by ordinal, and indeed even today only three of the four are exported by name.