2005-04-16 12:56

'Just the other day I whipped up a little QRICHEDIT extension to pop
'up a menu exactly like the default windows context menu. Here it is,
'enjoy:

'================== START NEW COMPONENT ============================

     DECLARE FUNCTION SendMessageA LIB "user32" ALIAS "SendMessageA" (hwnd _
      AS LONG, wMsg AS LONG, wParam AS LONG, lParam AS LONG) AS LONG

     DECLARE FUNCTION LINEINDEX AS LONG     ' first char  of string position
     DECLARE FUNCTION LINEFROMCHAR AS LONG  ' line number with  char ( íîìåð ñòðîêè ñîäåðæàùåé ñèìâîë â äàííîé ïîçèöèè)

     DECLARE FUNCTION GoToLineEnd AS LONG
     DECLARE FUNCTION GoToLineBegin AS LONG

     CONST rEM_EXLINEFROMCHAR = 1078
     CONST rEM_LINEINDEX = 187


     TYPE QMAXEDIT EXTENDS QRICHEDIT

      WITH QMAXEDIT

PRIVATE:

       MaxMenu      AS QPOPUPMENU
       mnuUndo      AS QMENUITEM
       mnuSep1      AS QMENUITEM
       mnuCut       AS QMENUITEM
       mnuCopy      AS QMENUITEM
       mnuPaste     AS QMENUITEM
       mnuDelete    AS QMENUITEM
       mnuSep2      AS QMENUITEM
       mnuSelectAll AS QMENUITEM

       EVENT MaxMenu.OnPopup
        .mnuUndo.Enabled = SendMessageA(.Handle, &HC6, 0, 0)
        .mnuCut.Enabled = .SelLength
        .mnuCopy.Enabled = .SelLength
        .mnuPaste.Enabled = LEN(ClipBoard.Text)
        .mnuDelete.Enabled = .SelLength
        .mnuSelectAll.Enabled = (LEN(.Text) XOR LEN (.SelText))
       END EVENT

PUBLIC:
       FUNCTION LINEINDEX AS LONG
        result=SendMessageA (.handle,rEM_LINEINDEX,.WhereY,0)'posFirstCharOfLine
       END FUNCTION

       FUNCTION GetLINEIdx(line AS LONG) AS LONG
        result=SendMessageA (.handle,rEM_LINEINDEX,line,0)'.LINEINDEX
       END FUNCTION

       FUNCTION LINEFROMCHAR AS LONG
        result=SendMessageA (.handle,rEM_LINEFROMCHAR,.SelStart,0)'.LINEINDEX
       END FUNCTION

       FUNCTION GoToLineEnd AS LONG
        .selstart=.LINEINDEX+LEN(.line(.WhereY))
       END FUNCTION

       FUNCTION GoToLineBegin AS LONG
        .selstart=.LINEINDEX
       END FUNCTION


       UsePopup AS LONG PROPERTY SET Set_Popup

       SUB Undo
        SendMessage(.Handle, &HC7, 0, 0)
       END SUB

       SUB Cut
        .CutToClipBoard
       END SUB

       SUB Copy
        .CopyToClipboard
       END SUB

       SUB Paste
        .PasteFromClipboard
       END SUB

       SUB Delete
        SendMessage (.Handle, &H100, &H2E, 0)
       END SUB

       SUB SelectAl
        .SelectAll
       END SUB

       PROPERTY SET Set_Popup(Use AS LONG)
        .MaxMenu.AutoPopup = Use
       END PROPERTY

       CONSTRUCTOR
        mnuUndo.CAPTION = "&Undo"
        mnuUndo.OnClick = QMAXEDIT.Undo
        mnuSep1.CAPTION = "-"
        mnuCut.CAPTION = "Cu&t"
        mnuCut.OnClick = QMAXEDIT.Cut
        mnuCopy.CAPTION = "&Copy"
        mnuCopy.OnClick = QMAXEDIT.Copy
        mnuPaste.CAPTION = "&Paste"
        mnuPaste.OnClick = QMAXEDIT.Paste
        mnuDelete.CAPTION = "&Delete"
        mnuDelete.OnClick = QMAXEDIT.Delete
        mnuSep2.CAPTION = "-"
        mnuSelectAll.CAPTION = "Select &All"
        mnuSelectAll.OnClick = QMAXEDIT.SelectAl
        MaxMenu.AddItems QMAXEDIT.mnuUndo, QMAXEDIT.mnuSep1,_
         QMAXEDIT.mnuCut, QMAXEDIT.mnuCopy, QMAXEDIT.mnuPaste, QMAXEDIT.mnuDelete,_
         QMAXEDIT.mnuSep2, QMAXEDIT.mnuSelectAll
        PopupMenu = .MaxMenu
        Set_Popup = 1
       END CONSTRUCTOR

      END WITH

     END TYPE

     $UNDEF QRICHEDIT
     $DEFINE QRICHEDIT QMAXEDIT

'================= END NEW COMPONENT ========================


'To turn off the popup, set UsePopup = 0
'To use a different popup, just set Popupmenu = <new popup>

'Create the new richedit as you would the old one, thanks to the
'$UNDEF-$DEFINE Keywords...ain't RapidQ great?

'Psyclops

2005-04-16 12:56