2003-08-14 09:04

'     **********************************************************
'     *            Html editor, use Dhtmled.ocx,               *
'     * example  for Rapid-Q by Thierry Guillo tguillo@free.fr *
'     * © TGuillo 2002 - 2003, GNU- General Public Licence     *
'     **********************************************************

' Before use it you need to register the  DHTMLED5.OCX
'For example, to manually register a DHTMLED5.OCX ActiveX control,
' type the following command at an MS-DOS prompt:
'c:\regsvr32.exe c:\program files\common files\microsoft shared\triedit\ DHTMLED5.OCX


'replcace 'BMP ="img..." by  picture

     $APPTYPE GUI



'Déclaration
     DIM FileName AS STRING
     DIM Font AS QFONT

'Déclaration des evenements
     DECLARE SUB mnuFilenew_Click (Sender AS QMENUITEM)
     DECLARE SUB mnuFileOpen_Click (Sender AS QMENUITEM)
     DECLARE SUB mnuFileSav_Click (Sender AS QMENUITEM)
     DECLARE SUB mnuedcopy_Click (Sender AS QMENUITEM)
     DECLARE SUB mnuedcut_Click (Sender AS QMENUITEM)
     DECLARE SUB mnuedpaste_Click (Sender AS QMENUITEM)
     DECLARE SUB menuabout
     DECLARE SUB CoolBtn1Click (Sender AS QCOOLBTN)
     DECLARE SUB CoolBtn2Click (Sender AS QCOOLBTN)
     DECLARE SUB CoolBtn3Click (Sender AS QCOOLBTN)
     DECLARE SUB CoolBtn4Click (Sender AS QCOOLBTN)
     DECLARE SUB CoolBtn5Click (Sender AS QCOOLBTN)
     DECLARE SUB CoolBtn6Click (Sender AS QCOOLBTN)
     DECLARE SUB CoolBtn7Click (Sender AS QCOOLBTN)
     DECLARE SUB CoolBtn8Click (Sender AS QCOOLBTN)
     DECLARE SUB CoolBtn9Click (Sender AS QCOOLBTN)
     DECLARE SUB CoolBtn10Click (Sender AS QCOOLBTN)
     DECLARE SUB CoolBtn11Click (Sender AS QCOOLBTN)
     DECLARE SUB CoolBtn12Click (Sender AS QCOOLBTN)
     DECLARE SUB CoolBtn13Click (Sender AS QCOOLBTN)
     DECLARE SUB CoolBtn14Click (Sender AS QCOOLBTN)
     DECLARE SUB CoolBtn15Click (Sender AS QCOOLBTN)
     DECLARE SUB CoolBtn16Click (Sender AS QCOOLBTN)
     DECLARE SUB formload
     DECLARE SUB movemouse(X%, Y%, Shift%)

'--------

     CREATE Fenetre AS QFORM
      CAPTION = "GThtmled"
      Width = 680
      Height = 486
      Center
      OnShow=formload

      OnMouseMove = movemouse
     '<<<<<< menu déroulant fichier
      CREATE mnuMain AS QMAINMENU
       CREATE mnuFile AS QMENUITEM
        CAPTION = "&Fichier"
        Checked = 0
        Enabled = 1
        Visible = 1

        CREATE mnuFilenew AS QMENUITEM
         CAPTION = "&Nouveau"
         Checked = 0
         Enabled = 1
         Visible = 1
         ShortCut = "Ctrl+N"
         onclick = mnuFilenew_Click
        END CREATE

        CREATE mnuFileOpen AS QMENUITEM
         CAPTION = "&Ouvrir"
         Checked = 0
         Enabled = 1
         Visible = 1
         ShortCut = "Ctrl+O"
         onclick = mnuFileOpen_Click
        END CREATE

        CREATE mnuFileSav AS QMENUITEM
         CAPTION = "&Enregistrer"
         Checked = 0
         Enabled = 1
         Visible = 1
         onclick = mnuFileSav_Click
        END CREATE

       END CREATE
'<<<<<<<<<< menu déroulant Edition

       CREATE mnued AS QMENUITEM
        CAPTION = "&Edition"
        Checked = 0
        Enabled = 1
        Visible = 1
        CREATE mnuedcut AS QMENUITEM
         CAPTION = "&Couper"
         Checked = 0
         Enabled = 1
         Visible = 1
         onclick = CoolBtn1Click
        END CREATE
        CREATE mnuedcopy AS QMENUITEM
         CAPTION = "&Copier"
         Checked = 0
         Enabled = 1
         Visible = 1
         onclick = CoolBtn2Click
        END CREATE

        CREATE mnuedpaste AS QMENUITEM
         CAPTION = "&Coller"
         Checked = 0
         Enabled = 1
         Visible = 1
         onclick = CoolBtn3Click
        END CREATE
       END CREATE
       CREATE about1 AS QMENUITEM
        CAPTION="&A propos"
        OnClick=menuabout
       END CREATE

      END CREATE
'-------------- Barre de boutons
      CREATE CoolBtn1 AS QCOOLBTN
        ''''''''BMP = "\img\cut.bmp"
       Left = 80-70
       Top = 4
       Width = 23
       Height = 22
       ShowHint = 1
       Hint = "Couper"
       OnClick = CoolBtn1Click
      END CREATE
      CREATE CoolBtn2 AS QCOOLBTN
        'BMP = "\img\copy.bmp"
       Left = 104-70
       Top = 4
       Width = 23
       Height = 22
       ShowHint = 1
       Hint = "Copier"
       OnClick = CoolBtn2Click
      END CREATE
      CREATE CoolBtn3 AS QCOOLBTN
        'BMP = "\img\Paste.bmp"
       Left = 129-70
       Top = 4
       Width = 23
       Height = 22
       ShowHint = 1
       Hint = "Coller"
       OnClick = CoolBtn3Click
      END CREATE
      CREATE CoolBtn4 AS QCOOLBTN
        'BMP = "\img\gras.bmp"
       Left = 160-70
       Top = 4
       Width = 23
       Height = 22
       ShowHint = 1
       Hint = "Gras"
       OnClick = CoolBtn4Click
      END CREATE
      CREATE CoolBtn5 AS QCOOLBTN
        'BMP = "\img\italic.bmp"
       Left = 184-70
       Top = 4
       Width = 23
       Height = 22
       ShowHint = 1
       Hint = "Italic"
       OnClick = CoolBtn5Click
      END CREATE
      CREATE CoolBtn6 AS QCOOLBTN
        'BMP = "\img\souling.bmp"
       Left = 208-70
       Top = 4
       Width = 23
       Height = 22
       ShowHint = 1
       Hint = "Souligné"
       OnClick = CoolBtn6Click
      END CREATE
      CREATE CoolBtn7 AS QCOOLBTN
        'BMP = "\img\aleft.bmp"
       Left = 264-70
       Top = 4
       Width = 23
       Height = 22
       ShowHint = 1
       Hint = "Aligner à Gauche"
       OnClick = CoolBtn7Click
      END CREATE
      CREATE CoolBtn8 AS QCOOLBTN
        'BMP = "\img\acentre.bmp"
       Left = 288-70
       Top = 4
       Width = 23
       Height = 22
       ShowHint = 1
       Hint = "Centrer"
       OnClick = CoolBtn8Click
      END CREATE
      CREATE CoolBtn9 AS QCOOLBTN
        'BMP = "\img\aright.bmp"
       Left = 312-70
       Top = 4
       Width = 23
       Height = 22
       ShowHint = 1
       Hint = "Aligner à Droite"
       OnClick = CoolBtn9Click
      END CREATE
      CREATE CoolBtn10 AS QCOOLBTN
        'BMP = "\img\fgcolor.bmp"
       Left = 344-70
       Top = 4
       Width = 23
       Height = 22
       ShowHint = 1
       Hint = "Police"
       OnClick = CoolBtn10Click
      END CREATE


      CREATE CoolBtn11 AS QCOOLBTN
        'BMP = "\img\bulletlist.bmp"
       Left = 376-70
       Top = 4
       Width = 23
       Height = 22
       ShowHint = 1
       Hint = "Liste à puces"
       OnClick = CoolBtn11Click
      END CREATE
      CREATE CoolBtn12 AS QCOOLBTN
        'BMP = "\img\numlist.bmp"
       Left = 400-70
       Top = 4
       Width = 23
       Height = 22
       ShowHint = 1
       Hint = "Liste Numérotée"
       OnClick = CoolBtn12Click
      END CREATE

      CREATE CoolBtn15 AS QCOOLBTN
        'BMP = "\img\link.bmp"
       Left = 232-70
       Top = 4
       Width = 23
       Height = 22
       ShowHint = 1
       Hint = "Créer le Lien"
       OnClick = CoolBtn15Click
      END CREATE
    '------------- A propos
      CREATE Form5 AS QFORM
       CAPTION = "GT Notepad"
       Width = 320
       Height = 240
       Center

       CREATE GroupBox1 AS QGROUPBOX
        Left = 10
        Top = 20
        Width = 281
        Height = 169
        COLOR = -2147483631
        TabOrder = 1
        CREATE Label2 AS QLABEL
         CAPTION = "       Editeur Html wysiwyg    "
         Left = 47
         Top = 70
         Width = 192
         COLOR =  &H00FF00

        END CREATE
        CREATE Label3 AS QLABEL
         CAPTION = "   © Thierry Guillo 2002 - 2003"
         Left = 82
         Top = 139
         Width = 184
        END CREATE
        CREATE Label4 AS QLABEL
         CAPTION = "Utilisant le controle dhtmled.ocx"
         Left = 47
         Top = 87
         Width = 200
         COLOR = -2147483631
        END CREATE
        CREATE Label5 AS QLABEL
         CAPTION = "de Microsoft © fournis avec IE5 et >"
         Left = 47
         Top = 100
         Width = 232
         COLOR = -2147483631
         Transparent = 1
        END CREATE
        CREATE Label6 AS QLABEL
         CAPTION = "tguillo@free.fr"
         Left = 162
         Top = 155
         Width = 104
         COLOR = -2147483631
        END CREATE

        CREATE OvalBtn1 AS QOVALBTN
         CAPTION = "GT html Editor"
         Left = 7
         Top = 13
         Width = 150
         Height = 50

         COLOR = &H00FF00
        END CREATE
       END CREATE
      END CREATE

 '  ------- création de l'object DHTMLEdit   DHTMLEd.ocx
      CREATE dhtm AS QOLECONTAINER
       autoshow=true
       CreateObject("DHTMLEdit.DHTMLEdit.1")
       ActivateApplets =   0   'False
       ActivateActiveXControls=   0   'False
       ActivateDTCs    =   -1  'True
       ShowDetails     =   0   'False
       ShowBorders     =   0   'False
       Appearance      =   1
       Scrollbars      =   -1  'True
       ScrollbarAppearance=   1
       SourceCodePreservation=   -1
       usedivoncarriagereturn= 0

       Left = 10
       Top = 28
       Width = 650
       Height = 380
      END CREATE



      CREATE StatusBar AS QSTATUSBAR
       AddPanels "","",""
       Panel(0).Width = 130
       Panel(1).Width = 130
      END CREATE
      Visible = 0
     END CREATE



     Fenetre.SHOWMODAL

'--------- routines traitant les boutons ---------

     SUB CoolBtn1Click (Sender AS QCOOLBTN)
      dhtm.ExecCommand  (5003)   '-- couper
     END SUB

     SUB CoolBtn2Click (Sender AS QCOOLBTN)
      dhtm.ExecCommand  (5002)   '-- copier
     END SUB

     SUB CoolBtn4Click (Sender AS QCOOLBTN)
      dhtm.ExecCommand  (5000)   '-- gras
     END SUB

     SUB CoolBtn5Click (Sender AS QCOOLBTN)
      dhtm.ExecCommand  (5023)   '-- italic
     END SUB

     SUB CoolBtn6Click (Sender AS QCOOLBTN)
      dhtm.ExecCommand  (5048)   '-- souligner
     END SUB

     SUB CoolBtn7Click (Sender AS QCOOLBTN)
      dhtm.ExecCommand  (5025)   '--a gauche
     END SUB

     SUB CoolBtn8Click (Sender AS QCOOLBTN)
      dhtm.ExecCommand  (5024)   '--au center
     END SUB

     SUB CoolBtn9Click (Sender AS QCOOLBTN)
      dhtm.ExecCommand  (5026)   '--a droite
     END SUB

     SUB CoolBtn10Click (Sender AS QCOOLBTN)
      dhtm.ExecCommand  (5009,1)   '--fontes xxx,1 fait apparaître la boite de dialogue
     END SUB

     SUB OvalBtn1Click (Sender AS QOVALBTN)
   '-- Valider
     END SUB

     SUB CoolBtn3Click (Sender AS QCOOLBTN)
      dhtm.ExecCommand  (5032)   '-- coller
     END SUB

     SUB CoolBtn11Click (Sender AS QCOOLBTN)
      dhtm.ExecCommand  (5051)   '--aliste a puce*****
     END SUB

     SUB CoolBtn12Click (Sender AS QCOOLBTN)
      dhtm.ExecCommand  (5030)   '--aliste a numeros
     END SUB

     SUB CoolBtn15Click (Sender AS QCOOLBTN)
      dhtm.ExecCommand  (5016)   '--lien
     END SUB

'*********************** Traitement des menus ***********************************
     SUB mnuFilenew_Click (Sender AS QMENUITEM)
      dhtm.documenthtml=""
     END SUB

     SUB mnuFileOpen_Click (Sender AS QMENUITEM)
      DIM OpenDialog AS QOPENDIALOG
      OpenDialog.Filter = "Fichiers Html|*.HTM"
      OpenDialog.FilterIndex = 0

      IF OpenDialog.EXECUTE THEN
       FileName = OpenDialog.FileName
       dhtm.LoadDocument FileName,True
      END IF
     END SUB

     SUB mnuFileSav_Click (Sender AS QMENUITEM)

      DIM SaveDialog AS QOPENDIALOG
      SaveDialog.Filter = "Fichiers Html|*.HTM"
      SaveDialog.FilterIndex = 0
      IF SaveDialog.EXECUTE THEN
       dhtm.SaveDocument SaveDialog.FileName, True
      END IF
     END SUB

     SUB menuabout
      form5.show
     END SUB
'--------
     SUB movemouse(X%, Y%, Shift%)

      StatusBar.Panel(2).CAPTION= " X: " + STR$(X%) + "  Y: " + STR$(Y%)

     END SUB


     Fenetre.SHOWMODAL



     dhtm.Free

2003-08-14 09:04