3D -Guess what we have when Zerodog and Jolly Roger create a project together .

[pistol350]

The possibility to see a woman naked   
LOL!!!!!
nice sample

Code Select Expand


' ZeroDog's X-Ray Shades
'3D models by Jolly Roger
'Requires IBasic 1.99g or later
IF GETDXVERSION < 7
   MESSAGEBOX 0,"This program requires" + chr$(13) + "DirectX 7.0 or greater","Error"
   END
ENDIF

DECLARE "gdi32",CombineRgn(hDestRgn:INT, hSrcRgn1:INT, hSrcRgn2:INT, nCombineMode:INT),INT
DECLARE "gdi32.dll",CreateRectRgn(X1:INT, Y1:INT, X2:INT, Y2:INT),INT
DECLARE "gdi32",CreateEllipticRgn(X1:INT, Y1:INT, X2:INT, Y2:INT),INT
DECLARE "user32",SetWindowRgn(hWnd:WINDOW, hRgn:INT, bRedraw:INT),INT
DECLARE "gdi32",DeleteObject(hObject:INT),INT
SETID "TRUE",1
SETID "FALSE",0
SETID "RGN_OR",2

DEF win[3]:WINDOW
DEF run,colorx,x,y,z,sX,sY,ShadesActivated:INT
DEF body,pelvis,spine,leftfemur,rightfemur,light[100],scene[100],camera[100],Region[5]:INT
DEF skull,leftarm,rightarm,head,nose,lefteye,righteye,lips,bottomlip:INT
DEF leftleg,rightleg,leftarmbones,rightarmbones:INT
DEF n,rib[10]:INT
DEF windowstring:STRING

getscreensize sx,sy
windowstring = "I,ZeroDog's X-Ray Shades (3D models by Jolly Roger)"+SPACE$(40)+"Click here to Activate X-Ray Shades"+SPACE$(120)+", 0, 0"
window win[0],0,0,sx+50,sy+50,@NOCAPTION|@MDIFRAME|@NOAUTODRAW,0,"X-Ray Shades",win0proc
window win[1],-5,-26,sx+10,sy+35,@NOCAPTION|@NOAUTODRAW,win[0],"backwin",win0proc
window win[2],-5,-26,sx+10,sy+35,@NOCAPTION|@NOAUTODRAW,win[0],"frontwin",win0proc
MENU win, windowstring


'Line to declare function to create 3D models from Ibasic subroutines
'N.B.numberofsections should be 3 or more
DECLARE modeller_object2(numberofsections:INT,topfacepresent:INT,bottomfacepresent:INT,parentscene:INT)
'Definitions needed for modeller_object function to work
DEF d[500],topfacepresent,bottomfacepresent,numberoflayers,lcn[100],r[8],g[8],b[8],t[8]:INT

GOSUB SetupWin1

run=1
waituntil run=0
D3DDELETE body
D3DDELETE pelvis
D3DDELETE spine
D3DDELETE skull
D3DDELETE leftarm
D3DDELETE rightarm
D3DDELETE head
D3DDELETE nose
D3DDELETE lips
D3DDELETE leftleg
D3DDELETE rightleg
D3DDELETE lefteye
D3DDELETE righteye
D3DDELETE leftarmbones
D3DDELETE rightarmbones
FOR n=0 TO 9
  D3DDELETE rib[n]
NEXT n
for x = 0 to 99
   if (scene[x]) then d3ddelete scene[x]
   if (camera[x]) then d3ddelete camera[x]
   if (light[x]) then d3ddelete light [x]
next x
closewindow win[0]
end
'----------------------------------------------------------------------------------------------------------------------
sub win0proc
select @CLASS
   CASE @IDCHAR
      if (@CODE = ASC("q")) then run =0
      if (@code =  (0x1b)) then run = 0

   CASE @IDCLOSEWINDOW
      run=0

   CASE @IDDXUPDATE
   'up arrow
         IF(GETKEYSTATE(0x26))
         for x = 1 to 2 : D3DCOMMAND camera[x],@ADDTRANSLATION,0,0,1.5 : next x
         ENDIF
   'down arrow
          IF(GETKEYSTATE(0x28))
      for x = 1 to 2 : D3DCOMMAND camera[x],@ADDTRANSLATION,0,0,-1.5 : next x
          ENDIF
   'left arrow
          IF(GETKEYSTATE(0x25))
      for x = 1 to 2 : D3DCOMMAND camera[x],@ADDROTATION,0,1,0,(-1.5 * (3.1415/180)) : next x
          ENDIF
   'right arrow
          IF(GETKEYSTATE(0x27))
      for x = 1 to 2 : D3DCOMMAND camera[x],@ADDROTATION,0,1,0,(1.5 * (3.1415/180)) : next x
          ENDIF

   SETFOCUS win[2]

   D3DRENDER scene[1],camera[1]
   IF ShadesActivated
      D3DRENDER scene[2],camera[2]
   ELSE
      D3DRENDER scene[1],camera[2]
   ENDIF

   'Draw our Xray Spec Frames
   ELLIPSE win[1],sx/4-15,sx/4-25,sx/4+20,sx/4+20,0,0
   ELLIPSE win[1],(sx/4+sx/3.5)-15, (sx/4)-25,  sx/4+20, sx/4+20 ,0,0
   RECT win[1], sx/4-15, sx/4-30,  sx/4+20, sx/8+15 ,0,0
   RECT win[1], (sx/4+sx/3.5)-15, (sx/4)-30,  sx/4+20, sx/8+15,0,0
   'arms
   RECT win[1],0,sx/4,sx,10,0,0
   'IBasic Plug <grin>
   move win[1], sx/2-48, sy-18
   frontpen win[1],rgb(0,0,0)
   print win[1],"Powered by IBasic"
   move win[1], sx/2-50, sy-20
   frontpen win[1],rgb(colorx,0,255) :colorx = colorx+5 :   if colorx > 255 then colorx = 0
   print win[1],"Powered by IBasic"

   for x = 1 to 2
      dxflip win[x],0
   next x

   CASE @IDMENUPICK
      if @MENUNUM = 0
        ShadesActivated=1-ShadesActivated
      endif
   
endselect
return
'----------------------------------------------------------------------------------------------------------------------

'===========================
SUB SetupWin1

drawmode win[1], @TRANSPARENT
frontpen win[1],rgb(255,255,255)

for x = 1 to 2

   IF CREATE3DSCREEN(win[x],sx,sy) <> 0
      MESSAGEBOX win[x], "Could not create Direct3D screen","Error"
      run=0
   ENDIF

   if (x=2)
   'make our xray spec lenses
      'left bottom
      Region[1] = CreateEllipticRgn(sx/4,sx/4,sx/4+sx/4,sx/4+sx/4) 
      'right bottom
      Region[2] = CreateEllipticRgn((sx/4+sx/3.5), (sx/4),  (sx/4)+(sx/3.5)+(sx/4), (sx/4+sx/4)) 
      'left top
      Region[3] = CreateRectRgn(sx/4,sx/4,sx/4+sx/4,sx/4+sx/8) 
      'right top
      Region[4] = CreateRectRgn((sx/4+sx/3.5), (sx/4),  (sx/4)+(sx/3.5)+(sx/4), (sx/4+sx/8)) 
      'combine the regions and apply it to the window
      CombineRgn(Region[1], Region[1], Region[2], @RGN_OR)
      CombineRgn(Region[1], Region[1], Region[3], @RGN_OR)
      CombineRgn(Region[1], Region[1], Region[4], @RGN_OR)
      SetWindowRgn(win[x], Region[1], @TRUE)
      'cleanup regions
      for z=1 to 4
         DeleteObject(Region[z])
      next z   
   endif

   scene[x] = D3DSCENE(win[x])
   D3DSETQUALITY win[x], @LIGHTON|@FILLsolid|@SHADEgouraud

   if (x=1) : D3DCOMMAND scene[x],@SETSCENEBACKCOLOR,0,.1,.5
   else : D3DCOMMAND scene[x],@SETSCENEBACKCOLOR,0,.1,.45
   endif

   camera[x] = D3DCAMERA(scene[x])
   D3DCOMMAND camera[x],@SETPOSITION,scene[x],0,-.5,0
   D3DCOMMAND camera[x],@SETORIENTATION,scene[x],0,0,1,0,1,0

   light[0+x] = D3DLIGHT(scene[x],@LIGHTDIRECTIONAL,.4,.4,.4)
   D3DCOMMAND light[0+x],@SETORIENTATION,scene[x],-1,-1,1, -1,1,1 
   light[2+x] = D3DLIGHT(scene[x],@LIGHTAMBIENT,.5, .5, .5)

   IF x=1
     'Create body
     readbodydata
     body=modeller_object2(12,0,1,scene[1])
     D3DCOMMAND body,@SCALE,.1,.1,.1
     D3DCOMMAND body,@SETPOSITION,scene[1],0,2,98.5
     'Create left arm
     readarmdata
     leftarm=modeller_object2(12,0,1,scene[1])
     D3DCOMMAND leftarm,@SCALE,.05,.05,.07
     D3DCOMMAND leftarm,@SETPOSITION,scene[1],4,2.2,98.5
     'Create right arm
     rightarm=modeller_object2(12,0,1,scene[1])
     D3DCOMMAND rightarm,@SCALE,-.05,.05,.07
     D3DCOMMAND rightarm,@SETPOSITION,scene[1],-4,2.2,98.5
     'Create head
     readheaddata
     head=modeller_object2(12,1,1,scene[1])
     D3DCOMMAND head,@SCALE,.025,.03,.03
     D3DCOMMAND head,@SETPOSITION,scene[2],0,11.8,98
     'Create eyes
     readeyedata
     lefteye=modeller_object2(8,1,0,scene[1])
     D3DCOMMAND lefteye,@SCALE,.007,.007,.007
     D3DCOMMAND lefteye,@SETPOSITION,scene[2],.8,11.1,95.7
     D3DCOMMAND lefteye,@ADDROTATION,1,0,0,-1.571
     righteye=modeller_object2(8,1,0,scene[1])
     D3DCOMMAND righteye,@SCALE,.007,.007,.007
     D3DCOMMAND righteye,@SETPOSITION,scene[2],-.8,11.1,95.7
     D3DCOMMAND righteye,@ADDROTATION,1,0,0,-1.571
     'Create nose
     readnosedata
     nose=modeller_object2(8,1,1,scene[1])
     D3DCOMMAND nose,@SCALE,.01,.01,.01
     D3DCOMMAND nose,@SETPOSITION,scene[2],0,11.5,96.4
     'Create lips
     readlipdata
     lips=modeller_object2(8,1,1,scene[1])
     D3DCOMMAND lips,@SCALE,.01,.01,.015
     D3DCOMMAND lips,@SETPOSITION,scene[2],.75,9.7,96.2
     D3DCOMMAND lips,@ADDROTATION,0,0,1,-1.571
   ELSE
    'Create skeleton
    'Create pelvis
    readpelvisdata
    pelvis=modeller_object2(12,1,1,scene[2])
    D3DCOMMAND pelvis,@SCALE,.02,.03,.03
    D3DCOMMAND pelvis,@SETPOSITION,scene[2],-2.4,-1,99.8
    D3DCOMMAND pelvis,@ADDROTATION,0,0,1,1.571
    'Create spine
    readspinedata
    spine=modeller_object2(6,0,0,scene[2])
    D3DCOMMAND spine,@SCALE,.1,.1,.1
    D3DCOMMAND spine,@SETPOSITION,scene[2],0,1.9,98.5
    'Create ribs
    readribdata
    FOR n=0 TO 9
      rib[n]=modeller_object2(6,1,1,scene[2])
      IF n<5
        D3DCOMMAND rib[n],@SETPOSITION,scene[2],-1.5-.2*(1.2+n%5/18),2.5+n/1,99.5
        D3DCOMMAND rib[n],@ADDROTATION,1,0,0,1.571
        D3DCOMMAND rib[n],@SCALE,.015,.02,.02
      ELSE
        D3DCOMMAND rib[n],@SETPOSITION,scene[2],1.5+.2*(1.2+n%5/18),2.6+(n-5)/1,99.5
        D3DCOMMAND rib[n],@ADDROTATION,1,0,0,1.571
        D3DCOMMAND rib[n],@SCALE,.015,.02,.015
        D3DCOMMAND rib[n],@ADDROTATION,0,1,0,3.142
      ENDIF
      D3DCOMMAND rib[n],@SCALE,1.2+n%5/18,1-n%5/20,1
    NEXT n
    'Create skull
    readskulldata
    skull==modeller_object2(12,1,1,scene[2])
    D3DCOMMAND skull,@SCALE,.025,.03,.027
    D3DCOMMAND skull,@SETPOSITION,scene[2],0,13.8,98
    'Create arm bones
    readarmbonesdata
    leftarmbones=modeller_object2(6,1,1,scene[2])
    D3DCOMMAND leftarmbones,@SCALE,.056,.056,.056
    D3DCOMMAND leftarmbones,@SETPOSITION,scene[2],4,3,98.5
    rightarmbones=modeller_object2(6,1,1,scene[2])
    D3DCOMMAND rightarmbones,@SCALE,.056,.056,.056
    D3DCOMMAND rightarmbones,@SETPOSITION,scene[2],-4,3,98.5
    'Create legs
    readleftlegdata
    leftleg=modeller_object2(6,1,0,scene[2])
    D3DCOMMAND leftleg,@SCALE,.05,.057,.05
    D3DCOMMAND leftleg,@SETPOSITION,scene[2],2.8,-4.2,99.5
    readrightlegdata
    rightleg=modeller_object2(6,1,0,scene[2])
    D3DCOMMAND rightleg,@SCALE,.05,.057,.05
    D3DCOMMAND rightleg,@SETPOSITION,scene[2],-2.8,-4.2,99.5
  ENDIF
next x
DELETEFILE(GETSTARTPATH+"temporary.x")
ShadesActivated = 0
RETURN


SUB readbodydata
numberoflayers=11
d=-150,110,210,132,198,-51,121,199,135,193,-34,126,194,136,190,-18,134,186,140,184
d[20]=17,126,194,132,188,26,126,194,120,190,34,126,194,120,190,47,126,194,133,187
d[40]=57,134,186,139,181,61,147,173,147,173,81,149,171,149,171
lcn=3,3,3,3,3,3,3,3,1,1,1
r=200,255,0,120,255,255,0,150
g=200,200,255,120,255,0,255,100
b=200,173,0,255,0,255,255,0
t=0,0,0,0,0,0,0,0
RETURN

SUB readarmdata
numberoflayers=9
d=-140,157,163,157,163,-120,155,165,150,170,-111,154,166,149,171,-100,153,167,152,168
d[20]=-30,146,174,148,172,74,143,177,145,175,94,112,172,145,175,106,101,161,145,175
d[40]=112,86,146,145,175
lcn=0,0,0,6,6,6,6,6,6
r=255,255,0,0,255,255,120,150
g=200,0,255,0,255,0,120,100
b=177,0,0,255,0,255,255,0
t=0,0,0,0,0,0,0,0
RETURN

SUB readpelvisdata
numberoflayers=13
d=-160,149,171,110,116,-154,124,196,122,150,-133,92,224,146,174,-117,85,229,157,189
d[20]=-101,59,229,158,196,-90,53,227,157,197,-80,52,216,156,198,-70,55,227,157,197
d[40]=-60,61,229,156,194,-45,83,229,155,189,-30,95,223,153,185,-4,121,191,127,155
d[60]=7,144,168,119,125
r=200,-1:g=200:b=200:t=0
RETURN

SUB readspinedata
numberoflayers=7
d=-18,155,165,174,182,-4,155,165,172,182,12,155,165,174,184,28,155,165,174,184
d[20]=44,155,165,171,181,61,155,165,167,177,80,155,165,166,174
r=200,-1:g=200:b=200:t=0
RETURN

SUB readarmbonesdata
numberoflayers=21
d=-140,157,163,156,164,-120,155,165,150,170,-106,154,166,149,171,-100,157,163,157,163
d[20]=-96,153,167,153,167,-93,154,166,153,167,-90,154,166,153,167,-87,155,165,154,166
d[40]=-43,155,165,154,166,-36,153,167,152,168,-33,154,166,153,167,-30,157,163,157,163
d[60]=-27,154,166,153,167,-24,152,168,151,169,-21,153,167,152,168,-18,154,166,154,166
d[80]=67,154,166,154,166,70,153,167,153,167,74,151,169,152,168,78,151,169,153,167
d[100]=82,157,163,157,163
r=200,-1:g=200:b=200:t=0
RETURN

SUB readribdata
numberoflayers=12
d=-160,202,284,146,174,-147,151,217,146,174,-133,121,173,146,174,-119,105,139,146,174
d[20]=-103,97,125,146,174,-85,93,117,147,173,-65,93,117,147,173,-45,98,124,147,173
d[40]=-17,118,146,147,173,6,142,176,147,173,25,169,207,147,173,41,202,236,147,173
r=200,-1:g=200:b=200:t=0
RETURN

SUB readskulldata
numberoflayers=11
d=-160,136,184,99,177,-151,124,196,100,186,-143,108,212,101,201,-134,100,220,98,242
d[20]=-114,96,224,96,260,-96,95,225,98,268,-76,95,225,112,268,-56,98,222,110,262
d[40]=-36,109,211,124,246,-21,137,183,160,206,-18,157,163,179,185
r=200,-1:g=200:b=200:t=0
RETURN

SUB readheaddata
numberoflayers=17
d=-99,136,184,103,181,-91,122,198,99,187,-83,115,205,101,201,-74,104,216,98,242
d[20]=-54,96,224,96,260,-36,95,225,98,268,-16,95,225,112,268,4,98,222,110,262
d[40]=24,102,218,113,249,-160,83,237,172,290,-42,91,229,142,280,-22,91,229,142,280
d[60]=-2,91,229,138,276,24,91,229,113,251,40,98,222,126,240,50,125,195,155,215
d[80]=57,152,168,182,188
lcn=0,0,0,0,0,0,0,0,7,7,7,7,7,7,7,7,7
r=255,255,0,0,255,255,0,150
g=200,0,255,0,255,0,255,100
b=173,0,0,255,0,255,255,0
t=0,0,0,0,0,0,0,0
RETURN

SUB readeyedata
numberoflayers=4
d=-160,100,220,100,220,-140,110,210,110,210,-122,130,190,129,191,-115,152,170,151,169
lcn=0,0,6,1
r=255,63,0,0,255,255,0,150
g=240,70,255,0,255,0,255,100
b=240,63,0,255,0,255,255,0
t=0,0,0,0,0,0,0,0
RETURN

SUB readnosedata
numberoflayers=5
d=-160,157,163,156,162,-146,127,193,126,192,-141,124,194,96,216,-134,124,194,96,216
d[20]=-41,157,163,157,163
r=255,-1:g=200:b=162:t=0
RETURN

SUB readlipdata
numberoflayers=4
d=-160,140,146,173,179,-113,147,175,153,173,-48,147,175,153,173,1,140,146,173,179
r=255,-1:g=152:b=138:t=0
RETURN

SUB readleftlegdata
numberoflayers=11
d=-160,149,171,123,171,-151,154,166,154,166,-83,154,166,154,166,-76,151,169,151,169
d[20]=-70,155,165,155,165,-63,150,170,150,170,-54,153,167,153,167,18,153,167,153,167
d[40]=30,142,168,151,169,37,141,169,150,170,44,154,160,157,163
r=200,-1:g=200:b=200:t=0
RETURN

SUB readrightlegdata
numberoflayers=11
d=-160,149,171,126,170,-151,154,166,154,166,-83,154,166,154,166,-76,151,169,151,169
d[20]=-70,155,165,155,165,-63,150,170,150,170,-54,153,167,153,167,18,153,167,153,167
d[40]=30,151,177,151,169,37,149,177,150,170,44,158,164,157,163
r=200,-1:g=200:b=200:t=0
RETURN


SUB modeller_object2(numberofsections,topfacepresent,bottomfacepresent,parentscene)
'Number of sections must be 3 or above
'Top face present and bottom face present should be 1 or 0
DEF objecthandle1:INT
IF numberofsections>2
  DEF objecthandle,colour:INT
  DEF facedata[100],section,vertex[10000],facenumber,xcentre,zcentre,xradius,zradius:INT
  DEF angle:FLOAT
  DEF layer,vertexnumber,normal:INT
  IF r[1]=-1
    'Only one colour used.Set all layer colour numbers to zero
    FOR layer=0 TO numberoflayers-1:lcn[layer]=0:NEXT layer
  ENDIF
  objecthandle=D3DSHAPE(parentscene,@SHAPECUSTOM)
  normal=D3DCOMMAND (objecthandle,@ADDNORMAL,0,-1,0)
  'Create vertices
  FOR layer=0 TO numberoflayers-1
   xcentre=-160+(d[layer*5+1]+d[layer*5+2])/2
   zcentre=-160+(d[layer*5+4]+d[layer*5+3])/2
   xradius=(d[layer*5+2]-d[layer*5+1])/2
   zradius=(d[layer*5+4]-d[layer*5+3])/2 
   FOR section=0 TO numberofsections-1
     angle=6.283*section/numberofsections
     vertexnumber=layer*numberofsections+section
     vertex[vertexnumber]=D3DCOMMAND (objecthandle,@ADDVERTEX,xcentre+xradius*SIN(angle),d[layer*5],zcentre+zradius*COS(angle))
    NEXT section
  NEXT layer
  'Create side faces
  facedata[0]=4:facedata[9]=0
  facedata[2]=normal:facedata[4]=normal:facedata[6]=normal:facedata[8]=normal
  FOR layer=1 TO numberoflayers-1
   FOR section=0 TO numberofsections-1
     facedata[7]=vertex[(layer-1)*numberofsections+section]
     facedata[5]=vertex[layer*numberofsections+section]
     IF section<>numberofsections-1
       facedata[3]=vertex[layer*numberofsections+section+1]
       facedata[1]=vertex[(layer-1)*numberofsections+section+1]
     ELSE
       facedata[3]=vertex[layer*numberofsections]
       facedata[1]=vertex[(layer-1)*numberofsections]
     ENDIF
     D3DCOMMAND objecthandle,@ADDFACES,facedata
      'Colour face
      colour=lcn[layer-1]
      D3DCOMMAND objecthandle,@SETFACECOLOR,facenumber,r[colour]/255,g[colour]/255,b[colour]/255,1-t[colour]/255
      facenumber=facenumber+1
   NEXT section
   D3DCOMMAND objecthandle,@CUSTOMINIT
  NEXT layer
  'Create top face if present
  IF topfacepresent
    facedata[0]=numberofsections:facedata[2*numberofsections+1]=0
    FOR section=0 TO numberofsections-1
      facedata[2*section+1]=vertex[(numberoflayers-1)*numberofsections+section]
      facedata[2*section+2]=normal
    NEXT section
    D3DCOMMAND objecthandle,@ADDFACES,facedata
    'Colour face
    colour=lcn[numberoflayers-1]
    D3DCOMMAND objecthandle,@SETFACECOLOR,facenumber,r[colour]/255,g[colour]/255,b[colour]/255,1-t[colour]/255
    facenumber=facenumber+1
    D3DCOMMAND objecthandle,@CUSTOMINIT
  ENDIF
  'Create bottom face if present
  IF bottomfacepresent
    facedata[0]=numberofsections:facedata[2*numberofsections+1]=0
    FOR section=numberofsections-1 TO 0 STEP -1
      facedata[2*(numberofsections-1-section)+1]=vertex[section]
      facedata[2*(numberofsections-1-section)+2]=normal
    NEXT section
    D3DCOMMAND objecthandle,@ADDFACES,facedata
    'Colour face
    colour=lcn[0]
    D3DCOMMAND objecthandle,@SETFACECOLOR,facenumber,r[colour]/255,g[colour]/255,b[colour]/255,1-t[colour]/255
    facenumber=facenumber+1
    D3DCOMMAND objecthandle,@CUSTOMINIT
  ENDIF
  'Save object without normals,delete it then reload it
  'Quick and dirty way to get DirectX to calculate normals
  D3DCOMMAND objecthandle,@SAVESHAPE,GETSTARTPATH+"temporary.x",@FORMATTEXT,@SAVEMATERIALS
  D3DDELETE objecthandle
  objecthandle1=D3DSHAPE(parentscene,@SHAPECUSTOM)
  D3DCOMMAND objecthandle1,@LOADSHAPE,GETSTARTPATH+"temporary.x",0
ENDIF
RETURN objecthandle1


[GWS]

Rampant imagination .. and a lot of skill .. 

For a simple language Creative Basic offers a lot of scope.

Graham