Déformation d'image en trapèze

' ==============================================================================
SUB Trapeze_H(f$,dg$,r,fr$)
  ' Déformation d'une image en trapèze horizontal
  ' Origine f$ (jpg, bmp), résultat dans fr$ (bmp)
  ' dg$ = "R" ou "L" côté droit (R) ou gauche (L) en trapèze
  ' r = facteur de rétrécissement par rapport au côté fixe, ex. r= 0.5 (= 1/2)
  DIM_LOCAL fm$,p%,im%,s2%,sp%,w%,h%,h1%,hl%,ry,rh,cy,x%,y%,d%,delta
  fm$ = "C:\TEMP\Provy.bmp"
  p% = 900: PICTURE p%: HIDE p%: FILE_LOAD p%,f$: FILE_SAVE p%,fm$
  FILEBIN_OPEN_READ 1,fm$: ' dimensions image -> w%, h%
      FILEBIN_POSITION 1,18: w% = FILEBIN_READ(1)+256*FILEBIN_READ(1)
      FILEBIN_POSITION 1,22: h% = FILEBIN_READ(1)+256*FILEBIN_READ(1)
  FILEBIN_CLOSE 1
  WIDTH p%,w%: HEIGHT p%,h%: FILE_LOAD p%,fm$: FILE_DELETE fm$
  im% = p%+1: IMAGE im%
  2D_TARGET_IS p%
  IF UPPER$(dg$) = "R"
      hl% = h%: y% = 0
  ELSE
      hl% = h%*r: y% = (h%-r*h%)/2
  END_IF
  d% = (h%-h%*r)/2: ' diminution totale d'ordonnée sur la largeur
  delta = d%/w%: ' diminution par colonne
  ry = y%: rh = hl%
  s2% = im%+1: SCENE2D s2%: WIDTH s2%,w%: HEIGHT s2%,h%
  sp% = s2%-1
  FOR x% = 0 TO w%-1
      2D_IMAGE_COPY im%,x%,0,x%+1,h%-1: ' 1 ligne verticale
      sp% = sp%+1: SPRITE sp%
      SPRITE_IMAGE_LOAD sp%,im%
      cy = hl%/h%
      SPRITE_Y_SCALE sp%,cy
      SPRITE_POSITION sp%,x%,y%
      IF UPPER$(dg$) = "R"
          ry = ry+delta: rh = rh-2*delta
      ELSE
          ry = ry-delta: rh = rh+2*delta
      END_IF
      y% = ry: hl% = rh: ' nouvelle hauteur de ligne
  NEXT x%
  SNAPSHOT s2%,fr$
  2D_TARGET_IS 0: DELETE p%: DELETE im%: DELETE s2%: SPRITE_DELETE_ALL
END_SUB
' ==============================================================================
SUB Trapeze_V(f$,dg$,r,fr$)
  ' Déformation d'une image en trapèze vertical
  ' Origine f$ (jpg, bmp), résultat dans fr$ (bmp)
  ' dg$ = "T" ou "B" côté haut (T) ou bas (B) en trapèze
  ' r = facteur de rétrécissement par rapport au côté fixe, ex. r= 0.5 (= 1/2)
  DIM_LOCAL fm$,p%,im%,s2%,sp%,w%,h%,w1%,wl%,rx,rw,cx,x%,y%,d%,delta
  fm$ = "C:\TEMP\Provy.bmp"
  p% = 900: PICTURE p%: HIDE p%: FILE_LOAD p%,f$: FILE_SAVE p%,fm$
  FILEBIN_OPEN_READ 1,fm$: ' dimensions image -> w%, h%
      FILEBIN_POSITION 1,18: w% = FILEBIN_READ(1)+256*FILEBIN_READ(1)
      FILEBIN_POSITION 1,22: h% = FILEBIN_READ(1)+256*FILEBIN_READ(1)
  FILEBIN_CLOSE 1
  WIDTH p%,w%: HEIGHT p%,h%: FILE_LOAD p%,fm$: FILE_DELETE fm$
  im% = p%+1: IMAGE im%
  2D_TARGET_IS p%
  IF UPPER$(dg$) = "B"
      wl% = w%: x% = 0
  ELSE
      wl% = w%*r: x% = (w%-r*w%)/2
  END_IF
  d% = (w%-w%*r)/2: ' diminution totale d'abscisse sur la hauteur
  delta = d%/h%: ' diminution par ligne
  rx = x%: rw = wl%
  s2% = im%+1: SCENE2D s2%: WIDTH s2%,w%: HEIGHT s2%,h%
  sp% = s2%-1
  FOR y% = 0 TO h%-1
      2D_IMAGE_COPY im%,0,y%,w%-1,y%+1: ' 1 ligne horizontale
      sp% = sp%+1: SPRITE sp%
      SPRITE_IMAGE_LOAD sp%,im%
      cx = wl%/w%
      SPRITE_X_SCALE sp%,cx
      SPRITE_POSITION sp%,x%,y%
      IF UPPER$(dg$) = "B"
          rx = rx+delta: rw = rw-2*delta
      ELSE
          rx = rx-delta: rw = rw+2*delta
      END_IF
      x% = rx: wl% = rw: ' nouvelle largeur de ligne
  NEXT y%
  SNAPSHOT s2%,fr$
  2D_TARGET_IS 0: DELETE p%: DELETE im%: DELETE s2%: SPRITE_DELETE_ALL
END_SUB
' ==============================================================================

SUB Trapeze(f$,x1%,y1%,x2%,y2%,x3%,y3%,x4%,y4%,fr$)
  ' Déformation d'une image rectangulaire f$ en quadrilatère quelconque
  ' Paramètres: coordonnées des sommets résultants dans le sens des aiguilles,
  '             en commençant par le sommet haut/gauche
  ' Résultat dans fr$ (bmp) (ou clipboard si fr$ = "").
  DIM_LOCAL p%,res%,hg$,hd$,bd$,bg$
  hg$ = STR$(x1%)+","+STR$(y1%): hd$ = STR$(x2%)+","+STR$(y2%)
  bd$ = STR$(x3%)+","+STR$(y3%): bg$ = STR$(x4%)+","+STR$(y4%)
  p% = 900: PICTURE p%: HIDE p%: FILE_LOAD p%,f$: CLIPBOARD_COPY p%
  DLL_ON "C:\PANORAMIC\KGF\KGF.dll"
    res% = DLL_CALL0("LoadPicture")
    res% = DLL_CALL4("TorturePicture",ADR(hg$),ADR(hd$),ADR(bd$),ADR(bg$))
    res% = DLL_CALL0("SavePicture")
  DLL_OFF
  IF fr$ <> "" THEN CLIPBOARD_PASTE p%: FILE_SAVE p%,fr$
  DELETE p%
END_SUB

dim a,xm,ym ,proph,roph,b,c,pi
label correc,rotpho
pi=acos (-1)
width 0,1000: height 0,1000  : border_small 0 :left 0,250
scene3d 1:left 1,200:top 1,50:width 1,600:height 1,600
print "correction de l'angle de prise de vue "
form 303 : left 303,0 :top 303,420 :height 303,100 :width 303,240 : caption 303,"Photo" : command_target_is 303
main_menu 81
sub_menu 83 : caption 83,"correction" : parent 83,81 :on_click 83,correc
sub_menu 84 : caption 84,"portait-paysage" : parent 84,81 :on_click 84,rotpho
scroll_bar 307 :top 307,0 :min 307,-45:max 307,45:position 307,0
alpha 317:caption 317,"parallaxe":top 317,20 :left 317,130
3d_cube 10,1 :3d_scale 10,3,4,1
3d_load_texture 10,"votrephoto.bmp"
roph=0

end

correc:
a =position (307)
3d_rotate 10,a,0,0
proph=even(roph)
 if proph =1
   3d_scale 10,6,(4/cos(a/(20*pi))),0.1
 else
   3d_scale 10,4,(6/cos(a/(20*pi))),0.1
 end_if
b=cos (a/64)
print a
print b
return

rotpho:
roph=roph+1
gosub correc
return