Encadrer une image

' Encadrement.bas
DIM f$,fc$,fp$,wi,hi,p,ex,ei,wb,wc,hc,a$,xc,yc,h
LABEL Chimg,DimJpgBmp,Crecad
fp$ = "C:\Tmp.bmp"
fc$ = "Z:\Cadre.bmp": ' <- Sauvegarde du résultat (bmp), À AJUSTER !
BORDER_SMALL 0: FONT_SIZE 0,12: COLOR 0,220,255,255
ALPHA 1: TOP 1,3: CAPTION 1,"Image:"
EDIT 2: TOP 2,1: LEFT 2,50: WIDTH 2,300: TEXT 2,"(clic)": ON_CLICK 2,Chimg
OPEN_DIALOG 3
ALPHA 4: TOP 4,TOP(1): LEFT 4,LEFT(2)+WIDTH(2)+5: ' dimensions image
BUTTON 10: TOP 10,5: LEFT 10,LEFT(4)+140: WIDTH 10,60: HEIGHT 10,40
           CAPTION 10,"Créer": ON_CLICK 10,Crecad
ALPHA 11: TOP 11,TOP(1)+25: CAPTION 11,"Étiquette:"
EDIT 12: TOP 12,TOP(11)-2: LEFT 12,70: WIDTH 12,200
CONTAINER_OPTION 14: TOP 14,TOP(12): LEFT 14,LEFT(12)+WIDTH(12)+5: HEIGHT 14,20
OPTION 15: PARENT 15,14: CAPTION 15,"Bas": MARK_ON 15
OPTION 16: PARENT 16,14: LEFT 16,50: CAPTION 16,"Haut"
p = 100: PICTURE p: TOP p,60: LEFT p,6: HIDE p
IMAGE p+1
END
' =============================================================================
Chimg:
  f$ = FILE_NAME$(3): TEXT 2,f$: GOSUB DimJpgBmp
  CAPTION 4,STR$(wi)+" x "+STR$(hi)+" pixels"  
RETURN
' =============================================================================
DimJpgBmp:
  IF FILE_EXTRACT_EXTENSION$(UPPER$(f$)) <> ".BMP"
      FILE_LOAD p,f$: FILE_SAVE p,fp$: f$ = fp$
  END_IF
  FILE_LOAD p+1,f$
  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 FILE_EXISTS(fp$) = 1 THEN FILE_DELETE fp$
RETURN  
' =============================================================================
Crecad:
  2D_TARGET_IS p
  ex = wi/15: IF ex<20 THEN ex = 20: ' largeur partie extérieure du cadre
  ei = INT(ex/2.5): ' largeur partie intérieure du cadre
  wb = ex+ei: ' largeur totale cadre
  wc = wi+2*wb: hc = hi+2*wb: ' dimensions extérieures
  WIDTH 0,wc+30: HEIGHT 0,hc+110: IF WIDTH(0)<600 THEN WIDTH 0,600
  WIDTH p,wc+5: HEIGHT p,hc+5
  2D_PEN_WIDTH 1: 2D_PEN_COLOR 0,0,0
  2D_RECTANGLE 0,0,wc,hc: 2D_FLOOD 5,5,180,96,0: ' plat du cadre
  2D_RECTANGLE ex,ex,wc-ex,hc-ex
  2D_IMAGE_PASTE p+1,wb,wb
  2D_FILL_OFF: 2D_RECTANGLE wb,wb,wc-wb,hc-wb
  2D_LINE 0,0,wb,wb: 2D_LINE wc,0,wc-wb,wb
  2D_LINE 0,hc,wb,hc-wb: 2D_LINE wc,hc,wc-wb,hc-wb
  ' colorisation du cadre
  2D_FLOOD wb,wb-ei/2,128,64,0: ' intérieur haut
  2D_FLOOD wb-ei/2,wb,128,64,0: ' intérieur gauche
  2D_FLOOD wc-wb+ei/2,hc-wb+ei/2,200,128,64: ' intérieur droite
  2D_FLOOD wb,hc-wb+ei/2,200,128,64: ' intérieur bas
  2D_PEN_WIDTH 4: 2D_LINE 0,hc+2,wc+2,hc: 2D_POLY_TO wc+2,0
  2D_PEN_WIDTH 3: 2D_LINE wb,hc-wb-1,wb,wb: 2D_POLY_TO wc-wb-1,wb
  wc = wc+2: hc = hc+2: WIDTH p,wc: HEIGHT p,hc
  a$ = TEXT$(12)
  IF a$ <> ""
      h = ex-2
      xc = wc/2: yc = ex/2: IF CHECKED(15) = 1 THEN yc = hc-ex/2
      Etiq_Oreil(xc,yc,h,a$)
  END_IF
  FILE_SAVE p,fc$
  SHOW p  
RETURN
' =============================================================================
SUB Etiq_Oreil(xc,yc,h,txt$)
  ' Dessin d'une étiquette avec oreillettes, texte txt$,
  ' centrée en xc,yc, hauteur h, sur 2D_Target,
  ' options courantes de police et d'enrichissement du texte
  ' (la taille de police est calculée)
  DIM_LOCAL p%,wt,ht,we,he,x0,y0,xce,yce,x,y,xt,yt,r,a
  p% = NUMBER_2D_TARGET: PRINT_TARGET_IS p%
  FONT_SIZE p%,h/2 
  wt = TEXT_WIDTH(txt$,p%): ht = TEXT_HEIGHT(txt$,p%): ' dim. texte
  we = wt+20: he = h: ' dimensions du rectangle contenant
  x0 = xc-we/2: y0 = yc-he/2: r = h/4: ' rayon des oreillettes
  xt = xc-wt/2: yt = yc-ht/2
  DEGREES: 2D_PEN_WIDTH 2
  2D_LINE x0,y0,x0+we,y0: 2d_pen_width 3: 2D_POLY_TO x0+we,y0+r
  xce = x0+we: yce = y0+h/2: 2D_ARC xce,yce,r,90,270
  2D_LINE x0+we,y0+3*r,x0+we,y0+h
  2D_POLY_TO x0,y0+h: 2d_pen_width 2: 2D_POLY_TO x0,y0+3*r
  xce = x0: 2D_ARC xce,yce,r,270,90
  2D_LINE x0,y0+r,x0,y0: 2D_FLOOD xc,yc,255,215,0
  2D_PEN_WIDTH 3: 2D_CIRCLE xce,yce,r/5: 2D_CIRCLE x0+we,yce,r/5
  PRINT_LOCATE xt,yt: PRINT txt$
END_SUB
' =============================================================================