FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC

Développement d'applications avec le langage Panoramic
 
AccueilAccueil  FAQFAQ  RechercherRechercher  S'enregistrerS'enregistrer  MembresMembres  GroupesGroupes  Connexion  
Derniers sujets
» KGF.dll - demandes ou suggestions de modifications ou ajouts
par Klaus Aujourd'hui à 4:52

» KGF_dll - nouvelles versions
par Klaus Hier à 23:05

» Mah-Jong européen new-look
par Minibug Hier à 22:31

» track_bar circulaire
par Klaus Hier à 13:54

» API Windows
par Klaus Hier à 3:21

» Cartes de voeux, menus, etc.
par JL35 Lun 11 Déc 2017 - 17:48

» a l'aide klaus
par Minibug Lun 11 Déc 2017 - 11:42

» bug SYNEDIT_TARGET_IS_OBJECT
par Jack Lun 11 Déc 2017 - 0:16

» Jukebox : Serge Reggiani
par papydall Sam 9 Déc 2017 - 5:58

» Ecouter la radio fm sur votre pc
par pascal10000 Sam 9 Déc 2017 - 3:42

» anomalie
par Klaus Sam 9 Déc 2017 - 3:21

» hommage
par Jicehel Ven 8 Déc 2017 - 11:29

» Logiciel de soutien scolaire en langues.
par Pedro Alvarez Ven 8 Déc 2017 - 10:43

» carte son
par Klaus Ven 8 Déc 2017 - 2:37

» mise a jour calculatrice
par joeeee2017 Mer 6 Déc 2017 - 22:19

Navigation
 Portail
 Index
 Membres
 Profil
 FAQ
 Rechercher
Rechercher
 
 

Résultats par :
 
Rechercher Recherche avancée
Décembre 2017
LunMarMerJeuVenSamDim
    123
45678910
11121314151617
18192021222324
25262728293031
CalendrierCalendrier

Partagez | 
 

 PLANORAMIC

Voir le sujet précédent Voir le sujet suivant Aller en bas 
Aller à la page : Précédent  1, 2, 3, 4  Suivant
AuteurMessage
JL35



Nombre de messages : 6018
Localisation : 77
Date d'inscription : 29/11/2007

MessageSujet: Re: PLANORAMIC   Lun 5 Mar 2012 - 17:22

Bonjour bignono, c'est quand même toi le plus fort ! cheers

Et je pense que c'est quand même une amélioration bien utile, et c'est tant mieux si ça ne t'a pas trop coûté de matière grise ni d'espérance de vie, je m'en serais voulu Smile

Testé et approuvé !
(maintenant tu peux imaginer un système pour tracer un mur à 97°, mais si c'est pour une unique utilisation ça perd un peu de son intérêt).


Et il va falloir t'attaquer un de ces jours à la rubrique 'Aide', comme ça se complique ça va manquer...
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jean Claude

avatar

Nombre de messages : 5086
Age : 63
Localisation : 83 Var
Date d'inscription : 07/05/2009

MessageSujet: Re: PLANORAMIC   Lun 5 Mar 2012 - 20:50

En tous cas, c'est un sacré challenge. Bravo.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jicehel

avatar

Nombre de messages : 5863
Age : 45
Localisation : 77500
Date d'inscription : 19/04/2011

MessageSujet: Re: PLANORAMIC   Lun 5 Mar 2012 - 22:33

Tests OK, ça avance bien Bignono ...
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
bignono

avatar

Nombre de messages : 1104
Age : 60
Localisation : Val de Marne
Date d'inscription : 13/11/2011

MessageSujet: Re: PLANORAMIC   Mar 6 Mar 2012 - 1:48

Bonsoir à tous, Smile
Bon, j'ai eu quand même un peu de temps pour travailler aujourd'hui sur PLANORAMIC. Demain et mercredi ce sera pas le cas. On verra!
Bon, j'ai codé la création de cote et la modification de cote. Donc à vous de tester et de me dire si il y a quelque chose d'anormal.
Et puis je vais au Sleep
Alors bonne soirée à vous tous Wink
Code:
dim h,i,j,n,q,p : ' réservés indices et boucles
dim x,y,z,gr,rg,rgy,rgx,clic,styl,pfstyl,mclic,v1,v2,v3,v4,v5,va,open
dim xa%,ya%,xb%,yb%,xc%,yc%,xd%,yd%,xe%,ye%,xf%,yf%,xp%,yp%,xv%,yv%
dim lg%,ha%,dh%,a,k,pi,nv,mx,my,x1%,y1%,x2%,y2%,axd%,ayd%
dim titre$,num$,ligne$(1000),seg$(10),typ$(1000),txt$(1000),undo(50),unimage(50)
dim dx(1000),dy(1000),fx(1000),fy(1000),ep(1000),hm(1000),op(1000),xm(1000),ym(1000)
' dx(i),dy(i) => xd%,yd% * fx(i),fy(i) => xf%,yf% * ep(i) => ha% * hm(i) => nv
label form_zr,form_mpf,form_list,vc1,vc2,vc3,vc4,s1,s2,s3,s4,retourne
label cliquer,init,grille,regle,refait_plan,motif_mur
label pos_souris,test_spin,calcul_points
label selection,cherche_seg,fait_ligne,cherche_num
label aerien,visite,photo
label modifmur,modifporte,modifent,modiftext,modifcote,supprime,aire
label mur,porte,fenetre,texte,cote
label annule,refait,copie,zoom
label nouveau,ouvre,enregistre,prefere,fin,propos,aide

titre$="*** P L A N O R A M I C ***":caption 0,titre$
full_space 0:hide 0:picture 1:width 1,5000:height 1,5000
form 2:hide 2:on_close 2,retourne
dlist 5

' menu Principal OBJETS RÉSERVÉS DE 10 A 80
main_menu 10
' les sous-menus
sub_menu 11:parent 11,10:caption 11,"Fichier"
sub_menu 12:parent 12,10:caption 12,"Edition"
sub_menu 13:parent 13,10:caption 13,"Plan"
sub_menu 14:parent 14,10:caption 14,"Commandes"
sub_menu 15:parent 15,10:caption 15,"Vues 3D"
sub_menu 16:parent 16,10:caption 16,"A propos"      :on_click 16,propos
sub_menu 17:parent 17,10:caption 17,"Aide"          :on_click 17,aide

' sous-menu Fichier
sub_menu 20:parent 20,11:caption 20,"Nouveau"      :on_click 20,nouveau
sub_menu 21:parent 21,11:caption 21,"Ouvrir"        :on_click 21,ouvre
sub_menu 22:parent 22,11:caption 22,"Enregistrer"  :on_click 22,enregistre
sub_menu 23:parent 23,11:caption 23,"Règlages"      :on_click 23,prefere      :' FAIT en partie
sub_menu 24:parent 24,11:caption 24,"Quitter"      :on_click 24,fin

' sous-menu Edition
sub_menu 30:parent 30,12:caption 30,"Annuler"      :on_click 30,annule
sub_menu 31:parent 31,12:caption 31,"Refaire"      :on_click 31,refait
sub_menu 32:parent 32,12:caption 32,"Copier"        :on_click 32,copie
sub_menu 33:parent 33,12:caption 33,"Zoom"          :on_click 33,zoom          :' FAIT

' sous-menu Plan
sub_menu 40:parent 40,13:caption 40,"Créer mur"    :on_click 40,mur          :' FAIT
sub_menu 41:parent 41,13:caption 41,"Créer porte"  :on_click 41,porte        :' FAIT
sub_menu 42:parent 42,13:caption 42,"Créer fenêtre" :on_click 42,fenetre      :' FAIT
sub_menu 43:parent 43,13:caption 43,"Créer texte"  :on_click 43,texte
sub_menu 44:parent 44,13:caption 44,"Créer cote"    :on_click 44,cote


' sous-menu Commandes
sub_menu 50:parent 50,14:caption 50,"Modifier mur"    :on_click 50,modifmur    :' FAIT
sub_menu 51:parent 51,14:caption 51,"Modifier porte"  :on_click 51,modifporte  :' FAIT
sub_menu 52:parent 52,14:caption 52,"Modifier fenêtre":on_click 52,modifent    :' FAIT
sub_menu 53:parent 53,14:caption 53,"Modifier texte"  :on_click 53,modiftext
sub_menu 54:parent 54,14:caption 54,"Modifier cote"  :on_click 54,modifcote
sub_menu 55:parent 55,14:caption 55,"Supprimer"      :on_click 55,supprime
' sub_menu 56:parent 56,14:caption 56,"Calculer surface":on_click 56,aire  <=== A VOIR ???

' sous-menu Vues 3D
sub_menu 60:parent 60,15:caption 60,"Vue aérienne"    :on_click 60,aerien
sub_menu 61:parent 61,15:caption 61,"Visite virtuelle" :on_click 61,visite
sub_menu 62:parent 62,15:caption 62,"Prendre une photo":on_click 62,photo

command_target_is 2
list 6:hide 6:width 6,300:height 6,100
left 6,(width(2)/2)-(width(6)/2):top 6,(height(2)/2-height(6)/2)
' Pour ZOOM et RÈGLAGES
option 81:hide 81:left 81,20:top 81, 30:caption 81," 25 %"
option 82:hide 82:left 82,20:top 82, 60:caption 82," 50 %"
option 83:hide 83:left 83,20:top 83, 90:caption 83,"100 %"
option 84:hide 84:left 84,20:top 84,120:caption 84,"200 %"
option 85:hide 85:left 85,20:top 85,150:caption 85,"400 %"
button 86:hide 86:left 86,120:top 86,170:width 86,50:caption 86," OK "
spin 87:hide 87:left 87,5:top 87,5:width 87,50:min 87, 4:max 87,100
spin 88:hide 88:left 88,5:top 88,30:width 88,50:min 88,10:max 88,300
check 89:hide 89:left 89,5:top 89,165:caption 89,"Règles visible"
check 90:hide 90:left 90,5:top 90,190:caption 90,"Grille visible"
option 91:hide 91:width 91,17:left 91,5:top 91,80
picture 92:hide 92:width 92,60:height 92,15:left 92,25:top 92,80
2d_target_is 92:2d_fill_solid:2d_flood 1,1,0,0,0
option 93:hide 93:width 93,17:left 93,95:top 93,80
picture 94:hide 94:width 94,60:height 94,15:left 94,115:top 94,80
2d_target_is 94:2d_fill_diagonal_up:2d_flood 1,1,0,0,0
option 95:hide 95:width 95,17:left 95,5:top 95,100
picture 96:hide 96:width 96,60:height 96,15:left 96,25:top 96,100
2d_target_is 96:2d_fill_diagonal_down:2d_flood 1,1,0,0,0
option 97:hide 97:width 97,17:left 97,95:top 97,100
picture 98:hide 98:width 98,60:height 98,15:left 98,115:top 98,100
2d_target_is 98:2d_fill_diagonal_cross:2d_flood 1,1,0,0,0
option 99:hide 99:width 99,17:left 99,5:top 99,120
picture 100:hide 100:width 100,60:height 100,15:left 100,25:top 100,120
2d_target_is 100:2d_fill_cross:2d_flood 1,1,0,0,0
option 101:hide 101:width 101,17:left 101,95:top 101,120
picture 102:hide 102:width 102,60:height 102,15:left 102,115:top 102,120
' POUR MODIFIER LES MURS, LES PORTES ET LES FENÊTRES
spin 103:hide 103:left 103, 20:top 103,25:min 103,-50:max 103,9900:' spin début mur x
spin 104:hide 104:left 104,220:top 104,25:min 104,-50:max 104,9900:' spin début mur y
spin 105:hide 105:left 105, 20:top 105,75:min 105,-50:max 105,9900:' spin fin mur x
spin 106:hide 106:left 106,220:top 106,75:min 106,-50:max 106,9900:' spin fin mur y
spin 107:hide 107:left 107, 20:top 107,135:min 107,0:max 107,9900:' spin longueur mur
spin 108:hide 108:left 108,220:top 108,135:min 108,10:max 108,300:' spin hauteur mur
spin 109:hide 109:left 109, 20:top 109,195:min 109,4:max 109,100:' spin épaisseur mur
button 110:hide 110:left 110,220:top 110,230:width 110,120:caption 110,"TEXTURE (3D)"
button 111:hide 111:left 111,220:top 111,265:width 111,120:caption 111,"VALIDER"
check 112:hide 112:left 112, 20:top 112,230:caption 112,"INVERSER"
check 113:hide 113:left 113, 20:top 113,250:caption 113,"MIROIR"

for j=151 to 180:alpha j:hide j:next j

left 151,45 :top 151,60 :caption 151,"  Style des murs  "
left 152,60 :top 152,10 :caption 152," cm. Épaisseur des murs "
left 153,60 :top 153,35 :caption 153," cm.  Hauteur  des murs "
left 154,7  :top 154,10 :caption 154,"DÉBUTE À:"
left 155,7  :top 155,30 :caption 155,"X"
left 156,145:top 156,30 :caption 156,"cm"
left 157,207:top 157,30 :caption 157,"Y"
left 158,345:top 158,30 :caption 158,"cm"
left 159,7  :top 159,60 :caption 159,"TERMINE À:"
left 160,7  :top 160,80 :caption 160,"X"
left 161,145:top 161,80 :caption 161,"cm"
left 162,207:top 162,80 :caption 162,"Y"
left 163,345:top 163,80 :caption 163,"cm"
left 164,20 :top 164,120
left 165,145:top 165,140:caption 165,"cm"
left 166,220:top 166,120:caption 166,"HAUTEUR"
left 167,345:top 167,140:caption 167,"cm"
left 168,20 :top 168,180:caption 168,"ÉPAISSEUR"
left 169,145:top 169,200:caption 169,"cm"

command_target_is 0
for j=300 to 1300:alpha j:hide j:next j

image 210: ' image ecran lors du traçage
image 211: ' image de la grille seule
image 212: ' image effaçant données porte et fenêtre
image 213: ' image du picture vierge
2d_image_copy 213,0,0,width(1),height(1)
gosub init

end

' ******************************************************************************
init:
show 0
pi=4*atn(1):ha%=20:gr=1:rg=1:z=1:open=2
dh%=ha%/(z*4):nv=250:styl=2:pfstyl=1
hide 1:gosub grille:gosub regle:show 1
return

cliquer:
wait 120:' <=== Valeur à ajuster (j'obtiens de bon résultats entre 100 et 200)
if scancode=1 then clic=clic+1
if scancode=1 then clic=clic+1
if clic=1 then mclic=1
if clic=2 then mclic=2
clic=0
return
' ******************************************************************************

pos_souris:
2d_fill_solid:2d_fill_color 255,255,100
print_locate xp%-20,yp%-30:print "x=";str$((xp%-50)*(z*2));" y=";str$((yp%-50)*(z*2))
wait 200
return

mur:
for j=11 to 17:inactive j:next j:2d_target_is 1
2d_image_copy 210,0,0,width(1),height(1)
cursor_cross 1
print_target_is 1
repeat
  xd%=mouse_x_position(1):yd%=mouse_y_position(1)
  if xd%<>xp% or yd%<>yp%
      2d_image_paste 210,0,0
      xp%=xd%:yp%=yd%:gosub pos_souris
  end_if
until (mouse_left_down(1)=1 and mouse_left_up(1)=0)
2d_image_paste 210,0,0:2d_image_copy 210,0,0,width(1),height(1)
2d_pen_color 0,0,0:2d_pen_width 2
while mouse_left_up(1)=0
  xf%=mouse_x_position(1):yf%=mouse_y_position(1)
  if scancode=162 or scancode=163 then yf%=yd%
  if scancode=160 or scancode=161 then xf%=xd%
  lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
  if xf%<>xv% or yf%<>yv%
      2d_image_paste 210,0,0:gosub calcul_points
      2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
      xv%=xf%:yv%=yf%:xp%=xf%:yp%=yf%
      print_locate xp%-20,yp%-60:print "Angle: ";str$(wrap_value(a));"°";" Épaisseur= ";str$(ha%/100);"m"
      print_locate xp%-20,yp%-45:print "Longueur= ";str$((int(lg%)/100)*(z*2));"m"
      gosub pos_souris:wait 100
  end_if
end_while
2d_image_paste 210,0,0
if lg%<>0
  gosub motif_mur:gosub cherche_num:typ$(i)="MURS"
  dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
  ep(i)=ha%:hm(i)=nv:op(i)=0:gosub fait_ligne:item_add 5,ligne$(i)
end_if
cursor_arrow 1
for j=11 to 17:active j:next j
return

calcul_points:
      if xf%>xd%
        k=atn((yd%-yf%)/(xf%-xd%)):a=k*180/pi:a=int(a*100)/100
      end_if
      if xf%<xd%
        k=atn((yd%-yf%)/(xf%-xd%)):a=k*180/pi:a=int(a*100)/100:a=180+a:k=k+3.14
      end_if
      if xd%=xf%
        if yf%<yd% then a=90:k=1.57
        if yf%>yd% then a=270:k=4.71
      end_if
      xa%=xd%-dh%*sin(k):ya%=yd%-dh%*cos(k): ' point A
      xe%=xd%+dh%*sin(k):ye%=yd%+dh%*cos(k): ' point E
      xc%=xe%+lg%*cos(k):yc%=ye%-lg%*sin(k): ' point C
      xb%=xa%+lg%*cos(k):yb%=ya%-lg%*sin(k): ' point B
return
motif_mur:
' Nettoyage
  2d_pen_color 255,255,255:2d_pen_width 2
  for j=-1*dh% to dh%
      x1%=xd%-j*sin(k):y1%=yd%-j*cos(k)
      x2%=x1%+lg%*cos(k):y2%=y1%-lg%*sin(k)
      2d_line x1%,y1%,x2%,y2%
  next j
  2d_pen_color 0,0,0
  2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
  if (styl<>0 and pfstyl<>0)
      mx=(xd%+xf%)/2:my=(yd%+yf%)/2
      if styl=1 then 2d_fill_solid
      if styl=2 then 2d_fill_diagonal_up
      if styl=3 then 2d_fill_diagonal_down
      if styl=4 then 2d_fill_diagonal_cross
      if styl=5 then 2d_fill_cross
      2d_flood mx,my,0,0,0
  end_if
return

porte:
for j=11 to 17:inactive j:next j:2d_target_is 1
2d_image_copy 210,0,0,width(1),height(1)
repeat
      axd%=mouse_x_position(1):ayd%=mouse_y_position(1)
  if axd%<>xv% or ayd%<>yv%
      2d_image_paste 210,0,0
      if (scancode>=160 and scancode<=163)
        xf%=mouse_x_position(1):yf%=mouse_y_position(1)
      else
        xd%=axd%:yd%=ayd%:xf%=xd%+40:yf%=yd%
      end_if
      lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
      gosub calcul_points:2d_pen_color 0,0,0:2d_pen_width 2
      2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
      ' Tracé ouvrant gauche sud par défaut
      for j=(pi*2)-k to ((pi*3)/2)-k step -0.01
        2d_point xc%-(lg%*cos(j)),yc%-(lg%*sin(j))
      next j:j=j+0.01
      2d_line xc%-(lg%*cos(j)),yc%-(lg%*sin(j)),xc%,yc%:xv%=axd%:yv%=ayd%:wait 100
      2d_image_copy 212,0,0,width(1),height(1):xp%=xf%:yp%=yf%
      print_locate xp%-20,yp%-60:print "Angle: ";str$(wrap_value(a));"°"
      print_locate xp%-20,yp%-45:print "Largeur= ";str$((int(lg%)/100)*(z*2));"m"
      gosub pos_souris
  end_if
until mouse_left_down(1)=1
2d_image_paste 212,0,0
pfstyl=0:gosub motif_mur:pfstyl=1:gosub cherche_num:typ$(i)="PORT"
  dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
  ep(i)=ha%:hm(i)=210:op(i)=2:gosub fait_ligne:item_add 5,ligne$(i)
2d_image_copy 210,0,0,width(1),height(1)
for j=11 to 17:active j:next j
return

fenetre:
for j=11 to 17:inactive j:next j:2d_target_is 1
2d_image_copy 210,0,0,width(1),height(1)
repeat
      axd%=mouse_x_position(1):ayd%=mouse_y_position(1)
  if axd%<>xv% or ayd%<>yv%
      2d_image_paste 210,0,0
      if (scancode>=160 and scancode<=163)
        xf%=mouse_x_position(1):yf%=mouse_y_position(1)
      else
        xd%=axd%:yd%=ayd%:xf%=xd%+80:yf%=yd%
      end_if
      lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
      gosub calcul_points:2d_pen_color 0,0,0:2d_pen_width 2
      2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
      for j=(pi*2)-k to ((pi*3)/2)-k step -0.01: ' ouvrant gauche orienté sud par défaut
        2d_point xc%-((lg%/2)*cos(j)),yc%-((lg%/2)*sin(j))
      next j:j=j+0.01
      2d_line xc%-((lg%/2)*cos(j)),yc%-((lg%/2)*sin(j)),xc%,yc%:xv%=axd%:yv%=ayd%
      for j=(pi*2)+k to ((pi*3)/2)+k step -0.01: ' ouvrant droit orienté sud par défaut
        2d_point xe%+((lg%/2)*cos(j)),ye%-((lg%/2)*sin(j))
      next j:j=j+0.01
      2d_line xe%+((lg%/2)*cos(j)),ye%-((lg%/2)*sin(j)),xe%,ye%:wait 100
      2d_image_copy 212,0,0,width(1),height(1):xp%=xf%:yp%=yf%
      print_locate xp%-20,yp%-60:print "Angle: ";str$(wrap_value(a));"°"
      print_locate xp%-20,yp%-45:print "Largeur= ";str$((int(lg%)/100)*(z*2));"m"
      gosub pos_souris
  end_if
until mouse_left_down(1)=1
2d_image_paste 212,0,0
pfstyl=0:gosub motif_mur:pfstyl=1:gosub cherche_num:typ$(i)="FENT"
  dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
  ep(i)=ha%:hm(i)=120:op(i)=2:gosub fait_ligne:item_add 5,ligne$(i)
2d_image_copy 210,0,0,width(1),height(1)
for j=11 to 17:active j:next j
return

texte:
return

cote:
for j=11 to 17:inactive j:next j:2d_target_is 1
2d_image_copy 210,0,0,width(1),height(1)
cursor_cross 1
print_target_is 1
repeat
  xd%=mouse_x_position(1):yd%=mouse_y_position(1)
  if xd%<>xp% or yd%<>yp%
      2d_image_paste 210,0,0
      xp%=xd%:yp%=yd%:gosub pos_souris
  end_if
until (mouse_left_down(1)=1 and mouse_left_up(1)=0)
2d_image_paste 210,0,0:2d_image_copy 210,0,0,width(1),height(1)
2d_pen_color 0,0,0:2d_pen_width 2
while mouse_left_up(1)=0
  xf%=mouse_x_position(1):yf%=mouse_y_position(1)
  if scancode=162 or scancode=163 then yf%=yd%
  if scancode=160 or scancode=161 then xf%=xd%
  lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
  if xf%<>xv% or yf%<>yv%
      2d_image_paste 210,0,0:gosub calcul_points
      2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
      xv%=xf%:yv%=yf%:xp%=xf%:yp%=yf%
      print_locate xp%-20,yp%-45:print "Longueur= ";str$((int(lg%)/100)*(z*2));"m"
      gosub pos_souris:wait 100
  end_if
end_while
2d_image_paste 210,0,0
if lg%<>0
  2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
  mx=(xd%+xf%)/2:my=(yd%+yf%)/2
  gosub cherche_num:typ$(i)="COTE":txt$(i)=str$((int(lg%)/100)*(z*2))+"m"
  left 300+i,mx:top 300+i,my:caption 300+i,txt$(i):show 300+i
  dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
  ep(i)=ha%:xm(i)=(mx-50)*(z*2):ym(i)=(my-50)*(z*2)
  gosub fait_ligne:item_add 5,ligne$(i)
end_if
cursor_arrow 1
for j=11 to 17:active j:next j
return

selection:
  if j>0
      if seg$(1)="COTE"
        2d_pen_color 0,0,0
        2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
      else
        2d_pen_color 0,0,0
        2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
      end_if
  end_if
  i=val(left$(item_read$(6,item_index(6)),3)):gosub cherche_seg
  ligne$(i)="":for q=0 to n-1:ligne$(i)=ligne$(i)+seg$(q)+"*":next q
  xd%=50+val(seg$(2))/(z*2):yd%=50+val(seg$(3))/(z*2)
  xf%=50+val(seg$(4))/(z*2):yf%=50+val(seg$(5))/(z*2)
  ha%=val(seg$(6)):nv=val(seg$(7)):dh%=ha%/(z*4)
  lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2)):gosub calcul_points
  if seg$(1)="COTE"
      2d_pen_color 200,0,0
      2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
  else
      2d_pen_color 200,0,0
      2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
  end_if
  mclic=0:j=i
return

modifmur:
for j=11 to 17:inactive j:next j
caption 2,"LISTE DES MURS":gosub form_list:j=0
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="MURS" then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s1
show 2:print_target_is 2:font_bold 2
j=0:show 6:on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
if mclic=1 then gosub selection
end_while
gosub selection
hide 6:off_click 6:clear 6

caption 2,"MODIFIER MUR":gosub form_mpf
for h=103 to 111:show h:next h:for h=154 to 169:show h:next h
caption 164,"LONGUEUR"
position 103,val(seg$(2)):position 104,val(seg$(3))
position 105,val(seg$(4)):position 106,val(seg$(5))
position 107,sqr(power(val(seg$(4))-val(seg$(2)),2)+power(val(seg$(3))-val(seg$(5)),2))
position 108,val(seg$(7)) :position 109,val(seg$(6))

while clicked(111)=0
  if clicked(1)=1 then to_foreground 2
  gosub test_spin
  if position(103)<>v1 or position(104)<>v2 then gosub vc1
  if position(105)<>v3 or position(106)<>v4 then gosub vc2
  if position(107)<>v5 then gosub vc3
  gosub vc4
end_while

xd%=50+position(103)/(z*2):yd%=50+position(104)/(z*2)
xf%=50+position(105)/(z*2):yf%=50+position(106)/(z*2)
ha%=position(109):nv=position(108):dh%=ha%/(z*4)
' refaire ligne$(i)
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
ep(i)=ha%:hm(i)=nv:op(i)=0:typ$(i)="MURS"
gosub fait_ligne:item_delete 5,i:item_insert 5,i,ligne$(i)
2d_target_is 2:for h=103 to 111:hide h:next h:for h=154 to 169:hide h:next h:hide 2
' refaire le plan
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle
gosub refait_plan
s1:
for j=11 to 17:active j:next j
return

modifporte:
for j=11 to 17:inactive j:next j
caption 2,"LISTE DES PORTES":gosub form_list:j=0
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="PORT" then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s2
show 2:print_target_is 2:font_bold 2
j=0:show 6:on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
  if mclic=1 then gosub selection
end_while
gosub selection
hide 6:off_click 6:clear 6

caption 2,"MODIFIER PORTE":gosub form_mpf
show 2:print_target_is 2:font_bold 2
for h=103 to 113:show h:next h:for h=154 to 167:show h:next h
caption 164,"LARGEUR"
dx(i)=val(seg$(2)):dy(i)=val(seg$(3)):fx(i)=val(seg$(4)):fy(i)=val(seg$(5))
hm(i)=val(seg$(7)):v1=dx(i):v2=dy(i):v3=fx(i):v4=fy(i)
v5=sqr(power(fx(i)-dx(i),2)+power(dy(i)-fy(i),2))

 position 103,dx(i):position 104,dy(i)
 position 105,fx(i):position 106,fy(i)
 position 107,sqr(power(fx(i)-dx(i),2)+power(dy(i)-fy(i),2))
 position 108,hm(i)

while clicked(111)=0
  if clicked(1)=1 then to_foreground 2
  gosub test_spin
  if position(103)<>v1 or position(104)<>v2 then gosub vc1
  if position(105)<>v3 or position(106)<>v4 then gosub vc2
  if position(107)<>v5 then gosub vc3
  gosub vc4
  if (checked(112)=0 and checked(113)=0) then open=2
  if (checked(112)=1 and checked(113)=0) then open=3
  if (checked(112)=0 and checked(113)=1) then open=4
  if (checked(112)=1 and checked(113)=1) then open=5
end_while

xd%=50+position(103)/(z*2):yd%=50+position(104)/(z*2)
xf%=50+position(105)/(z*2):yf%=50+position(106)/(z*2)
nv=position(108):dh%=ha%/(z*4)
' refaire ligne$(i)
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
ep(i)=ha%:hm(i)=nv:op(i)=open:typ$(i)="PORT"
gosub fait_ligne:item_delete 5,i:item_insert 5,i,ligne$(i)
2d_target_is 2:for h=103 to 113:hide h:next h:for h=154 to 167:hide h:next h:hide 2
' refaire le plan
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle
gosub refait_plan
s2:
for j=11 to 17:active j:next j
return

vc1:
  position 107,sqr(power(position(105)-position(103),2)+power(position(104)-position(106),2))
  v1=position(103):v2=position(104):v5=position(107)
return
vc2:
  position 107,sqr(power(position(105)-position(103),2)+power(position(104)-position(106),2))
  v3=position(105):v4=position(106):v5=position(107)
return
vc3:
  position 105,position(103)+position(107)*cos(a)
  position 106,position(104)-position(107)*sin(a)
  position 107,sqr(power(position(105)-position(103),2)+power(position(104)-position(106),2))
  v3=position(105):v4=position(106):v5=position(107)
return
vc4:
  if position(105)<>position(103)
      va=(atn((position(106)-position(104))/(position(105)-position(103)))*180)/pi:va=int(va*100)/100
  end_if
  if position(103)=position(105)
      if position(106)<position(104) then va=90
      if position(106)>position(104) then va=270
  end_if
  print_locate 220,200:print "ANGLE : "; wrap_value(va); "°        "
return

modifent:
for j=11 to 17:inactive j:next j
caption 2,"LISTE DES FENÊTRES":gosub form_list:j=0
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="FENT" then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s3
show 2:print_target_is 2:font_bold 2
j=0:show 6:on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
  if mclic=1 then gosub selection
end_while
gosub selection
hide 6:off_click 6:clear 6

caption 2,"MODIFIER FENÊTRE":gosub form_mpf
show 2:print_target_is 2:font_bold 2
for h=103 to 112:show h:next h:for h=154 to 167:show h:next h
caption 164,"LARGEUR"
dx(i)=val(seg$(2)):dy(i)=val(seg$(3)):fx(i)=val(seg$(4)):fy(i)=val(seg$(5))
hm(i)=val(seg$(7)):v1=dx(i):v2=dy(i):v3=fx(i):v4=fy(i)
v5=sqr(power(fx(i)-dx(i),2)+power(dy(i)-fy(i),2))

 position 103,dx(i):position 104,dy(i)
 position 105,fx(i):position 106,fy(i)
 position 107,sqr(power(fx(i)-dx(i),2)+power(dy(i)-fy(i),2))
 position 108,hm(i)

while clicked(111)=0
  if clicked(1)=1 then to_foreground 2
  gosub test_spin
  if position(103)<>v1 or position(104)<>v2 then gosub vc1
  if position(105)<>v3 or position(106)<>v4 then gosub vc2
  if position(107)<>v5 then gosub vc3
  gosub vc4
  if checked(112)=0 then open=2
  if checked(112)=1 then open=3
end_while

xd%=50+position(103)/(z*2):yd%=50+position(104)/(z*2)
xf%=50+position(105)/(z*2):yf%=50+position(106)/(z*2)
nv=position(108):dh%=ha%/(z*4)
' refaire ligne$(i)
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
ep(i)=ha%:hm(i)=nv:op(i)=open:typ$(i)="FENT"
gosub fait_ligne:item_delete 5,i:item_insert 5,i,ligne$(i)
2d_target_is 2:for h=103 to 112:hide h:next h:for h=154 to 167:hide h:next h:hide 2
' refaire le plan
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle
gosub refait_plan
s3:
for j=11 to 17:active j:next j
return

modiftext:
return

modifcote:
for j=11 to 17:inactive j:next j
caption 2,"LISTE DES COTES":gosub form_list:j=0
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="COTE" then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s4
show 2:print_target_is 2:font_bold 2
j=0:show 6:on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
if mclic=1 then gosub selection
end_while
gosub selection
hide 6:off_click 6:clear 6

caption 2,"MODIFIER COTE":gosub form_mpf
for h=103 to 107:show h:next h:for h=154 to 164:show h:next h:show 111
caption 164,"LONGUEUR"

position 103,val(seg$(2)):position 104,val(seg$(3))
position 105,val(seg$(4)):position 106,val(seg$(5))
position 107,sqr(power(val(seg$(4))-val(seg$(2)),2)+power(val(seg$(3))-val(seg$(5)),2))

while clicked(111)=0
  if clicked(1)=1 then to_foreground 2
  gosub test_spin
  if position(103)<>v1 or position(104)<>v2 then gosub vc1
  if position(105)<>v3 or position(106)<>v4 then gosub vc2
  if position(107)<>v5 then gosub vc3
end_while

xd%=50+position(103)/(z*2):yd%=50+position(104)/(z*2)
xf%=50+position(105)/(z*2):yf%=50+position(106)/(z*2)
mx=(xd%+xf%)/2:my=(yd%+yf%)/2
lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))

' refaire ligne$(i)
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
ep(i)=ha%:xm(i)=(mx-50)*(z*2):ym(i)=(my-50)*(z*2):txt$(i)=str$((int(lg%)/100)*(z*2))+"m"
typ$(i)="COTE":gosub fait_ligne:item_delete 5,i:item_insert 5,i,ligne$(i)
2d_target_is 2:for h=103 to 112:hide h:next h:for h=154 to 167:hide h:next h:hide 2

' refaire le plan
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle
gosub refait_plan
s4:
For j=11 to 17:active j:next j
return

supprime:
aire:
return

aerien:
visite:
photo:
return

' Recherche des segments
cherche_seg:
for p=0 to 10:seg$(p)="":next p: ' purger les segments
n=0:q=instr(ligne$(i),"*"): ' on cherche la première occurence du séparateur
while q>0: ' tant qu'il y a un séparateur, faire:
    seg$(n)=left$(ligne$(i),q-1): ' mémoriser le premier segment
    ligne$(i)=mid$(ligne$(i),q+1,len(ligne$(i)))
    n=n+1: ' éliminer ce segment et son séparateur
    q=instr(ligne$(i),"*"): ' chercher un nouveau séparateur
end_while
return

' routine de recherche d'un numéro d'objet 3d disponible
cherche_num:
p=1
while len(ligne$(p))>4:p=p+1:end_while
if p>999 then message "Vous avez atteint la limite!"+chr$(10)+chr$(13)+"Vous ne pouvez plus rien créer!":p=p-1
i=p
return

fait_ligne:
num$=str$(i)
if len(num$)=1 then num$="  "+num$
if len(num$)=2 then num$=" "+num$
ligne$(i)=num$+"*"+typ$(i)+"*": ' objet n°,type d'objet
if typ$(i)="MURS" or typ$(i)="PORT" or typ$(i)="FENT"
  ligne$(i)=ligne$(i)+str$(dx(i))+"*"+str$(dy(i))+"*"
  ligne$(i)=ligne$(i)+str$(fx(i))+"*"+str$(fy(i))+"*"
  ligne$(i)=ligne$(i)+str$(ep(i))+"*"+str$(hm(i))+"*"+str$(op(i))+"*"
end_if
if typ$(i)="COTE"
  ligne$(i)=ligne$(i)+str$(dx(i))+"*"+str$(dy(i))+"*"
  ligne$(i)=ligne$(i)+str$(fx(i))+"*"+str$(fy(i))+"*"+str$(ep(i))+"*"
  ligne$(i)=ligne$(i)+str$(xm(i))+"*"+str$(ym(i))+"*"+txt$(i)+"*"
end_if
if typ$(i)="AIRE"
end_if
if typ$(i)="TXTE"
end_if
return

annule:
refait:
copie:
return

zoom:
caption 2,"ZOOM":gosub form_zr:show 2:for h=81 to 86:show h:next h
if z=0.25 then set_focus 85:' 400%
if z=0.5 then set_focus 84: ' 200%
if z=1 then set_focus 83:  ' 100%
if z=2 then set_focus 82:  '  50%
if z=4 then set_focus 81:  '  25%
while clicked(86)=0
      if clicked(1)=1 then to_foreground 2
  if checked(81)=1 then z=4:  '  25%
  if checked(82)=1 then z=2:  '  50%
  if checked(83)=1 then z=1:  ' 100%
  if checked(84)=1 then z=0.5: ' 200%
  if checked(85)=1 then z=0.25:' 400%
end_while
for h=81 to 86:hide h:next h:hide 2
2d_target_is 1:2d_image_paste 211,0,0:gosub regle:dh%=ha%/(z*4)
gosub refait_plan
return

nouveau:
ouvre:
enregistre:
return

' routine de test de non dépassement des valeurs min et max si un chiffre est rentré manuellement dans un spin
test_spin:
 if position(87)>100 then position 87,100
 if position(88)>300 then position 88,300
 if position(103)>9900 then position 103,9900
 if position(104)>9900 then position 104,9900
 if position(105)>9900 then position 105,9900
 if position(106)>9900 then position 106,9900
 if position(108)>300 then position 108,300
 if position(109)>100 then position 109,100
 if position(87)<4 then position 87,4
 if position(88)<10 then position 88,10
 if position(103)<-50 then position 103,-50
 if position(104)<-50 then position 104,-50
 if position(105)<-50 then position 105,-50
 if position(106)<-50 then position 106,-50
 if position(108)<10 then position 108,10
 if position(109)<4 then position 109,4
return

prefere:
caption 2,"REGLAGES":gosub form_zr:show 2:for h=86 to 102:show h:next h
2d_target_is 2:2d_fill_color 255,255,255:print_target_is 2
for h=151 to 153:show h:next h
if rg=1 then mark_on 89
if rg<>1 then mark_off 89
if gr=1 then mark_on 90
if gr<>1 then mark_off 90
if styl=0 then mark_on 101
if styl=1 then mark_on 91
if styl=2 then mark_on 93
if styl=3 then mark_on 95
if styl=4 then mark_on 97
if styl=5 then mark_on 99
position 87,ha%:position 88,nv
while clicked(86)=0
      if clicked(1)=1 then to_foreground 2
  if checked(91)=1 then styl=1
  if checked(93)=1 then styl=2
  if checked(95)=1 then styl=3
  if checked(97)=1 then styl=4
  if checked(99)=1 then styl=5
  if checked(101)=1 then styl=0
  if checked(89)=1 then rg=1
  if checked(89)=0 then rg=0
  if checked(90)=1 then gr=1
  if checked(90)=0 then gr=0
  gosub test_spin
end_while
ha%=position(87):nv=position(88):dh%=ha%/(z*4)
for h=86 to 102:hide h:next h:for h= 151 to 153:hide h:next h:hide 2
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle

refait_plan:
2d_pen_color 0,0,0
for i=1 to count(5)
' width 5,1000:left 5,500:top 5,100:show 5: ' <== POUR VISIONNER LE LIST DES MURS ****** A SUPPRIMER *******
  gosub cherche_seg
  ligne$(i)="":for q=0 to n-1:ligne$(i) = ligne$(i) + seg$(q)+"*":next q:' reconstitue ligne$(i)
  ' RESTAURER LES MURS    <*******************
  if seg$(1)="MURS" or seg$(1)="PORT" or seg$(1)="FENT"
      xd%=50+val(seg$(2))/(z*2):yd%=50+val(seg$(3))/(z*2):xf%=50+val(seg$(4))/(z*2):yf%=50+val(seg$(5))/(z*2)
      ha%=val(seg$(6)):nv=val(seg$(7)):dh%=ha%/(z*4):open=val(seg$(8))
      lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2)):gosub calcul_points
      2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
  end_if
  if seg$(1)="MURS" then gosub motif_mur
  ' RESTAURER LES PORTES
  if seg$(1)="PORT"
      pfstyl=0:gosub motif_mur:pfstyl=1
      ' Tracé ouvrant gauche sud
      if open=2
        for j=(pi*2)-k to ((pi*3)/2)-k step -0.01
            2d_point xc%-(lg%*cos(j)),yc%-(lg%*sin(j))
        next j:j=j+0.01
        2d_line xc%-(lg%*cos(j)),yc%-(lg%*sin(j)),xc%,yc%
      end_if
      ' Tracé ouvrant gauche nord
      if open=3
        for j=pi-k to (pi/2)-k step -0.01
            2d_point xa%-(lg%*cos(j)),ya%-(lg%*sin(j))
        next j:j=j+0.01
        2d_line xa%-(lg%*cos(j)),ya%-(lg%*sin(j)),xa%,ya%
      end_if
      ' Tracé ouvrant droit nord
      if open=4
        for j=pi+k to (pi/2)+k step -0.01
            2d_point xb%+(lg%*cos(j)),yb%-(lg%*sin(j))
        next j:j=j+0.01
        2d_line xb%+(lg%*cos(j)),yb%-(lg%*sin(j)),xb%,yb%
      end_if
      ' Tracé ouvrant droit sud
      if open=5
        for j=(pi*2)+k to ((pi*3)/2)+k step -0.01
            2d_point xe%+(lg%*cos(j)),ye%-(lg%*sin(j))
        next j:j=j+0.01:2d_line xe%+(lg%*cos(j)),ye%-(lg%*sin(j)),xe%,ye%
      end_if
  end_if
  ' RESTAURER LES FENETRES
  if seg$(1)="FENT"
      pfstyl=0:gosub motif_mur:pfstyl=1
      if open=2
        for j=(pi*2)-k to ((pi*3)/2)-k step -0.01: ' ouvrant gauche
            2d_point xc%-((lg%/2)*cos(j)),yc%-((lg%/2)*sin(j))
        next j:j=j+0.01
        2d_line xc%-((lg%/2)*cos(j)),yc%-((lg%/2)*sin(j)),xc%,yc%
        for j=(pi*2)+k to ((pi*3)/2)+k step -0.01: ' ouvrant droit
            2d_point xe%+((lg%/2)*cos(j)),ye%-((lg%/2)*sin(j))
        next j:j=j+0.01
        2d_line xe%+((lg%/2)*cos(j)),ye%-((lg%/2)*sin(j)),xe%,ye%
      end_if
      if open=3
        for j=pi-k to (pi/2)-k step -0.01: ' ouvrant gauche
            2d_point xa%-((lg%/2)*cos(j)),ya%-((lg%/2)*sin(j))
        next j:j=j+0.01
        2d_line xa%-((lg%/2)*cos(j)),ya%-((lg%/2)*sin(j)),xa%,ya%
        for j=pi+k to (pi/2)+k step -0.01: ' ouvrant droit
            2d_point xb%+((lg%/2)*cos(j)),yb%-((lg%/2)*sin(j))
        next j:j=j+0.01
        2d_line xb%+((lg%/2)*cos(j)),yb%-((lg%/2)*sin(j)),xb%,yb%
      end_if
  end_if
  ' A FAIRE RESTAURER LES COTES  <*******************
  if seg$(1)="COTE"
      xd%=50+val(seg$(2))/(z*2):yd%=50+val(seg$(3))/(z*2):xf%=50+val(seg$(4))/(z*2):yf%=50+val(seg$(5))/(z*2)
      mx=50+val(seg$(7))/(z*2):my=50+val(seg$(8))/(z*2):ha%=val(seg$(6)):dh%=ha%/(z*4)
      lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2)):gosub calcul_points
      2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
      left 300+val(seg$(0)),mx:top 300+val(seg$(0)),my:caption 300+val(seg$(0)),seg$(9):show 300+val(seg$(0))
  end_if
  ' A FAIRE RESTAURER LES AIRES  <*******************
  if seg$(1)="AIRE"
  end_if
  ' A FAIRE RESTAURER LES TEXTES  <*******************
  if seg$(1)="TXTE"
  end_if
next i
return

' ******************************************************************************

regle:
font_name 1,"Fixedsys":2d_target_is 1:2d_fill_color 255,255,255:print_target_is 1
for y=0 to height(1) step 50
  if (int(y/50)=y/50 and y<>0)
      if rg=1
        print_locate 1,y-7:rgy=(int(y/50)*z)-z
        if int(rgy)=rgy then print rgy
      end_if
  end_if
next y
for x=0 to width(1) step 50
  if (int(x/50)=x/50 and x<>0)
      if rg=1
        print_locate x-7,1:rgx=(int(x/50)*z)-z
        if int(rgx)=rgx then print rgx
      end_if
  end_if
next x
return

grille:
2d_target_is 1:2d_pen_width 1
for y=0 to height(1) step 10
  if gr=1
      if int(y/50)<>y/50:2d_pen_color 0,200,200:else:2d_pen_color 0,0,250:end_if
      2d_line 0,y,width(1),y
  end_if
next y
for x=0 to width(1) step 10
  if gr=1
      if int(x/50)<>x/50:2d_pen_color 0,200,200:else:2d_pen_color 0,0,250:end_if
      2d_line x,0,x,height(1)
  end_if
next x
2d_image_copy 211,0,0,width(1),height(1): ' Copie de la grille
return

form_list:
color 2,180,180,180:width 2,400:height 2,300
left 2,(width(0)/2)+(width(2)/2):top 2,(height(0)/2-height(2)/2)
width 6,300:height 6,100
left 6,(width(2)/2)-(width(6)/2):top 2,(height(2)/2-height(6)/2):return
form_zr:
color 2,0,150,100:width 2,250:height 2,300
left 2,(width(0)/2)-(width(2)/2):top 2,(height(0)/2-height(2)/2):return
form_mpf:
color 2,200,200,200:width 2,400:height 2,330
left 2,(width(0)/2)+(width(2)/2):top 2,(height(0)/2-height(2)/2):return
retourne:
show 2:return

propos:
aide:
return
fin:
terminate
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jicehel

avatar

Nombre de messages : 5863
Age : 45
Localisation : 77500
Date d'inscription : 19/04/2011

MessageSujet: Re: PLANORAMIC   Mar 6 Mar 2012 - 2:22

Tests OK
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jean Claude

avatar

Nombre de messages : 5086
Age : 63
Localisation : 83 Var
Date d'inscription : 07/05/2009

MessageSujet: Re: PLANORAMIC   Mar 6 Mar 2012 - 11:29

Test OK

Deux suggestion:
1) ne serait-il pas mieux que l'affichage des cotes soit au dessus du trait ?
2) Pourrait-on sortir des modifs par la croix rouge s'il n'y a rien à modifier ?

Bravo, çà tient la route

cheers
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
bignono

avatar

Nombre de messages : 1104
Age : 60
Localisation : Val de Marne
Date d'inscription : 13/11/2011

MessageSujet: Re: PLANORAMIC   Mar 6 Mar 2012 - 12:00

Bonjour Jean Claude, Smile
Pour l'affichage des cotes je peux essayer de voir si je peux ajouter un choix pour la positionner au dessus ou au dessous du trait, mais ça n'aurait aucune incidence sur une cote verticale ou oblique, à moins de mettre à gauche ou à droite du tracé de la cote. Ce que je voulais faire au début, c'est afficher la cote avec une rotation du texte pour qu'elle soit bien positionnée au dessus du trait, mais malheureusement aucune instruction de panoramic ne permet d'écrire un texte à 20, ou 60 ou 90°. J'ai trouvé sur le forum un sujet sur la rotation de texte par JL35 je crois, mais l'algorythme de traçage est lent et laisse des trous. Donc ce n'était pas satisfaisant pour moi. Je crois que je vais laisser l'affichage de la cote tel quel.
Pour ce qui est des modifs la sortie ne s'effectue que par le bouton valider. En effet j'ai bloqué la croix rouge, car sinon on bloque le programme. Mais à la réflexion, j'aurais pu la laissée active et sortir du mode modif comme ça. Oui mais ça m'aurait aussi obligé de programmer un mode de sortie pour la fonction Zoom, règlages, sélection mur, portes fenêtres, etc... et pour chaque modif. Non je laisse comme ça après tout.
Mais je vous remercie tous de vos suggestions et de vos encouragements. Ça me permet de continuer l'aventure...
A+ Wink
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jicehel

avatar

Nombre de messages : 5863
Age : 45
Localisation : 77500
Date d'inscription : 19/04/2011

MessageSujet: Re: PLANORAMIC   Mar 6 Mar 2012 - 12:09

C'est vrai qu'un bouton annuler serait sympa (la croix rouge pourrait utiliser le code du bouton annuler par exemple). Ce n'est pas une priorité et je pense que tu as d'autres codes à produire, mais c'est vrai que ça améliore la convivialité du programme (et en plus en règle générale, c'est facile et rapide à coder).
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jean Claude

avatar

Nombre de messages : 5086
Age : 63
Localisation : 83 Var
Date d'inscription : 07/05/2009

MessageSujet: Re: PLANORAMIC   Mar 6 Mar 2012 - 13:28

Je fais des suggestions, mais effectivement je n'ai pas regardé le travail que cela engendre. Embarassed

A bientôt pour la suite. Very Happy
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jicehel

avatar

Nombre de messages : 5863
Age : 45
Localisation : 77500
Date d'inscription : 19/04/2011

MessageSujet: Re: PLANORAMIC   Mar 6 Mar 2012 - 13:40

Et je crois que Bignono préfère refuser des propositions qu'il n'a pas décidé de coder pour le moment que de ne pas en avoir et de rater des modifs à faire selon ses critères Smile
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
bignono

avatar

Nombre de messages : 1104
Age : 60
Localisation : Val de Marne
Date d'inscription : 13/11/2011

MessageSujet: Re: PLANORAMIC   Jeu 8 Mar 2012 - 0:53

Bonsoir planète PANORAMIC, Very Happy
Bon, ce soir j'ai eu un peu de temps et j'ai levé plusieurs bugs, j'ai codé la fonction "Créer Texte", "Modif Text", et ce qui m'a causé le plus de problèmes la fonction "Supprimer" du menu Commandes. Après va falloir que je trouve un peu de temps pour continuer, ce qui n'est pas évident, car ma semaine est assez mouvementée en ce moment.
Vous verrez, j'ai utilisé du goto et ça j'aime pas trop! (pour moi le recours à goto c'est de la mauvaise programmation) Le code provisoire: cheers
Code:
dim h,i,j,n,q,p : ' réservés indices et boucles
dim x,y,z,gr,rg,rgy,rgx,clic,styl,pfstyl,mclic,v1,v2,v3,v4,v5,va,open
dim xa%,ya%,xb%,yb%,xc%,yc%,xd%,yd%,xe%,ye%,xf%,yf%,xp%,yp%,xv%,yv%
dim lg%,ha%,dh%,a,k,pi,nv,mx,my,x1%,y1%,x2%,y2%,axd%,ayd%
dim titre$,num$,tx$,ligne$(1000),seg$(10),typ$(1000),txt$(1000),undo(50),unimage(50)
dim dx(1000),dy(1000),fx(1000),fy(1000),ep(1000),hm(1000),op(1000),xm(1000),ym(1000)
' dx(i),dy(i) => xd%,yd% * fx(i),fy(i) => xf%,yf% * ep(i) => ha% * hm(i) => nv
label form_zr,form_mpf,form_list,vc1,vc2,vc3,vc4,s1,s2,s3,s4,s5,s6,s7,s8
label cliquer,init,grille,regle,refait_plan,motif_mur,retourne,saisir,saisir2
label pos_souris,test_spin,calcul_points
label selection,slectext,cherche_seg,fait_ligne,cherche_num
label aerien,visite,photo
label modifmur,modifporte,modifent,modiftext,modifcote,supprime,aire
label mur,porte,fenetre,texte,cote
label annule,refait,copie,zoom
label nouveau,ouvre,enregistre,prefere,fin,propos,aide

titre$="*** P L A N O R A M I C ***":caption 0,titre$
full_space 0:hide 0:picture 1:width 1,5000:height 1,5000
form 2:hide 2:on_close 2,retourne
dlist 5

' menu Principal OBJETS RÉSERVÉS DE 10 A 80
main_menu 10
' les sous-menus
sub_menu 11:parent 11,10:caption 11,"Fichier"
sub_menu 12:parent 12,10:caption 12,"Edition"
sub_menu 13:parent 13,10:caption 13,"Plan"
sub_menu 14:parent 14,10:caption 14,"Commandes"
sub_menu 15:parent 15,10:caption 15,"Vues 3D"
sub_menu 16:parent 16,10:caption 16,"A propos"      :on_click 16,propos
sub_menu 17:parent 17,10:caption 17,"Aide"          :on_click 17,aide

' sous-menu Fichier
sub_menu 20:parent 20,11:caption 20,"Nouveau"      :on_click 20,nouveau
sub_menu 21:parent 21,11:caption 21,"Ouvrir"        :on_click 21,ouvre
sub_menu 22:parent 22,11:caption 22,"Enregistrer"  :on_click 22,enregistre
sub_menu 23:parent 23,11:caption 23,"Règlages"      :on_click 23,prefere      :' FAIT en partie (ya un bug!!!)
sub_menu 24:parent 24,11:caption 24,"Quitter"      :on_click 24,fin

' sous-menu Edition
sub_menu 30:parent 30,12:caption 30,"Annuler"      :on_click 30,annule
sub_menu 31:parent 31,12:caption 31,"Refaire"      :on_click 31,refait
sub_menu 32:parent 32,12:caption 32,"Copier"        :on_click 32,copie
sub_menu 33:parent 33,12:caption 33,"Zoom"          :on_click 33,zoom          :' FAIT

' sous-menu Plan
sub_menu 40:parent 40,13:caption 40,"Créer mur"    :on_click 40,mur          :' FAIT
sub_menu 41:parent 41,13:caption 41,"Créer porte"  :on_click 41,porte        :' FAIT
sub_menu 42:parent 42,13:caption 42,"Créer fenêtre" :on_click 42,fenetre      :' FAIT
sub_menu 43:parent 43,13:caption 43,"Créer texte"  :on_click 43,texte        :' FAIT
sub_menu 44:parent 44,13:caption 44,"Créer cote"    :on_click 44,cote          :' FAIT


' sous-menu Commandes
sub_menu 50:parent 50,14:caption 50,"Modifier mur"    :on_click 50,modifmur    :' FAIT (SAUF BOUTON TEXTURE 3D)
sub_menu 51:parent 51,14:caption 51,"Modifier porte"  :on_click 51,modifporte  :' FAIT (SAUF BOUTON TEXTURE 3D)
sub_menu 52:parent 52,14:caption 52,"Modifier fenêtre":on_click 52,modifent    :' FAIT (SAUF BOUTON TEXTURE 3D)
sub_menu 53:parent 53,14:caption 53,"Modifier texte"  :on_click 53,modiftext  :' FAIT
sub_menu 54:parent 54,14:caption 54,"Modifier cote"  :on_click 54,modifcote  :' FAIT
sub_menu 55:parent 55,14:caption 55,"Supprimer"      :on_click 55,supprime    :' FAIT
' sub_menu 56:parent 56,14:caption 56,"Calculer surface":on_click 56,aire  <=== A VOIR ???

' sous-menu Vues 3D
sub_menu 60:parent 60,15:caption 60,"Vue aérienne"    :on_click 60,aerien
sub_menu 61:parent 61,15:caption 61,"Visite virtuelle" :on_click 61,visite
sub_menu 62:parent 62,15:caption 62,"Prendre une photo":on_click 62,photo

command_target_is 2
list 6:hide 6:width 6,300:height 6,100
left 6,(width(2)/2)-(width(6)/2):top 6,(height(2)/2-height(6)/2)
' Pour ZOOM et RÈGLAGES
option 81:hide 81:left 81,20:top 81, 30:caption 81," 25 %"
option 82:hide 82:left 82,20:top 82, 60:caption 82," 50 %"
option 83:hide 83:left 83,20:top 83, 90:caption 83,"100 %"
option 84:hide 84:left 84,20:top 84,120:caption 84,"200 %"
option 85:hide 85:left 85,20:top 85,150:caption 85,"400 %"
button 86:hide 86:left 86,120:top 86,170:width 86,50:caption 86," OK "
spin 87:hide 87:left 87,5:top 87,5:width 87,50:min 87, 4:max 87,100
spin 88:hide 88:left 88,5:top 88,30:width 88,50:min 88,10:max 88,300
check 89:hide 89:left 89,5:top 89,165:caption 89,"Règles visible"
check 90:hide 90:left 90,5:top 90,190:caption 90,"Grille visible"
option 91:hide 91:width 91,17:left 91,5:top 91,80
picture 92:hide 92:width 92,60:height 92,15:left 92,25:top 92,80
2d_target_is 92:2d_fill_solid:2d_flood 1,1,0,0,0
option 93:hide 93:width 93,17:left 93,95:top 93,80
picture 94:hide 94:width 94,60:height 94,15:left 94,115:top 94,80
2d_target_is 94:2d_fill_diagonal_up:2d_flood 1,1,0,0,0
option 95:hide 95:width 95,17:left 95,5:top 95,100
picture 96:hide 96:width 96,60:height 96,15:left 96,25:top 96,100
2d_target_is 96:2d_fill_diagonal_down:2d_flood 1,1,0,0,0
option 97:hide 97:width 97,17:left 97,95:top 97,100
picture 98:hide 98:width 98,60:height 98,15:left 98,115:top 98,100
2d_target_is 98:2d_fill_diagonal_cross:2d_flood 1,1,0,0,0
option 99:hide 99:width 99,17:left 99,5:top 99,120
picture 100:hide 100:width 100,60:height 100,15:left 100,25:top 100,120
2d_target_is 100:2d_fill_cross:2d_flood 1,1,0,0,0
option 101:hide 101:width 101,17:left 101,95:top 101,120
picture 102:hide 102:width 102,60:height 102,15:left 102,115:top 102,120
' POUR MODIFIER LES MURS, LES PORTES ET LES FENÊTRES
spin 103:hide 103:left 103, 20:top 103,25:min 103,-50:max 103,9900:' spin début mur x
spin 104:hide 104:left 104,220:top 104,25:min 104,-50:max 104,9900:' spin début mur y
spin 105:hide 105:left 105, 20:top 105,75:min 105,-50:max 105,9900:' spin fin mur x
spin 106:hide 106:left 106,220:top 106,75:min 106,-50:max 106,9900:' spin fin mur y
spin 107:hide 107:left 107, 20:top 107,135:min 107,0:max 107,9900:' spin longueur mur
spin 108:hide 108:left 108,220:top 108,135:min 108,10:max 108,300:' spin hauteur mur
spin 109:hide 109:left 109, 20:top 109,195:min 109,4:max 109,100:' spin épaisseur mur
button 110:hide 110:left 110,220:top 110,230:width 110,120:caption 110,"TEXTURE (3D)"
button 111:hide 111:left 111,220:top 111,265:width 111,120:caption 111,"VALIDER"
check 112:hide 112:left 112, 20:top 112,230:caption 112,"INVERSER"
check 113:hide 113:left 113, 20:top 113,250:caption 113,"MIROIR"

for j=151 to 180:alpha j:hide j:next j

left 151,45 :top 151,60 :caption 151,"  Style des murs  "
left 152,60 :top 152,10 :caption 152," cm. Épaisseur des murs "
left 153,60 :top 153,35 :caption 153," cm.  Hauteur  des murs "
left 154,7  :top 154,10 :caption 154,"DÉBUTE À:"
left 155,7  :top 155,30 :caption 155,"X"
left 156,145:top 156,30 :caption 156,"cm"
left 157,207:top 157,30 :caption 157,"Y"
left 158,345:top 158,30 :caption 158,"cm"
left 159,7  :top 159,60 :caption 159,"TERMINE À:"
left 160,7  :top 160,80 :caption 160,"X"
left 161,145:top 161,80 :caption 161,"cm"
left 162,207:top 162,80 :caption 162,"Y"
left 163,345:top 163,80 :caption 163,"cm"
left 164,20 :top 164,120
left 165,145:top 165,140:caption 165,"cm"
left 166,220:top 166,120:caption 166,"HAUTEUR"
left 167,345:top 167,140:caption 167,"cm"
left 168,20 :top 168,180:caption 168,"ÉPAISSEUR"
left 169,145:top 169,200:caption 169,"cm"

command_target_is 0
for j=300 to 1300:alpha j:hide j:next j

image 210: ' image ecran lors du traçage
image 211: ' image de la grille seule
image 212: ' image effaçant données porte et fenêtre
image 213: ' image du picture vierge
2d_image_copy 213,0,0,width(1),height(1)
gosub init

end

' ******************************************************************************
init:
show 0
pi=4*atn(1):ha%=20:gr=1:rg=1:z=1:open=2
dh%=ha%/(z*4):nv=250:styl=2:pfstyl=1
gosub grille:gosub regle
return

cliquer:
wait 120:' <=== Valeur à ajuster (j'obtiens de bon résultats entre 100 et 200)
if scancode=1 then clic=clic+1
if scancode=1 then clic=clic+1
if clic=1 then mclic=1
if clic=2 then mclic=2
clic=0
return
' ******************************************************************************

pos_souris:
2d_fill_solid:2d_fill_color 255,255,100
print_locate xp%-20,yp%-30:print "x=";str$((xp%-50)*(z*2));" y=";str$((yp%-50)*(z*2))
wait 200
return

mur:
for j=11 to 17:inactive j:next j:2d_target_is 1
2d_image_copy 210,0,0,width(1),height(1)
cursor_cross 1
print_target_is 1
repeat
  xd%=mouse_x_position(1):yd%=mouse_y_position(1):xf%=xd%:yf%=yd%
  if xd%<>xp% or yd%<>yp%
      2d_image_paste 210,0,0
      xp%=xd%:yp%=yd%:gosub pos_souris
  end_if
until (mouse_left_down(1)=1 and mouse_left_up(1)=0)
2d_image_paste 210,0,0:2d_image_copy 210,0,0,width(1),height(1)
2d_pen_color 0,0,0:2d_pen_width 2
while mouse_left_up(1)=0
  xf%=mouse_x_position(1):yf%=mouse_y_position(1)
  if scancode=162 or scancode=163 then yf%=yd%
  if scancode=160 or scancode=161 then xf%=xd%
  lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
  if xf%<>xv% or yf%<>yv%
      2d_image_paste 210,0,0:gosub calcul_points
      2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
      xv%=xf%:yv%=yf%:xp%=xf%:yp%=yf%
      print_locate xp%-20,yp%-60:print "Angle: ";str$(wrap_value(a));"°";" Épaisseur= ";str$(ha%/100);"m"
      print_locate xp%-20,yp%-45:print "Longueur= ";str$((int(lg%)/100)*(z*2));"m"
      gosub pos_souris:wait 100
  end_if
end_while
2d_image_paste 210,0,0:lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
if lg%<>0
  gosub motif_mur:gosub cherche_num:typ$(i)="MURS"
  dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
  ep(i)=ha%:hm(i)=nv:op(i)=0:gosub fait_ligne:item_add 5,ligne$(i)
end_if
cursor_arrow 1
for j=11 to 17:active j:next j
return

calcul_points:
      if xf%>xd%
        k=atn((yd%-yf%)/(xf%-xd%)):a=k*180/pi:a=int(a*100)/100
      end_if
      if xf%<xd%
        k=atn((yd%-yf%)/(xf%-xd%)):a=k*180/pi:a=int(a*100)/100:a=180+a:k=k+3.14
      end_if
      if xd%=xf%
        if yf%<yd% then a=90:k=1.57
        if yf%>yd% then a=270:k=4.71
      end_if
      xa%=xd%-dh%*sin(k):ya%=yd%-dh%*cos(k): ' point A
      xe%=xd%+dh%*sin(k):ye%=yd%+dh%*cos(k): ' point E
      xc%=xe%+lg%*cos(k):yc%=ye%-lg%*sin(k): ' point C
      xb%=xa%+lg%*cos(k):yb%=ya%-lg%*sin(k): ' point B
return
motif_mur:
' Nettoyage
  2d_pen_color 255,255,255:2d_pen_width 2
  for j=-1*dh% to dh%
      x1%=xd%-j*sin(k):y1%=yd%-j*cos(k)
      x2%=x1%+lg%*cos(k):y2%=y1%-lg%*sin(k)
      2d_line x1%,y1%,x2%,y2%
  next j
  2d_pen_color 0,0,0
  2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
  if (styl<>0 and pfstyl<>0)
      mx=(xd%+xf%)/2:my=(yd%+yf%)/2
      if styl=1 then 2d_fill_solid
      if styl=2 then 2d_fill_diagonal_up
      if styl=3 then 2d_fill_diagonal_down
      if styl=4 then 2d_fill_diagonal_cross
      if styl=5 then 2d_fill_cross
      2d_flood mx,my,0,0,0
  end_if
return

porte:
for j=11 to 17:inactive j:next j:2d_target_is 1
2d_image_copy 210,0,0,width(1),height(1)
repeat
      axd%=mouse_x_position(1):ayd%=mouse_y_position(1)
  if axd%<>xv% or ayd%<>yv%
      2d_image_paste 210,0,0
      if (scancode>=160 and scancode<=163)
        xf%=mouse_x_position(1):yf%=mouse_y_position(1)
      else
        xd%=axd%:yd%=ayd%:xf%=xd%+40:yf%=yd%
      end_if
      lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
      gosub calcul_points:2d_pen_color 0,0,0:2d_pen_width 2
      2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
      ' Tracé ouvrant gauche sud par défaut
      for j=(pi*2)-k to ((pi*3)/2)-k step -0.01
        2d_point xc%-(lg%*cos(j)),yc%-(lg%*sin(j))
      next j:j=j+0.01
      2d_line xc%-(lg%*cos(j)),yc%-(lg%*sin(j)),xc%,yc%:xv%=axd%:yv%=ayd%:wait 100
      2d_image_copy 212,0,0,width(1),height(1):xp%=xf%:yp%=yf%
      print_locate xp%-20,yp%-60:print "Angle: ";str$(wrap_value(a));"°"
      print_locate xp%-20,yp%-45:print "Largeur= ";str$((int(lg%)/100)*(z*2));"m"
      gosub pos_souris
  end_if
until mouse_left_down(1)=1
2d_image_paste 212,0,0
pfstyl=0:gosub motif_mur:pfstyl=1:gosub cherche_num:typ$(i)="PORT"
  dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
  ep(i)=ha%:hm(i)=210:op(i)=2:gosub fait_ligne:item_add 5,ligne$(i)
2d_image_copy 210,0,0,width(1),height(1)
for j=11 to 17:active j:next j
return

fenetre:
for j=11 to 17:inactive j:next j:2d_target_is 1
2d_image_copy 210,0,0,width(1),height(1)
repeat
      axd%=mouse_x_position(1):ayd%=mouse_y_position(1)
  if axd%<>xv% or ayd%<>yv%
      2d_image_paste 210,0,0
      if (scancode>=160 and scancode<=163)
        xf%=mouse_x_position(1):yf%=mouse_y_position(1)
      else
        xd%=axd%:yd%=ayd%:xf%=xd%+80:yf%=yd%
      end_if
      lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
      gosub calcul_points:2d_pen_color 0,0,0:2d_pen_width 2
      2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
      for j=(pi*2)-k to ((pi*3)/2)-k step -0.01: ' ouvrant gauche orienté sud par défaut
        2d_point xc%-((lg%/2)*cos(j)),yc%-((lg%/2)*sin(j))
      next j:j=j+0.01
      2d_line xc%-((lg%/2)*cos(j)),yc%-((lg%/2)*sin(j)),xc%,yc%:xv%=axd%:yv%=ayd%
      for j=(pi*2)+k to ((pi*3)/2)+k step -0.01: ' ouvrant droit orienté sud par défaut
        2d_point xe%+((lg%/2)*cos(j)),ye%-((lg%/2)*sin(j))
      next j:j=j+0.01
      2d_line xe%+((lg%/2)*cos(j)),ye%-((lg%/2)*sin(j)),xe%,ye%:wait 100
      2d_image_copy 212,0,0,width(1),height(1):xp%=xf%:yp%=yf%
      print_locate xp%-20,yp%-60:print "Angle: ";str$(wrap_value(a));"°"
      print_locate xp%-20,yp%-45:print "Largeur= ";str$((int(lg%)/100)*(z*2));"m"
      gosub pos_souris
  end_if
until mouse_left_down(1)=1
2d_image_paste 212,0,0
pfstyl=0:gosub motif_mur:pfstyl=1:gosub cherche_num:typ$(i)="FENT"
  dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
  ep(i)=ha%:hm(i)=120:op(i)=2:gosub fait_ligne:item_add 5,ligne$(i)
2d_image_copy 210,0,0,width(1),height(1)
for j=11 to 17:active j:next j
return

texte:
for j=11 to 17:inactive j:next j:2d_target_is 1
2d_image_copy 210,0,0,width(1),height(1)
cursor_cross 1
print_target_is 1
repeat
  xd%=mouse_x_position(1):yd%=mouse_y_position(1)
  if xd%<>xp% or yd%<>yp%
      2d_image_paste 210,0,0
      xp%=xd%:yp%=yd%:gosub pos_souris
  end_if
until (mouse_left_down(1)=1 and mouse_left_up(1)=0)
2d_image_paste 210,0,0:2d_image_copy 210,0,0,width(1),height(1)

saisir:
  tx$=message_input$("PLANORAMIC", "Entrez un nom (20 caractères maxi)" , "")
  if len(tx$)>20 then goto saisir
  if tx$="" then goto s8
gosub cherche_num:typ$(i)="TXTE":txt$(i)=tx$
font_name 300+i,"Terminal":font_bold 300+i:font_size 300+i,(6/z)+6
left 300+i,xd%:top 300+i,yd%:caption 300+i,txt$(i):show 300+i
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2)
gosub fait_ligne:item_add 5,ligne$(i)
s8:
2d_image_copy 210,0,0,width(1),height(1)
cursor_arrow 1
for j=11 to 17:active j:next j
return

cote:
for j=11 to 17:inactive j:next j:2d_target_is 1
2d_image_copy 210,0,0,width(1),height(1)
cursor_cross 1
print_target_is 1
repeat
  xd%=mouse_x_position(1):yd%=mouse_y_position(1):xf%=xd%:yf%=yd%
  if xd%<>xp% or yd%<>yp%
      2d_image_paste 210,0,0
      xp%=xd%:yp%=yd%:gosub pos_souris
  end_if
until (mouse_left_down(1)=1 and mouse_left_up(1)=0)
2d_image_paste 210,0,0:2d_image_copy 210,0,0,width(1),height(1)
2d_pen_color 0,0,0:2d_pen_width 2
while mouse_left_up(1)=0
  xf%=mouse_x_position(1):yf%=mouse_y_position(1)
  if scancode=162 or scancode=163 then yf%=yd%
  if scancode=160 or scancode=161 then xf%=xd%
  lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
  if xf%<>xv% or yf%<>yv%
      2d_image_paste 210,0,0:gosub calcul_points
      2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
      xv%=xf%:yv%=yf%:xp%=xf%:yp%=yf%
      print_locate xp%-20,yp%-45:print "Longueur= ";str$((int(lg%)/100)*(z*2));"m"
      gosub pos_souris:wait 100
  end_if
end_while
2d_image_paste 210,0,0:lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
if lg%<>0
  2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
  mx=(xd%+xf%)/2:my=(yd%+yf%)/2
  gosub cherche_num:typ$(i)="COTE":txt$(i)=str$((int(lg%)/100)*(z*2))+"m"
  left 300+i,mx:top 300+i,my:caption 300+i,txt$(i):show 300+i
  dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
  ep(i)=ha%:xm(i)=(mx-50)*(z*2):ym(i)=(my-50)*(z*2)
  gosub fait_ligne:item_add 5,ligne$(i)
end_if
cursor_arrow 1
for j=11 to 17:active j:next j
return

selection:
  if j>0
      if seg$(1)="COTE"
        2d_pen_color 0,0,0
        2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
      else
        2d_pen_color 0,0,0
        2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
      end_if
  end_if
  i=val(left$(item_read$(6,item_index(6)),3)):gosub cherche_seg
  ligne$(i)="":for q=0 to n-1:ligne$(i)=ligne$(i)+seg$(q)+"*":next q
  xd%=50+val(seg$(2))/(z*2):yd%=50+val(seg$(3))/(z*2)
  xf%=50+val(seg$(4))/(z*2):yf%=50+val(seg$(5))/(z*2)
  ha%=val(seg$(6)):nv=val(seg$(7)):dh%=ha%/(z*4)
  lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2)):gosub calcul_points
  if seg$(1)="COTE"
      2d_pen_color 200,0,0
      2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
  else
      2d_pen_color 200,0,0
      2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
  end_if
  mclic=0:j=i
return

modifmur:
for j=11 to 17:inactive j:next j
caption 2,"LISTE DES MURS":gosub form_list:j=0
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="MURS" then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s1
show 2:print_target_is 2:font_bold 2
j=0:show 6:on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
if mclic=1 then gosub selection
end_while
gosub selection
hide 6:off_click 6:clear 6

caption 2,"MODIFIER MUR":gosub form_mpf
for h=103 to 111:show h:next h:for h=154 to 169:show h:next h
caption 164,"LONGUEUR"
position 103,val(seg$(2)):position 104,val(seg$(3))
position 105,val(seg$(4)):position 106,val(seg$(5))
position 107,sqr(power(val(seg$(4))-val(seg$(2)),2)+power(val(seg$(3))-val(seg$(5)),2))
position 108,val(seg$(7)) :position 109,val(seg$(6))

while clicked(111)=0
  if clicked(1)=1 then to_foreground 2
  gosub test_spin
  if position(103)<>v1 or position(104)<>v2 then gosub vc1
  if position(105)<>v3 or position(106)<>v4 then gosub vc2
  if position(107)<>v5 then gosub vc3
  gosub vc4
end_while

xd%=50+position(103)/(z*2):yd%=50+position(104)/(z*2)
xf%=50+position(105)/(z*2):yf%=50+position(106)/(z*2)
ha%=position(109):nv=position(108):dh%=ha%/(z*4)
' refaire ligne$(i)
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
ep(i)=ha%:hm(i)=nv:op(i)=0:typ$(i)="MURS"
gosub fait_ligne:item_delete 5,i:item_insert 5,i,ligne$(i)
2d_target_is 2:for h=103 to 111:hide h:next h:for h=154 to 169:hide h:next h:hide 2
' refaire le plan
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle
gosub refait_plan
s1:
for j=11 to 17:active j:next j
return

modifporte:
for j=11 to 17:inactive j:next j
caption 2,"LISTE DES PORTES":gosub form_list:j=0
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="PORT" then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s2
show 2:print_target_is 2:font_bold 2
j=0:show 6:on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
  if mclic=1 then gosub selection
end_while
gosub selection
hide 6:off_click 6:clear 6

caption 2,"MODIFIER PORTE":gosub form_mpf
show 2:print_target_is 2:font_bold 2
for h=103 to 113:show h:next h:for h=154 to 167:show h:next h
caption 164,"LARGEUR"
dx(i)=val(seg$(2)):dy(i)=val(seg$(3)):fx(i)=val(seg$(4)):fy(i)=val(seg$(5))
hm(i)=val(seg$(7)):v1=dx(i):v2=dy(i):v3=fx(i):v4=fy(i)
v5=sqr(power(fx(i)-dx(i),2)+power(dy(i)-fy(i),2))

 position 103,dx(i):position 104,dy(i)
 position 105,fx(i):position 106,fy(i)
 position 107,sqr(power(fx(i)-dx(i),2)+power(dy(i)-fy(i),2))
 position 108,hm(i)

while clicked(111)=0
  if clicked(1)=1 then to_foreground 2
  gosub test_spin
  if position(103)<>v1 or position(104)<>v2 then gosub vc1
  if position(105)<>v3 or position(106)<>v4 then gosub vc2
  if position(107)<>v5 then gosub vc3
  gosub vc4
  if (checked(112)=0 and checked(113)=0) then open=2
  if (checked(112)=1 and checked(113)=0) then open=3
  if (checked(112)=0 and checked(113)=1) then open=4
  if (checked(112)=1 and checked(113)=1) then open=5
end_while

xd%=50+position(103)/(z*2):yd%=50+position(104)/(z*2)
xf%=50+position(105)/(z*2):yf%=50+position(106)/(z*2)
nv=position(108):dh%=ha%/(z*4)
' refaire ligne$(i)
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
ep(i)=ha%:hm(i)=nv:op(i)=open:typ$(i)="PORT"
gosub fait_ligne:item_delete 5,i:item_insert 5,i,ligne$(i)
2d_target_is 2:for h=103 to 113:hide h:next h:for h=154 to 167:hide h:next h:hide 2
' refaire le plan
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle
gosub refait_plan
s2:
for j=11 to 17:active j:next j
return

vc1:
  position 107,sqr(power(position(105)-position(103),2)+power(position(104)-position(106),2))
  v1=position(103):v2=position(104):v5=position(107)
return
vc2:
  position 107,sqr(power(position(105)-position(103),2)+power(position(104)-position(106),2))
  v3=position(105):v4=position(106):v5=position(107)
return
vc3:
  position 105,position(103)+position(107)*cos(a)
  position 106,position(104)-position(107)*sin(a)
  position 107,sqr(power(position(105)-position(103),2)+power(position(104)-position(106),2))
  v3=position(105):v4=position(106):v5=position(107)
return
vc4:
  if position(105)<>position(103)
      va=(atn((position(106)-position(104))/(position(105)-position(103)))*180)/pi:va=int(va*100)/100
  end_if
  if position(103)=position(105)
      if position(106)<position(104) then va=90
      if position(106)>position(104) then va=270
  end_if
  print_locate 220,200:print "ANGLE : "; wrap_value(va); "°        "
return

modifent:
for j=11 to 17:inactive j:next j
caption 2,"LISTE DES FENÊTRES":gosub form_list:j=0
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="FENT" then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s3
show 2:print_target_is 2:font_bold 2
j=0:show 6:on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
  if mclic=1 then gosub selection
end_while
gosub selection
hide 6:off_click 6:clear 6

caption 2,"MODIFIER FENÊTRE":gosub form_mpf
show 2:print_target_is 2:font_bold 2
for h=103 to 112:show h:next h:for h=154 to 167:show h:next h
caption 164,"LARGEUR"
dx(i)=val(seg$(2)):dy(i)=val(seg$(3)):fx(i)=val(seg$(4)):fy(i)=val(seg$(5))
hm(i)=val(seg$(7)):v1=dx(i):v2=dy(i):v3=fx(i):v4=fy(i)
v5=sqr(power(fx(i)-dx(i),2)+power(dy(i)-fy(i),2))

 position 103,dx(i):position 104,dy(i)
 position 105,fx(i):position 106,fy(i)
 position 107,sqr(power(fx(i)-dx(i),2)+power(dy(i)-fy(i),2))
 position 108,hm(i)

while clicked(111)=0
  if clicked(1)=1 then to_foreground 2
  gosub test_spin
  if position(103)<>v1 or position(104)<>v2 then gosub vc1
  if position(105)<>v3 or position(106)<>v4 then gosub vc2
  if position(107)<>v5 then gosub vc3
  gosub vc4
  if checked(112)=0 then open=2
  if checked(112)=1 then open=3
end_while

xd%=50+position(103)/(z*2):yd%=50+position(104)/(z*2)
xf%=50+position(105)/(z*2):yf%=50+position(106)/(z*2)
nv=position(108):dh%=ha%/(z*4)
' refaire ligne$(i)
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
ep(i)=ha%:hm(i)=nv:op(i)=open:typ$(i)="FENT"
gosub fait_ligne:item_delete 5,i:item_insert 5,i,ligne$(i)
2d_target_is 2:for h=103 to 112:hide h:next h:for h=154 to 167:hide h:next h:hide 2
' refaire le plan
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle
gosub refait_plan
s3:
for j=11 to 17:active j:next j
return

modiftext:
for j=11 to 17:inactive j:next j
caption 2,"LISTE DES TEXTES":gosub form_list:j=0
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="TXTE" then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s5
show 2:print_target_is 2:font_bold 2
j=0:show 6:on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
if mclic=1 then gosub slectext
end_while
gosub slectext
hide 6:off_click 6:clear 6:hide 2

saisir2:
  tx$=message_input$("PLANORAMIC", "Entrez un nom (20 caractères maxi)" , "")
  if len(tx$)>20 then goto saisir2
  if len(tx$)=0 then tx$=txt$(i)
typ$(i)="TXTE":txt$(i)=tx$
font_name 300+i,"Terminal":font_bold 300+i:font_size 300+i,(6/z)+6
color 300+i,240,240,240:left 300+i,xd%:top 300+i,yd%:caption 300+i,txt$(i):show 300+i
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2)
gosub fait_ligne:item_delete 5,i:item_insert 5,i,ligne$(i)
s5:
for j=11 to 17:active j:next j
return

slectext:
  color 300+i,240,240,240
  i=val(left$(item_read$(6,item_index(6)),3)):gosub cherche_seg
  ligne$(i)="":for q=0 to n-1:ligne$(i)=ligne$(i)+seg$(q)+"*":next q
  xd%=50+val(seg$(2))/(z*2):yd%=50+val(seg$(3))/(z*2)
  txt$(i)=seg$(4)
  color 300+i,255,0,0
  mclic=0:j=i
return

modifcote:
for j=11 to 17:inactive j:next j
caption 2,"LISTE DES COTES":gosub form_list:j=0
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="COTE" then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s4
show 2:print_target_is 2:font_bold 2
j=0:show 6:on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
if mclic=1 then gosub selection
end_while
gosub selection
hide 6:off_click 6:clear 6

caption 2,"MODIFIER COTE":gosub form_mpf
for h=103 to 107:show h:next h:for h=154 to 164:show h:next h:show 111
caption 164,"LONGUEUR"

position 103,val(seg$(2)):position 104,val(seg$(3))
position 105,val(seg$(4)):position 106,val(seg$(5))
position 107,sqr(power(val(seg$(4))-val(seg$(2)),2)+power(val(seg$(3))-val(seg$(5)),2))

while clicked(111)=0
  if clicked(1)=1 then to_foreground 2
  gosub test_spin
  if position(103)<>v1 or position(104)<>v2 then gosub vc1
  if position(105)<>v3 or position(106)<>v4 then gosub vc2
  if position(107)<>v5 then gosub vc3
end_while

xd%=50+position(103)/(z*2):yd%=50+position(104)/(z*2)
xf%=50+position(105)/(z*2):yf%=50+position(106)/(z*2)
mx=(xd%+xf%)/2:my=(yd%+yf%)/2
lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))

' refaire ligne$(i)
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
ep(i)=ha%:xm(i)=(mx-50)*(z*2):ym(i)=(my-50)*(z*2):txt$(i)=str$((int(lg%)/100)*(z*2))+"m"
typ$(i)="COTE":gosub fait_ligne:item_delete 5,i:item_insert 5,i,ligne$(i)
2d_target_is 2:for h=103 to 112:hide h:next h:for h=154 to 167:hide h:next h:hide 2

' refaire le plan
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle
gosub refait_plan
s4:
for j=11 to 17:active j:next j
return

supprime:
for j=11 to 17:inactive j:next j:caption 111,"ANNULER":show 111
caption 2,"LISTE DES OBJETS":gosub form_list:j=0
for i=1 to count(5)
  if len(ligne$(i))>0 then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s6
show 2:print_target_is 2:font_bold 2
j=0:show 6
s7:
on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
  if clicked(111)=1 then off_click 6:hide 6:clear 6:hide 2:goto s6
end_while
off_click 6
i=val(left$(item_read$(6,item_index(6)),3))
if mid$(ligne$(i),5,4)="TXTE" : gosub slectext : else : gosub selection : end_if
j=message_warning_yes_no("SUPPRIMER?")
if j=0 or j=2
if mid$(ligne$(i),5,4)="TXTE" then color 300+i,240,240,240
if mid$(ligne$(i),5,4)="COTE" then 2d_pen_color 0,0,0:2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
if mid$(ligne$(i),5,4)="MURS" or mid$(ligne$(i),5,4)="PORT" or mid$(ligne$(i),5,4)="FENT"
  2d_pen_color 0,0,0:2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
end_if
goto s7
end_if
hide 6:clear 6:hide 2
if mid$(ligne$(i),5,4)="TXTE" then color 300+i,240,240,240:hide 300+i
if mid$(ligne$(i),5,4)="COTE" then hide 300+i
ligne$(i)="":item_delete 5,i:item_insert 5,i,ligne$(i)
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle
gosub refait_plan
s6:
caption 111,"VALIDER":hide 111:for j=11 to 17:active j:next j
return

aire:
return

aerien:
visite:
photo:
return

' Recherche des segments
cherche_seg:
for p=0 to 10:seg$(p)="":next p: ' purger les segments
n=0:q=instr(ligne$(i),"*"): ' on cherche la première occurence du séparateur
while q>0: ' tant qu'il y a un séparateur, faire:
    seg$(n)=left$(ligne$(i),q-1): ' mémoriser le premier segment
    ligne$(i)=mid$(ligne$(i),q+1,len(ligne$(i)))
    n=n+1: ' éliminer ce segment et son séparateur
    q=instr(ligne$(i),"*"): ' chercher un nouveau séparateur
end_while
return

' routine de recherche d'un numéro d'objet 3d disponible
cherche_num:
p=1
while len(ligne$(p))>4:p=p+1:end_while
if p>999 then message "Vous avez atteint la limite!"+chr$(10)+chr$(13)+"Vous ne pouvez plus rien créer!":p=p-1
i=p
return

fait_ligne:
num$=str$(i)
if len(num$)=1 then num$="  "+num$
if len(num$)=2 then num$=" "+num$
ligne$(i)=num$+"*"+typ$(i)+"*": ' objet n°,type d'objet
if typ$(i)="MURS" or typ$(i)="PORT" or typ$(i)="FENT"
  ligne$(i)=ligne$(i)+str$(dx(i))+"*"+str$(dy(i))+"*"
  ligne$(i)=ligne$(i)+str$(fx(i))+"*"+str$(fy(i))+"*"
  ligne$(i)=ligne$(i)+str$(ep(i))+"*"+str$(hm(i))+"*"+str$(op(i))+"*"
end_if
if typ$(i)="COTE"
  ligne$(i)=ligne$(i)+str$(dx(i))+"*"+str$(dy(i))+"*"
  ligne$(i)=ligne$(i)+str$(fx(i))+"*"+str$(fy(i))+"*"+str$(ep(i))+"*"
  ligne$(i)=ligne$(i)+str$(xm(i))+"*"+str$(ym(i))+"*"+txt$(i)+"*"
end_if
if typ$(i)="TXTE"
  ligne$(i)=ligne$(i)+str$(dx(i))+"*"+str$(dy(i))+"*"+txt$(i)+"*"
end_if
if typ$(i)="AIRE"
end_if
return

annule:
refait:
copie:
return

zoom:
caption 2,"ZOOM":gosub form_zr:show 2:for h=81 to 86:show h:next h
if z=0.25 then set_focus 85:' 400%
if z=0.5 then set_focus 84: ' 200%
if z=1 then set_focus 83:  ' 100%
if z=2 then set_focus 82:  '  50%
if z=4 then set_focus 81:  '  25%
while clicked(86)=0
      if clicked(1)=1 then to_foreground 2
  if checked(81)=1 then z=4:  '  25%
  if checked(82)=1 then z=2:  '  50%
  if checked(83)=1 then z=1:  ' 100%
  if checked(84)=1 then z=0.5: ' 200%
  if checked(85)=1 then z=0.25:' 400%
end_while
for h=81 to 86:hide h:next h:hide 2
2d_target_is 1:2d_image_paste 211,0,0:gosub regle:dh%=ha%/(z*4)
gosub refait_plan
return

nouveau:
ouvre:
enregistre:
return

' routine de test de non dépassement des valeurs min et max si un chiffre est rentré manuellement dans un spin
test_spin:
 if position(87)>100 then position 87,100
 if position(88)>300 then position 88,300
 if position(103)>9900 then position 103,9900
 if position(104)>9900 then position 104,9900
 if position(105)>9900 then position 105,9900
 if position(106)>9900 then position 106,9900
 if position(108)>300 then position 108,300
 if position(109)>100 then position 109,100
 if position(87)<4 then position 87,4
 if position(88)<10 then position 88,10
 if position(103)<-50 then position 103,-50
 if position(104)<-50 then position 104,-50
 if position(105)<-50 then position 105,-50
 if position(106)<-50 then position 106,-50
 if position(108)<10 then position 108,10
 if position(109)<4 then position 109,4
return

prefere:
caption 2,"REGLAGES":gosub form_zr:show 2:for h=86 to 102:show h:next h
2d_target_is 2:2d_fill_color 255,255,255:print_target_is 2
for h=151 to 153:show h:next h
if rg=1 then mark_on 89
if rg<>1 then mark_off 89
if gr=1 then mark_on 90
if gr<>1 then mark_off 90
if styl=0 then mark_on 101
if styl=1 then mark_on 91
if styl=2 then mark_on 93
if styl=3 then mark_on 95
if styl=4 then mark_on 97
if styl=5 then mark_on 99
position 87,ha%:position 88,nv
while clicked(86)=0
      if clicked(1)=1 then to_foreground 2
  if checked(91)=1 then styl=1
  if checked(93)=1 then styl=2
  if checked(95)=1 then styl=3
  if checked(97)=1 then styl=4
  if checked(99)=1 then styl=5
  if checked(101)=1 then styl=0
  if checked(89)=1 then rg=1
  if checked(89)=0 then rg=0
  if checked(90)=1 then gr=1
  if checked(90)=0 then gr=0
  gosub test_spin
end_while
ha%=position(87):nv=position(88):dh%=ha%/(z*4)
for h=86 to 102:hide h:next h:for h= 151 to 153:hide h:next h:hide 2
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle

refait_plan:
2d_pen_color 0,0,0
for i=1 to count(5)
  gosub cherche_seg
  ligne$(i)="":for q=0 to n-1:ligne$(i) = ligne$(i) + seg$(q)+"*":next q:' reconstitue ligne$(i)
  if ligne$(i)="*" then ligne$(i)=""
  ' RESTAURER LES MURS    <*******************
  if seg$(1)="MURS" or seg$(1)="PORT" or seg$(1)="FENT"
      xd%=50+val(seg$(2))/(z*2):yd%=50+val(seg$(3))/(z*2):xf%=50+val(seg$(4))/(z*2):yf%=50+val(seg$(5))/(z*2)
      ha%=val(seg$(6)):nv=val(seg$(7)):dh%=ha%/(z*4):open=val(seg$(8))
      lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2)):gosub calcul_points
      2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
  end_if
  if seg$(1)="MURS" then gosub motif_mur
  ' RESTAURER LES PORTES
  if seg$(1)="PORT"
      pfstyl=0:gosub motif_mur:pfstyl=1
      ' Tracé ouvrant gauche sud
      if open=2
        for j=(pi*2)-k to ((pi*3)/2)-k step -0.01
            2d_point xc%-(lg%*cos(j)),yc%-(lg%*sin(j))
        next j:j=j+0.01
        2d_line xc%-(lg%*cos(j)),yc%-(lg%*sin(j)),xc%,yc%
      end_if
      ' Tracé ouvrant gauche nord
      if open=3
        for j=pi-k to (pi/2)-k step -0.01
            2d_point xa%-(lg%*cos(j)),ya%-(lg%*sin(j))
        next j:j=j+0.01
        2d_line xa%-(lg%*cos(j)),ya%-(lg%*sin(j)),xa%,ya%
      end_if
      ' Tracé ouvrant droit nord
      if open=4
        for j=pi+k to (pi/2)+k step -0.01
            2d_point xb%+(lg%*cos(j)),yb%-(lg%*sin(j))
        next j:j=j+0.01
        2d_line xb%+(lg%*cos(j)),yb%-(lg%*sin(j)),xb%,yb%
      end_if
      ' Tracé ouvrant droit sud
      if open=5
        for j=(pi*2)+k to ((pi*3)/2)+k step -0.01
            2d_point xe%+(lg%*cos(j)),ye%-(lg%*sin(j))
        next j:j=j+0.01:2d_line xe%+(lg%*cos(j)),ye%-(lg%*sin(j)),xe%,ye%
      end_if
  end_if
  ' RESTAURER LES FENETRES
  if seg$(1)="FENT"
      pfstyl=0:gosub motif_mur:pfstyl=1
      if open=2
        for j=(pi*2)-k to ((pi*3)/2)-k step -0.01: ' ouvrant gauche
            2d_point xc%-((lg%/2)*cos(j)),yc%-((lg%/2)*sin(j))
        next j:j=j+0.01
        2d_line xc%-((lg%/2)*cos(j)),yc%-((lg%/2)*sin(j)),xc%,yc%
        for j=(pi*2)+k to ((pi*3)/2)+k step -0.01: ' ouvrant droit
            2d_point xe%+((lg%/2)*cos(j)),ye%-((lg%/2)*sin(j))
        next j:j=j+0.01
        2d_line xe%+((lg%/2)*cos(j)),ye%-((lg%/2)*sin(j)),xe%,ye%
      end_if
      if open=3
        for j=pi-k to (pi/2)-k step -0.01: ' ouvrant gauche
            2d_point xa%-((lg%/2)*cos(j)),ya%-((lg%/2)*sin(j))
        next j:j=j+0.01
        2d_line xa%-((lg%/2)*cos(j)),ya%-((lg%/2)*sin(j)),xa%,ya%
        for j=pi+k to (pi/2)+k step -0.01: ' ouvrant droit
            2d_point xb%+((lg%/2)*cos(j)),yb%-((lg%/2)*sin(j))
        next j:j=j+0.01
        2d_line xb%+((lg%/2)*cos(j)),yb%-((lg%/2)*sin(j)),xb%,yb%
      end_if
  end_if
  ' A FAIRE RESTAURER LES COTES  <*******************
  if seg$(1)="COTE"
      xd%=50+val(seg$(2))/(z*2):yd%=50+val(seg$(3))/(z*2):xf%=50+val(seg$(4))/(z*2):yf%=50+val(seg$(5))/(z*2)
      mx=50+val(seg$(7))/(z*2):my=50+val(seg$(8))/(z*2):ha%=val(seg$(6)):dh%=ha%/(z*4)
      lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2)):gosub calcul_points
      2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
      left 300+val(seg$(0)),mx:top 300+val(seg$(0)),my:caption 300+val(seg$(0)),seg$(9):show 300+val(seg$(0))
  end_if
  ' A FAIRE RESTAURER LES TEXTES  <*******************
  if seg$(1)="TXTE"
      xd%=50+val(seg$(2))/(z*2):yd%=50+val(seg$(3))/(z*2)
      font_name 300+val(seg$(0)),"Terminal":font_bold 300+val(seg$(0))
      font_size 300+val(seg$(0)),(6/z)+6:left 300+val(seg$(0)),xd%:top 300+val(seg$(0)),yd%
      caption 300+val(seg$(0)),seg$(4):show 300+val(seg$(0))
  end_if
  ' A FAIRE RESTAURER LES AIRES  <*******************
  if seg$(1)="AIRE"
  end_if
next i
return

' ******************************************************************************

regle:
hide 1
font_name 1,"Fixedsys":2d_target_is 1:2d_fill_color 255,255,255:print_target_is 1
for y=0 to height(1) step 50
  if (int(y/50)=y/50 and y<>0)
      if rg=1
        print_locate 1,y-7:rgy=(int(y/50)*z)-z
        if int(rgy)=rgy then print rgy
      end_if
  end_if
next y
for x=0 to width(1) step 50
  if (int(x/50)=x/50 and x<>0)
      if rg=1
        print_locate x-7,1:rgx=(int(x/50)*z)-z
        if int(rgx)=rgx then print rgx
      end_if
  end_if
next x
show 1
return

grille:
hide 1
2d_target_is 1:2d_pen_width 1
for y=0 to height(1) step 10
  if gr=1
      if int(y/50)<>y/50:2d_pen_color 0,200,200:else:2d_pen_color 0,0,250:end_if
      2d_line 0,y,width(1),y
  end_if
next y
for x=0 to width(1) step 10
  if gr=1
      if int(x/50)<>x/50:2d_pen_color 0,200,200:else:2d_pen_color 0,0,250:end_if
      2d_line x,0,x,height(1)
  end_if
next x
2d_image_copy 211,0,0,width(1),height(1): ' Copie de la grille
show 1
return

form_list:
color 2,180,180,180:width 2,400:height 2,330
left 2,(width(0)/2)+(width(2)/2):top 2,(height(0)/2-height(2)/2)
width 6,300:height 6,100
left 6,(width(2)/2)-(width(6)/2):top 2,(height(2)/2-height(6)/2):return
form_zr:
color 2,0,150,100:width 2,250:height 2,300
left 2,(width(0)/2)-(width(2)/2):top 2,(height(0)/2-height(2)/2):return
form_mpf:
color 2,200,200,200:width 2,400:height 2,330
left 2,(width(0)/2)+(width(2)/2):top 2,(height(0)/2-height(2)/2):return
retourne:
show 2:return

propos:
aide:
return
fin:
terminate
Bonne soirée à tous les habitants de la planète PANORAMIC! Wink
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
JL35



Nombre de messages : 6018
Localisation : 77
Date d'inscription : 29/11/2007

MessageSujet: Re: PLANORAMIC   Jeu 8 Mar 2012 - 1:08

Bonsoir bignono, comme tu vois la planète est déjà un peu endormie, alors on verra tout ça demain !
Bonne nuit à toi !
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jean Claude

avatar

Nombre de messages : 5086
Age : 63
Localisation : 83 Var
Date d'inscription : 07/05/2009

MessageSujet: Re: PLANORAMIC   Ven 9 Mar 2012 - 20:33

Salut,

il y a un problème: j'ai un message d'erreur dans une fenêtre Panoramic => "Espace insuffisant pour traiter cette commande". Crying or Very sad

Y a-t'il un Panoramicien qui a essayé la dernière version de Planoramic ? Et qui aurait le même problème.

A+ Wink
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
JL35



Nombre de messages : 6018
Localisation : 77
Date d'inscription : 29/11/2007

MessageSujet: Re: PLANORAMIC   Ven 9 Mar 2012 - 20:51

Perso je ne remarque rien de particulier...
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jean Claude

avatar

Nombre de messages : 5086
Age : 63
Localisation : 83 Var
Date d'inscription : 07/05/2009

MessageSujet: Re: PLANORAMIC   Ven 9 Mar 2012 - 20:59

Merci JL35 de ta réponse (qui m'inquiète).

Donc le problème serait chez moi, je vais chercher.

A+
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
JL35



Nombre de messages : 6018
Localisation : 77
Date d'inscription : 29/11/2007

MessageSujet: Re: PLANORAMIC   Ven 9 Mar 2012 - 23:00

Tu dois avoir une saturation quelque part... mais alors, pour trouver ça ... scratch
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jean Claude

avatar

Nombre de messages : 5086
Age : 63
Localisation : 83 Var
Date d'inscription : 07/05/2009

MessageSujet: Re: PLANORAMIC   Ven 9 Mar 2012 - 23:29

NAN NAN, moi pas saturé Razz

Mais mon ordi, faut voir.... Razz
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
JL35



Nombre de messages : 6018
Localisation : 77
Date d'inscription : 29/11/2007

MessageSujet: Re: PLANORAMIC   Sam 10 Mar 2012 - 0:15

Je ne t'ai pas dit non plus d'aller voir le docteur Mad
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
bignono

avatar

Nombre de messages : 1104
Age : 60
Localisation : Val de Marne
Date d'inscription : 13/11/2011

MessageSujet: Re: PLANORAMIC   Sam 10 Mar 2012 - 1:22

Bonsoir Amis PANORAMICIENS, Laughing
Jean-Claude, si tu peux me donner des précisions sur l'erreur que tu as déclenchée avec mon programme, je pourrais voir ce qui s'est passé. Me dire par exemple les dernières actions que tu as faites.
Bon entre plusieurs rendez-vous, j'ai continué ma petite programmation de PLANORAMIC!
Alors, on a maintenant le dossier "C:\planoramic" qui se crée automatiquement au lancement du programme si celui-ci n'existe pas, et ceci afin de recevoir des fichiers avec l'extension ".p23". ¨Pourquoi p23? J'en sais rien, au hasard quoi! Comme j'ai codé le menu fichier avec les fonctions "nouveau", "ouvrir", "enregistrer", ben maintenant, on peut garder trace de son précieux shéma, si il n'est pas fini, l'enregistrer et le réouvrir à un autre moment pour continuer à le modifier ou l'étendre. Je trouve que c'est mieux comme ça! N'est-ce-pas?
Bon, le code maintenant (toujours provisoire): cheers
Code:
dim h,i,j,n,q,p : ' réservés indices et boucles
dim x,y,z,gr,rg,rgy,rgx,clic,styl,pfstyl,mclic,v1,v2,v3,v4,v5,va,open
dim xa%,ya%,xb%,yb%,xc%,yc%,xd%,yd%,xe%,ye%,xf%,yf%,xp%,yp%,xv%,yv%
dim lg%,ha%,dh%,a,c,k,pi,nv,mx,my,x1%,y1%,x2%,y2%,axd%,ayd%
dim titre$,num$,tx$,img$,msg$,ligne$(1000),seg$(10),typ$(1000),txt$(1000)
dim dx(1000),dy(1000),fx(1000),fy(1000),ep(1000),hm(1000),op(1000),xm(1000),ym(1000)
' dx(i),dy(i) => xd%,yd% * fx(i),fy(i) => xf%,yf% * ep(i) => ha% * hm(i) => nv
label form_zr,form_mpf,form_list,vc1,vc2,vc3,vc4,s1,s2,s3,s4,s5,s6,s7,s8
label cliquer,init,grille,regle,refait_plan,motif_mur,retourne,saisir,saisir2
label pos_souris,test_spin,calcul_points
label selection,slectext,cherche_seg,fait_ligne,cherche_num
label aerien,visite,photo
label modifmur,modifporte,modifent,modiftext,modifcote,supprime,aire
label mur,porte,fenetre,texte,cote
label annule,refait,copie,zoom
label nouveau,ouvre,enregistre,prefere,fin,propos,aide

if dir_exists ("c:\planoramic") = 0 then dir_make "c:\planoramic"
titre$="*** P L A N O R A M I C ***":caption 0,titre$
full_space 0:hide 0:on_close 0,fin
picture 1:width 1,5000:height 1,5000
form 2:hide 2:on_close 2,retourne
dlist 5

' menu Principal OBJETS RÉSERVÉS DE 10 A 80
main_menu 10
' les sous-menus
sub_menu 11:parent 11,10:caption 11,"Fichier"
sub_menu 12:parent 12,10:caption 12,"Edition"
sub_menu 13:parent 13,10:caption 13,"Plan"
sub_menu 14:parent 14,10:caption 14,"Commandes"
sub_menu 15:parent 15,10:caption 15,"Vues 3D"
sub_menu 16:parent 16,10:caption 16,"A propos"      :on_click 16,propos
sub_menu 17:parent 17,10:caption 17,"Aide"          :on_click 17,aide

' sous-menu Fichier
sub_menu 20:parent 20,11:caption 20,"Nouveau"      :on_click 20,nouveau      :' FAIT
sub_menu 21:parent 21,11:caption 21,"Ouvrir"        :on_click 21,ouvre        :' FAIT
sub_menu 22:parent 22,11:caption 22,"Enregistrer"  :on_click 22,enregistre    :' FAIT
sub_menu 23:parent 23,11:caption 23,"Règlages"      :on_click 23,prefere      :' FAIT en partie (ya un bug!!!)
sub_menu 24:parent 24,11:caption 24,"Quitter"      :on_click 24,fin          :' FAIT
' Réfléchir à la possibilité d'exporter le croquis en jpg, bmp ou pdf

' sous-menu Edition
sub_menu 30:parent 30,12:caption 30,"Annuler"      :on_click 30,annule
sub_menu 31:parent 31,12:caption 31,"Refaire"      :on_click 31,refait
sub_menu 32:parent 32,12:caption 32,"Copier"        :on_click 32,copie
sub_menu 33:parent 33,12:caption 33,"Zoom"          :on_click 33,zoom          :' FAIT

' sous-menu Plan
sub_menu 40:parent 40,13:caption 40,"Créer mur"    :on_click 40,mur          :' FAIT
sub_menu 41:parent 41,13:caption 41,"Créer porte"  :on_click 41,porte        :' FAIT
sub_menu 42:parent 42,13:caption 42,"Créer fenêtre" :on_click 42,fenetre      :' FAIT
sub_menu 43:parent 43,13:caption 43,"Créer texte"  :on_click 43,texte        :' FAIT
sub_menu 44:parent 44,13:caption 44,"Créer cote"    :on_click 44,cote          :' FAIT


' sous-menu Commandes
sub_menu 50:parent 50,14:caption 50,"Modifier mur"    :on_click 50,modifmur    :' FAIT (SAUF BOUTON TEXTURE 3D)
sub_menu 51:parent 51,14:caption 51,"Modifier porte"  :on_click 51,modifporte  :' FAIT (SAUF BOUTON TEXTURE 3D)
sub_menu 52:parent 52,14:caption 52,"Modifier fenêtre":on_click 52,modifent    :' FAIT (SAUF BOUTON TEXTURE 3D)
sub_menu 53:parent 53,14:caption 53,"Modifier texte"  :on_click 53,modiftext  :' FAIT
sub_menu 54:parent 54,14:caption 54,"Modifier cote"  :on_click 54,modifcote  :' FAIT
sub_menu 55:parent 55,14:caption 55,"Supprimer"      :on_click 55,supprime    :' FAIT
' sub_menu 56:parent 56,14:caption 56,"Calculer surface":on_click 56,aire  <=== A VOIR ???

' sous-menu Vues 3D
sub_menu 60:parent 60,15:caption 60,"Vue aérienne"    :on_click 60,aerien
sub_menu 61:parent 61,15:caption 61,"Visite virtuelle" :on_click 61,visite
sub_menu 62:parent 62,15:caption 62,"Prendre une photo":on_click 62,photo

command_target_is 2
list 6:hide 6:width 6,300:height 6,100
left 6,(width(2)/2)-(width(6)/2):top 6,(height(2)/2-height(6)/2)
' Pour ZOOM et RÈGLAGES
option 81:hide 81:left 81,20:top 81, 30:caption 81," 25 %"
option 82:hide 82:left 82,20:top 82, 60:caption 82," 50 %"
option 83:hide 83:left 83,20:top 83, 90:caption 83,"100 %"
option 84:hide 84:left 84,20:top 84,120:caption 84,"200 %"
option 85:hide 85:left 85,20:top 85,150:caption 85,"400 %"
button 86:hide 86:left 86,120:top 86,170:width 86,50:caption 86," OK "
spin 87:hide 87:left 87,5:top 87,5:width 87,50:min 87, 4:max 87,100
spin 88:hide 88:left 88,5:top 88,30:width 88,50:min 88,10:max 88,300
check 89:hide 89:left 89,5:top 89,165:caption 89,"Règles visible"
check 90:hide 90:left 90,5:top 90,190:caption 90,"Grille visible"
option 91:hide 91:width 91,17:left 91,5:top 91,80
picture 92:hide 92:width 92,60:height 92,15:left 92,25:top 92,80
2d_target_is 92:2d_fill_solid:2d_flood 1,1,0,0,0
option 93:hide 93:width 93,17:left 93,95:top 93,80
picture 94:hide 94:width 94,60:height 94,15:left 94,115:top 94,80
2d_target_is 94:2d_fill_diagonal_up:2d_flood 1,1,0,0,0
option 95:hide 95:width 95,17:left 95,5:top 95,100
picture 96:hide 96:width 96,60:height 96,15:left 96,25:top 96,100
2d_target_is 96:2d_fill_diagonal_down:2d_flood 1,1,0,0,0
option 97:hide 97:width 97,17:left 97,95:top 97,100
picture 98:hide 98:width 98,60:height 98,15:left 98,115:top 98,100
2d_target_is 98:2d_fill_diagonal_cross:2d_flood 1,1,0,0,0
option 99:hide 99:width 99,17:left 99,5:top 99,120
picture 100:hide 100:width 100,60:height 100,15:left 100,25:top 100,120
2d_target_is 100:2d_fill_cross:2d_flood 1,1,0,0,0
option 101:hide 101:width 101,17:left 101,95:top 101,120
picture 102:hide 102:width 102,60:height 102,15:left 102,115:top 102,120
' POUR MODIFIER LES MURS, LES PORTES ET LES FENÊTRES
spin 103:hide 103:left 103, 20:top 103,25:min 103,-50:max 103,9900:' spin début mur x
spin 104:hide 104:left 104,220:top 104,25:min 104,-50:max 104,9900:' spin début mur y
spin 105:hide 105:left 105, 20:top 105,75:min 105,-50:max 105,9900:' spin fin mur x
spin 106:hide 106:left 106,220:top 106,75:min 106,-50:max 106,9900:' spin fin mur y
spin 107:hide 107:left 107, 20:top 107,135:min 107,0:max 107,9900:' spin longueur mur
spin 108:hide 108:left 108,220:top 108,135:min 108,10:max 108,300:' spin hauteur mur
spin 109:hide 109:left 109, 20:top 109,195:min 109,4:max 109,100:' spin épaisseur mur
button 110:hide 110:left 110,220:top 110,230:width 110,120:caption 110,"TEXTURE (3D)"
button 111:hide 111:left 111,220:top 111,265:width 111,120:caption 111,"VALIDER"
check 112:hide 112:left 112, 20:top 112,230:caption 112,"INVERSER"
check 113:hide 113:left 113, 20:top 113,250:caption 113,"MIROIR"

for j=151 to 180:alpha j:hide j:next j

left 151,45 :top 151,60 :caption 151,"  Style des murs  "
left 152,60 :top 152,10 :caption 152," cm. Épaisseur des murs "
left 153,60 :top 153,35 :caption 153," cm.  Hauteur  des murs "
left 154,7  :top 154,10 :caption 154,"DÉBUTE À:"
left 155,7  :top 155,30 :caption 155,"X"
left 156,145:top 156,30 :caption 156,"cm"
left 157,207:top 157,30 :caption 157,"Y"
left 158,345:top 158,30 :caption 158,"cm"
left 159,7  :top 159,60 :caption 159,"TERMINE À:"
left 160,7  :top 160,80 :caption 160,"X"
left 161,145:top 161,80 :caption 161,"cm"
left 162,207:top 162,80 :caption 162,"Y"
left 163,345:top 163,80 :caption 163,"cm"
left 164,20 :top 164,120
left 165,145:top 165,140:caption 165,"cm"
left 166,220:top 166,120:caption 166,"HAUTEUR"
left 167,345:top 167,140:caption 167,"cm"
left 168,20 :top 168,180:caption 168,"ÉPAISSEUR"
left 169,145:top 169,200:caption 169,"cm"

command_target_is 0
for j=300 to 1300:alpha j:hide j:next j

image 210: ' image ecran lors du traçage
image 211: ' image de la grille seule
image 212: ' image effaçant données porte et fenêtre
image 213: ' image du picture vierge
2d_image_copy 213,0,0,width(1),height(1)
gosub init

end

' ******************************************************************************
init:
show 0:2d_target_is 1:cls
pi=4*atn(1):ha%=20:gr=1:rg=1:z=1:open=2
dh%=ha%/(z*4):nv=250:styl=2:pfstyl=1
gosub grille:gosub regle
return

cliquer:
wait 120:' <=== Valeur à ajuster (j'obtiens de bon résultats entre 100 et 200)
if scancode=1 then clic=clic+1
if scancode=1 then clic=clic+1
if clic=1 then mclic=1
if clic=2 then mclic=2
clic=0
return
' ******************************************************************************

pos_souris:
2d_fill_solid:2d_fill_color 255,255,100
print_locate xp%-20,yp%-30:print "x=";str$((xp%-50)*(z*2));" y=";str$((yp%-50)*(z*2))
wait 200
return

mur:
for j=11 to 17:inactive j:next j:2d_target_is 1
2d_image_copy 210,0,0,width(1),height(1)
cursor_cross 1
print_target_is 1
repeat
  xd%=mouse_x_position(1):yd%=mouse_y_position(1):xf%=xd%:yf%=yd%
  if xd%<>xp% or yd%<>yp%
      2d_image_paste 210,0,0
      xp%=xd%:yp%=yd%:gosub pos_souris
  end_if
until (mouse_left_down(1)=1 and mouse_left_up(1)=0)
2d_image_paste 210,0,0:2d_image_copy 210,0,0,width(1),height(1)
2d_pen_color 0,0,0:2d_pen_width 2
while mouse_left_up(1)=0
  xf%=mouse_x_position(1):yf%=mouse_y_position(1)
  if scancode=162 or scancode=163 then yf%=yd%
  if scancode=160 or scancode=161 then xf%=xd%
  lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
  if xf%<>xv% or yf%<>yv%
      2d_image_paste 210,0,0:gosub calcul_points
      2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
      xv%=xf%:yv%=yf%:xp%=xf%:yp%=yf%
      print_locate xp%-20,yp%-60:print "Angle: ";str$(wrap_value(a));"°";" Épaisseur= ";str$(ha%/100);"m"
      print_locate xp%-20,yp%-45:print "Longueur= ";str$((int(lg%)/100)*(z*2));"m"
      gosub pos_souris:wait 100
  end_if
end_while
2d_image_paste 210,0,0:lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
if lg%<>0
  gosub motif_mur:gosub cherche_num:typ$(i)="MURS"
  dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
  ep(i)=ha%:hm(i)=nv:op(i)=0:gosub fait_ligne:item_add 5,ligne$(i)
end_if
cursor_arrow 1
for j=11 to 17:active j:next j:c=1
return

calcul_points:
      if xf%>xd%
        k=atn((yd%-yf%)/(xf%-xd%)):a=k*180/pi:a=int(a*100)/100
      end_if
      if xf%<xd%
        k=atn((yd%-yf%)/(xf%-xd%)):a=k*180/pi:a=int(a*100)/100:a=180+a:k=k+3.14
      end_if
      if xd%=xf%
        if yf%<yd% then a=90:k=1.57
        if yf%>yd% then a=270:k=4.71
      end_if
      xa%=xd%-dh%*sin(k):ya%=yd%-dh%*cos(k): ' point A
      xe%=xd%+dh%*sin(k):ye%=yd%+dh%*cos(k): ' point E
      xc%=xe%+lg%*cos(k):yc%=ye%-lg%*sin(k): ' point C
      xb%=xa%+lg%*cos(k):yb%=ya%-lg%*sin(k): ' point B
return
motif_mur:
' Nettoyage
  2d_pen_color 255,255,255:2d_pen_width 2
  for j=-1*dh% to dh%
      x1%=xd%-j*sin(k):y1%=yd%-j*cos(k)
      x2%=x1%+lg%*cos(k):y2%=y1%-lg%*sin(k)
      2d_line x1%,y1%,x2%,y2%
  next j
  2d_pen_color 0,0,0
  2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
  if (styl<>0 and pfstyl<>0)
      mx=(xd%+xf%)/2:my=(yd%+yf%)/2
      if styl=1 then 2d_fill_solid
      if styl=2 then 2d_fill_diagonal_up
      if styl=3 then 2d_fill_diagonal_down
      if styl=4 then 2d_fill_diagonal_cross
      if styl=5 then 2d_fill_cross
      2d_flood mx,my,0,0,0
  end_if
return

porte:
for j=11 to 17:inactive j:next j:2d_target_is 1
2d_image_copy 210,0,0,width(1),height(1)
repeat
      axd%=mouse_x_position(1):ayd%=mouse_y_position(1)
  if axd%<>xv% or ayd%<>yv%
      2d_image_paste 210,0,0
      if (scancode>=160 and scancode<=163)
        xf%=mouse_x_position(1):yf%=mouse_y_position(1)
      else
        xd%=axd%:yd%=ayd%:xf%=xd%+40:yf%=yd%
      end_if
      lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
      gosub calcul_points:2d_pen_color 0,0,0:2d_pen_width 2
      2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
      ' Tracé ouvrant gauche sud par défaut
      for j=(pi*2)-k to ((pi*3)/2)-k step -0.01
        2d_point xc%-(lg%*cos(j)),yc%-(lg%*sin(j))
      next j:j=j+0.01
      2d_line xc%-(lg%*cos(j)),yc%-(lg%*sin(j)),xc%,yc%:xv%=axd%:yv%=ayd%:wait 100
      2d_image_copy 212,0,0,width(1),height(1):xp%=xf%:yp%=yf%
      print_locate xp%-20,yp%-60:print "Angle: ";str$(wrap_value(a));"°"
      print_locate xp%-20,yp%-45:print "Largeur= ";str$((int(lg%)/100)*(z*2));"m"
      gosub pos_souris
  end_if
until mouse_left_down(1)=1
2d_image_paste 212,0,0
pfstyl=0:gosub motif_mur:pfstyl=1:gosub cherche_num:typ$(i)="PORT"
  dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
  ep(i)=ha%:hm(i)=210:op(i)=2:gosub fait_ligne:item_add 5,ligne$(i)
2d_image_copy 210,0,0,width(1),height(1)
for j=11 to 17:active j:next j:c=3
return

fenetre:
for j=11 to 17:inactive j:next j:2d_target_is 1
2d_image_copy 210,0,0,width(1),height(1)
repeat
      axd%=mouse_x_position(1):ayd%=mouse_y_position(1)
  if axd%<>xv% or ayd%<>yv%
      2d_image_paste 210,0,0
      if (scancode>=160 and scancode<=163)
        xf%=mouse_x_position(1):yf%=mouse_y_position(1)
      else
        xd%=axd%:yd%=ayd%:xf%=xd%+80:yf%=yd%
      end_if
      lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
      gosub calcul_points:2d_pen_color 0,0,0:2d_pen_width 2
      2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
      for j=(pi*2)-k to ((pi*3)/2)-k step -0.01: ' ouvrant gauche orienté sud par défaut
        2d_point xc%-((lg%/2)*cos(j)),yc%-((lg%/2)*sin(j))
      next j:j=j+0.01
      2d_line xc%-((lg%/2)*cos(j)),yc%-((lg%/2)*sin(j)),xc%,yc%:xv%=axd%:yv%=ayd%
      for j=(pi*2)+k to ((pi*3)/2)+k step -0.01: ' ouvrant droit orienté sud par défaut
        2d_point xe%+((lg%/2)*cos(j)),ye%-((lg%/2)*sin(j))
      next j:j=j+0.01
      2d_line xe%+((lg%/2)*cos(j)),ye%-((lg%/2)*sin(j)),xe%,ye%:wait 100
      2d_image_copy 212,0,0,width(1),height(1):xp%=xf%:yp%=yf%
      print_locate xp%-20,yp%-60:print "Angle: ";str$(wrap_value(a));"°"
      print_locate xp%-20,yp%-45:print "Largeur= ";str$((int(lg%)/100)*(z*2));"m"
      gosub pos_souris
  end_if
until mouse_left_down(1)=1
2d_image_paste 212,0,0
pfstyl=0:gosub motif_mur:pfstyl=1:gosub cherche_num:typ$(i)="FENT"
  dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
  ep(i)=ha%:hm(i)=120:op(i)=2:gosub fait_ligne:item_add 5,ligne$(i)
2d_image_copy 210,0,0,width(1),height(1)
for j=11 to 17:active j:next j:c=5
return

texte:
for j=11 to 17:inactive j:next j:2d_target_is 1
2d_image_copy 210,0,0,width(1),height(1)
cursor_cross 1
print_target_is 1
repeat
  xd%=mouse_x_position(1):yd%=mouse_y_position(1)
  if xd%<>xp% or yd%<>yp%
      2d_image_paste 210,0,0
      xp%=xd%:yp%=yd%:gosub pos_souris
  end_if
until (mouse_left_down(1)=1 and mouse_left_up(1)=0)
2d_image_paste 210,0,0:2d_image_copy 210,0,0,width(1),height(1)

saisir:
  tx$=message_input$("PLANORAMIC", "Entrez un nom (20 caractères maxi)" , "")
  if len(tx$)>20 then goto saisir
  if tx$="" then goto s8
gosub cherche_num:typ$(i)="TXTE":txt$(i)=tx$
font_name 300+i,"Terminal":font_bold 300+i:font_size 300+i,(6/z)+6
left 300+i,xd%:top 300+i,yd%:caption 300+i,txt$(i):show 300+i
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2)
gosub fait_ligne:item_add 5,ligne$(i)
s8:
2d_image_copy 210,0,0,width(1),height(1)
cursor_arrow 1
for j=11 to 17:active j:next j:c=7
return

cote:
for j=11 to 17:inactive j:next j:2d_target_is 1
2d_image_copy 210,0,0,width(1),height(1)
cursor_cross 1
print_target_is 1
repeat
  xd%=mouse_x_position(1):yd%=mouse_y_position(1):xf%=xd%:yf%=yd%
  if xd%<>xp% or yd%<>yp%
      2d_image_paste 210,0,0
      xp%=xd%:yp%=yd%:gosub pos_souris
  end_if
until (mouse_left_down(1)=1 and mouse_left_up(1)=0)
2d_image_paste 210,0,0:2d_image_copy 210,0,0,width(1),height(1)
2d_pen_color 0,0,0:2d_pen_width 2
while mouse_left_up(1)=0
  xf%=mouse_x_position(1):yf%=mouse_y_position(1)
  if scancode=162 or scancode=163 then yf%=yd%
  if scancode=160 or scancode=161 then xf%=xd%
  lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
  if xf%<>xv% or yf%<>yv%
      2d_image_paste 210,0,0:gosub calcul_points
      2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
      xv%=xf%:yv%=yf%:xp%=xf%:yp%=yf%
      print_locate xp%-20,yp%-45:print "Longueur= ";str$((int(lg%)/100)*(z*2));"m"
      gosub pos_souris:wait 100
  end_if
end_while
2d_image_paste 210,0,0:lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
if lg%<>0
  2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
  mx=(xd%+xf%)/2:my=(yd%+yf%)/2
  gosub cherche_num:typ$(i)="COTE":txt$(i)=str$((int(lg%)/100)*(z*2))+"m"
  left 300+i,mx:top 300+i,my:caption 300+i,txt$(i):show 300+i
  dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
  ep(i)=ha%:xm(i)=(mx-50)*(z*2):ym(i)=(my-50)*(z*2)
  gosub fait_ligne:item_add 5,ligne$(i)
end_if
cursor_arrow 1
for j=11 to 17:active j:next j:c=9
return

selection:
  if j>0
      if seg$(1)="COTE"
        2d_pen_color 0,0,0
        2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
      else
        2d_pen_color 0,0,0
        2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
      end_if
  end_if
  i=val(left$(item_read$(6,item_index(6)),3)):gosub cherche_seg
  ligne$(i)="":for q=0 to n-1:ligne$(i)=ligne$(i)+seg$(q)+"*":next q
  xd%=50+val(seg$(2))/(z*2):yd%=50+val(seg$(3))/(z*2)
  xf%=50+val(seg$(4))/(z*2):yf%=50+val(seg$(5))/(z*2)
  ha%=val(seg$(6)):nv=val(seg$(7)):dh%=ha%/(z*4)
  lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2)):gosub calcul_points
  if seg$(1)="COTE"
      2d_pen_color 200,0,0
      2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
  else
      2d_pen_color 200,0,0
      2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
  end_if
  mclic=0:j=i
return

modifmur:
for j=11 to 17:inactive j:next j
caption 2,"LISTE DES MURS":gosub form_list:j=0
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="MURS" then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s1
show 2:print_target_is 2:font_bold 2
j=0:show 6:on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
if mclic=1 then gosub selection
end_while
gosub selection
hide 6:off_click 6:clear 6

caption 2,"MODIFIER MUR":gosub form_mpf
for h=103 to 111:show h:next h:for h=154 to 169:show h:next h
caption 164,"LONGUEUR"
position 103,val(seg$(2)):position 104,val(seg$(3))
position 105,val(seg$(4)):position 106,val(seg$(5))
position 107,sqr(power(val(seg$(4))-val(seg$(2)),2)+power(val(seg$(3))-val(seg$(5)),2))
position 108,val(seg$(7)) :position 109,val(seg$(6))

while clicked(111)=0
  if clicked(1)=1 then to_foreground 2
  gosub test_spin
  if position(103)<>v1 or position(104)<>v2 then gosub vc1
  if position(105)<>v3 or position(106)<>v4 then gosub vc2
  if position(107)<>v5 then gosub vc3
  gosub vc4
end_while

xd%=50+position(103)/(z*2):yd%=50+position(104)/(z*2)
xf%=50+position(105)/(z*2):yf%=50+position(106)/(z*2)
ha%=position(109):nv=position(108):dh%=ha%/(z*4)
' refaire ligne$(i)
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
ep(i)=ha%:hm(i)=nv:op(i)=0:typ$(i)="MURS"
gosub fait_ligne:item_delete 5,i:item_insert 5,i,ligne$(i)
2d_target_is 2:for h=103 to 111:hide h:next h:for h=154 to 169:hide h:next h:hide 2
' refaire le plan
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle
gosub refait_plan
s1:
for j=11 to 17:active j:next j:c=2
return

modifporte:
for j=11 to 17:inactive j:next j
caption 2,"LISTE DES PORTES":gosub form_list:j=0
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="PORT" then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s2
show 2:print_target_is 2:font_bold 2
j=0:show 6:on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
  if mclic=1 then gosub selection
end_while
gosub selection
hide 6:off_click 6:clear 6

caption 2,"MODIFIER PORTE":gosub form_mpf
show 2:print_target_is 2:font_bold 2
for h=103 to 113:show h:next h:for h=154 to 167:show h:next h
caption 164,"LARGEUR"
dx(i)=val(seg$(2)):dy(i)=val(seg$(3)):fx(i)=val(seg$(4)):fy(i)=val(seg$(5))
hm(i)=val(seg$(7)):v1=dx(i):v2=dy(i):v3=fx(i):v4=fy(i)
v5=sqr(power(fx(i)-dx(i),2)+power(dy(i)-fy(i),2))

 position 103,dx(i):position 104,dy(i)
 position 105,fx(i):position 106,fy(i)
 position 107,sqr(power(fx(i)-dx(i),2)+power(dy(i)-fy(i),2))
 position 108,hm(i)

while clicked(111)=0
  if clicked(1)=1 then to_foreground 2
  gosub test_spin
  if position(103)<>v1 or position(104)<>v2 then gosub vc1
  if position(105)<>v3 or position(106)<>v4 then gosub vc2
  if position(107)<>v5 then gosub vc3
  gosub vc4
  if (checked(112)=0 and checked(113)=0) then open=2
  if (checked(112)=1 and checked(113)=0) then open=3
  if (checked(112)=0 and checked(113)=1) then open=4
  if (checked(112)=1 and checked(113)=1) then open=5
end_while

xd%=50+position(103)/(z*2):yd%=50+position(104)/(z*2)
xf%=50+position(105)/(z*2):yf%=50+position(106)/(z*2)
nv=position(108):dh%=ha%/(z*4)
' refaire ligne$(i)
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
ep(i)=ha%:hm(i)=nv:op(i)=open:typ$(i)="PORT"
gosub fait_ligne:item_delete 5,i:item_insert 5,i,ligne$(i)
2d_target_is 2:for h=103 to 113:hide h:next h:for h=154 to 167:hide h:next h:hide 2
' refaire le plan
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle
gosub refait_plan
s2:
for j=11 to 17:active j:next j:c=4
return

vc1:
  position 107,sqr(power(position(105)-position(103),2)+power(position(104)-position(106),2))
  v1=position(103):v2=position(104):v5=position(107)
return
vc2:
  position 107,sqr(power(position(105)-position(103),2)+power(position(104)-position(106),2))
  v3=position(105):v4=position(106):v5=position(107)
return
vc3:
  position 105,position(103)+position(107)*cos(a)
  position 106,position(104)-position(107)*sin(a)
  position 107,sqr(power(position(105)-position(103),2)+power(position(104)-position(106),2))
  v3=position(105):v4=position(106):v5=position(107)
return
vc4:
  if position(105)<>position(103)
      va=(atn((position(106)-position(104))/(position(105)-position(103)))*180)/pi:va=int(va*100)/100
  end_if
  if position(103)=position(105)
      if position(106)<position(104) then va=90
      if position(106)>position(104) then va=270
  end_if
  print_locate 220,200:print "ANGLE : "; wrap_value(va); "°        "
return

modifent:
for j=11 to 17:inactive j:next j
caption 2,"LISTE DES FENÊTRES":gosub form_list:j=0
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="FENT" then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s3
show 2:print_target_is 2:font_bold 2
j=0:show 6:on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
  if mclic=1 then gosub selection
end_while
gosub selection
hide 6:off_click 6:clear 6

caption 2,"MODIFIER FENÊTRE":gosub form_mpf
show 2:print_target_is 2:font_bold 2
for h=103 to 112:show h:next h:for h=154 to 167:show h:next h
caption 164,"LARGEUR"
dx(i)=val(seg$(2)):dy(i)=val(seg$(3)):fx(i)=val(seg$(4)):fy(i)=val(seg$(5))
hm(i)=val(seg$(7)):v1=dx(i):v2=dy(i):v3=fx(i):v4=fy(i)
v5=sqr(power(fx(i)-dx(i),2)+power(dy(i)-fy(i),2))

 position 103,dx(i):position 104,dy(i)
 position 105,fx(i):position 106,fy(i)
 position 107,sqr(power(fx(i)-dx(i),2)+power(dy(i)-fy(i),2))
 position 108,hm(i)

while clicked(111)=0
  if clicked(1)=1 then to_foreground 2
  gosub test_spin
  if position(103)<>v1 or position(104)<>v2 then gosub vc1
  if position(105)<>v3 or position(106)<>v4 then gosub vc2
  if position(107)<>v5 then gosub vc3
  gosub vc4
  if checked(112)=0 then open=2
  if checked(112)=1 then open=3
end_while

xd%=50+position(103)/(z*2):yd%=50+position(104)/(z*2)
xf%=50+position(105)/(z*2):yf%=50+position(106)/(z*2)
nv=position(108):dh%=ha%/(z*4)
' refaire ligne$(i)
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
ep(i)=ha%:hm(i)=nv:op(i)=open:typ$(i)="FENT"
gosub fait_ligne:item_delete 5,i:item_insert 5,i,ligne$(i)
2d_target_is 2:for h=103 to 112:hide h:next h:for h=154 to 167:hide h:next h:hide 2
' refaire le plan
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle
gosub refait_plan
s3:
for j=11 to 17:active j:next j:c=6
return

modiftext:
for j=11 to 17:inactive j:next j
caption 2,"LISTE DES TEXTES":gosub form_list:j=0
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="TXTE" then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s5
show 2:print_target_is 2:font_bold 2
j=0:show 6:on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
if mclic=1 then gosub slectext
end_while
gosub slectext
hide 6:off_click 6:clear 6:hide 2

saisir2:
  tx$=message_input$("PLANORAMIC", "Entrez un nom (20 caractères maxi)" , "")
  if len(tx$)>20 then goto saisir2
  if len(tx$)=0 then tx$=txt$(i)
typ$(i)="TXTE":txt$(i)=tx$
font_name 300+i,"Terminal":font_bold 300+i:font_size 300+i,(6/z)+6
color 300+i,240,240,240:left 300+i,xd%:top 300+i,yd%:caption 300+i,txt$(i):show 300+i
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2)
gosub fait_ligne:item_delete 5,i:item_insert 5,i,ligne$(i)
s5:
for j=11 to 17:active j:next j:c=8
return

slectext:
  color 300+i,240,240,240
  i=val(left$(item_read$(6,item_index(6)),3)):gosub cherche_seg
  ligne$(i)="":for q=0 to n-1:ligne$(i)=ligne$(i)+seg$(q)+"*":next q
  xd%=50+val(seg$(2))/(z*2):yd%=50+val(seg$(3))/(z*2)
  txt$(i)=seg$(4)
  color 300+i,255,0,0
  mclic=0:j=i
return

modifcote:
for j=11 to 17:inactive j:next j
caption 2,"LISTE DES COTES":gosub form_list:j=0
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="COTE" then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s4
show 2:print_target_is 2:font_bold 2
j=0:show 6:on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
if mclic=1 then gosub selection
end_while
gosub selection
hide 6:off_click 6:clear 6

caption 2,"MODIFIER COTE":gosub form_mpf
for h=103 to 107:show h:next h:for h=154 to 164:show h:next h:show 111
caption 164,"LONGUEUR"

position 103,val(seg$(2)):position 104,val(seg$(3))
position 105,val(seg$(4)):position 106,val(seg$(5))
position 107,sqr(power(val(seg$(4))-val(seg$(2)),2)+power(val(seg$(3))-val(seg$(5)),2))

while clicked(111)=0
  if clicked(1)=1 then to_foreground 2
  gosub test_spin
  if position(103)<>v1 or position(104)<>v2 then gosub vc1
  if position(105)<>v3 or position(106)<>v4 then gosub vc2
  if position(107)<>v5 then gosub vc3
end_while

xd%=50+position(103)/(z*2):yd%=50+position(104)/(z*2)
xf%=50+position(105)/(z*2):yf%=50+position(106)/(z*2)
mx=(xd%+xf%)/2:my=(yd%+yf%)/2
lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))

' refaire ligne$(i)
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
ep(i)=ha%:xm(i)=(mx-50)*(z*2):ym(i)=(my-50)*(z*2):txt$(i)=str$((int(lg%)/100)*(z*2))+"m"
typ$(i)="COTE":gosub fait_ligne:item_delete 5,i:item_insert 5,i,ligne$(i)
2d_target_is 2:for h=103 to 112:hide h:next h:for h=154 to 167:hide h:next h:hide 2

' refaire le plan
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle
gosub refait_plan
s4:
for j=11 to 17:active j:next j:c=10
return

supprime:
for j=11 to 17:inactive j:next j:caption 111,"ANNULER":show 111
caption 2,"LISTE DES OBJETS":gosub form_list:j=0
for i=1 to count(5)
  if len(ligne$(i))>0 then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s6
show 2:print_target_is 2:font_bold 2
j=0:show 6
s7:
on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
  if clicked(111)=1 then off_click 6:hide 6:clear 6:hide 2:goto s6
end_while
off_click 6
i=val(left$(item_read$(6,item_index(6)),3))
if mid$(ligne$(i),5,4)="TXTE" : gosub slectext : else : gosub selection : end_if
j=message_warning_yes_no("SUPPRIMER?")
if j=0 or j=2
if mid$(ligne$(i),5,4)="TXTE" then color 300+i,240,240,240
if mid$(ligne$(i),5,4)="COTE" then 2d_pen_color 0,0,0:2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
if mid$(ligne$(i),5,4)="MURS" or mid$(ligne$(i),5,4)="PORT" or mid$(ligne$(i),5,4)="FENT"
  2d_pen_color 0,0,0:2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
end_if
goto s7
end_if
hide 6:clear 6:hide 2
if mid$(ligne$(i),5,4)="TXTE" then color 300+i,240,240,240:hide 300+i
if mid$(ligne$(i),5,4)="COTE" then hide 300+i
ligne$(i)="":item_delete 5,i:item_insert 5,i,ligne$(i)
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle
gosub refait_plan
s6:
caption 111,"VALIDER":hide 111:for j=11 to 17:active j:next j:c=20
return

aire:
return

aerien:
visite:
photo:
return

' Recherche des segments
cherche_seg:
for p=0 to 10:seg$(p)="":next p: ' purger les segments
n=0:q=instr(ligne$(i),"*"): ' on cherche la première occurence du séparateur
while q>0: ' tant qu'il y a un séparateur, faire:
    seg$(n)=left$(ligne$(i),q-1): ' mémoriser le premier segment
    ligne$(i)=mid$(ligne$(i),q+1,len(ligne$(i)))
    n=n+1: ' éliminer ce segment et son séparateur
    q=instr(ligne$(i),"*"): ' chercher un nouveau séparateur
end_while
return

' routine de recherche d'un numéro d'objet 3d disponible
cherche_num:
p=1
while len(ligne$(p))>4:p=p+1:end_while
if p>999 then message "Vous avez atteint la limite!"+chr$(10)+chr$(13)+"Vous ne pouvez plus rien créer!":p=p-1
i=p
return

fait_ligne:
num$=str$(i)
if len(num$)=1 then num$="  "+num$
if len(num$)=2 then num$=" "+num$
ligne$(i)=num$+"*"+typ$(i)+"*": ' objet n°,type d'objet
if typ$(i)="MURS" or typ$(i)="PORT" or typ$(i)="FENT"
  ligne$(i)=ligne$(i)+str$(dx(i))+"*"+str$(dy(i))+"*"
  ligne$(i)=ligne$(i)+str$(fx(i))+"*"+str$(fy(i))+"*"
  ligne$(i)=ligne$(i)+str$(ep(i))+"*"+str$(hm(i))+"*"+str$(op(i))+"*"
end_if
if typ$(i)="COTE"
  ligne$(i)=ligne$(i)+str$(dx(i))+"*"+str$(dy(i))+"*"
  ligne$(i)=ligne$(i)+str$(fx(i))+"*"+str$(fy(i))+"*"+str$(ep(i))+"*"
  ligne$(i)=ligne$(i)+str$(xm(i))+"*"+str$(ym(i))+"*"+txt$(i)+"*"
end_if
if typ$(i)="TXTE"
  ligne$(i)=ligne$(i)+str$(dx(i))+"*"+str$(dy(i))+"*"+txt$(i)+"*"
end_if
if typ$(i)="AIRE"
end_if
return

annule:
' CAS 1
' si c'est une création de mur ou de porte ou de fenêtre ou de texte ou de cote
' il faut trouver ligne$(i) concerné et passer par ma routine supprime -> la valeur de "c" est impaire
' CAS 2
' si c'est une modif de mur ou de porte ou de fenêtre ou de texte ou de cote
' il faut restituer l'état précédent la modif. -> la valeur de "c" est paire
return

refait:
copie:
return

zoom:
caption 2,"ZOOM":gosub form_zr:show 2:for h=81 to 86:show h:next h
if z=0.25 then set_focus 85:' 400%
if z=0.5 then set_focus 84: ' 200%
if z=1 then set_focus 83:  ' 100%
if z=2 then set_focus 82:  '  50%
if z=4 then set_focus 81:  '  25%
while clicked(86)=0
      if clicked(1)=1 then to_foreground 2
  if checked(81)=1 then z=4:  '  25%
  if checked(82)=1 then z=2:  '  50%
  if checked(83)=1 then z=1:  ' 100%
  if checked(84)=1 then z=0.5: ' 200%
  if checked(85)=1 then z=0.25:' 400%
end_while
for h=81 to 86:hide h:next h:hide 2
2d_target_is 1:2d_image_paste 211,0,0:gosub regle:dh%=ha%/(z*4)
gosub refait_plan
return

nouveau:
if c>0
  a=message_warning_yes_no("VOULEZ-VOUS ENREGISTRER LES MODIFICATIONS?")
      if a=0 then return
      if a=1 then gosub enregistre
end_if
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="TXTE" or mid$(ligne$(i),5,4)="COTE" then delete 300+i:alpha 300+i:hide 300+i
  ligne$(i)=""
next i:clear 5
for i=0 to 10:seg$(i)="":next i:gosub init
gosub init:caption 0,titre$
return

ouvre:
if count(5)>1
  msg$="ATTENTION, vous avez un fichier déjà ouvert!"+chr$(10)+chr$(13)
  msg$=msg$+"Si vous continuez ses données seront perdues"+chr$(10)+chr$(13)
  msg$=msg$+"Continuer quand-même?"
  a=message_warning_yes_no(msg$)
  if a<>1 then return
end_if
' initialisation
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="TXTE" or mid$(ligne$(i),5,4)="COTE" then delete 300+i:alpha 300+i:hide 300+i
  ligne$(i)=""
next i:clear 5
for i=0 to 10:seg$(i)="":next i:gosub init
' recherche du fichier à ouvrir
open_dialog 117
dir_dialog 117,"c:\planoramic"
filter 117,"Fichier PLANORAMIC  -  *.p23|*.p23"
img$=file_name$(117)
delete 117
if img$<>"_"
  i=1:clear 5
  file_open_read 118,img$
  while file_eof(118)<>1
      file_readln 118,ligne$(i)
      item_add 5,ligne$(i):i=i+1
  end_while
  file_close 118
  gosub refait_plan
  c=0:caption 0,"P L A N O R A M I C ==> "+img$
end_if
return

enregistre:
save_dialog 115
dir_dialog 115,"c:\PLANORAMIC"
filter 115,"Fichier PLANORAMIC|*.p23"
img$=file_name$(115)
if right$(img$,4)<>".p23" then img$=img$+".p23"
delete 115
if img$="_.p23" then return
if file_exists(img$)=1
  msg$="Le fichier "+img$+" existe déjà dans le répertoire!"+chr$(10)+chr$(13)+"    Désirez-vous le remplacer?"
  a=message_warning_yes_no(msg$)
  if a=1
      file_read_only_off img$:file_delete img$
  else
  img$="_"
  end_if
end_if
if img$<>"_"
  file_open_write 116,img$
  for i=1 to count(5)
      file_writeln 116,ligne$(i)
  next i
  file_close 116
  c=0:caption 0,"P L A N O R A M I C ==> "+img$
end_if
return

' routine de test de non dépassement des valeurs min et max si un chiffre est rentré manuellement dans un spin
test_spin:
 if position(87)>100 then position 87,100
 if position(88)>300 then position 88,300
 if position(103)>9900 then position 103,9900
 if position(104)>9900 then position 104,9900
 if position(105)>9900 then position 105,9900
 if position(106)>9900 then position 106,9900
 if position(108)>300 then position 108,300
 if position(109)>100 then position 109,100
 if position(87)<4 then position 87,4
 if position(88)<10 then position 88,10
 if position(103)<-50 then position 103,-50
 if position(104)<-50 then position 104,-50
 if position(105)<-50 then position 105,-50
 if position(106)<-50 then position 106,-50
 if position(108)<10 then position 108,10
 if position(109)<4 then position 109,4
return

prefere:
caption 2,"REGLAGES":gosub form_zr:show 2:for h=86 to 102:show h:next h
2d_target_is 2:2d_fill_color 255,255,255:print_target_is 2
for h=151 to 153:show h:next h
if rg=1 then mark_on 89
if rg<>1 then mark_off 89
if gr=1 then mark_on 90
if gr<>1 then mark_off 90
if styl=0 then mark_on 101
if styl=1 then mark_on 91
if styl=2 then mark_on 93
if styl=3 then mark_on 95
if styl=4 then mark_on 97
if styl=5 then mark_on 99
position 87,ha%:position 88,nv
while clicked(86)=0
      if clicked(1)=1 then to_foreground 2
  if checked(91)=1 then styl=1
  if checked(93)=1 then styl=2
  if checked(95)=1 then styl=3
  if checked(97)=1 then styl=4
  if checked(99)=1 then styl=5
  if checked(101)=1 then styl=0
  if checked(89)=1 then rg=1
  if checked(89)=0 then rg=0
  if checked(90)=1 then gr=1
  if checked(90)=0 then gr=0
  gosub test_spin
end_while
ha%=position(87):nv=position(88):dh%=ha%/(z*4)
for h=86 to 102:hide h:next h:for h= 151 to 153:hide h:next h:hide 2
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle

refait_plan:
2d_pen_color 0,0,0
for i=1 to count(5)
  gosub cherche_seg
  ligne$(i)="":for q=0 to n-1:ligne$(i) = ligne$(i) + seg$(q)+"*":next q:' reconstitue ligne$(i)
  if ligne$(i)="*" then ligne$(i)=""
  ' RESTAURER LES MURS    <*******************
  if seg$(1)="MURS" or seg$(1)="PORT" or seg$(1)="FENT"
      xd%=50+val(seg$(2))/(z*2):yd%=50+val(seg$(3))/(z*2):xf%=50+val(seg$(4))/(z*2):yf%=50+val(seg$(5))/(z*2)
      ha%=val(seg$(6)):nv=val(seg$(7)):dh%=ha%/(z*4):open=val(seg$(8))
      lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2)):gosub calcul_points
      2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
  end_if
  if seg$(1)="MURS" then gosub motif_mur
  ' RESTAURER LES PORTES
  if seg$(1)="PORT"
      pfstyl=0:gosub motif_mur:pfstyl=1
      ' Tracé ouvrant gauche sud
      if open=2
        for j=(pi*2)-k to ((pi*3)/2)-k step -0.01
            2d_point xc%-(lg%*cos(j)),yc%-(lg%*sin(j))
        next j:j=j+0.01
        2d_line xc%-(lg%*cos(j)),yc%-(lg%*sin(j)),xc%,yc%
      end_if
      ' Tracé ouvrant gauche nord
      if open=3
        for j=pi-k to (pi/2)-k step -0.01
            2d_point xa%-(lg%*cos(j)),ya%-(lg%*sin(j))
        next j:j=j+0.01
        2d_line xa%-(lg%*cos(j)),ya%-(lg%*sin(j)),xa%,ya%
      end_if
      ' Tracé ouvrant droit nord
      if open=4
        for j=pi+k to (pi/2)+k step -0.01
            2d_point xb%+(lg%*cos(j)),yb%-(lg%*sin(j))
        next j:j=j+0.01
        2d_line xb%+(lg%*cos(j)),yb%-(lg%*sin(j)),xb%,yb%
      end_if
      ' Tracé ouvrant droit sud
      if open=5
        for j=(pi*2)+k to ((pi*3)/2)+k step -0.01
            2d_point xe%+(lg%*cos(j)),ye%-(lg%*sin(j))
        next j:j=j+0.01:2d_line xe%+(lg%*cos(j)),ye%-(lg%*sin(j)),xe%,ye%
      end_if
  end_if
  ' RESTAURER LES FENETRES
  if seg$(1)="FENT"
      pfstyl=0:gosub motif_mur:pfstyl=1
      if open=2
        for j=(pi*2)-k to ((pi*3)/2)-k step -0.01: ' ouvrant gauche
            2d_point xc%-((lg%/2)*cos(j)),yc%-((lg%/2)*sin(j))
        next j:j=j+0.01
        2d_line xc%-((lg%/2)*cos(j)),yc%-((lg%/2)*sin(j)),xc%,yc%
        for j=(pi*2)+k to ((pi*3)/2)+k step -0.01: ' ouvrant droit
            2d_point xe%+((lg%/2)*cos(j)),ye%-((lg%/2)*sin(j))
        next j:j=j+0.01
        2d_line xe%+((lg%/2)*cos(j)),ye%-((lg%/2)*sin(j)),xe%,ye%
      end_if
      if open=3
        for j=pi-k to (pi/2)-k step -0.01: ' ouvrant gauche
            2d_point xa%-((lg%/2)*cos(j)),ya%-((lg%/2)*sin(j))
        next j:j=j+0.01
        2d_line xa%-((lg%/2)*cos(j)),ya%-((lg%/2)*sin(j)),xa%,ya%
        for j=pi+k to (pi/2)+k step -0.01: ' ouvrant droit
            2d_point xb%+((lg%/2)*cos(j)),yb%-((lg%/2)*sin(j))
        next j:j=j+0.01
        2d_line xb%+((lg%/2)*cos(j)),yb%-((lg%/2)*sin(j)),xb%,yb%
      end_if
  end_if
  ' A FAIRE RESTAURER LES COTES  <*******************
  if seg$(1)="COTE"
      xd%=50+val(seg$(2))/(z*2):yd%=50+val(seg$(3))/(z*2):xf%=50+val(seg$(4))/(z*2):yf%=50+val(seg$(5))/(z*2)
      mx=50+val(seg$(7))/(z*2):my=50+val(seg$(8))/(z*2):ha%=val(seg$(6)):dh%=ha%/(z*4)
      lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2)):gosub calcul_points
      2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
      left 300+val(seg$(0)),mx:top 300+val(seg$(0)),my:caption 300+val(seg$(0)),seg$(9):show 300+val(seg$(0))
  end_if
  ' A FAIRE RESTAURER LES TEXTES  <*******************
  if seg$(1)="TXTE"
      xd%=50+val(seg$(2))/(z*2):yd%=50+val(seg$(3))/(z*2)
      font_name 300+val(seg$(0)),"Terminal":font_bold 300+val(seg$(0))
      font_size 300+val(seg$(0)),(6/z)+6:left 300+val(seg$(0)),xd%:top 300+val(seg$(0)),yd%
      caption 300+val(seg$(0)),seg$(4):show 300+val(seg$(0))
  end_if
  ' A FAIRE RESTAURER LES AIRES  <*******************
  if seg$(1)="AIRE"
  end_if
next i
return

' ******************************************************************************

regle:
hide 1
font_name 1,"Fixedsys":2d_target_is 1:2d_fill_color 255,255,255:print_target_is 1
for y=0 to height(1) step 50
  if (int(y/50)=y/50 and y<>0)
      if rg=1
        print_locate 1,y-7:rgy=(int(y/50)*z)-z
        if int(rgy)=rgy then print rgy
      end_if
  end_if
next y
for x=0 to width(1) step 50
  if (int(x/50)=x/50 and x<>0)
      if rg=1
        print_locate x-7,1:rgx=(int(x/50)*z)-z
        if int(rgx)=rgx then print rgx
      end_if
  end_if
next x
show 1
return

grille:
hide 1
2d_target_is 1:2d_pen_width 1
for y=0 to height(1) step 10
  if gr=1
      if int(y/50)<>y/50:2d_pen_color 0,200,200:else:2d_pen_color 0,0,250:end_if
      2d_line 0,y,width(1),y
  end_if
next y
for x=0 to width(1) step 10
  if gr=1
      if int(x/50)<>x/50:2d_pen_color 0,200,200:else:2d_pen_color 0,0,250:end_if
      2d_line x,0,x,height(1)
  end_if
next x
2d_image_copy 211,0,0,width(1),height(1): ' Copie de la grille
show 1
return

form_list:
color 2,180,180,180:width 2,400:height 2,330
left 2,(width(0)/2)+(width(2)/2):top 2,(height(0)/2-height(2)/2)
width 6,300:height 6,100
left 6,(width(2)/2)-(width(6)/2):top 2,(height(2)/2-height(6)/2):return
form_zr:
color 2,0,150,100:width 2,250:height 2,300
left 2,(width(0)/2)-(width(2)/2):top 2,(height(0)/2-height(2)/2):return
form_mpf:
color 2,200,200,200:width 2,400:height 2,330
left 2,(width(0)/2)+(width(2)/2):top 2,(height(0)/2-height(2)/2):return
retourne:
show 2:return

propos:
aide:
return
fin:
if c>0
  a=message_warning_yes_no("VOULEZ-VOUS ENREGISTRER LES MODIFICATIONS AVANT DE QUITTER?")
  if a=1 then gosub enregistre
end_if
terminate
Bon, il va falloir que je triture sérieusement mes méninges pour coder les fonctions "Annuler" et "Refaire". Ça m'a l'air assez complexe à faire quand-même! Bonne soirée à tous! Wink
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jean Claude

avatar

Nombre de messages : 5086
Age : 63
Localisation : 83 Var
Date d'inscription : 07/05/2009

MessageSujet: Re: PLANORAMIC   Sam 10 Mar 2012 - 11:33

Salut à tous

Ce matin j'ai pas de problème (sur les 2 dernières versions), çà fonctionne, comme l'a dit JL35 j'avais surement une saturation quelque part.
Je me demande si ce n'est pas un problème de ram (1Go). j'aurais du regarder le taux d'occupation quand c'est arrivé.
Donc, Bigono, ton code n'est pas en cause.

A+
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Invité
Invité



MessageSujet: Re: PLANORAMIC   Mer 14 Mar 2012 - 14:51

Citation :
il y a un problème: j'ai un message d'erreur dans une fenêtre Panoramic => "Espace insuffisant pour traiter cette commande".

Y a-t'il un Panoramicien qui a essayé la dernière version de Planoramic ? Et qui aurait le même problème.

J'avais voulu voir aussi, et j'avais le même problème, mais j'avais autre chose à faire (déjà que je n'ai pas beaucoup de temps).
Le problème vient de la largeur du picture à 5000
Avec 2000, l'erreur disparaissait.
(Il faudra que je révise mon français)
Revenir en haut Aller en bas
Jean Claude

avatar

Nombre de messages : 5086
Age : 63
Localisation : 83 Var
Date d'inscription : 07/05/2009

MessageSujet: Re: PLANORAMIC   Mer 14 Mar 2012 - 20:28

Salut Cosmos,

Si tu lis les message ci-dessus tu verras que j'ai eu le même problème, ce qui confirmerait un manque de RAM au lancement du programme.

On a des vieux coucou.... Very Happy

A+

EDIT: milles excuses Cosmos, j'ai mal lu ton message...., tu es déjà au courant. Embarassed
Je pense quand même à un problème de mémoire vive......
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
bignono

avatar

Nombre de messages : 1104
Age : 60
Localisation : Val de Marne
Date d'inscription : 13/11/2011

MessageSujet: Re: PLANORAMIC   Mer 14 Mar 2012 - 22:23

Bonsoir à vous tous amis de la planète Panoramic Laughing
Je suis un petit peu absent du forum en ce moment et je vais certainement l'être un peu plus. Comme vous le savez, je suis aussi passioné de généalogie, et récemment, une de mes branches où mes recherches s'étaient arrêtées vient d'être débloquées. Donc j'ai maintenant pas mal de registres paroissiaux sur les sites des archives départementales des Yvelines et de l'Essonne à explorer sur plusieurs communes sur une assez longue période. Et c'est pas facile à déchiffrer vu l'écriture qu'ils avaient dans le temps!
Bon, ceci dit, pour Planoramic, j'ai décidé de m'arrêter là. J'ai juste développé les fonctions annuler et rétablir dans le menu Edition.
Vous pouvez télécharger le dossier planoramic.zip sur:
http://www.mydrive.ch/
identifiant: panoramic@bignono
mot de passe: panoramic123
Vous trouverez un petit fichier d'aide et un plan que vous pourrez ouvrir pour exemple.
Je met ici le code par sécurité:
Code:
dim h,i,j,n,q,p,ii : ' réservés indices et boucles
dim x,y,z,gr,rg,rgy,rgx,clic,styl,pfstyl,mclic,v1,v2,v3,v4,v5,va,open
dim xa%,ya%,xb%,yb%,xc%,yc%,xd%,yd%,xe%,ye%,xf%,yf%,xp%,yp%,xv%,yv%
dim lg%,ha%,dh%,a,c,k,pi,nv,mx,my,x1%,y1%,x2%,y2%,axd%,ayd%
dim titre$,num$,tx$,img$,msg$,annul$,refair$
dim ligne$(1000),seg$(10),typ$(1000),txt$(1000)
dim dx(1000),dy(1000),fx(1000),fy(1000),ep(1000),hm(1000),op(1000),xm(1000),ym(1000)
' dx(i),dy(i) => xd%,yd% * fx(i),fy(i) => xf%,yf% * ep(i) => ha% * hm(i) => nv
label form_zr,form_mpf,form_list,vc1,vc2,vc3,vc4,s1,s2,s3,s4,s5,s6,s7,s8
label cliquer,init,grille,regle,refait_plan,motif_mur,retourne,saisir,saisir2
label pos_souris,test_spin,calcul_points
label selection,slectext,cherche_seg,fait_ligne,cherche_num
label modifmur,modifporte,modifent,modiftext,modifcote,supprime,sup
label mur,porte,fenetre,texte,cote
label annule,refait,zoom
label nouveau,ouvre,enregistre,prefere,fin,propos,aide

if dir_exists ("c:\planoramic") = 0 then dir_make "c:\planoramic"
titre$="*** P L A N O R A M I C ***":caption 0,titre$
full_space 0:hide 0:on_close 0,fin
picture 1:width 1,5000:height 1,5000
form 2:hide 2:on_close 2,retourne
dlist 5

' menu Principal OBJETS RÉSERVÉS DE 10 A 80
main_menu 10
' les sous-menus
sub_menu 11:parent 11,10:caption 11,"Fichier"
sub_menu 12:parent 12,10:caption 12,"Edition"
sub_menu 13:parent 13,10:caption 13,"Plan"
sub_menu 14:parent 14,10:caption 14,"Commandes"
sub_menu 15:parent 15,10
sub_menu 16:parent 16,10:caption 16,"A propos"      :on_click 16,propos
sub_menu 17:parent 17,10:caption 17,"Aide"          :on_click 17,aide

' sous-menu Fichier
sub_menu 20:parent 20,11:caption 20,"Nouveau"      :on_click 20,nouveau      :' FAIT
sub_menu 21:parent 21,11:caption 21,"Ouvrir"        :on_click 21,ouvre        :' FAIT
sub_menu 22:parent 22,11:caption 22,"Enregistrer"  :on_click 22,enregistre    :' FAIT
sub_menu 23:parent 23,11:caption 23,"Règlages"      :on_click 23,prefere      :' FAIT en partie (ya un bug!!!)
sub_menu 24:parent 24,11:caption 24,"Quitter"      :on_click 24,fin          :' FAIT

' sous-menu Edition
sub_menu 30:parent 30,12:caption 30,"Annuler"      :on_click 30,annule        :' FAIT
sub_menu 31:parent 31,12:caption 31,"Rétablir"      :on_click 31,refait        :' FAIT
sub_menu 32:parent 32,12:caption 32,"Zoom"          :on_click 32,zoom          :' FAIT

' sous-menu Plan
sub_menu 40:parent 40,13:caption 40,"Créer mur"    :on_click 40,mur          :' FAIT
sub_menu 41:parent 41,13:caption 41,"Créer porte"  :on_click 41,porte        :' FAIT
sub_menu 42:parent 42,13:caption 42,"Créer fenêtre" :on_click 42,fenetre      :' FAIT
sub_menu 43:parent 43,13:caption 43,"Créer texte"  :on_click 43,texte        :' FAIT
sub_menu 44:parent 44,13:caption 44,"Créer cote"    :on_click 44,cote          :' FAIT


' sous-menu Commandes
sub_menu 50:parent 50,14:caption 50,"Modifier mur"    :on_click 50,modifmur    :' FAIT
sub_menu 51:parent 51,14:caption 51,"Modifier porte"  :on_click 51,modifporte  :' FAIT
sub_menu 52:parent 52,14:caption 52,"Modifier fenêtre":on_click 52,modifent    :' FAIT
sub_menu 53:parent 53,14:caption 53,"Modifier texte"  :on_click 53,modiftext  :' FAIT
sub_menu 54:parent 54,14:caption 54,"Modifier cote"  :on_click 54,modifcote  :' FAIT
sub_menu 55:parent 55,14:caption 55,"Supprimer"      :on_click 55,supprime    :' FAIT

command_target_is 2
list 6:hide 6:width 6,300:height 6,100
left 6,(width(2)/2)-(width(6)/2):top 6,(height(2)/2-height(6)/2)
' Pour ZOOM et RÈGLAGES
option 81:hide 81:left 81,20:top 81, 30:caption 81," 25 %"
option 82:hide 82:left 82,20:top 82, 60:caption 82," 50 %"
option 83:hide 83:left 83,20:top 83, 90:caption 83,"100 %"
option 84:hide 84:left 84,20:top 84,120:caption 84,"200 %"
option 85:hide 85:left 85,20:top 85,150:caption 85,"400 %"
button 86:hide 86:left 86,120:top 86,170:width 86,50:caption 86," OK "
spin 87:hide 87:left 87,5:top 87,5:width 87,50:min 87, 4:max 87,100
spin 88:hide 88:left 88,5:top 88,30:width 88,50:min 88,10:max 88,300
check 89:hide 89:left 89,5:top 89,165:caption 89,"Règles visible"
check 90:hide 90:left 90,5:top 90,190:caption 90,"Grille visible"
option 91:hide 91:width 91,17:left 91,5:top 91,80
picture 92:hide 92:width 92,60:height 92,15:left 92,25:top 92,80
2d_target_is 92:2d_fill_solid:2d_flood 1,1,0,0,0
option 93:hide 93:width 93,17:left 93,95:top 93,80
picture 94:hide 94:width 94,60:height 94,15:left 94,115:top 94,80
2d_target_is 94:2d_fill_diagonal_up:2d_flood 1,1,0,0,0
option 95:hide 95:width 95,17:left 95,5:top 95,100
picture 96:hide 96:width 96,60:height 96,15:left 96,25:top 96,100
2d_target_is 96:2d_fill_diagonal_down:2d_flood 1,1,0,0,0
option 97:hide 97:width 97,17:left 97,95:top 97,100
picture 98:hide 98:width 98,60:height 98,15:left 98,115:top 98,100
2d_target_is 98:2d_fill_diagonal_cross:2d_flood 1,1,0,0,0
option 99:hide 99:width 99,17:left 99,5:top 99,120
picture 100:hide 100:width 100,60:height 100,15:left 100,25:top 100,120
2d_target_is 100:2d_fill_cross:2d_flood 1,1,0,0,0
option 101:hide 101:width 101,17:left 101,95:top 101,120
picture 102:hide 102:width 102,60:height 102,15:left 102,115:top 102,120
' POUR MODIFIER LES MURS, LES PORTES ET LES FENÊTRES
spin 103:hide 103:left 103, 20:top 103,25:min 103,-50:max 103,9900:' spin début mur x
spin 104:hide 104:left 104,220:top 104,25:min 104,-50:max 104,9900:' spin début mur y
spin 105:hide 105:left 105, 20:top 105,75:min 105,-50:max 105,9900:' spin fin mur x
spin 106:hide 106:left 106,220:top 106,75:min 106,-50:max 106,9900:' spin fin mur y
spin 107:hide 107:left 107, 20:top 107,135:min 107,0:max 107,9900:' spin longueur mur
spin 108:hide 108:left 108,220:top 108,135:min 108,10:max 108,300:' spin hauteur mur
spin 109:hide 109:left 109, 20:top 109,195:min 109,4:max 109,100:' spin épaisseur mur
button 110:hide 110:left 110,220:top 110,230:width 110,120:' caption 110,"TEXTURE (3D)"
button 111:hide 111:left 111,220:top 111,265:width 111,120:caption 111,"VALIDER"
check 112:hide 112:left 112, 20:top 112,230:caption 112,"INVERSER"
check 113:hide 113:left 113, 20:top 113,250:caption 113,"MIROIR"

for j=151 to 180:alpha j:hide j:next j

left 151,45 :top 151,60 :caption 151,"  Style des murs  "
left 152,60 :top 152,10 :caption 152," cm. Épaisseur des murs "
left 153,60 :top 153,35 :caption 153," cm.  Hauteur  des murs "
left 154,7  :top 154,10 :caption 154,"DÉBUTE À:"
left 155,7  :top 155,30 :caption 155,"X"
left 156,145:top 156,30 :caption 156,"cm"
left 157,207:top 157,30 :caption 157,"Y"
left 158,345:top 158,30 :caption 158,"cm"
left 159,7  :top 159,60 :caption 159,"TERMINE À:"
left 160,7  :top 160,80 :caption 160,"X"
left 161,145:top 161,80 :caption 161,"cm"
left 162,207:top 162,80 :caption 162,"Y"
left 163,345:top 163,80 :caption 163,"cm"
left 164,20 :top 164,120
left 165,145:top 165,140:caption 165,"cm"
left 166,220:top 166,120:caption 166,"HAUTEUR"
left 167,345:top 167,140:caption 167,"cm"
left 168,20 :top 168,180:caption 168,"ÉPAISSEUR"
left 169,145:top 169,200:caption 169,"cm"

command_target_is 0
for j=300 to 1300:alpha j:hide j:next j

image 210: ' image ecran lors du traçage
image 211: ' image de la grille seule
image 212: ' image effaçant données porte et fenêtre
image 213: ' image du picture vierge
2d_image_copy 213,0,0,width(1),height(1)
gosub init

end

' ******************************************************************************
init:
show 0:2d_target_is 1:cls
pi=4*atn(1):ha%=20:gr=1:rg=1:z=1:open=2
dh%=ha%/(z*4):nv=250:styl=2:pfstyl=1
gosub grille:gosub regle
return

cliquer:
wait 120:' <=== Valeur à ajuster (j'obtiens de bon résultats entre 100 et 200)
if scancode=1 then clic=clic+1
if scancode=1 then clic=clic+1
if clic=1 then mclic=1
if clic=2 then mclic=2
clic=0
return
' ******************************************************************************

pos_souris:
2d_fill_solid:2d_fill_color 255,255,100
print_locate xp%-20,yp%-30:print "x=";str$((xp%-50)*(z*2));" y=";str$((yp%-50)*(z*2))
wait 200
return

mur:
for j=11 to 17:inactive j:next j:2d_target_is 1
2d_image_copy 210,0,0,width(1),height(1)
cursor_cross 1
print_target_is 1
repeat
  xd%=mouse_x_position(1):yd%=mouse_y_position(1):xf%=xd%:yf%=yd%
  if xd%<>xp% or yd%<>yp%
      2d_image_paste 210,0,0
      xp%=xd%:yp%=yd%:gosub pos_souris
  end_if
until (mouse_left_down(1)=1 and mouse_left_up(1)=0)
2d_image_paste 210,0,0:2d_image_copy 210,0,0,width(1),height(1)
2d_pen_color 0,0,0:2d_pen_width 2
while mouse_left_up(1)=0
  xf%=mouse_x_position(1):yf%=mouse_y_position(1)
  if scancode=162 or scancode=163 then yf%=yd%
  if scancode=160 or scancode=161 then xf%=xd%
  lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
  if xf%<>xv% or yf%<>yv%
      2d_image_paste 210,0,0:gosub calcul_points
      2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
      xv%=xf%:yv%=yf%:xp%=xf%:yp%=yf%
      print_locate xp%-20,yp%-60:print "Angle: ";str$(wrap_value(a));"°";" Épaisseur= ";str$(ha%/100);"m"
      print_locate xp%-20,yp%-45:print "Longueur= ";str$((int(lg%)/100)*(z*2));"m"
      gosub pos_souris:wait 100
  end_if
end_while
2d_image_paste 210,0,0:lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
if lg%<>0
  gosub motif_mur:gosub cherche_num:typ$(i)="MURS"
  dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
  ep(i)=ha%:hm(i)=nv:op(i)=0:gosub fait_ligne:item_add 5,ligne$(i)
end_if
cursor_arrow 1
for j=11 to 17:active j:next j:c=1:ii=i
return

calcul_points:
      if xf%>xd%
        k=atn((yd%-yf%)/(xf%-xd%)):a=k*180/pi:a=int(a*100)/100
      end_if
      if xf%<xd%
        k=atn((yd%-yf%)/(xf%-xd%)):a=k*180/pi:a=int(a*100)/100:a=180+a:k=k+3.14
      end_if
      if xd%=xf%
        if yf%<yd% then a=90:k=1.57
        if yf%>yd% then a=270:k=4.71
      end_if
      xa%=xd%-dh%*sin(k):ya%=yd%-dh%*cos(k): ' point A
      xe%=xd%+dh%*sin(k):ye%=yd%+dh%*cos(k): ' point E
      xc%=xe%+lg%*cos(k):yc%=ye%-lg%*sin(k): ' point C
      xb%=xa%+lg%*cos(k):yb%=ya%-lg%*sin(k): ' point B
return
motif_mur:
' Nettoyage
  2d_pen_color 255,255,255:2d_pen_width 2
  for j=-1*dh% to dh%
      x1%=xd%-j*sin(k):y1%=yd%-j*cos(k)
      x2%=x1%+lg%*cos(k):y2%=y1%-lg%*sin(k)
      2d_line x1%,y1%,x2%,y2%
  next j
  2d_pen_color 0,0,0
  2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
  if (styl<>0 and pfstyl<>0)
      mx=(xd%+xf%)/2:my=(yd%+yf%)/2
      if styl=1 then 2d_fill_solid
      if styl=2 then 2d_fill_diagonal_up
      if styl=3 then 2d_fill_diagonal_down
      if styl=4 then 2d_fill_diagonal_cross
      if styl=5 then 2d_fill_cross
      2d_flood mx,my,0,0,0
  end_if
return

porte:
for j=11 to 17:inactive j:next j:2d_target_is 1
2d_image_copy 210,0,0,width(1),height(1)
repeat
      axd%=mouse_x_position(1):ayd%=mouse_y_position(1)
  if axd%<>xv% or ayd%<>yv%
      2d_image_paste 210,0,0
      if (scancode>=160 and scancode<=163)
        xf%=mouse_x_position(1):yf%=mouse_y_position(1)
      else
        xd%=axd%:yd%=ayd%:xf%=xd%+40:yf%=yd%
      end_if
      lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
      gosub calcul_points:2d_pen_color 0,0,0:2d_pen_width 2
      2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
      ' Tracé ouvrant gauche sud par défaut
      for j=(pi*2)-k to ((pi*3)/2)-k step -0.01
        2d_point xc%-(lg%*cos(j)),yc%-(lg%*sin(j))
      next j:j=j+0.01
      2d_line xc%-(lg%*cos(j)),yc%-(lg%*sin(j)),xc%,yc%:xv%=axd%:yv%=ayd%:wait 100
      2d_image_copy 212,0,0,width(1),height(1):xp%=xf%:yp%=yf%
      print_locate xp%-20,yp%-60:print "Angle: ";str$(wrap_value(a));"°"
      print_locate xp%-20,yp%-45:print "Largeur= ";str$((int(lg%)/100)*(z*2));"m"
      gosub pos_souris
  end_if
until mouse_left_down(1)=1
2d_image_paste 212,0,0
pfstyl=0:gosub motif_mur:pfstyl=1:gosub cherche_num:typ$(i)="PORT"
  dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
  ep(i)=ha%:hm(i)=210:op(i)=2:gosub fait_ligne:item_add 5,ligne$(i)
2d_image_copy 210,0,0,width(1),height(1)
for j=11 to 17:active j:next j:c=3:ii=i
return

fenetre:
for j=11 to 17:inactive j:next j:2d_target_is 1
2d_image_copy 210,0,0,width(1),height(1)
repeat
      axd%=mouse_x_position(1):ayd%=mouse_y_position(1)
  if axd%<>xv% or ayd%<>yv%
      2d_image_paste 210,0,0
      if (scancode>=160 and scancode<=163)
        xf%=mouse_x_position(1):yf%=mouse_y_position(1)
      else
        xd%=axd%:yd%=ayd%:xf%=xd%+80:yf%=yd%
      end_if
      lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
      gosub calcul_points:2d_pen_color 0,0,0:2d_pen_width 2
      2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
      for j=(pi*2)-k to ((pi*3)/2)-k step -0.01: ' ouvrant gauche orienté sud par défaut
        2d_point xc%-((lg%/2)*cos(j)),yc%-((lg%/2)*sin(j))
      next j:j=j+0.01
      2d_line xc%-((lg%/2)*cos(j)),yc%-((lg%/2)*sin(j)),xc%,yc%:xv%=axd%:yv%=ayd%
      for j=(pi*2)+k to ((pi*3)/2)+k step -0.01: ' ouvrant droit orienté sud par défaut
        2d_point xe%+((lg%/2)*cos(j)),ye%-((lg%/2)*sin(j))
      next j:j=j+0.01
      2d_line xe%+((lg%/2)*cos(j)),ye%-((lg%/2)*sin(j)),xe%,ye%:wait 100
      2d_image_copy 212,0,0,width(1),height(1):xp%=xf%:yp%=yf%
      print_locate xp%-20,yp%-60:print "Angle: ";str$(wrap_value(a));"°"
      print_locate xp%-20,yp%-45:print "Largeur= ";str$((int(lg%)/100)*(z*2));"m"
      gosub pos_souris
  end_if
until mouse_left_down(1)=1
2d_image_paste 212,0,0
pfstyl=0:gosub motif_mur:pfstyl=1:gosub cherche_num:typ$(i)="FENT"
  dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
  ep(i)=ha%:hm(i)=120:op(i)=2:gosub fait_ligne:item_add 5,ligne$(i)
2d_image_copy 210,0,0,width(1),height(1)
for j=11 to 17:active j:next j:c=5:ii=i
return

texte:
for j=11 to 17:inactive j:next j:2d_target_is 1
2d_image_copy 210,0,0,width(1),height(1)
cursor_cross 1
print_target_is 1
repeat
  xd%=mouse_x_position(1):yd%=mouse_y_position(1)
  if xd%<>xp% or yd%<>yp%
      2d_image_paste 210,0,0
      xp%=xd%:yp%=yd%:gosub pos_souris
  end_if
until (mouse_left_down(1)=1 and mouse_left_up(1)=0)
2d_image_paste 210,0,0:2d_image_copy 210,0,0,width(1),height(1)

saisir:
  tx$=message_input$("PLANORAMIC", "Entrez un nom (20 caractères maxi)" , "")
  if len(tx$)>20 then goto saisir
  if tx$="" then goto s8
gosub cherche_num:typ$(i)="TXTE":txt$(i)=tx$
font_name 300+i,"Terminal":font_bold 300+i:font_size 300+i,(6/z)+6
left 300+i,xd%:top 300+i,yd%:caption 300+i,txt$(i):show 300+i
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2)
gosub fait_ligne:item_add 5,ligne$(i)
s8:
2d_image_copy 210,0,0,width(1),height(1)
cursor_arrow 1
for j=11 to 17:active j:next j:c=7:ii=i
return

cote:
for j=11 to 17:inactive j:next j:2d_target_is 1
2d_image_copy 210,0,0,width(1),height(1)
cursor_cross 1
print_target_is 1
repeat
  xd%=mouse_x_position(1):yd%=mouse_y_position(1):xf%=xd%:yf%=yd%
  if xd%<>xp% or yd%<>yp%
      2d_image_paste 210,0,0
      xp%=xd%:yp%=yd%:gosub pos_souris
  end_if
until (mouse_left_down(1)=1 and mouse_left_up(1)=0)
2d_image_paste 210,0,0:2d_image_copy 210,0,0,width(1),height(1)
2d_pen_color 0,0,0:2d_pen_width 2
while mouse_left_up(1)=0
  xf%=mouse_x_position(1):yf%=mouse_y_position(1)
  if scancode=162 or scancode=163 then yf%=yd%
  if scancode=160 or scancode=161 then xf%=xd%
  lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
  if xf%<>xv% or yf%<>yv%
      2d_image_paste 210,0,0:gosub calcul_points
      2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
      xv%=xf%:yv%=yf%:xp%=xf%:yp%=yf%
      print_locate xp%-20,yp%-45:print "Longueur= ";str$((int(lg%)/100)*(z*2));"m"
      gosub pos_souris:wait 100
  end_if
end_while
2d_image_paste 210,0,0:lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
if lg%<>0
  2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
  mx=(xd%+xf%)/2:my=(yd%+yf%)/2
  gosub cherche_num:typ$(i)="COTE":txt$(i)=str$((int(lg%)/100)*(z*2))+"m"
  left 300+i,mx:top 300+i,my:caption 300+i,txt$(i):show 300+i
  dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
  ep(i)=ha%:xm(i)=(mx-50)*(z*2):ym(i)=(my-50)*(z*2)
  gosub fait_ligne:item_add 5,ligne$(i)
end_if
cursor_arrow 1
for j=11 to 17:active j:next j:c=9:ii=i
return

selection:
  if j>0
      if seg$(1)="COTE"
        2d_pen_color 0,0,0
        2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
      else
        2d_pen_color 0,0,0
        2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
      end_if
  end_if
  i=val(left$(item_read$(6,item_index(6)),3)):gosub cherche_seg
  ligne$(i)="":for q=0 to n-1:ligne$(i)=ligne$(i)+seg$(q)+"*":next q
  xd%=50+val(seg$(2))/(z*2):yd%=50+val(seg$(3))/(z*2)
  xf%=50+val(seg$(4))/(z*2):yf%=50+val(seg$(5))/(z*2)
  ha%=val(seg$(6)):nv=val(seg$(7)):dh%=ha%/(z*4)
  lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2)):gosub calcul_points
  if seg$(1)="COTE"
      2d_pen_color 200,0,0
      2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
  else
      2d_pen_color 200,0,0
      2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
  end_if
  mclic=0:j=i:annul$=ligne$(i)
return

modifmur:
for j=11 to 17:inactive j:next j
caption 2,"LISTE DES MURS":gosub form_list:j=0
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="MURS" then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s1
show 2:print_target_is 2:font_bold 2
j=0:show 6:on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
if mclic=1 then gosub selection
end_while
gosub selection
hide 6:off_click 6:clear 6

caption 2,"MODIFIER MUR":gosub form_mpf
for h=103 to 111:show h:next h:for h=154 to 169:show h:next h
caption 164,"LONGUEUR"
position 103,val(seg$(2)):position 104,val(seg$(3))
position 105,val(seg$(4)):position 106,val(seg$(5))
position 107,sqr(power(val(seg$(4))-val(seg$(2)),2)+power(val(seg$(3))-val(seg$(5)),2))
position 108,val(seg$(7)) :position 109,val(seg$(6))

while clicked(111)=0
  if clicked(1)=1 then to_foreground 2
  gosub test_spin
  if position(103)<>v1 or position(104)<>v2 then gosub vc1
  if position(105)<>v3 or position(106)<>v4 then gosub vc2
  if position(107)<>v5 then gosub vc3
  gosub vc4
end_while

xd%=50+position(103)/(z*2):yd%=50+position(104)/(z*2)
xf%=50+position(105)/(z*2):yf%=50+position(106)/(z*2)
ha%=position(109):nv=position(108):dh%=ha%/(z*4)
' refaire ligne$(i)
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
ep(i)=ha%:hm(i)=nv:op(i)=0:typ$(i)="MURS"
gosub fait_ligne:item_delete 5,i:item_insert 5,i,ligne$(i):ii=i
2d_target_is 2:for h=103 to 111:hide h:next h:for h=154 to 169:hide h:next h:hide 2
' refaire le plan
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle
gosub refait_plan
s1:
for j=11 to 17:active j:next j:c=2
return

modifporte:
for j=11 to 17:inactive j:next j
caption 2,"LISTE DES PORTES":gosub form_list:j=0
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="PORT" then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s2
show 2:print_target_is 2:font_bold 2
j=0:show 6:on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
  if mclic=1 then gosub selection
end_while
gosub selection
hide 6:off_click 6:clear 6

caption 2,"MODIFIER PORTE":gosub form_mpf
show 2:print_target_is 2:font_bold 2
for h=103 to 113:show h:next h:for h=154 to 167:show h:next h
caption 164,"LARGEUR"
dx(i)=val(seg$(2)):dy(i)=val(seg$(3)):fx(i)=val(seg$(4)):fy(i)=val(seg$(5))
hm(i)=val(seg$(7)):v1=dx(i):v2=dy(i):v3=fx(i):v4=fy(i)
v5=sqr(power(fx(i)-dx(i),2)+power(dy(i)-fy(i),2))

 position 103,dx(i):position 104,dy(i)
 position 105,fx(i):position 106,fy(i)
 position 107,sqr(power(fx(i)-dx(i),2)+power(dy(i)-fy(i),2))
 position 108,hm(i)

while clicked(111)=0
  if clicked(1)=1 then to_foreground 2
  gosub test_spin
  if position(103)<>v1 or position(104)<>v2 then gosub vc1
  if position(105)<>v3 or position(106)<>v4 then gosub vc2
  if position(107)<>v5 then gosub vc3
  gosub vc4
  if (checked(112)=0 and checked(113)=0) then open=2
  if (checked(112)=1 and checked(113)=0) then open=3
  if (checked(112)=0 and checked(113)=1) then open=4
  if (checked(112)=1 and checked(113)=1) then open=5
end_while

xd%=50+position(103)/(z*2):yd%=50+position(104)/(z*2)
xf%=50+position(105)/(z*2):yf%=50+position(106)/(z*2)
nv=position(108):dh%=ha%/(z*4)
' refaire ligne$(i)
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
ep(i)=ha%:hm(i)=nv:op(i)=open:typ$(i)="PORT"
gosub fait_ligne:item_delete 5,i:item_insert 5,i,ligne$(i):ii=i
2d_target_is 2:for h=103 to 113:hide h:next h:for h=154 to 167:hide h:next h:hide 2
' refaire le plan
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle
gosub refait_plan
s2:
for j=11 to 17:active j:next j:c=4
return

vc1:
  position 107,sqr(power(position(105)-position(103),2)+power(position(104)-position(106),2))
  v1=position(103):v2=position(104):v5=position(107)
return
vc2:
  position 107,sqr(power(position(105)-position(103),2)+power(position(104)-position(106),2))
  v3=position(105):v4=position(106):v5=position(107)
return
vc3:
  position 105,position(103)+position(107)*cos(a)
  position 106,position(104)-position(107)*sin(a)
  position 107,sqr(power(position(105)-position(103),2)+power(position(104)-position(106),2))
  v3=position(105):v4=position(106):v5=position(107)
return
vc4:
  if position(105)<>position(103)
      va=(atn((position(106)-position(104))/(position(105)-position(103)))*180)/pi:va=int(va*100)/100
  end_if
  if position(103)=position(105)
      if position(106)<position(104) then va=90
      if position(106)>position(104) then va=270
  end_if
  print_locate 220,200:print "ANGLE : "; wrap_value(va); "°        "
return

modifent:
for j=11 to 17:inactive j:next j
caption 2,"LISTE DES FENÊTRES":gosub form_list:j=0
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="FENT" then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s3
show 2:print_target_is 2:font_bold 2
j=0:show 6:on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
  if mclic=1 then gosub selection
end_while
gosub selection
hide 6:off_click 6:clear 6

caption 2,"MODIFIER FENÊTRE":gosub form_mpf
show 2:print_target_is 2:font_bold 2
for h=103 to 112:show h:next h:for h=154 to 167:show h:next h
caption 164,"LARGEUR"
dx(i)=val(seg$(2)):dy(i)=val(seg$(3)):fx(i)=val(seg$(4)):fy(i)=val(seg$(5))
hm(i)=val(seg$(7)):v1=dx(i):v2=dy(i):v3=fx(i):v4=fy(i)
v5=sqr(power(fx(i)-dx(i),2)+power(dy(i)-fy(i),2))

 position 103,dx(i):position 104,dy(i)
 position 105,fx(i):position 106,fy(i)
 position 107,sqr(power(fx(i)-dx(i),2)+power(dy(i)-fy(i),2))
 position 108,hm(i)

while clicked(111)=0
  if clicked(1)=1 then to_foreground 2
  gosub test_spin
  if position(103)<>v1 or position(104)<>v2 then gosub vc1
  if position(105)<>v3 or position(106)<>v4 then gosub vc2
  if position(107)<>v5 then gosub vc3
  gosub vc4
  if checked(112)=0 then open=2
  if checked(112)=1 then open=3
end_while

xd%=50+position(103)/(z*2):yd%=50+position(104)/(z*2)
xf%=50+position(105)/(z*2):yf%=50+position(106)/(z*2)
nv=position(108):dh%=ha%/(z*4)
' refaire ligne$(i)
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
ep(i)=ha%:hm(i)=nv:op(i)=open:typ$(i)="FENT"
gosub fait_ligne:item_delete 5,i:item_insert 5,i,ligne$(i):ii=i
2d_target_is 2:for h=103 to 112:hide h:next h:for h=154 to 167:hide h:next h:hide 2
' refaire le plan
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle
gosub refait_plan
s3:
for j=11 to 17:active j:next j:c=6
return

modiftext:
for j=11 to 17:inactive j:next j
caption 2,"LISTE DES TEXTES":gosub form_list:j=0
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="TXTE" then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s5
show 2:print_target_is 2:font_bold 2
j=0:show 6:on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
if mclic=1 then gosub slectext
end_while
gosub slectext
hide 6:off_click 6:clear 6:hide 2

saisir2:
  tx$=message_input$("PLANORAMIC", "Entrez un nom (20 caractères maxi)" , "")
  if len(tx$)>20 then goto saisir2
  if len(tx$)=0 then tx$=txt$(i)
typ$(i)="TXTE":txt$(i)=tx$
font_name 300+i,"Terminal":font_bold 300+i:font_size 300+i,(6/z)+6
color 300+i,240,240,240:left 300+i,xd%:top 300+i,yd%:caption 300+i,txt$(i):show 300+i
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2)
gosub fait_ligne:item_delete 5,i:item_insert 5,i,ligne$(i):ii=i
s5:
for j=11 to 17:active j:next j:c=8
return

slectext:
  color 300+i,240,240,240
  i=val(left$(item_read$(6,item_index(6)),3)):gosub cherche_seg
  ligne$(i)="":for q=0 to n-1:ligne$(i)=ligne$(i)+seg$(q)+"*":next q:annul$=ligne$(i)
  xd%=50+val(seg$(2))/(z*2):yd%=50+val(seg$(3))/(z*2)
  txt$(i)=seg$(4)
  color 300+i,255,0,0
  mclic=0:j=i
return

modifcote:
for j=11 to 17:inactive j:next j
caption 2,"LISTE DES COTES":gosub form_list:j=0
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="COTE" then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s4
show 2:print_target_is 2:font_bold 2
j=0:show 6:on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
if mclic=1 then gosub selection
end_while
gosub selection
hide 6:off_click 6:clear 6

caption 2,"MODIFIER COTE":gosub form_mpf
for h=103 to 107:show h:next h:for h=154 to 164:show h:next h:show 111
caption 164,"LONGUEUR"

position 103,val(seg$(2)):position 104,val(seg$(3))
position 105,val(seg$(4)):position 106,val(seg$(5))
position 107,sqr(power(val(seg$(4))-val(seg$(2)),2)+power(val(seg$(3))-val(seg$(5)),2))

while clicked(111)=0
  if clicked(1)=1 then to_foreground 2
  gosub test_spin
  if position(103)<>v1 or position(104)<>v2 then gosub vc1
  if position(105)<>v3 or position(106)<>v4 then gosub vc2
  if position(107)<>v5 then gosub vc3
end_while

xd%=50+position(103)/(z*2):yd%=50+position(104)/(z*2)
xf%=50+position(105)/(z*2):yf%=50+position(106)/(z*2)
mx=(xd%+xf%)/2:my=(yd%+yf%)/2
lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))

' refaire ligne$(i)
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
ep(i)=ha%:xm(i)=(mx-50)*(z*2):ym(i)=(my-50)*(z*2):txt$(i)=str$((int(lg%)/100)*(z*2))+"m"
typ$(i)="COTE":gosub fait_ligne:item_delete 5,i:item_insert 5,i,ligne$(i):ii=i
2d_target_is 2:for h=103 to 112:hide h:next h:for h=154 to 167:hide h:next h:hide 2

' refaire le plan
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle
gosub refait_plan
s4:
for j=11 to 17:active j:next j:c=10
return

supprime:
for j=11 to 17:inactive j:next j:caption 111,"ANNULER":show 111
caption 2,"LISTE DES OBJETS":gosub form_list:j=0
for i=1 to count(5)
  if len(ligne$(i))>0 then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s6
show 2:print_target_is 2:font_bold 2
j=0:show 6
s7:
on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
  if clicked(111)=1 then off_click 6:hide 6:clear 6:hide 2:goto s6
end_while
off_click 6
i=val(left$(item_read$(6,item_index(6)),3))
if mid$(ligne$(i),5,4)="TXTE" : gosub slectext : else : gosub selection : end_if
j=message_warning_yes_no("SUPPRIMER?")
if j=0 or j=2
if mid$(ligne$(i),5,4)="TXTE" then color 300+i,240,240,240
if mid$(ligne$(i),5,4)="COTE" then 2d_pen_color 0,0,0:2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
if mid$(ligne$(i),5,4)="MURS" or mid$(ligne$(i),5,4)="PORT" or mid$(ligne$(i),5,4)="FENT"
  2d_pen_color 0,0,0:2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
end_if
goto s7
end_if
hide 6:clear 6:hide 2
sup:
if mid$(ligne$(i),5,4)="TXTE" then color 300+i,240,240,240:hide 300+i
if mid$(ligne$(i),5,4)="COTE" then hide 300+i
ligne$(i)="":item_delete 5,i:item_insert 5,i,ligne$(i)
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle
gosub refait_plan
s6:
caption 111,"VALIDER":hide 111:for j=11 to 17:active j:next j:c=20
return

' Recherche des segments
cherche_seg:
for p=0 to 10:seg$(p)="":next p: ' purger les segments
n=0:q=instr(ligne$(i),"*"): ' on cherche la première occurence du séparateur
while q>0: ' tant qu'il y a un séparateur, faire:
    seg$(n)=left$(ligne$(i),q-1): ' mémoriser le premier segment
    ligne$(i)=mid$(ligne$(i),q+1,len(ligne$(i)))
    n=n+1: ' éliminer ce segment et son séparateur
    q=instr(ligne$(i),"*"): ' chercher un nouveau séparateur
end_while
return

' routine de recherche d'un numéro d'objet 3d disponible
cherche_num:
p=1
while len(ligne$(p))>4:p=p+1:end_while
if p>999 then message "Vous avez atteint la limite!"+chr$(10)+chr$(13)+"Vous ne pouvez plus rien créer!":p=p-1
i=p
return

fait_ligne:
num$=str$(i)
if len(num$)=1 then num$="  "+num$
if len(num$)=2 then num$=" "+num$
ligne$(i)=num$+"*"+typ$(i)+"*": ' objet n°,type d'objet
if typ$(i)="MURS" or typ$(i)="PORT" or typ$(i)="FENT"
  ligne$(i)=ligne$(i)+str$(dx(i))+"*"+str$(dy(i))+"*"
  ligne$(i)=ligne$(i)+str$(fx(i))+"*"+str$(fy(i))+"*"
  ligne$(i)=ligne$(i)+str$(ep(i))+"*"+str$(hm(i))+"*"+str$(op(i))+"*"
end_if
if typ$(i)="COTE"
  ligne$(i)=ligne$(i)+str$(dx(i))+"*"+str$(dy(i))+"*"
  ligne$(i)=ligne$(i)+str$(fx(i))+"*"+str$(fy(i))+"*"+str$(ep(i))+"*"
  ligne$(i)=ligne$(i)+str$(xm(i))+"*"+str$(ym(i))+"*"+txt$(i)+"*"
end_if
if typ$(i)="TXTE"
  ligne$(i)=ligne$(i)+str$(dx(i))+"*"+str$(dy(i))+"*"+txt$(i)+"*"
end_if
return

annule:
if c>10 then message "Impossible d'annuler!":return
if odd(c)=1 then i=ii:refair$=ligne$(i):gosub sup:return
if even(c)=1
  i=ii:refair$=ligne$(i):item_delete 5,i:ligne$(i)=annul$:item_insert 5,i,ligne$(i)
' refaire le plan
  2d_target_is 1:cls
  if gr=1 then 2d_image_paste 211,0,0
  if rg=1 then gosub regle
  gosub refait_plan:c=20
end_if
return

refait:
if refair$="" then message "Impossible de rétablir!":return
refair$=right$(refair$,len(refair$)-4):gosub cherche_num
if len(num$)=1 then num$="  "+num$
if len(num$)=2 then num$=" "+num$
ligne$(i)=num$+"*"+refair$:item_insert 5,i,ligne$(i)
' refaire le plan
  2d_target_is 1:cls
  if gr=1 then 2d_image_paste 211,0,0
  if rg=1 then gosub regle
  gosub refait_plan:c=20
refair$=""
return

zoom:
caption 2,"ZOOM":gosub form_zr:show 2:for h=81 to 86:show h:next h
if z=0.25 then set_focus 85:' 400%
if z=0.5 then set_focus 84: ' 200%
if z=1 then set_focus 83:  ' 100%
if z=2 then set_focus 82:  '  50%
if z=4 then set_focus 81:  '  25%
while clicked(86)=0
      if clicked(1)=1 then to_foreground 2
  if checked(81)=1 then z=4:  '  25%
  if checked(82)=1 then z=2:  '  50%
  if checked(83)=1 then z=1:  ' 100%
  if checked(84)=1 then z=0.5: ' 200%
  if checked(85)=1 then z=0.25:' 400%
end_while
for h=81 to 86:hide h:next h:hide 2
2d_target_is 1:2d_image_paste 211,0,0:gosub regle:dh%=ha%/(z*4)
gosub refait_plan
return

nouveau:
if c>0
  a=message_warning_yes_no("VOULEZ-VOUS ENREGISTRER LES MODIFICATIONS?")
      if a=0 then return
      if a=1 then gosub enregistre
end_if
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="TXTE" or mid$(ligne$(i),5,4)="COTE" then delete 300+i:alpha 300+i:hide 300+i
  ligne$(i)=""
next i:clear 5
for i=0 to 10:seg$(i)="":next i:gosub init
gosub init:caption 0,titre$
return

ouvre:
if count(5)>1
  msg$="ATTENTION, vous avez un fichier déjà ouvert!"+chr$(10)+chr$(13)
  msg$=msg$+"Si vous continuez ses données seront perdues"+chr$(10)+chr$(13)
  msg$=msg$+"Continuer quand-même?"
  a=message_warning_yes_no(msg$)
  if a<>1 then return
end_if
' initialisation
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="TXTE" or mid$(ligne$(i),5,4)="COTE" then delete 300+i:alpha 300+i:hide 300+i
  ligne$(i)=""
next i:clear 5
for i=0 to 10:seg$(i)="":next i:gosub init
' recherche du fichier à ouvrir
open_dialog 117
dir_dialog 117,"c:\planoramic"
filter 117,"Fichier PLANORAMIC  -  *.p23|*.p23"
img$=file_name$(117)
delete 117
if img$<>"_"
  i=1:clear 5
  file_open_read 118,img$
  while file_eof(118)<>1
      file_readln 118,ligne$(i)
      item_add 5,ligne$(i):i=i+1
  end_while
  file_close 118
  gosub refait_plan
  c=0:caption 0,"P L A N O R A M I C ==> "+img$
end_if
return

enregistre:
save_dialog 115
dir_dialog 115,"c:\PLANORAMIC"
filter 115,"Fichier PLANORAMIC|*.p23"
img$=file_name$(115)
if right$(img$,4)<>".p23" then img$=img$+".p23"
delete 115
if img$="_.p23" then return
if file_exists(img$)=1
  msg$="Le fichier "+img$+" existe déjà dans le répertoire!"+chr$(10)+chr$(13)+"    Désirez-vous le remplacer?"
  a=message_warning_yes_no(msg$)
  if a=1
      file_read_only_off img$:file_delete img$
  else
  img$="_"
  end_if
end_if
if img$<>"_"
  file_open_write 116,img$
  for i=1 to count(5)
      file_writeln 116,ligne$(i)
  next i
  file_close 116
  c=0:caption 0,"P L A N O R A M I C ==> "+img$
end_if
return

' routine de test de non dépassement des valeurs min et max si un chiffre est rentré manuellement dans un spin
test_spin:
 if position(87)>100 then position 87,100
 if position(88)>300 then position 88,300
 if position(103)>9900 then position 103,9900
 if position(104)>9900 then position 104,9900
 if position(105)>9900 then position 105,9900
 if position(106)>9900 then position 106,9900
 if position(108)>300 then position 108,300
 if position(109)>100 then position 109,100
 if position(87)<4 then position 87,4
 if position(88)<10 then position 88,10
 if position(103)<-50 then position 103,-50
 if position(104)<-50 then position 104,-50
 if position(105)<-50 then position 105,-50
 if position(106)<-50 then position 106,-50
 if position(108)<10 then position 108,10
 if position(109)<4 then position 109,4
return

prefere:
for j=11 to 17:inactive j:next j
caption 2,"REGLAGES":gosub form_zr:show 2:for h=86 to 102:show h:next h
2d_target_is 2:2d_fill_color 255,255,255:print_target_is 2
for h=151 to 153:show h:next h
if rg=1 then mark_on 89
if rg<>1 then mark_off 89
if gr=1 then mark_on 90
if gr<>1 then mark_off 90
if styl=0 then mark_on 101
if styl=1 then mark_on 91
if styl=2 then mark_on 93
if styl=3 then mark_on 95
if styl=4 then mark_on 97
if styl=5 then mark_on 99
position 87,ha%:position 88,nv
while clicked(86)=0
      if clicked(1)=1 then to_foreground 2
  if checked(91)=1 then styl=1
  if checked(93)=1 then styl=2
  if checked(95)=1 then styl=3
  if checked(97)=1 then styl=4
  if checked(99)=1 then styl=5
  if checked(101)=1 then styl=0
  if checked(89)=1 then rg=1
  if checked(89)=0 then rg=0
  if checked(90)=1 then gr=1
  if checked(90)=0 then gr=0
  gosub test_spin
end_while
ha%=position(87):nv=position(88):dh%=ha%/(z*4)
for h=86 to 102:hide h:next h:for h= 151 to 153:hide h:next h:hide 2
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle
for j=11 to 17:active j:next j

refait_plan:
2d_pen_color 0,0,0
for i=1 to count(5)
  gosub cherche_seg
  ligne$(i)="":for q=0 to n-1:ligne$(i) = ligne$(i) + seg$(q)+"*":next q:' reconstitue ligne$(i)
  if ligne$(i)="*" then ligne$(i)=""
  ' RESTAURER LES MURS    <*******************
  if seg$(1)="MURS" or seg$(1)="PORT" or seg$(1)="FENT"
      xd%=50+val(seg$(2))/(z*2):yd%=50+val(seg$(3))/(z*2):xf%=50+val(seg$(4))/(z*2):yf%=50+val(seg$(5))/(z*2)
      ha%=val(seg$(6)):nv=val(seg$(7)):dh%=ha%/(z*4):open=val(seg$(8))
      lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2)):gosub calcul_points
      2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
  end_if
  if seg$(1)="MURS" then gosub motif_mur
  ' RESTAURER LES PORTES
  if seg$(1)="PORT"
      pfstyl=0:gosub motif_mur:pfstyl=1
      ' Tracé ouvrant gauche sud
      if open=2
        for j=(pi*2)-k to ((pi*3)/2)-k step -0.01
            2d_point xc%-(lg%*cos(j)),yc%-(lg%*sin(j))
        next j:j=j+0.01
        2d_line xc%-(lg%*cos(j)),yc%-(lg%*sin(j)),xc%,yc%
      end_if
      ' Tracé ouvrant gauche nord
      if open=3
        for j=pi-k to (pi/2)-k step -0.01
            2d_point xa%-(lg%*cos(j)),ya%-(lg%*sin(j))
        next j:j=j+0.01
        2d_line xa%-(lg%*cos(j)),ya%-(lg%*sin(j)),xa%,ya%
      end_if
      ' Tracé ouvrant droit nord
      if open=4
        for j=pi+k to (pi/2)+k step -0.01
            2d_point xb%+(lg%*cos(j)),yb%-(lg%*sin(j))
        next j:j=j+0.01
        2d_line xb%+(lg%*cos(j)),yb%-(lg%*sin(j)),xb%,yb%
      end_if
      ' Tracé ouvrant droit sud
      if open=5
        for j=(pi*2)+k to ((pi*3)/2)+k step -0.01
            2d_point xe%+(lg%*cos(j)),ye%-(lg%*sin(j))
        next j:j=j+0.01:2d_line xe%+(lg%*cos(j)),ye%-(lg%*sin(j)),xe%,ye%
      end_if
  end_if
  ' RESTAURER LES FENETRES
  if seg$(1)="FENT"
      pfstyl=0:gosub motif_mur:pfstyl=1
      if open=2
        for j=(pi*2)-k to ((pi*3)/2)-k step -0.01: ' ouvrant gauche
            2d_point xc%-((lg%/2)*cos(j)),yc%-((lg%/2)*sin(j))
        next j:j=j+0.01
        2d_line xc%-((lg%/2)*cos(j)),yc%-((lg%/2)*sin(j)),xc%,yc%
        for j=(pi*2)+k to ((pi*3)/2)+k step -0.01: ' ouvrant droit
            2d_point xe%+((lg%/2)*cos(j)),ye%-((lg%/2)*sin(j))
        next j:j=j+0.01
        2d_line xe%+((lg%/2)*cos(j)),ye%-((lg%/2)*sin(j)),xe%,ye%
      end_if
      if open=3
        for j=pi-k to (pi/2)-k step -0.01: ' ouvrant gauche
            2d_point xa%-((lg%/2)*cos(j)),ya%-((lg%/2)*sin(j))
        next j:j=j+0.01
        2d_line xa%-((lg%/2)*cos(j)),ya%-((lg%/2)*sin(j)),xa%,ya%
        for j=pi+k to (pi/2)+k step -0.01: ' ouvrant droit
            2d_point xb%+((lg%/2)*cos(j)),yb%-((lg%/2)*sin(j))
        next j:j=j+0.01
        2d_line xb%+((lg%/2)*cos(j)),yb%-((lg%/2)*sin(j)),xb%,yb%
      end_if
  end_if
  ' RESTAURER LES COTES  <*******************
  if seg$(1)="COTE"
      xd%=50+val(seg$(2))/(z*2):yd%=50+val(seg$(3))/(z*2):xf%=50+val(seg$(4))/(z*2):yf%=50+val(seg$(5))/(z*2)
      mx=50+val(seg$(7))/(z*2):my=50+val(seg$(8))/(z*2):ha%=val(seg$(6)):dh%=ha%/(z*4)
      lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2)):gosub calcul_points
      2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
      left 300+val(seg$(0)),mx:top 300+val(seg$(0)),my:caption 300+val(seg$(0)),seg$(9):show 300+val(seg$(0))
  end_if
  ' RESTAURER LES TEXTES  <*******************
  if seg$(1)="TXTE"
      xd%=50+val(seg$(2))/(z*2):yd%=50+val(seg$(3))/(z*2)
      font_name 300+val(seg$(0)),"Terminal":font_bold 300+val(seg$(0))
      font_size 300+val(seg$(0)),(6/z)+6:left 300+val(seg$(0)),xd%:top 300+val(seg$(0)),yd%
      caption 300+val(seg$(0)),seg$(4):show 300+val(seg$(0))
  end_if
next i
return

' ******************************************************************************

regle:
hide 1
font_name 1,"Fixedsys":2d_target_is 1:2d_fill_color 255,255,255:print_target_is 1
for y=0 to height(1) step 50
  if (int(y/50)=y/50 and y<>0)
      if rg=1
        print_locate 1,y-7:rgy=(int(y/50)*z)-z
        if int(rgy)=rgy then print rgy
      end_if
  end_if
next y
for x=0 to width(1) step 50
  if (int(x/50)=x/50 and x<>0)
      if rg=1
        print_locate x-7,1:rgx=(int(x/50)*z)-z
        if int(rgx)=rgx then print rgx
      end_if
  end_if
next x
show 1
return

grille:
hide 1
2d_target_is 1:2d_pen_width 1
for y=0 to height(1) step 10
  if gr=1
      if int(y/50)<>y/50:2d_pen_color 0,200,200:else:2d_pen_color 0,0,250:end_if
      2d_line 0,y,width(1),y
  end_if
next y
for x=0 to width(1) step 10
  if gr=1
      if int(x/50)<>x/50:2d_pen_color 0,200,200:else:2d_pen_color 0,0,250:end_if
      2d_line x,0,x,height(1)
  end_if
next x
2d_image_copy 211,0,0,width(1),height(1): ' Copie de la grille
show 1
return

form_list:
color 2,180,180,180:width 2,400:height 2,330
left 2,(width(0)/2)+(width(2)/2):top 2,(height(0)/2-height(2)/2)
width 6,300:height 6,100
left 6,(width(2)/2)-(width(6)/2):top 2,(height(2)/2-height(6)/2):return
form_zr:
color 2,0,150,100:width 2,250:height 2,300
left 2,(width(0)/2)-(width(2)/2):top 2,(height(0)/2-height(2)/2):return
form_mpf:
color 2,200,200,200:width 2,400:height 2,330
left 2,(width(0)/2)+(width(2)/2):top 2,(height(0)/2-height(2)/2):return
retourne:
show 2:return

propos:
for j=11 to 17:inactive j:next j
msg$=    "PLANORAMIC créé le 14 Mars 2012 par Jean-Louis NAUDIN"+chr$(10)+chr$(13)
msg$=msg$+" Logiciel libre et gratuit. L'auteur ne peut pas être tenu"+chr$(10)+chr$(13)
msg$=msg$+" responsable des dommages éventuels suite à une mauvaise"+chr$(10)+chr$(13)
msg$=msg$+" utilisation de son logiciel."+chr$(10)+chr$(13)+chr$(10)+chr$(13)+chr$(10)+chr$(13)
msg$=msg$+"L'usage de ce programme à des fins commerciales est interdite."+chr$(10)+chr$(13)
message msg$
for j=11 to 17:active j:next j
return

aide:
' Pour Windows 7
if file_exists("c:\planoramic\aide_Planoramic.rtf")=1
  if file_exists("c:\Windows\write.exe")=1
      execute_wait "C:\Windows\write.exe C:\planoramic\aide_Planoramic.rtf"
  end_if
end_if
' Pour Windows XP
if file_exists("c:\planoramic\aide_Planoramic.rtf")=1
  if file_exists("c:\Windows\system32\write.exe")=1
      execute_wait "C:\Windows\system32\write.exe C:\planoramic\aide_Planoramic.rtf"
  end_if
end_if
return

fin:
if c>0
  a=message_warning_yes_no("VOULEZ-VOUS ENREGISTRER LES MODIFICATIONS AVANT DE QUITTER?")
  if a=1 then gosub enregistre
end_if
terminate
Je garde quand même un oeil sur panoramic et je vous souhaite une bonne soirée et une bonne continuation à tous.
A bientôt Wink
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jean Claude

avatar

Nombre de messages : 5086
Age : 63
Localisation : 83 Var
Date d'inscription : 07/05/2009

MessageSujet: Re: PLANORAMIC   Mer 14 Mar 2012 - 22:39

Bonne route à toi et reviens-nous vite... Very Happy
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
JL35



Nombre de messages : 6018
Localisation : 77
Date d'inscription : 29/11/2007

MessageSujet: Re: PLANORAMIC   Mer 14 Mar 2012 - 23:45

Bonsoir bignono, idem Jean Claude, beau boulot !
Et bonne chance dans tes recherches !
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Contenu sponsorisé




MessageSujet: Re: PLANORAMIC   

Revenir en haut Aller en bas
 
PLANORAMIC
Voir le sujet précédent Voir le sujet suivant Revenir en haut 
Page 3 sur 4Aller à la page : Précédent  1, 2, 3, 4  Suivant

Permission de ce forum:Vous ne pouvez pas répondre aux sujets dans ce forum
FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC :: PANORAMIC :: Vos projets-
Sauter vers: