Texte sur image

' Texte_sur_Image.bas : Texte sur image
LABEL Chf,Chc,Chc1,Chp,Chp1,Appliq,Deplace
DIM f$,fr$,x%,y%,rc$,w%,h%,wc%,hc%,w0%,h0%,wl%,wi%,hi%,et%,ed1%,ed2%
DIM i%,j%,k%,a$,ed%,m%,p%,fp%,fc%,pc%,er%,en%,ckt%,cke%,ckg%,pm%,bd%,ro
DIM po$,sz%,r%,g%,b%,coul%,attr%,RL$
rc$ = CHR$(13)+CHR$(10)
f$ = "C:\GRAPH\JPG\goldgate.jpg"
fr$ = "C:\TEMP\Result.bmp"
IF FILE_EXISTS(fr$) = 1 THEN FILE_DELETE fr$
DATA 0,0,0,0,0,128,0,128,0,0,128,128,128,0,0,128,0,128,128,64,0,192,192,192
DATA 128,128,128,0,0,255,0,255,0,0,255,255,255,0,0,255,0,255,255,255,0,255,255,255

w% = 720: h% = 540: ' dimensions maxi de l'aperçu
wl% = 250
BORDER_SMALL 0
wc% = WIDTH(0)-WIDTH_CLIENT(0): hc% = HEIGHT(0)-HEIGHT_CLIENT(0)
w0% = w%+wl%+wc%: h0% = h%+hc%
WIDTH 0,w0%: HEIGHT 0,h0%: COLOR 0,190,255,255
FONT_NAME 0,"Arial": FONT_BOLD 0: CAPTION 0,"          -  TEXTE  SUR  IMAGE  -"
PICTURE 1: LEFT 1,wl%: WIDTH 1,w%: HEIGHT 1,h%: STRETCH_ON 1
          ON_CLICK 1,Appliq
OPEN_DIALOG 2: FILTER 2,"Images JPG, BMP|*.bmp;*.jpg"
i% = 10: ALPHA i%: TOP i%,2: LEFT i%,5: CAPTION i%,"Image de fond (Jpg, Bmp) :"
i%=i%+1: EDIT i%: TOP i%,TOP(i%-1)+15: LEFT i%,2: WIDTH i%,wl%-4: ed1% = i%
        FONT_BOLD_OFF i%: FONT_NAME i%,"Consolas": FONT_SIZE i%,10: ON_CLICK i%,Chf
i%=i%+1: ALPHA i%: TOP i%,TOP(i%-1)+25: LEFT i%,5: CAPTION i%,"Image résultat (Bmp) :"
i%=i%+1: EDIT i%: TOP i%,TOP(i%-1)+15: LEFT i%,2: WIDTH i%,wl%-4: ed2% = i%
        FONT_BOLD_OFF i%: FONT_NAME i%,"Consolas": FONT_SIZE i%,10: ON_CLICK i%,Chf
        TEXT i%,fr$

i%=i%+1: ALPHA i%: TOP i%,TOP(i%-1)+20: FONT_COLOR i%,255,0,0: FONT_BOLD i%
        CAPTION i%," "+STRING$(22,CHR$(151))
       
i%=i%+1: CHECK i%: TOP i%,TOP(i%-1)+15: LEFT i%,20: CAPTION i%,"TEXTE :": ckt%=i%
        MARK_ON ckt%
i%=i%+1: ALPHA i%:TOP i%,TOP(ckt%)+18: LEFT i%,10
        CAPTION i%,"Police                                      Taille    Couleur"
i%=i%+1: EDIT i%: TOP i%,TOP(i%-1)+15: LEFT i%,2: WIDTH i%,150: TEXT i%,"Arial": p%=i%
        ON_CLICK p%,Chp
i%=i%+1: SPIN i%: TOP i%,TOP(i%-1): LEFT i%,WIDTH(i%-1)+10: WIDTH i%,42
        MIN i%,6: MAX i%,255: POSITION i%,12
i%=i%+1: FORM i%: HIDE i%: BORDER_HIDE i%: TOP i%,TOP(0)+TOP(p%)+50: LEFT i%,LEFT(0)+10
        WIDTH i%,wl%: HEIGHT i%,600: fp% = i%
i%=i%+1: LIST i%: PARENT i%,fp%: FULL_SPACE i%: FONT_NAMES_LOAD i%: ON_CLICK i%,Chp1
        FOR j% = COUNT(i%) TO 1 STEP -1
            IF LEFT$(ITEM_READ$(i%,j%),1) = "@" THEN ITEM_DELETE i%,j%
        NEXT j%
i%=i%+1: PICTURE i%: TOP i%,TOP(p%): LEFT i%,LEFT(i%-3)+WIDTH(i%-3)+6: ' couleur txt
        WIDTH i%,30: HEIGHT i%,20: COLOR i%,0,0,0: ON_CLICK i%,Chc: pc%=i%
i%=i%+1: FORM i%: HIDE i%: BORDER_HIDE i%: TOP i%,TOP(0)+TOP(pc%)+50: LEFT i%,LEFT(0)+170
        WIDTH i%,80: HEIGHT i%,160: fc% = i%: ' Form palette de couleurs
i%=i%+1: PICTURE i%: PARENT i%,fc%: FULL_SPACE i%: HEIGHT i%,160: ON_CLICK i%,Chc1
        2D_TARGET_IS i%
        FOR j% = 0 TO 7
            y% = j%*20
            FOR k% = 0 TO 1
                x% = k%*40: READ r%: READ g%: READ b%
                2D_FILL_COLOR r%,g%,b%: 2D_RECTANGLE x%,y%,x%+40,y%+20
            NEXT k%
        NEXT j%
i%=i%+1: CHECK i%: TOP i%,TOP(pc%)+28: LEFT i%,20: CAPTION i%,"Gras": ckg%=i%
i%=i%+1: CHECK i%: TOP i%,TOP(i%-1): LEFT i%,LEFT(i%-1)+60: CAPTION i%,"Italique"
i%=i%+1: CHECK i%: TOP i%,TOP(i%-1): LEFT i%,LEFT(i%-1)+70: CAPTION i%,"Souligné"
i%=i%+1: CONTAINER_OPTION i%: TOP i%,TOP(ckg%)+20: LEFT i%,2: WIDTH i%,wl%-4: er%=i%
        HEIGHT i%,35: CAPTION i%,"Rotation du texte :"
i%=i%+1: OPTION i%: PARENT i%,er%: TOP i%,15: LEFT i%,15: CAPTION i%,"Non": MARK_ON i%
i%=i%+1: OPTION i%: PARENT i%,er%: TOP i%,TOP(i%-1): LEFT i%,LEFT(i%-1)+50: CAPTION i%,"90° G"
i%=i%+1: OPTION i%: PARENT i%,er%: TOP i%,TOP(i%-1): LEFT i%,LEFT(i%-1)+55: CAPTION i%,"90° D"
i%=i%+1: OPTION i%: PARENT i%,er%: TOP i%,TOP(i%-1): LEFT i%,LEFT(i%-1)+55: CAPTION i%,"180°"

i%=i%+1: MEMO i%: HEIGHT i%,170: TOP i%,TOP(er%)+40: LEFT i%,2: WIDTH i%,wl%-6: m%=i%
i%=i%+1: BUTTON i%: TOP i%,TOP(m%)+HEIGHT(m%)+5: WIDTH i%,25: LEFT i%,40: bd%=i%
i%=i%+1: BUTTON i%: TOP i%,TOP(i%-1): WIDTH i%,WIDTH(i%-1): LEFT i%,LEFT(i%-1)+WIDTH(i%-1)+3
i%=i%+1: BUTTON i%: TOP i%,TOP(i%-1): WIDTH i%,WIDTH(i%-1): LEFT i%,LEFT(i%-1)+WIDTH(i%-1)+3
i%=i%+1: BUTTON i%: TOP i%,TOP(i%-1): WIDTH i%,WIDTH(i%-1): LEFT i%,LEFT(i%-1)+WIDTH(i%-1)+3
        FOR j% = 0 TO 3
              FONT_NAME i%-j%,Wingdings: CAPTION i%-j%,CHR$(234-j%): ON_CLICK i%-j%,Deplace
        NEXT j%
i%=i%+1: SPIN i%: TOP i%,TOP(i%-1): LEFT i%,LEFT(i%-1)+30: WIDTH i%,40: POSITION i%,5

i%=i%+1: ALPHA i%: TOP i%,TOP(i%-1)+HEIGHT(i%-1): FONT_COLOR i%,255,0,0: FONT_BOLD i%
        CAPTION i%," "+STRING$(22,CHR$(151))

i%=i%+1: CHECK i%: TOP i%,TOP(i%-1)+15: LEFT i%,20: CAPTION i%,"ENCADREMENT :"
        cke%=i%
i%=i%+1: CONTAINER_OPTION i%: HEIGHT i%,20: TOP i%,TOP(cke%)+20: LEFT i%,2: WIDTH i%,wl%-4
        CAPTION i%,"Type :": en%=i%
i%=i%+1: OPTION i%: PARENT i%,en%: TOP i%,2: LEFT i%,50: MARK_ON i%
i%=i%+1: PICTURE i%: HEIGHT i%,30: TOP i%,TOP(en%)+20: LEFT i%,LEFT(i%-1)-20: WIDTH i%,60
        COLOR i%,0,0,255
i%=i%+1: OPTION i%: PARENT i%,en%: TOP i%,TOP(i%-2): LEFT i%,LEFT(i%-2)+70
i%=i%+1: PICTURE i%: HEIGHT i%,HEIGHT(i%-2): TOP i%,TOP(i%-2): LEFT i%,LEFT(i%-1)-20
        WIDTH i%,WIDTH(i%-2): COLOR i%,0,0,255
        2D_TARGET_IS i%-2: 2D_PEN_COLOR 255,255,0: 2D_FILL_OFF: 2D_RECTANGLE 4,4,100,100
        2D_TARGET_IS i%: 2D_PEN_COLOR 255,255,0: 2D_FILL_OFF
        2D_RECTANGLE 7,7,100,100: 2D_PEN_WIDTH 3: 2D_RECTANGLE 3,3,100,100
       
' i%=i%+1: BUTTON i%: TOP i%,TOP(i%-1)+40: LEFT i%,wl%/2-40: CAPTION i%,"Appliquer"
        ON_CLICK i%,Appliq
       
i%=i%+1: PICTURE i%: HIDE i%: pm%=i%: ' Picture de manoeuvre

END
' ==============================================================================
Chf:
  ' ***** choix image de fond
  f$ = FILE_NAME$(2): TEXT ed1%,f$
  DimJpgBmp(f$): ' dimensions -> wi% x hi%
  IF wi% > hi%
      w0% = w%+wl%+wc%: h0% = h%+hc%: IF h0%<530 THEN h0% = 530
      WIDTH 0,w0%: HEIGHT 0,h0%
      HEIGHT 1,50: WIDTH 1,w%: HEIGHT 1,w%*hi%/wi%
  ELSE
      h0% = w%+hc%: w0% = wc%+wl%+w%*wi%/hi%: IF h0%<530 THEN h0% = 530
      HEIGHT 0,h0%: WIDTH 0,w0%
      WIDTH 1,50: HEIGHT 1,w%: WIDTH 1,w%*wi%/hi%
  END_IF
  ro = wi%/WIDTH(1)
  FILE_LOAD 1,f$
RETURN
' ==============================================================================
Chp:
  ' ***** choix police de caractères
  SHOW fp%: TO_FOREGROUND fp%
RETURN
' ==============================================================================
Chp1:
  TEXT p%,ITEM_INDEX$(fp%+1)
  HIDE fp%
RETURN
' ==============================================================================
Chc:
  ' ***** choix couleur de caractères
  SHOW fc%: TO_FOREGROUND fc%
RETURN
' ==============================================================================
Chc1:
  x% = MOUSE_X_LEFT_DOWN(fc%+1): y% = MOUSE_Y_LEFT_DOWN(fc%+1)
  r% = COLOR_PIXEL_RED(fc%+1,x%,y%): g% = COLOR_PIXEL_GREEN(fc%+1,x%,y%)
  b% = COLOR_PIXEL_BLUE(fc%+1,x%,y%): COLOR pc%,r%,g%,b%
  HIDE fc%
RETURN
' ==============================================================================
Appliq:
  ' ***** Clic dans l'image: insertion du exte
  x% = MOUSE_X_LEFT_DOWN(1): y% = MOUSE_Y_LEFT_DOWN(1)
  f$ = TEXT$(ed1%): IF FILE_EXISTS(f$) = 0 THEN RETURN
  IF FILE_EXISTS(fr$)=1 THEN FILE_DELETE fr$
  IF CHECKED(ckt%) = 1 AND f$<>"" AND COUNT(m%) > 0
    po$ = TEXT$(p%): sz% = POSITION(p%+1)
    r% = COLOR_PIXEL_RED(pc%,5,5): g% = COLOR_PIXEL_GREEN(pc%,5,5)
    b% = COLOR_PIXEL_BLUE(pc%,5,5): coul%=(r%*256+g%)*256+b%
    attr% = 0: IF CHECKED(ckg%) = 1 THEN attr% = 1
    IF CHECKED(ckg%+1) = 1 THEN attr% = attr%+2
    IF CHECKED(ckg%+2) = 1 THEN attr% = attr%+4
    a$ = ""
    FOR i% = 1 TO COUNT(m%)
        a$=a$+ITEM_READ$(m%,i%): IF i%<COUNT(m%) THEN a$ = a$+rc$
    NEXT i%
    x% = x%*ro: y% = y%*ro
    RL$ = ""
    IF CHECKED(er%+2) = 1 THEN RL$ = "L"
    IF CHECKED(er%+3) = 1 THEN RL$ = "R"
    IF CHECKED(er%+4) = 1 THEN RL$ = "RL"
    Txt2Img(f$,fr$,x%,y%,a$,po$,sz%,attr%,coul%,RL$)
  END_IF
  IF CHECKED(cke%) = 1
      WIDTH pm%,wi%: HEIGHT pm%,hi%
      IF FILE_EXISTS(fr$) = 1
          FILE_LOAD pm%,fr$
      ELSE
          FILE_LOAD pm%,f$
      END_IF
      et% = 3*wi%/w%: IF et%>20 THEN et% = 20
      2D_TARGET_IS pm%: 2D_PEN_COLOR 255,255,0: 2D_PEN_WIDTH et%: 2D_FILL_OFF
      IF CHECKED(en%+1) = 1
          i% = et%*2: 2D_RECTANGLE i%,i%,wi%-i%,hi%-i%
      ELSE
          IF CHECKED(en%+3) = 1
              i% = et%*5: 2D_RECTANGLE i%,i%,wi%-i%,hi%-i%
              i% = et%*2: IF i%>20 THEN i%=20
              2D_PEN_WIDTH i%
              i% = et%*2: 2D_RECTANGLE i%,i%,wi%-i%,hi%-i%
          END_IF
      END_IF
      FILE_SAVE pm%,fr$
  END_IF
  FILE_LOAD 1,fr$
RETURN
' ==============================================================================
Deplace:
  ' ***** Clic sur les flèches de positionnement précis
  i% = NUMBER_CLICK: j% = POSITION(bd%+4)
  IF i% = bd% THEN x% = x%-j%
  IF i% = bd%+1 THEN x% = x%+j%
  IF i% = bd%+2 THEN y% = y%-j%
  IF i% = bd%+3 THEN y% = y%+j%
  Txt2Img(f$,fr$,x%,y%,a$,po$,sz%,attr%,coul%,RL$)
  FILE_LOAD 1,fr$
RETURN
' ==============================================================================
SUB Txt2Img(f$,fr$,x%,y%,txt$,fnt$,sz%,attr%,coul%,RL$)
  ' Apposition d'un texte txt$ sur le fichier image f$ (jpg ou bmp)
  ' en x%,y% de l'image, police fnt$, taille sz%, enrichissements attr%
  ' (B=1 I=2 U=4) couleur coul% (=65536*R + 256*G + B)
  ' Rotation du texte RL$: "L" 90° G, "R" 90° D, "RL" 180°
  ' Résultat dans le fichier image fr$ (bmp)
  DIM_LOCAL n2d%,prt%,fm$,fm1$,s2%,p1%,im%,rc$,r%,g%,b%,yt%,w%,h%,k%,a$,wi%,hi%
  DIM_LOCAL scr$,rt$,q$: q$ = CHR$(34)
  n2d% = NUMBER_2D_TARGET: prt% = NUMBER_PRINT_TARGET
  fm$ = "C:\TEMP\Provy.bmp"
  fm1$ = "C:\TEMP\Provy1.bmp"
  scr$ = "C:\TEMP\Vbscript.vbs"
  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
  s2% = 950: SCENE2D s2%: TOP s2%,0: LEFT s2%,0: WIDTH s2%,wi%: HEIGHT s2%,hi%: HIDE s2%
  FILE_LOAD s2%,fm$: FILE_DELETE fm$
  SPRITE s2%
  p1% = s2%+1: PICTURE p1%: HIDE p1%: WIDTH p1%,1200: HEIGHT p1%,1600: ' pict. texte
  im% = p1%+1: IMAGE im%
  rc$ = CHR$(13)+CHR$(10)
  FONT_NAME p1%,fnt$: FONT_SIZE p1%,sz%
  IF BIN_AND(attr%,1) = 1 THEN FONT_BOLD p1%
  IF BIN_AND(attr%,2) = 2 THEN FONT_ITALIC p1%
  IF BIN_AND(attr%,4) = 4 THEN FONT_UNDERLINE p1%
  r%=INT(coul%/65536): g%=BIN_AND(coul%,255*256)/256: b%=BIN_AND(coul%,255)
  IF r% = 0 AND g% = 0 AND b% = 0 THEN r% = 5: g% = 5: b% = 5
  FONT_COLOR p1%,r%,g%,b%: 2D_TARGET_IS p1%: COLOR p1%,0,0,0: 2D_FILL_COLOR 0,0,0
  w% = 0: k% = LEN(txt$): PRINT_TARGET_IS p1%: h% = TEXT_HEIGHT(txt$,p1%): yt% = 0
  WHILE k%>0
      k% = INSTR(txt$,rc$)
      IF k%>0
          a$ = LEFT$(txt$,k%-1): txt$ = RIGHT_POS$(txt$,k%+2)
      ELSE
          a$ = txt$: txt$ = ""
      END_IF
      k% = TEXT_WIDTH(a$,p1%): IF k%>w% THEN w% = k%: ' largeur totale
      PRINT_LOCATE 0,yt%: PRINT a$: yt% = yt%+h%
      k% = LEN(txt$)
  END_WHILE
  h% = yt%: WIDTH p1%,w%: HEIGHT p1%,h%
  IF RL$ <> "": ' rotation texte
      FILE_SAVE p1%,fm$: IF FILE_EXISTS(fm1$) = 1 THEN FILE_DELETE fm1$
      rt$ = "270": IF UPPER$(RL$)="R" THEN rt$ = "90"
      IF UPPER$(RL$)="RL" THEN rt$ = "180"
      FILE_OPEN_WRITE 9,scr$
      FILE_WRITELN 9,"Dim Img 'As ImageFile"
      FILE_WRITELN 9,"Dim IP 'As ImageProcess"
      FILE_WRITELN 9,"Set Img = CreateObject("+q$+"WIA.ImageFile"+q$+")"
      FILE_WRITELN 9,"Set IP = CreateObject("+q$+"WIA.ImageProcess"+q$+")"
      FILE_WRITELN 9,"Img.LoadFile "+q$+fm$+q$
      FILE_WRITELN 9,"IP.Filters.Add IP.FilterInfos("+q$+"RotateFlip"+q$+").FilterID"
      FILE_WRITELN 9,"IP.Filters(1).Properties("+q$+"RotationAngle"+q$+") = "+rt$
      FILE_WRITELN 9,"Set Img = IP.Apply(Img)"
      FILE_WRITELN 9,"Img.SaveFile "+q$+fm1$+q$
      FILE_WRITELN 9,"WScript.Quit(0)"
      FILE_CLOSE 9
      EXECUTE_WAIT "Wscript.exe " + scr$: ' Exécution du script
      FILE_DELETE scr$: FILE_DELETE fm$
      CLS: FILE_LOAD p1%,fm1$: FILE_DELETE fm1$
      IF RL$="L" OR RL$="R" THEN h% = w%: w% = yt%: ' rotation 90° G ou D
  END_IF
  ' Recopie du picture de travail p1% dans le sprite
  2D_IMAGE_COPY im%,0,0,w%-1,h%-1
  SPRITE_IMAGE_LOAD s2%,im%: SPRITE_POSITION s2%,x%,y%
  SNAPSHOT s2%,fr$
  DELETE s2%
  2D_TARGET_IS n2d%: PRINT_TARGET_IS prt%: DELETE p1%: DELETE im%
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 ecrire_sur_image(param1%, px%, py%, param2$)
    dim_local i%, hnd%, r%, g%, b%, degre%
    dim_local coul%, font$, text$, attrib%, pos%
    dim_local aBold% : aBold% = 1
    dim_local aItalic% : aItalic% = 0
    dim_local aUnder% : aUnder% = 0
    dim_local aStrike% : aStrike% = 0
    dim_local aSize% : aSize% = 8
    dim_local aRotate% : aRotate% = 65536

    hnd%=handle_canvas(param1%)
    r%=255
    g%=255
    b%=255
    coul%=(b%*256+g%)*256+r%
    font$="Times New Roman"
    text$=param2$
    degre%=0
    attrib%=aBold%+aUnder%+aItalic%+aSize%*36+aRotate%*degre%
    pos%=px%+py%*65536
    res%=dll_call6("WriteTextOverPicture",hnd%,pos%,adr(text$),adr(font$),attrib%,coul%)
end_sub