Rem Example on how to make a double-texturing using memblocks.
Rem Restrictions : the 2 used textures must use the same size and same depth.
Rem
Rem You must défine that value to make real-time calculation faster
dim _dt(5)
Rem we define screen resolution and frame-rate.
set display mode 1024,768,16
sync rate 0 : sync on
de la démo.
Rem Loading textures and create objects for demo.
  load image "gfx\texture1.jpg",1
  load image "gfx\texture2.jpg",2
  for boucle=1 to 3
    make object cube boucle,128
    position object boucle,(boucle-2)*160,-128,0
   next boucle
  position camera 0,0,-384
  texture object 1,1
  texture object 3,2
  FLX_Double_Texturing(2,1,2,50)
  Rem We show the résult with rotating cubes.
  x1#=0.0 : y1#=0.0 : x2#=0.0 : y2#=0.0 : x3#=0.0 : y3#=0.0
  _addpercent#=0.5 : _percent#=50.0
  Repeat
    set cursor 0,0
    print "DarkBasic Memblock's double texturing demo"
    Print "Made by freddix ( freddbprojects@wanadoo.fr )"
    print " "
    print " Press left mouse button to switch between simple and real-time DT-Alpha% mode"
    print " press space key to quit the demo "
    print " "
    if _mode=0 then print "MODE : simple" else print "MODE : Real-time double-texturing calculation"
    x1#=wrapvalue(x1#+1) : x2#=wrapvalue(x2#+2) : x3#=wrapvalue(x3#+0.5)
    y1#=wrapvalue(y1#+1) : y2#=wrapvalue(y2#+2) : y3#=wrapvalue(y3#+0.5)
    rotate object 1,x1#,y1#,0 : rotate object 2,x2#,y2#,0 : rotate object 3,x3#,y3#,0
    print " FPS : ",screen fps()
    if mouseclick()=1
      inc _mode,1
      repeat
       until mouseclick()=0
     endif
    if _mode=1
      _percent#=_percent#+_addpercent#
      if _percent#=100.0 then _addpercent#=-0.5
      if _percent#=0.0 then _addpercent#=0.5
      _DEPTH=FLX_Double_Texturing(2,1,2,int(_percent#))
     endif
    if _mode=2
      _mode=0
     endif
    sync
   Until spacekey()=1
  Rem We delete all things.
  for boucle=1 to 3
    if object exist(boucle)=1 then delete object boucle
    if image exist(boucle)=1 then delete image boucle
    if memblock exist(boucle)=1 then delete memblock boucle
   next boucle
  end

Rem ********************************************************************************************************
Rem Double-Texturing need the 2 images to own the same sizes and same depth !
Function FLX_Double_Texturing(_object,_texture1,_texture2,_alpha)
  Rem ********************************************************************************************************
  if _dt(1)=0
    Rem We look for 3 available memblocks to create 3 buffers ( 1st Texture , 2nd Texture , Melting )
    _memblock1=1 : _memblock2=2 : _memblock3=3
    _Texture3=65535
    Rem ********************************************************************************************************
    Rem We look for an empty image slot to put the double-textured image.
    if image exist(_texture1)=0 or image exist(_texture2)=0 then _texture3=0
    Rem ********************************************************************************************************
    Rem If we founded 3 availables memblocks and 1 free image slot , we make the shaking . . .
    if _memblock1>0 and _memblock2>0 and _memblock3>0 and _texture3>0
      make memblock from image _memblock1,_texture1
      make memblock from image _memblock2,_texture2
      _length=get memblock size(_memblock1)
      if memblock exist(_memblock3)=0 then make memblock _memblock3,_length
      _xsize=memblock dword(_memblock1,0) : write memblock dword _memblock3,0,_xsize
      _ysize=memblock dword(_memblock1,4) : write memblock dword _memblock3,4,_ysize
      _Depth=memblock dword(_memblock1,8) : write memblock dword _memblock3,8,_depth
     endif
   endif
  _bytepos=12
Rem
  if _depth=16 then _flt1=2048 : _flt2=32
  if _depth=32 or _depth=24 then _flt1=65536 : _flt2=256
  if _alpha(0-1)
    _alpha1=_alpha : _alpha2=100-_alpha
   else
    _alpha1=50 : _alpha2=50
   endif
  repeat
    if _depth=16
      _pixel1=memblock word(_memblock1,_bytepos)
      _pixel2=memblock word(_memblock2,_bytepos)
     else
      _pixel1=memblock dword(_memblock1,_bytepos)
      _pixel2=memblock dword(_memblock2,_bytepos)
     endif
    _r1=_pixel1/_flt1 : _v1=(_pixel1-(_r1*_flt1))/_flt2 : _b1=(_pixel1-((_r1*_flt1)+(_v1*_flt2)))
    _r2=_pixel2/_flt1 : _v2=(_pixel2-(_r2*_flt1))/_flt2 : _b2=(_pixel2-((_r2*_flt1)+(_v2*_flt2)))
    _r3=((_r1*_alpha1)+(_r2*_alpha2)) : _v3=((_v1*_alpha1)+(_v2*_alpha2))
    _b3=((_b1*_alpha1)+(_b2*_alpha2))
    _r3=_r3/100 : _v3=_v3/100 : _b3=_b3/100
    _pixel3=(_r3*_flt1)+(_v3*_flt2)+_b3
    if _depth=16
      write memblock word _memblock3,_bytepos,_pixel3
     else
      write memblock dword _memblock3,_bytepos,_pixel3
     endif
    if _depth=16 then inc _bytepos,2 else inc _bytepos,4
   until _bytepos>_length-1
  Rem We create the final image and texture object if it exist.
  make image from memblock _texture3,_memblock3
  if object exist(_object)=1 then texture object _object,_texture3
  _SUCCESS=1
 EndFunction _SUCCESS