FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC
Vous souhaitez réagir à ce message ? Créez un compte en quelques clics ou connectez-vous pour continuer.
FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC

Développement d'applications avec le langage Panoramic
 
AccueilAccueil  RechercherRechercher  Dernières imagesDernières images  S'enregistrerS'enregistrer  MembresMembres  Connexion  
Derniers sujets
» demande explication KGF pour imprimer en mm
PLANORAMIC - Page 2 Emptypar JL35 Aujourd'hui à 17:28

» Petit passage furtif
PLANORAMIC - Page 2 Emptypar Froggy One Hier à 14:26

» SPIN et aide langage (résolu)
PLANORAMIC - Page 2 Emptypar leclode Sam 23 Mar 2024 - 15:20

» Aide-mémoire des mots-clés Panoramic
PLANORAMIC - Page 2 Emptypar papydall Mer 20 Mar 2024 - 21:23

» Je ne comprend pas pourquoi la largeur de la scene 3d change
PLANORAMIC - Page 2 Emptypar Marc Mar 12 Mar 2024 - 20:06

» Comment télécharger panoramic?
PLANORAMIC - Page 2 Emptypar lepetitmarocain Sam 9 Mar 2024 - 13:31

» @lepetitmarocain <==> KGFGrid
PLANORAMIC - Page 2 Emptypar Klaus Dim 3 Mar 2024 - 9:59

» Tangram-Toukaré
PLANORAMIC - Page 2 Emptypar jjn4 Mer 28 Fév 2024 - 18:12

» Editeur EliP 6 : Le Tiny éditeur avec 25 onglets de travail
PLANORAMIC - Page 2 Emptypar jjn4 Mer 28 Fév 2024 - 18:09

» KGF_dll - nouvelles versions
PLANORAMIC - Page 2 Emptypar Klaus Mer 28 Fév 2024 - 17:01

» Mes souhaits d'amélioration de Panoramic.
PLANORAMIC - Page 2 Emptypar Pedro Lun 26 Fév 2024 - 18:12

» Testez-votre-QI
PLANORAMIC - Page 2 Emptypar jjn4 Dim 25 Fév 2024 - 17:12

» Utilisation d'Élip
PLANORAMIC - Page 2 Emptypar jjn4 Sam 24 Fév 2024 - 18:33

» Récapitulatif ludothèque panoramic jjn4
PLANORAMIC - Page 2 Emptypar jjn4 Sam 24 Fév 2024 - 18:11

» Générateur de mots de passe
PLANORAMIC - Page 2 Emptypar mindstorm Mar 20 Fév 2024 - 20:09

Navigation
 Portail
 Index
 Membres
 Profil
 FAQ
 Rechercher
Rechercher
 
 

Résultats par :
 
Rechercher Recherche avancée
Mars 2024
LunMarMerJeuVenSamDim
    123
45678910
11121314151617
18192021222324
25262728293031
CalendrierCalendrier
Le Deal du moment :
TCL C74 Series 55C743 – TV 55” 4K QLED 144 ...
Voir le deal
499 €

 

 PLANORAMIC

Aller en bas 
+3
JL35
Jicehel
bignono
7 participants
Aller à la page : Précédent  1, 2, 3, 4  Suivant
AuteurMessage
JL35




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

PLANORAMIC - Page 2 Empty
MessageSujet: Re: PLANORAMIC   PLANORAMIC - Page 2 EmptySam 3 Mar 2012 - 21:07

Bonjour bignono, une minute, j'étais de sortie et j'arrive seulement maintenant... mais ça paraît élémentaire, d'ailleurs tes deux questions sont le même problème ?

Voilà, la variable étant l'angle a, à voir les cas particuliers éventuels:
Code:

xf = xd + lg * COS(a)
yf = yd - lg * SIN(a)
En illustration du tracé d'un segment suivant un angle donné, une petite pendulette que j'avais publiée ici autrefois:
Code:
' Pendulette
DIM np, wp, hp, xc, yc, r, h, m, s, pi, rh, rm, rs, re
DIM a, ah, am, as, x, y, xph, yph, xpm, ypm, xps, yps, t$
LABEL rrb, Fin, Heure, Minute, Seconde

wp = 200: hp = 200: xc = wp/2: yc = hp/2
r = wp/2-5: re = r-8: rs = r-15: rm = rs-10: rh = rm-15
pi = 4*ATN(1)
xph = xc: yph = yc: xpm = xc: ypm = yc: xps = xc: yps = yc

WIDTH 0, wp: HEIGHT 0, hp: border_hide 0
np = 1
PICTURE np: FULL_SPACE np: COLOR np, 0, 255, 255
2D_TARGET_IS np: 2D_FILL_COLOR 255, 255, 255
2D_PEN_COLOR 255, 0, 0: 2D_PEN_WIDTH 3
2D_CIRCLE xc, yc, r
FOR a = 0 TO 2*pi STEP 2*pi/60
    x = xc + re*COS(a): y = yc + re*SIN(a)
    2D_CIRCLE x, y, 2
NEXT a
2D_PEN_COLOR 0, 0, 0
FOR a = 0 TO 2*pi STEP 2*pi/12
    x = xc + re*COS(a): y = yc + re*SIN(a)
    2D_CIRCLE x, y, 4
NEXT a
2D_FILL_COLOR 255, 0, 0
rrb:
WHILE TIME$ = t$: WAIT 200: END_WHILE
IF CLICKED(np) = 1 THEN GOTO Fin
PRINT_LOCATE 40, 400: PRINT TIME$
t$ = TIME$
h = VAL(LEFT$(t$, 2))
m = VAL(MID$(t$, 4, 2))
s = VAL(RIGHT$(t$, 2))
IF h >= 12 THEN h = h - 12
ah = h*2*pi/12: ' angle des heures
am = m*2*pi/60: ' angle des minutes
as = s*2*pi/60: ' angle des secondes
am = am + as/60: ah = ah + am/12
ah = pi/2 - ah: am = pi/2 - am: as = pi/2 - as
GOSUB Heure
GOSUB Minute
GOSUB Seconde
GOTO rrb
END
Fin:
TERMINATE

Heure:
2D_PEN_WIDTH 9
2D_PEN_COLOR 255, 255, 255: 2D_LINE xc, yc, xph, yph
2D_PEN_COLOR 0, 0, 0
xph = xc + rh*COS(ah): yph = yc + -1*rh*SIN(ah)
2D_LINE xc, yc, xph, yph
RETURN

Minute:
2D_PEN_WIDTH 7
2D_PEN_COLOR 255, 255, 255: 2D_LINE xc, yc, xpm, ypm
2D_PEN_COLOR 0, 0, 0
xpm = xc + rm*COS(am): ypm = yc + -1*rm*SIN(am)
2D_LINE xc, yc, xpm, ypm
RETURN

Seconde:
2D_PEN_WIDTH 2
2D_PEN_COLOR 255, 255, 255: 2D_LINE xc, yc, xps, yps
2D_PEN_COLOR 255, 0, 0
xps = xc + rs*COS(as): yps = yc + -1*rs*SIN(as)
2D_LINE xc, yc, xps, yps
2D_CIRCLE xc, yc, 8
RETURN


Dernière édition par JL35 le Sam 3 Mar 2012 - 23:06, édité 2 fois
Revenir en haut Aller en bas
bignono

bignono


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

PLANORAMIC - Page 2 Empty
MessageSujet: Re: PLANORAMIC   PLANORAMIC - Page 2 EmptySam 3 Mar 2012 - 22:57

Merci bien JL35.
Je continuerai mon prog demain, je suis trop fatigué. Wink Sleep
Revenir en haut Aller en bas
JL35




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

PLANORAMIC - Page 2 Empty
MessageSujet: Re: PLANORAMIC   PLANORAMIC - Page 2 EmptySam 3 Mar 2012 - 22:58

Bonsoir bignono, j'étais en train d'éditer mon message avec ma pendulette !
bonne nuit à toi ! Sleep
Revenir en haut Aller en bas
sergeauze

sergeauze


Nombre de messages : 391
Age : 71
Localisation : Hautes Alpes France
Date d'inscription : 09/01/2010

PLANORAMIC - Page 2 Empty
MessageSujet: Re: PLANORAMIC    PLANORAMIC - Page 2 EmptySam 3 Mar 2012 - 23:07

Salut à tous
Inspire par ce que fait jl 35 je me suis dit qu'un rectangle,on peut
aussi le faire tourner autour des son centre de gravite
https://panoramic.1fr1.net/t2109-silenceon-tourne.
Si ça peut servir ..
Je t'encourage à persister dans ton projet.
Le bouillonnement des idees du forum
m'incite à me perfectionner au contact des Panoraniciens
Bonne fin de soiree
Revenir en haut Aller en bas
http://sergeauze.blog-video.tv/
Jicehel

Jicehel


Nombre de messages : 5947
Age : 51
Localisation : 77500
Date d'inscription : 18/04/2011

PLANORAMIC - Page 2 Empty
MessageSujet: Re: PLANORAMIC   PLANORAMIC - Page 2 EmptyDim 4 Mar 2012 - 8:05

JL35, elle est bien ton horloge. Juste pour info, j'ai quand même modifié la première ligne de la routine rrb puisqu'en fait elle remplace une routine qui serait appelé par un timer mais le while était selon moi quand même non nécessaire, du coup j'ai mis directement:
rrb:
WAIT 80
IF CLICKED ...

Ideallement, je pense qui faudrait appeler rrb à chaque fois qu'un timer est atteind (réglé sur 500 par exemple).

Bon, aller, par principe, je mets le code de l'horloge avec le timer (désolé Bignono, c'est un peu hors sujet, mais je ne vais pas faire un post indépendant pour une petite modif sur un vieux programme de JL35 qu'il donne en illustration Smile ). Toutefois je l'aime bien son horloge alors bon ...

Code:
' Pendulette
DIM np, wp, hp, xc, yc, r, h, m, s, pi, rh, rm, rs, re
DIM a, ah, am, as, x, y, xph, yph, xpm, ypm, xps, yps, t$
LABEL rrb, Fin, Trace, Dessine_Cadran

wp = 200: hp = 200: xc = wp/2: yc = hp/2
r = wp/2-5: re = r-8: rs = r-15: rm = rs-10: rh = rm-15
pi = 4*ATN(1)
xph = xc: yph = yc: xpm = xc: ypm = yc: xps = xc: yps = yc

WIDTH 0, wp: HEIGHT 0, hp: border_hide 0
np = 1
PICTURE np: FULL_SPACE np: COLOR np, 0, 255, 255
2D_TARGET_IS np
GOSUB Dessine_Cadran
GOSUB rrb
TIMER 10 : TIMER_INTERVAL 10,500 : ON_TIMER 10,RRB
END

Dessine_Cadran:
2D_FILL_COLOR 255, 255, 255
2D_PEN_COLOR 255, 0, 0: 2D_PEN_WIDTH 3
2D_CIRCLE xc, yc, r
FOR a = 0 TO 2*pi STEP 2*pi/60
    x = xc + re*COS(a): y = yc + re*SIN(a)
    2D_CIRCLE x, y, 2
NEXT a
2D_PEN_COLOR 0, 0, 0
FOR a = 0 TO 2*pi STEP 2*pi/12
    x = xc + re*COS(a): y = yc + re*SIN(a)
    2D_CIRCLE x, y, 4
NEXT a
RETURN

rrb:
WAIT 80
IF CLICKED(np) = 1 THEN GOTO Fin
PRINT_LOCATE 40, 400: PRINT TIME$
t$ = TIME$
h = VAL(LEFT$(t$, 2))
m = VAL(MID$(t$, 4, 2))
s = VAL(RIGHT$(t$, 2))
IF h >= 12 THEN h = h - 12
ah = h*2*pi/12: ' angle des heures
am = m*2*pi/60: ' angle des minutes
as = s*2*pi/60: ' angle des secondes
am = am + as/60: ah = ah + am/12
ah = pi/2 - ah: am = pi/2 - am: as = pi/2 - as
GOSUB Trace
RETURN

Trace:
2D_PEN_COLOR 255, 255, 255 : ' On efface les aiguilles
2D_PEN_WIDTH 9 : 2D_LINE xc, yc, xph, yph
2D_PEN_WIDTH 7 : 2D_LINE xc, yc, xpm, ypm
2D_PEN_WIDTH 2 : 2D_LINE xc, yc, xps, yps
2D_PEN_COLOR 0, 0, 0      : ' On trace les aiguilles des heures et minutes en noir
xph = xc + rh*COS(ah): yph = yc + -1*rh*SIN(ah)
2D_PEN_WIDTH 9 : 2D_LINE xc, yc, xph, yph
xpm = xc + rm*COS(am): ypm = yc + -1*rm*SIN(am)
2D_PEN_WIDTH 7 : 2D_LINE xc, yc, xpm, ypm
2D_PEN_COLOR 255, 0, 0  : ' On trace la trotteuse en rouge
xps = xc + rs*COS(as): yps = yc + -1*rs*SIN(as)
2D_PEN_WIDTH 2 : 2D_LINE xc, yc, xps, yps
' 2D_LINE xc, yc, xpm, ypm : 2D_LINE xc, yc, xph, yph : ' Si on veut on trace en rouge le centre des autres aiguilles
RETURN

Fin:
TERMINATE
Revenir en haut Aller en bas
bignono

bignono


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

PLANORAMIC - Page 2 Empty
MessageSujet: Re: PLANORAMIC   PLANORAMIC - Page 2 EmptyDim 4 Mar 2012 - 8:28

Bonjour à tous, Smile
@Sergeauze
Merci, mais j'avais déjà vu ton post l'autre jour, et ton programme je l'ai mis de coté pour une une éventuzlle utilisation.

@Jicehel,
Sympa ton horloge. Manque un peu de chiffres. Et puis la trotteuse qui bouge par à coup toutes les secondes! Y-aurait pas moyen de lui faire faire un déplacement plus fluide? Wink

Bon, allez je me met au travail ce matin.
Tiens, comme tu es en ligne Jicehel, je te mets le code provisoire de PLANORAMIC la fonction "modifier mur" est opérationnelle et tu peux la tester. Pas la peine d'essayer "modifier porte et modifier fenêtre", c'est pas fini encore et je vais tâcher de le faire aujourd'hui.
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
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),undo(50),unimage(50)
dim dx(1000),dy(1000),fx(1000),fy(1000),ep(1000),hm(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
label cliquer,init,grille,regle,refait_plan,motif_mur
label pos_souris,test_spin,calcul_points
label cherche_seg,fait_ligne,cherche_num
label mur,cote,aire,texte,zoom
label selection,modifmur,divismur,porte,fenetre,modifporte,modifent
label annule,refait,copie,colle,supprime
label aerien,visite,photo
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:picture 1:width 1,5000:height 1,5000

form 2:hide 2:dlist 5:' hide 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,"Coller"        :on_click 33,colle
sub_menu 34:parent 34,12:caption 34,"Supprimer"    :on_click 34,supprime

' 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 cotes"  :on_click 41,cote
sub_menu 42:parent 42,13:caption 42,"Créer surface" :on_click 42,aire
sub_menu 43:parent 43,13:caption 43,"Créer texte"  :on_click 43,texte
sub_menu 44:parent 44,13:caption 44,"Zoom"          :on_click 44,zoom          :' FAIT

' sous-menu Commandes
sub_menu 50:parent 50,14:caption 50,"Modifier mur"  :on_click 50,modifmur
sub_menu 51:parent 51,14:caption 51,"Diviser mur"  :on_click 51,divismur
sub_menu 52:parent 52,14:caption 52,"Ajout porte"  :on_click 52,porte        :' FAIT
sub_menu 53:parent 53,14:caption 53,"Ajout fenêtre" :on_click 53,fenetre      :' FAIT
sub_menu 54:parent 54,14:caption 54,"Modifier porte":on_click 54,modifporte
sub_menu 55:parent 55,14:caption 55,"Modifier fenêtre":on_click 55,modifent

' 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 2,(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,195:width 110,120:caption 110,"TEXTURE (3D)"
button 111:hide 111:left 111,220:top 111,230:width 111,120:caption 111,"VALIDER"
check 112:hide 112:left 112, 20:top 112,25:caption 112,"INVERSER"
check 113:hide 113:left 113,220:top 113,25:caption 113,"MIROIR"
edit 114:hide 114:width 114,20:left 114,120:top 114,135:color 114,180,180,180
spin 115:hide 115::left 115, 20:top 115,195:min 115,0:max 115,359:' spin angle

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:
pi=4*atn(1):ha%=20:gr=1:rg=1:z=1
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)
  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)
  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: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

cote:
aire:
texte:
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 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

selection:
  if j>0
      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
  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
  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%
  mclic=0:j=i
return

modifmur:
for j=11 to 17:inactive j:next j
' NE PAS OUBLIER DE BLOQUER LE MENU
' Modification d'un mur:
' 1°) afficher un list avec seulement les murs  ===> FAIT
' 2°) un clic colore le mur en rouge            ===> FAIT
' 3°) deux clics colore le mur en rouge, le sélectionne et ouvre le form suivant  ===> FAIT
' 4°) une fois que l'on a fait les changements et validé
'    on recolore en noir et on enregistre les nouvelles données
caption 2,"LISTE DES MURS":gosub form_list
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="MURS" then item_add 6,ligne$(i)
next i
show 2:print_target_is 2:font_bold 2
j=0:show 6:on_click 6,cliquer
while mclic<>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

print_locate 7,10:print "DÉBUTE À:"
show 103:print_locate 7,  30:print "X":print_locate 145,30:print "cm"
show 104:print_locate 207,30:print "Y":print_locate 345,30:print "cm"
print_locate 7,60:print "TERMINE À:"
show 105:print_locate 7,  80:print "X":print_locate 145,80:print "cm"
show 106:print_locate 207,80:print "Y":print_locate 345,80:print "cm"
print_locate 20,120:print "LONGUEUR"
show 107:print_locate 145,140:print "cm"
print_locate 220,120:print "HAUTEUR"
show 108:print_locate 345,140:print "cm"
print_locate 20,180:print "ÉPAISSEUR"
show 109:print_locate 145,200:print "cm"
show 110:show 111:show 114
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
  gosub test_spin
  position 107,sqr(power(position(105)-position(103),2)+power(position(104)-position(106),2))
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:typ$(i)="MURS"
gosub fait_ligne:item_delete 5,i:item_insert 5,i,ligne$(i)
2d_target_is 2:for j=103 to 111:hide j:next j:hide 114:cls: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:for j=11 to 17:active j:next j
return

divismur:
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
      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
      ' Tracé ouvrant droit <=== A IMPLÉMENTER DANS MODIFIER PORTE
      ' 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%
      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: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
        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
        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: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

modifporte:
for j=11 to 17:inactive j:next j
' Modification d'une porte:
' 1°) afficher un list avec seulement les portes ==> FAIT
' 2°) un clic colore la porte sélectionnée en rouge ==> FAIT
' 3°) deux clics colore la porte en rouge, la sélectionne et ouvre le form suivant ==> FAIT
' 4°) une fois que l'on a fait les changements et validé,
'    on recolore en noir et on enregistre les nouvelles données
caption 2,"LISTE DES PORTES":gosub form_list
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="PORT" then item_add 6,ligne$(i)
next i
show 2:print_target_is 2:font_bold 2
j=0:show 6:on_click 6,cliquer
while mclic<>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
print_locate 7,60:print "POSITION:"
show 105:print_locate 7,  80:print "X":print_locate 145,80:print "cm"
show 106:print_locate 207,80:print "Y":print_locate 345,80:print "cm"
print_locate 20,120:print "LARGEUR"
show 107:print_locate 145,140:print "cm"
print_locate 220,120:print "HAUTEUR"
show 108:print_locate 345,140:print "cm"
print_locate 20,180:print "ANGLE"
show 115:print_locate 145,200:print "°"
show 110:show 111:show 112:show 113

position 105,val(seg$(2)):position 106,val(seg$(3))
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 115,a

while clicked(111)=0
  gosub test_spin
'  position 107,sqr(power(position(105)-position(103),2)+power(position(104)-position(106),2))
end_while

2d_target_is 2:for j=105 to 115:hide j:next j:cls:hide 2
for j=11 to 17:active j:next j
return
' ******************************************************************************
' ******************************************************************************
' ******************************************************************************
dim xd, yd, xf, yf, lg, a, pi
pi = 4*atn(1)

picture 1: full_space 1
2d_target_is 1
xd = 300: yd = 200 : lg = 150
for a = 0 TO 2*pi step pi/8
    xf = xd + lg * COS(a)
    yf = yd - lg * SIN(a)
    2D_line xd,yd,xf,yf
next a
end
' ******************************************************************************
' ******************************************************************************
' ******************************************************************************
modifent:
' Modification d'une fenêtre:
' 1°) afficher un list avec seulement les fenêtres
' 2°) un clic colore la fenêtre sélectionnée en rouge
' 3°) deux clics colore la fenêtre en rouge, la sélectionne et ouvre le form suivant
' 4°) une fois que l'on a fait les changements et validé, on recolore en noir et on enregistre les nouvelles données
caption 2,"MODIFIER FENÊTRE":gosub form_mpf
show 2:print_target_is 2:font_bold 2
print_locate 7,60:print "POSITION:"
show 105:print_locate 7,  80:print "X":print_locate 145,80:print "cm"
show 106:print_locate 207,80:print "Y":print_locate 345,80:print "cm"
print_locate 20,120:print "LARGEUR"
show 107:print_locate 145,140:print "cm"
print_locate 220,120:print "HAUTEUR"
show 108:print_locate 345,140:print "cm"
print_locate 20,180:print "ANGLE"
show 109:print_locate 145,200:print "°"
show 110:show 111:show 112
while scancode=0:end_while:wait 200
while scancode=0:end_while
2d_target_is 2:for j=105 to 112:hide j:next j:cls:hide 2
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))+"*"
end_if
if typ$(i)="COTE"
end_if
if typ$(i)="AIRE"
end_if
if typ$(i)="TXTE"
end_if
return

propos:
aide:
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(107)>9900 then position 107,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
' if position(107)<1
'    position 103,position(103)-1
'    position 105,position(105)+1
'    position 104,position(104)-1
'    position 106,position(106)+1
' end_if
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
print_locate 45,60:print "  Style des murs  "
print_locate 60,10:print " cm. Épaisseur des murs "
print_locate 60,35:print " cm.  Hauteur  des murs "
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 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: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:
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)
      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
      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%
      ' Tracé ouvrant droit <=== A IMPLÉMENTER DANS MODIFIER PORTE
      ' 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
  ' RESTAURER LES FENETRES
  if seg$(1)="FENT"
      pfstyl=0:gosub motif_mur:pfstyl=1
      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
  ' A FAIRE RESTAURER LES COTES  <*******************
  if seg$(1)="COTE"
  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
annule:
refait:
copie:
colle:
supprime:
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,200:height 2,250
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,300
left 2,(width(0)/2)-(width(2)/2):top 2,(height(0)/2-height(2)/2):return
fin:
terminate
Revenir en haut Aller en bas
Jicehel

Jicehel


Nombre de messages : 5947
Age : 51
Localisation : 77500
Date d'inscription : 18/04/2011

PLANORAMIC - Page 2 Empty
MessageSujet: Re: PLANORAMIC   PLANORAMIC - Page 2 EmptyDim 4 Mar 2012 - 8:50

Un petit bug si l'on veut car sinon, la fonction marche nickel: si l'utilisateur est en zoom par exemple et qu'il a ouvert la fenêtre modifier (par un double clic dans la liste, par exemple), s'il clique sur la fenêtre de dessin, celle ci passe en avant plan avec les menus désactivés et l'utilisateur se retrouve bloqué. Je serais toi ,je désactiverais le traitement du clic pour le réactiver à la fermeture de la fenêtre modifier
Revenir en haut Aller en bas
Klaus

Klaus


Nombre de messages : 12274
Age : 74
Localisation : Ile de France
Date d'inscription : 29/12/2009

PLANORAMIC - Page 2 Empty
MessageSujet: Re: PLANORAMIC   PLANORAMIC - Page 2 EmptyDim 4 Mar 2012 - 10:01

Si je peux me permettre d'intervenir dans cette discussion:

J'ai rencontré le même problème dans quantité de mes programmes: ouvrir une fenêtre de saisie et bloquer l'accès aux autres fenêtres tant que la fenêtre de saisie n'est pas fermée de façon contrôlée.

Ma solution (utilisée entre autres dans mon éditeur de fichiers ini):
avant de faire SHOW de la fenêtre de saisie, je fais INACTIVE sur le form 0 ainsi que sur toutes les autres fenêtres éventuellement actives. Sur la fenêtre de saisie, dans le bouton de validation et/ou d'annulation, je fais HIDE de cette fenêtre, puis ACTIVE sur toutes les fenêtres déactivées. Et pour maîtriser le problème de la croix rouge, je déclare ON_CLOSE sur la fenêtre de saisie, avec une routine qui restaure également l'état des autres fenêtres.

Ainsi, on n'a pas besoin de toucher aux évènements ON_xxx des objets hors de la fenêtre de saisie.
Revenir en haut Aller en bas
http://klauspanoramic.comxa.com/index.html
Jicehel

Jicehel


Nombre de messages : 5947
Age : 51
Localisation : 77500
Date d'inscription : 18/04/2011

PLANORAMIC - Page 2 Empty
MessageSujet: Re: PLANORAMIC   PLANORAMIC - Page 2 EmptyDim 4 Mar 2012 - 10:19

Et comment que tu peux intervenir Klaus!! Smile Bien sûr tu as raison sur ton intervention et le Inactive / active de la fenêtre sera beaucoup plus simple et efficace
Revenir en haut Aller en bas
bignono

bignono


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

PLANORAMIC - Page 2 Empty
MessageSujet: Re: PLANORAMIC   PLANORAMIC - Page 2 EmptyDim 4 Mar 2012 - 10:43

Bon je vous donne ma solution si on clique en dehors du form sur lequel on travaille pour éviter qu'il passe en arrière plan.
Je rajoute juste un test: if clicked(1)=1 then to_foreground 2 (2 étant le form sur lequel on travaille et 1 le picture qui doit resté en arrière plan) Je trouve cette solution plus simple et même si on clique dans la barre de titre du form 0, le form 2 disparait, mais en cliquant sur le picture il réapparait. Pour ce qui est des boutons du form (tiret, carré et croix) un simple border_hide 2 suffit en début de programme. J'enlèverais plus tard mes caption et je ferais un alpha ou un print bien placé sur mon form 2 pour avoir un titre ou une indication sur ce qu'on est en train de traiter.
Code provisoire, mais les fonctions modif porte et fenêtre sont toujours en cours et me posent problèmes!
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
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),undo(50),unimage(50)
dim dx(1000),dy(1000),fx(1000),fy(1000),ep(1000),hm(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
label cliquer,init,grille,regle,refait_plan,motif_mur
label pos_souris,test_spin,calcul_points
label cherche_seg,fait_ligne,cherche_num
label mur,cote,aire,texte,zoom
label selection,modifmur,divismur,porte,fenetre,modifporte,modifent
label annule,refait,copie,colle,supprime
label aerien,visite,photo
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:picture 1:width 1,5000:height 1,5000

form 2:hide 2:border_hide 2:dlist 5:' hide 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,"Coller"        :on_click 33,colle
sub_menu 34:parent 34,12:caption 34,"Supprimer"    :on_click 34,supprime

' 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 cotes"  :on_click 41,cote
sub_menu 42:parent 42,13:caption 42,"Créer surface" :on_click 42,aire
sub_menu 43:parent 43,13:caption 43,"Créer texte"  :on_click 43,texte
sub_menu 44:parent 44,13:caption 44,"Zoom"          :on_click 44,zoom          :' 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,"Diviser mur"  :on_click 51,divismur
sub_menu 52:parent 52,14:caption 52,"Ajout porte"  :on_click 52,porte        :' FAIT
sub_menu 53:parent 53,14:caption 53,"Ajout fenêtre" :on_click 53,fenetre      :' FAIT
sub_menu 54:parent 54,14:caption 54,"Modifier porte":on_click 54,modifporte
sub_menu 55:parent 55,14:caption 55,"Modifier fenêtre":on_click 55,modifent

' 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,195:width 110,120:caption 110,"TEXTURE (3D)"
button 111:hide 111:left 111,220:top 111,230:width 111,120:caption 111,"VALIDER"
check 112:hide 112:left 112, 20:top 112,25:caption 112,"INVERSER"
check 113:hide 113:left 113,220:top 113,25:caption 113,"MIROIR"
edit 114:hide 114:width 114,20:left 114,120:top 114,135:color 114,180,180,180
spin 115:hide 115::left 115, 20:top 115,195:min 115,0:max 115,359:' spin angle

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:
pi=4*atn(1):ha%=20:gr=1:rg=1:z=1
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)
  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)
  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: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

cote:
aire:
texte:
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

selection:
  if j>0
      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
  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
  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%
  mclic=0:j=i
return

modifmur:
for j=11 to 17:inactive j:next j
' NE PAS OUBLIER DE BLOQUER LE MENU
' Modification d'un mur:
' 1°) afficher un list avec seulement les murs  ===> FAIT
' 2°) un clic colore le mur en rouge            ===> FAIT
' 3°) deux clics colore le mur en rouge, le sélectionne et ouvre le form suivant  ===> FAIT
' 4°) une fois que l'on a fait les changements et validé
'    on recolore en noir et on enregistre les nouvelles données
caption 2,"LISTE DES MURS":gosub form_list
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="MURS" then item_add 6,ligne$(i)
next i
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

print_locate 7,10:print "DÉBUTE À:"
show 103:print_locate 7,  30:print "X":print_locate 145,30:print "cm"
show 104:print_locate 207,30:print "Y":print_locate 345,30:print "cm"
print_locate 7,60:print "TERMINE À:"
show 105:print_locate 7,  80:print "X":print_locate 145,80:print "cm"
show 106:print_locate 207,80:print "Y":print_locate 345,80:print "cm"
print_locate 20,120:print "LONGUEUR"
show 107:print_locate 145,140:print "cm"
print_locate 220,120:print "HAUTEUR"
show 108:print_locate 345,140:print "cm"
print_locate 20,180:print "ÉPAISSEUR"
show 109:print_locate 145,200:print "cm"
show 110:show 111:show 114
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
  position 107,sqr(power(position(105)-position(103),2)+power(position(104)-position(106),2))
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:typ$(i)="MURS"
gosub fait_ligne:item_delete 5,i:item_insert 5,i,ligne$(i)
2d_target_is 2:for j=103 to 111:hide j:next j:hide 114:cls: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:for j=11 to 17:active j:next j
return

divismur:
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
      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
      ' Tracé ouvrant droit <=== A IMPLÉMENTER DANS MODIFIER PORTE
      ' 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%
      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: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
        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
        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: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

modifporte:
for j=11 to 17:inactive j:next j
' Modification d'une porte:
' 1°) afficher un list avec seulement les portes ==> FAIT
' 2°) un clic colore la porte sélectionnée en rouge ==> FAIT
' 3°) deux clics colore la porte en rouge, la sélectionne et ouvre le form suivant ==> FAIT
' 4°) une fois que l'on a fait les changements et validé,
'    on recolore en noir et on enregistre les nouvelles données
caption 2,"LISTE DES PORTES":gosub form_list
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="PORT" then item_add 6,ligne$(i)
next i
show 2:print_target_is 2:font_bold 2
j=0:show 6:on_click 6,cliquer
while mclic<>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
print_locate 7,60:print "POSITION:"
show 105:print_locate 7,  80:print "X":print_locate 145,80:print "cm"
show 106:print_locate 207,80:print "Y":print_locate 345,80:print "cm"
print_locate 20,120:print "LARGEUR"
show 107:print_locate 145,140:print "cm"
print_locate 220,120:print "HAUTEUR"
show 108:print_locate 345,140:print "cm"
print_locate 20,180:print "ANGLE"
show 115:print_locate 145,200:print "°"
show 110:show 111:show 112:show 113

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))

' position 105,val(seg$(2)):position 106,val(seg$(3))
' 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 105,dx(i):position 106,dy(i)
 position 107,sqr(power(fx(i)-dx(i),2)+power(dy(i)-fy(i),2))
 position 108,hm(i):position 115,a

while clicked(111)=0
  gosub test_spin
  position 105,fx(i)-position(107)*cos(a)
  position 106,fy(i)-position(107)*sin(a)
  position 107,sqr(power(position(105)-fx(i),2)+power(fy(i)-position(106),2))

end_while

2d_target_is 2:for j=105 to 115:hide j:next j:cls:hide 2
for j=11 to 17:active j:next j
return
' ******************************************************************************
' ******************************************************************************
' ******************************************************************************
dim xd, yd, xf, yf, lg, a, pi
pi = 4*atn(1)

picture 1: full_space 1
2d_target_is 1
xd = 300: yd = 200 : lg = 150
for a = 0 TO 2*pi step pi/8
    xf = xd + lg * COS(a)
    yf = yd - lg * SIN(a)
    2D_line xd,yd,xf,yf
next a
end
' ******************************************************************************
' ******************************************************************************
' ******************************************************************************
modifent:
' Modification d'une fenêtre:
' 1°) afficher un list avec seulement les fenêtres
' 2°) un clic colore la fenêtre sélectionnée en rouge
' 3°) deux clics colore la fenêtre en rouge, la sélectionne et ouvre le form suivant
' 4°) une fois que l'on a fait les changements et validé, on recolore en noir et on enregistre les nouvelles données
caption 2,"MODIFIER FENÊTRE":gosub form_mpf
show 2:print_target_is 2:font_bold 2
print_locate 7,60:print "POSITION:"
show 105:print_locate 7,  80:print "X":print_locate 145,80:print "cm"
show 106:print_locate 207,80:print "Y":print_locate 345,80:print "cm"
print_locate 20,120:print "LARGEUR"
show 107:print_locate 145,140:print "cm"
print_locate 220,120:print "HAUTEUR"
show 108:print_locate 345,140:print "cm"
print_locate 20,180:print "ANGLE"
show 109:print_locate 145,200:print "°"
show 110:show 111:show 112
while scancode=0:end_while:wait 200
while scancode=0:end_while
2d_target_is 2:for j=105 to 112:hide j:next j:cls:hide 2
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))+"*"
end_if
if typ$(i)="COTE"
end_if
if typ$(i)="AIRE"
end_if
if typ$(i)="TXTE"
end_if
return

propos:
aide:
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(107)>9900 then position 107,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
' if position(107)<1
'    position 103,position(103)-1
'    position 105,position(105)+1
'    position 104,position(104)-1
'    position 106,position(106)+1
' end_if
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
print_locate 45,60:print "  Style des murs  "
print_locate 60,10:print " cm. Épaisseur des murs "
print_locate 60,35:print " cm.  Hauteur  des murs "
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: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:
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)
      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
      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%
      ' Tracé ouvrant droit <=== A IMPLÉMENTER DANS MODIFIER PORTE
      ' 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
  ' RESTAURER LES FENETRES
  if seg$(1)="FENT"
      pfstyl=0:gosub motif_mur:pfstyl=1
      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
  ' A FAIRE RESTAURER LES COTES  <*******************
  if seg$(1)="COTE"
  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
annule:
refait:
copie:
colle:
supprime:
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,200:height 2,250
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,300
left 2,(width(0)/2)-(width(2)/2):top 2,(height(0)/2-height(2)/2):return
fin:
terminate
PS: Klaus tu peux intervenir sans problèmes, même tout le monde. C'est en mettant nos connaissances en commun qu'on avancera plus vite!
Revenir en haut Aller en bas
Jicehel

Jicehel


Nombre de messages : 5947
Age : 51
Localisation : 77500
Date d'inscription : 18/04/2011

PLANORAMIC - Page 2 Empty
MessageSujet: Re: PLANORAMIC   PLANORAMIC - Page 2 EmptyDim 4 Mar 2012 - 10:55

Petits bugs:
- bloqué si l'on modifie un mur alors que l'on n'en a pas encore créé
- Il manque les flèches pour augmenter / diminuer la longueur
- Après une question, dans ta liste, tu mets: 1*MURS*.... pourquoi un S à mur ?
(bon d'accord, la dernière est vraiment une broutille, mais bon, tant qu'à faire ...)

Sinon, la gestion de la fenêtre active est très bien
Revenir en haut Aller en bas
bignono

bignono


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

PLANORAMIC - Page 2 Empty
MessageSujet: Re: PLANORAMIC   PLANORAMIC - Page 2 EmptyDim 4 Mar 2012 - 11:17

Je sais pour le bug si aucun mur n'est créé/ Je verrais ça plus tard. pour ce qui est MURS, tu remarquera que j'utilise PORT pour porte, FENT pour fenêtre, il y aura COTE pour cote, AIRE pour surface (si j'arrive à développer cette fonction, ça c'est moins sur!) et TXTE pour texte. Ce sont mes mots clés d'une longueur de 4 caractères pour me repérer dans un futur fichier pour enregistrer les données ou pour ouvrir ce fichier. Cela s'affiche comme ça dans le list de sélection, mais rien ne m'empêche plus tard de faire un affichage du type MUR N° 001 *100*100..., MUR N°002 *200*150*..., etc dans le même list afin que cela soit compréhensible pour l'utilisateur. Tout ça c'est un peu le même principe que j'ai utilisé dans 3d_world.
A+ Wink
Revenir en haut Aller en bas
bignono

bignono


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

PLANORAMIC - Page 2 Empty
MessageSujet: Re: PLANORAMIC   PLANORAMIC - Page 2 EmptyDim 4 Mar 2012 - 11:27

J'allais oublier:
pour les flèches pour diminuer / augmenter la longueur du mur, je les ai cachées avec un edit positionné dessus, puisque quand tu changes la valeur des points x,y du début et x,y de fin la longueur se recalcule automatiquement, donc les flèches sont inutiles!
Revenir en haut Aller en bas
Jicehel

Jicehel


Nombre de messages : 5947
Age : 51
Localisation : 77500
Date d'inscription : 18/04/2011

PLANORAMIC - Page 2 Empty
MessageSujet: Re: PLANORAMIC   PLANORAMIC - Page 2 EmptyDim 4 Mar 2012 - 11:41

ok c'est logique. Je me suis dit que tu les laissais pour si le mur devait avoir une longueur particulière (je pensais que c'était en partie la question que tu avais posé à JL35 pour déterminer à partir du point d'origine et de la longueur, les coordonnées du point d'arrivée)
Revenir en haut Aller en bas
JL35




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

PLANORAMIC - Page 2 Empty
MessageSujet: Re: PLANORAMIC   PLANORAMIC - Page 2 EmptyDim 4 Mar 2012 - 14:30

[mode hs horloge]
@Jicehel je retiens ta modif, c'est plus simple... et il n'y a plus le trait blanc sur les aiguilles au passage de celle des secondes, toutefois je maintiens le timer à 200 ou 300 ms, sinon l'aiguille saute une seconde de temps en temps.
@bignono le mouvement saccadé de l'aiguille des secondes ne me choque pas, c'est courant et réaliste... et pour les chiffres, ceci n'est que le mouvement d'horlogerie, c'est assez simple pour que n'importe qui l'accommode à son goût !
[mode hs off]

@bignono
je commence juste à regarder ton code, mais un truc très désagréable (chez moi du moins) c'est au lancement (s/p init) ce clignotement de plusieurs secondes pendant le dessin de la grille et des règles.
Par contre si je fais:
Code:
init:
HIDE 1
.....
gosub grille: gosub regle
SHOW 1
return
1) l'exécution du s/p est bien plus rapide
2) évidemment plus de clignotement
Qu'en penses-tu ?

En fait c'est le s/p regle qui fait clignoter, on peut donc faire simplement:
gosub grille: hide 1: gosub regle: show 1
ou carrément dans le s/p, hide au début et show à la fin.
Revenir en haut Aller en bas
bignono

bignono


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

PLANORAMIC - Page 2 Empty
MessageSujet: Re: PLANORAMIC   PLANORAMIC - Page 2 EmptyDim 4 Mar 2012 - 15:08


Bonjour et Merci JL35, c'est bien plus rapide comme ça! Very Happy Wink
Revenir en haut Aller en bas
JL35




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

PLANORAMIC - Page 2 Empty
MessageSujet: Re: PLANORAMIC   PLANORAMIC - Page 2 EmptyDim 4 Mar 2012 - 17:02

Une suggestion:
Quand on trace un mur assez long, il peut arriver qu'on relâche le bouton alors que le mur n'est pas tout à fait horizontal ou vertical.
Et on ne peut pas corriger, les fonctions du menu Edition sont inopérantes.
J'ai un logiciel de dessin vectoriel où, quand on trace une droite, si on appuie en même temps sur la touche Maj, et qu'on est proche de la verticale, l'horizontale, ou 45°, le trait s'oriente automatiquement sur la verticale, l'horizontale ou 45° le plus proche, un peu comme l'attraction de la grille.
Ça paraît logique du fait que sur le plan les murs sont, dans l'immense majorité des cas, verticaux ou horizontaux.

Un truc qui me gêne, également, c'est que la fenêtre de dessin prend tout l'écran, qu'on ne peut pas la redimensionner ni la déplacer, et qu'elle cache tout ce qui se trouve derrière, seule solution la minimiser dans la barre des tâches.
Revenir en haut Aller en bas
bignono

bignono


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

PLANORAMIC - Page 2 Empty
MessageSujet: Re: PLANORAMIC   PLANORAMIC - Page 2 EmptyDim 4 Mar 2012 - 19:12

Bonsoir JL35,
Ce n'est pas toujours vrai ce que tu dis, les murs ne sont pas tout le temps horizontaux ou verticaux. Autrement j'aurais programmé comme cela PLANORAMIC et ça aurait été plus simple pour moi. Dans la maison que je fais bâtir à Bamako avec ma femme, le terrain n'est pas rectangulaire, et j'aurais un angle de maison d'environ 97°. On peut aussi faire une maison en forme de pentagone et les angles ont environ 108° je crois. Une forme octogonale ou dodécagonale ou circulaire sont aussi envisageable pour une maison.
C'est pour ces raisons que je laisse le tracé des murs tels quels. Je développe le programme au fur et à mesure et à chaque nouvelle fonction faite je met en ligne.
Mais avec ce programme, je me rends compte de mes limites. Ce genre de logiciel fait appel à des calculs hyper pointus et je ne suis pas loin de jeter l'éponge là.
Bon, cela dit, j'ai revu la fonction "modifier mur" et maintenant on peut modifier soit le point de départ soit le point d'arrivée comme avant, mais on peut aussi maintenant modifier directement la longueur du mur et le point d'arrivée se modifiera automatiquement.
J'ai réussi en partie à coder (je dis en partie car il y a un truc qui me chiffonne) à coder "Modifier porte", et le sens d'ouverture m'a causé quelques soucis.
Je vais essayer dans la soirée de coder "Modifier fenêtre"
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),undo(50),unimage(50)
dim dx(1000),dy(1000),fx(1000),fy(1000),ep(1000),hm(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
label cliquer,init,grille,regle,refait_plan,motif_mur
label pos_souris,test_spin,calcul_points
label cherche_seg,fait_ligne,cherche_num
label mur,cote,aire,texte,zoom
label selection,modifmur,divismur,porte,fenetre,modifporte,modifent
label annule,refait,copie,colle,supprime
label aerien,visite,photo
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:picture 1:width 1,5000:height 1,5000

form 2:hide 2:border_hide 2:dlist 5:' hide 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,"Coller"        :on_click 33,colle
sub_menu 34:parent 34,12:caption 34,"Supprimer"    :on_click 34,supprime

' 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 cotes"  :on_click 41,cote
sub_menu 42:parent 42,13:caption 42,"Créer surface" :on_click 42,aire
sub_menu 43:parent 43,13:caption 43,"Créer texte"  :on_click 43,texte
sub_menu 44:parent 44,13:caption 44,"Zoom"          :on_click 44,zoom          :' 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,"Diviser mur"  :on_click 51,divismur
sub_menu 52:parent 52,14:caption 52,"Ajout porte"  :on_click 52,porte        :' FAIT
sub_menu 53:parent 53,14:caption 53,"Ajout fenêtre" :on_click 53,fenetre      :' FAIT
sub_menu 54:parent 54,14:caption 54,"Modifier porte":on_click 54,modifporte
sub_menu 55:parent 55,14:caption 55,"Modifier fenêtre":on_click 55,modifent

' 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"

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:
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)
  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: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

cote:
aire:
texte:
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

selection:
  if j>0
      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
  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
  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%
  mclic=0:j=i
return

modifmur:
for j=11 to 17:inactive j:next j
' NE PAS OUBLIER DE BLOQUER LE MENU
' Modification d'un mur:
' 1°) afficher un list avec seulement les murs  ===> FAIT
' 2°) un clic colore le mur en rouge            ===> FAIT
' 3°) deux clics colore le mur en rouge, le sélectionne et ouvre le form suivant  ===> FAIT
' 4°) une fois que l'on a fait les changements et validé
'    on recolore en noir et on enregistre les nouvelles données
caption 2,"LISTE DES MURS":gosub form_list
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="MURS" then item_add 6,ligne$(i)
next i
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

print_locate 7,10:print "DÉBUTE À:"
show 103:print_locate 7,  30:print "X":print_locate 145,30:print "cm"
show 104:print_locate 207,30:print "Y":print_locate 345,30:print "cm"
print_locate 7,60:print "TERMINE À:"
show 105:print_locate 7,  80:print "X":print_locate 145,80:print "cm"
show 106:print_locate 207,80:print "Y":print_locate 345,80:print "cm"
print_locate 20,120:print "LONGUEUR"
show 107:print_locate 145,140:print "cm"
print_locate 220,120:print "HAUTEUR"
show 108:print_locate 345,140:print "cm"
print_locate 20,180:print "ÉPAISSEUR"
show 109:print_locate 145,200:print "cm"
show 110:show 111
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
'  faire un print locate de l'angle après calcul
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:typ$(i)="MURS"
gosub fait_ligne:item_delete 5,i:item_insert 5,i,ligne$(i)
2d_target_is 2:for j=103 to 111:hide j:next j:cls: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:for j=11 to 17:active j:next j
return

divismur:
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
      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
      ' Tracé ouvrant droit <=== A IMPLÉMENTER DANS MODIFIER PORTE
      ' 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%
      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: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
        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
        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: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

modifporte:
for j=11 to 17:inactive j:next j
' Modification d'une porte:
' 1°) afficher un list avec seulement les portes ==> FAIT
' 2°) un clic colore la porte sélectionnée en rouge ==> FAIT
' 3°) deux clics colore la porte en rouge, la sélectionne et ouvre le form suivant ==> FAIT
' 4°) une fois que l'on a fait les changements et validé,
'    on recolore en noir et on enregistre les nouvelles données
caption 2,"LISTE DES PORTES":gosub form_list
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="PORT" then item_add 6,ligne$(i)
next i
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
print_locate 7,10:print "DÉBUTE À:"
show 103:print_locate 7,  30:print "X":print_locate 145,30:print "cm"
show 104:print_locate 207,30:print "Y":print_locate 345,30:print "cm"
print_locate 7,60:print "TERMINE À:"
show 105:print_locate 7,  80:print "X":print_locate 145,80:print "cm"
show 106:print_locate 207,80:print "Y":print_locate 345,80:print "cm"
print_locate 20,120:print "LARGEUR"
show 107:print_locate 145,140:print "cm"
print_locate 220,120:print "HAUTEUR"
show 108:print_locate 345,140:print "cm"

show 110:show 111:show 112:show 113

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 105,val(seg$(2)):position 106,val(seg$(3))
' 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 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
  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(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,210:print "ANGLE : "; wrap_value(va); "°        "
  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:typ$(i)="PORT"
gosub fait_ligne:item_delete 5,i:item_insert 5,i,ligne$(i)
2d_target_is 2:for j=103 to 111:hide j:next j:cls: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: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

' ******************************************************************************
' ******************************************************************************
' ******************************************************************************
      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





dim xd, yd, xf, yf, lg, a, pi
pi = 4*atn(1)

picture 1: full_space 1
2d_target_is 1
xd = 300: yd = 200 : lg = 150
for a = 0 TO 2*pi step pi/8
    xf = xd + lg * COS(a)
    yf = yd - lg * SIN(a)
    2D_line xd,yd,xf,yf
next a
end
' ******************************************************************************
' ******************************************************************************
' ******************************************************************************
modifent:
' Modification d'une fenêtre:
' 1°) afficher un list avec seulement les fenêtres
' 2°) un clic colore la fenêtre sélectionnée en rouge
' 3°) deux clics colore la fenêtre en rouge, la sélectionne et ouvre le form suivant
' 4°) une fois que l'on a fait les changements et validé, on recolore en noir et on enregistre les nouvelles données
caption 2,"MODIFIER FENÊTRE":gosub form_mpf
show 2:print_target_is 2:font_bold 2
print_locate 7,60:print "POSITION:"
show 105:print_locate 7,  80:print "X":print_locate 145,80:print "cm"
show 106:print_locate 207,80:print "Y":print_locate 345,80:print "cm"
print_locate 20,120:print "LARGEUR"
show 107:print_locate 145,140:print "cm"
print_locate 220,120:print "HAUTEUR"
show 108:print_locate 345,140:print "cm"
print_locate 20,180:print "ANGLE"
show 109:print_locate 145,200:print "°"
show 110:show 111:show 112
while scancode=0:end_while:wait 200
while scancode=0:end_while
2d_target_is 2:for j=105 to 112:hide j:next j:cls:hide 2
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))+"*"
end_if
if typ$(i)="COTE"
end_if
if typ$(i)="AIRE"
end_if
if typ$(i)="TXTE"
end_if
return

propos:
aide:
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(107)>9900 then position 107,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
' if position(107)<1
'    position 103,position(103)-1
'    position 105,position(105)+1
'    position 104,position(104)-1
'    position 106,position(106)+1
' end_if
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
print_locate 45,60:print "  Style des murs  "
print_locate 60,10:print " cm. Épaisseur des murs "
print_locate 60,35:print " cm.  Hauteur  des murs "
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: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:
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)
      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
      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
  ' A FAIRE RESTAURER LES COTES  <*******************
  if seg$(1)="COTE"
  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
annule:
refait:
copie:
colle:
supprime:
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,200:height 2,250
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,300
left 2,(width(0)/2)-(width(2)/2):top 2,(height(0)/2-height(2)/2):return
fin:
terminate
Revenir en haut Aller en bas
JL35




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

PLANORAMIC - Page 2 Empty
MessageSujet: Re: PLANORAMIC   PLANORAMIC - Page 2 EmptyDim 4 Mar 2012 - 21:47

Bonsoir ami bignono,
Attention, je n'ai jamais dit que les murs étaient TOUJOURS horizontaux ou verticaux, j'ai dit 'dans l'immense majorité des cas', et il faut bien évidemment garder la possibilité de les faire dans tous les sens ! Je ne parlais que de la possibilité de rendre cette horizontalité ou verticalité automatiques par appui simultané sur une touche et sans cette touche le mur se met où on veut (comme ça on peut très bien construire un mur à 97° à Bamako Very Happy ).
Mais tout ça est de la théorie, c'est bien plus facile à faire que la mise en pratique, j'en suis bien conscient, et je suis bien conscient de tous les problèmes que tu rencontres au fur et à mesure, c'est bien pour ça que je ne m'étais pas lancé là-dedans !
Revenir en haut Aller en bas
bignono

bignono


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

PLANORAMIC - Page 2 Empty
MessageSujet: Re: PLANORAMIC   PLANORAMIC - Page 2 EmptyDim 4 Mar 2012 - 23:30

JL35 Wink , j'avais bien compris le sens de ton post. Je verrais si on peut ajouter cette possibilité au programme: appui sur CTRL mur à 90°/270° et sur SHIFT à 0°/180°. C'est ce que je fait déjà pour orienter la porte ou la fenêtre à leur création.
Bon, je vous met le code avec la fonction "modifier fenêtre" qui est opérationnelle maintenant.
J'ai voulu remettre les bordures du form que j'utilise pour les saisies, et ceci de manière à pouvoir le déplacer comme on veut en cliquant dans la barre de titre. Mais le problème, c'est que si on clique par inadvertance sur la croix rouge, il disparait et le programme reste bloqué. Comment faire pour éviter cela?
J'ai essayé avec un évènement on_close 2 de lui dire show 2, ça marche, mais tous les print sur le form 2 ont disparu! Donc je ne sais comment faire pour l'instant.
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),undo(50),unimage(50)
dim dx(1000),dy(1000),fx(1000),fy(1000),ep(1000),hm(1000),op(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
label cliquer,init,grille,regle,refait_plan,motif_mur
label pos_souris,test_spin,calcul_points
label cherche_seg,fait_ligne,cherche_num
label mur,cote,aire,texte,zoom
label selection,modifmur,divismur,porte,fenetre,modifporte,modifent
label annule,refait,copie,colle,supprime
label aerien,visite,photo
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:picture 1:width 1,5000:height 1,5000

form 2:hide 2:dlist 5:' hide 5  :border_hide 2

' 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,"Coller"        :on_click 33,colle
sub_menu 34:parent 34,12:caption 34,"Supprimer"    :on_click 34,supprime

' 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 cotes"  :on_click 41,cote
sub_menu 42:parent 42,13:caption 42,"Créer surface" :on_click 42,aire
sub_menu 43:parent 43,13:caption 43,"Créer texte"  :on_click 43,texte
sub_menu 44:parent 44,13:caption 44,"Zoom"          :on_click 44,zoom          :' 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,"Diviser mur"  :on_click 51,divismur
sub_menu 52:parent 52,14:caption 52,"Ajout porte"  :on_click 52,porte        :' FAIT
sub_menu 53:parent 53,14:caption 53,"Ajout fenêtre" :on_click 53,fenetre      :' FAIT
sub_menu 54:parent 54,14:caption 54,"Modifier porte":on_click 54,modifporte    :' FAIT
sub_menu 55:parent 55,14:caption 55,"Modifier fenêtre":on_click 55,modifent    :' FAIT

' 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"

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:
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)
  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

cote:
aire:
texte:
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

selection:
  if j>0
      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
  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
  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%
  mclic=0:j=i
return

modifmur:
for j=11 to 17:inactive j:next j
caption 2,"LISTE DES MURS":gosub form_list
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="MURS" then item_add 6,ligne$(i)
next i
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

print_locate 7,10:print "DÉBUTE À:"
show 103:print_locate 7,  30:print "X":print_locate 145,30:print "cm"
show 104:print_locate 207,30:print "Y":print_locate 345,30:print "cm"
print_locate 7,60:print "TERMINE À:"
show 105:print_locate 7,  80:print "X":print_locate 145,80:print "cm"
show 106:print_locate 207,80:print "Y":print_locate 345,80:print "cm"
print_locate 20,120:print "LONGUEUR"
show 107:print_locate 145,140:print "cm"
print_locate 220,120:print "HAUTEUR"
show 108:print_locate 345,140:print "cm"
print_locate 20,180:print "ÉPAISSEUR"
show 109:print_locate 145,200:print "cm"
show 110:show 111
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
'  faire un print locate de l'angle après calcul
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 j=103 to 111:hide j:next j:cls: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:for j=11 to 17:active j:next j
return

divismur:
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
      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
      ' Tracé ouvrant droit <=== A IMPLÉMENTER DANS MODIFIER PORTE
      ' 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%
      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
        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
        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

modifporte:
for j=11 to 17:inactive j:next j
caption 2,"LISTE DES PORTES":gosub form_list
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="PORT" then item_add 6,ligne$(i)
next i
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
print_locate 7,10:print "DÉBUTE À:"
show 103:print_locate 7,  30:print "X":print_locate 145,30:print "cm"
show 104:print_locate 207,30:print "Y":print_locate 345,30:print "cm"
print_locate 7,60:print "TERMINE À:"
show 105:print_locate 7,  80:print "X":print_locate 145,80:print "cm"
show 106:print_locate 207,80:print "Y":print_locate 345,80:print "cm"
print_locate 20,120:print "LARGEUR"
show 107:print_locate 145,140:print "cm"
print_locate 220,120:print "HAUTEUR"
show 108:print_locate 345,140:print "cm"

