SubClass Many

Date: 02-16-2022

Return to Index

 
'Compilable Example:  (Jose Includes)
'In this example, subclassing is used to prevent the normal context menu from
'appearing when a textbox is right-mouse clicked.  A substitute context menu
'is then provided.
#Compiler PBWin 9, PBWin 10
#Compile Exe
#Dim All
%Unicode=1
#Include "Win32API.inc"
Global hDlg As Dword, hContext As Dword, hTextBox As Dword, OldProc&
 
%IDM_TextBox01 = 600
%IDM_TextBox02 = 601
%IDM_TextBox03 = 602
%IDM_TextBox04 = 603
%IDM_TextBox05 = 604
 
%IDM_Cut    = 500
%IDM_Paste  = 501
%IDM_Copy   = 502
%IDM_Delete = 503
 
Function PBMain() As Long
   Local i As Long
   Dialog New Pixels, 0, "Test Code",300,300,200,200, %WS_OverlappedWindow To hDlg
   For i = %IDM_TextBox01 To %IDM_TextBox05
      Control Add TextBox, hDlg, i, "Sample Data", 20,10+(i-%IDM_TextBox01)*25,120,20
   Next i
   CreateCustomPopupMenu
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Local i As Long
   Select Case Cb.Msg
      Case %WM_InitDialog
         For i = %IDM_TextBox01 To %IDM_TextBox05
            OldProc& = SetWindowLong(GetDlgItem(hDlg, i), %GWL_WndProc, CodePtr(NewProc))  'subclass
         Next i
      Case %WM_Command
         Select Case Cb.Ctl
              Case %IDM_Cut     : SendMessage GetFocus, %WM_CUT, 0, 0
              Case %IDM_Copy    : SendMessage GetFocus, %WM_COPY, 0, 0
              Case %IDM_Paste   : SendMessage GetFocus, %WM_PASTE, 0, 0
              Case %IDM_Delete  : SendMessage GetFocus, %WM_CLEAR, 0, 0
         End Select
      Case %WM_Destroy
         For i = %IDM_TextBox01 To %IDM_TextBox05
            SetWindowLong GetDlgItem(hDlg, i), %GWL_WNDPROC, OldProc&   'un-subclass
         Next i
   End Select
End Function
 
Function NewProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   Local x As Long, y As Long
   Select Case Msg
      Case %WM_ContextMenu
         SetFocus wParam
         x = Lo(Integer,lParam) : y = Hi(Integer, lParam)    'WM_ContextMenu returns xy coordinates of mouse
         TrackPopupMenu hContext, %TPM_LeftAlign, x, y, 0, hDlg, ByVal 0   'put context menu where mouse is
         Function = 0 : Exit Function
   End Select
   Function = CallWindowProc(OldProc&, hWnd, Msg, wParam, lParam)
End Function
 
Sub CreateCustomPopUpMenu
   Menu New PopUp To hContext
   Menu Add String, hContext, "Copy",   %IDM_Copy,  %MF_Enabled
   Menu Add String, hContext, "Cut",    %IDM_Cut,  %MF_Enabled
   Menu Add String, hContext, "Paste",  %IDM_Paste,  %MF_Enabled
   Menu Add String, hContext, "Delete", %IDM_Delete,  %MF_Enabled
End Sub
 
'gbs_00430
'Date: 03-14-2012

created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm