Pour coincer la bulle

LABEL Clic
DIM tx$,x%,y%
WIDTH 0,660: HEIGHT 0,520
PICTURE 1: WIDTH 1,400: HEIGHT 1,194: FILE_LOAD 1,"z:\im1.jpg": ON_CLICK 1,Clic
FONT_NAME 1,"Arial": FONT_SIZE 1,14
tx$ = "Salut les amis !"+CHR$(13)+CHR$(10)+"j'arrive !"
END
' ==================
Clic:
  x% = MOUSE_X_LEFT_DOWN(1): y% = MOUSE_Y_LEFT_DOWN(1)
  Texte_Bulle(1,x%,y%,tx$,2)
  file_save 1,"Z:\img.bmp"
RETURN
' ==============================================================================+
SUB Texte_Bulle(p%,x%,y%,tx$,ang%)
  ' Texte bulle tx$ dans une ellipse à la pointe en x%,y% sur le picture p%,
  ' couleur de fond blanc, ang% = position de la bulle par rapport à la pointe:
  ' =1: haut à gauche, =2: haut à droite, =3: bas à droite, =4: bas à gauche.
  ' Texte dans la police, taille, couleur, enrichissements courants.
  DIM_LOCAL hdl%,res%,xc%,yc%,r%,g%,b%,wt%,ht%,w%,h%,xt%,yt%,i%,j%,x1%,y1%
  DIM_LOCAL dl%,cr$,hl%,k%,a$
  dl% = 900
  cr$ = CHR$(13)+CHR$(10)
  hl% = TEXT_HEIGHT(tx$,p%): wt% = 0
  DLIST dl%
  k% = INSTR(tx$,cr$)
  WHILE k%>0
      a$ = LEFT$(tx$,k%-1): tx$ = RIGHT_POS$(tx$,k%+2)
      IF TEXT_WIDTH(a$,p%)>wt% THEN wt% = TEXT_WIDTH(a$,p%)
      ITEM_ADD dl%,a$: k% = INSTR(tx$,cr$)
  END_WHILE
  IF TEXT_WIDTH(tx$,p%)>wt% THEN wt% = TEXT_WIDTH(tx$,p%)
  ITEM_ADD dl%,tx$
  FOR k% = COUNT(dl%) TO 1 STEP -1
      a$ = ITEM_READ$(dl%,k%)
      WHILE TEXT_WIDTH(a$,p%)<wt%: a$=" "+a$+" ": END_WHILE
      ITEM_DELETE dl%,k%: ITEM_INSERT dl%,k%,a$
  NEXT k%
  ht% = hl%*COUNT(dl%): ' hauteur totale du texte
  w% = wt%*1.5: h% = ht%*1.5: ' dimensios de la bulle en fonction du texte
  2D_TARGET_IS p%: PRINT_TARGET_IS p%
  hdl% = HANDLE_CANVAS(p%)
  2D_FILL_COLOR 255,255,255: 2D_PEN_COLOR 255,255,255
  SELECT ang%: ' dessin de l'ellipse
      CASE 1: x1% = x%-w%: y1% = y%-h%
      CASE 2: x1% = x%: y1% = y%-h%
      CASE 3: x1% = x%: y1% = y%
      CASE 4: x1% = x%-w%: y1% = y%
  END_SELECT
  DLL_ON "gdi32.dll"
      res% = DLL_CALL5("Ellipse",hdl%,x1%,y1%,x1%+w%-1,y1%+h%-1)
  DLL_OFF
  xc% = x1%+w%/2: yc% = y1%+h%/2: ' centre de la bulle
  FOR i% = xc%-w%/3 TO xc%+w%/3: 2D_LINE x%,y%,i%,yc%: NEXT i%
  x% = xc%-wt%/2: y% = yc%-ht%/2: ' affichage du texte
  FOR k% = 1 TO COUNT(dl%)
      PRINT_LOCATE x%,y%: PRINT ITEM_READ$(dl%,k%)
      y% = y%+hl%
  NEXT k%
  DELETE dl%
END_SUB
' ==============================================================================

rem ============================================================================
rem     Courbe en coordonnées polaires pour faire une bulle
rem           ______________________________________
rem          |                                      |
rem          |  r = 1/(1+hcos(t) * sin(t) * sin(t)) |
rem          |           avec -pi < t < pi          |
rem          |______________________________________|
rem
rem ============================================================================

dim x,y,xc,yc,r,t,p,zoom
picture 10 : full_space 10 : 2d_target_is 10 : print_target_is 10
font_bold 10 : font_color 10,0,0,255 : font_size 10,16
p = pi/180 : xc = width_client(10)/2 : yc = height_client(10)/2 : zoom = 200
2d_poly_from xc-zoom,yc
for t = 0-pi to pi step p
    r = 1/(1+hcos(t) * sin(t) * sin(t/1.8)) : ' jouer sur ce dernier sin
    x = r*cos(t)
    y = r*sin(t)
    2d_poly_to xc+x*zoom,yc+y*zoom
next t
2d_fill_color 255,255,255
print_locate xc-30,yc-10 : print "Papydall vous salue !"

rem ============================================================================

rem ============================================================================
rem              Ellipse inclinée
rem ============================================================================

Ellipse_Inclinee(300,250,150,50,45)
Ellipse_Inclinee(200,100,100,50,135)
Ellipse_Inclinee(400,350,50,20,90)
Ellipse_Inclinee(400,50,80,40,0)
Ellipse_Inclinee(100,250,80,20,0)


end
rem ============================================================================

' cx,cy : coordonnées du centre de rotation de l'ellipse
' Rx et Ry sont les longueurs des demi-diagonales
' IncliDeg : inclinaison en degrés de l'ellipse par rapport à l'horizontale dans le sens anti-horaire

SUB Ellipse_Inclinee(cx,cy,rx,ry,IncliDeg)
    dim_local a,x1,y1,xp,yp
    degrees
    2d_pen_width 2
    IncliDeg = 0-IncliDeg
    ' Calcul du point Origine
    x1 = rx*sin(IncliDeg) : y1 = ry*cos(IncliDeg)
    xp = cx + (x1*cos(IncliDeg) - y1*sin(IncliDeg))
    yp = cy + (x1*sin(IncliDeg) + y1*cos(IncliDeg))
    2d_poly_from xp,yp : ' Point de départ
    for a = 0 to 360
        x1 = rx*sin(a + IncliDeg) : y1 = ry*cos(a + IncliDeg)
        ' Application de la matrice de rotation par rapport au centre cx,cy
        xp = cx + (x1*cos(IncliDeg) - y1*sin(IncliDeg))
        yp = cy + (x1*sin(IncliDeg) + y1*cos(IncliDeg))
        2d_poly_to xp,yp : ' Tracer l'ellipse
    next a
END_SUB
rem ============================================================================

' Application d'une bulle de texte (genre BD) sur une image quelconque
LABEL Imgf,Chpos,Orient,Chpol,Chpol1,Clic,Appliq,Anul,Enr
DIM bh%,bv%,het%,f$,fs$,wi%,hi%,p%,tx$,a$,x%,y%,i%,j%,k%,cr$,pos%,wc%,hc%,sz%,wn%,hn%
cr$ = CHR$(13)+CHR$(10)
bh% = WIDTH(0)-WIDTH_CLIENT(0): bv% = HEIGHT(0)-HEIGHT_CLIENT(0)
WIDTH 0,720: BORDER_SMALL 0: FONT_BOLD 0: COLOR 0,180,255,255
ALPHA 1: TOP 1,0: CAPTION 1,"Image de fond:": COLOR 1,255,255,0
EDIT 2: TOP 2,13: LEFT 2,0: WIDTH 2,280: ON_CLICK 2,Imgf
OPEN_DIALOG 3: FILTER 3,"Image JOPG,BMP|*.jpg;*.bmp"
ALPHA 5: TOP 5,0: LEFT 5,WIDTH(2)+10: CAPTION 5,"Texte"+CHR$(10)+"de la"+CHR$(10)+" bulle:"
  COLOR 5,255,255,0
MEMO 6: TOP 6,0: LEFT 6,LEFT(5)+35: WIDTH 6,270: HEIGHT 6,75
ALPHA 7: TOP 7,0: LEFT 7,LEFT(6)+WIDTH(6)+30: CAPTION 7," Position: ": COLOR 7,255,255,0
wc% = 45: hc% = 28
PICTURE 10: TOP 10,TOP(7)+14: LEFT 10,LEFT(7)-20: WIDTH 10,wc%: HEIGHT 10,hc%
PICTURE 11: TOP 11,TOP(10): LEFT 11,LEFT(10)+wc%+5: WIDTH 11,wc%: HEIGHT 11,hc%
PICTURE 12: TOP 12,TOP(10)+hc%+4: LEFT 12,LEFT(10): WIDTH 12,wc%: HEIGHT 12,hc%
PICTURE 13: TOP 13,TOP(12): LEFT 13,LEFT(11): WIDTH 13,wc%: HEIGHT 13,hc%
  FOR k% = 10 TO 13: ON_CLICK k%,Orient: NEXT k%
  GOSUB Chpos: pos% = 1
2D_TARGET_IS 10: 2D_PEN_COLOR 255,0,0: 2D_FILL_OFF: 2D_RECTANGLE 1,1,wc%,hc%
EDIT 16: TOP 16,TOP(2)+21: WIDTH 16,160: TEXT 16,"Arial": ON_CLICK 16,Chpol
SPIN 17: TOP 17,TOP(16): LEFT 17,LEFT(16)+WIDTH(16)+3: WIDTH 17,40
  MIN 17,1: MAX 17,255: POSITION 17,14: ON_CHANGE 17,Appliq
LIST 18: HIDE 18: TOP 18,TOP(16)+25: LEFT 18,LEFT(16): WIDTH 18,WIDTH(16)+20
  HEIGHT 18,350: FONT_NAMES_LOAD 18: ON_CLICK 18,Chpol1
  FOR i% = COUNT(18) TO 1 STEP -1
      a$ = ITEM_READ$(18,i%): IF LEFT$(a$,1) = "@" THEN ITEM_DELETE 18,i%
  NEXT i%
CHECK 20: TOP 20,TOP(16)+4: WIDTH 20,40: LEFT 20,LEFT(17)+WIDTH(17)+5: CAPTION 20,"G"
CHECK 21: TOP 21,TOP(20): WIDTH 21,WIDTH(20): LEFT 21,LEFT(20)+30: CAPTION 21,"I"
CHECK 22: TOP 22,TOP(21): WIDTH 22,WIDTH(20): LEFT 22,LEFT(21)+30: CAPTION 22,"S"
  FOR i% = 20 TO 22: ON_CLICK i%,Appliq: NEXT i%
BUTTON 25: TOP 25,TOP(16)+24: HEIGHT 25,20: WIDTH 25,50: CAPTION 25,"Annul": ON_CLICK 25,Anul
BUTTON 26: TOP 26,TOP(25): HEIGHT 26,HEIGHT(25): LEFT 26,55: CAPTION 26,"Enregistrer"
  ON_CLICK 26,Enr
SAVE_DIALOG 27: FILTER 27,"Image BMP|*.bmp"

het% = TOP(25)+22: ' hauteur de l'en-tête
p% = 30: PICTURE p%: TOP p%,het%: ON_CLICK p%,Clic
         FONT_NAME p%,TEXT$(16): FONT_SIZE p%,POSITION(17)
GOSUB Appliq
END
' ==============================================================================
Imgf:
  f$ = FILE_NAME$(3): TEXT 2,f$
  DimJpgBmp(f$): ' -> dimensions image wi% x hi%
  wn% = 0
  IF hi% > (SCREEN_Y-bv%-het%-30)
      hn% = SCREEN_Y-bv%-het%-30: wn% = hn%*wi%/hi%
  ELSE
      IF wi% > SCREEN_X-bh%
          wn% = SCREEN_X-bh%: hn% = wn%*hi%/wi%
      END_IF
  END_IF
  IF wn% > 0
      RedimImg(f$,wn%,hn%,""): ' -> clipboard
      wi% = wn%: hi% = hn%
  END_IF
  WIDTH 0,wi%+bh%: IF WIDTH(0) > SCREEN_X THEN WIDTH 0,SCREEN_X
  HEIGHT 0,hi%+bv%+het%+30: IF HEIGHT(0) > (SCREEN_Y-30) THEN HEIGHT 0,SCREEN_Y-30
  IF WIDTH(0)<720 THEN WIDTH 0,720
  WIDTH p%,wi%: HEIGHT p%,hi%
  IF wn% = 0
      FILE_LOAD p%,f$
  ELSE
      CLIPBOARD_PASTE p%
  END_IF
RETURN
' ==============================================================================
Clic:
  IF COUNT(6) = 0 THEN RETURN: ' pas de texte
  x% = MOUSE_X_LEFT_DOWN(p%): y% = MOUSE_Y_LEFT_DOWN(p%)
  tx$ = ""
  FOR i% = 1 TO COUNT(6)
      tx$ = tx$+ITEM_READ$(6,i%)+cr$
  NEXT i%
  tx$ = LEFT$(tx$,LEN(tx$)-2)
  CLIPBOARD_COPY p%
  Texte_Bulle(p%,x%,y%,tx$,pos%)
RETURN
' ==============================================================================
Chpos:
  FOR k% = 10 TO 13
    2D_TARGET_IS k%: CLS: 2D_PEN_COLOR 0,0,0: 2D_PEN_WIDTH 2: 2D_FILL_ON
    SELECT k%
        CASE 10: x% = wc%: y% = hc%
        CASE 11: x% = 0: y% = hc%
        CASE 12: x% = wc%: y% = 0
        CASE 13: x% = 0: y% = 0
    END_SELECT
    2D_LINE wc%/2,hc%/2,x%,y%: 2D_PEN_WIDTH 3: 2D_CIRCLE x%-1,y%-1,5
    2D_PEN_WIDTH 2: 2D_CIRCLE wc%/2,hc%/2,hc%/3
  NEXT k%
RETURN
' ==============================================================================
Orient:
  ' position de la flèche par rapport à l'ellipse
  GOSUB Chpos
  i% = NUMBER_CLICK
  SELECT i%
      CASE 10: pos% = 1
      CASE 11: pos% = 2
      CASE 12: pos% = 4
      CASE 13: pos% = 3
  END_SELECT
  2D_TARGET_IS i%: 2D_PEN_COLOR 255,0,0: 2D_FILL_OFF: 2D_RECTANGLE 1,1,wc%,hc%
  2D_PEN_COLOR 0,0,0: 2D_PEN_WIDTH 1
RETURN
' ==============================================================================
Chpol:
  SHOW 18: ' choix de la police
RETURN
' ==============================================================================
Chpol1:
  TEXT 16,ITEM_INDEX$(18)
  HIDE 18
  GOSUB Appliq
RETURN
' ==============================================================================
Appliq:
  ' application des paramètres de texte au picture
  FONT_NAME p%,TEXT$(16): FONT_SIZE p%,POSITION(17)
  FONT_BOLD_OFF p%: FONT_ITALIC_OFF p%: FONT_UNDERLINE_OFF p%
  FONT_NAME 6,TEXT$(16): FONT_SIZE 6,POSITION(17)
  FONT_BOLD_OFF 6: FONT_ITALIC_OFF 6: FONT_UNDERLINE_OFF 6
  IF CHECKED(20) = 1 THEN FONT_BOLD p%: FONT_BOLD 6
  IF CHECKED(21) = 1 THEN FONT_ITALIC p%: FONT_ITALIC 6
  IF CHECKED(22) = 1 THEN FONT_UNDERLINE p%: FONT_UNDERLINE 6
RETURN
' ==============================================================================
Anul:
  ' Annul dernier
  CLIPBOARD_PASTE p%
RETURN
' ==============================================================================
Enr:
  ' Enregistrer le résultat
  fs$ = FILE_NAME$(27)
  FILE_SAVE p%,fs$
RETURN
' ==============================================================================
SUB Texte_Bulle(p%,x%,y%,tx$,ang%)
  ' Texte bulle tx$ dans une ellipse à la pointe en x%,y% sur le picture p%,
  ' couleur de fond blanc, ang% = position de la bulle par rapport à la pointe:
  ' =1: haut à gauche, =2: haut à droite, =3: bas à droite, =4: bas à gauche.
  ' Texte dans la police, taille, couleur, enrichissements courants du picture.
  ' Le texte peut comporter plusieurs lignes, séparées par des cr/lf (0D0A),
  ' les lignes seront centrées entre elles.
  DIM_LOCAL hdl%,res%,xc%,yc%,r%,g%,b%,wt%,ht%,w%,h%,xt%,yt%,i%,j%,x1%,y1%
  DIM_LOCAL dl%,cr$,hl%,k%,a$
  dl% = 900
  cr$ = CHR$(13)+CHR$(10)
  hl% = TEXT_HEIGHT(tx$,p%): wt% = 0
  DLIST dl%
  k% = INSTR(tx$,cr$)
  WHILE k%>0
      a$ = LEFT$(tx$,k%-1): tx$ = RIGHT_POS$(tx$,k%+2)
      IF TEXT_WIDTH(a$,p%)>wt% THEN wt% = TEXT_WIDTH(a$,p%)
      ITEM_ADD dl%,a$: k% = INSTR(tx$,cr$)
  END_WHILE
  IF TEXT_WIDTH(tx$,p%)>wt% THEN wt% = TEXT_WIDTH(tx$,p%): ' largeur totale texte
  ITEM_ADD dl%,tx$
  FOR k% = COUNT(dl%) TO 1 STEP -1: ' centrage des lignes
      a$ = TRIM$(ITEM_READ$(dl%,k%))
      WHILE TEXT_WIDTH(a$,p%)<wt%: a$=" "+a$+" ": END_WHILE
      ITEM_DELETE dl%,k%: ITEM_INSERT dl%,k%,RTRIM$(a$)
  NEXT k%
  ht% = hl%*COUNT(dl%): ' hauteur totale du texte
  w% = wt%*1.5: h% = ht%*1.5: ' dimensios de la bulle en fonction du texte
  2D_TARGET_IS p%: PRINT_TARGET_IS p%
  hdl% = HANDLE_CANVAS(p%)
  2D_FILL_COLOR 255,255,255: 2D_PEN_COLOR 255,255,255
  SELECT ang%: ' dessin de l'ellipse
      CASE 1: x1% = x%-w%: y1% = y%-h%
      CASE 2: x1% = x%: y1% = y%-h%
      CASE 3: x1% = x%: y1% = y%
      CASE 4: x1% = x%-w%: y1% = y%
  END_SELECT
  DLL_ON "gdi32.dll"
      res% = DLL_CALL5("Ellipse",hdl%,x1%,y1%,x1%+w%,y1%+h%)
  DLL_OFF
  xc% = x1%+w%/2: yc% = y1%+h%/2: ' centre de la bulle
  FOR i% = xc%-w%/3 TO xc%+w%/3: 2D_LINE x%,y%,i%,yc%: NEXT i%: ' dessin flèche
  x% = xc%-wt%/2: y% = yc%-ht%/2: ' affichage du texte
  FOR k% = 1 TO COUNT(dl%)
      PRINT_LOCATE x%,y%: PRINT ITEM_READ$(dl%,k%)
      y% = y%+hl%
  NEXT k%
  DELETE dl%
END_SUB
' ==============================================================================
SUB DimJpgBmp(f$)
   ' Image JPG ou BMP exclusivement, dimensions dans wi% et hi%
   DIM_LOCAL fm$: fm$ = "Z:\Provy.bmp"
   PICTURE 1099: HIDE 1099: FILE_LOAD 1099,f$: FILE_SAVE 1099,fm$: DELETE 1099
   FILEBIN_OPEN_READ 1,fm$
      FILEBIN_POSITION 1,18: wi% = FILEBIN_READ(1)+256*FILEBIN_READ(1)
      FILEBIN_POSITION 1,22: hi% = FILEBIN_READ(1)+256*FILEBIN_READ(1)
   FILEBIN_CLOSE 1
   FILE_DELETE fm$
END_SUB
' ==============================================================================
SUB RedimImg(f$,w%,h%,fr$)
  ' Redimensionner l'image f$ (BMP ou JPG) en w%,h%, résultat dans fr$ (BMP)
  ' Si fr$ = "", résultat dans le prese-papier
  ' Si w% = 0 ou h% = 0: redimensionnement proportionnel
  DIM_LOCAL fm$,wi%,hi%,cx,cy,op%
  fm$ = "C:\TEMP\Provimg.bmp"
  op% = 1900: ' objet provisoire
  IF UPPER$(FILE_EXTRACT_EXTENSION$(f$)) = ".JPG"
      PICTURE op%: FILE_LOAD op%,f$: FILE_SAVE op%,fm$: DELETE op%: f$ = fm$
  END_IF
  FILEBIN_OPEN_READ 1,f$
      FILEBIN_POSITION 1,18: wi% = FILEBIN_READ(1)+256*FILEBIN_READ(1)
      FILEBIN_POSITION 1,22: hi% = FILEBIN_READ(1)+256*FILEBIN_READ(1)
  FILEBIN_CLOSE 1
  IF h% = 0 THEN h% = w%*hi%/wi%
  IF w% = 0 THEN w% = h%*wi%/hi%
  cx = w%/wi%: cy = h%/hi%
  SCENE2D op%: HIDE op%: WIDTH op%,w%: HEIGHT op%,h%
  SPRITE op%: SPRITE_FILE_LOAD op%,f$: SPRITE_SCALE op%,cx,cy
  IF fr$ = ""
      SNAPSHOT op%,fm$
      PICTURE op%+1: FILE_LOAD op%+1,fm$: CLIPBOARD_COPY op%+1
      DELETE op%+1
  ELSE
      SNAPSHOT op%,fr$
  END_IF
  DELETE op%: IF FILE_EXISTS(fm$) = 1 THEN FILE_DELETE fm$
END_SUB
' ==============================================================================