FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC

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

» KGF_dll - nouvelles versions
par pascal10000 Aujourd'hui à 17:27

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

» track_bar circulaire
par Klaus Hier à 13:54

» API Windows
par Klaus Hier à 3:21

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

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

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

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

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

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

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

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

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

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

Navigation
 Portail
 Index
 Membres
 Profil
 FAQ
 Rechercher
Rechercher
 
 

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

Partagez | 
 

 Annoter une image avec des bulles de texte

Voir le sujet précédent Voir le sujet suivant Aller en bas 
AuteurMessage
Klaus

avatar

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

MessageSujet: Annoter une image avec des bulles de texte   Lun 3 Avr 2017 - 4:05

Voici un utilitaire qui peut annoter des images (dessins, photos, ...) avec des bulles de texte en forme de rectangles, rectangles arrondis et ellipses, tout en y inscrivant éventuellement une ou plusieurs lignes de texte.

Le texte peut être orienté de gauche à droite, de bas en haut, de haut en bas et de droite à gauche. On peut choisir les couleurs (bordure, remplissage et texte), l'épaisseur des bordures, le rayon de courbure des rectangles arrondis, police, taille et attributs du texte.

Le programme est piloté par des menus, et une barre d'outils à gauche de l'écran pour le choix des paramètres. La partie principale de l'écran est occupé par l'affichage de l'image. Détail important: si l'image est plus grande que la fenêtre de visualisation, des ascenseurs verticaux et horizontaux apparaissent, et on peut défiler l'image à volonte. L'image, enfin la partie visible, sera toujours affichée en taille réelle, sans aucune déformation.

Un petit mot sur le mode opératoire:
pour tracer une bulle, cliquer d'abord sur le bouton "Tracer bulle". Un libellé en gras apparaît juste en-dessous du bouton indiquant la marche à suivre. On commence par tracer le rectangle de sélection en  plaçant le curseur sur le coin en haut à gauche du futur rectangle. Puis, on enfonce le bouton gauche et, tout en le maintenant enfoncé, on "tire" le rectangle de sélection jusqu'au coin en bas à droite. Là, on lâche le bouton gauche. L'indication à l'écran change et on choisit l'emplacement de la pointe de la flèche, en cliquant à cet endroit avec le bouton droit de la souris. L'affichage change encore, et on valide la bulle en cliquant sur le bouton "Valider bulle". Si du texte avait été saisi dans le mémo en bas de la barre d'outils, il sera imprimé dans la bulle selon les paramètres choisis.

Fin de baratin. Voici le source:
Code:
' annoter_une_image.bas

' Cet utilitaire permet de:
'   - charger une image
'   - y placer des bulles de texte
'   - sauvegarder le résultat obtenu

dll_on "KGF.dll"

labels()
variables()
form0()
menus()

end

nouveau:
  nouveau()
  return
  
ouvrir:
  ouvrir()
  return
  
enregistrer:
  enregistrer()
  return
  
enregistrersous:
  enregistrersous()
  return
  
sortir:
  sortir()
  return
  
tracer:
  tracer()
  return
  
valider:
  valider()
  return
  
MouseDown:
  MouseDown()
  return

MouseMove:
  off_mouse_move 11
  MouseMove()
  on_mouse_move 11,MouseMove
  return
  
scroll:
  scroll()
  return
  
couleur:
  couleur()
  return
  
couleurok:
  hide 500
  to_foreground 0
  active 0
  set_focus 43
  return
  
changecouleur:
  changecouleur(number_change)
  return
  

sub labels()
  label nouveau, ouvrir, enregistrer, enregistrersous, sortir
  label tracer, MouseDown, MouseMove, valider, scroll
  label couleur, couleurok, changecouleur

end_sub


sub variables()
  dim no%, d%, res%, typ%
  dim actif%                  : ' flag "une image est présente, modifiée et non sauvegardée"
  dim fichier$                : ' nom du fichier chargé dans le picture 11
  dim larg%, haut%            : ' dimensions réelles de l'image du fichier chargé
  dim wlarg%, whaut%          : ' dimensions réelles de du picture 11
  dim mousex%, mousey%        : ' coordonnées de la souris
  dim bulle%(3)               : ' dimensions de la bulle (types 1...3)
  dim pointe%(1)              : ' coordonnées de la pointe
  dim TypeTrace%              : ' type de traçage  0=rien  1=bulle 2=pointe 3=prêt à valider
  dim TraceEnCours%           : ' flag "traçage du rectangle en cours"
  dim Origine%                : ' origine de la flèche: 0=TL 1=TR 2=BR 3=BL 4=T B=R 6=B 7=L
  dim down%                   : ' flag "bouton gauche de la souris est enfoncé"
  dim hdc%                    : ' reçoit handle_canvas(11)
  dim CNV%                    : ' identifiant du canvas pour le dessin
  dim Params%(20)             : ' paramètres pour DrawOnCanvas
  dim xpos%, ypos%            : ' positions de la fenêtre de visualisation
  dim CouleurBord%            : ' code couleur pour la bordure
  dim CouleurRemplissage%     : ' code couleur pour le remplissage
  dim CouleurText%            : ' couleur du texte à imprimer
  dim nCouleur%               : ' indice du type de couleur
  dim RR%, GG%, BB%           : ' couleurs RGB décodées
end_sub


sub form0()
  dim_local res%, i%
  full_space 0
  
  ' les outils
  container 1 : height 1,height_client(0) - 30 : width 1,300 : caption 1,"Outils"

  ' les outils "Fichiers"
  container 31 : parent 31,1 : top 31,15 : left 31,15 : width 31,width_client(1)-30
    color 31,225,225,225
    caption 31,"Fichiers"
  button 32 : parent 32,31 : top 32,15 : left 32,15 : height 32,20 : width 32,70 : caption 32,"Nouveau"
    on_click 32,nouveau
  button 33 : parent 33,31 : top 33,15 : left 33,100 : height 33,20 : width 33,50 : caption 33,"Ouvrir"
    on_click 33,ouvrir  
  button 34 : parent 34,31 : top 34,15 : left 34,170 : height 34,20 : width 34,70 : caption 34,"Enregistrer"
    on_click 34,enregistrer  
  button 35 : parent 35,31 : top 35,40 : left 35,75 : height 35,20 : width 35,100 : caption 35,"Enregistrer sous"
    on_click 35,enregistrersous  
  button 36 : parent 36,31 : top 36,75 : left 36,95 : height 36,20 : width 36,60 : caption 36,"Sortir"
    on_click 36,sortir
   alpha 37 : parent 37,31 : top 37,45 : left 37,200 : caption 37,"W; "  
   alpha 38 : parent 38,31 : top 38,65 : left 38,200 : caption 38,"H; "  
    
' les outils  "Bulles"
  container 41 : parent 41,1 : top 41,15+height(31)+5 : left 41,15
    width 41,width_client(1)-30 : height 41,height_client(1)-top(41)-10
    color 41,225,225,225
    caption 41,"Bulles"
  combo 42 : parent 42,41 : top 42,15 : left 42,15 : width 42,width_client(41)-30
    item_add 42,"Bulle rectangle"
    item_add 42,"Bulle rectangle arrondi"
    item_add 42,"Bulle ellipse"
  res% = dll_call2("SelectComboBoxItem",handle(42),1)
  button 43 : parent 43,41 : top 43,top(42)+height(42)+5: left 43,15 : height 43,20
    caption 43,"Tracer bulle" : on_click 43,tracer
  alpha 44 : parent 44,41 : top 44,top(43)+30 : left 44,15 : font_bold 44
  button 45 : parent 45,41 : top 45,top(43) : left 45,115 : height 45,20
    caption 45,"Valider bulle" : on_click 45,valider
  alpha 46 : parent 46,41 : top 46,top(44)+30 : left 46,15
    caption 46,"Rayon de courbure d'arrondi:"
  spin 47 : parent 47,41 : top 47,top(46) : left 47,160 : width 47,60
    min 47,0 : max 47,50 : position 47,10
  alpha 48 : parent 48,41 : top 48,top(46)+30 : left 48,15
    caption 48,"Diamètre de la base de flèche:"
  spin 49 : parent 49,41 : top 49,top(48) : left 49,160 : width 49,60
    min 49,5 : max 49,200 : position 49,20  
  alpha 50 : parent 50,41 : top 50,top(48)+30 : left 50,15
    caption 50,"Epaisseur de la bordure:"
  spin 51 : parent 51,41 : top 51,top(50) : left 51,160 : width 51,60
    min 51,1 : max 51,20 : position 51,1

  alpha 52 : parent 52,41 : top 52,top(50)+30 : left 52,15
    caption 52,"Couleur de la bordure:"
  picture 53 : parent 53,41 : top 53,top(52) : left 53,160 : width 53,30 : height 53,20
    color 53,0,0,0
  button 54 : parent 54,41 : top 54,top(52) : left 54,left(53)+35 : width 54,30 : height 54,20
    caption 54,"..." : font_bold 54 : on_click 54,couleur
    
  alpha 55 : parent 55,41 : top 55,top(52)+30 : left 55,15
    caption 55,"Couleur de remplissage:"
  picture 56 : parent 56,41 : top 56,top(55) : left 56,160 : width 56,30 : height 56,20
    color 56,255,255,0
  button 57 : parent 57,41 : top 57,top(55) : left 57,left(56)+35 : width 57,30 : height 57,20
    caption 57,"..." : font_bold 57 : on_click 57,couleur

  alpha 58 : parent 58,41 : top 58,top(55)+30 : left 58,15
    caption 58,"Couleur du texte:"
  picture 59 : parent 59,41 : top 59,top(58) : left 59,160 : width 59,30 : height 59,20
    color 59,0,0,0
  button 60 : parent 60,41 : top 60,top(58) : left 60,left(59)+35 : width 60,30 : height 60,20
    caption 60,"..." : font_bold 60 : on_click 60,couleur

  memo 61 : parent 61,41 : top 61,top(58)+30 : left 61,15 : width 61,width_client(41)-30
    height 61,150 : bar_both 61 : font_size 61,10
  combo 62 : parent 62,41 : top 62,top(61)+height(61)+10 : left 62,15
    width 62,120
    item_add 62,"Gauche -> Droite"
    item_add 62,"Bas -> Haut"
    item_add 62,"Haut-> Bas"
    item_add 62,"Droite -> Gauche"
  res% = dll_call2("SelectComboBoxItem",handle(62),1)
'  check 63 : parent 63,41 : top 63,top(62) : left 63,160 : caption 63,"Centré"  
  combo 64 : parent 64,41 : top 64,top(62)+30 : left 64,15
    width 64,width_client(41)-30 : font_names_load 64
  for i%=1 to count(64)
    if item_read$(64,i%)="Arial"
      res% = dll_call2("SelectComboBoxItem",handle(64),i%)      
      exit_for
    end_if
  next i%
  check 65 : parent 65,41 : top 65,top(64)+30 : left 65,15 : caption 65,"G" : font_bold 65  
  check 66 : parent 66,41 : top 66,top(65) : left 66,60 : caption 66,"I" : font_italic 66  
  check 67 : parent 67,41 : top 67,top(65) : left 67,105 : caption 67,"S" : font_underline 67  
  check 68 : parent 68,41 : top 68,top(65) : left 68,150 : caption 68,"B" : font_strike 68  
  combo 69 : parent 69,41 : top 69,top(65) : left 69,200 : width 69,width_client(41)-215
    item_add 69,"8"
    item_add 69,"10"
    item_add 69,"12"
    item_add 69,"14"
    item_add 69,"16"
    item_add 69,"18"
    item_add 69,"20"
    item_add 69,"22"
    item_add 69,"24"
    item_add 69,"38"
    item_add 69,"32"
    item_add 69,"36"
    item_add 69,"48"
    res% = dll_call2("SelectComboBoxItem",handle(69),3)      
    
' l'image
  container 2 : left 2,300 : height 2,height_client(0) - 30 : width 2,width_client(0)-300
    caption 2,"Image"
  wlarg% = width_client(2)-30
  whaut% = height_client(2)-35
  picture 11 : parent 11,2
    top 11,15 : left 11,10 : width 11,wlarg% : height 11,whaut%
    color 11,225,225,0 : parent 11,2
  2d_target_is 11
  scroll_bar 101 : parent 101,2
    height 101,20 : width 101,width_client(2)-20 : top 101,height(2)-20
    min 101,0 : max 101,width_client(2)-20 : inactive 101 : on_change 101,scroll
  scroll_bar 102 : parent 102,2 : vertical 102
    width 102,20 : height 102,height_client(2)-20 : left 102,width(2)-20
    min 102,0 : max 102,height_client(2)-20 : inactive 102 : on_change 101,scroll
  form 110 : full_space 110 : hide 110
  picture 111 : parent 111,110 : width 111,wlarg% : height 111,whaut%
                            
  ' la fenêtre "sablier"
  form 20 : hide 20 : border_hide 20 : width 20,400 : height 20,100
    top 20,(screen_y-height(20))/2 : left 20,(screen_x-width(20))/2
  panel 21 : parent 21,20 : full_space 21 : color 21,255,192,192
    font_size 21,24
    caption 21,"Opération en cours..."
    
  ' la fenêtre de sélection de couleur
  form 500 : hide 500 : caption 500,"Sélection de couleur" : width 500,500
    top 500,(screen_y-height(500))/2 : left 500,(screen_x-width(500))/2
    on_close 500,couleurok
  alpha 501 : parent 501,500 : top 501,10 : left 501,10 : font_bold 501
  
  alpha 502 : parent 502,500 : top 502,40 : left 502,10 : font_bold 501
    font_bold 502 : caption 502,"R"
  scroll_bar 503 : parent 503,500 : top 503,40 : left 503,30
    width 503,width_client(500)-100 : min 503,0 : max 503,255
    on_change 503,changecouleur
  alpha 504 : parent 504,500 : top 504,40 : left 504,left(503)+width(503)+20
    
  alpha 505 : parent 505,500 : top 505,70 : left 505,10 : font_bold 505
    font_bold 505 : caption 505,"G"
  scroll_bar 506 : parent 506,500 : top 506,70 : left 506,30
    width 506,width_client(500)-100 : min 506,0 : max 506,255
    on_change 506,changecouleur
  alpha 507 : parent 507,500 : top 507,70 : left 507,left(506)+width(506)+20
    
  alpha 508 : parent 508,500 : top 508,100 : left 508,10 : font_bold 508
    font_bold 508 : caption 508,"B"
  scroll_bar 509 : parent 509,500 : top 509,100 : left 509,30
    width 509,width_client(500)-100 : min 509,0 : max 509,255
    on_change 509,changecouleur
  alpha 510 : parent 510,500 : top 510,100 : left 510,left(509)+width(509)+20


  ' objets invisibles
  open_dialog 12
  save_dialog 13
  image 14              : ' pour mémoriser l'image avant toute opération
                            
  actif% = 0
  larg% = width(11)
  haut% = height(11)
  CouleurBord%         = 0                     : ' noir
  CouleurRemplissage%  = (0*256+255)*256+255   : ' jaune
  CouleurText%         = 0                     : ' noir
  2d_target_is 11
  2d_image_copy 14,0,0,wlarg%,whaut%
  caption 0,"Annotation"
end_sub


sub menus()
  dim_local no1%, no2%
  no% = 1000 : main_menu no%
  no% = no% + 1 : sub_menu no% : parent no%,1000 : no1% = no% : caption no%,"Fichiers"
    no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"Nouveau"
      on_click no%,nouveau
    no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"Ouvrir..."
      on_click no%,ouvrir
    no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"Enregistrer"
      on_click no%,enregistrer
    no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"Enregistrer sous..."
      on_click no%,enregistrersous
    no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"-"
    no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"Sortir"
      on_click no%,sortir
  no% = no% + 1 : sub_menu no% : parent no%,1000 : no1% = no% : caption no%,"Bulles"
end_sub


sub nouveau()
  if actif%=1
    if message_confirmation_yes_no("L'image actuelle n'est pas enregistrée. Sortir quand-même ?")<>1 then exit_sub
  end_if
  if CNV%<>0
    CNV% = dll_call1("FreeCanvas",CNV%)
  end_if
  actif% = 0
  fichier$ = ""
  2d_clear
  stretch_off 11
  full_space 11
  TypeTrace% = 0
'  width 11,width(2)-20 : height 11,height(2)-20
  larg% = wlarg%
  haut% = whaut%
  clipboard_copy 11
  clipboard_paste 111
  width 111,larg% : height 111,haut%
  caption 37,"W: "+str$(larg%)
  caption 38,"H: "+str$(haut%)
  inactive 101 : inactive 102
  hdc% = handle_canvas(11)
  CNV% = dll_call2("GetCanvas",object_internal(11),adr(hdc%))
  xpos% = 0 : ypos% = 0
  CouleurBord%         = 0                     : ' noir
  CouleurRemplissage%  = (0*256+255)*256+255   : ' jaune
  CouleurText%         = 0                     : ' noir
  color 53,0,0,0
  color 56,255,255,0
  color 59,0,0,0
  2d_target_is 11
  2d_image_copy 14,0,0,wlarg%,whaut%
  caption 0,"Annotation"
end_sub


sub ouvrir()
  dim_local res%, f$, w%, h%
  filter 12,"Images JPG|*.jpg"
  f$ = file_name$(12)
  if f$="_" then exit_sub
  if file_exists(f$)=0
    message "Fichier non trouvé"
    exit_sub
  end_if
  if CNV%<>0
    CNV% = dll_call1("FreeCanvas",CNV%)
  end_if
  inactive 0 : show 20 : display
  res% = dll_call3("AnalyzeImageFile",adr(f$),adr(larg%),adr(haut%))
  off_change 101 : position 101,0 : on_change 101,scroll
  if larg%>wlarg%
    min 101,0 : max 101,larg%-wlarg%
  else
    inactive 101
  end_if
  off_change 102 : position 102,0 : on_change 102,scroll
  if haut%>whaut%
    min 102,0 : max 102,haut%-whaut%
    position 102,0
  else
    inactive 102
  end_if
  caption 37,"W: "+str$(larg%)
  caption 38,"H: "+str$(haut%)
  width 110,larg%+30 : height 110,haut%+100
  width 111,larg% : height 111,haut%
                                    
  fichier$ = f$
  res% = dll_call1("LoadAnyImageFile",adr(fichier$))
  clipboard_paste 111
  2d_target_is 111
  
  2d_image_copy 14,0,0,wlarg%,whaut%
  2d_target_is 11
  2d_image_paste 14,0,0
'  show 110
  
  caption 0,"Annotation de "+fichier$
  TypeTrace% = 0
  xpos% = 0 : ypos% = 0
  CouleurBord%         = 0                     : ' noir
  CouleurRemplissage%  = (0*256+255)*256+255   : ' jaune
  CouleurText%         = 0                     : ' noir
  color 53,0,0,0
  color 56,255,255,0
  color 59,0,0,0
  2d_target_is 11
  2d_image_copy 14,0,0,wlarg%,whaut%
  hide 20: active 0
end_sub


sub enregistrer()
  dim_local res%
  if fichier$=""
    message "Pas d'image ouverte"
    exit_sub
  end_if
  inactive 0 : show 20 : display
'  clipboard_copy 11
  clipboard_copy 111
  pause 100
  res% = dll_call1("SaveAnyImageFile",adr(fichier$))
  actif% = 0
  caption 0,"Annotation de "+fichier$
  hide 20 : active 0
end_sub


sub enregistrersous()
  dim_local f$, res%
  f$ = file_name$(13)
  if f$="_" then exit_sub
  if file_exists(f$)=1
    if message_confirmation_yes_no("Ce fichier existe déjà. Remplacer ?")<>1 then exit_sub
  end_if
  inactive 0 : show 20 : display
  clipboard_copy 111
  pause 300
  res% = dll_call1("SaveAnyImageFile",adr(f$))
  fichier$ = f$
  actif% = 0
  caption 0,"Annotation de "+fichier$
  hide 20 : active 0
end_sub


sub sortir()
  if actif%=1
    if message_confirmation_yes_no("L'image actuelle n'est pas enregistrée. Sortir quand-même ?")<>1 then exit_sub
  end_if
  terminate
end_sub


sub tracer()
  TypeTrace% = 1                        : ' on trace la bulle
  TraceEnCours% = 0
  on_mouse_down 11,MouseDown
  caption 44,"Tracer le rectangle délimiteur..."
end_sub


sub MouseDown()
  off_mouse_down 11
  mousex% = mouse_x_left_down(11) : ' *(larg%/wlarg%)
  mousey% = mouse_y_left_down(11) : ' *(haut%/whaut%)
  select TypeTrace%
    case 1:    ' bulle
      bulle%(0) = mousex%
      bulle%(1) = mousey%
      bulle%(2) = mousex%
      bulle%(3) = mousey%
      TraceEnCours% = 1
    case 2:    ' pointe
      down% = dll_call1("CheckMouseButton",2)
      if down%=1                : ' est-ce que le bouton droit est enfoncé ?
        mousex% = mouse_x_position(11) : ' *(larg%/wlarg%)
        mousey% = mouse_y_position(11) : ' *(haut%/whaut%)
        Origine% = 0
        if mousex%<bulle%(0)
          if mousey%<bulle%(1)
            Origine% = 0            : ' TL
          else
            if mousey%>bulle%(3)
              Origine% = 3          : ' BL
            else
              Origine% = 7          : ' L
            end_if
          end_if
        else
          if mousex%>bulle%(2)
            if mousey%<bulle%(1)
              Origine% = 1          : ' TR
            else
              if mousey%>bulle%(3)
                Origine% = 2        : ' BR
              else
                Origine% = 5        : ' R
              end_if
            end_if
          else
            if Mousey%<bulle%(1)
              Origine% = 4          : ' T
            else
              if Mousey%>bulle%(3)
                Origine% = 6        : ' B
              else
                ' ici, on a cliqué sur le bord ou à l'intérieur !
                ' donc, on ignore ce clic !
                on_mouse_down 11,MouseDown
                return
              end_if
            end_if
          end_if
        end_if
        TypeTrace% = 3
        caption 44,"Valdez la bulle maintenant..."
        return
      end_if
      on_mouse_down 11,MouseDown
      return
  end_select
  down% = 1
  on_mouse_move 11,MouseMove
end_sub


sub MouseMove()
  d% = dll_call1("CheckMouseButton",1)
  down% = down% * d%
  if down%=0
    TraceEnCours% = 0
    TypeTrace% = 2
    caption 44,"Clic droit pour positionner la pointe..."
    on_mouse_down 11,MouseDown
    return
  end_if

  caption 0,str$(mouse_x_position(11))+","+str$(mouse_y_position(11))
  mousex% = mouse_x_position(11) : ' *(larg%/wlarg%)
  mousey% = mouse_y_position(11) : ' *(haut%/whaut%)
  bulle%(2) = mousex%
  bulle%(3) = mousey%
'  caption 0,str$(mousex%)+","+str$(mousey%)
  2d_image_paste 14,0,0
  display
  2d_poly_from bulle%(0),bulle%(1)
  2d_poly_to bulle%(2),bulle%(1)
  2d_poly_to bulle%(2),bulle%(3)
  2d_poly_to bulle%(0),bulle%(3)
  2d_poly_to bulle%(0),bulle%(1)
  display
end_sub

sub valider()
  dim_local i%, px%, py%, dx%, dy%, pol$, txt$, dir%, pitch%, angle%
  dim_local wblanc%, hblanc%
  if TypeTrace%<>3 then return
  2d_image_paste 14,0,0
  typ% = item_index(42)
  hdc% = handle_canvas(11)
  CNV% = dll_call2("GetCanvas",object_internal(11),adr(hdc%))
  ' paramètres communs à tous les types de bules
      params%(2)  = bulle%(0)               : ' coin en haut à gauche
      params%(3)  = bulle%(1)
      params%(4)  = bulle%(2)               : ' coin en bas à droite
      params%(5)  = bulle%(3)
      params%(6)  = position(51)            : ' épaisseur du trait
      params%(7)  = CouleurBord%            : ' clBlack
      params%(8)  = CouleurRemplissage%     : ' clYellow
      params%(9)  = position(47)            : ' rayon de l'arrondi
      params%(10) = typ%-1                  : ' type de bulle
      params%(11) = 0                       : ' ./. non utilisé
      params%(12) = Origine%                : ' départ  
      params%(13) = mousex%                 : ' position de la pointe
      params%(14) = mousey%
      params%(15) = position(49)            : ' largeur de la flèche à la base
  if typ%>1
    if params%(6)=1 then params%(6) = 2
  end_if
  res% = dll_call3("DrawOnCanvas",CNV%,6,adr(params%))
  display
  CNV% = dll_call1("FreeCanvas",CNV%)
  2d_image_copy 14,0,0,wlarg%,whaut%
  display  
  2d_image_paste 14,0,0
  pause 100
  2d_target_is 111
  2d_image_paste 14,xpos%,ypos%
  pause 200
  2d_target_is 11
  display
  
  ' imprimer le texte dans la bulle
  if count(61)>0
    pitch% = val(text$(69))
    ' 1 = Gauche -> Droite
    ' 2 = Bas -> Haut
    ' 3 = Haut-> Bas
    ' 4 = Droite -> Gauche
    dir% = item_index(62)
    select dir%
      case 1
        px% = bulle%(0) + 10
        py% = bulle%(1) + 10
        dx% = 0
        dy% = pitch%
        angle% = 0
      case 2
        px% = bulle%(0) + 10
        py% = bulle%(3) - 10
        dx% = pitch%
        dy% = 0
        angle% = 90
      case 3
        px% = bulle%(2) - 10
        py% = bulle%(1) + 10
        dx% = 0 - pitch%
        dy% = 0
        angle% = 270
      case 4
        px% = bulle%(2) - 10
        py% = bulle%(3) - 10
        dx% = 0
        dy% = 0 - pitch%
        angle% = 180
    end_select
    pol$ = text$(64)
    
    ' paramètres valables pour toutes les lignes
    params%(5) = adr(pol$)              : ' nom de la police
    params%(6) = angle%*10              : ' angle d'inclinaison * 10
    params%(7) = CouleurText%           : ' couleur de la police
    params%(8) = 0                      : ' ./. non utilisé
    params%(9) = pitch%                 : ' taille de la police
    params%(10) = checked(65)           : ' gras
    params%(11) = checked(66)           : ' italique
    params%(12) = checked(67)           : ' sousligné
    params%(13) = checked(68)           : ' barré    
    
    for i%=1 to count(61)
      ' paramètres spécifiques à 1 ligne
      txt$ = item_read$(61,i%)
'      caption 0,str$(px%)+","+str$(py%)+"  "+txt$    
      params%(2) = px%                    : ' position de début d'impression
      params%(3) = py%
      params%(4) = adr(txt$)              : ' ligne de texte
      ' impression de la ligne
      hdc% = handle_canvas(11)
      CNV% = dll_call2("GetCanvas",object_internal(11),adr(hdc%))
      res% = dll_call3("DrawOnCanvas",CNV%,5,adr(params%))
      CNV% = dll_call1("FreeCanvas",CNV%)
      ' assurer l'affichage
      2d_image_copy 14,0,0,wlarg%,whaut%
      display  
      2d_image_paste 14,0,0
      pause 100
      2d_target_is 111
      2d_image_paste 14,xpos%,ypos%
      pause 200
      2d_target_is 11
      display
      ' préparer la position de la ligne suivangte
      px% = px% + dx%
      py% = py% + dy%
    next i%
  end_if
  
  actif% = 1
  caption 44,""
'  message "Pointe en "+str$(mousex%)+","+str$(mousey%)+"  Origine%="+str$(Origine%)
end_sub


sub scroll()
  xpos% = position(101)
  ypos% = position(102)
  off_change 101 : off_change 102
  2d_target_is 111
  2d_image_copy 14,xpos%,ypos%,xpos%+wlarg%,ypos%+whaut%
  pause 100
  2d_target_is 11
  2d_image_paste 14,0,0
  pause 100
  on_change 101,scroll : on_change 102,scroll
end_sub


sub RGB(c%)
  RR% = bin_and(c%,255)
  GG% = bin_and(c%,hex("FF00"))/256
  BB% = (bin_and(c%,hex("FF0000"))/256)/256
end_sub


sub changecouleur(n%)
  dim_local c%
  c% = position(n%)
  select n%
    case 503
      RR% = c%
    case 506
      GG% = c%
    case 509
      BB% = c%
  end_select
  caption n%+1,str$(c%)
  select nCouleur%
    case 1:     ' bourdure
      color 53,RR%,GG%,BB%
      CouleurBord% = (BB%*256+GG%)*256+RR%
    case 2:     ' remplissage
      color 56,RR%,GG%,BB%
      CouleurRemplissage% = (BB%*256+GG%)*256+RR%
    case 3:     ' texte
      color 59,RR%,GG%,BB%
      CouleurText% = (BB%*256+GG%)*256+RR%
  end_select
end_sub


sub couleur()
  inactive 0
  if number_click=54 then nCouleur% = 1   : ' couleur de la bordure
  if number_click=57 then nCouleur% = 2   : ' couleur de remplissage
  if number_click=60 then nCouleur% = 3   : ' couleur du texte
  select nCouleur%
    case 1:    ' couleur de la bordure
      caption 501,"Couleur de la bordure"
      RGB(CouleurBord%)
      position 503,RR%
      caption 504,str$(RR%)
      position 506,GG%
      caption 507,str$(GG%)
      position 509,BB%
      caption 510,str$(BB%)
    case 2:    ' couleur de remplissage
      caption 501,"Couleur de remplissage"
      RGB(CouleurRemplissage%)
      position 503,RR%
      caption 504,str$(RR%)
      position 506,GG%
      caption 507,str$(GG%)
      position 509,BB%
      caption 510,str$(BB%)
    case 3:    ' couleur du texte
      caption 501,"Couleur du texte"
      RGB(CouleurText%)
      position 503,RR%
      caption 504,str$(RR%)
      position 506,GG%
      caption 507,str$(GG%)
      position 509,BB%
      caption 510,str$(BB%)
  end_select
  show 500
end_sub
  

Un dernier mot; prochainement, il y aura un bouton "Annuler" permettant d'effacer la dernière bulle si elle ne convient pas.

Et, bien sûr, il faut la dernière version de KGF.dll: la V07.37 du 03/04/2017.


Dernière édition par Klaus le Mar 4 Avr 2017 - 1:04, édité 1 fois
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Yannick

avatar

Nombre de messages : 8002
Age : 46
Localisation : Bretagne
Date d'inscription : 15/02/2010

MessageSujet: re   Lun 3 Avr 2017 - 7:48

Belle application !
cheers
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jicehel

avatar

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

MessageSujet: Re: Annoter une image avec des bulles de texte   Lun 3 Avr 2017 - 8:47

Bel ajout de fonctionnalités
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Klaus

avatar

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

MessageSujet: Re: Annoter une image avec des bulles de texte   Lun 3 Avr 2017 - 12:20

Et voici la version avec le bouton "Annuler bulle" - c'est magique ! Quelle belle invention ces objets IMAGE !
Code:
' annoter_une_image.bas

' Cet utilitaire permet de:
'   - charger une image
'   - y placer des bulles de texte
'   - sauvegarder le résultat obtenu

dll_on "KGF.dll"

labels()
variables()
form0()
menus()

end

nouveau:
  nouveau()
  return
  
ouvrir:
  ouvrir()
  return
  
enregistrer:
  enregistrer()
  return
  
enregistrersous:
  enregistrersous()
  return
  
sortir:
  sortir()
  return
  
tracer:
  tracer()
  return
  
valider:
  valider()
  return
  
annuler:
  annuler()
  return
  
MouseDown:
  MouseDown()
  return

MouseMove:
  off_mouse_move 11
  MouseMove()
  on_mouse_move 11,MouseMove
  return
  
scroll:
  scroll()
  return
  
couleur:
  couleur()
  return
  
couleurok:
  hide 500
  to_foreground 0
  active 0
  set_focus 43
  return
  
changecouleur:
  changecouleur(number_change)
  return
  

sub labels()
  label nouveau, ouvrir, enregistrer, enregistrersous, sortir
  label tracer, MouseDown, MouseMove, valider, annuler, scroll
  label couleur, couleurok, changecouleur

end_sub


sub variables()
  dim no%, d%, res%, typ%
  dim actif%                  : ' flag "une image est présente, modifiée et non sauvegardée"
  dim fichier$                : ' nom du fichier chargé dans le picture 11
  dim larg%, haut%            : ' dimensions réelles de l'image du fichier chargé
  dim wlarg%, whaut%          : ' dimensions réelles de du picture 11
  dim mousex%, mousey%        : ' coordonnées de la souris
  dim bulle%(3)               : ' dimensions de la bulle (types 1...3)
  dim pointe%(1)              : ' coordonnées de la pointe
  dim TypeTrace%              : ' type de traçage  0=rien  1=bulle 2=pointe 3=prêt à valider
  dim TraceEnCours%           : ' flag "traçage du rectangle en cours"
  dim Origine%                : ' origine de la flèche: 0=TL 1=TR 2=BR 3=BL 4=T B=R 6=B 7=L
  dim down%                   : ' flag "bouton gauche de la souris est enfoncé"
  dim hdc%                    : ' reçoit handle_canvas(11)
  dim CNV%                    : ' identifiant du canvas pour le dessin
  dim Params%(20)             : ' paramètres pour DrawOnCanvas
  dim xpos%, ypos%            : ' positions de la fenêtre de visualisation
  dim CouleurBord%            : ' code couleur pour la bordure
  dim CouleurRemplissage%     : ' code couleur pour le remplissage
  dim CouleurText%            : ' couleur du texte à imprimer
  dim nCouleur%               : ' indice du type de couleur
  dim RR%, GG%, BB%           : ' couleurs RGB décodées
  dim Undo%                   : ' nombre d'étapes mémorisées pour "Annuler"
  dim MUndo% : MUndo% = 100   : ' nombre maxi d'etapes d'annulation
  dim UndoPos%(MUndo%,1)      : ' sauvegarde des xpos% et ypos% pour "Annuler"
end_sub


sub form0()
  dim_local res%, i%
  full_space 0
  
  ' les outils
  container 1 : height 1,height_client(0) - 30 : width 1,300 : caption 1,"Outils"

  ' les outils "Fichiers"
  container 31 : parent 31,1 : top 31,15 : left 31,15 : width 31,width_client(1)-30
    color 31,225,225,225
    caption 31,"Fichiers"
  button 32 : parent 32,31 : top 32,15 : left 32,15 : height 32,20 : width 32,70 : caption 32,"Nouveau"
    on_click 32,nouveau
  button 33 : parent 33,31 : top 33,15 : left 33,100 : height 33,20 : width 33,50 : caption 33,"Ouvrir"
    on_click 33,ouvrir  
  button 34 : parent 34,31 : top 34,15 : left 34,170 : height 34,20 : width 34,70 : caption 34,"Enregistrer"
    on_click 34,enregistrer  
  button 35 : parent 35,31 : top 35,40 : left 35,75 : height 35,20 : width 35,100 : caption 35,"Enregistrer sous"
    on_click 35,enregistrersous  
  button 36 : parent 36,31 : top 36,75 : left 36,95 : height 36,20 : width 36,60 : caption 36,"Sortir"
    on_click 36,sortir
   alpha 37 : parent 37,31 : top 37,45 : left 37,200 : caption 37,"W; "  
   alpha 38 : parent 38,31 : top 38,65 : left 38,200 : caption 38,"H; "  
    
' les outils  "Bulles"
  container 41 : parent 41,1 : top 41,15+height(31)+5 : left 41,15
    width 41,width_client(1)-30 : height 41,height_client(1)-top(41)-10
    color 41,225,225,225
    caption 41,"Bulles"
  combo 42 : parent 42,41 : top 42,15 : left 42,15 : width 42,width_client(41)-30
    item_add 42,"Bulle rectangle"
    item_add 42,"Bulle rectangle arrondi"
    item_add 42,"Bulle ellipse"
  res% = dll_call2("SelectComboBoxItem",handle(42),1)
  button 43 : parent 43,41 : top 43,top(42)+height(42)+5: left 43,15 : height 43,20
    caption 43,"Tracer bulle" : on_click 43,tracer
  alpha 44 : parent 44,41 : top 44,top(43)+30 : left 44,15 : font_bold 44
  button 45 : parent 45,41 : top 45,top(43) : left 45,95 : height 45,20
    caption 45,"Valider bulle" : on_click 45,valider
  button 451 : parent 451,41 : top 451,top(43) : left 451,175 : height 451,20
    caption 451,"Annuler bulle" : on_click 451,annuler : inactive 451      
  alpha 46 : parent 46,41 : top 46,top(44)+30 : left 46,15
    caption 46,"Rayon de courbure d'arrondi:"
  spin 47 : parent 47,41 : top 47,top(46) : left 47,160 : width 47,60
    min 47,0 : max 47,50 : position 47,10
  alpha 48 : parent 48,41 : top 48,top(46)+30 : left 48,15
    caption 48,"Diamètre de la base de flèche:"
  spin 49 : parent 49,41 : top 49,top(48) : left 49,160 : width 49,60
    min 49,5 : max 49,200 : position 49,20  
  alpha 50 : parent 50,41 : top 50,top(48)+30 : left 50,15
    caption 50,"Epaisseur de la bordure:"
  spin 51 : parent 51,41 : top 51,top(50) : left 51,160 : width 51,60
    min 51,1 : max 51,20 : position 51,1

  alpha 52 : parent 52,41 : top 52,top(50)+30 : left 52,15
    caption 52,"Couleur de la bordure:"
  picture 53 : parent 53,41 : top 53,top(52) : left 53,160 : width 53,30 : height 53,20
    color 53,0,0,0
  button 54 : parent 54,41 : top 54,top(52) : left 54,left(53)+35 : width 54,30 : height 54,20
    caption 54,"..." : font_bold 54 : on_click 54,couleur
    
  alpha 55 : parent 55,41 : top 55,top(52)+30 : left 55,15
    caption 55,"Couleur de remplissage:"
  picture 56 : parent 56,41 : top 56,top(55) : left 56,160 : width 56,30 : height 56,20
    color 56,255,255,0
  button 57 : parent 57,41 : top 57,top(55) : left 57,left(56)+35 : width 57,30 : height 57,20
    caption 57,"..." : font_bold 57 : on_click 57,couleur

  alpha 58 : parent 58,41 : top 58,top(55)+30 : left 58,15
    caption 58,"Couleur du texte:"
  picture 59 : parent 59,41 : top 59,top(58) : left 59,160 : width 59,30 : height 59,20
    color 59,0,0,0
  button 60 : parent 60,41 : top 60,top(58) : left 60,left(59)+35 : width 60,30 : height 60,20
    caption 60,"..." : font_bold 60 : on_click 60,couleur

  memo 61 : parent 61,41 : top 61,top(58)+30 : left 61,15 : width 61,width_client(41)-30
    height 61,150 : bar_both 61 : font_size 61,10
  combo 62 : parent 62,41 : top 62,top(61)+height(61)+10 : left 62,15
    width 62,120
    item_add 62,"Gauche -> Droite"
    item_add 62,"Bas -> Haut"
    item_add 62,"Haut-> Bas"
    item_add 62,"Droite -> Gauche"
  res% = dll_call2("SelectComboBoxItem",handle(62),1)
'  check 63 : parent 63,41 : top 63,top(62) : left 63,160 : caption 63,"Centré"  
  combo 64 : parent 64,41 : top 64,top(62)+30 : left 64,15
    width 64,width_client(41)-30 : font_names_load 64
  for i%=1 to count(64)
    if item_read$(64,i%)="Arial"
      res% = dll_call2("SelectComboBoxItem",handle(64),i%)      
      exit_for
    end_if
  next i%
  check 65 : parent 65,41 : top 65,top(64)+30 : left 65,15 : caption 65,"G" : font_bold 65  
  check 66 : parent 66,41 : top 66,top(65) : left 66,60 : caption 66,"I" : font_italic 66  
  check 67 : parent 67,41 : top 67,top(65) : left 67,105 : caption 67,"S" : font_underline 67  
  check 68 : parent 68,41 : top 68,top(65) : left 68,150 : caption 68,"B" : font_strike 68  
  combo 69 : parent 69,41 : top 69,top(65) : left 69,200 : width 69,width_client(41)-215
    item_add 69,"8"
    item_add 69,"10"
    item_add 69,"12"
    item_add 69,"14"
    item_add 69,"16"
    item_add 69,"18"
    item_add 69,"20"
    item_add 69,"22"
    item_add 69,"24"
    item_add 69,"38"
    item_add 69,"32"
    item_add 69,"36"
    item_add 69,"48"
    res% = dll_call2("SelectComboBoxItem",handle(69),3)      
    
' l'image
  container 2 : left 2,300 : height 2,height_client(0) - 30 : width 2,width_client(0)-300
    caption 2,"Image"
  wlarg% = width_client(2)-30
  whaut% = height_client(2)-35
  picture 11 : parent 11,2
    top 11,15 : left 11,10 : width 11,wlarg% : height 11,whaut%
    color 11,225,225,0 : parent 11,2
  2d_target_is 11
  scroll_bar 101 : parent 101,2
    height 101,20 : width 101,width_client(2)-20 : top 101,height(2)-20
    min 101,0 : max 101,width_client(2)-20 : inactive 101 : on_change 101,scroll
  scroll_bar 102 : parent 102,2 : vertical 102
    width 102,20 : height 102,height_client(2)-20 : left 102,width(2)-20
    min 102,0 : max 102,height_client(2)-20 : inactive 102 : on_change 101,scroll
  form 110 : full_space 110 : hide 110
  picture 111 : parent 111,110 : width 111,wlarg% : height 111,whaut%
                            
  ' la fenêtre "sablier"
  form 20 : hide 20 : border_hide 20 : width 20,400 : height 20,100
    top 20,(screen_y-height(20))/2 : left 20,(screen_x-width(20))/2
  panel 21 : parent 21,20 : full_space 21 : color 21,255,192,192
    font_size 21,24
    caption 21,"Opération en cours..."
    
  ' la fenêtre de sélection de couleur
  form 500 : hide 500 : caption 500,"Sélection de couleur" : width 500,500
    top 500,(screen_y-height(500))/2 : left 500,(screen_x-width(500))/2
    on_close 500,couleurok
  alpha 501 : parent 501,500 : top 501,10 : left 501,10 : font_bold 501
  
  alpha 502 : parent 502,500 : top 502,40 : left 502,10 : font_bold 501
    font_bold 502 : caption 502,"R"
  scroll_bar 503 : parent 503,500 : top 503,40 : left 503,30
    width 503,width_client(500)-100 : min 503,0 : max 503,255
    on_change 503,changecouleur
  alpha 504 : parent 504,500 : top 504,40 : left 504,left(503)+width(503)+20
    
  alpha 505 : parent 505,500 : top 505,70 : left 505,10 : font_bold 505
    font_bold 505 : caption 505,"G"
  scroll_bar 506 : parent 506,500 : top 506,70 : left 506,30
    width 506,width_client(500)-100 : min 506,0 : max 506,255
    on_change 506,changecouleur
  alpha 507 : parent 507,500 : top 507,70 : left 507,left(506)+width(506)+20
    
  alpha 508 : parent 508,500 : top 508,100 : left 508,10 : font_bold 508
    font_bold 508 : caption 508,"B"
  scroll_bar 509 : parent 509,500 : top 509,100 : left 509,30
    width 509,width_client(500)-100 : min 509,0 : max 509,255
    on_change 509,changecouleur
  alpha 510 : parent 510,500 : top 510,100 : left 510,left(509)+width(509)+20


  ' objets invisibles
  open_dialog 12
  save_dialog 13
  image 14              : ' pour mémoriser l'image avant toute opération
                            
  actif% = 0
  larg% = width(11)
  haut% = height(11)
  CouleurBord%         = 0                     : ' noir
  CouleurRemplissage%  = (0*256+255)*256+255   : ' jaune
  CouleurText%         = 0                     : ' noir
  Undo%                = 0                     : ' aucune situation pour "Annuler"
  2d_target_is 11
  2d_image_copy 14,0,0,wlarg%,whaut%
  caption 0,"Annotation"
end_sub


sub menus()
  dim_local no1%, no2%
  no% = 1000 : main_menu no%
  no% = no% + 1 : sub_menu no% : parent no%,1000 : no1% = no% : caption no%,"Fichiers"
    no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"Nouveau"
      on_click no%,nouveau
    no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"Ouvrir..."
      on_click no%,ouvrir
    no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"Enregistrer"
      on_click no%,enregistrer
    no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"Enregistrer sous..."
      on_click no%,enregistrersous
    no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"-"
    no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"Sortir"
      on_click no%,sortir
  no% = no% + 1 : sub_menu no% : parent no%,1000 : no1% = no% : caption no%,"Bulles"
end_sub


sub nouveau()
  if actif%=1
    if message_confirmation_yes_no("L'image actuelle n'est pas enregistrée. Sortir quand-même ?")<>1 then exit_sub
  end_if
  if CNV%<>0
    CNV% = dll_call1("FreeCanvas",CNV%)
  end_if
  actif% = 0
  fichier$ = ""
  2d_clear
  stretch_off 11
  full_space 11
  TypeTrace% = 0
'  width 11,width(2)-20 : height 11,height(2)-20
  larg% = wlarg%
  haut% = whaut%
  clipboard_copy 11
  clipboard_paste 111
  width 111,larg% : height 111,haut%
  caption 37,"W: "+str$(larg%)
  caption 38,"H: "+str$(haut%)
  inactive 101 : inactive 102
  hdc% = handle_canvas(11)
  CNV% = dll_call2("GetCanvas",object_internal(11),adr(hdc%))
  xpos% = 0 : ypos% = 0
  CouleurBord%         = 0                     : ' noir
  CouleurRemplissage%  = (0*256+255)*256+255   : ' jaune
  CouleurText%         = 0                     : ' noir
  color 53,0,0,0
  color 56,255,255,0
  color 59,0,0,0
  2d_target_is 11
  2d_image_copy 14,0,0,wlarg%,whaut%
  if Undo%>0
    dim_local i%
    for i%=1 to i%
      if object_exists(3000+i%)=1 then delete 3000+i%
    next i%
    Undo% = 0
  end_if
  inactive 451
  caption 0,"Annotation"
end_sub


sub ouvrir()
  dim_local res%, f$, w%, h%
  filter 12,"Images JPG|*.jpg"
  f$ = file_name$(12)
  if f$="_" then exit_sub
  if file_exists(f$)=0
    message "Fichier non trouvé"
    exit_sub
  end_if
  if CNV%<>0
    CNV% = dll_call1("FreeCanvas",CNV%)
  end_if
  inactive 0 : show 20 : display
  res% = dll_call3("AnalyzeImageFile",adr(f$),adr(larg%),adr(haut%))
  off_change 101 : position 101,0 : on_change 101,scroll
  if larg%>wlarg%
    min 101,0 : max 101,larg%-wlarg%
  else
    inactive 101
  end_if
  off_change 102 : position 102,0 : on_change 102,scroll
  if haut%>whaut%
    min 102,0 : max 102,haut%-whaut%
    position 102,0
  else
    inactive 102
  end_if
  caption 37,"W: "+str$(larg%)
  caption 38,"H: "+str$(haut%)
  width 110,larg%+30 : height 110,haut%+100
  width 111,larg% : height 111,haut%
                                    
  fichier$ = f$
  res% = dll_call1("LoadAnyImageFile",adr(fichier$))
  clipboard_paste 111
  2d_target_is 111
  
  2d_image_copy 14,0,0,wlarg%,whaut%
  2d_target_is 11
  2d_image_paste 14,0,0
'  show 110
  
  caption 0,"Annotation de "+fichier$
  TypeTrace% = 0
  xpos% = 0 : ypos% = 0
  CouleurBord%         = 0                     : ' noir
  CouleurRemplissage%  = (0*256+255)*256+255   : ' jaune
  CouleurText%         = 0                     : ' noir
  color 53,0,0,0
  color 56,255,255,0
  color 59,0,0,0
  2d_target_is 11
  2d_image_copy 14,0,0,wlarg%,whaut%
  if Undo%>0
    dim_local i%
    for i%=1 to i%
      if object_exists(3000+i%)=1 then delete 3000+i%
    next i%
    Undo% = 0
  end_if
  inactive 451
  hide 20: active 0
end_sub


sub enregistrer()
  dim_local res%
  if fichier$=""
    message "Pas d'image ouverte"
    exit_sub
  end_if
  inactive 0 : show 20 : display
'  clipboard_copy 11
  clipboard_copy 111
  pause 100
  res% = dll_call1("SaveAnyImageFile",adr(fichier$))
  actif% = 0
  caption 0,"Annotation de "+fichier$
  hide 20 : active 0
end_sub


sub enregistrersous()
  dim_local f$, res%
  f$ = file_name$(13)
  if f$="_" then exit_sub
  if file_exists(f$)=1
    if message_confirmation_yes_no("Ce fichier existe déjà. Remplacer ?")<>1 then exit_sub
  end_if
  inactive 0 : show 20 : display
  clipboard_copy 111
  pause 300
  res% = dll_call1("SaveAnyImageFile",adr(f$))
  fichier$ = f$
  actif% = 0
  caption 0,"Annotation de "+fichier$
  hide 20 : active 0
end_sub


sub sortir()
  if actif%=1
    if message_confirmation_yes_no("L'image actuelle n'est pas enregistrée. Sortir quand-même ?")<>1 then exit_sub
  end_if
  terminate
end_sub


sub tracer()
  TypeTrace% = 1                        : ' on trace la bulle
  TraceEnCours% = 0
  on_mouse_down 11,MouseDown
  caption 44,"Tracer le rectangle délimiteur..."
end_sub


sub MouseDown()
  off_mouse_down 11
  mousex% = mouse_x_left_down(11) : ' *(larg%/wlarg%)
  mousey% = mouse_y_left_down(11) : ' *(haut%/whaut%)
  select TypeTrace%
    case 1:    ' bulle
      bulle%(0) = mousex%
      bulle%(1) = mousey%
      bulle%(2) = mousex%
      bulle%(3) = mousey%
      TraceEnCours% = 1
    case 2:    ' pointe
      down% = dll_call1("CheckMouseButton",2)
      if down%=1                : ' est-ce que le bouton droit est enfoncé ?
        mousex% = mouse_x_position(11) : ' *(larg%/wlarg%)
        mousey% = mouse_y_position(11) : ' *(haut%/whaut%)
        Origine% = 0
        if mousex%<bulle%(0)
          if mousey%<bulle%(1)
            Origine% = 0            : ' TL
          else
            if mousey%>bulle%(3)
              Origine% = 3          : ' BL
            else
              Origine% = 7          : ' L
            end_if
          end_if
        else
          if mousex%>bulle%(2)
            if mousey%<bulle%(1)
              Origine% = 1          : ' TR
            else
              if mousey%>bulle%(3)
                Origine% = 2        : ' BR
              else
                Origine% = 5        : ' R
              end_if
            end_if
          else
            if Mousey%<bulle%(1)
              Origine% = 4          : ' T
            else
              if Mousey%>bulle%(3)
                Origine% = 6        : ' B
              else
                ' ici, on a cliqué sur le bord ou à l'intérieur !
                ' donc, on ignore ce clic !
                on_mouse_down 11,MouseDown
                return
              end_if
            end_if
          end_if
        end_if
        2d_circle Mousex%,Mousey%,5
        set_focus 45
        TypeTrace% = 3
        caption 44,"Valdez la bulle maintenant..."
        return
      end_if
      on_mouse_down 11,MouseDown
      return
  end_select
  down% = 1
  on_mouse_move 11,MouseMove
end_sub


sub MouseMove()
  d% = dll_call1("CheckMouseButton",1)
  down% = down% * d%
  if down%=0
    TraceEnCours% = 0
    TypeTrace% = 2
    caption 44,"Clic droit pour positionner la pointe..."
    on_mouse_down 11,MouseDown
    return
  end_if

  caption 0,str$(mouse_x_position(11))+","+str$(mouse_y_position(11))
  mousex% = mouse_x_position(11) : ' *(larg%/wlarg%)
  mousey% = mouse_y_position(11) : ' *(haut%/whaut%)
  bulle%(2) = mousex%
  bulle%(3) = mousey%
'  caption 0,str$(mousex%)+","+str$(mousey%)
  2d_image_paste 14,0,0
  display
  2d_poly_from bulle%(0),bulle%(1)
  2d_poly_to bulle%(2),bulle%(1)
  2d_poly_to bulle%(2),bulle%(3)
  2d_poly_to bulle%(0),bulle%(3)
  2d_poly_to bulle%(0),bulle%(1)
  display
end_sub

sub valider()
  dim_local i%, px%, py%, dx%, dy%, pol$, txt$, dir%, pitch%, angle%
  dim_local wblanc%, hblanc%
  if TypeTrace%<>3 then return
  2d_image_paste 14,0,0
  ' mémoriser la situation pour "Annuler"
  if Undo%=MUndo%
    
  end_if
  Undo% = Undo% + 1                    : ' compter la nouvelle mémorisation
  image 3000+Undo%                     : ' créer un image pour memoriser le contenu de l'objet 11
  2d_image_copy 3000+Undo%,0,0,wlarg%,whaut%   : ' mémoriser la partie visible de 11
  UndoPos%(Undo%,0) = xpos%            : ' et mémoriser la position dans l'image globale
  UndoPos%(Undo%,1) = ypos%
  active 451
  
  ' tracer la bulle
  typ% = item_index(42)
  hdc% = handle_canvas(11)
  CNV% = dll_call2("GetCanvas",object_internal(11),adr(hdc%))
  ' paramètres communs à tous les types de bules
      params%(2)  = bulle%(0)               : ' coin en haut à gauche
      params%(3)  = bulle%(1)
      params%(4)  = bulle%(2)               : ' coin en bas à droite
      params%(5)  = bulle%(3)
      params%(6)  = position(51)            : ' épaisseur du trait
      params%(7)  = CouleurBord%            : ' clBlack
      params%(8)  = CouleurRemplissage%     : ' clYellow
      params%(9)  = position(47)            : ' rayon de l'arrondi
      params%(10) = typ%-1                  : ' type de bulle
      params%(11) = 0                       : ' ./. non utilisé
      params%(12) = Origine%                : ' départ  
      params%(13) = mousex%                 : ' position de la pointe
      params%(14) = mousey%
      params%(15) = position(49)            : ' largeur de la flèche à la base
  if typ%>1
    if params%(6)=1 then params%(6) = 2
  end_if
  res% = dll_call3("DrawOnCanvas",CNV%,6,adr(params%))
  display
  CNV% = dll_call1("FreeCanvas",CNV%)
  2d_image_copy 14,0,0,wlarg%,whaut%
  display  
  2d_image_paste 14,0,0
  pause 100
  2d_target_is 111
  2d_image_paste 14,xpos%,ypos%
  pause 200
  2d_target_is 11
  display
  
  ' imprimer le texte dans la bulle
  if count(61)>0
    pitch% = val(text$(69))
    ' 1 = Gauche -> Droite
    ' 2 = Bas -> Haut
    ' 3 = Haut-> Bas
    ' 4 = Droite -> Gauche
    dir% = item_index(62)
    select dir%
      case 1
        px% = bulle%(0) + 10
        py% = bulle%(1) + 10
        dx% = 0
        dy% = pitch%
        angle% = 0
      case 2
        px% = bulle%(0) + 10
        py% = bulle%(3) - 10
        dx% = pitch%
        dy% = 0
        angle% = 90
      case 3
        px% = bulle%(2) - 10
        py% = bulle%(1) + 10
        dx% = 0 - pitch%
        dy% = 0
        angle% = 270
      case 4
        px% = bulle%(2) - 10
        py% = bulle%(3) - 10
        dx% = 0
        dy% = 0 - pitch%
        angle% = 180
    end_select
    pol$ = text$(64)
    
    ' paramètres valables pour toutes les lignes
    params%(5) = adr(pol$)              : ' nom de la police
    params%(6) = angle%*10              : ' angle d'inclinaison * 10
    params%(7) = CouleurText%           : ' couleur de la police
    params%(8) = 0                      : ' ./. non utilisé
    params%(9) = pitch%                 : ' taille de la police
    params%(10) = checked(65)           : ' gras
    params%(11) = checked(66)           : ' italique
    params%(12) = checked(67)           : ' sousligné
    params%(13) = checked(68)           : ' barré    
    
    for i%=1 to count(61)
      ' paramètres spécifiques à 1 ligne
      txt$ = item_read$(61,i%)
'      caption 0,str$(px%)+","+str$(py%)+"  "+txt$    
      params%(2) = px%                    : ' position de début d'impression
      params%(3) = py%
      params%(4) = adr(txt$)              : ' ligne de texte
      ' impression de la ligne
      hdc% = handle_canvas(11)
      CNV% = dll_call2("GetCanvas",object_internal(11),adr(hdc%))
      res% = dll_call3("DrawOnCanvas",CNV%,5,adr(params%))
      CNV% = dll_call1("FreeCanvas",CNV%)
      ' assurer l'affichage
      2d_image_copy 14,0,0,wlarg%,whaut%
      display  
      2d_image_paste 14,0,0
      pause 100
      2d_target_is 111
      2d_image_paste 14,xpos%,ypos%
      pause 200
      2d_target_is 11
      display
      ' préparer la position de la ligne suivangte
      px% = px% + dx%
      py% = py% + dy%
    next i%
  end_if
  
  actif% = 1
  caption 44,""
'  message "Pointe en "+str$(mousex%)+","+str$(mousey%)+"  Origine%="+str$(Origine%)
end_sub


sub annuler()
  if Undo%=0          : ' ceci ne devrait jamais arriver...
    inactive 451
    exit_sub
  end_if
  2d_target_is 111
  2d_image_paste 3000+Undo%,UndoPos%(Undo%,0),UndoPos%(Undo%,1)
  display
  2d_image_copy 14,xpos%,ypos%,xpos%+wlarg%,ypos%+whaut%
  display
  2d_target_is 11
  2d_image_paste 14,0,0
  display
  delete 3000+Undo%                  : ' supprimer l'image mémorisée
  Undo% = Undo% - 1                  : ' "oublier" cette étape
  if Undo%=0 then inactive 451       : ' plus rien en mémoire ? désactiver le outon
end_sub


sub scroll()
  xpos% = position(101)
  ypos% = position(102)
  off_change 101 : off_change 102
  2d_target_is 111
  2d_image_copy 14,xpos%,ypos%,xpos%+wlarg%,ypos%+whaut%
  pause 100
  2d_target_is 11
  2d_image_paste 14,0,0
  pause 100
  on_change 101,scroll : on_change 102,scroll
end_sub


sub RGB(c%)
  RR% = bin_and(c%,255)
  GG% = bin_and(c%,hex("FF00"))/256
  BB% = (bin_and(c%,hex("FF0000"))/256)/256
end_sub


sub changecouleur(n%)
  dim_local c%
  c% = position(n%)
  select n%
    case 503
      RR% = c%
    case 506
      GG% = c%
    case 509
      BB% = c%
  end_select
  caption n%+1,str$(c%)
  select nCouleur%
    case 1:     ' bourdure
      color 53,RR%,GG%,BB%
      CouleurBord% = (BB%*256+GG%)*256+RR%
    case 2:     ' remplissage
      color 56,RR%,GG%,BB%
      CouleurRemplissage% = (BB%*256+GG%)*256+RR%
    case 3:     ' texte
      color 59,RR%,GG%,BB%
      CouleurText% = (BB%*256+GG%)*256+RR%
  end_select
end_sub


sub couleur()
  inactive 0
  if number_click=54 then nCouleur% = 1   : ' couleur de la bordure
  if number_click=57 then nCouleur% = 2   : ' couleur de remplissage
  if number_click=60 then nCouleur% = 3   : ' couleur du texte
  select nCouleur%
    case 1:    ' couleur de la bordure
      caption 501,"Couleur de la bordure"
      RGB(CouleurBord%)
      position 503,RR%
      caption 504,str$(RR%)
      position 506,GG%
      caption 507,str$(GG%)
      position 509,BB%
      caption 510,str$(BB%)
    case 2:    ' couleur de remplissage
      caption 501,"Couleur de remplissage"
      RGB(CouleurRemplissage%)
      position 503,RR%
      caption 504,str$(RR%)
      position 506,GG%
      caption 507,str$(GG%)
      position 509,BB%
      caption 510,str$(BB%)
    case 3:    ' couleur du texte
      caption 501,"Couleur du texte"
      RGB(CouleurText%)
      position 503,RR%
      caption 504,str$(RR%)
      position 506,GG%
      caption 507,str$(GG%)
      position 509,BB%
      caption 510,str$(BB%)
  end_select
  show 500
end_sub
  
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Klaus

avatar

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

MessageSujet: Re: Annoter une image avec des bulles de texte   Lun 3 Avr 2017 - 21:38

Nouvelle version, et je pense "version définitive":
Ajout du cadrage du texte:
- à gauche (par défaut)
- centré
- cadré à droite
toujours dans le rectangle englobant la bulle. Et toujours la grande nouveauté de la version précédente: le bouton "Annuler bulle" permet de revenir en arrière, bulle par bulle ! Quelque soit la taille de l'image d'origine. La limite est de 100 étapes mémorisées.
Code:
' annoter_une_image.bas

' Cet utilitaire permet de:
'  - charger une image
'  - y placer des bulles de texte
'  - sauvegarder le résultat obtenu

dll_on "KGF.dll"

labels()
variables()
form0()
menus()

end

nouveau:
  nouveau()
  return
 
ouvrir:
  ouvrir()
  return
 
enregistrer:
  enregistrer()
  return
 
enregistrersous:
  enregistrersous()
  return
 
sortir:
  sortir()
  return
 
tracer:
  tracer()
  return
 
valider:
  valider()
  return
 
annuler:
  annuler()
  return
 
MouseDown:
  MouseDown()
  return

MouseMove:
  off_mouse_move 11
  MouseMove()
  on_mouse_move 11,MouseMove
  return
 
scroll:
  scroll()
  return
 
couleur:
  couleur()
  return
 
couleurok:
  hide 500
  to_foreground 0
  active 0
  set_focus 43
  return
 
changecouleur:
  changecouleur(number_change)
  return
 

sub labels()
  label nouveau, ouvrir, enregistrer, enregistrersous, sortir
  label tracer, MouseDown, MouseMove, valider, annuler, scroll
  label couleur, couleurok, changecouleur

end_sub


sub variables()
  dim no%, d%, res%, typ%
  dim actif%                  : ' flag "une image est présente, modifiée et non sauvegardée"
  dim fichier$                : ' nom du fichier chargé dans le picture 11
  dim larg%, haut%            : ' dimensions réelles de l'image du fichier chargé
  dim wlarg%, whaut%          : ' dimensions réelles de du picture 11
  dim mousex%, mousey%        : ' coordonnées de la souris
  dim bulle%(3)              : ' dimensions de la bulle (types 1...3)
  dim pointe%(1)              : ' coordonnées de la pointe
  dim TypeTrace%              : ' type de traçage  0=rien  1=bulle 2=pointe 3=prêt à valider
  dim TraceEnCours%          : ' flag "traçage du rectangle en cours"
  dim Origine%                : ' origine de la flèche: 0=TL 1=TR 2=BR 3=BL 4=T B=R 6=B 7=L
  dim down%                  : ' flag "bouton gauche de la souris est enfoncé"
  dim hdc%                    : ' reçoit handle_canvas(11)
  dim CNV%                    : ' identifiant du canvas pour le dessin
  dim Params%(20)            : ' paramètres pour DrawOnCanvas
  dim xpos%, ypos%            : ' positions de la fenêtre de visualisation
  dim CouleurBord%            : ' code couleur pour la bordure
  dim CouleurRemplissage%    : ' code couleur pour le remplissage
  dim CouleurText%            : ' couleur du texte à imprimer
  dim nCouleur%              : ' indice du type de couleur
  dim RR%, GG%, BB%          : ' couleurs RGB décodées
  dim Undo%                  : ' nombre d'étapes mémorisées pour "Annuler"
  dim MUndo% : MUndo% = 100  : ' nombre maxi d'etapes d'annulation
  dim UndoPos%(MUndo%,1)      : ' sauvegarde des xpos% et ypos% pour "Annuler"
  dim txt$                    : ' une ligne de texte à imprimer dans la bulle
  dim pitch%                  : ' taille de la police d'impression
end_sub


sub form0()
  dim_local res%, i%
  full_space 0
 
  ' les outils
  container 1 : height 1,height_client(0) - 30 : width 1,300 : caption 1,"Outils"

  ' les outils "Fichiers"
  container 31 : parent 31,1 : top 31,15 : left 31,15 : width 31,width_client(1)-30
    color 31,225,225,225
    caption 31,"Fichiers"
  button 32 : parent 32,31 : top 32,15 : left 32,15 : height 32,20 : width 32,70 : caption 32,"Nouveau"
    on_click 32,nouveau
  button 33 : parent 33,31 : top 33,15 : left 33,100 : height 33,20 : width 33,50 : caption 33,"Ouvrir"
    on_click 33,ouvrir 
  button 34 : parent 34,31 : top 34,15 : left 34,170 : height 34,20 : width 34,70 : caption 34,"Enregistrer"
    on_click 34,enregistrer 
  button 35 : parent 35,31 : top 35,40 : left 35,75 : height 35,20 : width 35,100 : caption 35,"Enregistrer sous"
    on_click 35,enregistrersous 
  button 36 : parent 36,31 : top 36,75 : left 36,95 : height 36,20 : width 36,60 : caption 36,"Sortir"
    on_click 36,sortir
  alpha 37 : parent 37,31 : top 37,45 : left 37,200 : caption 37,"W; " 
  alpha 38 : parent 38,31 : top 38,65 : left 38,200 : caption 38,"H; " 
   
' les outils  "Bulles"
  container 41 : parent 41,1 : top 41,15+height(31)+5 : left 41,15
    width 41,width_client(1)-30 : height 41,height_client(1)-top(41)-10
    color 41,225,225,225
    caption 41,"Bulles"
  combo 42 : parent 42,41 : top 42,15 : left 42,15 : width 42,width_client(41)-30
    item_add 42,"Bulle rectangle"
    item_add 42,"Bulle rectangle arrondi"
    item_add 42,"Bulle ellipse"
  res% = dll_call2("SelectComboBoxItem",handle(42),1)
  button 43 : parent 43,41 : top 43,top(42)+height(42)+5: left 43,15 : height 43,20
    caption 43,"Tracer bulle" : on_click 43,tracer
  alpha 44 : parent 44,41 : top 44,top(43)+30 : left 44,15 : font_bold 44
  button 45 : parent 45,41 : top 45,top(43) : left 45,95 : height 45,20
    caption 45,"Valider bulle" : on_click 45,valider
  button 451 : parent 451,41 : top 451,top(43) : left 451,175 : height 451,20
    caption 451,"Annuler bulle" : on_click 451,annuler : inactive 451     
  alpha 46 : parent 46,41 : top 46,top(44)+30 : left 46,15
    caption 46,"Rayon de courbure d'arrondi:"
  spin 47 : parent 47,41 : top 47,top(46) : left 47,160 : width 47,60
    min 47,0 : max 47,50 : position 47,10
  alpha 48 : parent 48,41 : top 48,top(46)+30 : left 48,15
    caption 48,"Diamètre de la base de flèche:"
  spin 49 : parent 49,41 : top 49,top(48) : left 49,160 : width 49,60
    min 49,5 : max 49,200 : position 49,20 
  alpha 50 : parent 50,41 : top 50,top(48)+30 : left 50,15
    caption 50,"Epaisseur de la bordure:"
  spin 51 : parent 51,41 : top 51,top(50) : left 51,160 : width 51,60
    min 51,1 : max 51,20 : position 51,1

  alpha 52 : parent 52,41 : top 52,top(50)+30 : left 52,15
    caption 52,"Couleur de la bordure:"
  picture 53 : parent 53,41 : top 53,top(52) : left 53,160 : width 53,30 : height 53,20
    color 53,0,0,0
  button 54 : parent 54,41 : top 54,top(52) : left 54,left(53)+35 : width 54,30 : height 54,20
    caption 54,"..." : font_bold 54 : on_click 54,couleur
   
  alpha 55 : parent 55,41 : top 55,top(52)+30 : left 55,15
    caption 55,"Couleur de remplissage:"
  picture 56 : parent 56,41 : top 56,top(55) : left 56,160 : width 56,30 : height 56,20
    color 56,255,255,0
  button 57 : parent 57,41 : top 57,top(55) : left 57,left(56)+35 : width 57,30 : height 57,20
    caption 57,"..." : font_bold 57 : on_click 57,couleur

  alpha 58 : parent 58,41 : top 58,top(55)+30 : left 58,15
    caption 58,"Couleur du texte:"
  picture 59 : parent 59,41 : top 59,top(58) : left 59,160 : width 59,30 : height 59,20
    color 59,0,0,0
  button 60 : parent 60,41 : top 60,top(58) : left 60,left(59)+35 : width 60,30 : height 60,20
    caption 60,"..." : font_bold 60 : on_click 60,couleur

  memo 61 : parent 61,41 : top 61,top(58)+30 : left 61,15 : width 61,width_client(41)-30
    height 61,150 : bar_both 61 : font_size 61,10
  combo 62 : parent 62,41 : top 62,top(61)+height(61)+10 : left 62,15
    width 62,120
    item_add 62,"Gauche -> Droite"
    item_add 62,"Bas -> Haut"
    item_add 62,"Haut-> Bas"
    item_add 62,"Droite -> Gauche"
  res% = dll_call2("SelectComboBoxItem",handle(62),1)
  option 63 : parent 63,41 : top 63,top(62) : left 63,140 : caption 63,"Centré" 
  option 631 : parent 631,41 : top 631,top(62) : left 631,200 : caption 631,"à Droite" 
  combo 64 : parent 64,41 : top 64,top(62)+30 : left 64,15
    width 64,width_client(41)-30 : font_names_load 64
  for i%=1 to count(64)
    if item_read$(64,i%)="Arial"
      res% = dll_call2("SelectComboBoxItem",handle(64),i%)     
      exit_for
    end_if
  next i%
  check 65 : parent 65,41 : top 65,top(64)+30 : left 65,15 : caption 65,"G" : font_bold 65 
  check 66 : parent 66,41 : top 66,top(65) : left 66,60 : caption 66,"I" : font_italic 66 
  check 67 : parent 67,41 : top 67,top(65) : left 67,105 : caption 67,"S" : font_underline 67 
  check 68 : parent 68,41 : top 68,top(65) : left 68,150 : caption 68,"B" : font_strike 68 
  combo 69 : parent 69,41 : top 69,top(65) : left 69,200 : width 69,width_client(41)-215
    item_add 69,"8"
    item_add 69,"10"
    item_add 69,"12"
    item_add 69,"14"
    item_add 69,"16"
    item_add 69,"18"
    item_add 69,"20"
    item_add 69,"22"
    item_add 69,"24"
    item_add 69,"38"
    item_add 69,"32"
    item_add 69,"36"
    item_add 69,"48"
    res% = dll_call2("SelectComboBoxItem",handle(69),3)     
   
' l'image
  container 2 : left 2,300 : height 2,height_client(0) - 30 : width 2,width_client(0)-300
    caption 2,"Image"
  wlarg% = width_client(2)-30
  whaut% = height_client(2)-35
  picture 11 : parent 11,2
    top 11,15 : left 11,10 : width 11,wlarg% : height 11,whaut%
    color 11,225,225,0 : parent 11,2
  2d_target_is 11
  scroll_bar 101 : parent 101,2
    height 101,20 : width 101,width_client(2)-20 : top 101,height(2)-20
    min 101,0 : max 101,width_client(2)-20 : inactive 101 : on_change 101,scroll
  scroll_bar 102 : parent 102,2 : vertical 102
    width 102,20 : height 102,height_client(2)-20 : left 102,width(2)-20
    min 102,0 : max 102,height_client(2)-20 : inactive 102 : on_change 101,scroll
  form 110 : full_space 110 : hide 110
  picture 111 : parent 111,110 : width 111,wlarg% : height 111,whaut%
                           
  ' la fenêtre "sablier"
  form 20 : hide 20 : border_hide 20 : width 20,400 : height 20,100
    top 20,(screen_y-height(20))/2 : left 20,(screen_x-width(20))/2
  panel 21 : parent 21,20 : full_space 21 : color 21,255,192,192
    font_size 21,24
    caption 21,"Opération en cours..."
   
  ' la fenêtre de sélection de couleur
  form 500 : hide 500 : caption 500,"Sélection de couleur" : width 500,500
    top 500,(screen_y-height(500))/2 : left 500,(screen_x-width(500))/2
    on_close 500,couleurok
  alpha 501 : parent 501,500 : top 501,10 : left 501,10 : font_bold 501
 
  alpha 502 : parent 502,500 : top 502,40 : left 502,10 : font_bold 501
    font_bold 502 : caption 502,"R"
  scroll_bar 503 : parent 503,500 : top 503,40 : left 503,30
    width 503,width_client(500)-100 : min 503,0 : max 503,255
    on_change 503,changecouleur
  alpha 504 : parent 504,500 : top 504,40 : left 504,left(503)+width(503)+20
   
  alpha 505 : parent 505,500 : top 505,70 : left 505,10 : font_bold 505
    font_bold 505 : caption 505,"G"
  scroll_bar 506 : parent 506,500 : top 506,70 : left 506,30
    width 506,width_client(500)-100 : min 506,0 : max 506,255
    on_change 506,changecouleur
  alpha 507 : parent 507,500 : top 507,70 : left 507,left(506)+width(506)+20
   
  alpha 508 : parent 508,500 : top 508,100 : left 508,10 : font_bold 508
    font_bold 508 : caption 508,"B"
  scroll_bar 509 : parent 509,500 : top 509,100 : left 509,30
    width 509,width_client(500)-100 : min 509,0 : max 509,255
    on_change 509,changecouleur
  alpha 510 : parent 510,500 : top 510,100 : left 510,left(509)+width(509)+20


  ' objets invisibles
  open_dialog 12
  save_dialog 13
  image 14                : ' pour mémoriser l'image avant toute opération
  picture 112 : hide 112  : ' pour déterminer les dimensions d'un texte
                           
  actif% = 0
  larg% = width(11)
  haut% = height(11)
  CouleurBord%        = 0                    : ' noir
  CouleurRemplissage%  = (0*256+255)*256+255  : ' jaune
  CouleurText%        = 0                    : ' noir
  Undo%                = 0                    : ' aucune situation pour "Annuler"
  2d_target_is 11
  2d_image_copy 14,0,0,wlarg%,whaut%
  caption 0,"Annotation"
end_sub


sub menus()
  dim_local no1%, no2%
  no% = 1000 : main_menu no%
  no% = no% + 1 : sub_menu no% : parent no%,1000 : no1% = no% : caption no%,"Fichiers"
    no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"Nouveau"
      on_click no%,nouveau
    no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"Ouvrir..."
      on_click no%,ouvrir
    no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"Enregistrer"
      on_click no%,enregistrer
    no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"Enregistrer sous..."
      on_click no%,enregistrersous
    no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"-"
    no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"Sortir"
      on_click no%,sortir
  no% = no% + 1 : sub_menu no% : parent no%,1000 : no1% = no% : caption no%,"Bulles"
end_sub


sub nouveau()
  if actif%=1
    if message_confirmation_yes_no("L'image actuelle n'est pas enregistrée. Sortir quand-même ?")<>1 then exit_sub
  end_if
  if CNV%<>0
    CNV% = dll_call1("FreeCanvas",CNV%)
  end_if
  actif% = 0
  fichier$ = ""
  2d_clear
  stretch_off 11
  full_space 11
  TypeTrace% = 0
'  width 11,width(2)-20 : height 11,height(2)-20
  larg% = wlarg%
  haut% = whaut%
  clipboard_copy 11
  clipboard_paste 111
  width 111,larg% : height 111,haut%
  caption 37,"W: "+str$(larg%)
  caption 38,"H: "+str$(haut%)
  inactive 101 : inactive 102
  hdc% = handle_canvas(11)
  CNV% = dll_call2("GetCanvas",object_internal(11),adr(hdc%))
  xpos% = 0 : ypos% = 0
  CouleurBord%        = 0                    : ' noir
  CouleurRemplissage%  = (0*256+255)*256+255  : ' jaune
  CouleurText%        = 0                    : ' noir
  color 53,0,0,0
  color 56,255,255,0
  color 59,0,0,0
  2d_target_is 11
  2d_image_copy 14,0,0,wlarg%,whaut%
  if Undo%>0
    dim_local i%
    for i%=1 to i%
      if object_exists(3000+i%)=1 then delete 3000+i%
    next i%
    Undo% = 0
  end_if
  inactive 451
  mark_off 63 : mark_off 631
  caption 0,"Annotation"
end_sub


sub ouvrir()
  dim_local res%, f$, w%, h%
  filter 12,"Images JPG|*.jpg"
  f$ = file_name$(12)
  if f$="_" then exit_sub
  if file_exists(f$)=0
    message "Fichier non trouvé"
    exit_sub
  end_if
  if CNV%<>0
    CNV% = dll_call1("FreeCanvas",CNV%)
  end_if
  inactive 0 : show 20 : display
  res% = dll_call3("AnalyzeImageFile",adr(f$),adr(larg%),adr(haut%))
  off_change 101 : position 101,0 : on_change 101,scroll
  if larg%>wlarg%
    min 101,0 : max 101,larg%-wlarg%
  else
    inactive 101
  end_if
  off_change 102 : position 102,0 : on_change 102,scroll
  if haut%>whaut%
    min 102,0 : max 102,haut%-whaut%
    position 102,0
  else
    inactive 102
  end_if
  caption 37,"W: "+str$(larg%)
  caption 38,"H: "+str$(haut%)
  width 110,larg%+30 : height 110,haut%+100
  width 111,larg% : height 111,haut%
                                   
  fichier$ = f$
  res% = dll_call1("LoadAnyImageFile",adr(fichier$))
  clipboard_paste 111
  2d_target_is 111
 
  2d_image_copy 14,0,0,wlarg%,whaut%
  2d_target_is 11
  2d_image_paste 14,0,0
'  show 110
 
  caption 0,"Annotation de "+fichier$
  TypeTrace% = 0
  xpos% = 0 : ypos% = 0
  CouleurBord%        = 0                    : ' noir
  CouleurRemplissage%  = (0*256+255)*256+255  : ' jaune
  CouleurText%        = 0                    : ' noir
  color 53,0,0,0
  color 56,255,255,0
  color 59,0,0,0
  2d_target_is 11
  2d_image_copy 14,0,0,wlarg%,whaut%
  if Undo%>0
    dim_local i%
    for i%=1 to i%
      if object_exists(3000+i%)=1 then delete 3000+i%
    next i%
    Undo% = 0
  end_if
  inactive 451
  mark_off 63 : mark_off 631
  hide 20: active 0
end_sub


sub enregistrer()
  dim_local res%
  if fichier$=""
    message "Pas d'image ouverte"
    exit_sub
  end_if
  inactive 0 : show 20 : display
'  clipboard_copy 11
  clipboard_copy 111
  pause 100
  res% = dll_call1("SaveAnyImageFile",adr(fichier$))
  actif% = 0
  caption 0,"Annotation de "+fichier$
  hide 20 : active 0
end_sub


sub enregistrersous()
  dim_local f$, res%
  f$ = file_name$(13)
  if f$="_" then exit_sub
  if file_exists(f$)=1
    if message_confirmation_yes_no("Ce fichier existe déjà. Remplacer ?")<>1 then exit_sub
  end_if
  inactive 0 : show 20 : display
  clipboard_copy 111
  pause 300
  res% = dll_call1("SaveAnyImageFile",adr(f$))
  fichier$ = f$
  actif% = 0
  caption 0,"Annotation de "+fichier$
  hide 20 : active 0
end_sub


sub sortir()
  if actif%=1
    if message_confirmation_yes_no("L'image actuelle n'est pas enregistrée. Sortir quand-même ?")<>1 then exit_sub
  end_if
  terminate
end_sub


sub tracer()
  TypeTrace% = 1                        : ' on trace la bulle
  TraceEnCours% = 0
  on_mouse_down 11,MouseDown
  caption 44,"Tracer le rectangle délimiteur..."
end_sub


sub MouseDown()
  off_mouse_down 11
  mousex% = mouse_x_left_down(11) : ' *(larg%/wlarg%)
  mousey% = mouse_y_left_down(11) : ' *(haut%/whaut%)
  select TypeTrace%
    case 1:    ' bulle
      bulle%(0) = mousex%
      bulle%(1) = mousey%
      bulle%(2) = mousex%
      bulle%(3) = mousey%
      TraceEnCours% = 1
    case 2:    ' pointe
      down% = dll_call1("CheckMouseButton",2)
      if down%=1                : ' est-ce que le bouton droit est enfoncé ?
        mousex% = mouse_x_position(11) : ' *(larg%/wlarg%)
        mousey% = mouse_y_position(11) : ' *(haut%/whaut%)
        Origine% = 0
        if mousex%<bulle%(0)
          if mousey%<bulle%(1)
            Origine% = 0            : ' TL
          else
            if mousey%>bulle%(3)
              Origine% = 3          : ' BL
            else
              Origine% = 7          : ' L
            end_if
          end_if
        else
          if mousex%>bulle%(2)
            if mousey%<bulle%(1)
              Origine% = 1          : ' TR
            else
              if mousey%>bulle%(3)
                Origine% = 2        : ' BR
              else
                Origine% = 5        : ' R
              end_if
            end_if
          else
            if Mousey%<bulle%(1)
              Origine% = 4          : ' T
            else
              if Mousey%>bulle%(3)
                Origine% = 6        : ' B
              else
                ' ici, on a cliqué sur le bord ou à l'intérieur !
                ' donc, on ignore ce clic !
                on_mouse_down 11,MouseDown
                return
              end_if
            end_if
          end_if
        end_if
        2d_circle Mousex%,Mousey%,5
        set_focus 45
        TypeTrace% = 3
        caption 44,"Valdez la bulle maintenant..."
        return
      end_if
      on_mouse_down 11,MouseDown
      return
  end_select
  down% = 1
  on_mouse_move 11,MouseMove
end_sub


sub MouseMove()
  d% = dll_call1("CheckMouseButton",1)
  down% = down% * d%
  if down%=0
    TraceEnCours% = 0
    TypeTrace% = 2
    caption 44,"Clic droit pour positionner la pointe..."
    on_mouse_down 11,MouseDown
    return
  end_if

  caption 0,str$(mouse_x_position(11))+","+str$(mouse_y_position(11))
  mousex% = mouse_x_position(11) : ' *(larg%/wlarg%)
  mousey% = mouse_y_position(11) : ' *(haut%/whaut%)
  bulle%(2) = mousex%
  bulle%(3) = mousey%
'  caption 0,str$(mousex%)+","+str$(mousey%)
  2d_image_paste 14,0,0
  display
  2d_poly_from bulle%(0),bulle%(1)
  2d_poly_to bulle%(2),bulle%(1)
  2d_poly_to bulle%(2),bulle%(3)
  2d_poly_to bulle%(0),bulle%(3)
  2d_poly_to bulle%(0),bulle%(1)
  display
end_sub
         
sub valider()
  dim_local i%, px%, py%, dx%, dy%, pol$, dir%, angle%
  dim_local wtxt%, htxt%
  if TypeTrace%<>3 then return
  2d_image_paste 14,0,0
  ' mémoriser la situation pour "Annuler"
  if Undo%=MUndo%
   
  end_if
  Undo% = Undo% + 1                    : ' compter la nouvelle mémorisation
  image 3000+Undo%                    : ' créer un image pour memoriser le contenu de l'objet 11
  2d_image_copy 3000+Undo%,0,0,wlarg%,whaut%  : ' mémoriser la partie visible de 11
  UndoPos%(Undo%,0) = xpos%            : ' et mémoriser la position dans l'image globale
  UndoPos%(Undo%,1) = ypos%
  active 451
 
  ' tracer la bulle
  typ% = item_index(42)
  hdc% = handle_canvas(11)
  CNV% = dll_call2("GetCanvas",object_internal(11),adr(hdc%))
  ' paramètres communs à tous les types de bules
      params%(2)  = bulle%(0)              : ' coin en haut à gauche
      params%(3)  = bulle%(1)
      params%(4)  = bulle%(2)              : ' coin en bas à droite
      params%(5)  = bulle%(3)
      params%(6)  = position(51)            : ' épaisseur du trait
      params%(7)  = CouleurBord%            : ' clBlack
      params%(8)  = CouleurRemplissage%    : ' clYellow
      params%(9)  = position(47)            : ' rayon de l'arrondi
      params%(10) = typ%-1                  : ' type de bulle
      params%(11) = 0                      : ' ./. non utilisé
      params%(12) = Origine%                : ' départ 
      params%(13) = mousex%                : ' position de la pointe
      params%(14) = mousey%
      params%(15) = position(49)            : ' largeur de la flèche à la base
  if typ%>1
    if params%(6)=1 then params%(6) = 2
  end_if
  res% = dll_call3("DrawOnCanvas",CNV%,6,adr(params%))
  display
  CNV% = dll_call1("FreeCanvas",CNV%)
  2d_image_copy 14,0,0,wlarg%,whaut%
  display 
  2d_image_paste 14,0,0
  pause 100
  2d_target_is 111
  2d_image_paste 14,xpos%,ypos%
  pause 200
  2d_target_is 11
  display
 
  ' imprimer le texte dans la bulle
  if count(61)>0
    pitch% = val(text$(69))
    ' 1 = Gauche -> Droite
    ' 2 = Bas -> Haut
    ' 3 = Haut-> Bas
    ' 4 = Droite -> Gauche
    dir% = item_index(62)
    select dir%
      case 1
        px% = bulle%(0) + 10
        py% = bulle%(1) + 10
        dx% = 0
        dy% = pitch%
        angle% = 0
      case 2
        px% = bulle%(0) + 10
        py% = bulle%(3) - 10
        dx% = pitch%
        dy% = 0
        angle% = 90
      case 3
        px% = bulle%(2) - 10
        py% = bulle%(1) + 10
        dx% = 0 - pitch%
        dy% = 0
        angle% = 270
      case 4
        px% = bulle%(2) - 10
        py% = bulle%(3) - 10
        dx% = 0
        dy% = 0 - pitch%
        angle% = 180
    end_select
    pol$ = text$(64) 

    ' paramètres valables pour toutes les lignes
    params%(5) = adr(pol$)              : ' nom de la police
    params%(6) = angle%*10              : ' angle d'inclinaison * 10
    params%(7) = CouleurText%          : ' couleur de la police
    params%(8) = 0                      : ' ./. non utilisé
    params%(9) = pitch%                : ' taille de la police
    params%(10) = checked(65)          : ' gras
    params%(11) = checked(66)          : ' italique
    params%(12) = checked(67)          : ' sousligné
    params%(13) = checked(68)          : ' barré   
   
    for i%=1 to count(61)
      ' paramètres spécifiques à 1 ligne
      txt$ = item_read$(61,i%)
      Formater()                        : ' gérer le centrage ou le cardrage à droite
                                 
'      caption 0,str$(px%)+","+str$(py%)+"  "+txt$   
      params%(2) = px%                    : ' position de début d'impression
      params%(3) = py%
      params%(4) = adr(txt$)              : ' ligne de texte
      ' impression de la ligne
      hdc% = handle_canvas(11)
      CNV% = dll_call2("GetCanvas",object_internal(11),adr(hdc%))
      res% = dll_call3("DrawOnCanvas",CNV%,5,adr(params%))
      CNV% = dll_call1("FreeCanvas",CNV%)
      ' assurer l'affichage
      2d_image_copy 14,0,0,wlarg%,whaut%
      display 
      2d_image_paste 14,0,0
      pause 100
      2d_target_is 111
      2d_image_paste 14,xpos%,ypos%
      pause 200
      2d_target_is 11
      display
      ' préparer la position de la ligne suivangte
      px% = px% + dx%
      py% = py% + dy%
    next i%
  end_if
 
  actif% = 1
  caption 44,""
  mark_off 63 : mark_off 631
'  message "Pointe en "+str$(mousex%)+","+str$(mousey%)+"  Origine%="+str$(Origine%)
end_sub


sub annuler()
  if Undo%=0          : ' ceci ne devrait jamais arriver...
    inactive 451
    exit_sub
  end_if
  2d_target_is 111
  2d_image_paste 3000+Undo%,UndoPos%(Undo%,0),UndoPos%(Undo%,1)
  display
  2d_image_copy 14,xpos%,ypos%,xpos%+wlarg%,ypos%+whaut%
  display
  2d_target_is 11
  2d_image_paste 14,0,0
  display
  delete 3000+Undo%                  : ' supprimer l'image mémorisée
  Undo% = Undo% - 1                  : ' "oublier" cette étape
  if Undo%=0 then inactive 451      : ' plus rien en mémoire ? désactiver le outon
end_sub


sub scroll()
  xpos% = position(101)
  ypos% = position(102)
  off_change 101 : off_change 102
  2d_target_is 111
  2d_image_copy 14,xpos%,ypos%,xpos%+wlarg%,ypos%+whaut%
  pause 100
  2d_target_is 11
  2d_image_paste 14,0,0
  pause 100
  on_change 101,scroll : on_change 102,scroll
end_sub


sub RGB(c%)
  RR% = bin_and(c%,255)
  GG% = bin_and(c%,hex("FF00"))/256
  BB% = (bin_and(c%,hex("FF0000"))/256)/256
end_sub


sub changecouleur(n%)
  dim_local c%
  c% = position(n%)
  select n%
    case 503
      RR% = c%
    case 506
      GG% = c%
    case 509
      BB% = c%
  end_select
  caption n%+1,str$(c%)
  select nCouleur%
    case 1:    ' bourdure
      color 53,RR%,GG%,BB%
      CouleurBord% = (BB%*256+GG%)*256+RR%
    case 2:    ' remplissage
      color 56,RR%,GG%,BB%
      CouleurRemplissage% = (BB%*256+GG%)*256+RR%
    case 3:    ' texte
      color 59,RR%,GG%,BB%
      CouleurText% = (BB%*256+GG%)*256+RR%
  end_select
end_sub


sub couleur()
  inactive 0
  if number_click=54 then nCouleur% = 1  : ' couleur de la bordure
  if number_click=57 then nCouleur% = 2  : ' couleur de remplissage
  if number_click=60 then nCouleur% = 3  : ' couleur du texte
  select nCouleur%
    case 1:    ' couleur de la bordure
      caption 501,"Couleur de la bordure"
      RGB(CouleurBord%)
      position 503,RR%
      caption 504,str$(RR%)
      position 506,GG%
      caption 507,str$(GG%)
      position 509,BB%
      caption 510,str$(BB%)
    case 2:    ' couleur de remplissage
      caption 501,"Couleur de remplissage"
      RGB(CouleurRemplissage%)
      position 503,RR%
      caption 504,str$(RR%)
      position 506,GG%
      caption 507,str$(GG%)
      position 509,BB%
      caption 510,str$(BB%)
    case 3:    ' couleur du texte
      caption 501,"Couleur du texte"
      RGB(CouleurText%)
      position 503,RR%
      caption 504,str$(RR%)
      position 506,GG%
      caption 507,str$(GG%)
      position 509,BB%
      caption 510,str$(BB%)
  end_select
  show 500
end_sub


sub Formater()
  dim_local s1$, s2$
  if checked(63)=1    : ' texte centré
    s1$ = " "
    s2$ = " "
  end_if
  if checked(631)=1    : ' texte cadré à droite
    s1$ = " "
  end_if
  if len(s1$+s2$)=0 then exit_sub
    dim_local wRect%, hRect%          : ' dimensions du rectangle ciblé
    dim_local wtxt%, htxt%            : ' dimensions du texte imprimé
    wRect% = bulle%(2) - bulle%(0)    : ' dimensions du rectangle de la bulle
    hRect% = bulle%(3) - bulle%(0)
    font_name 112,pol$
    font_size 112,pitch%
    if checked(65)=1
      font_bold 112
    else
      font_bold_off 112
    end_if
    if checked(66)=1
      font_italic 112
    else
      font_italic_off 112
    end_if
    if checked(67)=1
      font_underline 112
    else
      font_underline_off 112
    end_if
    if checked(68)=1
      font_strike 112
      else
      font_strike_off 112
    end_if     
    wtxt% = text_width(txt$,112)
    htxt% = text_height(txt$,112)
    while wtxt%<wRect%
      txt$ = s1$ + txt$ + s2$
      wtxt% = text_width(txt$,112)
      htxt% = text_height(txt$,112)
    end_while 
end_sub

Et voici le résultat du cadrage:
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Marc



Nombre de messages : 549
Age : 56
Localisation : TOURS
Date d'inscription : 18/03/2014

MessageSujet: Re: Annoter une image avec des bulles de texte   Lun 3 Avr 2017 - 23:40


Waouh !

Très belle réussite !

MERCI KLAUS !

Spoiler:
 
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Klaus

avatar

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

MessageSujet: Re: Annoter une image avec des bulles de texte   Mar 4 Avr 2017 - 0:41

Very Happy Very Happy Very Happy
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
papydall

avatar

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

MessageSujet: Re: Annoter une image avec des bulles de texte   Mar 4 Avr 2017 - 1:01

Tout ça est beau, très beau, parfaitement beau !
Merci Klaus.
Mais le plus beau sera de corriger le lapsus clavis du titre   Annuter annoter une image avec des bulles de texte

Wink
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://papydall-panoramic.forumarabia.com/
Klaus

avatar

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

MessageSujet: Re: Annoter une image avec des bulles de texte   Mar 4 Avr 2017 - 1:03

Un petit gadget supplémentaire: un bouton (et option menu) "Rétablir", pour annuler toutes les interventions et revenir à l'état initial. Et une autre particularité: on peut cocher une case "Fond transparent", et le programme ne dessinera que les bords et éventuellement le texte:
Code:
' annoter_une_image.bas

' Cet utilitaire permet de:
'   - charger une image
'   - y placer des bulles de texte
'   - sauvegarder le résultat obtenu

dll_on "KGF.dll"

labels()
variables()
form0()
menus()

end

nouveau:
 nouveau()
 return
 
ouvrir:
 ouvrir()
 return
 
enregistrer:
 enregistrer()
 return
 
retablir:
 if inactive(341)=1 then return
 retablir(fichier$)
 return
 
enregistrersous:
 enregistrersous()
 return
 
sortir:
 sortir()
 return
 
tracer:
 tracer()
 return
 
valider:
 valider()
 return
 
annuler:
 annuler()
 return
 
MouseDown:
 MouseDown()
 return

MouseMove:
 off_mouse_move 11
 MouseMove()
 on_mouse_move 11,MouseMove
 return
 
scroll:
 scroll()
 return
 
couleur:
 couleur()
 return
 
couleurok:
 hide 500
 to_foreground 0
 active 0
 set_focus 43
 return
 
changecouleur:
 changecouleur(number_change)
 return
 

sub labels()
 label nouveau, ouvrir, enregistrer, retablir, enregistrersous, sortir
 label tracer, MouseDown, MouseMove, valider, annuler, scroll
 label couleur, couleurok, changecouleur

end_sub


sub variables()
 dim no%, d%, res%, typ%
 dim actif%                  : ' flag "une image est présente, modifiée et non sauvegardée"
 dim fichier$                : ' nom du fichier chargé dans le picture 11
 dim larg%, haut%            : ' dimensions réelles de l'image du fichier chargé
 dim wlarg%, whaut%          : ' dimensions réelles de du picture 11
 dim mousex%, mousey%        : ' coordonnées de la souris
 dim bulle%(3)               : ' dimensions de la bulle (types 1...3)
 dim pointe%(1)              : ' coordonnées de la pointe
 dim TypeTrace%              : ' type de traçage  0=rien  1=bulle 2=pointe 3=prêt à valider
 dim TraceEnCours%           : ' flag "traçage du rectangle en cours"
 dim Origine%                : ' origine de la flèche: 0=TL 1=TR 2=BR 3=BL 4=T B=R 6=B 7=L
 dim down%                   : ' flag "bouton gauche de la souris est enfoncé"
 dim hdc%                    : ' reçoit handle_canvas(11)
 dim CNV%                    : ' identifiant du canvas pour le dessin
 dim Params%(20)             : ' paramètres pour DrawOnCanvas
 dim xpos%, ypos%            : ' positions de la fenêtre de visualisation
 dim CouleurBord%            : ' code couleur pour la bordure
 dim CouleurRemplissage%     : ' code couleur pour le remplissage
 dim CouleurText%            : ' couleur du texte à imprimer
 dim nCouleur%               : ' indice du type de couleur
 dim RR%, GG%, BB%           : ' couleurs RGB décodées
 dim Undo%                   : ' nombre d'étapes mémorisées pour "Annuler"
 dim MUndo% : MUndo% = 100   : ' nombre maxi d'etapes d'annulation
 dim UndoPos%(MUndo%,1)      : ' sauvegarde des xpos% et ypos% pour "Annuler"
 dim txt$                    : ' une ligne de texte à imprimer dans la bulle
 dim pitch%                  : ' taille de la police d'impression
end_sub


sub form0()
 dim_local res%, i%
 full_space 0
 
 ' les outils
 container 1 : height 1,height_client(0) - 30 : width 1,300 : caption 1,"Outils"

 ' les outils "Fichiers"
 container 31 : parent 31,1 : top 31,15 : left 31,15 : width 31,width_client(1)-30
   color 31,225,225,225
   caption 31,"Fichiers"
 button 32 : parent 32,31 : top 32,15 : left 32,15 : height 32,20 : width 32,70 : caption 32,"Nouveau"
   on_click 32,nouveau
 button 33 : parent 33,31 : top 33,15 : left 33,100 : height 33,20 : width 33,50 : caption 33,"Ouvrir"
   on_click 33,ouvrir  
 button 34 : parent 34,31 : top 34,15 : left 34,170 : height 34,20 : width 34,70 : caption 34,"Enregistrer"
   on_click 34,enregistrer  
 button 341 : parent 341,31 : top 341,40 : left 341,15 : height 341,20 : width 341,50 : caption 341,"Rétablir"
   on_click 341,retablir : inactive 341
 button 35 : parent 35,31 : top 35,40 : left 35,75 : height 35,20 : width 35,100 : caption 35,"Enregistrer sous"
   on_click 35,enregistrersous  
 button 36 : parent 36,31 : top 36,75 : left 36,95 : height 36,20 : width 36,60 : caption 36,"Sortir"
   on_click 36,sortir
  alpha 37 : parent 37,31 : top 37,45 : left 37,200 : caption 37,"W; "  
  alpha 38 : parent 38,31 : top 38,65 : left 38,200 : caption 38,"H; "  
   
' les outils  "Bulles"
 container 41 : parent 41,1 : top 41,15+height(31)+5 : left 41,15
   width 41,width_client(1)-30 : height 41,height_client(1)-top(41)-10
   color 41,225,225,225
   caption 41,"Bulles"
 combo 42 : parent 42,41 : top 42,15 : left 42,15 : width 42,width_client(41)-30
   item_add 42,"Bulle rectangle"
   item_add 42,"Bulle rectangle arrondi"
   item_add 42,"Bulle ellipse"
 res% = dll_call2("SelectComboBoxItem",handle(42),1)
 button 43 : parent 43,41 : top 43,top(42)+height(42)+5: left 43,15 : height 43,20
   caption 43,"Tracer bulle" : on_click 43,tracer
 alpha 44 : parent 44,41 : top 44,top(43)+30 : left 44,15 : font_bold 44
 button 45 : parent 45,41 : top 45,top(43) : left 45,95 : height 45,20
   caption 45,"Valider bulle" : on_click 45,valider
 button 451 : parent 451,41 : top 451,top(43) : left 451,175 : height 451,20
   caption 451,"Annuler bulle" : on_click 451,annuler : inactive 451      
 alpha 46 : parent 46,41 : top 46,top(44)+30 : left 46,15
   caption 46,"Rayon de courbure d'arrondi:"
 spin 47 : parent 47,41 : top 47,top(46) : left 47,160 : width 47,60
   min 47,0 : max 47,50 : position 47,10
 alpha 48 : parent 48,41 : top 48,top(46)+30 : left 48,15
   caption 48,"Diamètre de la base de flèche:"
 spin 49 : parent 49,41 : top 49,top(48) : left 49,160 : width 49,60
   min 49,5 : max 49,200 : position 49,20  
 alpha 50 : parent 50,41 : top 50,top(48)+30 : left 50,15
   caption 50,"Epaisseur de la bordure:"
 spin 51 : parent 51,41 : top 51,top(50) : left 51,160 : width 51,60
   min 51,1 : max 51,20 : position 51,1

 alpha 52 : parent 52,41 : top 52,top(50)+30 : left 52,15
   caption 52,"Couleur de la bordure:"
 picture 53 : parent 53,41 : top 53,top(52) : left 53,160 : width 53,30 : height 53,20
   color 53,0,0,0
 button 54 : parent 54,41 : top 54,top(52) : left 54,left(53)+35 : width 54,30 : height 54,20
   caption 54,"..." : font_bold 54 : on_click 54,couleur
   
 alpha 55 : parent 55,41 : top 55,top(52)+30 : left 55,15
   caption 55,"Couleur de remplissage:"
 picture 56 : parent 56,41 : top 56,top(55) : left 56,160 : width 56,30 : height 56,20
   color 56,255,255,0
 button 57 : parent 57,41 : top 57,top(55) : left 57,left(56)+35 : width 57,30 : height 57,20
   caption 57,"..." : font_bold 57 : on_click 57,couleur

 check 571 : parent 571,41 : top 571,top(55)+30 : left 571,160
   caption 571,"Fond transparent" : width 571,100

 alpha 58 : parent 58,41 : top 58,top(571)+30 : left 58,15
   caption 58,"Couleur du texte:"
 picture 59 : parent 59,41 : top 59,top(58) : left 59,160 : width 59,30 : height 59,20
   color 59,0,0,0
 button 60 : parent 60,41 : top 60,top(58) : left 60,left(59)+35 : width 60,30 : height 60,20
   caption 60,"..." : font_bold 60 : on_click 60,couleur

 memo 61 : parent 61,41 : top 61,top(58)+30 : left 61,15 : width 61,width_client(41)-30
   height 61,150 : bar_both 61 : font_size 61,10
 combo 62 : parent 62,41 : top 62,top(61)+height(61)+10 : left 62,15
   width 62,120
   item_add 62,"Gauche -> Droite"
   item_add 62,"Bas -> Haut"
   item_add 62,"Haut-> Bas"
   item_add 62,"Droite -> Gauche"
 res% = dll_call2("SelectComboBoxItem",handle(62),1)
 option 63 : parent 63,41 : top 63,top(62) : left 63,140 : caption 63,"Centré"  
 option 631 : parent 631,41 : top 631,top(62) : left 631,200 : caption 631,"à Droite"  
 combo 64 : parent 64,41 : top 64,top(62)+30 : left 64,15
   width 64,width_client(41)-30 : font_names_load 64
 for i%=1 to count(64)
   if item_read$(64,i%)="Arial"
     res% = dll_call2("SelectComboBoxItem",handle(64),i%)      
     exit_for
   end_if
 next i%
 check 65 : parent 65,41 : top 65,top(64)+30 : left 65,15 : caption 65,"G" : font_bold 65  
 check 66 : parent 66,41 : top 66,top(65) : left 66,60 : caption 66,"I" : font_italic 66  
 check 67 : parent 67,41 : top 67,top(65) : left 67,105 : caption 67,"S" : font_underline 67  
 check 68 : parent 68,41 : top 68,top(65) : left 68,150 : caption 68,"B" : font_strike 68  
 combo 69 : parent 69,41 : top 69,top(65) : left 69,200 : width 69,width_client(41)-215
   item_add 69,"8"
   item_add 69,"10"
   item_add 69,"12"
   item_add 69,"14"
   item_add 69,"16"
   item_add 69,"18"
   item_add 69,"20"
   item_add 69,"22"
   item_add 69,"24"
   item_add 69,"28"
   item_add 69,"32"
   item_add 69,"36"
   item_add 69,"48"
   res% = dll_call2("SelectComboBoxItem",handle(69),3)      
   
' l'image
 container 2 : left 2,300 : height 2,height_client(0) - 30 : width 2,width_client(0)-300
   caption 2,"Image"
 wlarg% = width_client(2)-30
 whaut% = height_client(2)-35
 picture 11 : parent 11,2
   top 11,15 : left 11,10 : width 11,wlarg% : height 11,whaut%
   color 11,225,225,0 : parent 11,2
 2d_target_is 11
 scroll_bar 101 : parent 101,2
   height 101,20 : width 101,width_client(2)-20 : top 101,height(2)-20
   min 101,0 : max 101,width_client(2)-20 : inactive 101 : on_change 101,scroll
 scroll_bar 102 : parent 102,2 : vertical 102
   width 102,20 : height 102,height_client(2)-20 : left 102,width(2)-20
   min 102,0 : max 102,height_client(2)-20 : inactive 102 : on_change 101,scroll
 form 110 : full_space 110 : hide 110
 picture 111 : parent 111,110 : width 111,wlarg% : height 111,whaut%
                           
 ' la fenêtre "sablier"
 form 20 : hide 20 : border_hide 20 : width 20,400 : height 20,100
   top 20,(screen_y-height(20))/2 : left 20,(screen_x-width(20))/2
 panel 21 : parent 21,20 : full_space 21 : color 21,255,192,192
   font_size 21,24
   caption 21,"Opération en cours..."
   
 ' la fenêtre de sélection de couleur
 form 500 : hide 500 : caption 500,"Sélection de couleur" : width 500,500
   top 500,(screen_y-height(500))/2 : left 500,(screen_x-width(500))/2
   on_close 500,couleurok
 alpha 501 : parent 501,500 : top 501,10 : left 501,10 : font_bold 501
 
 alpha 502 : parent 502,500 : top 502,40 : left 502,10 : font_bold 501
   font_bold 502 : caption 502,"R"
 scroll_bar 503 : parent 503,500 : top 503,40 : left 503,30
   width 503,width_client(500)-100 : min 503,0 : max 503,255
   on_change 503,changecouleur
 alpha 504 : parent 504,500 : top 504,40 : left 504,left(503)+width(503)+20
   
 alpha 505 : parent 505,500 : top 505,70 : left 505,10 : font_bold 505
   font_bold 505 : caption 505,"G"
 scroll_bar 506 : parent 506,500 : top 506,70 : left 506,30
   width 506,width_client(500)-100 : min 506,0 : max 506,255
   on_change 506,changecouleur
 alpha 507 : parent 507,500 : top 507,70 : left 507,left(506)+width(506)+20
   
 alpha 508 : parent 508,500 : top 508,100 : left 508,10 : font_bold 508
   font_bold 508 : caption 508,"B"
 scroll_bar 509 : parent 509,500 : top 509,100 : left 509,30
   width 509,width_client(500)-100 : min 509,0 : max 509,255
   on_change 509,changecouleur
 alpha 510 : parent 510,500 : top 510,100 : left 510,left(509)+width(509)+20


 ' objets invisibles
 open_dialog 12
 save_dialog 13
 image 14                 : ' pour mémoriser l'image avant toute opération
 picture 112 : hide 112   : ' pour déterminer les dimensions d'un texte
                           
 actif% = 0
 larg% = width(11)
 haut% = height(11)
 CouleurBord%         = 0                     : ' noir
 CouleurRemplissage%  = (0*256+255)*256+255   : ' jaune
 CouleurText%         = 0                     : ' noir
 Undo%                = 0                     : ' aucune situation pour "Annuler"
 2d_target_is 11
 2d_image_copy 14,0,0,wlarg%,whaut%
 caption 0,"Annotation"
end_sub


sub menus()
 dim_local no1%, no2%
 no% = 1000 : main_menu no%
 no% = no% + 1 : sub_menu no% : parent no%,1000 : no1% = no% : caption no%,"Fichiers"
   no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"Nouveau"
     on_click no%,nouveau
   no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"Ouvrir..."
     on_click no%,ouvrir
   no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"Enregistrer"
     on_click no%,enregistrer
   no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"Enregistrer sous..."
     on_click no%,enregistrersous
   no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"-"
   no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"Rétablir"
     on_click no%,retablir
   no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"-"
   no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"Sortir"
     on_click no%,sortir
 no% = no% + 1 : sub_menu no% : parent no%,1000 : no1% = no% : caption no%,"Bulles"
end_sub


sub nouveau()
 if actif%=1
   if message_confirmation_yes_no("L'image actuelle n'est pas enregistrée. Sortir quand-même ?")<>1 then exit_sub
 end_if
 if CNV%<>0
   CNV% = dll_call1("FreeCanvas",CNV%)
 end_if
 actif% = 0
 fichier$ = ""
 2d_clear
 stretch_off 11
 full_space 11
 TypeTrace% = 0
'  width 11,width(2)-20 : height 11,height(2)-20
 larg% = wlarg%
 haut% = whaut%
 clipboard_copy 11
 clipboard_paste 111
 width 111,larg% : height 111,haut%
 caption 37,"W: "+str$(larg%)
 caption 38,"H: "+str$(haut%)
 inactive 101 : inactive 102
 hdc% = handle_canvas(11)
 CNV% = dll_call2("GetCanvas",object_internal(11),adr(hdc%))
 xpos% = 0 : ypos% = 0
 CouleurBord%         = 0                     : ' noir
 CouleurRemplissage%  = (0*256+255)*256+255   : ' jaune
 CouleurText%         = 0                     : ' noir
 color 53,0,0,0
 color 56,255,255,0
 color 59,0,0,0
 2d_target_is 11
 2d_image_copy 14,0,0,wlarg%,whaut%
 if Undo%>0
   dim_local i%
   for i%=1 to i%
     if object_exists(3000+i%)=1 then delete 3000+i%
   next i%
   Undo% = 0
 end_if
 inactive 451 : inactive 341
 mark_off 63 : mark_off 631
 caption 0,"Annotation"
end_sub


sub ouvrir()
 dim_local f$
 filter 12,"Images JPG|*.jpg"
 f$ = file_name$(12)
 if f$="_" then exit_sub
 if file_exists(f$)=0
   message "Fichier non trouvé"
   exit_sub
 end_if
 retablir(f$)
end_sub

sub retablir(f$)
 dim_local res%, w%, h%
 if CNV%<>0
   CNV% = dll_call1("FreeCanvas",CNV%)
 end_if
 inactive 0 : show 20 : display
 res% = dll_call3("AnalyzeImageFile",adr(f$),adr(larg%),adr(haut%))
 off_change 101 : position 101,0 : on_change 101,scroll
 if larg%>wlarg%
   min 101,0 : max 101,larg%-wlarg%
 else
   inactive 101
 end_if
 off_change 102 : position 102,0 : on_change 102,scroll
 if haut%>whaut%
   min 102,0 : max 102,haut%-whaut%
   position 102,0
 else
   inactive 102
 end_if
 caption 37,"W: "+str$(larg%)
 caption 38,"H: "+str$(haut%)
 width 110,larg%+30 : height 110,haut%+100
 width 111,larg% : height 111,haut%
                                   
 fichier$ = f$
 res% = dll_call1("LoadAnyImageFile",adr(fichier$))
 clipboard_paste 111
 2d_target_is 111
 
 2d_image_copy 14,0,0,wlarg%,whaut%
 2d_target_is 11
 2d_image_paste 14,0,0
'  show 110
 
 caption 0,"Annotation de "+fichier$
 TypeTrace% = 0
 xpos% = 0 : ypos% = 0
 CouleurBord%         = 0                     : ' noir
 CouleurRemplissage%  = (0*256+255)*256+255   : ' jaune
 CouleurText%         = 0                     : ' noir
 color 53,0,0,0
 color 56,255,255,0
 color 59,0,0,0
 2d_target_is 11
 2d_image_copy 14,0,0,wlarg%,whaut%
 if Undo%>0
   dim_local i%
   for i%=1 to i%
     if object_exists(3000+i%)=1 then delete 3000+i%
   next i%
   Undo% = 0
 end_if
 inactive 451 : active 341
 mark_off 63 : mark_off 631
 hide 20: active 0
end_sub


sub enregistrer()
 dim_local res%
 if fichier$=""
   message "Pas d'image ouverte"
   exit_sub
 end_if
 inactive 0 : show 20 : display
'  clipboard_copy 11
 clipboard_copy 111
 pause 100
 res% = dll_call1("SaveAnyImageFile",adr(fichier$))
 actif% = 0
 caption 0,"Annotation de "+fichier$
 hide 20 : active 0
end_sub


sub enregistrersous()
 dim_local f$, res%
 f$ = file_name$(13)
 if f$="_" then exit_sub
 if file_exists(f$)=1
   if message_confirmation_yes_no("Ce fichier existe déjà. Remplacer ?")<>1 then exit_sub
 end_if
 inactive 0 : show 20 : display
 clipboard_copy 111
 pause 300
 res% = dll_call1("SaveAnyImageFile",adr(f$))
 fichier$ = f$
 actif% = 0
 caption 0,"Annotation de "+fichier$
 hide 20 : active 0
end_sub


sub sortir()
 if actif%=1
   if message_confirmation_yes_no("L'image actuelle n'est pas enregistrée. Sortir quand-même ?")<>1 then exit_sub
 end_if
 terminate
end_sub


sub tracer()
 TypeTrace% = 1                        : ' on trace la bulle
 TraceEnCours% = 0
 on_mouse_down 11,MouseDown
 caption 44,"Tracer le rectangle délimiteur..."
end_sub


sub MouseDown()
 off_mouse_down 11
 mousex% = mouse_x_left_down(11) : ' *(larg%/wlarg%)
 mousey% = mouse_y_left_down(11) : ' *(haut%/whaut%)
 select TypeTrace%
   case 1:    ' bulle
     bulle%(0) = mousex%
     bulle%(1) = mousey%
     bulle%(2) = mousex%
     bulle%(3) = mousey%
     TraceEnCours% = 1
   case 2:    ' pointe
     down% = dll_call1("CheckMouseButton",2)
     if down%=1                : ' est-ce que le bouton droit est enfoncé ?
       mousex% = mouse_x_position(11) : ' *(larg%/wlarg%)
       mousey% = mouse_y_position(11) : ' *(haut%/whaut%)
       Origine% = 0
       if mousex%<bulle%(0)
         if mousey%<bulle%(1)
           Origine% = 0            : ' TL
         else
           if mousey%>bulle%(3)
             Origine% = 3          : ' BL
           else
             Origine% = 7          : ' L
           end_if
         end_if
       else
         if mousex%>bulle%(2)
           if mousey%<bulle%(1)
             Origine% = 1          : ' TR
           else
             if mousey%>bulle%(3)
               Origine% = 2        : ' BR
             else
               Origine% = 5        : ' R
             end_if
           end_if
         else
           if Mousey%<bulle%(1)
             Origine% = 4          : ' T
           else
             if Mousey%>bulle%(3)
               Origine% = 6        : ' B
             else
               ' ici, on a cliqué sur le bord ou à l'intérieur !
               ' donc, on ignore ce clic !
               on_mouse_down 11,MouseDown
               return
             end_if
           end_if
         end_if
       end_if
       2d_circle Mousex%,Mousey%,5
       set_focus 45
       TypeTrace% = 3
       caption 44,"Valdez la bulle maintenant..."
       return
     end_if
     on_mouse_down 11,MouseDown
     return
 end_select
 down% = 1
 on_mouse_move 11,MouseMove
end_sub


sub MouseMove()
 d% = dll_call1("CheckMouseButton",1)
 down% = down% * d%
 if down%=0
   TraceEnCours% = 0
   TypeTrace% = 2
   caption 44,"Clic droit pour positionner la pointe..."
   on_mouse_down 11,MouseDown
   return
 end_if

 caption 0,str$(mouse_x_position(11))+","+str$(mouse_y_position(11))
 mousex% = mouse_x_position(11) : ' *(larg%/wlarg%)
 mousey% = mouse_y_position(11) : ' *(haut%/whaut%)
 bulle%(2) = mousex%
 bulle%(3) = mousey%
'  caption 0,str$(mousex%)+","+str$(mousey%)
 2d_image_paste 14,0,0
 display
 2d_poly_from bulle%(0),bulle%(1)
 2d_poly_to bulle%(2),bulle%(1)
 2d_poly_to bulle%(2),bulle%(3)
 2d_poly_to bulle%(0),bulle%(3)
 2d_poly_to bulle%(0),bulle%(1)
 display
end_sub
         
sub valider()
 dim_local i%, px%, py%, dx%, dy%, pol$, dir%, angle%
 dim_local wtxt%, htxt%
 if TypeTrace%<>3 then return
 2d_image_paste 14,0,0
 ' mémoriser la situation pour "Annuler"
 if Undo%=MUndo%
   
 end_if
 Undo% = Undo% + 1                    : ' compter la nouvelle mémorisation
 image 3000+Undo%                     : ' créer un image pour memoriser le contenu de l'objet 11
 2d_image_copy 3000+Undo%,0,0,wlarg%,whaut%   : ' mémoriser la partie visible de 11
 UndoPos%(Undo%,0) = xpos%            : ' et mémoriser la position dans l'image globale
 UndoPos%(Undo%,1) = ypos%
 active 451
 
 ' tracer la bulle
 typ% = item_index(42)
 hdc% = handle_canvas(11)
 CNV% = dll_call2("GetCanvas",object_internal(11),adr(hdc%))
 ' paramètres communs à tous les types de bules
     params%(2)  = bulle%(0)               : ' coin en haut à gauche
     params%(3)  = bulle%(1)
     params%(4)  = bulle%(2)               : ' coin en bas à droite
     params%(5)  = bulle%(3)
     params%(6)  = position(51)            : ' épaisseur du trait
     params%(7)  = CouleurBord%            : ' clBlack
     params%(8)  = CouleurRemplissage%     : ' clYellow
     if checked(571)=1 then params%(8)  = -99     : ' transparent
     params%(9)  = position(47)            : ' rayon de l'arrondi
     params%(10) = typ%-1                  : ' type de bulle
     params%(11) = 0                       : ' ./. non utilisé
     params%(12) = Origine%                : ' départ  
     params%(13) = mousex%                 : ' position de la pointe
     params%(14) = mousey%
     params%(15) = position(49)            : ' largeur de la flèche à la base
 if typ%>1
   if params%(6)=1 then params%(6) = 2
 end_if
 res% = dll_call3("DrawOnCanvas",CNV%,6,adr(params%))
 display
 CNV% = dll_call1("FreeCanvas",CNV%)
 2d_image_copy 14,0,0,wlarg%,whaut%
 display  
 2d_image_paste 14,0,0
 pause 100
 2d_target_is 111
 2d_image_paste 14,xpos%,ypos%
 pause 200
 2d_target_is 11
 display
 
 ' imprimer le texte dans la bulle
 if count(61)>0
   pitch% = val(text$(69))
   ' 1 = Gauche -> Droite
   ' 2 = Bas -> Haut
   ' 3 = Haut-> Bas
   ' 4 = Droite -> Gauche
   dir% = item_index(62)
   select dir%
     case 1
       px% = bulle%(0) + 10
       py% = bulle%(1) + 10
       dx% = 0
       dy% = pitch%
       angle% = 0
     case 2
       px% = bulle%(0) + 10
       py% = bulle%(3) - 10
       dx% = pitch%
       dy% = 0
       angle% = 90
     case 3
       px% = bulle%(2) - 10
       py% = bulle%(1) + 10
       dx% = 0 - pitch%
       dy% = 0
       angle% = 270
     case 4
       px% = bulle%(2) - 10
       py% = bulle%(3) - 10
       dx% = 0
       dy% = 0 - pitch%
       angle% = 180
   end_select
   pol$ = text$(64)  

   ' paramètres valables pour toutes les lignes
   params%(5) = adr(pol$)              : ' nom de la police
   params%(6) = angle%*10              : ' angle d'inclinaison * 10
   params%(7) = CouleurText%           : ' couleur de la police
   params%(8) = 0                      : ' ./. non utilisé
   params%(9) = pitch%                 : ' taille de la police
   params%(10) = checked(65)           : ' gras
   params%(11) = checked(66)           : ' italique
   params%(12) = checked(67)           : ' sousligné
   params%(13) = checked(68)           : ' barré    
   
   for i%=1 to count(61)
     ' paramètres spécifiques à 1 ligne
     txt$ = item_read$(61,i%)
     Formater()                        : ' gérer le centrage ou le cardrage à droite
                                 
'      caption 0,str$(px%)+","+str$(py%)+"  "+txt$    
     params%(2) = px%                    : ' position de début d'impression
     params%(3) = py%
     params%(4) = adr(txt$)              : ' ligne de texte
     ' impression de la ligne
     hdc% = handle_canvas(11)
     CNV% = dll_call2("GetCanvas",object_internal(11),adr(hdc%))
     res% = dll_call3("DrawOnCanvas",CNV%,5,adr(params%))
     CNV% = dll_call1("FreeCanvas",CNV%)
     ' assurer l'affichage
     2d_image_copy 14,0,0,wlarg%,whaut%
     display  
     2d_image_paste 14,0,0
     pause 100
     2d_target_is 111
     2d_image_paste 14,xpos%,ypos%
     pause 200
     2d_target_is 11
     display
     ' préparer la position de la ligne suivangte
     px% = px% + dx%
     py% = py% + dy%
   next i%
 end_if
 
 actif% = 1
 caption 44,""
 mark_off 63 : mark_off 631
'  message "Pointe en "+str$(mousex%)+","+str$(mousey%)+"  Origine%="+str$(Origine%)
end_sub


sub annuler()
 if Undo%=0          : ' ceci ne devrait jamais arriver...
   inactive 451
   exit_sub
 end_if
 2d_target_is 111
 2d_image_paste 3000+Undo%,UndoPos%(Undo%,0),UndoPos%(Undo%,1)
 display
 2d_image_copy 14,xpos%,ypos%,xpos%+wlarg%,ypos%+whaut%
 display
 2d_target_is 11
 2d_image_paste 14,0,0
 display
 delete 3000+Undo%                  : ' supprimer l'image mémorisée
 Undo% = Undo% - 1                  : ' "oublier" cette étape
 if Undo%=0 then inactive 451       : ' plus rien en mémoire ? désactiver le outon
end_sub


sub scroll()
 xpos% = position(101)
 ypos% = position(102)
 off_change 101 : off_change 102
 2d_target_is 111
 2d_image_copy 14,xpos%,ypos%,xpos%+wlarg%,ypos%+whaut%
 pause 100
 2d_target_is 11
 2d_image_paste 14,0,0
 pause 100
 on_change 101,scroll : on_change 102,scroll
end_sub


sub RGB(c%)
 RR% = bin_and(c%,255)
 GG% = bin_and(c%,hex("FF00"))/256
 BB% = (bin_and(c%,hex("FF0000"))/256)/256
end_sub


sub changecouleur(n%)
 dim_local c%
 c% = position(n%)
 select n%
   case 503
     RR% = c%
   case 506
     GG% = c%
   case 509
     BB% = c%
 end_select
 caption n%+1,str$(c%)
 select nCouleur%
   case 1:     ' bourdure
     color 53,RR%,GG%,BB%
     CouleurBord% = (BB%*256+GG%)*256+RR%
   case 2:     ' remplissage
     color 56,RR%,GG%,BB%
     CouleurRemplissage% = (BB%*256+GG%)*256+RR%
   case 3:     ' texte
     color 59,RR%,GG%,BB%
     CouleurText% = (BB%*256+GG%)*256+RR%
 end_select
end_sub


sub couleur()
 inactive 0
 if number_click=54 then nCouleur% = 1   : ' couleur de la bordure
 if number_click=57 then nCouleur% = 2   : ' couleur de remplissage
 if number_click=60 then nCouleur% = 3   : ' couleur du texte
 select nCouleur%
   case 1:    ' couleur de la bordure
     caption 501,"Couleur de la bordure"
     RGB(CouleurBord%)
     position 503,RR%
     caption 504,str$(RR%)
     position 506,GG%
     caption 507,str$(GG%)
     position 509,BB%
     caption 510,str$(BB%)
   case 2:    ' couleur de remplissage
     caption 501,"Couleur de remplissage"
     RGB(CouleurRemplissage%)
     position 503,RR%
     caption 504,str$(RR%)
     position 506,GG%
     caption 507,str$(GG%)
     position 509,BB%
     caption 510,str$(BB%)
   case 3:    ' couleur du texte
     caption 501,"Couleur du texte"
     RGB(CouleurText%)
     position 503,RR%
     caption 504,str$(RR%)
     position 506,GG%
     caption 507,str$(GG%)
     position 509,BB%
     caption 510,str$(BB%)
 end_select
 show 500
end_sub


sub Formater()
 dim_local s1$, s2$
 if checked(63)=1     : ' texte centré
   s1$ = " "
   s2$ = " "
 end_if
 if checked(631)=1    : ' texte cadré à droite
   s1$ = " "
 end_if
 if len(s1$+s2$)=0 then exit_sub
   dim_local wRect%, hRect%          : ' dimensions du rectangle ciblé
   dim_local wtxt%, htxt%            : ' dimensions du texte imprimé
   wRect% = bulle%(2) - bulle%(0)    : ' dimensions du rectangle de la bulle
   hRect% = bulle%(3) - bulle%(0)
   font_name 112,pol$
   font_size 112,pitch%
   if checked(65)=1
     font_bold 112
   else
     font_bold_off 112
   end_if
   if checked(66)=1
     font_italic 112
   else
     font_italic_off 112
   end_if
   if checked(67)=1
     font_underline 112
   else
     font_underline_off 112
   end_if
   if checked(68)=1
     font_strike 112
     else
     font_strike_off 112
   end_if      
   wtxt% = text_width(txt$,112)
   htxt% = text_height(txt$,112)
   while wtxt%<wRect%
     txt$ = s1$ + txt$ + s2$
     wtxt% = text_width(txt$,112)
     htxt% = text_height(txt$,112)
   end_while  
end_sub
Le lapsus "clavis" est corrigé !
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Klaus

avatar

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

MessageSujet: Re: Annoter une image avec des bulles de texte   Mar 4 Avr 2017 - 18:38

Une petite amélioration lors du traçage d'une bulle. Au moment de positionner la pointe de la flèche par un clic droit, un petit cercle est dessiné pour le visualiser. Puis, le programme passe en attente de la validation, et on ne peut plus déplacer la pointe.

Ceci est corrigé maintenant. On peut cliquer à droite autant de fois qu'il faut pour bien positionner la pointe de la flèche. Le cercle déposé avant le deuxième clic droit disparaît, on nouveau cercle apparaît, et c'est ce point qui sera la pmointe de la flèche (toujours en-dehors du rectangle de la bulle !). Cette opération peut être répétée autant de fois que nécessaire, et le cycle est clos par la validation de la bulle.

Voici le code adapté:
Code:
' annoter_une_image.bas

' Cet utilitaire permet de:
'  - charger une image
'  - y placer des bulles de texte
'  - sauvegarder le résultat obtenu

dll_on "KGF.dll"

labels()
variables()
form0()
menus()

end

nouveau:
  nouveau()
  return
 
ouvrir:
  ouvrir()
  return
 
enregistrer:
  enregistrer()
  return
 
retablir:
  if inactive(341)=1 then return
  retablir(fichier$)
  return
 
enregistrersous:
  enregistrersous()
  return
 
sortir:
  sortir()
  return
 
tracer:
  tracer()
  return
 
valider:
  valider()
  return
 
annuler:
  annuler()
  return
 
MouseDown:
  MouseDown()
  return

MouseMove:
  off_mouse_move 11
  MouseMove()
  on_mouse_move 11,MouseMove
  return
 
scroll:
  scroll()
  return
 
couleur:
  couleur()
  return
 
couleurok:
  hide 500
  to_foreground 0
  active 0
  set_focus 43
  return
 
changecouleur:
  changecouleur(number_change)
  return
 

sub labels()
  label nouveau, ouvrir, enregistrer, retablir, enregistrersous, sortir
  label tracer, MouseDown, MouseMove, valider, annuler, scroll
  label couleur, couleurok, changecouleur

end_sub


sub variables()
  dim no%, d%, res%, typ%
  dim actif%                  : ' flag "une image est présente, modifiée et non sauvegardée"
  dim fichier$                : ' nom du fichier chargé dans le picture 11
  dim larg%, haut%            : ' dimensions réelles de l'image du fichier chargé
  dim wlarg%, whaut%          : ' dimensions réelles de du picture 11
  dim mousex%, mousey%        : ' coordonnées de la souris
  dim bulle%(3)              : ' dimensions de la bulle (types 1...3)
  dim pointe%(1)              : ' coordonnées de la pointe
  dim TypeTrace%              : ' type de traçage  0=rien  1=bulle 2=pointe 3=prêt à valider
  dim Origine%                : ' origine de la flèche: 0=TL 1=TR 2=BR 3=BL 4=T B=R 6=B 7=L
  dim down%                  : ' flag "bouton gauche de la souris est enfoncé"
  dim hdc%                    : ' reçoit handle_canvas(11)
  dim CNV%                    : ' identifiant du canvas pour le dessin
  dim Params%(20)            : ' paramètres pour DrawOnCanvas
  dim xpos%, ypos%            : ' positions de la fenêtre de visualisation
  dim CouleurBord%            : ' code couleur pour la bordure
  dim CouleurRemplissage%    : ' code couleur pour le remplissage
  dim CouleurText%            : ' couleur du texte à imprimer
  dim nCouleur%              : ' indice du type de couleur
  dim RR%, GG%, BB%          : ' couleurs RGB décodées
  dim Undo%                  : ' nombre d'étapes mémorisées pour "Annuler"
  dim MUndo% : MUndo% = 100  : ' nombre maxi d'etapes d'annulation
  dim UndoPos%(MUndo%,1)      : ' sauvegarde des xpos% et ypos% pour "Annuler"
  dim txt$                    : ' une ligne de texte à imprimer dans la bulle
  dim pitch%                  : ' taille de la police d'impression
end_sub


sub form0()
  dim_local res%, i%
  full_space 0
 
  ' les outils
  container 1 : height 1,height_client(0) - 30 : width 1,300 : caption 1,"Outils"

  ' les outils "Fichiers"
  container 31 : parent 31,1 : top 31,15 : left 31,15 : width 31,width_client(1)-30
    color 31,225,225,225
    caption 31,"Fichiers"
  button 32 : parent 32,31 : top 32,15 : left 32,15 : height 32,20 : width 32,70 : caption 32,"Nouveau"
    on_click 32,nouveau
  button 33 : parent 33,31 : top 33,15 : left 33,100 : height 33,20 : width 33,50 : caption 33,"Ouvrir"
    on_click 33,ouvrir 
  button 34 : parent 34,31 : top 34,15 : left 34,170 : height 34,20 : width 34,70 : caption 34,"Enregistrer"
    on_click 34,enregistrer 
  button 341 : parent 341,31 : top 341,40 : left 341,15 : height 341,20 : width 341,50 : caption 341,"Rétablir"
    on_click 341,retablir : inactive 341
  button 35 : parent 35,31 : top 35,40 : left 35,75 : height 35,20 : width 35,100 : caption 35,"Enregistrer sous"
    on_click 35,enregistrersous 
  button 36 : parent 36,31 : top 36,75 : left 36,95 : height 36,20 : width 36,60 : caption 36,"Sortir"
    on_click 36,sortir
  alpha 37 : parent 37,31 : top 37,45 : left 37,200 : caption 37,"W; " 
  alpha 38 : parent 38,31 : top 38,65 : left 38,200 : caption 38,"H; " 
   
' les outils  "Bulles"
  container 41 : parent 41,1 : top 41,15+height(31)+5 : left 41,15
    width 41,width_client(1)-30 : height 41,height_client(1)-top(41)-10
    color 41,225,225,225
    caption 41,"Bulles"
  combo 42 : parent 42,41 : top 42,15 : left 42,15 : width 42,width_client(41)-30
    item_add 42,"Bulle rectangle"
    item_add 42,"Bulle rectangle arrondi"
    item_add 42,"Bulle ellipse"
  res% = dll_call2("SelectComboBoxItem",handle(42),1)
  button 43 : parent 43,41 : top 43,top(42)+height(42)+5: left 43,15 : height 43,20
    caption 43,"Tracer bulle" : on_click 43,tracer
  alpha 44 : parent 44,41 : top 44,top(43)+30 : left 44,15 : font_bold 44
  button 45 : parent 45,41 : top 45,top(43) : left 45,95 : height 45,20
    caption 45,"Valider bulle" : on_click 45,valider
  button 451 : parent 451,41 : top 451,top(43) : left 451,175 : height 451,20
    caption 451,"Annuler bulle" : on_click 451,annuler : inactive 451     
  alpha 46 : parent 46,41 : top 46,top(44)+30 : left 46,15
    caption 46,"Rayon de courbure d'arrondi:"
  spin 47 : parent 47,41 : top 47,top(46) : left 47,160 : width 47,60
    min 47,0 : max 47,50 : position 47,10
  alpha 48 : parent 48,41 : top 48,top(46)+30 : left 48,15
    caption 48,"Diamètre de la base de flèche:"
  spin 49 : parent 49,41 : top 49,top(48) : left 49,160 : width 49,60
    min 49,5 : max 49,200 : position 49,20 
  alpha 50 : parent 50,41 : top 50,top(48)+30 : left 50,15
    caption 50,"Epaisseur de la bordure:"
  spin 51 : parent 51,41 : top 51,top(50) : left 51,160 : width 51,60
    min 51,1 : max 51,20 : position 51,1

  alpha 52 : parent 52,41 : top 52,top(50)+30 : left 52,15
    caption 52,"Couleur de la bordure:"
  picture 53 : parent 53,41 : top 53,top(52) : left 53,160 : width 53,30 : height 53,20
    color 53,0,0,0
  button 54 : parent 54,41 : top 54,top(52) : left 54,left(53)+35 : width 54,30 : height 54,20
    caption 54,"..." : font_bold 54 : on_click 54,couleur
   
  alpha 55 : parent 55,41 : top 55,top(52)+30 : left 55,15
    caption 55,"Couleur de remplissage:"
  picture 56 : parent 56,41 : top 56,top(55) : left 56,160 : width 56,30 : height 56,20
    color 56,255,255,0
  button 57 : parent 57,41 : top 57,top(55) : left 57,left(56)+35 : width 57,30 : height 57,20
    caption 57,"..." : font_bold 57 : on_click 57,couleur

  check 571 : parent 571,41 : top 571,top(55)+30 : left 571,160
    caption 571,"Fond transparent" : width 571,100

  alpha 58 : parent 58,41 : top 58,top(571)+30 : left 58,15
    caption 58,"Couleur du texte:"
  picture 59 : parent 59,41 : top 59,top(58) : left 59,160 : width 59,30 : height 59,20
    color 59,0,0,0
  button 60 : parent 60,41 : top 60,top(58) : left 60,left(59)+35 : width 60,30 : height 60,20
    caption 60,"..." : font_bold 60 : on_click 60,couleur

  memo 61 : parent 61,41 : top 61,top(58)+30 : left 61,15 : width 61,width_client(41)-30
    height 61,150 : bar_both 61 : font_size 61,10
  combo 62 : parent 62,41 : top 62,top(61)+height(61)+10 : left 62,15
    width 62,120
    item_add 62,"Gauche -> Droite"
    item_add 62,"Bas -> Haut"
    item_add 62,"Haut-> Bas"
    item_add 62,"Droite -> Gauche"
  res% = dll_call2("SelectComboBoxItem",handle(62),1)
  option 63 : parent 63,41 : top 63,top(62) : left 63,140 : caption 63,"Centré" 
  option 631 : parent 631,41 : top 631,top(62) : left 631,200 : caption 631,"à Droite" 
  combo 64 : parent 64,41 : top 64,top(62)+30 : left 64,15
    width 64,width_client(41)-30 : font_names_load 64
  for i%=1 to count(64)
    if item_read$(64,i%)="Arial"
      res% = dll_call2("SelectComboBoxItem",handle(64),i%)     
      exit_for
    end_if
  next i%
  check 65 : parent 65,41 : top 65,top(64)+30 : left 65,15 : caption 65,"G" : font_bold 65 
  check 66 : parent 66,41 : top 66,top(65) : left 66,60 : caption 66,"I" : font_italic 66 
  check 67 : parent 67,41 : top 67,top(65) : left 67,105 : caption 67,"S" : font_underline 67 
  check 68 : parent 68,41 : top 68,top(65) : left 68,150 : caption 68,"B" : font_strike 68 
  combo 69 : parent 69,41 : top 69,top(65) : left 69,200 : width 69,width_client(41)-215
    item_add 69,"8"
    item_add 69,"10"
    item_add 69,"12"
    item_add 69,"14"
    item_add 69,"16"
    item_add 69,"18"
    item_add 69,"20"
    item_add 69,"22"
    item_add 69,"24"
    item_add 69,"28"
    item_add 69,"32"
    item_add 69,"36"
    item_add 69,"48"
    res% = dll_call2("SelectComboBoxItem",handle(69),3)     
   
' l'image
  container 2 : left 2,300 : height 2,height_client(0) - 30 : width 2,width_client(0)-300
    caption 2,"Image"
  wlarg% = width_client(2)-30
  whaut% = height_client(2)-35
  picture 11 : parent 11,2
    top 11,15 : left 11,10 : width 11,wlarg% : height 11,whaut%
    color 11,225,225,0 : parent 11,2
  2d_target_is 11
  scroll_bar 101 : parent 101,2
    height 101,20 : width 101,width_client(2)-20 : top 101,height(2)-20
    min 101,0 : max 101,width_client(2)-20 : inactive 101 : on_change 101,scroll
  scroll_bar 102 : parent 102,2 : vertical 102
    width 102,20 : height 102,height_client(2)-20 : left 102,width(2)-20
    min 102,0 : max 102,height_client(2)-20 : inactive 102 : on_change 101,scroll
  form 110 : full_space 110 : hide 110
  picture 111 : parent 111,110 : width 111,wlarg% : height 111,whaut%
                           
  ' la fenêtre "sablier"
  form 20 : hide 20 : border_hide 20 : width 20,400 : height 20,100
    top 20,(screen_y-height(20))/2 : left 20,(screen_x-width(20))/2
  panel 21 : parent 21,20 : full_space 21 : color 21,255,192,192
    font_size 21,24
    caption 21,"Opération en cours..."
   
  ' la fenêtre de sélection de couleur
  form 500 : hide 500 : caption 500,"Sélection de couleur" : width 500,500
    top 500,(screen_y-height(500))/2 : left 500,(screen_x-width(500))/2
    on_close 500,couleurok
  alpha 501 : parent 501,500 : top 501,10 : left 501,10 : font_bold 501
 
  alpha 502 : parent 502,500 : top 502,40 : left 502,10 : font_bold 501
    font_bold 502 : caption 502,"R"
  scroll_bar 503 : parent 503,500 : top 503,40 : left 503,30
    width 503,width_client(500)-100 : min 503,0 : max 503,255
    on_change 503,changecouleur
  alpha 504 : parent 504,500 : top 504,40 : left 504,left(503)+width(503)+20
   
  alpha 505 : parent 505,500 : top 505,70 : left 505,10 : font_bold 505
    font_bold 505 : caption 505,"G"
  scroll_bar 506 : parent 506,500 : top 506,70 : left 506,30
    width 506,width_client(500)-100 : min 506,0 : max 506,255
    on_change 506,changecouleur
  alpha 507 : parent 507,500 : top 507,70 : left 507,left(506)+width(506)+20
   
  alpha 508 : parent 508,500 : top 508,100 : left 508,10 : font_bold 508
    font_bold 508 : caption 508,"B"
  scroll_bar 509 : parent 509,500 : top 509,100 : left 509,30
    width 509,width_client(500)-100 : min 509,0 : max 509,255
    on_change 509,changecouleur
  alpha 510 : parent 510,500 : top 510,100 : left 510,left(509)+width(509)+20


  ' objets invisibles
  open_dialog 12
  save_dialog 13
  image 14                : ' pour mémoriser l'image avant toute opération
  image 15 : hide 15      : ' pour déplacer la pointe de la flèche si TypeTrace%=3
  picture 112 : hide 112  : ' pour déterminer les dimensions d'un texte
                           
  actif% = 0
  larg% = width(11)
  haut% = height(11)
  CouleurBord%        = 0                    : ' noir
  CouleurRemplissage%  = (0*256+255)*256+255  : ' jaune
  CouleurText%        = 0                    : ' noir
  Undo%                = 0                    : ' aucune situation pour "Annuler"
  2d_target_is 11
  2d_image_copy 14,0,0,wlarg%,whaut%
  caption 0,"Annotation"
end_sub


sub menus()
  dim_local no1%, no2%
  no% = 1000 : main_menu no%
  no% = no% + 1 : sub_menu no% : parent no%,1000 : no1% = no% : caption no%,"Fichiers"
    no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"Nouveau"
      on_click no%,nouveau
    no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"Ouvrir..."
      on_click no%,ouvrir
    no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"Enregistrer"
      on_click no%,enregistrer
    no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"Enregistrer sous..."
      on_click no%,enregistrersous
    no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"-"
    no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"Rétablir"
      on_click no%,retablir
    no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"-"
    no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"Sortir"
      on_click no%,sortir
  no% = no% + 1 : sub_menu no% : parent no%,1000 : no1% = no% : caption no%,"Bulles"
end_sub


sub nouveau()
  if actif%=1
    if message_confirmation_yes_no("L'image actuelle n'est pas enregistrée. Sortir quand-même ?")<>1 then exit_sub
  end_if
  if CNV%<>0
    CNV% = dll_call1("FreeCanvas",CNV%)
  end_if
  actif% = 0
  fichier$ = ""
  2d_clear
  stretch_off 11
  full_space 11
  TypeTrace% = 0
'  width 11,width(2)-20 : height 11,height(2)-20
  larg% = wlarg%
  haut% = whaut%
  clipboard_copy 11
  clipboard_paste 111
  width 111,larg% : height 111,haut%
  caption 37,"W: "+str$(larg%)
  caption 38,"H: "+str$(haut%)
  inactive 101 : inactive 102
  hdc% = handle_canvas(11)
  CNV% = dll_call2("GetCanvas",object_internal(11),adr(hdc%))
  xpos% = 0 : ypos% = 0
  CouleurBord%        = 0                    : ' noir
  CouleurRemplissage%  = (0*256+255)*256+255  : ' jaune
  CouleurText%        = 0                    : ' noir
  color 53,0,0,0
  color 56,255,255,0
  color 59,0,0,0
  2d_target_is 11
  2d_image_copy 14,0,0,wlarg%,whaut%
  if Undo%>0
    dim_local i%
    for i%=1 to i%
      if object_exists(3000+i%)=1 then delete 3000+i%
    next i%
    Undo% = 0
  end_if
  inactive 451 : inactive 341
  mark_off 63 : mark_off 631
  caption 0,"Annotation"
end_sub


sub ouvrir()
  dim_local f$
  filter 12,"Images JPG|*.jpg"
  f$ = file_name$(12)
  if f$="_" then exit_sub
  if file_exists(f$)=0
    message "Fichier non trouvé"
    exit_sub
  end_if
  retablir(f$)
end_sub

sub retablir(f$)
  dim_local res%, w%, h%
  if CNV%<>0
    CNV% = dll_call1("FreeCanvas",CNV%)
  end_if
  inactive 0 : show 20 : display
  res% = dll_call3("AnalyzeImageFile",adr(f$),adr(larg%),adr(haut%))
  off_change 101 : position 101,0 : on_change 101,scroll
  if larg%>wlarg%
    min 101,0 : max 101,larg%-wlarg%
  else
    inactive 101
  end_if
  off_change 102 : position 102,0 : on_change 102,scroll
  if haut%>whaut%
    min 102,0 : max 102,haut%-whaut%
    position 102,0
  else
    inactive 102
  end_if
  caption 37,"W: "+str$(larg%)
  caption 38,"H: "+str$(haut%)
  width 110,larg%+30 : height 110,haut%+100
  width 111,larg% : height 111,haut%
                                   
  fichier$ = f$
  res% = dll_call1("LoadAnyImageFile",adr(fichier$))
  clipboard_paste 111
  2d_target_is 111
 
  2d_image_copy 14,0,0,wlarg%,whaut%
  2d_target_is 11
  2d_image_paste 14,0,0
 
  caption 0,"Annotation de "+fichier$
  TypeTrace% = 0
  xpos% = 0 : ypos% = 0
  CouleurBord%        = 0                    : ' noir
  CouleurRemplissage%  = (0*256+255)*256+255  : ' jaune
  CouleurText%        = 0                    : ' noir
  color 53,0,0,0
  color 56,255,255,0
  color 59,0,0,0
  2d_target_is 11
  2d_image_copy 14,0,0,wlarg%,whaut%
  if Undo%>0
    dim_local i%
    for i%=1 to i%
      if object_exists(3000+i%)=1 then delete 3000+i%
    next i%
    Undo% = 0
  end_if
  inactive 451 : active 341
  mark_off 63 : mark_off 631
  hide 20: active 0
end_sub


sub enregistrer()
  dim_local res%
  if fichier$=""
    message "Pas d'image ouverte"
    exit_sub
  end_if
  inactive 0 : show 20 : display
'  clipboard_copy 11
  clipboard_copy 111
  pause 100
  res% = dll_call1("SaveAnyImageFile",adr(fichier$))
  actif% = 0
  caption 0,"Annotation de "+fichier$
  hide 20 : active 0
end_sub


sub enregistrersous()
  dim_local f$, res%
  f$ = file_name$(13)
  if f$="_" then exit_sub
  if file_exists(f$)=1
    if message_confirmation_yes_no("Ce fichier existe déjà. Remplacer ?")<>1 then exit_sub
  end_if
  inactive 0 : show 20 : display
  clipboard_copy 111
  pause 300
  res% = dll_call1("SaveAnyImageFile",adr(f$))
  fichier$ = f$
  actif% = 0
  caption 0,"Annotation de "+fichier$
  hide 20 : active 0
end_sub


sub sortir()
  if actif%=1
    if message_confirmation_yes_no("L'image actuelle n'est pas enregistrée. Sortir quand-même ?")<>1 then exit_sub
  end_if
  terminate
end_sub


sub tracer()
  TypeTrace% = 1                        : ' on trace la bulle
  on_mouse_down 11,MouseDown
  caption 44,"Tracer le rectangle délimiteur..."
end_sub


sub MouseDown()
  off_mouse_down 11
  mousex% = mouse_x_left_down(11) : ' *(larg%/wlarg%)
  mousey% = mouse_y_left_down(11) : ' *(haut%/whaut%)
  select TypeTrace%
    case 1:    ' bulle
      bulle%(0) = mousex%
      bulle%(1) = mousey%
      bulle%(2) = mousex%
      bulle%(3) = mousey%
    case 2:    ' pointe
      down% = dll_call1("CheckMouseButton",2)
      if down%=1                : ' est-ce que le bouton droit est enfoncé ?
        mousex% = mouse_x_position(11) : ' *(larg%/wlarg%)
        mousey% = mouse_y_position(11) : ' *(haut%/whaut%)
        Origine% = 0
        if mousex%<bulle%(0)
          if mousey%<bulle%(1)
            Origine% = 0            : ' TL
          else
            if mousey%>bulle%(3)
              Origine% = 3          : ' BL
            else
              Origine% = 7          : ' L
            end_if
          end_if
        else
          if mousex%>bulle%(2)
            if mousey%<bulle%(1)
              Origine% = 1          : ' TR
            else
              if mousey%>bulle%(3)
                Origine% = 2        : ' BR
              else
                Origine% = 5        : ' R
              end_if
            end_if
          else
            if Mousey%<bulle%(1)
              Origine% = 4          : ' T
            else
              if Mousey%>bulle%(3)
                Origine% = 6        : ' B
              else
                ' ici, on a cliqué sur le bord ou à l'intérieur !
                ' donc, on ignore ce clic !
                on_mouse_down 11,MouseDown
                return
              end_if
            end_if
          end_if
        end_if
        2d_image_copy 15,0,0,wlarg%,whaut%
        2d_circle Mousex%,Mousey%,5
        set_focus 45
        TypeTrace% = 3
        caption 44,"Valdez la bulle maintenant..."
        on_mouse_down 11,MouseDown
        return
      end_if
      on_mouse_down 11,MouseDown
      return
    case 3:    ' pointe s'il y a déjà une pointe positionnée
      down% = dll_call1("CheckMouseButton",2)
      if down%=1                : ' est-ce que le bouton droit est enfoncé ?
        2d_image_paste 15,xpos%,ypos%
        mousex% = mouse_x_position(11) : ' *(larg%/wlarg%)
        mousey% = mouse_y_position(11) : ' *(haut%/whaut%)
        Origine% = 0
        if mousex%<bulle%(0)
          if mousey%<bulle%(1)
            Origine% = 0            : ' TL
          else
            if mousey%>bulle%(3)
              Origine% = 3          : ' BL
            else
              Origine% = 7          : ' L
            end_if
          end_if
        else
          if mousex%>bulle%(2)
            if mousey%<bulle%(1)
              Origine% = 1          : ' TR
            else
              if mousey%>bulle%(3)
                Origine% = 2        : ' BR
              else
                Origine% = 5        : ' R
              end_if
            end_if
          else
            if Mousey%<bulle%(1)
              Origine% = 4          : ' T
            else
              if Mousey%>bulle%(3)
                Origine% = 6        : ' B
              else
                ' ici, on a cliqué sur le bord ou à l'intérieur !
                ' donc, on ignore ce clic !
                on_mouse_down 11,MouseDown
                return
              end_if
            end_if
          end_if
        end_if
        2d_circle Mousex%,Mousey%,5
        set_focus 45
        TypeTrace% = 3
        caption 44,"Valdez la bulle maintenant..."
        on_mouse_down 11,MouseDown
        return
      end_if
      on_mouse_down 11,MouseDown
      return     
  end_select
  down% = 1
  on_mouse_move 11,MouseMove
end_sub


sub MouseMove()
  d% = dll_call1("CheckMouseButton",1)
  down% = down% * d%
  if down%=0
    TypeTrace% = 2
    caption 44,"Clic droit pour positionner la pointe..."
    on_mouse_down 11,MouseDown
    return
  end_if

  caption 0,str$(mouse_x_position(11))+","+str$(mouse_y_position(11))
  mousex% = mouse_x_position(11) : ' *(larg%/wlarg%)
  mousey% = mouse_y_position(11) : ' *(haut%/whaut%)
  bulle%(2) = mousex%
  bulle%(3) = mousey%
  2d_image_paste 14,0,0
  display
  2d_poly_from bulle%(0),bulle%(1)
  2d_poly_to bulle%(2),bulle%(1)
  2d_poly_to bulle%(2),bulle%(3)
  2d_poly_to bulle%(0),bulle%(3)
  2d_poly_to bulle%(0),bulle%(1)
  display
end_sub
         
sub valider()
  dim_local i%, px%, py%, dx%, dy%, pol$, dir%, angle%
  dim_local wtxt%, htxt%
  if TypeTrace%<>3 then return
  off_mouse_down 11
  2d_image_paste 14,0,0
  ' mémoriser la situation pour "Annuler"
  if Undo%=MUndo%
   
  end_if
  Undo% = Undo% + 1                    : ' compter la nouvelle mémorisation
  image 3000+Undo%                    : ' créer un image pour memoriser le contenu de l'objet 11
  2d_image_copy 3000+Undo%,0,0,wlarg%,whaut%  : ' mémoriser la partie visible de 11
  UndoPos%(Undo%,0) = xpos%            : ' et mémoriser la position dans l'image globale
  UndoPos%(Undo%,1) = ypos%
  active 451
 
  ' tracer la bulle
  typ% = item_index(42)
  hdc% = handle_canvas(11)
  CNV% = dll_call2("GetCanvas",object_internal(11),adr(hdc%))
  ' paramètres communs à tous les types de bules
      params%(2)  = bulle%(0)              : ' coin en haut à gauche
      params%(3)  = bulle%(1)
      params%(4)  = bulle%(2)              : ' coin en bas à droite
      params%(5)  = bulle%(3)
      params%(6)  = position(51)            : ' épaisseur du trait
      params%(7)  = CouleurBord%            : ' clBlack
      params%(8)  = CouleurRemplissage%    : ' clYellow
      if checked(571)=1 then params%(8)  = -99    : ' transparent
      params%(9)  = position(47)            : ' rayon de l'arrondi
      params%(10) = typ%-1                  : ' type de bulle
      params%(11) = 0                      : ' ./. non utilisé
      params%(12) = Origine%                : ' départ 
      params%(13) = mousex%                : ' position de la pointe
      params%(14) = mousey%
      params%(15) = position(49)            : ' largeur de la flèche à la base
  if typ%>1
    if params%(6)=1 then params%(6) = 2
  end_if
  res% = dll_call3("DrawOnCanvas",CNV%,6,adr(params%))
  display
  CNV% = dll_call1("FreeCanvas",CNV%)
  2d_image_copy 14,0,0,wlarg%,whaut%
  display 
  2d_image_paste 14,0,0
  pause 100
  2d_target_is 111
  2d_image_paste 14,xpos%,ypos%
  pause 200
  2d_target_is 11
  display
 
  ' imprimer le texte dans la bulle
  if count(61)>0
    pitch% = val(text$(69))
    ' 1 = Gauche -> Droite
    ' 2 = Bas -> Haut
    ' 3 = Haut-> Bas
    ' 4 = Droite -> Gauche
    dir% = item_index(62)
    select dir%
      case 1
        px% = bulle%(0) + 10
        py% = bulle%(1) + 10
        dx% = 0
        dy% = pitch%
        angle% = 0
      case 2
        px% = bulle%(0) + 10
        py% = bulle%(3) - 10
        dx% = pitch%
        dy% = 0
        angle% = 90
      case 3
        px% = bulle%(2) - 10
        py% = bulle%(1) + 10
        dx% = 0 - pitch%
        dy% = 0
        angle% = 270
      case 4
        px% = bulle%(2) - 10
        py% = bulle%(3) - 10
        dx% = 0
        dy% = 0 - pitch%
        angle% = 180
    end_select
    pol$ = text$(64) 

    ' paramètres valables pour toutes les lignes
    params%(5) = adr(pol$)              : ' nom de la police
    params%(6) = angle%*10              : ' angle d'inclinaison * 10
    params%(7) = CouleurText%          : ' couleur de la police
    params%(8) = 0                      : ' ./. non utilisé
    params%(9) = pitch%                : ' taille de la police
    params%(10) = checked(65)          : ' gras
    params%(11) = checked(66)          : ' italique
    params%(12) = checked(67)          : ' sousligné
    params%(13) = checked(68)          : ' barré   
   
    for i%=1 to count(61)
      ' paramètres spécifiques à 1 ligne
      txt$ = item_read$(61,i%)
      Formater()                        : ' gérer le centrage ou le cardrage à droite
                                 
'      caption 0,str$(px%)+","+str$(py%)+"  "+txt$   
      params%(2) = px%                    : ' position de début d'impression
      params%(3) = py%
      params%(4) = adr(txt$)              : ' ligne de texte
      ' impression de la ligne
      hdc% = handle_canvas(11)
      CNV% = dll_call2("GetCanvas",object_internal(11),adr(hdc%))
      res% = dll_call3("DrawOnCanvas",CNV%,5,adr(params%))
      CNV% = dll_call1("FreeCanvas",CNV%)
      ' assurer l'affichage
      2d_image_copy 14,0,0,wlarg%,whaut%
      display 
      2d_image_paste 14,0,0
      pause 100
      2d_target_is 111
      2d_image_paste 14,xpos%,ypos%
      pause 200
      2d_target_is 11
      display
      ' préparer la position de la ligne suivangte
      px% = px% + dx%
      py% = py% + dy%
    next i%
  end_if
 
  actif% = 1
  caption 44,""
  mark_off 63 : mark_off 631
'  message "Pointe en "+str$(mousex%)+","+str$(mousey%)+"  Origine%="+str$(Origine%)
end_sub


sub annuler()
  if Undo%=0          : ' ceci ne devrait jamais arriver...
    inactive 451
    exit_sub
  end_if
  2d_target_is 111
  2d_image_paste 3000+Undo%,UndoPos%(Undo%,0),UndoPos%(Undo%,1)
  display
  2d_image_copy 14,xpos%,ypos%,xpos%+wlarg%,ypos%+whaut%
  display
  2d_target_is 11
  2d_image_paste 14,0,0
  display
  delete 3000+Undo%                  : ' supprimer l'image mémorisée
  Undo% = Undo% - 1                  : ' "oublier" cette étape
  if Undo%=0 then inactive 451      : ' plus rien en mémoire ? désactiver le outon
  TypeTrace% = 0                    : ' oublier un éventuel traçage en cours
end_sub


sub scroll()
  xpos% = position(101)
  ypos% = position(102)
  off_change 101 : off_change 102
  2d_target_is 111
  2d_image_copy 14,xpos%,ypos%,xpos%+wlarg%,ypos%+whaut%
  pause 100
  2d_target_is 11
  2d_image_paste 14,0,0
  pause 100
  on_change 101,scroll : on_change 102,scroll
end_sub


sub RGB(c%)
  RR% = bin_and(c%,255)
  GG% = bin_and(c%,hex("FF00"))/256
  BB% = (bin_and(c%,hex("FF0000"))/256)/256
end_sub


sub changecouleur(n%)
  dim_local c%
  c% = position(n%)
  select n%
    case 503
      RR% = c%
    case 506
      GG% = c%
    case 509
      BB% = c%
  end_select
  caption n%+1,str$(c%)
  select nCouleur%
    case 1:    ' bourdure
      color 53,RR%,GG%,BB%
      CouleurBord% = (BB%*256+GG%)*256+RR%
    case 2:    ' remplissage
      color 56,RR%,GG%,BB%
      CouleurRemplissage% = (BB%*256+GG%)*256+RR%
    case 3:    ' texte
      color 59,RR%,GG%,BB%
      CouleurText% = (BB%*256+GG%)*256+RR%
  end_select
end_sub


sub couleur()
  inactive 0
  if number_click=54 then nCouleur% = 1  : ' couleur de la bordure
  if number_click=57 then nCouleur% = 2  : ' couleur de remplissage
  if number_click=60 then nCouleur% = 3  : ' couleur du texte
  select nCouleur%
    case 1:    ' couleur de la bordure
      caption 501,"Couleur de la bordure"
      RGB(CouleurBord%)
      position 503,RR%
      caption 504,str$(RR%)
      position 506,GG%
      caption 507,str$(GG%)
      position 509,BB%
      caption 510,str$(BB%)
    case 2:    ' couleur de remplissage
      caption 501,"Couleur de remplissage"
      RGB(CouleurRemplissage%)
      position 503,RR%
      caption 504,str$(RR%)
      position 506,GG%
      caption 507,str$(GG%)
      position 509,BB%
      caption 510,str$(BB%)
    case 3:    ' couleur du texte
      caption 501,"Couleur du texte"
      RGB(CouleurText%)
      position 503,RR%
      caption 504,str$(RR%)
      position 506,GG%
      caption 507,str$(GG%)
      position 509,BB%
      caption 510,str$(BB%)
  end_select
  show 500
end_sub


sub Formater()
  dim_local s1$, s2$
  if checked(63)=1    : ' texte centré
    s1$ = " "
    s2$ = " "
  end_if
  if checked(631)=1    : ' texte cadré à droite
    s1$ = " "
  end_if
  if len(s1$+s2$)=0 then exit_sub
    dim_local wRect%, hRect%          : ' dimensions du rectangle ciblé
    dim_local wtxt%, htxt%            : ' dimensions du texte imprimé
    wRect% = bulle%(2) - bulle%(0)    : ' dimensions du rectangle de la bulle
    hRect% = bulle%(3) - bulle%(0)
    font_name 112,pol$
    font_size 112,pitch%
    if checked(65)=1
      font_bold 112
    else
      font_bold_off 112
    end_if
    if checked(66)=1
      font_italic 112
    else
      font_italic_off 112
    end_if
    if checked(67)=1
      font_underline 112
    else
      font_underline_off 112
    end_if
    if checked(68)=1
      font_strike 112
      else
      font_strike_off 112
    end_if     
    wtxt% = text_width(txt$,112)
    htxt% = text_height(txt$,112)
    while wtxt%<wRect%
      txt$ = s1$ + txt$ + s2$
      wtxt% = text_width(txt$,112)
      htxt% = text_height(txt$,112)
    end_while 
end_sub
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Klaus

avatar

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

MessageSujet: Re: Annoter une image avec des bulles de texte   Mer 5 Avr 2017 - 21:57

Nouvelle version, avec une correction de la gestion du cadrage (gauche, centré, droit), à l'aide de la version V07.29 de KGF.dll de ce jour.
Code:
' annoter_une_image.bas

' Cet utilitaire permet de:
'  - charger une image
'  - y placer des bulles de texte
'  - sauvegarder le résultat obtenu

dll_on "KGF.dll"

labels()
variables()
form0()
menus()

end

nouveau:
  nouveau()
  return
 
ouvrir:
  ouvrir()
  return
 
enregistrer:
  enregistrer()
  return
 
retablir:
  if inactive(341)=1 then return
  retablir(fichier$)
  return
 
enregistrersous:
  enregistrersous()
  return
 
sortir:
  sortir()
  return
 
tracer:
  tracer()
  return
 
valider:
  valider()
  return
 
annuler:
  annuler()
  return
 
MouseDown:
  MouseDown()
  return

MouseMove:
  off_mouse_move 11
  MouseMove()
  on_mouse_move 11,MouseMove
  return
 
scroll:
  scroll()
  return
 
couleur:
  couleur()
  return
 
couleurok:
  hide 500
  to_foreground 0
  active 0
  set_focus 43
  return
 
changecouleur:
  changecouleur(number_change)
  return
 

sub labels()
  label nouveau, ouvrir, enregistrer, retablir, enregistrersous, sortir
  label tracer, MouseDown, MouseMove, valider, annuler, scroll
  label couleur, couleurok, changecouleur

end_sub


sub variables()
  dim no%, d%, res%, typ%
  dim actif%                  : ' flag "une image est présente, modifiée et non sauvegardée"
  dim fichier$                : ' nom du fichier chargé dans le picture 11
  dim larg%, haut%            : ' dimensions réelles de l'image du fichier chargé
  dim wlarg%, whaut%          : ' dimensions réelles de du picture 11
  dim mousex%, mousey%        : ' coordonnées de la souris
  dim bulle%(3)              : ' dimensions de la bulle (types 1...3)
  dim pointe%(1)              : ' coordonnées de la pointe
  dim TypeTrace%              : ' type de traçage  0=rien  1=bulle 2=pointe 3=prêt à valider
  dim Origine%                : ' origine de la flèche: 0=TL 1=TR 2=BR 3=BL 4=T B=R 6=B 7=L
  dim down%                  : ' flag "bouton gauche de la souris est enfoncé"
  dim hdc%                    : ' reçoit handle_canvas(11)
  dim CNV%                    : ' identifiant du canvas pour le dessin
  dim Params%(20)            : ' paramètres pour DrawOnCanvas
  dim xpos%, ypos%            : ' positions de la fenêtre de visualisation
  dim CouleurBord%            : ' code couleur pour la bordure
  dim CouleurRemplissage%    : ' code couleur pour le remplissage
  dim CouleurText%            : ' couleur du texte à imprimer
  dim nCouleur%              : ' indice du type de couleur
  dim RR%, GG%, BB%          : ' couleurs RGB décodées
  dim Undo%                  : ' nombre d'étapes mémorisées pour "Annuler"
  dim MUndo% : MUndo% = 100  : ' nombre maxi d'etapes d'annulation
  dim UndoPos%(MUndo%,1)      : ' sauvegarde des xpos% et ypos% pour "Annuler"
  dim txt$                    : ' une ligne de texte à imprimer dans la bulle
  dim pitch%                  : ' taille de la police d'impression
end_sub


sub form0()
  dim_local res%, i%
  full_space 0
 
  ' les outils
  container 1 : height 1,height_client(0) - 30 : width 1,300 : caption 1,"Outils"

  ' les outils "Fichiers"
  container 31 : parent 31,1 : top 31,15 : left 31,15 : width 31,width_client(1)-30
    color 31,225,225,225
    caption 31,"Fichiers"
  button 32 : parent 32,31 : top 32,15 : left 32,15 : height 32,20 : width 32,70 : caption 32,"Nouveau"
    on_click 32,nouveau
  button 33 : parent 33,31 : top 33,15 : left 33,100 : height 33,20 : width 33,50 : caption 33,"Ouvrir"
    on_click 33,ouvrir 
  button 34 : parent 34,31 : top 34,15 : left 34,170 : height 34,20 : width 34,70 : caption 34,"Enregistrer"
    on_click 34,enregistrer 
  button 341 : parent 341,31 : top 341,40 : left 341,15 : height 341,20 : width 341,50 : caption 341,"Rétablir"
    on_click 341,retablir : inactive 341
  button 35 : parent 35,31 : top 35,40 : left 35,75 : height 35,20 : width 35,100 : caption 35,"Enregistrer sous"
    on_click 35,enregistrersous 
  button 36 : parent 36,31 : top 36,75 : left 36,95 : height 36,20 : width 36,60 : caption 36,"Sortir"
    on_click 36,sortir
  alpha 37 : parent 37,31 : top 37,45 : left 37,200 : caption 37,"W; " 
  alpha 38 : parent 38,31 : top 38,65 : left 38,200 : caption 38,"H; " 
   
' les outils  "Bulles"
  container 41 : parent 41,1 : top 41,15+height(31)+5 : left 41,15
    width 41,width_client(1)-30 : height 41,height_client(1)-top(41)-10
    color 41,225,225,225
    caption 41,"Bulles"
  combo 42 : parent 42,41 : top 42,15 : left 42,15 : width 42,width_client(41)-30
    item_add 42,"Bulle rectangle"
    item_add 42,"Bulle rectangle arrondi"
    item_add 42,"Bulle ellipse"
  res% = dll_call2("SelectComboBoxItem",handle(42),1)
  button 43 : parent 43,41 : top 43,top(42)+height(42)+5: left 43,15 : height 43,20
    caption 43,"Tracer bulle" : on_click 43,tracer
  alpha 44 : parent 44,41 : top 44,top(43)+30 : left 44,15 : font_bold 44
  button 45 : parent 45,41 : top 45,top(43) : left 45,95 : height 45,20
    caption 45,"Valider bulle" : on_click 45,valider
  button 451 : parent 451,41 : top 451,top(43) : left 451,175 : height 451,20
    caption 451,"Annuler bulle" : on_click 451,annuler : inactive 451     
  alpha 46 : parent 46,41 : top 46,top(44)+30 : left 46,15
    caption 46,"Rayon de courbure d'arrondi:"
  spin 47 : parent 47,41 : top 47,top(46) : left 47,160 : width 47,60
    min 47,0 : max 47,50 : position 47,10
  alpha 48 : parent 48,41 : top 48,top(46)+30 : left 48,15
    caption 48,"Diamètre de la base de flèche:"
  spin 49 : parent 49,41 : top 49,top(48) : left 49,160 : width 49,60
    min 49,5 : max 49,200 : position 49,20 
  alpha 50 : parent 50,41 : top 50,top(48)+30 : left 50,15
    caption 50,"Epaisseur de la bordure:"
  spin 51 : parent 51,41 : top 51,top(50) : left 51,160 : width 51,60
    min 51,1 : max 51,20 : position 51,1

  alpha 52 : parent 52,41 : top 52,top(50)+30 : left 52,15
    caption 52,"Couleur de la bordure:"
  picture 53 : parent 53,41 : top 53,top(52) : left 53,160 : width 53,30 : height 53,20
    color 53,0,0,0
  button 54 : parent 54,41 : top 54,top(52) : left 54,left(53)+35 : width 54,30 : height 54,20
    caption 54,"..." : font_bold 54 : on_click 54,couleur
   
  alpha 55 : parent 55,41 : top 55,top(52)+30 : left 55,15
    caption 55,"Couleur de remplissage:"
  picture 56 : parent 56,41 : top 56,top(55) : left 56,160 : width 56,30 : height 56,20
    color 56,255,255,0
  button 57 : parent 57,41 : top 57,top(55) : left 57,left(56)+35 : width 57,30 : height 57,20
    caption 57,"..." : font_bold 57 : on_click 57,couleur

  check 571 : parent 571,41 : top 571,top(55)+30 : left 571,160
    caption 571,"Fond transparent" : width 571,100

  alpha 58 : parent 58,41 : top 58,top(571)+30 : left 58,15
    caption 58,"Couleur du texte:"
  picture 59 : parent 59,41 : top 59,top(58) : left 59,160 : width 59,30 : height 59,20
    color 59,0,0,0
  button 60 : parent 60,41 : top 60,top(58) : left 60,left(59)+35 : width 60,30 : height 60,20
    caption 60,"..." : font_bold 60 : on_click 60,couleur

  memo 61 : parent 61,41 : top 61,top(58)+30 : left 61,15 : width 61,width_client(41)-30
    height 61,150 : bar_both 61 : font_size 61,10
  combo 62 : parent 62,41 : top 62,top(61)+height(61)+10 : left 62,15
    width 62,120
    item_add 62,"Gauche -> Droite"
    item_add 62,"Bas -> Haut"
    item_add 62,"Haut-> Bas"
    item_add 62,"Droite -> Gauche"
  res% = dll_call2("SelectComboBoxItem",handle(62),1)
  option 63 : parent 63,41 : top 63,top(62) : left 63,140 : caption 63,"Centré" 
  option 631 : parent 631,41 : top 631,top(62) : left 631,200 : caption 631,"à Droite" 
  combo 64 : parent 64,41 : top 64,top(62)+30 : left 64,15
    width 64,width_client(41)-30 : font_names_load 64
  for i%=1 to count(64)
    if item_read$(64,i%)="Arial"
      res% = dll_call2("SelectComboBoxItem",handle(64),i%)     
      exit_for
    end_if
  next i%
  check 65 : parent 65,41 : top 65,top(64)+30 : left 65,15 : caption 65,"G" : font_bold 65 
  check 66 : parent 66,41 : top 66,top(65) : left 66,60 : caption 66,"I" : font_italic 66 
  check 67 : parent 67,41 : top 67,top(65) : left 67,105 : caption 67,"S" : font_underline 67 
  check 68 : parent 68,41 : top 68,top(65) : left 68,150 : caption 68,"B" : font_strike 68 
  combo 69 : parent 69,41 : top 69,top(65) : left 69,200 : width 69,width_client(41)-215
    item_add 69,"8"
    item_add 69,"10"
    item_add 69,"12"
    item_add 69,"14"
    item_add 69,"16"
    item_add 69,"18"
    item_add 69,"20"
    item_add 69,"22"
    item_add 69,"24"
    item_add 69,"28"
    item_add 69,"32"
    item_add 69,"36"
    item_add 69,"48"
    res% = dll_call2("SelectComboBoxItem",handle(69),3)     
   
' l'image
  container 2 : left 2,300 : height 2,height_client(0) - 30 : width 2,width_client(0)-300
    caption 2,"Image"
  wlarg% = width_client(2)-30
  whaut% = height_client(2)-35
  picture 11 : parent 11,2
    top 11,15 : left 11,10 : width 11,wlarg% : height 11,whaut%
    color 11,225,225,0 : parent 11,2
  2d_target_is 11
  scroll_bar 101 : parent 101,2
    height 101,20 : width 101,width_client(2)-20 : top 101,height(2)-20
    min 101,0 : max 101,width_client(2)-20 : inactive 101 : on_change 101,scroll
  scroll_bar 102 : parent 102,2 : vertical 102
    width 102,20 : height 102,height_client(2)-20 : left 102,width(2)-20
    min 102,0 : max 102,height_client(2)-20 : inactive 102 : on_change 101,scroll
  form 110 : full_space 110 : hide 110
  picture 111 : parent 111,110 : width 111,wlarg% : height 111,whaut%
                           
  ' la fenêtre "sablier"
  form 20 : hide 20 : border_hide 20 : width 20,400 : height 20,100
    top 20,(screen_y-height(20))/2 : left 20,(screen_x-width(20))/2
  panel 21 : parent 21,20 : full_space 21 : color 21,255,192,192
    font_size 21,24
    caption 21,"Opération en cours..."
   
  ' la fenêtre de sélection de couleur
  form 500 : hide 500 : caption 500,"Sélection de couleur" : width 500,500
    top 500,(screen_y-height(500))/2 : left 500,(screen_x-width(500))/2
    on_close 500,couleurok
  alpha 501 : parent 501,500 : top 501,10 : left 501,10 : font_bold 501
 
  alpha 502 : parent 502,500 : top 502,40 : left 502,10 : font_bold 501
    font_bold 502 : caption 502,"R"
  scroll_bar 503 : parent 503,500 : top 503,40 : left 503,30
    width 503,width_client(500)-100 : min 503,0 : max 503,255
    on_change 503,changecouleur
  alpha 504 : parent 504,500 : top 504,40 : left 504,left(503)+width(503)+20
   
  alpha 505 : parent 505,500 : top 505,70 : left 505,10 : font_bold 505
    font_bold 505 : caption 505,"G"
  scroll_bar 506 : parent 506,500 : top 506,70 : left 506,30
    width 506,width_client(500)-100 : min 506,0 : max 506,255
    on_change 506,changecouleur
  alpha 507 : parent 507,500 : top 507,70 : left 507,left(506)+width(506)+20
   
  alpha 508 : parent 508,500 : top 508,100 : left 508,10 : font_bold 508
    font_bold 508 : caption 508,"B"
  scroll_bar 509 : parent 509,500 : top 509,100 : left 509,30
    width 509,width_client(500)-100 : min 509,0 : max 509,255
    on_change 509,changecouleur
  alpha 510 : parent 510,500 : top 510,100 : left 510,left(509)+width(509)+20


  ' objets invisibles
  open_dialog 12
  save_dialog 13
  image 14                : ' pour mémoriser l'image avant toute opération
  image 15 : hide 15      : ' pour déplacer la pointe de la flèche si TypeTrace%=3
  picture 112 : hide 112  : ' pour déterminer les dimensions d'un texte
                           
  actif% = 0
  larg% = width(11)
  haut% = height(11)
  CouleurBord%        = 0                    : ' noir
  CouleurRemplissage%  = (0*256+255)*256+255  : ' jaune
  CouleurText%        = 0                    : ' noir
  Undo%                = 0                    : ' aucune situation pour "Annuler"
  2d_target_is 11
  2d_image_copy 14,0,0,wlarg%,whaut%
  caption 0,"Annotation"
end_sub


sub menus()
  dim_local no1%, no2%
  no% = 1000 : main_menu no%
  no% = no% + 1 : sub_menu no% : parent no%,1000 : no1% = no% : caption no%,"Fichiers"
    no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"Nouveau"
      on_click no%,nouveau
    no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"Ouvrir..."
      on_click no%,ouvrir
    no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"Enregistrer"
      on_click no%,enregistrer
    no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"Enregistrer sous..."
      on_click no%,enregistrersous
    no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"-"
    no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"Rétablir"
      on_click no%,retablir
    no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"-"
    no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"Sortir"
      on_click no%,sortir
  no% = no% + 1 : sub_menu no% : parent no%,1000 : no1% = no% : caption no%,"Bulles"
end_sub


sub nouveau()
  if actif%=1
    if message_confirmation_yes_no("L'image actuelle n'est pas enregistrée. Sortir quand-même ?")<>1 then exit_sub
  end_if
  if CNV%<>0
    CNV% = dll_call1("FreeCanvas",CNV%)
  end_if
  actif% = 0
  fichier$ = ""
  2d_clear
  stretch_off 11
  full_space 11
  TypeTrace% = 0
'  width 11,width(2)-20 : height 11,height(2)-20
  larg% = wlarg%
  haut% = whaut%
  clipboard_copy 11
  clipboard_paste 111
  width 111,larg% : height 111,haut%
  caption 37,"W: "+str$(larg%)
  caption 38,"H: "+str$(haut%)
  inactive 101 : inactive 102
  hdc% = handle_canvas(11)
  CNV% = dll_call2("GetCanvas",object_internal(11),adr(hdc%))
  xpos% = 0 : ypos% = 0
  CouleurBord%        = 0                    : ' noir
  CouleurRemplissage%  = (0*256+255)*256+255  : ' jaune
  CouleurText%        = 0                    : ' noir
  color 53,0,0,0
  color 56,255,255,0
  color 59,0,0,0
  2d_target_is 11
  2d_image_copy 14,0,0,wlarg%,whaut%
  if Undo%>0
    dim_local i%
    for i%=1 to i%
      if object_exists(3000+i%)=1 then delete 3000+i%
    next i%
    Undo% = 0
  end_if
  inactive 451 : inactive 341
  mark_off 63 : mark_off 631
  caption 0,"Annotation"
end_sub


sub ouvrir()
  dim_local f$
  filter 12,"Images JPG|*.jpg"
  f$ = file_name$(12)
  if f$="_" then exit_sub
  if file_exists(f$)=0
    message "Fichier non trouvé"
    exit_sub
  end_if
  retablir(f$)
end_sub

sub retablir(f$)
  dim_local res%, w%, h%
  if CNV%<>0
    CNV% = dll_call1("FreeCanvas",CNV%)
  end_if
  inactive 0 : show 20 : display
  res% = dll_call3("AnalyzeImageFile",adr(f$),adr(larg%),adr(haut%))
  off_change 101 : position 101,0 : on_change 101,scroll
  if larg%>wlarg%
    min 101,0 : max 101,larg%-wlarg%
  else
    inactive 101
  end_if
  off_change 102 : position 102,0 : on_change 102,scroll
  if haut%>whaut%
    min 102,0 : max 102,haut%-whaut%
    position 102,0
  else
    inactive 102
  end_if
  caption 37,"W: "+str$(larg%)
  caption 38,"H: "+str$(haut%)
  width 110,larg%+30 : height 110,haut%+100
  width 111,larg% : height 111,haut%
                                   
  fichier$ = f$
  res% = dll_call1("LoadAnyImageFile",adr(fichier$))
  clipboard_paste 111
  2d_target_is 111
 
  2d_image_copy 14,0,0,wlarg%,whaut%
  2d_target_is 11
  2d_image_paste 14,0,0
 
  caption 0,"Annotation de "+fichier$
  TypeTrace% = 0
  xpos% = 0 : ypos% = 0
  CouleurBord%        = 0                    : ' noir
  CouleurRemplissage%  = (0*256+255)*256+255  : ' jaune
  CouleurText%        = 0                    : ' noir
  color 53,0,0,0
  color 56,255,255,0
  color 59,0,0,0
  2d_target_is 11
  2d_image_copy 14,0,0,wlarg%,whaut%
  if Undo%>0
    dim_local i%
    for i%=1 to i%
      if object_exists(3000+i%)=1 then delete 3000+i%
    next i%
    Undo% = 0
  end_if
  inactive 451 : active 341
  mark_off 63 : mark_off 631
  hide 20: active 0
end_sub


sub enregistrer()
  dim_local res%
  if fichier$=""
    message "Pas d'image ouverte"
    exit_sub
  end_if
  inactive 0 : show 20 : display
'  clipboard_copy 11
  clipboard_copy 111
  pause 100
  res% = dll_call1("SaveAnyImageFile",adr(fichier$))
  actif% = 0
  caption 0,"Annotation de "+fichier$
  hide 20 : active 0
end_sub


sub enregistrersous()
  dim_local f$, res%
  f$ = file_name$(13)
  if f$="_" then exit_sub
  if file_exists(f$)=1
    if message_confirmation_yes_no("Ce fichier existe déjà. Remplacer ?")<>1 then exit_sub
  end_if
  inactive 0 : show 20 : display
  clipboard_copy 111
  pause 300
  res% = dll_call1("SaveAnyImageFile",adr(f$))
  fichier$ = f$
  actif% = 0
  caption 0,"Annotation de "+fichier$
  hide 20 : active 0
end_sub


sub sortir()
  if actif%=1
    if message_confirmation_yes_no("L'image actuelle n'est pas enregistrée. Sortir quand-même ?")<>1 then exit_sub
  end_if
  terminate
end_sub


sub tracer()
  TypeTrace% = 1                        : ' on trace la bulle
  on_mouse_down 11,MouseDown
  caption 44,"Tracer le rectangle délimiteur..."
end_sub


sub MouseDown()
  off_mouse_down 11
  mousex% = mouse_x_left_down(11) : ' *(larg%/wlarg%)
  mousey% = mouse_y_left_down(11) : ' *(haut%/whaut%)
  select TypeTrace%
    case 1:    ' bulle
      bulle%(0) = mousex%
      bulle%(1) = mousey%
      bulle%(2) = mousex%
      bulle%(3) = mousey%
    case 2:    ' pointe
      down% = dll_call1("CheckMouseButton",2)
      if down%=1                : ' est-ce que le bouton droit est enfoncé ?
        mousex% = mouse_x_position(11) : ' *(larg%/wlarg%)
        mousey% = mouse_y_position(11) : ' *(haut%/whaut%)
        Origine% = 0
        if mousex%<bulle%(0)
          if mousey%<bulle%(1)
            Origine% = 0            : ' TL
          else
            if mousey%>bulle%(3)
              Origine% = 3          : ' BL
            else
              Origine% = 7          : ' L
            end_if
          end_if
        else
          if mousex%>bulle%(2)
            if mousey%<bulle%(1)
              Origine% = 1          : ' TR
            else
              if mousey%>bulle%(3)
                Origine% = 2        : ' BR
              else
                Origine% = 5        : ' R
              end_if
            end_if
          else
            if Mousey%<bulle%(1)
              Origine% = 4          : ' T
            else
              if Mousey%>bulle%(3)
                Origine% = 6        : ' B
              else
                ' ici, on a cliqué sur le bord ou à l'intérieur !
                ' donc, on ignore ce clic !
                on_mouse_down 11,MouseDown
                return
              end_if
            end_if
          end_if
        end_if
        2d_image_copy 15,0,0,wlarg%,whaut%
        2d_circle Mousex%,Mousey%,5
        set_focus 45
        TypeTrace% = 3
        caption 44,"Valdez la bulle maintenant..."
        on_mouse_down 11,MouseDown
        return
      end_if
      on_mouse_down 11,MouseDown
      return
    case 3:    ' pointe s'il y a déjà une pointe positionnée
      down% = dll_call1("CheckMouseButton",2)
      if down%=1                : ' est-ce que le bouton droit est enfoncé ?
        2d_image_paste 15,xpos%,ypos%
        mousex% = mouse_x_position(11) : ' *(larg%/wlarg%)
        mousey% = mouse_y_position(11) : ' *(haut%/whaut%)
        Origine% = 0
        if mousex%<bulle%(0)
          if mousey%<bulle%(1)
            Origine% = 0            : ' TL
          else
            if mousey%>bulle%(3)
              Origine% = 3          : ' BL
            else
              Origine% = 7          : ' L
            end_if
          end_if
        else
          if mousex%>bulle%(2)
            if mousey%<bulle%(1)
              Origine% = 1          : ' TR
            else
              if mousey%>bulle%(3)
                Origine% = 2        : ' BR
              else
                Origine% = 5        : ' R
              end_if
            end_if
          else
            if Mousey%<bulle%(1)
              Origine% = 4          : ' T
            else
              if Mousey%>bulle%(3)
                Origine% = 6        : ' B
              else
                ' ici, on a cliqué sur le bord ou à l'intérieur !
                ' donc, on ignore ce clic !
                on_mouse_down 11,MouseDown
                return
              end_if
            end_if
          end_if
        end_if
        2d_circle Mousex%,Mousey%,5
        set_focus 45
        TypeTrace% = 3
        caption 44,"Valdez la bulle maintenant..."
        on_mouse_down 11,MouseDown
        return
      end_if
      on_mouse_down 11,MouseDown
      return     
  end_select
  down% = 1
  on_mouse_move 11,MouseMove
end_sub


sub MouseMove()
  d% = dll_call1("CheckMouseButton",1)
  down% = down% * d%
  if down%=0
    TypeTrace% = 2
    caption 44,"Clic droit pour positionner la pointe..."
    on_mouse_down 11,MouseDown
    return
  end_if

  caption 0,str$(mouse_x_position(11))+","+str$(mouse_y_position(11))
  mousex% = mouse_x_position(11) : ' *(larg%/wlarg%)
  mousey% = mouse_y_position(11) : ' *(haut%/whaut%)
  bulle%(2) = mousex%
  bulle%(3) = mousey%
  2d_image_paste 14,0,0
  display
  2d_poly_from bulle%(0),bulle%(1)
  2d_poly_to bulle%(2),bulle%(1)
  2d_poly_to bulle%(2),bulle%(3)
  2d_poly_to bulle%(0),bulle%(3)
  2d_poly_to bulle%(0),bulle%(1)
  display
end_sub
         
sub valider()
  dim_local i%, px%, py%, dx%, dy%, pol$, dir%, angle%
  if TypeTrace%<>3 then return
  off_mouse_down 11
  2d_image_paste 14,0,0
  ' mémoriser la situation pour "Annuler"
  if Undo%=MUndo%
   
  end_if
  Undo% = Undo% + 1                    : ' compter la nouvelle mémorisation
  image 3000+Undo%                    : ' créer un image pour memoriser le contenu de l'objet 11
  2d_image_copy 3000+Undo%,0,0,wlarg%,whaut%  : ' mémoriser la partie visible de 11
  UndoPos%(Undo%,0) = xpos%            : ' et mémoriser la position dans l'image globale
  UndoPos%(Undo%,1) = ypos%
  active 451
 
  ' tracer la bulle
  typ% = item_index(42)
  hdc% = handle_canvas(11)
  CNV% = dll_call2("GetCanvas",object_internal(11),adr(hdc%))
  ' paramètres communs à tous les types de bules
      params%(2)  = bulle%(0)              : ' coin en haut à gauche
      params%(3)  = bulle%(1)
      params%(4)  = bulle%(2)              : ' coin en bas à droite
      params%(5)  = bulle%(3)
      params%(6)  = position(51)            : ' épaisseur du trait
      params%(7)  = CouleurBord%            : ' clBlack
      params%(8)  = CouleurRemplissage%    : ' clYellow
      if checked(571)=1 then params%(8)  = -99    : ' transparent
      params%(9)  = position(47)            : ' rayon de l'arrondi
      params%(10) = typ%-1                  : ' type de bulle
      params%(11) = 0                      : ' ./. non utilisé
      params%(12) = Origine%                : ' départ 
      params%(13) = mousex%                : ' position de la pointe
      params%(14) = mousey%
      params%(15) = position(49)            : ' largeur de la flèche à la base
  if typ%>1
    if params%(6)=1 then params%(6) = 2
  end_if
  res% = dll_call3("DrawOnCanvas",CNV%,6,adr(params%))
  display
  CNV% = dll_call1("FreeCanvas",CNV%)
  2d_image_copy 14,0,0,wlarg%,whaut%
  display 
  2d_image_paste 14,0,0
  pause 100
  2d_target_is 111
  2d_image_paste 14,xpos%,ypos%
  pause 200
  2d_target_is 11
  display
 
  ' imprimer le texte dans la bulle
  if count(61)>0
    pitch% = val(text$(69))
    ' 1 = Gauche -> Droite
    ' 2 = Bas -> Haut
    ' 3 = Haut-> Bas
    ' 4 = Droite -> Gauche
    dir% = item_index(62)
    select dir%
      case 1
        px% = bulle%(0) + 10
        py% = bulle%(1) + 10
        dx% = 0
        dy% = pitch%
        angle% = 0
        Params%(14) = bulle%(2)-bulle%(0) + 1 - 20 
      case 2
        px% = bulle%(0) + 10
        py% = bulle%(3) - 10
        dx% = pitch%
        dy% = 0
        angle% = 90
        Params%(14) = bulle%(3)-bulle%(1) + 1 - 20 
      case 3
        px% = bulle%(2) - 10
        py% = bulle%(1) + 10
        dx% = 0 - pitch%
        dy% = 0
        angle% = 270
        Params%(14) = bulle%(3)-bulle%(1) + 1 - 20 
      case 4
        px% = bulle%(2) - 10
        py% = bulle%(3) - 10
        dx% = 0
        dy% = 0 - pitch%
        angle% = 180
        Params%(14) = bulle%(2)-bulle%(0) + 1 - 20 
    end_select
    pol$ = text$(64) 

    ' paramètres valables pour toutes les lignes
    params%(5) = adr(pol$)              : ' nom de la police
    params%(6) = angle%*10              : ' angle d'inclinaison * 10
    params%(7) = CouleurText%          : ' couleur de la police
    params%(9) = pitch%                : ' taille de la police
    params%(10) = checked(65)          : ' gras
    params%(11) = checked(66)          : ' italique
    params%(12) = checked(67)          : ' sousligné
    params%(13) = checked(68)          : ' barré
   
    for i%=1 to count(61)
      ' paramètres spécifiques à 1 ligne
      txt$ = item_read$(61,i%)
      params%(2) = px%                    : ' position de début d'impression
      params%(3) = py%
      params%(4) = adr(txt$)              : ' ligne de texte
'      Formater()                          : ' gérer le centrage ou le cardrage à droite
      params%(8) = 0                          : ' cadrage à gauche
      if checked(63)=1 then params%(8) = 1    : ' centré
      if checked(631)=1 then params%(8) = 2  : ' cadrage à droite
                               
      ' impression de la ligne
      hdc% = handle_canvas(11)
      CNV% = dll_call2("GetCanvas",object_internal(11),adr(hdc%))
      res% = dll_call3("DrawOnCanvas",CNV%,5,adr(params%))
      CNV% = dll_call1("FreeCanvas",CNV%)
      ' assurer l'affichage
      2d_image_copy 14,0,0,wlarg%,whaut%
      display 
      2d_image_paste 14,0,0
      pause 100
      2d_target_is 111
      2d_image_paste 14,xpos%,ypos%
      pause 200
      2d_target_is 11
      display
      ' préparer la position de la ligne suivangte
      px% = px% + dx%
      py% = py% + dy%
    next i%
  end_if
 
  actif% = 1
  caption 44,""
  mark_off 63 : mark_off 631
'  message "Pointe en "+str$(mousex%)+","+str$(mousey%)+"  Origine%="+str$(Origine%)
end_sub


sub annuler()
  if Undo%=0          : ' ceci ne devrait jamais arriver...
    inactive 451
    exit_sub
  end_if
  2d_target_is 111
  2d_image_paste 3000+Undo%,UndoPos%(Undo%,0),UndoPos%(Undo%,1)
  display
  2d_image_copy 14,xpos%,ypos%,xpos%+wlarg%,ypos%+whaut%
  display
  2d_target_is 11
  2d_image_paste 14,0,0
  display
  delete 3000+Undo%                  : ' supprimer l'image mémorisée
  Undo% = Undo% - 1                  : ' "oublier" cette étape
  if Undo%=0 then inactive 451      : ' plus rien en mémoire ? désactiver le outon
  TypeTrace% = 0                    : ' oublier un éventuel traçage en cours
end_sub


sub scroll()
  xpos% = position(101)
  ypos% = position(102)
  off_change 101 : off_change 102
  2d_target_is 111
  2d_image_copy 14,xpos%,ypos%,xpos%+wlarg%,ypos%+whaut%
  pause 100
  2d_target_is 11
  2d_image_paste 14,0,0
  pause 100
  on_change 101,scroll : on_change 102,scroll
end_sub


sub RGB(c%)
  RR% = bin_and(c%,255)
  GG% = bin_and(c%,hex("FF00"))/256
  BB% = (bin_and(c%,hex("FF0000"))/256)/256
end_sub


sub changecouleur(n%)
  dim_local c%
  c% = position(n%)
  select n%
    case 503
      RR% = c%
    case 506
      GG% = c%
    case 509
      BB% = c%
  end_select
  caption n%+1,str$(c%)
  select nCouleur%
    case 1:    ' bourdure
      color 53,RR%,GG%,BB%
      CouleurBord% = (BB%*256+GG%)*256+RR%
    case 2:    ' remplissage
      color 56,RR%,GG%,BB%
      CouleurRemplissage% = (BB%*256+GG%)*256+RR%
    case 3:    ' texte
      color 59,RR%,GG%,BB%
      CouleurText% = (BB%*256+GG%)*256+RR%
  end_select
end_sub


sub couleur()
  inactive 0
  if number_click=54 then nCouleur% = 1  : ' couleur de la bordure
  if number_click=57 then nCouleur% = 2  : ' couleur de remplissage
  if number_click=60 then nCouleur% = 3  : ' couleur du texte
  select nCouleur%
    case 1:    ' couleur de la bordure
      caption 501,"Couleur de la bordure"
      RGB(CouleurBord%)
      position 503,RR%
      caption 504,str$(RR%)
      position 506,GG%
      caption 507,str$(GG%)
      position 509,BB%
      caption 510,str$(BB%)
    case 2:    ' couleur de remplissage
      caption 501,"Couleur de remplissage"
      RGB(CouleurRemplissage%)
      position 503,RR%
      caption 504,str$(RR%)
      position 506,GG%
      caption 507,str$(GG%)
      position 509,BB%
      caption 510,str$(BB%)
    case 3:    ' couleur du texte
      caption 501,"Couleur du texte"
      RGB(CouleurText%)
      position 503,RR%
      caption 504,str$(RR%)
      position 506,GG%
      caption 507,str$(GG%)
      position 509,BB%
      caption 510,str$(BB%)
  end_select
  show 500
end_sub
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Marc



Nombre de messages : 549
Age : 56
Localisation : TOURS
Date d'inscription : 18/03/2014

MessageSujet: Re: Annoter une image avec des bulles de texte   Jeu 6 Avr 2017 - 3:20

Salut Klaus !

On arrête plus le progrès ! Merci pour ces améliorations. La possibilité de rectifier le placement du point de la flèche fonctionne bien : c'est pratique et convivial.

Je suis désolé, je n'ai pas suivi les consignes et j'ai réussi à planter le programme :

Spoiler:
 

Ce qu'il s'est passé : J'ai voulu faire une bulle sans flèche.  Embarassed
J'ai donc validé la bulle seule et au deuxième appui sur valider : plantage...
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Klaus

avatar

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

MessageSujet: Re: Annoter une image avec des bulles de texte   Ven 7 Avr 2017 - 0:31

Ok. merci pour le retour. Je vais sécuriser cela.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Klaus

avatar

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

MessageSujet: Re: Annoter une image avec des bulles de texte   Ven 7 Avr 2017 - 1:21

Il me semble que c'est sécurisé, maintenant. J'ai aussi ouvert l'accès qux fichiers BMP et JPEG:
Code:
' annoter_une_image.bas

' Cet utilitaire permet de:
'   - charger une image
'   - y placer des bulles de texte
'   - sauvegarder le résultat obtenu

dll_on "KGF.dll"

labels()
variables()
form0()
menus()

end

nouveau:
  nouveau()
  return
  
ouvrir:
  ouvrir()
  return
  
enregistrer:
  enregistrer()
  return
  
retablir:
  if inactive(341)=1 then return
  retablir(fichier$)
  return
  
enregistrersous:
  enregistrersous()
  return
  
sortir:
  sortir()
  return
  
tracer:
  tracer()
  return
  
valider:
  valider()
  return
  
annuler:
  annuler()
  return
  
MouseDown:
  MouseDown()
  return

MouseMove:
  off_mouse_move 11
  MouseMove()
  on_mouse_move 11,MouseMove
  return
  
scroll:
  scroll()
  return
  
couleur:
  couleur()
  return
  
couleurok:
  hide 500
  to_foreground 0
  active 0
  set_focus 43
  return
  
changecouleur:
  changecouleur(number_change)
  return
  

sub labels()
  label nouveau, ouvrir, enregistrer, retablir, enregistrersous, sortir
  label tracer, MouseDown, MouseMove, valider, annuler, scroll
  label couleur, couleurok, changecouleur

end_sub


sub variables()
  dim no%, d%, res%, typ%
  dim actif%                  : ' flag "une image est présente, modifiée et non sauvegardée"
  dim fichier$                : ' nom du fichier chargé dans le picture 11
  dim larg%, haut%            : ' dimensions réelles de l'image du fichier chargé
  dim wlarg%, whaut%          : ' dimensions réelles de du picture 11
  dim mousex%, mousey%        : ' coordonnées de la souris
  dim bulle%(3)               : ' dimensions de la bulle (types 1...3)
  dim pointe%(1)              : ' coordonnées de la pointe
  dim TypeTrace%              : ' type de traçage  0=rien  1=bulle 2=pointe 3=prêt à valider
  dim Origine%                : ' origine de la flèche: 0=TL 1=TR 2=BR 3=BL 4=T B=R 6=B 7=L
  dim down%                   : ' flag "bouton gauche de la souris est enfoncé"
  dim hdc%                    : ' reçoit handle_canvas(11)
  dim CNV%                    : ' identifiant du canvas pour le dessin
  dim Params%(20)             : ' paramètres pour DrawOnCanvas
  dim xpos%, ypos%            : ' positions de la fenêtre de visualisation
  dim CouleurBord%            : ' code couleur pour la bordure
  dim CouleurRemplissage%     : ' code couleur pour le remplissage
  dim CouleurText%            : ' couleur du texte à imprimer
  dim nCouleur%               : ' indice du type de couleur
  dim RR%, GG%, BB%           : ' couleurs RGB décodées
  dim Undo%                   : ' nombre d'étapes mémorisées pour "Annuler"
  dim MUndo% : MUndo% = 100   : ' nombre maxi d'etapes d'annulation
  dim UndoPos%(MUndo%,1)      : ' sauvegarde des xpos% et ypos% pour "Annuler"
  dim txt$                    : ' une ligne de texte à imprimer dans la bulle
  dim pitch%                  : ' taille de la police d'impression
end_sub


sub form0()
  dim_local res%, i%
  full_space 0
  
  ' les outils
  container 1 : height 1,height_client(0) - 30 : width 1,300 : caption 1,"Outils"

  ' les outils "Fichiers"
  container 31 : parent 31,1 : top 31,15 : left 31,15 : width 31,width_client(1)-30
    color 31,225,225,225
    caption 31,"Fichiers"
  button 32 : parent 32,31 : top 32,15 : left 32,15 : height 32,20 : width 32,70 : caption 32,"Nouveau"
    on_click 32,nouveau
  button 33 : parent 33,31 : top 33,15 : left 33,100 : height 33,20 : width 33,50 : caption 33,"Ouvrir"
    on_click 33,ouvrir  
  button 34 : parent 34,31 : top 34,15 : left 34,170 : height 34,20 : width 34,70 : caption 34,"Enregistrer"
    on_click 34,enregistrer  
  button 341 : parent 341,31 : top 341,40 : left 341,15 : height 341,20 : width 341,50 : caption 341,"Rétablir"
    on_click 341,retablir : inactive 341
  button 35 : parent 35,31 : top 35,40 : left 35,75 : height 35,20 : width 35,100 : caption 35,"Enregistrer sous"
    on_click 35,enregistrersous  
  button 36 : parent 36,31 : top 36,75 : left 36,95 : height 36,20 : width 36,60 : caption 36,"Sortir"
    on_click 36,sortir
   alpha 37 : parent 37,31 : top 37,45 : left 37,200 : caption 37,"W; "  
   alpha 38 : parent 38,31 : top 38,65 : left 38,200 : caption 38,"H; "  
    
' les outils  "Bulles"
  container 41 : parent 41,1 : top 41,15+height(31)+5 : left 41,15
    width 41,width_client(1)-30 : height 41,height_client(1)-top(41)-10
    color 41,225,225,225
    caption 41,"Bulles"
  combo 42 : parent 42,41 : top 42,15 : left 42,15 : width 42,width_client(41)-30
    item_add 42,"Bulle rectangle"
    item_add 42,"Bulle rectangle arrondi"
    item_add 42,"Bulle ellipse"
  res% = dll_call2("SelectComboBoxItem",handle(42),1)
  button 43 : parent 43,41 : top 43,top(42)+height(42)+5: left 43,15 : height 43,20
    caption 43,"Tracer bulle" : on_click 43,tracer
  alpha 44 : parent 44,41 : top 44,top(43)+30 : left 44,15 : font_bold 44
  button 45 : parent 45,41 : top 45,top(43) : left 45,95 : height 45,20
    caption 45,"Valider bulle" : on_click 45,valider : inactive 45
  button 451 : parent 451,41 : top 451,top(43) : left 451,175 : height 451,20
    caption 451,"Annuler bulle" : on_click 451,annuler : inactive 451      
  alpha 46 : parent 46,41 : top 46,top(44)+30 : left 46,15
    caption 46,"Rayon de courbure d'arrondi:"
  spin 47 : parent 47,41 : top 47,top(46) : left 47,160 : width 47,60
    min 47,0 : max 47,50 : position 47,10
  alpha 48 : parent 48,41 : top 48,top(46)+30 : left 48,15
    caption 48,"Diamètre de la base de flèche:"
  spin 49 : parent 49,41 : top 49,top(48) : left 49,160 : width 49,60
    min 49,5 : max 49,200 : position 49,20  
  alpha 50 : parent 50,41 : top 50,top(48)+30 : left 50,15
    caption 50,"Epaisseur de la bordure:"
  spin 51 : parent 51,41 : top 51,top(50) : left 51,160 : width 51,60
    min 51,1 : max 51,20 : position 51,1

  alpha 52 : parent 52,41 : top 52,top(50)+30 : left 52,15
    caption 52,"Couleur de la bordure:"
  picture 53 : parent 53,41 : top 53,top(52) : left 53,160 : width 53,30 : height 53,20
    color 53,0,0,0
  button 54 : parent 54,41 : top 54,top(52) : left 54,left(53)+35 : width 54,30 : height 54,20
    caption 54,"..." : font_bold 54 : on_click 54,couleur
    
  alpha 55 : parent 55,41 : top 55,top(52)+30 : left 55,15
    caption 55,"Couleur de remplissage:"
  picture 56 : parent 56,41 : top 56,top(55) : left 56,160 : width 56,30 : height 56,20
    color 56,255,255,0
  button 57 : parent 57,41 : top 57,top(55) : left 57,left(56)+35 : width 57,30 : height 57,20
    caption 57,"..." : font_bold 57 : on_click 57,couleur

  check 571 : parent 571,41 : top 571,top(55)+30 : left 571,160
    caption 571,"Fond transparent" : width 571,100

  alpha 58 : parent 58,41 : top 58,top(571)+30 : left 58,15
    caption 58,"Couleur du texte:"
  picture 59 : parent 59,41 : top 59,top(58) : left 59,160 : width 59,30 : height 59,20
    color 59,0,0,0
  button 60 : parent 60,41 : top 60,top(58) : left 60,left(59)+35 : width 60,30 : height 60,20
    caption 60,"..." : font_bold 60 : on_click 60,couleur

  memo 61 : parent 61,41 : top 61,top(58)+30 : left 61,15 : width 61,width_client(41)-30
    height 61,150 : bar_both 61 : font_size 61,10
  combo 62 : parent 62,41 : top 62,top(61)+height(61)+10 : left 62,15
    width 62,120
    item_add 62,"Gauche -> Droite"
    item_add 62,"Bas -> Haut"
    item_add 62,"Haut-> Bas"
    item_add 62,"Droite -> Gauche"
  res% = dll_call2("SelectComboBoxItem",handle(62),1)
  option 63 : parent 63,41 : top 63,top(62) : left 63,140 : caption 63,"Centré"  
  option 631 : parent 631,41 : top 631,top(62) : left 631,200 : caption 631,"à Droite"  
  combo 64 : parent 64,41 : top 64,top(62)+30 : left 64,15
    width 64,width_client(41)-30 : font_names_load 64
  for i%=1 to count(64)
    if item_read$(64,i%)="Arial"
      res% = dll_call2("SelectComboBoxItem",handle(64),i%)      
      exit_for
    end_if
  next i%
  check 65 : parent 65,41 : top 65,top(64)+30 : left 65,15 : caption 65,"G" : font_bold 65  
  check 66 : parent 66,41 : top 66,top(65) : left 66,60 : caption 66,"I" : font_italic 66  
  check 67 : parent 67,41 : top 67,top(65) : left 67,105 : caption 67,"S" : font_underline 67  
  check 68 : parent 68,41 : top 68,top(65) : left 68,150 : caption 68,"B" : font_strike 68  
  combo 69 : parent 69,41 : top 69,top(65) : left 69,200 : width 69,width_client(41)-215
    item_add 69,"8"
    item_add 69,"10"
    item_add 69,"12"
    item_add 69,"14"
    item_add 69,"16"
    item_add 69,"18"
    item_add 69,"20"
    item_add 69,"22"
    item_add 69,"24"
    item_add 69,"28"
    item_add 69,"32"
    item_add 69,"36"
    item_add 69,"48"
    res% = dll_call2("SelectComboBoxItem",handle(69),3)      
    
' l'image
  container 2 : left 2,300 : height 2,height_client(0) - 30 : width 2,width_client(0)-300
    caption 2,"Image"
  wlarg% = width_client(2)-30
  whaut% = height_client(2)-35
  picture 11 : parent 11,2
    top 11,15 : left 11,10 : width 11,wlarg% : height 11,whaut%
    color 11,225,225,0 : parent 11,2
  2d_target_is 11
  scroll_bar 101 : parent 101,2
    height 101,20 : width 101,width_client(2)-20 : top 101,height(2)-20
    min 101,0 : max 101,width_client(2)-20 : inactive 101 : on_change 101,scroll
  scroll_bar 102 : parent 102,2 : vertical 102
    width 102,20 : height 102,height_client(2)-20 : left 102,width(2)-20
    min 102,0 : max 102,height_client(2)-20 : inactive 102 : on_change 101,scroll
  form 110 : full_space 110 : hide 110
  picture 111 : parent 111,110 : width 111,wlarg% : height 111,whaut%
                            
  ' la fenêtre "sablier"
  form 20 : hide 20 : border_hide 20 : width 20,400 : height 20,100
    top 20,(screen_y-height(20))/2 : left 20,(screen_x-width(20))/2
  panel 21 : parent 21,20 : full_space 21 : color 21,255,192,192
    font_size 21,24
    caption 21,"Opération en cours..."
    
  ' la fenêtre de sélection de couleur
  form 500 : hide 500 : caption 500,"Sélection de couleur" : width 500,500
    top 500,(screen_y-height(500))/2 : left 500,(screen_x-width(500))/2
    on_close 500,couleurok
  alpha 501 : parent 501,500 : top 501,10 : left 501,10 : font_bold 501
  
  alpha 502 : parent 502,500 : top 502,40 : left 502,10 : font_bold 501
    font_bold 502 : caption 502,"R"
  scroll_bar 503 : parent 503,500 : top 503,40 : left 503,30
    width 503,width_client(500)-100 : min 503,0 : max 503,255
    on_change 503,changecouleur
  alpha 504 : parent 504,500 : top 504,40 : left 504,left(503)+width(503)+20
    
  alpha 505 : parent 505,500 : top 505,70 : left 505,10 : font_bold 505
    font_bold 505 : caption 505,"G"
  scroll_bar 506 : parent 506,500 : top 506,70 : left 506,30
    width 506,width_client(500)-100 : min 506,0 : max 506,255
    on_change 506,changecouleur
  alpha 507 : parent 507,500 : top 507,70 : left 507,left(506)+width(506)+20
    
  alpha 508 : parent 508,500 : top 508,100 : left 508,10 : font_bold 508
    font_bold 508 : caption 508,"B"
  scroll_bar 509 : parent 509,500 : top 509,100 : left 509,30
    width 509,width_client(500)-100 : min 509,0 : max 509,255
    on_change 509,changecouleur
  alpha 510 : parent 510,500 : top 510,100 : left 510,left(509)+width(509)+20


  ' objets invisibles
  open_dialog 12
  save_dialog 13
  image 14                 : ' pour mémoriser l'image avant toute opération
  image 15 : hide 15       : ' pour déplacer la pointe de la flèche si TypeTrace%=3
  picture 112 : hide 112   : ' pour déterminer les dimensions d'un texte
                            
  actif% = 0
  larg% = width(11)
  haut% = height(11)
  CouleurBord%         = 0                     : ' noir
  CouleurRemplissage%  = (0*256+255)*256+255   : ' jaune
  CouleurText%         = 0                     : ' noir
  Undo%                = 0                     : ' aucune situation pour "Annuler"
  2d_target_is 11
  2d_image_copy 14,0,0,wlarg%,whaut%
  caption 0,"Annotation"
end_sub


sub menus()
  dim_local no1%, no2%
  no% = 1000 : main_menu no%
  no% = no% + 1 : sub_menu no% : parent no%,1000 : no1% = no% : caption no%,"Fichiers"
    no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"Nouveau"
      on_click no%,nouveau
    no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"Ouvrir..."
      on_click no%,ouvrir
    no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"Enregistrer"
      on_click no%,enregistrer
    no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"Enregistrer sous..."
      on_click no%,enregistrersous
    no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"-"
    no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"Rétablir"
      on_click no%,retablir
    no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"-"
    no% = no% + 1 :sub_menu no% : parent no%,no1% : caption no%,"Sortir"
      on_click no%,sortir
  no% = no% + 1 : sub_menu no% : parent no%,1000 : no1% = no% : caption no%,"Bulles"
end_sub


sub nouveau()
  if actif%=1
    if message_confirmation_yes_no("L'image actuelle n'est pas enregistrée. Sortir quand-même ?")<>1 then exit_sub
  end_if
  if CNV%<>0
    CNV% = dll_call1("FreeCanvas",CNV%)
  end_if
  actif% = 0
  fichier$ = ""
  2d_clear
  stretch_off 11
  full_space 11
  TypeTrace% = 0
'  width 11,width(2)-20 : height 11,height(2)-20
  larg% = wlarg%
  haut% = whaut%
  clipboard_copy 11
  clipboard_paste 111
  width 111,larg% : height 111,haut%
  caption 37,"W: "+str$(larg%)
  caption 38,"H: "+str$(haut%)
  inactive 101 : inactive 102
  hdc% = handle_canvas(11)
  CNV% = dll_call2("GetCanvas",object_internal(11),adr(hdc%))
  xpos% = 0 : ypos% = 0
  CouleurBord%         = 0                     : ' noir
  CouleurRemplissage%  = (0*256+255)*256+255   : ' jaune
  CouleurText%         = 0                     : ' noir
  color 53,0,0,0
  color 56,255,255,0
  color 59,0,0,0
  2d_target_is 11
  2d_image_copy 14,0,0,wlarg%,whaut%
  if Undo%>0
    dim_local i%
    for i%=1 to i%
      if object_exists(3000+i%)=1 then delete 3000+i%
    next i%
    Undo% = 0
  end_if
  inactive 451 : inactive 341
  mark_off 63 : mark_off 631
  caption 0,"Annotation"
end_sub


sub ouvrir()
  dim_local f$
  filter 12,"Images (JPG,BMP,JPEG)|*.jpg;*.bmp;*.jpeg"
  f$ = file_name$(12)
  if f$="_" then exit_sub
  if file_exists(f$)=0
    message "Fichier non trouvé"
    exit_sub
  end_if
  retablir(f$)
end_sub

sub retablir(f$)
  dim_local res%, w%, h%
  if CNV%<>0
    CNV% = dll_call1("FreeCanvas",CNV%)
  end_if
  inactive 0 : show 20 : display
  res% = dll_call3("AnalyzeImageFile",adr(f$),adr(larg%),adr(haut%))
  off_change 101 : position 101,0 : on_change 101,scroll
  if larg%>wlarg%
    min 101,0 : max 101,larg%-wlarg%
  else
    inactive 101
  end_if
  off_change 102 : position 102,0 : on_change 102,scroll
  if haut%>whaut%
    min 102,0 : max 102,haut%-whaut%
    position 102,0
  else
    inactive 102
  end_if
  caption 37,"W: "+str$(larg%)
  caption 38,"H: "+str$(haut%)
  width 110,larg%+30 : height 110,haut%+100
  width 111,larg% : height 111,haut%
                                    
  fichier$ = f$
  res% = dll_call1("LoadAnyImageFile",adr(fichier$))
  clipboard_paste 111
  2d_target_is 111
  
  2d_image_copy 14,0,0,wlarg%,whaut%
  2d_target_is 11
  2d_image_paste 14,0,0
  
  caption 0,"Annotation de "+fichier$
  TypeTrace% = 0
  xpos% = 0 : ypos% = 0
  CouleurBord%         = 0                     : ' noir
  CouleurRemplissage%  = (0*256+255)*256+255   : ' jaune
  CouleurText%         = 0                     : ' noir
  color 53,0,0,0
  color 56,255,255,0
  color 59,0,0,0
  2d_target_is 11
  2d_image_copy 14,0,0,wlarg%,whaut%
  if Undo%>0
    dim_local i%
    for i%=1 to i%
      if object_exists(3000+i%)=1 then delete 3000+i%
    next i%
    Undo% = 0
  end_if
  inactive 451 : active 341
  mark_off 63 : mark_off 631
  hide 20: active 0
end_sub


sub enregistrer()
  dim_local res%
  if fichier$=""
    message "Pas d'image ouverte"
    exit_sub
  end_if
  inactive 0 : show 20 : display
'  clipboard_copy 11
  clipboard_copy 111
  pause 100
  res% = dll_call1("SaveAnyImageFile",adr(fichier$))
  actif% = 0
  caption 0,"Annotation de "+fichier$
  hide 20 : active 0
end_sub


sub enregistrersous()
  dim_local f$, res%
  f$ = file_name$(13)
  if f$="_" then exit_sub
  if file_exists(f$)=1
    if message_confirmation_yes_no("Ce fichier existe déjà. Remplacer ?")<>1 then exit_sub
  end_if
  inactive 0 : show 20 : display
  clipboard_copy 111
  pause 300
  res% = dll_call1("SaveAnyImageFile",adr(f$))
  fichier$ = f$
  actif% = 0
  caption 0,"Annotation de "+fichier$
  hide 20 : active 0
end_sub


sub sortir()
  if actif%=1
    if message_confirmation_yes_no("L'image actuelle n'est pas enregistrée. Sortir quand-même ?")<>1 then exit_sub
  end_if
  terminate
end_sub


sub tracer()
  TypeTrace% = 1                        : ' on trace la bulle
  on_mouse_down 11,MouseDown
  caption 44,"Tracer le rectangle délimiteur..."
end_sub


sub MouseDown()
  off_mouse_down 11
  mousex% = mouse_x_left_down(11) : ' *(larg%/wlarg%)
  mousey% = mouse_y_left_down(11) : ' *(haut%/whaut%)
  select TypeTrace%
    case 1:    ' bulle
      inactive 45
      bulle%(0) = mousex%
      bulle%(1) = mousey%
      bulle%(2) = mousex%
      bulle%(3) = mousey%
    case 2:    ' pointe
      down% = dll_call1("CheckMouseButton",2)
      if down%=1                : ' est-ce que le bouton droit est enfoncé ?
        mousex% = mouse_x_position(11) : ' *(larg%/wlarg%)
        mousey% = mouse_y_position(11) : ' *(haut%/whaut%)
        Origine% = 0
        if mousex%<bulle%(0)
          if mousey%<bulle%(1)
            Origine% = 0            : ' TL
          else
            if mousey%>bulle%(3)
              Origine% = 3          : ' BL
            else
              Origine% = 7          : ' L
            end_if
          end_if
        else
          if mousex%>bulle%(2)
            if mousey%<bulle%(1)
              Origine% = 1          : ' TR
            else
              if mousey%>bulle%(3)
                Origine% = 2        : ' BR
              else
                Origine% = 5        : ' R
              end_if
            end_if
          else
            if Mousey%<bulle%(1)
              Origine% = 4          : ' T
            else
              if Mousey%>bulle%(3)
                Origine% = 6        : ' B
              else
                ' ici, on a cliqué sur le bord ou à l'intérieur !
                ' donc, on ignore ce clic !
                on_mouse_down 11,MouseDown
                return
              end_if
            end_if
          end_if
        end_if
        2d_image_copy 15,0,0,wlarg%,whaut%
        2d_circle Mousex%,Mousey%,5
        active 45
        set_focus 45
        TypeTrace% = 3
        caption 44,"Valdez la bulle maintenant..."
        on_mouse_down 11,MouseDown
        return
      end_if
      on_mouse_down 11,MouseDown
      return
    case 3:    ' pointe s'il y a déjà une pointe positionnée
      down% = dll_call1("CheckMouseButton",2)
      if down%=1                : ' est-ce que le bouton droit est enfoncé ?
        2d_image_paste 15,xpos%,ypos%
        mousex% = mouse_x_position(11) : ' *(larg%/wlarg%)
        mousey% = mouse_y_position(11) : ' *(haut%/whaut%)
        Origine% = 0
        if mousex%<bulle%(0)
          if mousey%<bulle%(1)
            Origine% = 0            : ' TL
          else
            if mousey%>bulle%(3)
              Origine% = 3          : ' BL
            else
              Origine% = 7          : ' L
            end_if
          end_if
        else
          if mousex%>bulle%(2)
            if mousey%<bulle%(1)
              Origine% = 1          : ' TR
            else
              if mousey%>bulle%(3)
                Origine% = 2        : ' BR
              else
                Origine% = 5        : ' R
              end_if
            end_if
          else
            if Mousey%<bulle%(1)
              Origine% = 4          : ' T
            else
              if Mousey%>bulle%(3)
                Origine% = 6        : ' B
              else
                ' ici, on a cliqué sur le bord ou à l'intérieur !
                ' donc, on ignore ce clic !
                on_mouse_down 11,MouseDown
                return
              end_if
            end_if
          end_if
        end_if
        2d_circle Mousex%,Mousey%,5
        set_focus 45
        TypeTrace% = 3
        caption 44,"Valdez la bulle maintenant..."
        on_mouse_down 11,MouseDown
        return
      end_if
      on_mouse_down 11,MouseDown
      return      
  end_select
  down% = 1
  on_mouse_move 11,MouseMove
end_sub


sub MouseMove()
  d% = dll_call1("CheckMouseButton",1)
  down% = down% * d%
  if down%=0
    TypeTrace% = 2
    caption 44,"Clic droit pour positionner la pointe..."
    on_mouse_down 11,MouseDown
    return
  end_if

  caption 0,str$(mouse_x_position(11))+","+str$(mouse_y_position(11))
  mousex% = mouse_x_position(11) : ' *(larg%/wlarg%)
  mousey% = mouse_y_position(11) : ' *(haut%/whaut%)
  bulle%(2) = mousex%
  bulle%(3) = mousey%
  2d_image_paste 14,0,0
  display
  2d_poly_from bulle%(0),bulle%(1)
  2d_poly_to bulle%(2),bulle%(1)
  2d_poly_to bulle%(2),bulle%(3)
  2d_poly_to bulle%(0),bulle%(3)
  2d_poly_to bulle%(0),bulle%(1)
  display
end_sub
          
sub valider()
  dim_local i%, px%, py%, dx%, dy%, pol$, dir%, angle%
  if TypeTrace%<>3 then return
  off_mouse_down 11
  inactive 45
  2d_image_paste 14,0,0
  ' mémoriser la situation pour "Annuler"
  if Undo%=MUndo%
    
  end_if
  Undo% = Undo% + 1                    : ' compter la nouvelle mémorisation
  image 3000+Undo%                     : ' créer un image pour memoriser le contenu de l'objet 11
  2d_image_copy 3000+Undo%,0,0,wlarg%,whaut%   : ' mémoriser la partie visible de 11
  UndoPos%(Undo%,0) = xpos%            : ' et mémoriser la position dans l'image globale
  UndoPos%(Undo%,1) = ypos%
  active 451
  
  ' tracer la bulle
  typ% = item_index(42)
  hdc% = handle_canvas(11)
  CNV% = dll_call2("GetCanvas",object_internal(11),adr(hdc%))
  ' paramètres communs à tous les types de bules
      params%(2)  = bulle%(0)               : ' coin en haut à gauche
      params%(3)  = bulle%(1)
      params%(4)  = bulle%(2)               : ' coin en bas à droite
      params%(5)  = bulle%(3)
      params%(6)  = position(51)            : ' épaisseur du trait
      params%(7)  = CouleurBord%            : ' clBlack
      params%(8)  = CouleurRemplissage%     : ' clYellow
      if checked(571)=1 then params%(8)  = -99     : ' transparent
      params%(9)  = position(47)            : ' rayon de l'arrondi
      params%(10) = typ%-1                  : ' type de bulle
      params%(11) = 0                       : ' ./. non utilisé
      params%(12) = Origine%                : ' départ  
      params%(13) = mousex%                 : ' position de la pointe
      params%(14) = mousey%
      params%(15) = position(49)            : ' largeur de la flèche à la base
  if typ%>1
    if params%(6)=1 then params%(6) = 2
  end_if
  res% = dll_call3("DrawOnCanvas",CNV%,6,adr(params%))
  display
  CNV% = dll_call1("FreeCanvas",CNV%)
  2d_image_copy 14,0,0,wlarg%,whaut%
  display  
  2d_image_paste 14,0,0
  pause 100
  2d_target_is 111
  2d_image_paste 14,xpos%,ypos%
  pause 200
  2d_target_is 11
  display
  
  ' imprimer le texte dans la bulle
  if count(61)>0
    pitch% = val(text$(69))
    ' 1 = Gauche -> Droite
    ' 2 = Bas -> Haut
    ' 3 = Haut-> Bas
    ' 4 = Droite -> Gauche
    dir% = item_index(62)
    select dir%
      case 1
        px% = bulle%(0) + 10
        py% = bulle%(1) + 10
        dx% = 0
        dy% = pitch%
        angle% = 0
        Params%(14) = bulle%(2)-bulle%(0) + 1 - 20  
      case 2
        px% = bulle%(0) + 10
        py% = bulle%(3) - 10
        dx% = pitch%
        dy% = 0
        angle% = 90
        Params%(14) = bulle%(3)-bulle%(1) + 1 - 20  
      case 3
        px% = bulle%(2) - 10
        py% = bulle%(1) + 10
        dx% = 0 - pitch%
        dy% = 0
        angle% = 270
        Params%(14) = bulle%(3)-bulle%(1) + 1 - 20  
      case 4
        px% = bulle%(2) - 10
        py% = bulle%(3) - 10
        dx% = 0
        dy% = 0 - pitch%
        angle% = 180
        Params%(14) = bulle%(2)-bulle%(0) + 1 - 20  
    end_select
    pol$ = text$(64)  

    ' paramètres valables pour toutes les lignes
    params%(5) = adr(pol$)              : ' nom de la police
    params%(6) = angle%*10              : ' angle d'inclinaison * 10
    params%(7) = CouleurText%           : ' couleur de la police
    params%(9) = pitch%                 : ' taille de la police
    params%(10) = checked(65)           : ' gras
    params%(11) = checked(66)           : ' italique
    params%(12) = checked(67)           : ' sousligné
    params%(13) = checked(68)           : ' barré
    
    for i%=1 to count(61)
      ' paramètres spécifiques à 1 ligne
      txt$ = item_read$(61,i%)
      params%(2) = px%                    : ' position de début d'impression
      params%(3) = py%
      params%(4) = adr(txt$)              : ' ligne de texte
'      Formater()                          : ' gérer le centrage ou le cardrage à droite
      params%(8) = 0                          : ' cadrage à gauche
      if checked(63)=1 then params%(8) = 1    : ' centré
      if checked(631)=1 then params%(8) = 2   : ' cadrage à droite
                                
      ' impression de la ligne
      hdc% = handle_canvas(11)
      CNV% = dll_call2("GetCanvas",object_internal(11),adr(hdc%))
      res% = dll_call3("DrawOnCanvas",CNV%,5,adr(params%))
      CNV% = dll_call1("FreeCanvas",CNV%)
      ' assurer l'affichage
      2d_image_copy 14,0,0,wlarg%,whaut%
      display  
      2d_image_paste 14,0,0
      pause 100
      2d_target_is 111
      2d_image_paste 14,xpos%,ypos%
      pause 200
      2d_target_is 11
      display
      ' préparer la position de la ligne suivangte
      px% = px% + dx%
      py% = py% + dy%
    next i%
  end_if
  
  actif% = 1
  caption 44,""
  mark_off 63 : mark_off 631
'  message "Pointe en "+str$(mousex%)+","+str$(mousey%)+"  Origine%="+str$(Origine%)
end_sub


sub annuler()
  if Undo%=0          : ' ceci ne devrait jamais arriver...
    inactive 451
    exit_sub
  end_if
  2d_target_is 111
  2d_image_paste 3000+Undo%,UndoPos%(Undo%,0),UndoPos%(Undo%,1)
  display
  2d_image_copy 14,xpos%,ypos%,xpos%+wlarg%,ypos%+whaut%
  display
  2d_target_is 11
  2d_image_paste 14,0,0
  display
  delete 3000+Undo%                  : ' supprimer l'image mémorisée
  Undo% = Undo% - 1                  : ' "oublier" cette étape
  if Undo%=0 then inactive 451       : ' plus rien en mémoire ? désactiver le outon
  TypeTrace% = 0                     : ' oublier un éventuel traçage en cours
end_sub


sub scroll()
  xpos% = position(101)
  ypos% = position(102)
  off_change 101 : off_change 102
  2d_target_is 111
  2d_image_copy 14,xpos%,ypos%,xpos%+wlarg%,ypos%+whaut%
  pause 100
  2d_target_is 11
  2d_image_paste 14,0,0
  pause 100
  on_change 101,scroll : on_change 102,scroll
end_sub


sub RGB(c%)
  RR% = bin_and(c%,255)
  GG% = bin_and(c%,hex("FF00"))/256
  BB% = (bin_and(c%,hex("FF0000"))/256)/256
end_sub


sub changecouleur(n%)
  dim_local c%
  c% = position(n%)
  select n%
    case 503
      RR% = c%
    case 506
      GG% = c%
    case 509
      BB% = c%
  end_select
  caption n%+1,str$(c%)
  select nCouleur%
    case 1:     ' bourdure
      color 53,RR%,GG%,BB%
      CouleurBord% = (BB%*256+GG%)*256+RR%
    case 2:     ' remplissage
      color 56,RR%,GG%,BB%
      CouleurRemplissage% = (BB%*256+GG%)*256+RR%
    case 3:     ' texte
      color 59,RR%,GG%,BB%
      CouleurText% = (BB%*256+GG%)*256+RR%
  end_select
end_sub


sub couleur()
  inactive 0
  if number_click=54 then nCouleur% = 1   : ' couleur de la bordure
  if number_click=57 then nCouleur% = 2   : ' couleur de remplissage
  if number_click=60 then nCouleur% = 3   : ' couleur du texte
  select nCouleur%
    case 1:    ' couleur de la bordure
      caption 501,"Couleur de la bordure"
      RGB(CouleurBord%)
      position 503,RR%
      caption 504,str$(RR%)
      position 506,GG%
      caption 507,str$(GG%)
      position 509,BB%
      caption 510,str$(BB%)
    case 2:    ' couleur de remplissage
      caption 501,"Couleur de remplissage"
      RGB(CouleurRemplissage%)
      position 503,RR%
      caption 504,str$(RR%)
      position 506,GG%
      caption 507,str$(GG%)
      position 509,BB%
      caption 510,str$(BB%)
    case 3:    ' couleur du texte
      caption 501,"Couleur du texte"
      RGB(CouleurText%)
      position 503,RR%
      caption 504,str$(RR%)
      position 506,GG%
      caption 507,str$(GG%)
      position 509,BB%
      caption 510,str$(BB%)
  end_select
  show 500
end_sub

Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Contenu sponsorisé




MessageSujet: Re: Annoter une image avec des bulles de texte   

Revenir en haut Aller en bas
 
Annoter une image avec des bulles de texte
Voir le sujet précédent Voir le sujet suivant Revenir en haut 
Page 1 sur 1
 Sujets similaires
-
» Comment insérer une image dans les messages du forum ?
» [Résolu] Images avec des petites images lien ??
» mauvaise qualité d'image en peritel
» PAS d'image sur TV
» Effet grossissement d'image avec texte apparent

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: