2003-03-03 19:12

     $OPTION ICON "edit.ico"
     $TYPECHECK ON
     $INCLUDE "Rapidq.inc"
     $INCLUDE "Object/QTextEdit.inc"
     $INCLUDE "Object/QColorDialog.inc"
     $INCLUDE "Object/QFormEx.inc"
     $INCLUDE "Object\QPageSetup.inc"
     $INCLUDE "Object\QPrinterInfo.inc"

     DECLARE SUB menuEdit
     DECLARE SUB menuAnnul
     DECLARE SUB menuCouper
     DECLARE SUB menuCopier
     DECLARE SUB menuColler
     DECLARE SUB menuSelection
     DECLARE SUB menuNouveau
     DECLARE SUB menuOuvrir
     DECLARE SUB menuSauver
     DECLARE SUB menuSauverSous
     DECLARE SUB menuQuitter
     DECLARE SUB menuRecherche
     DECLARE SUB menuPoursuivre
     DECLARE SUB menuRemplacer
     DECLARE SUB menuImprimer
     DECLARE SUB menuConfig
     DECLARE SUB ShowLC
     DECLARE SUB ChangePolice
     DECLARE SUB ChangeFond
     DECLARE SUB ChangeTextRecherche
     DECLARE SUB ChangeTextRemplacer
     DECLARE SUB AnnulerRecherche
     DECLARE SUB AnnulerRemplacer
     DECLARE SUB PoursuivreRecherche
     DECLARE SUB PoursuivreRemplacer
     DECLARE SUB Remplacer
     DECLARE SUB RemplacerTout
     DECLARE SUB Show

     DIM FontDialog AS QFONTDIALOG
     DIM cd AS QcolorDialog
     cd.CAPTION="Couleur de fond"
     DIM FileName AS STRING
     FileName="Sans Titre"
     DIM start AS LONG
     DIM PgSetup AS QPageSetup
     PgSetup.CAPTION="Configuration imprimante"
     DIM PrtInfo AS QPrinterInfo
     DIM font AS QFONT

     CREATE Form AS QFORMEX
      CAPTION=Application.title+" - "+FileName
      Width=715
      Height=508
      Center
      OnClose=MenuQuitter
      OnShow=Show
      DeskBar=true
      CREATE Menu AS QMAINMENU
       CREATE Fichier AS QMENUITEM
        CAPTION="&Fichier"
        CREATE Nouveau AS QMENUITEM
         CAPTION="&Nouveau"
         OnClick=MenuNouveau
        END CREATE
        CREATE Ouvrir AS QMENUITEM
         CAPTION="&Ouvrir"
         OnClick=MenuOuvrir
        END CREATE
        CREATE Sauver AS QMENUITEM
         CAPTION="&Sauver"
         OnClick=MenuSauver
        END CREATE
        CREATE SauverSous AS QMENUITEM
         CAPTION="&Sauver Sous..."
         OnClick=MenuSauverSous
        END CREATE
        CREATE Sep1 AS QMENUITEM
         CAPTION="-"
        END CREATE
        CREATE Imprimer AS QMENUITEM
         CAPTION="&Imprimer"
         OnClick=MenuImprimer
        END CREATE
        CREATE Config AS QMENUITEM
         CAPTION="&Configuration imprimante"
         OnClick=MenuConfig
        END CREATE
        CREATE Sep2 AS QMENUITEM
         CAPTION="-"
        END CREATE
        CREATE Quitter AS QMENUITEM
         CAPTION="&Quitter"
         OnClick=MenuQuitter
        END CREATE
       END CREATE
       CREATE Edition AS QMENUITEM
        CAPTION="&Edition"
        OnClick=menuEdit
        CREATE Annul AS QMENUITEM
         CAPTION="&Annuler"
         Enabled=false
         ShortCut="CTRL+Z"
         OnClick=MenuAnnul
        END CREATE
        CREATE Sep3 AS QMENUITEM
         CAPTION="-"
        END CREATE
        CREATE Couper AS QMENUITEM
         CAPTION="&Couper"
         Enabled=false
         ShortCut="CTRL+X"
         OnClick=MenuCouper
        END CREATE
        CREATE Copier AS QMENUITEM
         CAPTION="&Copier"
         Enabled=false
         ShortCut="CTRL+C"
         OnClick=MenuCopier
        END CREATE
        CREATE Coller AS QMENUITEM
         CAPTION="&Coller"
         Enabled=false
         ShortCut="CTRL+V"
         OnClick=MenuColler
        END CREATE
        CREATE Sep4 AS QMENUITEM
         CAPTION="-"
        END CREATE
        CREATE Selection AS QMENUITEM
         CAPTION="&Selectionner tout"
         Enabled=false
         ShortCut="CTRL+A"
         OnClick=MenuSelection
        END CREATE
       END CREATE
       CREATE Recherche AS QMENUITEM
        CAPTION="&Recherche"
        CREATE Rechercher AS QMENUITEM
         CAPTION="&Rechercher"
         OnClick=MenuRecherche
        END CREATE
        CREATE Poursuivre AS QMENUITEM
         CAPTION="&Poursuivre la recherche"
         OnClick=MenuPoursuivre
        END CREATE
        CREATE Remplace AS QMENUITEM
         CAPTION="&Remplacer"
         OnClick=MenuRemplacer
        END CREATE
       END CREATE
       CREATE Format AS QMENUITEM
        CAPTION="&Format"
        CREATE Police AS QMENUITEM
         CAPTION="&Police"
         OnClick=ChangePolice
        END CREATE
        CREATE CouleurFond AS QMENUITEM
         CAPTION="&Couleur fond"
         OnClick=ChangeFond
        END CREATE
       END CREATE
      END CREATE
      CREATE infos AS QSTATUSBAR
       AddPanels "Li:","Col:","Taille:"
       Panel(0).width=80
       Panel(1).width=80
      END CREATE
      CREATE Edit AS QTEXTEDIT
       Align=5
       PlainText=1
       ScrollBars=3
       WordWrap=false
       UndoCaption="&Annuler"
       CutCaption="&Couper"
       CopyCaption="&Copier"
       PasteCaption="&Coller"
       SelectAllCaption="&Selectionner tout"
       HideSelection=false
       OnMouseDown=ShowLC
       OnKeyUp=ShowLC
      END CREATE
     END CREATE

     CREATE Form2 AS QFORM
      CAPTION="Rechercher"
      Width=326
      Height=119
      borderStyle=bsDialog
      Center
      CREATE LabRech AS QLABEL
       CAPTION="Rechercher:"
       Left=8
       Top=12
       Width=64
       Height=21
      END CREATE
      CREATE EditRech AS QEDIT
       Left=74
       Top=9
       Width=145
       ShowHint=1
       Hint="Mot recherché"
       OnChange=ChangeTextRecherche
       TabOrder=1
      END CREATE
      CREATE BtRech1 AS QBUTTON
       CAPTION="Poursuivre"
       Left=229
       Top=9
       Width=80
       TabOrder=2
       Enabled=false
       OnClick=PoursuivreRecherche
      END CREATE
      CREATE BtRech2 AS QBUTTON
       CAPTION="Annuler"
       Left=229
       Top=41
       Width=80
       TabOrder=3
       OnClick=AnnulerRecherche
      END CREATE
      CREATE CheckRech AS QCHECKBOX
       CAPTION="Respecter la casse"
       Left=8
       Top=57
       Width=113
       ShowHint=1
       Hint="Respect majuscule et minuscule si coché"
       TabOrder=4
      END CREATE
     END CREATE

     CREATE Form3 AS QFORM
      CAPTION="Remplacer"
      Width=362
      Height=177
      borderStyle=bsDialog
      Center
      CREATE Lab1Repl AS QLABEL
       CAPTION="Rechercher:"
       Left=8
       Top=11
       Width=64
      END CREATE
      CREATE Lab2Repl AS QLABEL
       CAPTION="Remplacer par:"
       Left=8
       Top=43
       Width=75
      END CREATE
      CREATE Edit1Repl AS QEDIT
       Left=82
       Top=8
       Width=145
       TabOrder=1
       OnChange=ChangeTextRemplacer
      END CREATE
      CREATE Edit2Repl AS QEDIT
       Left=82
       Top=40
       Width=145
       TabOrder=2
      END CREATE
      CREATE Bt1Repl AS QBUTTON
       CAPTION="Poursuivre"
       Left=237
       Top=8
       Width=107
       TabOrder=3
       Enabled=false
       OnClick=PoursuivreRemplacer
      END CREATE
      CREATE Bt2Repl AS QBUTTON
       CAPTION="Remplacer"
       Left=237
       Top=40
       Width=107
       TabOrder=4
       Enabled=false
       OnClick=Remplacer
      END CREATE
      CREATE Bt3Repl AS QBUTTON
       CAPTION="Remplacer tout"
       Left=237
       Top=72
       Width=107
       TabOrder=5
       Enabled=false
       OnClick=RemplacerTout
      END CREATE
      CREATE Bt4Repl AS QBUTTON
       CAPTION="Annuler"
       Left=237
       Top=104
       Width=107
       TabOrder=6
       OnClick=AnnulerRemplacer
      END CREATE
      CREATE CheckRepl AS QCHECKBOX
       CAPTION="Respecter la casse"
       Left=8
       Top=114
       Width=121
       TabOrder=7
      END CREATE
     END CREATE

'form.DeskBar=true

     Form.SHOWMODAL

     SUB Show
      edit.limit(100000)
      font.Name="Courier New"
      font.size=10
      edit.font=font
      edit.modified=false
      FontDialog.GetFont(font)
     END SUB

     SUB menuEdit
      Annul.Enabled=Edit.CanUndo
      IF LEN(ClipBoard.Text)>0 THEN
       Coller.Enabled=true
      ELSE
       Coller.Enabled=false
      END IF
      IF LEN(edit.text)>0 THEN
       selection.enabled=true
      ELSE
       selection.enabled=false
      END IF
      IF LEN(edit.seltext)>0 THEN
       couper.enabled=true
       copier.enabled=true
      ELSE
       couper.enabled=false
       copier.enabled=false
      END IF
     END SUB

     SUB menuAnnul
      edit.undo
      ShowLC
     END SUB

     SUB menuCouper
      edit.cut
      ShowLC
     END SUB

     SUB menuCopier
      edit.copy
     END SUB

     SUB menuColler
      edit.paste
      ShowLC
     END SUB

     SUB menuSelection
      edit.selectAll
     END SUB

     SUB ShowLC
      infos.panel(0).CAPTION="Li:"+STR$(edit.wherey+1)
      infos.panel(1).CAPTION="Col:"+STR$(edit.wherex+1)
      infos.panel(2).CAPTION="Taille:"+STR$(LEN(edit.text))
     END SUB

     SUB ChangePolice
      DIM memo AS SHORT

      memo=edit.modified
      IF FontDialog.EXECUTE THEN
       FontDialog.SetFont(font)
       edit.font=font
      END IF
      IF memo=false THEN edit.modified=false
     END SUB

     SUB changeFond
      IF cd.EXECUTE THEN
       edit.COLOR=cd.COLOR
      END IF
     END SUB

     SUB menuNouveau
      DIM msgButton AS INTEGER

      IF edit.modified THEN
       msgButton=MESSAGEBOX("Sauver fichier?",application.title,35)
       IF msgButton<>mrCancel THEN
        IF msgButton=mrYes THEN
         menuSauver
        END IF
        edit.Modified=false
        edit.clear
        filename="Sans Titre"
        form.CAPTION=application.title+" - "+filename
       END IF
      ELSE
       edit.clear
       filename="Sans Titre"
       form.CAPTION=application.title+" - "+filename
      END IF
      ShowLC
     END SUB

     SUB menuOuvrir
      DIM OpenDialog AS QOPENDIALOG
      DIM msgButton AS INTEGER

      OpenDialog.Filter="Fichier texte|*.txt|"
      OpenDialog.CAPTION= "Ouvrir fichier"
      IF edit.modified THEN
       msgButton=MESSAGEBOX("Sauver fichier?",application.title,35)
       IF msgButton<>mrCancel THEN
        IF msgButton=mrYes THEN
         menuSauver
        END IF
        OpenDialog.InitialDir=CURDIR$
        IF openDialog.EXECUTE THEN
         FileName=OpenDialog.fileName
         screen.cursor=crHourGlass
         edit.loadfromfile(filename)
         screen.cursor=crDefault
         edit.modified=false
         form.CAPTION=application.title+" - "+RIGHT$(FileName,LEN(FileName)-RINSTR(FileName,"\"))
        END IF
       END IF
      ELSE
       OpenDialog.InitialDir=CURDIR$
       IF openDialog.EXECUTE THEN
        FileName=OpenDialog.fileName
        screen.cursor=crHourGlass
        edit.loadfromfile(filename)
        screen.cursor=crDefault
        edit.modified=false
        form.CAPTION=application.title+" - "+RIGHT$(FileName,LEN(FileName)-RINSTR(FileName,"\"))
       END IF
      END IF
      ShowLC
     END SUB

     SUB menuSauver
      IF FileName="Sans Titre" THEN
       menuSauverSous
      ELSE
       screen.cursor=crHourGlass
       edit.SaveToFile(filename)
       screen.cursor=crDefault
      END IF
     END SUB

     SUB menuSauverSous
      DIM SaveDialog AS QSAVEDIALOG

      SaveDialog.Filter="Fichier texte|*.txt|"
      SaveDialog.CAPTION= "Sauver fichier"
      SaveDialog.InitialDir=CURDIR$
      IF saveDialog.EXECUTE THEN
       FileName=SaveDialog.FileName
       IF INSTR(LCASE$(FileName),".txt")=0 THEN
        FileName=FileName+".txt"
       END IF
       form.CAPTION=application.title+" - "+RIGHT$(FileName,LEN(FileName)-RINSTR(FileName,"\"))
       screen.cursor=crHourGlass
       edit.SaveToFile(filename)
       screen.cursor=crDefault
      END IF
     END SUB

     SUB menuQuitter
      DIM msgButton AS INTEGER

      IF edit.modified THEN
       msgButton=MESSAGEBOX("Sauver fichier?",application.title,35)
       IF msgButton<>mrCancel THEN
        IF msgButton=mrYes THEN
         menuSauver
        END IF
        edit.clear
        application.terminate
       ELSE
        form.modalresult=0
       END IF
      ELSE
       edit.clear
       application.terminate
      END IF
     END SUB

     SUB ChangeTextRecherche
      IF LEN(editRech.text)>0 THEN
       BtRech1.enabled=true
      ELSE
       BtRech1.enabled=false
      END IF
     END SUB

     SUB menuRecherche
      form2.show
     END SUB

     SUB menuRemplacer
      form3.show
     END SUB

     SUB AnnulerRecherche
      form2.CLOSE
     END SUB

     SUB PoursuivreRecherche
      DIM flag AS INTEGER

      flag=checkRech.checked
      IF edit.seltext="" THEN start=edit.selstart
      IF edit.find(start,editRech.text,flag)>0 THEN
       start=edit.find(start,editRech.text,flag)
       start=start+LEN(editRech.text)
      ELSE
       MESSAGEDLG("Impossible de trouver "+CHR$(34)+editRech.text+CHR$(34),mtInformation,mbOk,0)
      END IF
     END SUB

     SUB MenuPoursuivre
      DIM flag AS INTEGER

      flag=checkRech.checked
      IF edit.seltext="" THEN start=edit.selstart
      IF edit.find(start,editRech.text,flag)>0 THEN
       start=edit.find(start,editRech.text,flag)
       start=start+LEN(editRech.text)
      ELSE
       MESSAGEDLG("Impossible de trouver "+CHR$(34)+editRech.text+CHR$(34),mtInformation,mbOk,0)
      END IF
     END SUB

     SUB ChangeTextRemplacer
      IF LEN(edit1Repl.text)>0 THEN
       Bt1Repl.enabled=true
       Bt2Repl.enabled=true
       Bt3Repl.enabled=true
      ELSE
       Bt1Repl.enabled=false
       Bt2Repl.enabled=false
       Bt3Repl.enabled=false
      END IF
     END SUB

     SUB AnnulerRemplacer
      form3.CLOSE
     END SUB

     SUB PoursuivreRemplacer
      DIM flag AS INTEGER

      flag=checkRepl.checked
      IF edit.seltext="" THEN start=edit.selstart
      IF edit.find(start,edit1Repl.text,flag)>0 THEN
       start=edit.find(start,edit1Repl.text,flag)
       start=start+LEN(edit1Repl.text)
      ELSE
       MESSAGEDLG("Impossible de trouver "+CHR$(34)+edit1Repl.text+CHR$(34),mtInformation,mbOk,0)
      END IF
     END SUB

     SUB Remplacer
      IF edit.sellength>0 THEN
       edit.seltext=edit2repl.text
      END IF
      PoursuivreRemplacer
     END SUB

     SUB RemplacerTout
      DIM flag AS INTEGER

      form3.CLOSE
      flag=checkRepl.checked
      IF edit.seltext="" THEN start=edit.selstart
      WHILE edit.find(start,edit1Repl.text,flag)>0
       start=edit.find(start,edit1Repl.text,flag)
       start=start+LEN(edit1Repl.text)
       edit.seltext=edit2repl.text
      WEND
     END SUB

     SUB menuImprimer
      DIM i AS INTEGER
      DIM Top AS SHORT
      DIM Left AS SHORT
      DIM PgWidth AS INTEGER
      DIM PgHeight AS INTEGER
      DIM indexH AS INTEGER
      DIM CharByPixel AS SINGLE
      DIM CharCount AS INTEGER
      DIM buffer AS STRING
      DIM text AS STRING

  'calcul des dimensions page avec les marges
      screen.cursor=crHourGlass
      PgWidth=printer.pagewidth-PrtInfo.MetricToPixel(PgSetup.MarginLeft)-PrtInfo.MetricToPixel(PgSetup.MarginRight)
      PgHeight=printer.pageheight-PrtInfo.MetricToPixel(PgSetup.MarginTop)-PrtInfo.MetricToPixel(PgSetup.MarginBottom)
      printer.font=font
      indexH=0
  'affectation des marges
      Top=PrtInfo.MetricToPixel(PgSetup.MarginTop)
      Left=PrtInfo.MetricToPixel(PgSetup.MarginLeft)
      Printer.BeginDoc
      FOR i=0 TO edit.linecount-1
      ' test si nouvelle page
       IF printer.TextHeight(edit.line(i))+indexH>PgHeight THEN
        printer.NewPage
        indexH=0
       END IF
      ' ajustement largeur texte
       IF printer.TextWidth(edit.line(i))>PgWidth THEN
        CharByPixel=LEN(edit.line(i))/printer.TextWidth(edit.line(i))
        CharCount=ROUND(CharByPixel*PgWidth)
        buffer=edit.line(i)
        WHILE buffer<>""
         IF LEN(buffer)>CharCount THEN
          text=LEFT$(buffer,CharCount)
          buffer=RIGHT$(buffer,LEN(buffer)-CharCount)
            ' test si nouvelle page
          IF printer.TextHeight(text)+indexH>PgHeight THEN
           printer.NewPage
           indexH=0
          END IF
          Printer.TextOut(Left,Top+indexH,text,0,-1)
          indexH=indexH+printer.TextHeight(text)
         ELSE
          text=LEFT$(buffer,LEN(buffer))
          buffer=""
            ' test si nouvelle page
          IF printer.TextHeight(text)+indexH>PgHeight THEN
           printer.NewPage
           indexH=0
          END IF
          Printer.TextOut(Left,Top+indexH,text,0,-1)
          indexH=indexH+printer.TextHeight(text)
         END IF
        WEND
       ELSE
        Text=edit.line(i)
        IF Text="" THEN Text=SPACE$(1)
        Printer.TextOut(Left,Top+indexH,Text,0,-1)
        indexH=indexH+printer.TextHeight(Text)
       END IF
      NEXT i
      Printer.EndDoc
      screen.cursor=crDefault
     END SUB

     SUB menuConfig
      PgSetup.orientation=printer.orientation
      IF PgSetup.EXECUTE THEN
       printer.orientation=PgSetup.orientation
      END IF
     END SUB

2003-03-03 19:12