Menu - Skeleton, Context, TextBox

Category: Menus

Date: 02-16-2022

Return to Index


 
'To get a context menu (right mouse click), use the %WM_ContextMenu
'and TrackPopupMenu to display a popup menu.
'For a textbox, which already has a context menu, you must
'SubClass the textbox and use the %WM_ContextMenu within
'the subclass procedure.
 
'Compilable Example:  (Jose Includes)
'This example subclasses a textbox to replace the default context menu.
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#Include "Win32API.inc"
Global hDlg As Dword, hContext As Dword, OrigTextBoxProc&
%IDC_TextBox = 400
%IDMC_CopyAll = 500  : %IDMC_DeleteSelection = 501  : %IDMC_PrintSelection = 502
 
Function PBMain() As Long
   Dialog New Pixels, 0, "Test Code",300,300,200,200, %WS_OverlappedWindow To hDlg
   Control Add TextBox, hDlg, %IDC_TextBox,"Right click me!", 50,10,100,20
   SubClassTextBox
   AddContextMenu
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Local x As Long, y As Long, iReturn As Long
   Select Case CB.Msg
      Case %WM_Command
         Select Case CB.Ctl
            Case %IDMC_CopyAll
            Case %IDMC_DeleteSelection
            Case %IDMC_PrintSelection
         End Select
   End Select
End Function
 
Sub AddContextMenu
   Menu New Popup To hContext
   Menu Add String, hContext, "Copy All",  %IDMC_CopyAll,  %MF_Enabled
   Menu Add String, hContext, "Delete Selection",  %IDMC_DeleteSelection,  %MF_Enabled
   Menu Add String, hContext, "Print Selection", %IDMC_PrintSelection, %MF_Enabled
End Sub
 
Sub SubClassTextBox
   OrigTextBoxProc& = SetWindowLong(GetDlgItem(hDlg, %IDC_TextBox), %GWL_WndProc, Codeptr(NewTextBoxProc))
End Sub
 
Function NewTextBoxProc(ByVal hWnd As LongByVal Msg As LongByVal wParam As LongByVal lParam As LongAs Long
   Dim x As Long, y As Long
   If Msg = %WM_ContextMenu Then
      x = Lo(Integer,lParam) : y = Hi(Integer, lParam)
      TrackPopupMenu hContext, %TPM_LEFTALIGN, x, y, 0, hDlg, ByVal 0
      Function = 0 : Exit Function
   End If
   Function = CallWindowProc(OrigTextBoxProc&, hWnd, Msg, wParam, lParam)
End Function
 
'gbs_00203
'Date: 03-10-2012


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