show 110:show 111:show 112:show 113

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
  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(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,210:print "ANGLE : "; wrap_value(va); "°        "
  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 j=103 to 113:hide j:next j:cls: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: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

modifent:
for j=11 to 17:inactive j:next j
caption 2,"LISTE DES FENÊTRES":gosub form_list
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="FENT" then item_add 6,ligne$(i)
next i
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
print_locate 7,10:print "DÉBUTE À:"
show 103:print_locate 7,  30:print "X":print_locate 145,30:print "cm"
show 104:print_locate 207,30:print "Y":print_locate 345,30:print "cm"
print_locate 7,60:print "TERMINE À:"
show 105:print_locate 7,  80:print "X":print_locate 145,80:print "cm"
show 106:print_locate 207,80:print "Y":print_locate 345,80:print "cm"
print_locate 20,120:print "LARGEUR"
show 107:print_locate 145,140:print "cm"
print_locate 220,120:print "HAUTEUR"
show 108:print_locate 345,140:print "cm"

show 110:show 111:show 112

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
  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(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,210:print "ANGLE : "; wrap_value(va); "°        "
  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 j=103 to 112:hide j:next j:cls: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:for j=11 to 17:active j:next j
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"
end_if
if typ$(i)="AIRE"
end_if
if typ$(i)="TXTE"
end_if
return

propos:
aide:
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
print_locate 45,60:print "  Style des murs  "
print_locate 60,10:print " cm. Épaisseur des murs "
print_locate 60,35:print " cm.  Hauteur  des murs "
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: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:
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)
      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"
  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
annule:
refait:
copie:
colle:
supprime:
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,200:height 2,250
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
fin:
terminate
Bonne soirée à vous tous, moi Sleep
Revenir en haut Aller en bas
Klaus

Klaus


Nombre de messages : 12274
Age : 74
Localisation : Ile de France
Date d'inscription : 29/12/2009

PLANORAMIC - Page 2 Empty
MessageSujet: Re: PLANORAMIC   PLANORAMIC - Page 2 EmptyDim 4 Mar 2012 - 23:35

Tu fais encore des print sur la form 0 ? Tu sais que si un autre programme vient se positionner par-dessus, les print sont perdus aussi, même si ta form n'a pas été minimisée ? Tu ne peux pas les placer dans des alpha que tu positionnes à l'endroit stratégique - là, ce ne sera pas perdu. Et tu peux faire des alpha multi-lignes, et ajoutant simplement:
dim nl$ : nl$ = chr$(13)+chr$(10)
et en chargeant ton alpha comme suit:
alpha 123 : caption 123,"ligne 1"+nl$+"ligne2"+nl$+"ligne 3"
Revenir en haut Aller en bas
http://klauspanoramic.comxa.com/index.html
JL35




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

PLANORAMIC - Page 2 Empty
MessageSujet: Re: PLANORAMIC   PLANORAMIC - Page 2 EmptyDim 4 Mar 2012 - 23:41

C'est bien sûr ! mais là l'ami bignono est déjà couché, il verra ça demain ! Very Happy
Revenir en haut Aller en bas
bignono

bignono


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

PLANORAMIC - Page 2 Empty
MessageSujet: Re: PLANORAMIC   PLANORAMIC - Page 2 EmptyLun 5 Mar 2012 - 11:06

Bonjour à tous, Smile
J'ai règlé le problème si il n'y a pas de mur ou de porte ou de fenêtre créés, quand on voulait modifier, ça bloquait le programme avec un list vide.
J'ai mis des alpha à la place de mes print dans mon form 2.
Quand on veut fermer le form 2 avec la croix, bah on peut pas, maintenant! Il faut valider les données pour ça maintenant. Donc ça ne bloque plus le programme bêtement. Maintenant, il faut triturer un peu les spin pour saisir comment orienter une fenêtre, ou une porte ou un mur! Avec un peu d'entrainement on y arrive.
Bon il faut maintenant que je trouve un truc pour orienter les murs soit horizontalement soit verticalement directement si on ne veux pas un angle précis (C'est pour JL35, chut faut pas le dire! lol! )
Allez, A+ 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),undo(50),unimage(50)
dim dx(1000),dy(1000),fx(1000),fy(1000),ep(1000),hm(1000),op(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,retourne
label cliquer,init,grille,regle,refait_plan,motif_mur
label pos_souris,test_spin,calcul_points
label cherche_seg,fait_ligne,cherche_num
label mur,cote,aire,texte,zoom
label selection,modifmur,divismur,porte,fenetre,modifporte,modifent
label annule,refait,copie,colle,supprime
label aerien,visite,photo
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:picture 1:width 1,5000:height 1,5000

form 2:hide 2:dlist 5:' hide 5  :border_hide 2
on_close 2,retourne
' 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,"Coller"        :on_click 33,colle
sub_menu 34:parent 34,12:caption 34,"Supprimer"    :on_click 34,supprime

' 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 cotes"  :on_click 41,cote
sub_menu 42:parent 42,13:caption 42,"Créer surface" :on_click 42,aire
sub_menu 43:parent 43,13:caption 43,"Créer texte"  :on_click 43,texte
sub_menu 44:parent 44,13:caption 44,"Zoom"          :on_click 44,zoom          :' 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,"Diviser mur"  :on_click 51,divismur
sub_menu 52:parent 52,14:caption 52,"Ajout porte"  :on_click 52,porte        :' FAIT
sub_menu 53:parent 53,14:caption 53,"Ajout fenêtre" :on_click 53,fenetre      :' FAIT
sub_menu 54:parent 54,14:caption 54,"Modifier porte":on_click 54,modifporte    :' FAIT
sub_menu 55:parent 55,14:caption 55,"Modifier fenêtre":on_click 55,modifent    :' FAIT

' 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"

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:
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)
  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

cote:
aire:
texte:
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

selection:
  if j>0
      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
  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
  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%
  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

divismur:
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

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(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


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"
end_if
if typ$(i)="AIRE"
end_if
if typ$(i)="TXTE"
end_if
return

propos:
aide:
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:
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)
      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"
  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
annule:
refait:
copie:
colle:
supprime:
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
fin:
terminate
Revenir en haut Aller en bas
JL35




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

PLANORAMIC - Page 2 Empty
MessageSujet: Re: PLANORAMIC   PLANORAMIC - Page 2 EmptyLun 5 Mar 2012 - 13:57

Ne t'obnubiles (je cause bien, hein ?) quand même pas là-dessus, c'était juste une suggestion en l'air... quoique...
Revenir en haut Aller en bas
bignono

bignono


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

PLANORAMIC - Page 2 Empty
MessageSujet: Re: PLANORAMIC   PLANORAMIC - Page 2 EmptyLun 5 Mar 2012 - 14:49

Bonjour JL35, Smile
Je ne suis nullement obnubilé par quoique se soit. Laughing Ton truc, ça m"a coûté 2 lignes de code en plus seulement!
Quand tu traces un mur, si tu restes appuyé sur une des deux touches Shift en restant cliqué sur le bouton gauche de la souris, tu seras en mode vertical 90/270° et si tu maintiens une des deux touches CTRL appuyés suivant le même principe tu auras droit au mode horizontal 0°/180°.
Bon j'ai revu un peu mon menu de manière à être un peu moins ambitieux quant à mon programme, et ordonné un peu tout ça, car c'était un peu le cafarnaum ce code. Il faut que je puisse m'y retrouver.
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),undo(50),unimage(50)
dim dx(1000),dy(1000),fx(1000),fy(1000),ep(1000),hm(1000),op(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,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,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: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"
sub_menu 54:parent 54,14:caption 54,"Modifier cote"
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"

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:
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:
cote:
return

selection:
  if j>0
      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
  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
  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%
  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

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"
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:
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"
  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
A+ Wink
Revenir en haut Aller en bas
Contenu sponsorisé





PLANORAMIC - Page 2 Empty
MessageSujet: Re: PLANORAMIC   PLANORAMIC - Page 2 Empty

Revenir en haut Aller en bas
 
PLANORAMIC
Revenir en haut 
Page 2 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: