2013-06-19 07:50

'=======================================================
' Type Objet
' Classe QTextEdit
'=======================================================
     $IFNDEF TRUE
      $DEFINE True 1
     $ENDIF

     $IFNDEF FALSE
      $DEFINE False 0
     $ENDIF

     $IFNDEF boolean
      $DEFINE boolean INTEGER
     $ENDIF

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

     TYPE QTEXTEDIT EXTENDS QRICHEDIT
PRIVATE:
      MaxMenu AS QPOPUPMENU
      mnuUndo AS QMENUITEM
      mnuSep1 AS QMENUITEM
      mnuCut  AS QMENUITEM
      mnuCopy AS QMENUITEM
      mnuPaste AS QMENUITEM
      mnuSep2 AS QMENUITEM
      mnuSelectAll AS QMENUITEM

      EVENT MaxMenu.OnPopup
       QTEXTEDIT.mnuUndo.Enabled=SendMessageA(QTEXTEDIT.Handle,&HC6,0,0)
       IF QTEXTEDIT.SelLength>0 THEN
        QTEXTEDIT.mnuCut.Enabled =true
        QTEXTEDIT.mnuCopy.Enabled=true
       ELSE
        QTEXTEDIT.mnuCut.Enabled=false
        QTEXTEDIT.mnuCopy.Enabled=false
       END IF
       IF LEN(ClipBoard.Text)>0 THEN
        QTEXTEDIT.mnuPaste.Enabled=true
       ELSE
        QTEXTEDIT.mnuPaste.Enabled=false
       END IF
       IF LEN(QTEXTEDIT.Text)>0 THEN
        QTEXTEDIT.mnuSelectAll.Enabled=true
       ELSE
        QTEXTEDIT.mnuSelectAll.Enabled=false
       END IF
      END EVENT

PUBLIC:
      UsePopup AS boolean PROPERTY SET Set_Popup
      UndoCaption AS STRING PROPERTY SET SetUndoCaption
      CutCaption AS STRING PROPERTY SET SetCutCaption
      CopyCaption AS STRING PROPERTY SET SetCopyCaption
      PasteCaption AS STRING PROPERTY SET SetPasteCaption
      SelectAllCaption AS STRING PROPERTY SET SetSelectAllCaption

    '========================================
    ' Proprieté utilisation du menu popup
    '========================================
      PROPERTY SET Set_Popup(Use AS boolean)
       QTEXTEDIT.MaxMenu.AutoPopup=Use
      END PROPERTY

    '========================================
    ' Proprieté libellé du menu annuler
    '========================================
      PROPERTY SET SetUndoCaption(CAPTION AS STRING)
       QTEXTEDIT.mnuUndo.CAPTION=CAPTION
      END PROPERTY

    '========================================
    ' Proprieté libellé du menu couper
    '========================================
      PROPERTY SET SetCutCaption(CAPTION AS STRING)
       QTEXTEDIT.mnuCut.CAPTION=CAPTION
      END PROPERTY

    '========================================
    ' Proprieté libellé du menu copier
    '========================================
      PROPERTY SET SetCopyCaption(CAPTION AS STRING)
       QTEXTEDIT.mnuCopy.CAPTION=CAPTION
      END PROPERTY

    '========================================
    ' Proprieté libellé du menu coller
    '========================================
      PROPERTY SET SetPasteCaption(CAPTION AS STRING)
       QTEXTEDIT.mnuPaste.CAPTION=CAPTION
      END PROPERTY

    '========================================
    ' Proprieté libellé du menu selectionner
    '========================================
      PROPERTY SET SetSelectAllCaption(CAPTION AS STRING)
       QTEXTEDIT.mnuSelectAll.CAPTION=CAPTION
      END PROPERTY

    '========================================
    ' Méthode annuler derniere modification
    '========================================
      SUB Undo
       SendMessage(QTEXTEDIT.Handle,&HC7,0,0)
      END SUB

    '========================================
    ' Méthode couper
    '========================================
      SUB Cut
       QTEXTEDIT.CutToClipBoard
      END SUB

    '========================================
    ' Méthode copier
    '========================================
      SUB Copy
       QTEXTEDIT.CopyToClipboard
      END SUB

    '========================================
    ' Méthode coller
    '========================================
      SUB Paste
       QTEXTEDIT.PasteFromClipboard
      END SUB

    '========================================
    ' Méthode selectionner tout
    '========================================
      SUB SelectAl
       QTEXTEDIT.SelectAll
      END SUB

    '========================================
    ' Méthode limitation nombre de caractere
    '========================================
      SUB Limit(value AS LONG)
       SendMessage(QTEXTEDIT.handle,&hc5,value,0)
      END SUB

    '========================================
    ' Méthode remplace le texte selectionner
    '========================================
      SUB ReplaceSel(text AS STRING)
       DIM replace AS STRING

       IF QTEXTEDIT.SelLength>0 THEN
        replace=text
        SendMessage(QTEXTEDIT.handle,&hc2,0,VARPTR(replace))
       END IF
      END SUB

    '========================================================================
    ' Méthode recherche de chaine,retourne la position de la chaine trouvée
    '========================================================================
      FUNCTION Find(start AS LONG,text AS STRING,CASE AS boolean) AS LONG
       IF CASE THEN
        IF INSTR(start,QTEXTEDIT.Text,text)>0 THEN
         QTEXTEDIT.SelStart = INSTR(start,QTEXTEDIT.Text,text)-1
         QTEXTEDIT.SelLength = LEN(text)
         result=QTEXTEDIT.SelStart+1
        ELSE
         result=0
        END IF
       ELSE
        IF INSTR(start,UCASE$(QTEXTEDIT.Text),UCASE$(text))>0 THEN
         QTEXTEDIT.SelStart = INSTR(start,UCASE$(QTEXTEDIT.Text),UCASE$(text))-1
         QTEXTEDIT.SelLength = LEN(text)
         result=QTEXTEDIT.SelStart+1
        ELSE
         result=0
        END IF
       END IF
      END FUNCTION

    '=================================================
    ' Méthode deplace le curseur a la ligne demandée
    '=================================================
      SUB LinesScroll(number AS LONG)
       DIM i AS INTEGER
       DIM count AS LONG

       IF number<=QTEXTEDIT.LineCount THEN
        FOR i=0 TO number-2
         count=count+LEN(QTEXTEDIT.line(i))+2
        NEXT i
        QTEXTEDIT.SelStart=count
       END IF
      END SUB

    '=================================================
    ' Méthode retourne la possibilité d'annulation
    '=================================================
      FUNCTION CanUndo AS boolean
       result=SendMessageA(QTEXTEDIT.Handle,&HC6,0,0)
      END FUNCTION

      CONSTRUCTOR
       mnuUndo.CAPTION="&Undo"
       mnuUndo.OnClick=QTEXTEDIT.Undo
       mnuUndo.ShortCut="CTRL+Z"
       mnuSep1.CAPTION="-"
       mnuCut.CAPTION="Cu&t"
       mnuCut.OnClick=QTEXTEDIT.Cut
       mnuCut.ShortCut="CTRL+X"
       mnuCopy.CAPTION="&Copy"
       mnuCopy.OnClick=QTEXTEDIT.Copy
       mnuCopy.ShortCut="CTRL+C"
       mnuPaste.CAPTION="&Paste"
       mnuPaste.OnClick=QTEXTEDIT.Paste
       mnuPaste.ShortCut="CTRL+V"
       mnuSep2.CAPTION="-"
       mnuSelectAll.CAPTION="Select &All"
       mnuSelectAll.OnClick=QTEXTEDIT.SelectAl
       mnuSelectAll.ShortCut="CTRL+A"
       MaxMenu.AddItems QTEXTEDIT.mnuUndo,QTEXTEDIT.mnuSep1,QTEXTEDIT.mnuCut,QTEXTEDIT.mnuCopy,QTEXTEDIT.mnuPaste,QTEXTEDIT.mnuSep2,QTEXTEDIT.mnuSelectAll
       PopupMenu=QTEXTEDIT.MaxMenu
       UsePopup=1
      END CONSTRUCTOR
     END TYPE

2013-06-19 07:50