1: 'Hello If you find this program usefull please let me know. I'm a 13 year old 2: 'That lives in AZ, I didn't see any kind of 3d Qbasic modler out there so 3: 'here one is. I am trying to get shading, but that is incredibly difficult. 4: 'If anyone out there does it before me please send me your Qbasic program. 5: 'I would like to see how you did it. My AOL address is Coyles, or 6: 'for you non-AOLers its coyles@AOL.com. I would really like so feedback. 7: ' THNX for reading. 8: DECLARE SUB drawit () 9: DECLARE SUB plotit () 10: DECLARE SUB ms () 11: DECLARE SUB Pause () 12: DECLARE SUB MOUSESTATUS (lb%, rb%, XMouse%, YMouse%) 13: DECLARE SUB mouserange (x1%, y1%, x2%, y2%) 14: DECLARE SUB MousePut (x%, y%) 15: DECLARE SUB MouseHide () 16: DECLARE SUB MouseDriver (ax%, bx%, cx%, dx%) 17: DECLARE SUB mouseshow () 18: DECLARE FUNCTION MouseInit% () 19: COMMON SHARED nodes 20: COMMON SHARED nx, ny, num 21: DIM SHARED Mouse$ 22: '*************************************************************************** 23: '***if you get a "subscript out of range" error increase this variable.**** 24: nodes = 1000 25: '***if you get a "subscript out of range" error increase this variable.**** 26: '*************************************************************************** 27: DIM SHARED nx(1 TO nodes) 28: DIM SHARED ny(1 TO nodes) 29: TYPE sammy 30: x AS INTEGER 31: y AS INTEGER 32: END TYPE 33: 34: Mouse$ = SPACE$(57) 35: FOR i% = 1 TO 57 36: READ a$ 37: H$ = CHR$(VAL("&H" + a$)) 38: MID$(Mouse$, i%, 1) = H$ 39: NEXT i% 40: DATA 55,89,E5,8B,5E,0C,8B,07,50,8B,5E,0A,8B,07,50,8B 41: DATA 5E,08,8B,0F,8B,5E,06,8B,17,5B,58,1E,07,CD,33,53 42: DATA 8B,5E,0C,89,07,58,8B,5E,0A,89,07,8B,5E,08,89,0F 43: DATA 8B,5E,06,89,17,5D,CA,08,00 44: CLS 45: SCREEN 12 46: mouseshow 47: plotit 48: drawit 49: 50: SUB drawit 51: DIM fs(1 TO nodes) 52: DIM f(1 TO nodes) 53: CLS 54: steps = 20 55: FOR gh% = 1 TO num 56: fs(gh%) = ny(gh%) / steps 57: NEXT gh% 58: 'PRINT f1; f2; f3; f4; f5; f6 59: 60: FOR fi% = 1 TO steps * 2 61: FOR gh% = 1 TO num 62: f(gh%) = f(gh%) + fs(gh%) 63: NEXT gh% 64: 65: FOR rt% = 1 TO num - 1 66: tx = nx(rt%): ty = (240 - ny(rt%)) + f(rt%) 67: tx2 = nx(rt% + 1): ty2 = (240 - ny(rt%)) + f(rt%) 68: LINE (tx, ty)-(tx2, ty2), 2 69: NEXT rt% 70: NEXT fi% 71: END SUB 72: 73: SUB MouseDriver (ax%, bx%, cx%, dx%) 74: DEF SEG = VARSEG(Mouse$) 75: Mouse% = SADD(Mouse$) 76: CALL Absolute(ax%, bx%, cx%, dx%, Mouse%) 77: END SUB 78: 79: SUB MouseHide 80: ax% = 2 81: MouseDriver ax%, 0, 0, 0 82: END SUB 83: 84: FUNCTION MouseInit% 85: ax% = 0 86: MouseDriver ax%, 0, 0, 0 87: MouseInit% = ax% 88: END FUNCTION 89: 90: SUB MousePut (x%, y%) 91: ax% = 4 92: cx% = x% 93: dx% = y% 94: MouseDriver ax%, 0, cx%, dx% 95: END SUB 96: 97: SUB mouserange (x1%, y1%, x2%, y2%) 98: ax% = 7 99: cx% = x1% 100: dx% = x2% 101: MouseDriver ax%, 0, cx%, dx% 102: ax% = 8 103: cx% = y1% 104: dx% = y2% 105: MouseDriver ax%, 0, cx%, dx% 106: END SUB 107: 108: SUB mouseshow 109: ax% = 1 110: MouseDriver ax%, 0, 0, 0 111: END SUB 112: 113: SUB MOUSESTATUS (lb%, rb%, XMouse%, YMouse%) 114: ax% = 3 115: MouseDriver ax%, bx%, cx%, dx% 116: lb% = ((bx% AND 1) <> 0) 117: rb% = ((bx% AND 2) <> 0) 118: XMouse% = cx% 119: YMouse% = dx% 120: END SUB 121: 122: SUB Pause 123: 'This sub used for demo, not needed for mouse calls 124: PRINT "Press any key to continue..." 125: G$ = INPUT$(1) 126: PRINT 127: END SUB 128: 129: SUB plotit 130: CLS : SCREEN 12 131: mouserange 0, 240, 640, 480 132: loops: 133: FOR yi = 1 TO 100 STEP .6: NEXT yi 134: DO 135: MOUSESTATUS lb%, rb%, x%, y% 136: IF lb% = -1 THEN GOTO spoint 137: IF rb% = -1 THEN GOTO dones 138: LOOP 139: spoint: 140: yu% = yu% + 1 141: nx(yu%) = x%: ny(yu%) = 480 - y% 142: CIRCLE (x%, y%), 2 143: GOTO loops 144: dones: 145: num = yu% 146: END SUB 147: |