rem créer un programme simplifier de courrier
width 0,880: height 0,screen_y :color 0,214,226,188 :error_french
' ¤¤
label adresse , sauve_adresse ,new_adresse , formulation , politesse ,clic_clic ,couleur ,SET ,ctrl ,mettre_couleur
label normal, suivi, R_simple,lettre_AR ,v_ref , piece_jointe ,supl ,encodage , save_html ,lire_fic ,decompose
label fond_couleur , saut , print_html
dim da$(12):da$(1)="janvier":da$(2)="février":da$(3)="mars":da$(4)="avril":da$(5)="mai":da$(6)="juin"
da$(7)="juillet":da$(8)="août":da$(9)="septembre":da$(10)="octobre":da$(11)="novembre":da$(12)="décembre"
dim a,b,c,a$,b$,c$, adresse , adr$ , dos$ , f$ , dossier$ ,l ,g$ ,sa$ ,sav$ ,d ,color ,set ,Nvu$ ,htm$
dossier$="C:\COURRIER\" : dos$=dossier$+"ADR\"
g$=chr$(34)
dir_change dos$
Nvu$="C:\HTML\Nvu\Nvu.exe ":' pour execute Nvu$+"impression.HTML"
memo 10:left 10,10:top 10,40:width 10,270:height 10,150:font_size 10,12 :on_click 10,set
edit 11:top 11,5:left 11,10:width 11,330:font_size 11,10 :on_click 11,set
alpha 12:left 12,350:top 12,15:font_size 12,8:caption 12,"DESTINATAIRE"
memo 13:left 13,290:top 13,40:font_size 13,12:width 13,350:height 13,150:on_click 13,set
combo 14:left 14,435:top 14,10:width 14,200:text 14,"************ destinataire *************" :on_click 14,adresse
if file_exists(dos$+"adresse.fic")=1 then file_load 14,dos$+"adresse.fic"
button 15:left 15,650:top 15,5:width 15,90:caption 15,"sauve adresse":on_click 15,sauve_adresse
button 16:left 16,758:top 16,5:width 16,90:caption 16,"new adresse":on_click 16,new_adresse
combo 17:left 17,650:top 17,40:width 17,200:text 17,"formulation":on_click 17,formulation
item_add 17,"Monsieur":item_add 17,"Madame":item_add 17,"Mademoiselle":item_add 17,"Monsieur le Directeur"
item_add 17,"Madame la Directrice":item_add 17,"Monsieur le Proviseur":item_add 17,"Monsieur le Maire":item_add 17,"autre"
item_add 17,"Maître"
alpha 18:left 18,650:top 18,70:width 18,200:caption 18,"formulation à formuler"
edit 19:left 19,650:top 19,90:width 19,200:font_size 19,10:on_click 19,set
combo 20:left 20,10:top 20,200:width 20,630:text 20,"formule de politesse à choisir":on_click 20,politesse
rem
: alt gauche+184 pour être remplacé par Monsieur ou Madame
if file_exists(dossier$+"formules_politesse.txt")=1 then file_load 20,dossier$ + "formules_politesse.txt"
alpha 21:left 21,260:top 21,200:caption 21,"formulation à afficher"
memo 22:left 22,10:top 22,240:width 22,630:height 22,70:font_size 22,12:bar_horizontal 22:on_click 22,set
alpha 59:left 59,650:top 59,200:caption 59,"couleur encre"
list 58:left 58,650:top 58,220:width 58,90:height 58,90
item_add 58,"¤1-violet":item_add 58,"¤2-rouge":item_add 58,"¤3-bleu":item_add 58,"¤4-marron":item_add 58,"¤0-fin":font_size 58,10
on_click 58,couleur
alpha 60:left 60,758:top 60,200:caption 60,"couleur fond"
list 61:left 61,758:top 61,220:width 61,90:height 61,90
item_add 61,"¤5-jaune":item_add 61,"¤6-rouge":item_add 61,"¤7-bleu clair":item_add 61,"¤8-gris":item_add 61,"¤0-fin":font_size 61,10
on_click 61,fond_couleur
container_option 23:top 23,320:width 23,140:height 23,140
option 24:parent 24,23:left 24,5:top 24,10:width 24,130:caption 24,"lettre normale"
option 25:parent 25,23:left 25,5:top 25,40:width 25,130:caption 25,"lettre suivie"
option 26:parent 26,23:left 26,5:top 26,70:width 26,130:caption 26,"recommandé simple"
option 27:parent 27,23:left 27,5:top 27,99:width 27,130:caption 27,"recommandée avec AR"
edit 28:left 28,160:top 28,330:width 28,180:font_size 28,12 :on_click 28,set :hide 28
alpha 63:left 63,180:top 63,430:caption 63,"corps du courrier":font_size 63,12
container 30:left 30,360:top 30,320:width 30,493:height 30,140
check 31:parent 31,30:left 31,5:top 31,10:width 31,130:caption 31,"votre référence"
check 32:parent 32,30:left 32,5:top 32,40:width 32,130:caption 32,"autre"
check 33:parent 33,30:left 33,5:top 33,70:width 33,130:caption 33,"Pièce jointe"
edit 35:parent 35,30:left 35,140:top 35,10:width 35,340 :on_click 35,set
edit 36:parent 36,30:left 36,140:top 36,40:width 36,340 :on_click 36,set
memo 37:parent 37,30:left 37,140:top 37,70:width 37,340:height 37,60 :bar_horizontal 37:on_click 37,set:hide 37
button 38:left 38,700:top 38,550:width 38,130:height 38,70:caption 38,"encodage":font_size 38,16:on_click 38,encodage
memo 40:left 40,40:top 40,470:width 40,620:height 40,height(0)-530:font_size 40,12:on_click 40,set:bar_horizontal 40
button 62:top 62,500:left 62,700:width 62,130:caption 62,"saut page" :on_click 62,saut:hint 62,"insère un saut de page"
dlist 50
alpha 51:top 51,130:left 51,650:caption 51,"signature"
edit 52:top 52,150:left 52,650:width 52,200:font_size 52,12
button 53:top 53,680:left 53,700:width 53,130:font_size 53,12:caption 53,"sauvegarde":on_click 53,save_html
hint 53,"sauve le fichier en" + chr$(13)+ "HTML et fichier brut"
save_dialog 54
open_dialog 55
dlist 56
button 57:top 57,740:left 57,700:width 57,130:caption 57,"lecture fichier brut":on_click 57,lire_fic
hint 57,"lit un fichier et rempli" +chr$(13)+ "les objets de la fenêtre"
button 64:top 64,780:left 64,700:width 64,130:caption 64,"Print fichier HTML" :on_click 64,print_html
hint 64,"Pour imprimer un"+chr$(13)+ "courrier du fichier"
if file_exists(dossier$+"MOI.txt")=1
file_load 56,dossier$+"MOI.txt"
b=0
for a=2 to count(56)
a$=item_read$(56,a)
if instr(a$,"/*")>0 then b=b+1 :c=1:else:c=0
if b=0 then item_add 10,a$
if b=1 and c=0 and a$<>"" then text 52,a$
if b=2 and c=0 and a$<>"" then b$=a$:exit_for
next a
a$=left$(date$,2)+" "+da$( val(mid$(date$,4,2)))+" "+right$(date$,4)+","
text 11,b$+" "+a$
end_if
mark_on 24
hint 16,"définir le nom en premier"+chr$(13)+"préparer l'adresse ensuite"
gosub clic_clic
end
' ====================================
saut:
' ¤¤
item_add 40,"µ
-------saut de page--------saut de page------":return :' µ + alt gauche + 169
couleur:
color=item_index(58)
' ¤¤
select color
case 1:c$="¤1":gosub ctrl
case 2:c$="¤2":gosub ctrl
case 3:c$="¤3":gosub ctrl
case 4:c$="¤4":gosub ctrl
case 5:c$="¤0":gosub ctrl
end_select
return
fond_couleur:
color=item_index(61)
' ¤¤
select color
case 1:c$="¤5":gosub ctrl :' j'ai mis devant ¤x pour pouvoir l'écrire depuis le clavier si on veut
case 2:c$="¤6":gosub ctrl
case 3:c$="¤7":gosub ctrl
case 4:c$="¤8":gosub ctrl
case 5:c$="¤0":gosub ctrl
end_select
return
ctrl:
if instr(" 10 13 22 37 40 "," "+str$(set)+" ")>0
clipboard_string_copy c$
clipboard_paste set
else
a$=text$(set)+c$:text set,a$ :' dommage que l''on ne puisse coller dans un edit !
end_if
set_focus set
return
set:
set=NUMBER_click
if set=19 then gosub politesse
return
clic_clic:
' pour lire le fichier, il faut désarmer les clics, sinon en queue de file, chg des edit. ici on les rétablis
on_click 24,normal:on_click 25,suivi:on_click 26,R_simple :on_click 27,lettre_AR
on_click 31,v_ref:on_click 32,supl:on_click 33,piece_jointe
return
v_ref:
set=35
if checked(31)=1 then text 35,"V/réf: ":show 35:else:text 35,"":hide 35
return
supl:
set=36
if checked(32)=1 then show 36:else:text 36,"":hide 36
return
piece_jointe:
set=37
if checked(33)=1 then clear 37:item_add 37,"P.J.: ":show 37:else:clear 37:hide 37
return
normal:
text 28,"":hide 28:return
suivi:
set=28
text 28,"lettre suivie":show 28:return
R_simple:
set=28
text 28,"lettre en recommandée":show 28:return
lettre_AR:
set=28
text 28,"lettre avec AR":show 28:return
adresse:
adresse=item_index(14)
f$=dos$+item_index$(14)+".txt"
if file_exists(f$)=1 then file_load 13,f$
return
new_adresse:
a$=message_input$("donner un nom","nouveau nom:","")
if a$<>""
clear 13:adresse=count(14)+1
if count(14)>0
for a=1 to count(14):b$=item_read$(14,a)
if upper$(a$)=upper$(b$) then exit_for
next a
if a<=count(14)
message "nom déjà défini"
else
item_add 14,a$
sort 14
end_if
else
item_add 14,a$
end_if
file_save 14,dos$+"adresse.fic"
end_if
return
sauve_adresse:
if count(13)>0
f$=dos$+item_index$(14)+".txt"
file_save 13,f$
end_if
return
formulation:
text 19,item_index$(17):active 22
if text$(19)<>""
color 19,255,255,150
if text$(19)="autre" then color 19,255,0,0
else
color 19,255,255,255
end_if
gosub politesse
return
politesse:
active 22:clear 22
a$=item_index$(20)
a=instr(a$,"
")
if a>0 then a$=left$(a$,a-1)+text$(19)+mid$(a$,a+1,len(a$))
item_add 22,a$+chr$(0) :' évite le retour à la ligne
color 22,255,255,150
return
encodage:
file_load 50,dossier$+"encodage.txt"
l=0
item_add 50, "<pre class="+g$+"entete"+g$+"> <xls:stylesheet></xls:stylesheet>"
if count(10)>0
for a=1 to count(10)
a$= item_read$(10,a):gosub mettre_couleur
if a=count(10)
item_add 50, a$ +"</pre>"
else
item_add 50,a$
end_if
next a
else
message "pas d'expéditeur":return
end_if
rem expéditeur mémo 13
item_add 50,"<pre class="+g$+"destinataire"+g$+"> <xls:stylesheet></xls:stylesheet>"
if count(13)>0
for a=1 to count(13)
a$= item_read$(13,a):gosub mettre_couleur
if a=count(13)
item_add 50, a$ +"</pre>"
else
item_add 50,a$
end_if
next a
else
message "pas d'expéditeur":return
end_if
l=count(10)+count(13)
rem date
a$=text$(11):gosub mettre_couleur
item_add 50,"<pre class= "+g$+"date"+g$+">"+ a$ +"<br/></pre>"
l=l+1
rem type de lettre
if text$(28)<>""
a$=text$(28):gosub mettre_couleur
item_add 50,"<p class="+g$+"soulig"+g$+">"+ a$ +"</p>"
l=l+2
end_if
rem V/réf
if text$(35)<>""
a$=text$(35):gosub mettre_couleur
item_add 50,"<p class="+g$+"soulig"+g$+">" + a$ + "</p>"
l=l+2
end_if
rem autre
if text$(36)<>""
a$=text$(36):gosub mettre_couleur
item_add 50,"<p class="+g$+"soulig"+g$+">"+ a$ +"</p>"
l=l+2
end_if
for a=11 to l step -1:item_add 50,"<br/>":next a
rem formulation
if text$(19)<>""
a$=text$(19):gosub mettre_couleur
item_add 50,"<pre>" + a$ + "</pre><BR/>":l=l+1
else
message "il n'y a pas de choix d'interlocuteur":return
end_if
rem memo 40
if count(40)>0
item_add 50,"<pre>"
for a=1 to count(40)
a$=item_read$(40,a)
if a$<>""
gosub mettre_couleur
' a$= item_read$(40,a)
if instr(a$,"µ
")>0 then a$="<div class="+g$+"breakafter"+g$+"></div>" :' µ et
alt + 169
item_add 50,a$
else
if a<count(40)
item_add 50,"</pre><pre>"
else
item_add 50,"</pre>"
end_if
end_if
next a
if item_read$(50,count(50))<>"</pre>" then item_add 50,"</pre>"
l=l+count(40)
else
message "pas de texte courrier":return
end_if
rem politesse
if count(22)>0
item_add 50,"<pre>"
for a=1 to count(22)
a$=item_read$(22,a):gosub mettre_couleur
item_add 50, a$
next a
item_add 50,"</pre><br/>"
l=l+count(22)+1
else
message "pas de formulation de politesse":return
end_if
rem signature 52
if text$(52)<>""
a$=text$(52):gosub mettre_couleur
item_add 50,"<pre>"+ a$+ "</pre>"
l=l+1
end_if
rem pièce jointe
if count(37)>0
item_add 50,"<pre>"
REM ********************************************
rem SAUT DE X LIGNES POUR ALLER EN BAS
REM ********************************************
for a=l + count(37) to 47:item_add 50,"":next a
' **********************************************
for a=1 to count(37)
a$=item_read$(37,a):gosub mettre_couleur
item_add 50,a$
next a
item_add 50,"</pre>"
end_if
' final impression
item_add 50,"</body></html>"
item_add 50,"</xsl:template>"
item_add 50,"</xml:stylesheet>"
file_save 50,dossier$+"impression.html"
execute NVU$+dossier$+"impression.html"
return
print_html:
filter 55,"Lecture courrier html|*.html"
htm$=file_name$(55)
if htm$<>"_"
show 28:show 37
execute NVU$+htm$
end_if
return
mettre_couleur:
c=instr(a$,"¤")
if c >0
repeat
c=instr(a$,"¤")
if c>0
if numeric(mid$(a$,c+1,1))=1
color=val(mid$(a$,c+1,1))
b$=left$(a$,c-1)
select color
case 0 : c$="</span>"
case 1 : c$="<span class="+g$+"v"+g$+">"
case 2 : c$="<span class="+g$+"r"+g$+">"
case 3 : c$="<span class="+g$+"b"+g$+">"
case 4 : c$="<span class="+g$+"m"+g$+">"
case 5 : c$="<span class="+g$+"fj"+g$+">"
case 6 : c$="<span class="+g$+"fr"+g$+">"
case 7 : c$="<span class="+g$+"fb"+g$+">"
case 8 : c$="<span class="+g$+"fg"+g$+">"
end_select
b$=b$+c$+mid$(a$,c+2,len(a$)):a$=b$
end_if :' sinon ce n'est pas un marqueur mais du texte
end_if
until instr(a$,"¤")=0 or scancode=27
end_if
return
save_html:
filter 54," Sauvegarde courrier html|*.html"
sa$=file_name$(54)
if lower$(right$(sa$,4)) <> "html" then sa$=sa$ +".html"
if sa$<>"_"
if instr(sa$,"html")=0 then sav$=sa$+".html" :else:sav$=sa$
file_save 50,sav$
end_if
clear 56:item_add 56,"[11]"
item_add 56,text$(11):' date
item_add 56,"[19]" :' formulation
item_add 56,text$(19)
item_add 56,"[52]" :' signature
item_add 56,text$(52)
item_add 56,"[24]"
a$=""
for a=24 to 27:if checked(a)=1 then a$=a$+"1":else:a$=a$+"0"
next a
item_add 56,a$
item_add 56,text$(28):' statut de lettre
item_add 56,"[31]"
a$=""
for a=31 to 33:if checked(a)=1 then a$=a$+"1":else:a$=a$+"0"
next a
item_add 56,a$
item_add 56,text$(35)
item_add 56,text$(36)
if count(10)>0
item_add 56,"[10]"
for a=1 to count(10): item_add 56,item_read$(10,a):next a:' expéditeur
else
item_add 56,"[10]/]"
end_if
if count(13)>0
item_add 56,"[13]"
for a=1 to count(13): item_add 56,item_read$(13,a):next a:' destinataire
else
item_add 56,"[13]/]"
end_if
if count(22)>0
item_add 56,"[22]"
for a=1 to count(22): item_add 56,item_read$(22,a):next a:' politesse
else
item_add 56,"[22]/]"
end_if
if count(40)>0
item_add 56,"[40]"
for a=1 to count(40)
item_add 56,item_read$(40,a)
next a:' texte
else
item_add 56,"[40]/]"
end_if
if count(37)>0
item_add 56,"[37]"
for a=1 to count(37): item_add 56,item_read$(37,a):next a:' pièce jointe
else
item_add 56,"[37]/]"
end_if
if sa$<>"_"
if right$(sa$,5)=".html" then sa$=left$(sa$,instr(sa$,".html")-1)
sav$=sa$+".fic"
file_save 56,sav$
end_if
return
lire_fic:
filter 55,"Lecture courrier fic|*.fic"
sav$=file_name$(55)
d=56
if sav$<>"_"
file_load d,sav$
off_click 24:off_click 25:off_click 26:off_click 27
off_click 31:off_click 32:off_click 33
' --
a=1
a$=item_read$(d,a):b$=mid$(a$,2,2):l=val(b$) :gosub decompose
' --
a=3 :a$=item_read$(d,a):b$=mid$(a$,2,2):l=val(b$):gosub decompose
' --
a=5 :a$=item_read$(d,a):b$=mid$(a$,2,2):l=val(b$):gosub decompose
' --
a=7 :a$=item_read$(d,a):b$=mid$(a$,2,2):l=val(b$):gosub decompose
' --
a=10:a$=item_read$(d,a):b$=mid$(a$,2,2):l=val(b$):gosub decompose
' --
a=a+1
a$=item_read$(d,a):b$=mid$(a$,2,2):l=val(b$):gosub decompose :' destinataire 13
' --
a$=item_read$(d,a):b$=mid$(a$,2,2):l=val(b$):gosub decompose :' politesse 22
' --
a$=item_read$(d,a):b$=mid$(a$,2,2):l=val(b$):gosub decompose :' texte 40
a$=item_read$(d,a):b$=mid$(a$,2,2):l=val(b$):gosub decompose
a$=item_read$(d,a):b$=mid$(a$,2,2):l=val(b$):gosub decompose
gosub clic_clic
end_if
return
decompose:
select l
case 11:a=2: text 11,item_read$(d,a)
case 19:a=4: text 19,item_read$(d,a)
case 52:a=6: text 52,item_read$(d,a)
case 24:a=8: a$=item_read$(d,a)
for b=1 to len(a$):b$=mid$(a$,b,1)
if b$="1" then mark_on 23+b:else:mark_off 23+b
next b
a=9: text 28,item_read$(d,a):show 28
case 31:a=11: a$=item_read$(d,a)
for b=1 to len(a$):b$=mid$(a$,b,1)
if b$="1" then mark_on 30+b:else:mark_off 30+b
next b
a=12: text 35,item_read$(d,a) :' v/réf
a=13: text 36,item_read$(d,a) :' autre
case 10:clear 10
repeat
a=a+1
a$=item_read$(d,a)
if left$(a$,4)<>"[13]" then item_add 10,a$
until left$(a$,4)="[13]"
case 13:clear 13
repeat
a=a+1
a$=item_read$(d,a)
if left$(a$,4)<>"[22]" then item_add 13,a$
until left$(a$,4)="[22]"
case 22:clear 22
repeat
a=a+1
a$=item_read$(d,a)
if left$(a$,4)<>"[40]" then item_add 22,a$+chr$(0)
until left$(a$,4)="[40]"
case 40:clear 40
repeat
a=a+1
a$=item_read$(d,a)
if left$(a$,4)<>"[37]" then item_add 40,a$
until left$(a$,4)="[37]"
case 37:clear 37:show 37
repeat
a=a+1
if a>count(d) then exit_repeat
a$=item_read$(d,a)
item_add 37,a$
until a>count(d)
b=50
end_select
return
Accueil 
Calendrier
