'$OPTION ICON "rapidq\examples\Object\examples\edit.ico"
$TYPECHECK ON
$INCLUDE "Rapidq.inc"
$INCLUDE "\Rapidq\examples\Object\QTextEdit.inc"
$INCLUDE "\rapidq\examples\Object\QColorDialog.inc"
$INCLUDE "\rapidq\examples\Object\QFormEx.inc"
$INCLUDE "\rapidq\examples\Object\QPageSetup.inc"
'$INCLUDE "\rapidq\examples\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