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
» Aide de PANORAMIC
J'ai copié sur Bignono - Page 8 Emptypar papydall Aujourd'hui à 4:21

» Je teste PANORAMIC V 1 beta 1
J'ai copié sur Bignono - Page 8 Emptypar papydall Aujourd'hui à 4:17

» select intégrés
J'ai copié sur Bignono - Page 8 Emptypar jjn4 Hier à 18:33

» PANORAMIC V 1
J'ai copié sur Bignono - Page 8 Emptypar Klaus Hier à 9:53

» bouton dans autre form que 0
J'ai copié sur Bignono - Page 8 Emptypar leclode Lun 6 Mai 2024 - 13:59

» KGF_dll - nouvelles versions
J'ai copié sur Bignono - Page 8 Emptypar Klaus Lun 6 Mai 2024 - 11:41

» Gestion d'un système client-serveur.
J'ai copié sur Bignono - Page 8 Emptypar Klaus Lun 6 Mai 2024 - 10:23

» Editeur EliP 6 : Le Tiny éditeur avec 25 onglets de travail
J'ai copié sur Bignono - Page 8 Emptypar Froggy One Jeu 2 Mai 2024 - 11:16

» @Jack
J'ai copié sur Bignono - Page 8 Emptypar Jack Mar 30 Avr 2024 - 20:40

» trop de fichiers en cours
J'ai copié sur Bignono - Page 8 Emptypar papydall Lun 29 Avr 2024 - 23:39

» Une calculatrice en une ligne de programme
J'ai copié sur Bignono - Page 8 Emptypar jean_debord Dim 28 Avr 2024 - 8:47

» Form(résolu)
J'ai copié sur Bignono - Page 8 Emptypar leclode Sam 27 Avr 2024 - 17:59

» Bataille navale SM
J'ai copié sur Bignono - Page 8 Emptypar jjn4 Ven 26 Avr 2024 - 17:39

» Les maths du crocodile
J'ai copié sur Bignono - Page 8 Emptypar jean_debord Jeu 25 Avr 2024 - 10:37

» Naissance de Crocodile Basic
J'ai copié sur Bignono - Page 8 Emptypar jean_debord Jeu 25 Avr 2024 - 8:45

Navigation
 Portail
 Index
 Membres
 Profil
 FAQ
 Rechercher
Rechercher
 
 

Résultats par :
 
Rechercher Recherche avancée
Mai 2024
LunMarMerJeuVenSamDim
  12345
6789101112
13141516171819
20212223242526
2728293031  
CalendrierCalendrier
Le Deal du moment :
Jeux, jouets et Lego : le deuxième à ...
Voir le deal

 

 J'ai copié sur Bignono

Aller en bas 
+5
bignono
Minibug
Yannick
Jicehel
papydall
9 participants
Aller à la page : Précédent  1, 2, 3, 4, 5, 6, 7, 8
AuteurMessage
papydall

papydall


Nombre de messages : 7006
Age : 73
Localisation : Moknine (Tunisie) Entre la chaise et le clavier
Date d'inscription : 03/03/2012

J'ai copié sur Bignono - Page 8 Empty
MessageSujet: Re: J'ai copié sur Bignono   J'ai copié sur Bignono - Page 8 EmptyVen 14 Sep 2012 - 19:21

Salut ygeronimi

Ça bosse fort, hein ?
Les SUBs ne sont pas si douloureuses que ça, au final ?

Bon, j’ai apporté quelques modification à ton embryon (qui deviendra bientôt fœtus, ensuite bébé puis ….)
MEMU devient une procédure appelée par MENU().
Les modifications sont marquées par des ‘Papydall pour mieux les trouver.
Étudie-les et adopte-les si ça te dis quelque chose !
Voici ton code modifié
Code:

dim Lang$,def$(200)
Label click : ' click au lieu de menu, menu devient une procédure : Papydall

Init_F0()
end
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
sub Init_F0()
  Dim_local x% : ' Papydall
  width 0,500:height 0,350:top 0,(screen_y-350)/2:left 0,(screen_x-500)/2
  caption 0,"Viewer 3DS":font_name 0,"Times new roman":font_size 0,10
  main_menu 1
  for x%=2 to 18:sub_menu x% :on_click x%,click:next x% : ' Appeller click au lieu de menu : Papydall
  for x%=2 to 6 :parent x%,1 :next x%
  for x%=7 to 8 :parent x%,2 :next x%
  for x%=9 to 15:parent x%,3 :next x%
  for x%=16 to 18:parent x%,4:next x%

  dlist 99
  if lang$="" then lang$="French"
  Langue(lang$)
end_sub
' ------------------------------------------------------------------------------
click:
menu()  : ' Papydall
return
' ------------------------------------------------------------------------------
SUB menu()
  DIM_LOCAL M%,x% : ' Papydall
  for x% = 2 to 18
      if clicked(x%)=1 then M%=x%
  next x%
  select M%
  case 2
  case 3
  case 4
  case 5
  case 6
  case 7
  case 8
    Quitter()
  case 9
  case 10
  case 11
  case 12
  case 13
  case 14
  case 15
  case 16
      Lang$="French"
      Langue(Lang$)
  case 17
      Lang$="English"
      Langue(Lang$)
  case 18
      Lang$="Deutsch"
      Langue(Lang$)
  end_select
 ' free M%:free x%  : ' n'a plus sa raison d'être : ' Papydall
END_SUB
' ------------------------------------------------------------------------------
sub Langue(Lang$)
  Dim_local x%,Lang$,s$:Lang$=Lang$
  restore
  read s$
  while s$<>Lang$
      read s$
  end_while
  def$(1)=s$
  for x%= 2 to 18:read def$(x%):next x%
  Init_Caption()
end_sub
' ------------------------------------------------------------------------------
sub Init_Caption()
  dim_local x%
  for x%= 2 to 18:caption x%,def$(x%):next x%
end_sub
' ------------------------------------------------------------------------------

' ------------------------------------------------------------------------------
sub Quitter()
  Terminate
end_sub
' ------------------------------------------------------------------------------
''                                LANGUES
' ------------------------------------------------------------------------------
data "French"
data "Fichier"
data "Outils"
data "Langue"
data "A Propos..."
data "Aide"
data "Ouvrir"
data "Quitter"
data "Zoom"
data "Direction"
data "Rotation"
data "Caméra"
data "Lumière"
data "Couleur de fond"
data "Habillage"
data "-Français"
data "-Anglais"
data "-Allemand"
' ------------------------------------------------------------------------------
data "English"
data "File"
data "Tools"
data "Language"
data "About ..."
data "Help"
data "Open"
data "Exit"
data "Zoom"
data "Direction"
data "Rotation"
data "Camera"
data "Light"
data "Background Color"
data "Skin"
data "-French"
data "-English"
data "-German"
' ------------------------------------------------------------------------------
Data "Deutsch"
Data "File"
Data "Tools"
Data "Sprache"
Data "Über ..."
Data "Help"
Data "Open"
Data "Exit"
Data "Zoom"
Data "Direction"
Data "Rotation"
Data "Camera"
Data "Light"
Data "Hintergrundfarbe"
Data "Skin"
data "-Französisch"
data "-English"
data "-deutsch"
' ----------------------------------------------------------------------


Dernière édition par papydall le Ven 14 Sep 2012 - 19:39, édité 1 fois (Raison : CORRECTION)
Revenir en haut Aller en bas
http://papydall-panoramic.forumarabia.com/
Jicehel

Jicehel


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

J'ai copié sur Bignono - Page 8 Empty
MessageSujet: Re: J'ai copié sur Bignono   J'ai copié sur Bignono - Page 8 EmptyVen 14 Sep 2012 - 20:06

Beau début Wink Ce sera plus propre en effet
Revenir en haut Aller en bas
Yannick




Nombre de messages : 8610
Age : 53
Localisation : Bretagne
Date d'inscription : 15/02/2010

J'ai copié sur Bignono - Page 8 Empty
MessageSujet: re   J'ai copié sur Bignono - Page 8 EmptySam 15 Sep 2012 - 0:31

J'ai beau tourner l'histoire dans tous les sens,
avec le nombre de "on_click" et "on_change" que compte ce prog
je suis obligé de passer par des "label...gosub...return"

si je veux placer des "select...end_select" pour tout,
il faut que je regroupe tous mes "button" et "scroll_bar"
et là, une chatte n'y retrouve plus ses petits... scratch



Dernière édition par ygeronimi le Sam 15 Sep 2012 - 3:28, édité 1 fois
Revenir en haut Aller en bas
Yannick




Nombre de messages : 8610
Age : 53
Localisation : Bretagne
Date d'inscription : 15/02/2010

J'ai copié sur Bignono - Page 8 Empty
MessageSujet: re   J'ai copié sur Bignono - Page 8 EmptySam 15 Sep 2012 - 3:28

Il manque encore quelques "caption" et un peu de déco
mais çà s'approche...
Code:
' ------------------------------------------------------------------------------
' LES DERNIERS DES MOHICANS
' ------------------------------------------------------------------------------
' VARIABLES GLOBALES
dim D$,DT$,DC$,D3D$,Lang$,def$(200),R2%,G2%,B2%,R1%,G1%,B1%,nom$,File$
' LABEL
Label Menu,Direction,Rotation,Position_Cam,Position_PV,Lumiere,Coloration,Appli_Color
Label Appli_Texture,Couleur_Fond,Appli_Fond,Zoom,Dialog_open,Valid_Selection
' ------------------------------------------------------------------------------
Init_F0()
Init_Container()
Init_F800()
Init_Prog()
Langue(lang$)
end
' ------------------------------------------------------------------------------
' CREATION DU FORM 0
' ------------------------------------------------------------------------------
sub Init_F0()
  Dim_local x%
  width 0,425:height 0,292:top 0,(screen_y-292)/2:left 0,(screen_x-425)/2
  caption 0,"Viewer 3DS":font_name 0,"Times new roman":font_size 0,10
  main_menu 1
  for x%=2 to 19:sub_menu x% :on_click x%,menu :next x%
  for x%=2 to 6 :parent x%,1 :next x%
  for x%=7 to 8 :parent x%,2 :next x%
  for x%=9 to 16:parent x%,3 :next x%
  for x%=17 to 19:parent x%,4:next x%
  Inactive 3
  image 98
  dlist 99
end_sub
' ------------------------------------------------------------------------------
' A TABLE !!!
' ------------------------------------------------------------------------------
menu:
  dim M%,x%
  for x% = 2 to 19
      if clicked(x%)=1 then M%=x%
  next x%
  select M%
  case 2
  case 3
  case 4
  case 5
      message "En cours"
  case 6
      message "En cours"
  case 7
    Ouvrir()
  case 8
    Quitter()
  case 9
    show 100
    hide 200:hide 300:hide 400:hide 500:hide 600:hide 700
  case 10
    show 200
    hide 100:hide 300:hide 400:hide 500:hide 600:hide 700
  case 11
    show 300
    hide 200:hide 100:hide 400:hide 500:hide 600:hide 700
  case 12
    show 400
    hide 200:hide 300:hide 100:hide 500:hide 600:hide 700
  case 13
    show 500
    hide 200:hide 300:hide 400:hide 100:hide 600:hide 700
  case 14
    show 600
    hide 200:hide 300:hide 400:hide 500:hide 100:hide 700
  case 15
    show 700
    hide 200:hide 300:hide 400:hide 500:hide 600:hide 100
  case 16
    Capture()
  case 17
    Lang$="French"
    Langue(Lang$)
  case 18
    Lang$="English"
    Langue(Lang$)
  case 19
    Lang$="Deutsch"
    Langue(Lang$)
  end_select
  free M%:free x%
return
' ------------------------------------------------------------------------------
' CREATION DES "CONTAINER"
' ------------------------------------------------------------------------------
Sub Init_Container()
dim_local x%,y%
for x%=100 to 700 step 100 :container x% :hide x% :width x%,400:height x%,220:top x%,10:left x%,5:next x%
' Contenu du container 100 (Zoom)
scroll_bar 101:parent 101,100:top 101,40:left 101,20:min 101,1:max 101,2000:position 101,1
position 101,0.001:on_change 101,Zoom
alpha 102    :parent 102,100:top 102,65:left 102,20
' Contenu du container 200 (Direction)
for x%=201 to 210:button x% :parent x%,200:font_name x%,"webdings":font_size x%,12 :on_click x%,Direction:next x%
for x%=201 to 208:width x%,30:height x%,30:next x%
for x%=209 to 210:width x%,30:height x%,15:next x%
top 201,90:left 201,230
top 202,90:left 202,260 :caption 202,"5"
top 203,90:left 203,290
top 204,120:left 204,230 :caption 204,"3"
top 205,120:left 205,290:caption 205,"4"
top 206,150:left 206,230
top 207,150:left 207,260 :caption 207,"6"
top 208,150:left 208,290
top 209,120:left 209,260 :caption 209,"5"
top 210,135:left 210,260 :caption 210,"6"
' Contenu du container 300 (Rotation)
alpha 301:parent 301,300:top 301,35 :left 301,13:caption 301,"Axe X":font_color 301,0,0,255
scroll_bar 302:parent 302,300:top 302,50:left 302,13:width 302,160:min 302,0:max 302,359
position 302,0:on_change 302,Rotation
alpha 303:parent 303,300:top 303,70 :left 303,13:caption 303,"Axe Y":font_color 303,0,0,255
scroll_bar 304:parent 304,300:top 304,85:left 304,13:width 304,160:min 304,0:max 304,359
position 304,0:on_change 304,Rotation
alpha 305:parent 305,300:top 305,105 :left 305,13:caption 305,"Axe Z":font_color 305,0,0,255
scroll_bar 306:parent 306,300:top 306,120:left 306,13:width 306,160:min 306,0:max 306,359
position 306,0:on_change 306,Rotation
' Contenu du container 400 (Caméra)
alpha 401    :parent 401,400:top 401,45 :left 401,13:caption 401,"Axe X":font_color 401,0,0,255
scroll_bar 402:parent 402,400:top 402,60 :left 402,13:min 402,-100:max 402,100:on_change 402,Position_Cam
alpha 403    :parent 403,400:top 403,80 :left 403,13:caption 403,"Axe Y":font_color 403,0,0,255
scroll_bar 404:parent 404,400:top 404,95 :left 404,13:min 404,-100:max 404,100:on_change 404,Position_Cam
alpha 405    :parent 405,400:top 405,115:left 405,13:caption 405,"Axe Z":font_color 405,0,0,255
scroll_bar 406:parent 406,400:top 406,130:left 406,13:min 406,-100:max 406,100:on_change 406,Position_Cam
y%=10
for x%=407 to 409:y%=y%+35:alpha x%:parent x%,400:top x%,y%:left x%,50:font_name x%,"arial":font_size x%,8:font_color x%,255,0,0:next x%
alpha 410:parent 410,400:top 410,30:left 410,250

alpha 411    :parent 411,400:top 411,45 :left 411,213:caption 411,"Axe X":font_color 411,0,0,255
scroll_bar 412:parent 412,400:top 412,60 :left 412,213:min 412,-100:max 412,100:on_change 412,Position_PV
alpha 413    :parent 413,400:top 413,80 :left 413,213:caption 413,"Axe Y":font_color 413,0,0,255
scroll_bar 414:parent 414,400:top 414,95 :left 414,213:min 414,-100:max 414,100:on_change 414,Position_PV
alpha 415    :parent 415,400:top 415,115:left 415,213:caption 415,"Axe Z":font_color 415,0,0,255
scroll_bar 416:parent 416,400:top 416,130:left 416,213:min 416,-100:max 416,100:on_change 416,Position_PV
y%=10
for x%=417 to 419:y%=y%+35:alpha x%:parent x%,400:top x%,y%:left x%,250:font_name x%,"arial":font_size x%,8:font_color x%,255,0,0:next x%
alpha 420:parent 420,400:top 420,30:left 420,50
' Contenu du container 500 (Lumière)
alpha 501    :parent 501,500:top 501,45 :left 501,213:caption 501,"Axe X":font_color 501,0,0,255
scroll_bar 502:parent 502,500:top 502,60 :left 502,213:min 502,0:max 502,359:on_change 502,Lumiere
alpha 503    :parent 503,500:top 503,80 :left 503,213:caption 503,"Axe Y":font_color 503,0,0,255
scroll_bar 504:parent 504,500:top 504,95 :left 504,213:min 504,0:max 504,359:on_change 504,Lumiere
alpha 505    :parent 505,500:top 505,115:left 505,213:caption 505,"Axe Z":font_color 505,0,0,255
scroll_bar 506:parent 506,500:top 506,130:left 506,213:min 506,0:max 506,359:on_change 506,Lumiere
y%=10
for x%=507 to 509:y%=y%+35:alpha x%:parent x%,500:top x%,y%:left x%,250:font_name x%,"arial":font_size x%,8:font_color x%,255,0,0:next x%
alpha 510:parent 510,500:top 510,30:left 510,250
' Contenu du container 600 (Couleur de fond)
picture 601:parent 601,600:height 601,70:width 601,70:top 601,25:left 601,5:color 601,0,0,0
spin 602:parent 602,600:top 602,25 :left 602,80:width 602,45:font_color 602,255,0,0:cursor_point 602:min 602,0:max 602,255
spin 603:parent 603,600:top 603,50:left 603,80:width 603,45:font_color 603,0,255,0:cursor_point 603:min 603,0:max 603,255
spin 604:parent 604,600:top 604,75:left 604,80:width 604,45:font_color 604,0,0,255:cursor_point 604:min 604,0:max 604,255
button 605:parent 605,600:top 605,85:left 605,155:cursor_point 605
for x%=602 to 604:on_change x%,Couleur_Fond:next x%
on_click 605,Appli_Fond
' Contenu du container 700 (Habillage)
picture 701 :parent 701,700:width 701,40:height 701,40:top 701,60:left 701,25:color 701,0,0,0
spin 702    :parent 702,700:height 702,15:width 702,45:top 702,50:left 702,70:min 702,0:max 702,255
font_size 702,8:font_name 702,"arial":font_color 702,255,0,0:on_change 702,Coloration
spin 703    :parent 703,700:height 703,15:width 703,45:top 703,70:left 703,70:min 703,0:max 703,255
font_size 703,8:font_name 703,"arial":font_color 703,0,255,0:on_change 703,Coloration
spin 704    :parent 704,700:height 704,15:width 704,45:top 704,90:left 704,70:min 704,0:max 704,255
font_size 704,8:font_name 704,"arial":font_color 704,0,0,255:on_change 704,Coloration
button 705  :parent 705,700:width 705,70:top 705,120:left 705,40
cursor_point 705:on_click 705,Appli_Color
alpha 709  :parent 709,700:top 709,30 :Left 709,25
alpha 710  :parent 710,700:top 710,110:Left 710,220
button 711  :parent 711,700:top 711,130:left 711,220:width 711,140
cursor_point 711:on_click 711,Appli_Texture
end_sub
' ------------------------------------------------------------------------------
sub Init_Prog()
  D$=Dir_current$
  if dir_exists(D$+"\Texture")=0 then dir_make D$+"\Texture"
  DT$=D$+"\Texture"
  if dir_exists(D$+"\Capture")=0 then dir_make D$+"\Capture"
  DC$=D$+"\Capture"
  if dir_exists(D$+"\3D")=0 then dir_make D$+"\3D"
  D3D$=D$+"\3D"
end_sub
' ------------------------------------------------------------------------------
sub Init_Scene()
  position 101,1:position 302,0:position 304,0:position 306,0
  gosub Zoom
  position 402,0:position 404,0:position 406,5
  gosub Position_Cam
  position 502,0:position 504,0:position 506,5
  gosub Lumiere
end_sub
' ------------------------------------------------------------------------------
sub Ouvrir()
  dim_local F$,x%
  ' Placement de l'appli dans le dossier où sont les fichiers 3d
  dir_change D3D$
  ' Récupération des adresses des fichiers 3DS et 3ds
  F$=file_find_first$
  if Upper$(file_extract_extension$(F$))=".3DS" then item_add 99,F$
  F$=file_find_next$
  while F$<>"_"
  if Upper$(file_extract_extension$(F$))=".3DS" then item_add 99,F$
  F$=file_find_next$
  end_while
  file_find_close
  if count(99)>0
  ' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
      form 900:top 900,top_f%+54:left 900,left_f%+8:width 900,200:height 900,340
      font_name 900,"Times new roman":font_size 900,10
      command_target_is 900
      list 901:width 901,184:height 901,240:cursor_point 901:on_double_click 901,Valid_Selection
      alpha 902:top 902,240:left 902,5
      font_color 902,0,0,255
      button 903:width 903,30:height 903,30:top 903,260:left 903,77:font_name 903,"Wingdings":caption 903,"1":font_bold 903
      on_click 903,Dialog_open:cursor_point 903
      ' Affichage des fichiers récupérés dans le list 901
      for x%=1 to count(99)
        F$=item_read$(99,x%)
        item_add 901,left$(file_extract_name$(F$),len(file_extract_name$(F$))-4)
      next x%
      Init_Caption()
      command_target_is 0
  ' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
  else
      if Message_information_yes_no(def$(25)+chr$(13)+def$(26))=1
        gosub Dialog_open
      end_if
  end_if
end_sub
' ------------------------------------------------------------------------------
Dialog_open:
    open_dialog 1000
    dir_dialog 1000,left$(D$,2)
    filter 1000,"Fichiers *.3DS,*.3ds|*.3DS;*.3ds"
    file$=file_name$(1000)
    delete 1000
    if file$<>"_"
      Create_Objet()
    end_if
    if object_exists(900)=1 then delete 900
return
' ------------------------------------------------------------------------------
Valid_Selection:
  if o3d_object_exists(1)=1 then 3d_delete 1
  File$=D3D$+"\"+item_read$(99,item_index(901))
  Create_Objet()
return
' ------------------------------------------------------------------------------
sub Create_Objet()
  caption 800,"3DS Viewer"+chr$(32)+"("+chr$(32)+file_extract_name$(File$)+chr$(32)+")"
  nom$=file_extract_name$(file$)
  nom$=left$(nom$,len(nom$)-4)
  3d_mesh 1
  3d_load_object 1,File$
  Init_Scene()
  clear 99
  if object_exists(900)=1 then delete 900
  if file$<>"_"
      active 3
      Replace_Form(top(0),left(0),top(800),left(800))
  end_if
end_sub
' ------------------------------------------------------------------------------
sub Replace_Form(T0%,L0%,T800%,L800%)
  dim_local x%,y%
  top 800,(screen_y-656)/2
  left 800,(screen_x-425-816)
  top 0,Top(800)
  left 0,(screen_x-425)
  show 800
end_sub
' ------------------------------------------------------------------------------
Direction:
  dim x%,Dir%,x,y,z
  for x%=201 to 210
      if clicked(x%)=1 then Dir%=x%
  next x%
  select Dir%
  case 201
    ' decale vers haut gauche
    y=o3d_y_position(1):x=o3d_x_position(1):z=o3d_z_position(1)
    y=y+0.1:x=x-0.1:3d_position 1,x,y,z
  case 202
    ' decale vers haut
    y=o3d_y_position(1):y=y+0.1:3d_y_position 1,y
  case 203
    ' decale vers haut droit
    y=o3d_y_position(1):x=o3d_x_position(1):z=o3d_z_position(1)
    y=y+0.1:x=x+0.1:3d_position 1,x,y,z
  case 204
    ' decale vers gauche
    x=o3d_x_position(1):x=x-0.1:3d_x_position 1,x
  case 205
    ' decale vers droite
    x=o3d_x_position(1):x=x+0.1:3d_x_position 1,x
  case 206
    ' decale vers bas gauche
    y=o3d_y_position(1):x=o3d_x_position(1):z=o3d_z_position(1)
    y=y-0.1:x=x-0.1:3d_position 1,x,y,z
  case 207
    ' decale vers bas
    y=o3d_y_position(1):y=y-0.1:3d_y_position 1,y
  case 208
    ' decale vers bas droite
    y=o3d_y_position(1):x=o3d_x_position(1):z=o3d_z_position(1)
    y=y-0.1:x=x+0.1:3d_position 1,x,y,z
  case 209
    ' decale vers fond
    z=o3d_z_position(1):z=z+0.1:3d_z_position 1,z
  case 210
    ' decale vers avant
    z=o3d_z_position(1):z=z-0.1:3d_z_position 1,z
  end_select
  free x%:free Dir%:free x:free y:free z
return
' ------------------------------------------------------------------------------
Zoom:
  dim V
  V=position(101)/1000
  if O3D_object_exists(1) = 1 then 3d_scale 1,V,V,V
  caption 102,str$(V)
  free V
return
' ------------------------------------------------------------------------------
Rotation:
  3d_x_rotate 1,position(302)
  3d_y_rotate 1,position(304)
  3d_z_rotate 1,position(306)
return
' ------------------------------------------------------------------------------
Position_Cam:
  dim Cx,Cy,Cz
  if O3D_object_exists(1) = 1
      Cx=Position(402):Cy=Position(404):Cz=Position(406)
      caption 407,"("+str$(Cx)+")":caption 408,"("+str$(Cy)+")":caption 409,"("+str$(Cz)+")"
      cam_position Cx,Cy,Cz
  end_if
  free Cx:free Cy:free Cz
return
' ------------------------------------------------------------------------------
Position_PV:
  dim PVx,PVy,PVz
  if O3D_object_exists(1) = 1
      PVx=Position(412)/10:PVy=Position(414)/10:PVz=Position(416)/10
      caption 417,"("+str$(PVx)+")":caption 418,"("+str$(PVy)+")":caption 419,"("+str$(PVz)+")"
      point_position PVx,PVy,PVz
  end_if
  free PVx:free PVy:free PVz
return
' ------------------------------------------------------------------------------
Lumiere:
  dim Lx,Ly,Lz
  if O3D_object_exists(1) = 1
      Lx=Position(502):Ly=Position(504):Lz=Position(506)
      caption 207,"("+str$(Lx)+")":caption 208,"("+str$(Ly)+")":caption 509,"("+str$(Lz)+")"
      light_position Lx,Ly,Lz
  end_if
  free Lx:free Ly:free Lz
return
' ------------------------------------------------------------------------------
Couleur_Fond:
  if numeric(text$(602))=1 then R2%=val(text$(602))
  if numeric(text$(603))=1 then G2%=val(text$(603))
  if numeric(text$(604))=1 then B2%=val(text$(604))
  Color 601,R2%,G2%,B2%
return
' ------------------------------------------------------------------------------
Appli_Fond:
  Color 801,R2%,G2%,B2%
return
' ------------------------------------------------------------------------------
Coloration:
  if numeric(text$(702))=1 then R1%=val(text$(702))
  if R1% > 255 then R1% = 255
  if numeric(text$(703))=1 then G1%=val(text$(703))
  if G1% > 255 then G1% = 255
  if numeric(text$(704))=1 then B1%=val(text$(704))
  if B1% > 255 then B1% = 255
  color 701,R1%,G1%,B1%
return
' ------------------------------------------------------------------------------
Appli_Color:
  if O3D_object_exists(1) = 1 then 3d_color 1,R1%,G1%,B1%
return
' ------------------------------------------------------------------------------
Appli_Texture:
  dim a$,texture$
  texture$=""
  dir_change DT$
  a$=file_find_first$
  if a$=nom$+".bmp"
      texture$=a$
  else
      a$=file_find_next$
      if a$=nom$+".bmp"
        texture$=a$
      else
        while a$<>"_"
        a$=file_find_next$
        if a$=nom$+".bmp"
            texture$=a$
            exit_while
        end_if
        end_while
      end_if
  end_if
  if texture$=""
      open_dialog 1000
      dir_dialog 1000,DT$
      Texture$=file_name$(1000)
      delete 1000
  end_if
  if Texture$<>"_"
      if O3D_object_exists(1) = 1 then 3d_load_texture 1,Texture$
  end_if
return
' ------------------------------------------------------------------------------
sub Capture()
  dll_on D$+"\KGF.dll"
  to_foreground 800
  res%=dll_call1("ScreenCopy",2)
  pause 100
  clipboard_paste 98
  file_save 98,D$+"\Capture\"+nom$+".bmp"
  wait 1000
  to_foreground 100
  message "Vôtre capture a été enregistré dans :"+chr$(13)+D$+"\Capture\"+nom$+".bmp"
  dll_off
end_sub
' ------------------------------------------------------------------------------
' CREATION DU FORM 800 DE VISUALISATION
' ------------------------------------------------------------------------------
sub Init_F800()
  form 800:hide 800:width 800,816:height 800,638
  command_target_is 800
  scene3d 801:width 801,800:height 801,600:color 801,0,0,0
  3d_target_is 801
end_sub
' ------------------------------------------------------------------------------
' INITIALISATION DE LA LANGUE
' ------------------------------------------------------------------------------
sub Langue(Lang$)
  Dim_local x%,Lang$,s$:Lang$=Lang$
  if lang$="" then lang$="French"
  restore
  read s$
  while s$<>Lang$
      read s$
  end_while
  def$(1)=s$
  for x%= 2 to 19:read def$(x%):next x%
  Init_Caption()
end_sub
' ------------------------------------------------------------------------------
' INITIALISATION DE TOUT LES "CAPTION"
' ------------------------------------------------------------------------------
sub Init_Caption()
  dim_local x%
  for x%= 2 to 19:caption x%,def$(x%):next x%
  caption 100,chr$(32)+chr$(32)+def$(9)+chr$(32)+chr$(32)
  caption 200,chr$(32)+chr$(32)+def$(10)+chr$(32)+chr$(32)
  caption 300,chr$(32)+chr$(32)+def$(11)+chr$(32)+chr$(32)
  caption 400,chr$(32)+chr$(32)+def$(12)+chr$(32)+chr$(32)
  caption 500,chr$(32)+chr$(32)+def$(13)+chr$(32)+chr$(32)
  caption 600,chr$(32)+chr$(32)+def$(14)+chr$(32)+chr$(32)
  caption 700,chr$(32)+chr$(32)+def$(15)+chr$(32)+chr$(32)
end_sub
' ------------------------------------------------------------------------------
' CIRCULEZ Y A RIEN A VOIR !
' ------------------------------------------------------------------------------
sub Quitter()
  Terminate
end_sub
' ------------------------------------------------------------------------------
''                                LANGUES
' ------------------------------------------------------------------------------
data "French"
data "Fichier"
data "Outils"
data "Langue"
data "A Propos..."
data "Aide"
data "Ouvrir"
data "Quitter"
data "Zoom"
data "Direction"
data "Rotation"
data "Caméra"
data "Lumière"
data "Couleur de fond"
data "Habillage"
data "Capture"
data "-Français"
data "-Anglais"
data "-Allemand"
' ------------------------------------------------------------------------------
data "English"
data "File"
data "Tools"
data "Language"
data "About ..."
data "Help"
data "Open"
data "Exit"
data "Zoom"
data "Direction"
data "Rotation"
data "Camera"
data "Light"
data "Background Color"
data "Skin"
data "Capture"
data "-French"
data "-English"
data "-German"
' ------------------------------------------------------------------------------
Data "Deutsch"
Data "File"
Data "Tools"
Data "Sprache"
Data "Über ..."
Data "Help"
Data "Open"
Data "Exit"
Data "Zoom"
Data "Direction"
Data "Rotation"
Data "Camera"
Data "Light"
Data "Hintergrundfarbe"
Data "Skin"
data "Bilderfassung"
data "-Französisch"
data "-English"
data "-deutsch"
' ------------------------------------------------------------------------------
Revenir en haut Aller en bas
papydall

papydall


Nombre de messages : 7006
Age : 73
Localisation : Moknine (Tunisie) Entre la chaise et le clavier
Date d'inscription : 03/03/2012

J'ai copié sur Bignono - Page 8 Empty
MessageSujet: Re: J'ai copié sur Bignono   J'ai copié sur Bignono - Page 8 EmptySam 15 Sep 2012 - 4:28

Ygeronimi, c’est bien ce que tu as fais.
Tu peux transformer tous les LABELs qui sont appelés par ON_CLICK par des procédures SUB (regarde mon précédent post et aussi mon dernier post dans Ce qui est en cours)
Les sous-programmes suivants peuvent devenirs des procédures SUB :
MENU
DIRECTION
APPLI_COLOR
APPLI_TEXTURE
APPLI_FOND
APPLI_COLOR
VALID_SELECTION


Tu transformes ces sous-programmes en procédures
Après avoir transformé les SUB …
tu ajoutes, au début, ceci
Code:

LABEL clic
....
clic :
for x% = 2 to 19
  if clicked(x%) = 1 then menu() : return
next x%
for x% = 201 to 210
  if clicked(x%) = 1 then  direction() : return
next x%
if clicked(711) = 1 then  Appli_Texture() : return
....
....
return

Tu transformes tous tes ON_CLICK xx,yyy
comme ceci
Code:

ON_CLICK xx,clic
et tu les traites dans le sous-programme clic :



Revenir en haut Aller en bas
http://papydall-panoramic.forumarabia.com/
Yannick




Nombre de messages : 8610
Age : 53
Localisation : Bretagne
Date d'inscription : 15/02/2010

J'ai copié sur Bignono - Page 8 Empty
MessageSujet: re   J'ai copié sur Bignono - Page 8 EmptySam 15 Sep 2012 - 5:03

Pourquoi tu colles des "return" de partout puisque tu passes en procédures "sub xxxx()" et plus par des "gosub"
Revenir en haut Aller en bas
Jicehel

Jicehel


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

J'ai copié sur Bignono - Page 8 Empty
MessageSujet: Re: J'ai copié sur Bignono   J'ai copié sur Bignono - Page 8 EmptySam 15 Sep 2012 - 9:10

C'est le return du label clic déclenché par l'événement
Revenir en haut Aller en bas
papydall

papydall


Nombre de messages : 7006
Age : 73
Localisation : Moknine (Tunisie) Entre la chaise et le clavier
Date d'inscription : 03/03/2012

J'ai copié sur Bignono - Page 8 Empty
MessageSujet: Re: J'ai copié sur Bignono   J'ai copié sur Bignono - Page 8 EmptySam 15 Sep 2012 - 11:54

Bonjour ygeronimi

Jicehel a donné la réponse.
Je la formule autrement :

Pour tous les ON_CLICK xxx, yyy, tu les envoies non pas aux différents LABEL yyy, mais au seul et unique LABEL clic :
Là tu les traites par des appels à leur SUB respectifs.
Comme clic : est un LABEL, on ne peut en sortir qu’avec RETURN.
Dans l’exemple donné dans mon post précédent, on pourrait très bien ne mettre qu’UN SEUL RETURN à la fin.
Si je «colle des RETURN de partout » c’est pour accélérer les traitements : on sort du sous-programme avant d’effectuer les autres IF qui sont devenus forcement FAUX.

Si tu as compris l’astuce, ce que je me suis bien expliqué Laughing , sinon aïe ! Sad
Revenir en haut Aller en bas
http://papydall-panoramic.forumarabia.com/
Klaus

Klaus


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

J'ai copié sur Bignono - Page 8 Empty
MessageSujet: Re: J'ai copié sur Bignono   J'ai copié sur Bignono - Page 8 EmptySam 15 Sep 2012 - 12:12

J'espère quand-même qu'à terme, Jack donnera la possibilité de mettre une procédure à la place du sous-programme dans les ON_xxx. Peut-être conditionné par une directive du type #ON_EVENT_PROCEDURE. Tous les noms après un ON_xxx seraient alors pris comme des noms de procédures, éventuellement déclarées obligatoiremement comme ceci:
Code:

SUB ON_xxx_nom(objet%,p1%,p2%)
...
END_SUB
avec
obj% = numéro de l'objet ayant produit l'évènement
p1%, p2% = valeurs spécifiques en fonction de l'évènement
Dans le cas d'un clic, ces paramètres pourraient contenir les coordonnées du clic, etc.

Cette technique étant conditionnée par l'usage de la directive #ON_EVENT_PROCEDURE, cela ne s'appliquerait évidemment pas à un programme qui n'utilise pas cette directive.

Mais c'est juste une idée comme ça. Ce n'est pas forcément une demande, et c'est pourquoi je l'exprime ici et non dans la section des "souhaits...".
Revenir en haut Aller en bas
http://klauspanoramic.comxa.com/index.html
papydall

papydall


Nombre de messages : 7006
Age : 73
Localisation : Moknine (Tunisie) Entre la chaise et le clavier
Date d'inscription : 03/03/2012

J'ai copié sur Bignono - Page 8 Empty
MessageSujet: Re: J'ai copié sur Bignono   J'ai copié sur Bignono - Page 8 EmptySam 15 Sep 2012 - 12:24

Salut Klaus.

Je suis d’accord avec toi.
Ça bouillonne à l’aube d’une (r)évolution de PANORAMIC !
On exprime des points de vues, des souhaits, des rêves aussi, chacun à sa manière.
Jack prendra en compte ce qu’il estime faisable et utile, le reste « passe et ne laisse que des traces » lesquelles traces s’effacent .... Et bis, on recommence!
Revenir en haut Aller en bas
http://papydall-panoramic.forumarabia.com/
Yannick




Nombre de messages : 8610
Age : 53
Localisation : Bretagne
Date d'inscription : 15/02/2010

J'ai copié sur Bignono - Page 8 Empty
MessageSujet: re   J'ai copié sur Bignono - Page 8 EmptySam 15 Sep 2012 - 12:45

@ papydall,

"...Si tu as compris l’astuce, ce que je me suis bien expliqué , sinon aïe ! " ( c'est ) Laughing

J'ai tout compris, tu t'es bien expliqué... Laughing

Revenir en haut Aller en bas
papydall

papydall


Nombre de messages : 7006
Age : 73
Localisation : Moknine (Tunisie) Entre la chaise et le clavier
Date d'inscription : 03/03/2012

J'ai copié sur Bignono - Page 8 Empty
MessageSujet: Re: J'ai copié sur Bignono   J'ai copié sur Bignono - Page 8 EmptySam 15 Sep 2012 - 12:47

Je suis très Very Happy Laughing Very Happy
Revenir en haut Aller en bas
http://papydall-panoramic.forumarabia.com/
Yannick




Nombre de messages : 8610
Age : 53
Localisation : Bretagne
Date d'inscription : 15/02/2010

J'ai copié sur Bignono - Page 8 Empty
MessageSujet: re   J'ai copié sur Bignono - Page 8 EmptySam 15 Sep 2012 - 23:28

Bon j'en suis là et je vais en rester là pour ce viewer.

Code:
'            ***********************************************
'            *                                            *
'            *              3DS VIEWER                    *
'            *                                            *
'            *  Viewer pour Objet 3D d'estension *.3ds    *
'            *  Avec la participation de la communauté    *
'            *                PANORAMIC                    *
'            ***********************************************

' ------------------------------------------------------------------------------
' LES DERNIERS DES MOHICANS
' ------------------------------------------------------------------------------
' VARIABLES GLOBALES
dim D$,DT$,DC$,D3D$,Lang$,def$(200),R2%,G2%,B2%,R1%,G1%,B1%,nom$,File$
' LABEL
Label Menu,Direction,Rotation,Position_Cam,Position_PV,Lumiere,Coloration,Appli_Color
Label Appli_Texture,Couleur_Fond,Appli_Fond,Zoom,Dialog_open,Valid_Selection
' ------------------------------------------------------------------------------
Init_F0()
Init_Container()
Init_F800()
Init_Prog()
Langue(lang$)
end
' ------------------------------------------------------------------------------
' CREATION DU FORM 0
' ------------------------------------------------------------------------------
sub Init_F0()
  Dim_local x%
  width 0,425:height 0,292:top 0,(screen_y-292)/2:left 0,(screen_x-425)/2
  caption 0,"Viewer 3DS":font_name 0,"Times new roman":font_size 0,10
  main_menu 1
  for x%=2 to 19:sub_menu x% :on_click x%,menu :next x%
  for x%=2 to 6 :parent x%,1 :next x%
  for x%=7 to 8 :parent x%,2 :next x%
  for x%=9 to 16:parent x%,3 :next x%
  for x%=17 to 19:parent x%,4:next x%
  Inactive 3
  image 98
  dlist 99
end_sub
' ------------------------------------------------------------------------------
' A TABLE !!!
' ------------------------------------------------------------------------------
menu:
  dim M%,x%
  for x% = 2 to 19
      if clicked(x%)=1 then M%=x%
  next x%
  select M%
  case 2
  case 3
  case 4
  case 5
      message "En cours"
  case 6
      message "En cours"
  case 7
    Ouvrir()
  case 8
    Quitter()
  case 9
    show 100
    hide 200:hide 300:hide 400:hide 500:hide 600:hide 700
  case 10
    show 200
    hide 100:hide 300:hide 400:hide 500:hide 600:hide 700
  case 11
    show 300
    hide 200:hide 100:hide 400:hide 500:hide 600:hide 700
  case 12
    show 400
    hide 200:hide 300:hide 100:hide 500:hide 600:hide 700
  case 13
    show 500
    hide 200:hide 300:hide 400:hide 100:hide 600:hide 700
  case 14
    show 600
    hide 200:hide 300:hide 400:hide 500:hide 100:hide 700
  case 15
    show 700
    hide 200:hide 300:hide 400:hide 500:hide 600:hide 100
  case 16
    Capture()
  case 17
    Lang$="French"
    Langue(Lang$)
  case 18
    Lang$="English"
    Langue(Lang$)
  case 19
    Lang$="Deutsch"
    Langue(Lang$)
  end_select
  free M%:free x%
return
' ------------------------------------------------------------------------------
' CREATION DES "CONTAINER"
' ------------------------------------------------------------------------------
Sub Init_Container()
dim_local x%,y%
for x%=100 to 700 step 100 :container x% :hide x% :width x%,400:height x%,220:top x%,10:left x%,5:next x%
' Contenu du container 100 (Zoom)
scroll_bar 101:parent 101,100:top 101,40:left 101,20:min 101,1:max 101,2000:position 101,1
position 101,0.001:on_change 101,Zoom
alpha 102    :parent 102,100:top 102,65:left 102,20
picture 103:parent 103,100:stretch_on 103:width 103,208:height 103,162:top 103,35:left 103,150
file_load 103,"zoom.bmp"
' Contenu du container 200 (Direction)
for x%=201 to 210:button x% :parent x%,200:font_name x%,"webdings":font_size x%,12 :on_click x%,Direction:next x%
for x%=201 to 208:width x%,30:height x%,30:next x%
for x%=209 to 210:width x%,30:height x%,15:next x%
top 201,90:left 201,230
top 202,90:left 202,260 :caption 202,"5"
top 203,90:left 203,290
top 204,120:left 204,230 :caption 204,"3"
top 205,120:left 205,290:caption 205,"4"
top 206,150:left 206,230
top 207,150:left 207,260 :caption 207,"6"
top 208,150:left 208,290
top 209,120:left 209,260 :caption 209,"5"
top 210,135:left 210,260 :caption 210,"6"
picture 211:parent 211,200:top 211,40:left 211,60:width 211,68:height 211,136:stretch_on 211
file_load 211,"direction.bmp"
' Contenu du container 300 (Rotation)
alpha 301:parent 301,300:top 301,35 :left 301,13:caption 301,"Axe X":font_color 301,0,0,255
scroll_bar 302:parent 302,300:top 302,50:left 302,13:width 302,160:min 302,0:max 302,359
position 302,0:on_change 302,Rotation
alpha 303:parent 303,300:top 303,70 :left 303,13:caption 303,"Axe Y":font_color 303,0,0,255
scroll_bar 304:parent 304,300:top 304,85:left 304,13:width 304,160:min 304,0:max 304,359
position 304,0:on_change 304,Rotation
alpha 305:parent 305,300:top 305,105 :left 305,13:caption 305,"Axe Z":font_color 305,0,0,255
scroll_bar 306:parent 306,300:top 306,120:left 306,13:width 306,160:min 306,0:max 306,359
position 306,0:on_change 306,Rotation
' Contenu du container 400 (Caméra)
alpha 401    :parent 401,400:top 401,45 :left 401,13:caption 401,"Axe X":font_color 401,0,0,255
scroll_bar 402:parent 402,400:top 402,60 :left 402,13:min 402,-100:max 402,100:on_change 402,Position_Cam
alpha 403    :parent 403,400:top 403,80 :left 403,13:caption 403,"Axe Y":font_color 403,0,0,255
scroll_bar 404:parent 404,400:top 404,95 :left 404,13:min 404,-100:max 404,100:on_change 404,Position_Cam
alpha 405    :parent 405,400:top 405,115:left 405,13:caption 405,"Axe Z":font_color 405,0,0,255
scroll_bar 406:parent 406,400:top 406,130:left 406,13:min 406,-100:max 406,100:on_change 406,Position_Cam
y%=10
for x%=407 to 409:y%=y%+35:alpha x%:parent x%,400:top x%,y%:left x%,50:font_name x%,"arial":font_size x%,8:font_color x%,255,0,0:next x%
alpha 410:parent 410,400:top 410,30:left 410,250

alpha 411    :parent 411,400:top 411,45 :left 411,213:caption 411,"Axe X":font_color 411,0,0,255
scroll_bar 412:parent 412,400:top 412,60 :left 412,213:min 412,-100:max 412,100:on_change 412,Position_PV
alpha 413    :parent 413,400:top 413,80 :left 413,213:caption 413,"Axe Y":font_color 413,0,0,255
scroll_bar 414:parent 414,400:top 414,95 :left 414,213:min 414,-100:max 414,100:on_change 414,Position_PV
alpha 415    :parent 415,400:top 415,115:left 415,213:caption 415,"Axe Z":font_color 415,0,0,255
scroll_bar 416:parent 416,400:top 416,130:left 416,213:min 416,-100:max 416,100:on_change 416,Position_PV
y%=10
for x%=417 to 419:y%=y%+35:alpha x%:parent x%,400:top x%,y%:left x%,250:font_name x%,"arial":font_size x%,8:font_color x%,255,0,0:next x%
alpha 420:parent 420,400:top 420,30:left 420,50
' Contenu du container 500 (Lumière)
alpha 501    :parent 501,500:top 501,45 :left 501,213:caption 501,"Axe X":font_color 501,0,0,255
scroll_bar 502:parent 502,500:top 502,60 :left 502,213:min 502,0:max 502,359:on_change 502,Lumiere
alpha 503    :parent 503,500:top 503,80 :left 503,213:caption 503,"Axe Y":font_color 503,0,0,255
scroll_bar 504:parent 504,500:top 504,95 :left 504,213:min 504,0:max 504,359:on_change 504,Lumiere
alpha 505    :parent 505,500:top 505,115:left 505,213:caption 505,"Axe Z":font_color 505,0,0,255
scroll_bar 506:parent 506,500:top 506,130:left 506,213:min 506,0:max 506,359:on_change 506,Lumiere
y%=10
for x%=507 to 509:y%=y%+35:alpha x%:parent x%,500:top x%,y%:left x%,250:font_name x%,"arial":font_size x%,8:font_color x%,255,0,0:next x%
alpha 510:parent 510,500:top 510,30:left 510,250
picture 511:parent 511,500:width 511,100:height 511,165:top 511,30:left 511,30:stretch_on 511
file_load 511,"lumiere.bmp"
' Contenu du container 600 (Couleur de fond)
picture 601:parent 601,600:height 601,70:width 601,70:top 601,25:left 601,5:color 601,0,0,0
spin 602:parent 602,600:top 602,25 :left 602,80:width 602,45:font_color 602,255,0,0:cursor_point 602:min 602,0:max 602,255
spin 603:parent 603,600:top 603,50:left 603,80:width 603,45:font_color 603,0,255,0:cursor_point 603:min 603,0:max 603,255
spin 604:parent 604,600:top 604,75:left 604,80:width 604,45:font_color 604,0,0,255:cursor_point 604:min 604,0:max 604,255
button 605:parent 605,600:top 605,85:left 605,155:cursor_point 605
for x%=602 to 604:on_change x%,Couleur_Fond:next x%
on_click 605,Appli_Fond
' Contenu du container 700 (Habillage)
picture 701 :parent 701,700:width 701,40:height 701,40:top 701,60:left 701,25:color 701,0,0,0
spin 702    :parent 702,700:height 702,15:width 702,45:top 702,50:left 702,70:min 702,0:max 702,255
font_size 702,8:font_name 702,"arial":font_color 702,255,0,0:on_change 702,Coloration
spin 703    :parent 703,700:height 703,15:width 703,45:top 703,70:left 703,70:min 703,0:max 703,255
font_size 703,8:font_name 703,"arial":font_color 703,0,255,0:on_change 703,Coloration
spin 704    :parent 704,700:height 704,15:width 704,45:top 704,90:left 704,70:min 704,0:max 704,255
font_size 704,8:font_name 704,"arial":font_color 704,0,0,255:on_change 704,Coloration
button 705  :parent 705,700:width 705,70:top 705,120:left 705,40
cursor_point 705:on_click 705,Appli_Color
alpha 709  :parent 709,700:top 709,30 :Left 709,25
alpha 710  :parent 710,700:top 710,110:Left 710,220
button 711  :parent 711,700:top 711,130:left 711,220:width 711,140
cursor_point 711:on_click 711,Appli_Texture
end_sub
' ------------------------------------------------------------------------------
sub Init_Prog()
  D$=Dir_current$
  if dir_exists(D$+"\Texture")=0 then dir_make D$+"\Texture"
  DT$=D$+"\Texture"
  if dir_exists(D$+"\Capture")=0 then dir_make D$+"\Capture"
  DC$=D$+"\Capture"
  if dir_exists(D$+"\3D")=0 then dir_make D$+"\3D"
  D3D$=D$+"\3D"
end_sub
' ------------------------------------------------------------------------------
sub Init_Scene()
  position 101,1:position 302,0:position 304,0:position 306,0
  gosub Zoom
  position 402,0:position 404,0:position 406,5
  gosub Position_Cam
  position 502,0:position 504,0:position 506,5
  gosub Lumiere
end_sub
' ------------------------------------------------------------------------------
sub Ouvrir()
  dim_local F$,x%,top_f%,left_f%
  top_f%=top(0):left_f%=left(0)
  ' Placement de l'appli dans le dossier où sont les fichiers 3d
  dir_change D3D$
  ' Récupération des adresses des fichiers 3DS et 3ds
  F$=file_find_first$
  if Upper$(file_extract_extension$(F$))=".3DS" then item_add 99,F$
  F$=file_find_next$
  while F$<>"_"
  if Upper$(file_extract_extension$(F$))=".3DS" then item_add 99,F$
  F$=file_find_next$
  end_while
  file_find_close
  if count(99)>0
  ' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
      form 900:top 900,top_f%+54:left 900,left_f%+8:width 900,200:height 900,240
      font_name 900,"Times new roman":font_size 900,10
      command_target_is 900
      list 901:width 901,184:height 901,140:cursor_point 901:on_double_click 901,Valid_Selection
      alpha 902:top 902,140:left 902,5
      font_color 902,0,0,255
      button 903:width 903,30:height 903,30:top 903,160:left 903,77:font_name 903,"Wingdings":caption 903,"1":font_bold 903
      on_click 903,Dialog_open:cursor_point 903
      ' Affichage des fichiers récupérés dans le list 901
      for x%=1 to count(99)
        F$=item_read$(99,x%)
        item_add 901,left$(file_extract_name$(F$),len(file_extract_name$(F$))-4)
      next x%
      Init_Caption()
      command_target_is 0
  ' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
  else
      if Message_information_yes_no(def$(22)+chr$(13)+def$(23))=1
        gosub Dialog_open
      end_if
  end_if
end_sub
' ------------------------------------------------------------------------------
Dialog_open:
    open_dialog 1000
    dir_dialog 1000,left$(D$,2)
    filter 1000,"Fichiers *.3DS,*.3ds|*.3DS;*.3ds"
    file$=file_name$(1000)
    delete 1000
    if file$<>"_"
      Create_Objet()
    end_if
    if object_exists(900)=1 then delete 900
return
' ------------------------------------------------------------------------------
Valid_Selection:
  if o3d_object_exists(1)=1 then 3d_delete 1
  File$=D3D$+"\"+item_read$(99,item_index(901))
  Create_Objet()
return
' ------------------------------------------------------------------------------
sub Create_Objet()
  caption 800,"3DS Viewer"+chr$(32)+"("+chr$(32)+file_extract_name$(File$)+chr$(32)+")"
  nom$=file_extract_name$(file$)
  nom$=left$(nom$,len(nom$)-4)
  3d_mesh 1
  3d_load_object 1,File$
  Init_Scene()
  clear 99
  if object_exists(900)=1 then delete 900
  if file$<>"_"
      active 3
      Replace_Form()
      to_foreground 0
  end_if
end_sub
' ------------------------------------------------------------------------------
sub Replace_Form()
  dim_local x%,y%
  top 800,(screen_y-656)/2
  left 800,(screen_x-425-816)
  top 0,Top(800)
  left 0,(screen_x-425)
  show 800
end_sub
' ------------------------------------------------------------------------------
Direction:
  dim x%,Dir%,x,y,z
  for x%=201 to 210
      if clicked(x%)=1 then Dir%=x%
  next x%
  select Dir%
  case 201
    ' decale vers haut gauche
    y=o3d_y_position(1):x=o3d_x_position(1):z=o3d_z_position(1)
    y=y+0.1:x=x-0.1:3d_position 1,x,y,z
  case 202
    ' decale vers haut
    y=o3d_y_position(1):y=y+0.1:3d_y_position 1,y
  case 203
    ' decale vers haut droit
    y=o3d_y_position(1):x=o3d_x_position(1):z=o3d_z_position(1)
    y=y+0.1:x=x+0.1:3d_position 1,x,y,z
  case 204
    ' decale vers gauche
    x=o3d_x_position(1):x=x-0.1:3d_x_position 1,x
  case 205
    ' decale vers droite
    x=o3d_x_position(1):x=x+0.1:3d_x_position 1,x
  case 206
    ' decale vers bas gauche
    y=o3d_y_position(1):x=o3d_x_position(1):z=o3d_z_position(1)
    y=y-0.1:x=x-0.1:3d_position 1,x,y,z
  case 207
    ' decale vers bas
    y=o3d_y_position(1):y=y-0.1:3d_y_position 1,y
  case 208
    ' decale vers bas droite
    y=o3d_y_position(1):x=o3d_x_position(1):z=o3d_z_position(1)
    y=y-0.1:x=x+0.1:3d_position 1,x,y,z
  case 209
    ' decale vers fond
    z=o3d_z_position(1):z=z+0.1:3d_z_position 1,z
  case 210
    ' decale vers avant
    z=o3d_z_position(1):z=z-0.1:3d_z_position 1,z
  end_select
  free x%:free Dir%:free x:free y:free z
return
' ------------------------------------------------------------------------------
Zoom:
  dim V
  V=position(101)/1000
  if O3D_object_exists(1) = 1 then 3d_scale 1,V,V,V
  caption 102,str$(V)
  free V
return
' ------------------------------------------------------------------------------
Rotation:
  3d_x_rotate 1,position(302)
  3d_y_rotate 1,position(304)
  3d_z_rotate 1,position(306)
return
' ------------------------------------------------------------------------------
Position_Cam:
  dim Cx,Cy,Cz
  if O3D_object_exists(1) = 1
      Cx=Position(402):Cy=Position(404):Cz=Position(406)
      caption 407,"("+str$(Cx)+")":caption 408,"("+str$(Cy)+")":caption 409,"("+str$(Cz)+")"
      cam_position Cx,Cy,Cz
  end_if
  free Cx:free Cy:free Cz
return
' ------------------------------------------------------------------------------
Position_PV:
  dim PVx,PVy,PVz
  if O3D_object_exists(1) = 1
      PVx=Position(412)/10:PVy=Position(414)/10:PVz=Position(416)/10
      caption 417,"("+str$(PVx)+")":caption 418,"("+str$(PVy)+")":caption 419,"("+str$(PVz)+")"
      point_position PVx,PVy,PVz
  end_if
  free PVx:free PVy:free PVz
return
' ------------------------------------------------------------------------------
Lumiere:
  dim Lx,Ly,Lz
  if O3D_object_exists(1) = 1
      Lx=Position(502):Ly=Position(504):Lz=Position(506)
      caption 507,"("+str$(Lx)+")":caption 508,"("+str$(Ly)+")":caption 509,"("+str$(Lz)+")"
      light_position Lx,Ly,Lz
  end_if
  free Lx:free Ly:free Lz
return
' ------------------------------------------------------------------------------
Couleur_Fond:
  if numeric(text$(602))=1 then R2%=val(text$(602))
  if numeric(text$(603))=1 then G2%=val(text$(603))
  if numeric(text$(604))=1 then B2%=val(text$(604))
  Color 601,R2%,G2%,B2%
return
' ------------------------------------------------------------------------------
Appli_Fond:
  Color 801,R2%,G2%,B2%
return
' ------------------------------------------------------------------------------
Coloration:
  if numeric(text$(702))=1 then R1%=val(text$(702))
  if R1% > 255 then R1% = 255
  if numeric(text$(703))=1 then G1%=val(text$(703))
  if G1% > 255 then G1% = 255
  if numeric(text$(704))=1 then B1%=val(text$(704))
  if B1% > 255 then B1% = 255
  color 701,R1%,G1%,B1%
return
' ------------------------------------------------------------------------------
Appli_Color:
  if O3D_object_exists(1) = 1 then 3d_color 1,R1%,G1%,B1%
return
' ------------------------------------------------------------------------------
Appli_Texture:
  dim a$,texture$
  texture$=""
  dir_change DT$
  a$=file_find_first$
  if a$=nom$+".bmp"
      texture$=a$
  else
      a$=file_find_next$
      if a$=nom$+".bmp"
        texture$=a$
      else
        while a$<>"_"
        a$=file_find_next$
        if a$=nom$+".bmp"
            texture$=a$
            exit_while
        end_if
        end_while
      end_if
  end_if
  if texture$=""
      open_dialog 1000
      dir_dialog 1000,DT$
      Texture$=file_name$(1000)
      delete 1000
  end_if
  if Texture$<>"_"
      if O3D_object_exists(1) = 1 then 3d_load_texture 1,Texture$
  end_if
return
' ------------------------------------------------------------------------------
sub Capture()
  dim_local res%
  dll_on D$+"\KGF.dll"
  to_foreground 800
  res%=dll_call1("ScreenCopy",2)
  pause 100
  clipboard_paste 98
  file_save 98,D$+"\Capture\"+nom$+".bmp"
  wait 1000
  to_foreground 0
  message "Vôtre capture a été enregistré dans :"+chr$(13)+D$+"\Capture\"+nom$+".bmp"
  dll_off
end_sub
' ------------------------------------------------------------------------------
' CREATION DU FORM 800 DE VISUALISATION
' ------------------------------------------------------------------------------
sub Init_F800()
  form 800:hide 800:width 800,816:height 800,638
  command_target_is 800
  scene3d 801:width 801,800:height 801,600:color 801,0,0,0
  3d_target_is 801
end_sub
' ------------------------------------------------------------------------------
' INITIALISATION DE LA LANGUE
' ------------------------------------------------------------------------------
sub Langue(Lang$)
  Dim_local x%,Lang$,s$:Lang$=Lang$
  if lang$="" then lang$="French"
  restore
  read s$
  while s$<>Lang$
      read s$
  end_while
  def$(1)=s$
  for x%= 2 to 24:read def$(x%):next x%
  Init_Caption()
end_sub
' ------------------------------------------------------------------------------
' INITIALISATION DE TOUT LES "CAPTION"
' ------------------------------------------------------------------------------
sub Init_Caption()
  dim_local x%
  for x%= 2 to 19:caption x%,def$(x%):next x%
  caption 100,chr$(32)+chr$(32)+def$(9)+chr$(32)+chr$(32)
  caption 200,chr$(32)+chr$(32)+def$(10)+chr$(32)+chr$(32)
  caption 300,chr$(32)+chr$(32)+def$(11)+chr$(32)+chr$(32)
  caption 400,chr$(32)+chr$(32)+def$(12)+chr$(32)+chr$(32)
  caption 500,chr$(32)+chr$(32)+def$(13)+chr$(32)+chr$(32)
  caption 600,chr$(32)+chr$(32)+def$(14)+chr$(32)+chr$(32)
  caption 700,chr$(32)+chr$(32)+def$(15)+chr$(32)+chr$(32)
 
  caption 605,def$(20)
  caption 705,def$(20)
  caption 711,def$(21)
  if object_exists(902)=1 then caption 902,def$(24)

end_sub
' ------------------------------------------------------------------------------
' CIRCULEZ Y A RIEN A VOIR !
' ------------------------------------------------------------------------------
sub Quitter()
  Terminate
end_sub
' ------------------------------------------------------------------------------
''                                LANGUES
' ------------------------------------------------------------------------------
data "French"
data "Fichier"
data "Outils"
data "Langue"
data "A Propos..."
data "Aide"
data "Ouvrir"
data "Quitter"
data "Zoom"
data "Direction"
data "Rotation"
data "Caméra"
data "Lumière"
data "Couleur de fond"
data "Habillage"
data "Capture"
data "-Français"
data "-Anglais"
data "-Allemand"
data "Appliquer"
data "Appliquer une texture"
data "Le dossier 3D est vide !"
data "Voulez faire une recherche ?"
data "Double cliquez pour sélectionner"
' ------------------------------------------------------------------------------
data "English"
data "File"
data "Tools"
data "Language"
data "About ..."
data "Help"
data "Open"
data "Exit"
data "Zoom"
data "Direction"
data "Rotation"
data "Camera"
data "Light"
data "Background Color"
data "Skin"
data "Capture"
data "-French"
data "-English"
data "-German"
data "Apply"
data "applying a texture"
data "3d folder is empty!"
data "Would you like to search?"
data "Double click to select"
' ------------------------------------------------------------------------------
Data "Deutsch"
Data "File"
Data "Tools"
Data "Sprache"
Data "Über ..."
Data "Help"
Data "Open"
Data "Exit"
Data "Zoom"
Data "Direction"
Data "Rotation"
Data "Camera"
Data "Light"
Data "Hintergrundfarbe"
Data "Skin"
data "Bilderfassung"
data "-Französisch"
data "-English"
data "-deutsch"
data "anwenden"
data "Aufbringen einer Textur"
data "3d Ordner leer ist!"
data "Sie suchen?"
data "Doppelklicken Sie auf die Option"
' ------------------------------------------------------------------------------
J'ai bien entendu (vu Laughing ) toutes vos astuces même si un gros poil s'est mis
à pousser dans ma main pour toutes les appliquer sur cet outil, elles sont notés Wink .

PS: Les pictures *.bmp sont sur mon Webdav, vous pouvez prendre tout le zip "viewer 2.0.zip"
Revenir en haut Aller en bas
Contenu sponsorisé





J'ai copié sur Bignono - Page 8 Empty
MessageSujet: Re: J'ai copié sur Bignono   J'ai copié sur Bignono - Page 8 Empty

Revenir en haut Aller en bas
 
J'ai copié sur Bignono
Revenir en haut 
Page 8 sur 8Aller à la page : Précédent  1, 2, 3, 4, 5, 6, 7, 8
 Sujets similaires
-
» Bonjour Bignono
» chasseur d’astéroïdes V4 sonorisé par Bignono
» copie multiple clip_board
» Copie de fichiers
» Fonction copie de fichiers

Permission de ce forum:Vous ne pouvez pas répondre aux sujets dans ce forum
FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC :: PANORAMIC :: Vos sources, vos utilitaires à partager-
Sauter vers: