Annoter une image avec des bulles de texte

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.

Belle application !
cheers

Bel ajout de fonctionnalités

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

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:
Annoter une image avec des bulles de texte Aa125

Waouh !

Très belle réussite !

MERCI KLAUS !

Spoiler:

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

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é !

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

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

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

Ok. merci pour le retour. Je vais sécuriser cela.

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

» Écrire un texte dans une image
» Texte sur image
» Ecrire un texte sur une image.
» Bulle de texte sur image
» Cryptage d'un texte Ascii en image bmp