Texte sur cercle

' Texte sur cercle
DIM f$,fr$,q$,xc%,yc%,ry%,tx$,pol$,sz%,rgb%,gis$
fr$ = "Z:\Img.jpg"
tx$ = "  JOYEUX PANORAMIC !"
PICTURE 1: FULL_SPACE 1: 2D_TARGET_IS 1

PRINT_TARGET_IS 1
pol$ = "Lucida Console": sz% = 32: ' police, taille
gis$ = "G": rgb% = 255*65536: ' gras, rouge
xc% = 250: yc% = 220: ry% = 150: ' cercle
Texte_sur_cercle(1,xc%,yc%,ry%,tx$,pol$,sz%,rgb%,gis$)
END
' ==============================================================================
SUB Texte_sur_cercle(p%,xc%,yc%,ry%,tx$,pol$,sz%,rgb%,gis$)
  ' Apposition dans le picture p% du texte tx$ sur le cercle
  ' centré en xc%,yc%,de rayon ry%
  ' Police texte pol$, taille sz%, couleur rgb% (R*65536+G*256+B)
  ' enrichissements gis$ = "G", "I", "S", combinables.
  IF LABEL("Rotima") = 0 THEN LABEL Rotima
  DIM_LOCAL px%,q$,wt%,wc%,hc%,rt%,ci%,an%,a1%,a2%,ac%,aa%,rot%,i%,a$,x%,y%
  DIM_LOCAL rtm$,f$,fr$,ftm$
  DIM_LOCAL w%,h%,ax%,ay%,dx%,dy%,res%,hg$,hd$,bd$,bg$,r%,g%,b%
  DIM_LOCAL kgf$: kgf$ = "C:\PANORAMIC\KGF\KGF.dll": ' <===== A AJUSTER !
  rtm$ = "C:\TEMP": ' répertoire des fichiers provisoires    A AJUSTER
  f$ = rtm$+"Im1.bmp"
  fr$ = rtm$+"Im2.bmp"
  ftm$ = rtm$+"TmpImg.bmp": ' A ajuster
  q$ = CHR$(34)
  2D_TARGET_IS p%
  DEGREES
  px%=990: PICTURE px%: HIDE px%: FONT_NAME px%,pol$: FONT_SIZE px%,sz%
  gis$ = UPPER$(gis$): IF INSTR(gis$,"G") > 0 THEN FONT_BOLD px%
  IF INSTR(gis$,"I") > 0 THEN FONT_ITALIC px%
  IF INSTR(gis$,"S") > 0 THEN FONT_UNDERLINE px%
  r% = INT(rgb%/65536): g% = BIN_AND(rgb%,65280)/256: b% = BIN_AND(rgb%,255)
  FONT_COLOR px%,r%,g%,b%
  PRINT_TARGET_IS px%
  wt% = TEXT_WIDTH(tx$,px%): ' largeur du texte, en pixels
  wt% = wt%+wt%/5: ' + écartement supplémentaire
  wc% = wt%/LEN(tx$): hc% = TEXT_HEIGHT(tx$,px%): ' dimensions d'un caractère
  i% = wc%: IF hc%>wc% THEN i% = hc%
  WIDTH px%,i%: HEIGHT px%,i%
  IMAGE px%+1
  ci% = 2*PI*ry%: ' circonférence
  an% = 360*wt%/ci%: ' angle occupé par tout le texte
  ac% = an%/LEN(tx$): ' angle occupé par un caractère
  a1% = 90+an%/2: ' angle de départ
  rt% = ry%+hc%: ' rayon de base des caractères
  rt% = rt%+rt%/20
  aa% = a1%
  DLL_ON kgf$
  FOR i% = 1 TO LEN(tx$)
      a$ = MID$(tx$,i%,1)
      IF a$ <> " "
          PRINT_LOCATE 0,0: PRINT a$
          IF aa% > 90
              rot% = -1*(aa%-90)
          ELSE
              rot% = 90-aa%
          END_IF
          CLIPBOARD_COPY px%
          w% = WIDTH(px%): h% = HEIGHT(px%)
          GOSUB Rotima
          x% = xc%+rt%*COS(aa%): y% = yc%-rt%*SIN(aa%)
          2D_IMAGE_PASTE px%+1,x%,y%
      END_IF
      aa% = aa%-ac%
  NEXT i%
  DLL_OFF
  PRINT_TARGET_IS p%: DELETE px%: DELETE px%+1
  EXIT_SUB
Rotima:
  IF FILE_EXISTS(ftm$) = 1 THEN FILE_DELETE ftm$
  ax% = w%*COS(rot%): ay% = h%*COS(rot%)
  dx% = h%*SIN(rot%): dy% = w%*SIN(rot%)
  hg$ = STR$(dx%)+",0": hd$ = STR$(dx%+ax%)+","+STR$(dy%)
  bd$ = STR$(ax%)+","+STR$(dy%+ay%): bg$ = "0,"+STR$(ay%)
    res% = DLL_CALL0("LoadPicture")
    res% = DLL_CALL4("TorturePicture",ADR(hg$),ADR(hd$),ADR(bd$),ADR(bg$))
    res% = DLL_CALL0("SavePicture")
  CLIPBOARD_PASTE px%+1: ' -> IMAGE
RETURN
END_SUB
' ==============================================================================