The possibility to see a woman naked ::)
LOL!!!!! ;D ;D ;D
nice sample
' 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
Rampant imagination .. and a lot of skill .. :)
For a simple language Creative Basic offers a lot of scope.
Graham