• Welcome to Powerbasic Museum 2020-B.
 

News:

Forum in repository mode. No new members allowed.

Main Menu

Context Menu Dialog with tooltips

Started by Chris Chancellor, November 15, 2018, 04:44:35 AM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

Chris Chancellor

Hello All

here is the program that comes with a context menu together with tooltips to guide
users to select which program to run.   Users can select  Internet or Notepad or windows explorer to run

O2 is very flexible and have no equals


' Subclassing Textbox in a Dialog with context menus
' ContextMenuDlg.o2bas


$ filename "ContextMenuDlg.exe"

uses rtl64

'% review
uses O2Common
uses dialogs
uses O2TrackPopMenu
uses O2Tooltips

% GWLP_WNDPROC= -4
% DS_3DLOOK  0x0004L
% DS_NOFAILCREATE  0x0010L
% DS_MODALFRAME  0x80L

'Identifiers
% IDC_EDIT1    = 1001
% IDC_LABEL1   = 1006

% IDC_EDIT2    = 1008
% IDC_LABEL2   = 1009

% IDC_prog1 = 1111
% IDC_prog2 = 1112
% IDC_prog3 = 1113


' Globals
sys hEdit1 , hEdit2
sys hLabel
sys     hTopMenu , hMenuPop1 , hCursorMenu


'=================================
sub WinMain()

Dialog( 0, 0, 372, 100, "Context Menus 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)
     
    '  Textbox 1
      EDITTEXT("", IDC_EDIT1, 8, 18, 200, 14,
                        WS_VISIBLE | ES_WANTRETURN | ES_LEFT | WS_BORDER,
                       WS_EX_CLIENTEDGE)

    ' Label for    Textbox 1
     LText( "Right click to cut and paste entries", IDC_LABEL1, 8, 5, 150, 10)


'  Textbox 2
      EDITTEXT("", IDC_EDIT2, 8, 53, 200, 14,
                        WS_VISIBLE | ES_WANTRETURN | ES_LEFT | WS_BORDER,
                       WS_EX_CLIENTEDGE)

    ' Label for    Textbox 2
     LText( "Right click to cut and paste entries", IDC_LABEL2, 8, 40, 150, 10)

   '  for lightcyan  background
        MainWindBGColor = 8


    CreateModalDialog( null, @DlgProc, 0)     
end function
   

'================================
'  Create the context menu options for user to right click
SUB  Create_ContextMenu
         hTopMenu = CreateMenu 
         hMenuPop1 = CreateMenu 
         AppendMenu hMenuPop1 ,  MF_POPUP,      IDC_prog1, "&Notepad"
         AppendMenu hMenuPop1 ,  MF_POPUP,      IDC_prog2 , "&Internet"
          AppendMenu hMenuPop1 ,  MF_POPUP,     IDC_prog3 , "&Explorer"
         AppendMenu  hTopMenu,     MF_POPUP,     hMenuPop1,  "&Objects"
         hCursorMenu = GetSubMenu(hTopMenu, 0)
End Sub


'=================================
'  Main dialog call back function
Function DlgProc( sys hDlg, uint uMsg, sys wParam, lParam ) as sys callback
    hEdit1= GetDlgItem(hDlg, IDC_EDIT1)
    hEdit2= GetDlgItem(hDlg, IDC_EDIT2)

   

   select case uMsg

    case WM_INITDIALOG
      '  subclass the textboxes
        SetProp(hEdit1, "OldEditProc1", SetWindowLongPtr(hEdit1, GWLP_WNDPROC, @EditProc1))
        SetProp(hEdit2, "OldEditProc2", SetWindowLongPtr(hEdit2, GWLP_WNDPROC, @EditProc2))

      '   Tooltips for the top right close button 
             LOCAL rtc AS RECT
             GetClientRect(hDlg, rtc)
             rtc.Right  = rtc.Right - 3
             rtc.Left   = rtc.Right - GetSystemMetrics(SM_CYCAPTION)- 2
             rtc.Bottom = -3
              rtc.Top    = 3 - GetSystemMetrics(SM_CYCAPTION)
              SetToolTipsPArea(hDlg, rtc,  " Close and Exit the program ") 

'   Tooltips for the main dialog
'   take the dialog area below the caption bar  (client area)
             LOCAL rtd AS RECT
             GetClientRect(hDlg, rtd)
             rtd.Top    = rtd.Top + GetSystemMetrics(SM_CYCAPTION)
             SetToolTipsPArea(hDlg, rtd,  " Right click on Main dialog area to run some programs ") 

  '  Tooltips for the textboxes
           SetToolTip( hEdit1, "Right click this textbox and select the options on text handling " )
          SetToolTip( hEdit2, "Right click this textbox and select the options on text handling " )

           Create_ContextMenu
     



    case WM_CLOSE
             ' display the values from Textboxes upon closing
              string text1=nuls 100
              GetWindowText(hEdit1, text1, 32)
             mbox " textbox1   " + text1 ,0
             string text2=nuls 100
             GetWindowText(hEdit2, text2, 32)
             mbox  "    textbox2   " + text2 ,0

       'Remove control subclassing upon exit
       RemoveProp(hEdit1, "OldEditProc1", GetWindowLongPtr(hEdit1, GWLP_WNDPROC, @EditProc1))       
       RemoveProp(hEdit2, "OldEditProc2", GetWindowLongPtr(hEdit2, GWLP_WNDPROC, @EditProc2))           
       EndDialog( hDlg, null )



CASE   WM_RBUTTONDOWN
           '  Right button -- display the popup menu or context menu
             GetCursorPos MousePt             
              TrackPopupMenu( hCursorMenu,
                 TPM_LEFTALIGN  OR  TPM_LEFTBUTTON  OR  TPM_RIGHTBUTTON,
                  MousePt.x, MousePt.y, 0, hDlg, NULL) 'BYVAL NULL       


  CASE WM_COMMAND
           if wparam =  IDC_prog1 then     
              ' Notepad program is selected   
               ShellExecute(0, "", "Notepad.exe",  "my data file.txt" , "", SW_SHOWNORMAL)
            end if
           if wparam =  IDC_prog2 then
             '   Internet explorer is selected
                 ShellExecute(0, "", "Iexplore.exe", "www.google.com", "", SW_SHOWMAXIMIZED)
           End if
            if wparam =  IDC_prog3 then
             ' Windows explorer is selected
                  ShellExecute(0, "", "explorer","","", SW_SHOWMAXIMIZED)
           End if

    CASE WM_ERASEBKGND   
'            added to display background color for the main window 
             hBGDC = wParam
  '          Pass the DC of the region to be repaint
             DrawGradient hBGDC           
             FUNCTION = 1
             EXIT FUNCTION

    CASE   WM_CTLCOLORSTATIC
                 '  set text forecolor to  Fuschia
               SetTextColor(wPARAM, RGB(255,0,255))
                 ' set background to transparent
               SetBkMode(wPARAM, Transparent)
               FUNCTION = GetStockObject(NULL_BRUSH)
               EXIT FUNCTION



    end select   
 
    return 0
end function


'======================================
' Subclass procedure for the Textbox 1 control
Function EditProc1(sys hDlg, uint wMsg, sys wParam, lParam) as sys callback

   Select CASE wMsg 
       
        CASE  WM_KEYDOWN
         


        CASE WM_KEYUP
                   '  Go to the next control when enter key is pressed
                   IF wParam = 13 THEN
                       SetFocus GetNextDlgTabItem(GetParent(hDlg), GetFocus, FALSE)
                   End if
                    IF wParam = 27 THEN
                       'ESCAPE key was pressed -- just close and exit the system
                        SendMessage hDlg, WM_CLOSE, 0, 0   
                         PostQuitMessage 0 
                    End if

   End Select

   Return CallWindowProc(GetProp(hEdit1, "OldEditProc1"), hEdit1, wMsg, wParam, lParam)

End Function


'======================================
' Subclass procedure for the Textbox 2
Function EditProc2(sys hDlg, uint wMsg, sys wParam, lParam) as sys callback

   Select CASE wMsg 
     
        CASE  WM_KEYDOWN
     
       

       CASE WM_KEYUP
        '  Go to the next control when enter key is pressed
         IF wParam = 13 THEN
              SetFocus GetNextDlgTabItem(GetParent(hDlg), GetFocus, FALSE)
         end if
               IF wParam = 27 THEN
                       'ESCAPE key was pressed  -- just close and exit the system
                        SendMessage hDlg, WM_CLOSE, 0, 0   
                        PostQuitMessage 0 
             End if


   End Select

   Return CallWindowProc(GetProp(hEdit2, "OldEditProc2"), hEdit2, wMsg, wParam, lParam)

End Function





'-----------------------------------------
'  Start of program
   WinMain()


Chris Chancellor

Here is a better looking program with icons for the context menu