Affichage d'un texte formaté dans un picture

DIM p%,txt$,x%,y%,fnt$,sz%,cr$,a$,k%,wt%,ht%
cr$ = CHR$(13)+CHR$(10)
txt$ = "Au clair de la lune"+cr$
txt$ = txt$+"Mon <B>ami</B> Pierrot"+cr$
txt$ = txt$+"<S=16>Prête-moi <I>ta plume</I>"
txt$ = txt$+cr$+"<F=Lucida Console><S=14>Pour <C=hFF0000>écrire<C=000000> un mot"
PICTURE 1: FULL_SPACE 1
PICTURE 2: HIDE 2
x% = 20: y% = 30: fnt$ = "Arial": sz% = 12
Textformat(1,txt$,x%,y%,fnt$,sz%)
END

SUB Textformat(p%,txt$,x%,y%,fnt$,sz%)
  ' Affichage du texte txt$ sur le picture p% en x%,y%,
  ' Police et taille de départ fnt$ et sz% (fnt$="" et sz%=0: fonte et taille actuels)
  ' avec enrichissements dans le corps du texte:
  ' <F=...> police, <S=...> taille,
  ' <C=hRRGGBB...> couleur RGB sous forme hexa, ou <C=xxx...> sous forme numérique
  ' <B>...</B> gras, <I>...</I> italique, <U>...</U> souligné
  ' Les dimensions résultantes du texte en pixels sont rendues dans le clipboard
  ' sous la forme d'une chaîne Ascii: "www,hhh"
  DIM_LOCAL me%,i%,j%,k%,k1%,a$,s$,a1$,c$,r%,g%,b%,hl%,xi%,yi%,w%
  me% = 800: MEMO me%: HIDE me%: WIDTH me%,1000: ITEM_ADD me%,txt$
  PRINT_TARGET_IS p%
  IF fnt$<>"" THEN FONT_NAME p%,fnt$
  IF sz% <> 0 THEN FONT_SIZE p%,sz%
  xi% = x%: yi% = y%: w% = 0
  FOR i% = 1 TO COUNT(me%)
      a$ = ITEM_READ$(me%,i%)
      k1% = 0: k% = INSTR(a$,"<"): IF k% > 0 THEN k1% = INSTR_POS(a$,">",k%+1)
      WHILE k1%>0
          PRINT_LOCATE x%,y%: a1$= LEFT$(a$,k%-1): PRINT a1$
          x% = x%+TEXT_WIDTH(a1$,p%)
          s$ = MID$(a$,k%+1,k1%-k%-1): a$ = RIGHT_POS$(a$,k1%+1)
          IF MID$(s$,2,1) = "="
              IF LEFT$(s$,2)="F=": ' Fonte
                  FONT_NAME p%,RIGHT_POS$(s$,3)
              END_IF
              IF LEFT$(s$,2)="S=": ' Taille
                  FONT_SIZE p%,VAL(RIGHT_POS$(s$,3))
              END_IF
             IF LEFT$(s$,2) = "C=": ' Couleur
                  IF UPPER$(MID$(s$,3,1)) = "H": ' couleur sous forme hexa RRGGBB
                    r%=HEX(MID$(s$,4,2)): g%=HEX(MID$(s$,6,2)): b%=HEX(MID$(s$,8,2))
                  ELSE: ' couleur sous forme numérique R*65536+G*256+B
                    j% = VAL(RIGHT_POS$(s$,3))
                    r%=INT(j%/65536): g%=BIN_AND(j%,65280)/256: b%=BIN_AND(j%,255)
                  END_IF
                  FONT_COLOR p%,r%,g%,b%
              END_IF
          ELSE
              IF s$ = "B" THEN FONT_BOLD p%
              IF s$ = "/B" THEN FONT_BOLD_OFF p%
              IF s$ = "I" THEN FONT_ITALIC p%
              IF s$ = "/I" THEN FONT_ITALIC_OFF p%
              IF s$ = "U" THEN FONT_UNDERLINE p%
              IF s$ = "/U" THEN FONT_UNDERLINE_OFF p%
          END_IF
          ' a$ = RIGHT_POS$(a$,k1%+1)
          k1%=0: k% = INSTR(a$,"<"): IF k% > 0 THEN k1% = INSTR_POS(a$,">",k%+1)
      END_WHILE
      IF a$ = "" THEN a$ = " "
      PRINT_LOCATE x%,y%: PRINT a$: j%=x%+TEXT_WIDTH(a$,p%): IF j%>w% THEN w%=j%
      hl% = TEXT_HEIGHT(a$,p%)
      x% = xi%: y% = y%+hl%
  NEXT i%
  CLIPBOARD_STRING_COPY STR$(w%-xi%)+","+STR$(y%-yi%): ' dimensions du texte
  DELETE me%
END_SUB

DIM frtf$,fbmp$
frtf$ = "C:\TEMP\MonDocument.rtf": ' document créé dans WordPad
fbmp$ = "Z:\Imgbmp.bmp": ' image résultante (chemin à adapter)
WIDTH 0,600: HEIGHT 0,SCREEN_Y-30: BORDER_SMALL 0: COLOR 0,164,255,255
RtfToBmp(frtf$,fbmp$)
' Affichage du résultat:
PICTURE 1: TOP 1,10: LEFT 1,10: WIDTH 1,550: HEIGHT 1,HEIGHT(0)-50
CAPTION 0,clipboard_string_paste$: ' dimensions de l'image
FILE_LOAD 1,fbmp$
END
' ==============================================================================
SUB RtfToBmp(frtf$,fbmp$)
  ' Conversion d'un texte formaté .RTF en image .BMP (ou clip si fbmp$="")
  ' Si fichier, les dimensions sont dans le clipboard, sous la forme wwwxhhh)
  ' Le Form 0 doit être assez grand pour contenir l'ensemble du texte.
  DIM_LOCAL RE%,res%,wt%,ht%,fm%,im%,mg%,mh%,x%,y%
  mg%=(WIDTH(0)-WIDTH_CLIENT(0))/2: mh%=HEIGHT(0)-HEIGHT_CLIENT(0)-mg%: ' marges Form 0
  DLL_ON "C:\PANORAMIC\KGF\KGF.dll": '  <================== À ADAPTER ==========
  RE% = DLL_CALL1("RichEditCreate",HANDLE(0))
  res% = DLL_CALL5("RichEditGeometry",RE%,0,0,600,800): ' x, y, w, h
  res% = DLL_CALL2("RichEditFileLoad",RE%,ADR(frtf$))
  ' dimensions du résultat :
  res% = DLL_CALL4("RichEditGetTextSizes",RE%,HANDLE(0),ADR(wt%),ADR(ht%))
  fm%=900
  FORM fm%: TOP fm%,0: LEFT fm%,0: WIDTH fm%,SCREEN_X: HEIGHT fm%,SCREEN_Y
    BORDER_HIDE fm%: HIDE fm%: 2D_TARGET_IS fm%: WAIT 100
  ht% = ht%-ht%/3
  x% = LEFT(0)+mg%+3: y% = TOP(0)+mh%+3: ' (bordures du RE% = 3 pixels)
  im%=fm%+1: IMAGE im%: 2D_IMAGE_COPY im%,x%,y%,x%+wt%,y%+ht%: ' capture de l'image affichée
  res% = DLL_CALL1("RichEditDelete",RE%): ' suppression du RichEdit
  DLL_OFF
  IF fbmp$ = ""
      CLIPBOARD_COPY im%
  ELSE
      FILE_SAVE im%,fbmp$: clipboard_string_copy str$(wt%)+"x"+str$(ht%)
  END_IF
  2D_TARGET_IS 0: DELETE fm%: DELETE im%
END_SUB
' ==============================================================================

H$ = right$("0000000"+hex$(couleur%),8)

couleur%=(B%*266+G%)*256+R%

             IF LEFT$(s$,2) = "C=": ' Couleur
                  IF UPPER$(MID$(s$,3,1)) = "H": ' couleur sous forme hexa RRGGBB
                    r%=HEX(MID$(s$,4,2)): g%=HEX(MID$(s$,6,2)): b%=HEX(MID$(s$,8,2))
                  ELSE: ' couleur sous forme numérique R*65536+G*256+B
                    j% = VAL(RIGHT_POS$(s$,3))
                    r%=INT(j%/65536): g%=BIN_AND(j%,65280)/256: b%=BIN_AND(j%,255)
                  END_IF
                  FONT_COLOR p%,r%,g%,b%
              END_IF

a$ = CLIPBOARD_STRING_PASTE$: k% = INSTR(a$,",")
wt%=VAL(LEFT$(a$,k%-1)): ht%=VAL(RIGHT_POS$(a$,k%+1)): ' dimensions du texte créé
message "w="+str$(wt%)+" h="+str$(ht%)

res% = dll_call2("RichEditHtmlFileSave",RE%,adr(html$))

' test_RichEditHtmlFileSave.bas

label close0
dim res%, RTF$, HTML$, RE%


on_close 0,close0
dll_on "KGF.dll"

RE% = dll_call1("RichEditCreate",handle(0))
res% = dll_call5("RichEditGeometry",RE%,10,40,400,300)

RTF$ = "MonDocument.rtf"
res% = dll_call2("RichEditFileLoad",RE%,adr(RTF$))

HTML$ = "MonDocument.html"
res% = dll_call2("RichEditHtmlFileSave",RE%,adr(HTML$))
 
end

close0:
  res% = dll_call1("RichEditDelete",RE%)
  return

' Affichage dans un HVIEWER d'un texte formaté au format .RTF (Wordpad)
DIM f$,wh%,hh%
COLOR 0,180,255,255
f$ = "C:\TEMP\MonDocument.rtf": ' document créé dans WordPad
wh% = 340: hh% = 200: ' Dimensions du HVIEWER en fonction du texte à afficher
HVIEWER 10: TOP 10,20: LEFT 10,50: WIDTH 10,wh% : HEIGHT 10,hh%
RtfToScreen(f$,10)
END
' ==============================================================================
SUB RtfToScreen(f$,h%)
  ' Affichage d'un fichier f$ .rtf (origine wordpad) dans un Hviewer h%
  DIM_LOCAL RE%,res%,fhtm$,wh%,hh%
  wh% = WIDTH(h%): hh% = HEIGHT(h%)
  fhtm$ = "C:\TEMP\Mondoc.htm"
  DLL_ON "C:\PANORAMIC\KGF\KGF.dll": '  <================== À AJUSTER ==========
    RE% = dll_call1("RichEditCreate",handle(0))
    res% = dll_call5("RichEditGeometry",RE%,0,1200,wh%,hh%)
    res% = dll_call2("RichEditFileLoad",RE%,adr(f$))
    res% = dll_call2("RichEditHtmlFileSave",RE%,adr(fhtm$))
    res% = dll_call1("RichEditDelete",RE%)
  DLL_OFF
  FILE_LOAD h%,fhtm$: FILE_DELETE fhtm$
END_SUB
' ==============================================================================

dim Largeur%, Hauteur%
...
  Largeur% = dll_call3("RichEditFunction",RE%,14,adr(Hauteur%))
  message "Largeur="+str$(Largeur%)+"  Hauteur="+str$(Hauteur%)

SUB RtfToScreen(frtf$,h%)
  ' Affichage dans le Hviewer h% d'un fichier texte formaté f$ (.rtf)
  ' (créé dans Wordpad)
  DIM_LOCAL RE%,res%,fhtm$,wt%,ht%
  fhtm$ = "C:\TEMP\Mondoc.htm": ' fichier provisoire résultat format htm
  DLL_ON "C:\PANORAMIC\KGF\KGF.dll": '  <================== À AJUSTER ==========
    RE% = DLL_CALL1("RichEditCreate",handle(0))
    res% = DLL_CALL5("RichEditGeometry",RE%,0,1200,600,600): ' créé hors écran
    res% = DLL_CALL2("RichEditFileLoad",RE%,adr(frtf$))
    res% = DLL_CALL2("RichEditHtmlFileSave",RE%,adr(fhtm$)): ' conversion rtf -> htm
    wt% = DLL_CALL3("RichEditFunction",RE%,14,ADR(ht%)): ' dimensions du résultat
    res% = DLL_CALL1("RichEditDelete",RE%)
  DLL_OFF
  message str$(wt%)+" x "+str$(ht%)
  WIDTH h%,wt%: HEIGHT h%,ht%
  FILE_LOAD h%,fhtm$: FILE_DELETE fhtm$
END_SUB