3D x-ray shade house By Zerodog

[pistol350]

I just keep my mouth shut .The only thing i can say is Hat off to you ZD!!!
Great one!

Code Select Expand


' ZeroDog's X-Ray Shades
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 shape[100],light[100],scene[100],camera[100],Region[5]:INT
DEF windowstring:STRING

getscreensize sx,sy
windowstring = "I,ZeroDog's X-Ray Shades"+SPACE$(57)+"Click 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
GOSUB SetupWin1

run=1
waituntil run=0
for x = 0 to 99
   if (shape[x]) then d3ddelete shape[x]
   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]

   for x = 1 to 2 : D3DRENDER scene[x],camera[x] : next x

   'Draw our Xray Spec Frames
   ELLIPSE win[1], sx/3-10, sx/4-26,  sx/6+10, sx/6+14,0,0
   ELLIPSE win[1], (sx/3+sx/5)-10, (sx/4)-26,  sx/6+10, sx/6+14 ,0,0
   RECT win[1], sx/3-10, sx/4-26,  sx/6+10, sx/12 ,0,0
   RECT win[1], (sx/3+sx/5)-10, (sx/4)-26,  sx/6+10, sx/12  ,0,0
   'arms
   RECT win[1], sx/5, sx/4, sx/5, 10 ,0,0
   RECT win[1], sx/1.65, sx/4, sx/5, 10 ,0,0
   RECT win[1], sx/2.5, sx/4, sx/5, 5, 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
         if  (ShadesActivated = 1)
            ShadesActivated = 0
            D3DSETQUALITY win[2], @LIGHTON|@FILLsolid|@SHADEgouraud
            D3DCOMMAND light[4], @SETLIGHTCOLOR, .5,.5,.5
         else
            ShadesActivated = 1
            D3DSETQUALITY win[2], @LIGHTON|@FILLwireframe
            D3DCOMMAND light[4], @SETLIGHTCOLOR, 0,0,0
         endif
      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/3,sx/4,sx/3+sx/6,sx/4+sx/6) 
      'right bottom
      Region[2] = CreateEllipticRgn((sx/3+sx/5), (sx/4),  (sx/3)+(sx/6)+(sx/5), (sx/4+sx/6)) 
      'left top
      Region[3] = CreateRectRgn(sx/3,sx/4,sx/3+sx/6,sx/4+sx/12) 
      'right top
      Region[4] = CreateRectRgn((sx/3+sx/5), (sx/4),  (sx/3)+(sx/6)+(sx/5), (sx/4+sx/12)) 
      '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],1,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)

   'ground
   shape[0+x] = D3DSHAPE(scene[x],@SHAPECUBE,100,5,100)
   D3DCOMMAND shape[0+x],@SETPOSITION,scene[x],0,-4.5,0
   D3DCOMMAND shape[0+x],@SETSHAPECOLOR,.3, .5, .4
   'housebase
   shape[2+x] = D3DSHAPE(scene[x],@SHAPECUBE,10.01, 7, 20.01)
   D3DCOMMAND shape[2+x],@SETPOSITION,scene[x],20,1.5,0
   D3DCOMMAND shape[2+x],@SETSHAPECOLOR,.5, .3, .4
   'houseroof1
   shape[4+x] = D3DSHAPE(scene[x],@SHAPECUBE,7, 7, 20)
   D3DCOMMAND shape[4+x],@SETPOSITION,scene[x],20,5,0
   D3DCOMMAND shape[4+x],@SETORIENTATION,scene[x],0,0,1,1,1,0
   D3DCOMMAND shape[4+x],@SETSHAPECOLOR,.5, .3, .4
   'houseroof2
   shape[6+x] = D3DSHAPE(scene[x],@SHAPECUBE,.5, 8, 20.5)
   D3DCOMMAND shape[6+x],@SETPOSITION,scene[x],17.3,7,0
   D3DCOMMAND shape[6+x],@SETORIENTATION,scene[x],0,0,1,1,1,0
   D3DCOMMAND shape[6+x],@SETSHAPECOLOR,.2, .2, .2
   'houseroof3
   shape[8+x] = D3DSHAPE(scene[x],@SHAPECUBE,8, .5, 20.5)
   D3DCOMMAND shape[8+x],@SETPOSITION,scene[x],22.7,7,0
   D3DCOMMAND shape[8+x],@SETORIENTATION,scene[x],0,0,1,1,1,0
   D3DCOMMAND shape[8+x],@SETSHAPECOLOR,.2, .2, .2
   'housechimney
   shape[10+x] = D3DSHAPE(scene[x],@SHAPECUBE,2, 6, 2)
   D3DCOMMAND shape[10+x],@SETPOSITION,scene[x],22,8,8
   D3DCOMMAND shape[10+x],@SETSHAPECOLOR,.5, .3, .3
   'housedoor
   shape[12+x] = D3DSHAPE(scene[x],@SHAPECUBE,2.5, 4,  .1)
   D3DCOMMAND shape[12+x],@SETPOSITION,scene[x],20,1,-10.05
   D3DCOMMAND shape[12+x],@SETSHAPECOLOR,.35,.35,.35
   'doorknob
   shape[14+x] = D3DSHAPE(scene[x],@SHAPESPHERE,.2,10)
   D3DCOMMAND shape[14+x],@SETPOSITION,scene[x],20.75,1,-10.2
   D3DCOMMAND shape[14+x],@SETSHAPECOLOR,1,1,0
   'step1
   shape[16+x] = D3DSHAPE(scene[x],@SHAPECUBE,3,.5,1.6)
   D3DCOMMAND shape[16+x],@SETPOSITION,scene[x],20,-1.75,-10.8
   D3DCOMMAND shape[16+x],@SETSHAPECOLOR,1,1,1
   'step2
   shape[18+x] = D3DSHAPE(scene[x],@SHAPECUBE,3,.5,1)
   D3DCOMMAND shape[18+x],@SETPOSITION,scene[x],20,-1.25,-10.5
   D3DCOMMAND shape[18+x],@SETSHAPECOLOR,1,1,1
   'fence1top
   shape[20+x] = D3DSHAPE(scene[x],@SHAPECUBE,100,.2,.2)
   D3DCOMMAND shape[20+x],@SETPOSITION,scene[x],0,0,50
   D3DCOMMAND shape[20+x],@SETSHAPECOLOR,1,.8,0
   'fence1bottom
   shape[22+x] = D3DSHAPE(scene[x],@SHAPECUBE,100,.2,.2)
   D3DCOMMAND shape[22+x],@SETPOSITION,scene[x],0,-1.25,50
   D3DCOMMAND shape[22+x],@SETSHAPECOLOR,1,.8,0
   'fence2top
   shape[24+x] = D3DSHAPE(scene[x],@SHAPECUBE,100,.2,.2)
   D3DCOMMAND shape[24+x],@SETPOSITION,scene[x],0,0,-50
   D3DCOMMAND shape[24+x],@SETSHAPECOLOR,1,.8,0
   'fence2bottom
   shape[26+x] = D3DSHAPE(scene[x],@SHAPECUBE,100,.2,.2)
   D3DCOMMAND shape[26+x],@SETPOSITION,scene[x],0,-1.25,-50
   D3DCOMMAND shape[26+x],@SETSHAPECOLOR,1,.8,0
   'fence3top
   shape[28+x] = D3DSHAPE(scene[x],@SHAPECUBE,.2,.2,100)
   D3DCOMMAND shape[28+x],@SETPOSITION,scene[x],50,0,0
   D3DCOMMAND shape[28+x],@SETSHAPECOLOR,1,.8,0
   'fence3bottom
   shape[30+x] = D3DSHAPE(scene[x],@SHAPECUBE,.2,.2,100)
   D3DCOMMAND shape[30+x],@SETPOSITION,scene[x],50,-1.25,0
   D3DCOMMAND shape[30+x],@SETSHAPECOLOR,1,.8,0
   'fence4top
   shape[32+x] = D3DSHAPE(scene[x],@SHAPECUBE,.2,.2,100)
   D3DCOMMAND shape[32+x],@SETPOSITION,scene[x],-50,0,0
   D3DCOMMAND shape[32+x],@SETSHAPECOLOR,1,.8,0
   'fence4bottom
   shape[34+x] = D3DSHAPE(scene[x],@SHAPECUBE,.2,.2,100)
   D3DCOMMAND shape[34+x],@SETPOSITION,scene[x],-50,-1.25,0
   D3DCOMMAND shape[34+x],@SETSHAPECOLOR,1,.8,0
   'fence1 posts
   for z = -50 to 50 step 10
     for y = 36 to 46 step 2
      shape[y+x] = D3DSHAPE(scene[x],@SHAPECUBE,.2,3,.2)
      D3DCOMMAND shape[y+x],@SETPOSITION,scene[x],z,-1,50
      D3DCOMMAND shape[y+x],@SETSHAPECOLOR,1,.8,0
        next y
   next z
   'fence2 posts
   for z = -50 to 50 step 10
        for y = 48 to 58 step 2
      shape[y+x] = D3DSHAPE(scene[x],@SHAPECUBE,.2,3,.2)
      D3DCOMMAND shape[y+x],@SETPOSITION,scene[x],z,-1,-50
      D3DCOMMAND shape[y+x],@SETSHAPECOLOR,1,.8,0
       next y
   next z
   'fence3 posts
   for z = -50 to 50 step 10
      for y = 60 to 70 step 2
      shape[y+x] = D3DSHAPE(scene[x],@SHAPECUBE,.2,3,.2)
      D3DCOMMAND shape[y+x],@SETPOSITION,scene[x],50,-1,z
      D3DCOMMAND shape[y+x],@SETSHAPECOLOR,1,.8,0
       next y
   next z
   'fence4 posts
   for z = -50 to 50 step 10
       for y = 72 to 82 step 2
      shape[y+x] = D3DSHAPE(scene[x],@SHAPECUBE,.2,3,.2)
      D3DCOMMAND shape[y+x],@SETPOSITION,scene[x],-50,-1,z
      D3DCOMMAND shape[y+x],@SETSHAPECOLOR,1,.8,0
       next y
   next z
   'Driveway
   shape[84+x] = D3DSHAPE(scene[x],@SHAPECUBE,10,.1,60)
   D3DCOMMAND shape[84+x],@SETPOSITION,scene[x],10,-2,-20
   D3DCOMMAND shape[84+x],@SETSHAPECOLOR,0,0,0
   'window1glass
   shape[86+x] = D3DSHAPE(scene[x],@SHAPECUBE,.1,3,6)
   D3DCOMMAND shape[86+x],@SETPOSITION,scene[x],15,1.5,-5
   D3DCOMMAND shape[86+x],@SETSHAPECOLOR,.6,.7,1
   'window1frame top
   shape[88+x] = D3DSHAPE(scene[x],@SHAPECUBE,.2,.25,6.5)
   D3DCOMMAND shape[88+x],@SETPOSITION,scene[x],15,3,-5
   D3DCOMMAND shape[88+x],@SETSHAPECOLOR,.35,.35,.35
   'window1frame bottom
   shape[88+x] = D3DSHAPE(scene[x],@SHAPECUBE,.2,.25,6.5)
   D3DCOMMAND shape[88+x],@SETPOSITION,scene[x],15,0,-5
   D3DCOMMAND shape[88+x],@SETSHAPECOLOR,.35,.35,.35
   'window1frame left
   shape[90+x] = D3DSHAPE(scene[x],@SHAPECUBE,.2,3,.25)
   D3DCOMMAND shape[90+x],@SETPOSITION,scene[x],15,1.5,-1.875
   D3DCOMMAND shape[90+x],@SETSHAPECOLOR,.35,.35,.35
   'window1frame right
   shape[92+x] = D3DSHAPE(scene[x],@SHAPECUBE,.2,3,.25)
   D3DCOMMAND shape[92+x],@SETPOSITION,scene[x],15,1.5,-8.125
   D3DCOMMAND shape[92+x],@SETSHAPECOLOR,.35,.35,.35   

next x

ShadesActivated = 0
RETURN

[GWS]

Nice one by ZeroDog.

Graham