Spring

[FellippeHeitor]

Grab the red handle and pull it in any direction and watch as the elastic string will pull it back to its original spot.

Change the resistance of the string using the slider.

I called this Spring because my original idea was to have a spring-like spiral go from the origin point to the handle, but that went beyond my math skills...

[bplus]

Hi Fellippe,

I haven't checked code yet but already I am thinking there should be a paddle on the other end of the ball and "spring" or bungee cord... would that work with the mouse moving the paddle...? hmm...

[FellippeHeitor]

Replace just the contents of the .bas file in the zip above with the code below and turn the elastic band into a thicker version of itself, one that will actually resemble a real stretching elastic band that changes thickness according to how far it's stretched.

Code: QB64: [Select]

1. ': This program uses
2. ': InForm - GUI library for QB64 - Beta version 8
3. ': Fellippe Heitor, 2016-2018 - fellippe@qb64.org - @fellippeheitor
4. ': https://github.com/FellippeHeitor/InForm
5. '-----------------------------------------------------------
6.  
7. ': Controls' IDs: ------------------------------------------------------------------
8. DIM SHARED Spring AS LONG
9. DIM SHARED PictureBox1 AS LONG
10. DIM SHARED ResistanceLB AS LONG
11. DIM SHARED TrackBar1 AS LONG
12. DIM SHARED ExitBT AS LONG
13.  
14. TYPE vector
15.     x AS SINGLE
16.     y AS SINGLE
17. END TYPE
18.  
19. DIM SHARED origin AS vector, handle AS vector, mouse AS vector
20. DIM SHARED diff AS vector
21.  
22. origin.x = 400
23. origin.y = 300
24. handle = origin
25.  
26. ': External modules: ---------------------------------------------------------------
27. '$INCLUDE:'InForm\InForm.ui'
28. '$INCLUDE:'InForm\xp.uitheme'
29. '$INCLUDE:'Spring.frm'
30.  
31. ': Event procedures: ---------------------------------------------------------------
32. SUB __UI_BeforeInit
33.  
34. END SUB
35.  
36. SUB __UI_OnLoad
37.  
38. END SUB
39.  
40. SUB __UI_BeforeUpdateDisplay STATIC
41.     'This event occurs at approximately 30 frames per second.
42.     'You can change the update frequency by calling SetFrameRate DesiredRate%
43.  
44.     BeginDraw PictureBox1
45.     CLS
46.  
47.     mouse.x = _MOUSEX
48.     mouse.y = _MOUSEY
49.  
50.     d = distB(origin, handle)
51.     m = distB(handle, mouse)
52.  
53.     PRINT d
54.  
55.     IF _MOUSEBUTTON(1) THEN
56.         IF NOT mouseDown THEN
57.             IF m < 30 THEN mouseDown = True
58.         ELSE
59.             handle = mouse
60.         END IF
61.     ELSE
62.         IF mouseDown THEN
63.             mouseDown = False
64.         END IF
65.     END IF
66.  
67.     IF NOT mouseDown THEN
68.         IF d > 0 THEN
69.             diff.y = handle.y - origin.y
70.             diff.x = handle.x - origin.x
71.             'a = _ATAN2(diff.x, diff.y)
72.  
73.             handle.x = handle.x - diff.x / map(d, 0, _WIDTH, 1, 32 - Control(TrackBar1).Value)
74.             handle.y = handle.y - diff.y / map(d, 0, _HEIGHT, 1, 32 - Control(TrackBar1).Value)
75.         END IF
76.     END IF
77.  
78.     COLOR _RGB32(127, 127, 127)
79.     thickLine origin.x, origin.y, handle.x, handle.y, map(d, 0, _WIDTH, 10, 1)
80.     CircleFill origin.x, origin.y, 5, _RGB32(255, 0, 0)
81.     CircleFill handle.x, handle.y, 30, _RGB32(255, 0, 0)
82.     EndDraw PictureBox1
83. END SUB
84.  
85. SUB __UI_BeforeUnload
86.     'If you set __UI_UnloadSignal = False here you can
87.     'cancel the user's request to close.
88.  
89. END SUB
90.  
91. SUB __UI_Click (id AS LONG)
92.     SELECT CASE id
93.         CASE Spring
94.  
95.         CASE PictureBox1
96.  
97.         CASE ResistanceLB
98.  
99.         CASE TrackBar1
100.  
101.         CASE ExitBT
102.             SYSTEM
103.     END SELECT
104. END SUB
105.  
106. SUB __UI_MouseEnter (id AS LONG)
107.     SELECT CASE id
108.         CASE Spring
109.  
110.         CASE PictureBox1
111.  
112.         CASE ResistanceLB
113.  
114.         CASE TrackBar1
115.  
116.         CASE ExitBT
117.  
118.     END SELECT
119. END SUB
120.  
121. SUB __UI_MouseLeave (id AS LONG)
122.     SELECT CASE id
123.         CASE Spring
124.  
125.         CASE PictureBox1
126.  
127.         CASE ResistanceLB
128.  
129.         CASE TrackBar1
130.  
131.         CASE ExitBT
132.  
133.     END SELECT
134. END SUB
135.  
136. SUB __UI_FocusIn (id AS LONG)
137.     SELECT CASE id
138.         CASE TrackBar1
139.  
140.         CASE ExitBT
141.  
142.     END SELECT
143. END SUB
144.  
145. SUB __UI_FocusOut (id AS LONG)
146.     'This event occurs right before a control loses focus.
147.     'To prevent a control from losing focus, set __UI_KeepFocus = True below.
148.     SELECT CASE id
149.         CASE TrackBar1
150.  
151.         CASE ExitBT
152.  
153.     END SELECT
154. END SUB
155.  
156. SUB __UI_MouseDown (id AS LONG)
157.     SELECT CASE id
158.         CASE Spring
159.  
160.         CASE PictureBox1
161.  
162.         CASE ResistanceLB
163.  
164.         CASE TrackBar1
165.  
166.         CASE ExitBT
167.  
168.     END SELECT
169. END SUB
170.  
171. SUB __UI_MouseUp (id AS LONG)
172.     SELECT CASE id
173.         CASE Spring
174.  
175.         CASE PictureBox1
176.  
177.         CASE ResistanceLB
178.  
179.         CASE TrackBar1
180.  
181.         CASE ExitBT
182.  
183.     END SELECT
184. END SUB
185.  
186. SUB __UI_KeyPress (id AS LONG)
187.     'When this event is fired, __UI_KeyHit will contain the code of the key hit.
188.     'You can change it and even cancel it by making it = 0
189.     SELECT CASE id
190.         CASE TrackBar1
191.  
192.         CASE ExitBT
193.  
194.     END SELECT
195. END SUB
196.  
197. SUB __UI_TextChanged (id AS LONG)
198.     SELECT CASE id
199.     END SELECT
200. END SUB
201.  
202. SUB __UI_ValueChanged (id AS LONG)
203.     SELECT CASE id
204.         CASE TrackBar1
205.  
206.     END SELECT
207. END SUB
208.  
209. SUB __UI_FormResized
210.  
211. END SUB
212.  
213. FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
214.     map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
215. END FUNCTION
216.  
217. SUB CircleFill (x AS LONG, y AS LONG, R AS LONG, C AS _UNSIGNED LONG)
218.     x0 = R
219.     y0 = 0
220.     e = 0
221.     DO WHILE y0 < x0
222.         IF e <= 0 THEN
223.             y0 = y0 + 1
224.             LINE (x - x0, y + y0)-(x + x0, y + y0), C, BF
225.             LINE (x - x0, y - y0)-(x + x0, y - y0), C, BF
226.             e = e + 2 * y0
227.         ELSE
228.             LINE (x - y0, y - x0)-(x + y0, y - x0), C, BF
229.             LINE (x - y0, y + x0)-(x + y0, y + x0), C, BF
230.             x0 = x0 - 1
231.             e = e - 2 * x0
232.         END IF
233.     LOOP
234.     LINE (x - R, y)-(x + R, y), C, BF
235. END SUB
236.  
237. FUNCTION dist! (x1!, y1!, x2!, y2!)
238.     dist! = _HYPOT((x2! - x1!), (y2! - y1!))
239. END FUNCTION
240.  
241. FUNCTION distB! (v1 AS vector, v2 AS vector)
242.     distB! = dist!(v1.x, v1.y, v2.x, v2.y)
243. END FUNCTION
244.  
245. SUB thickLine (x1 AS SINGLE, y1 AS SINGLE, x2 AS SINGLE, y2 AS SINGLE, lineWeight%)
246.     DIM a AS SINGLE, x0 AS SINGLE, y0 AS SINGLE
247.     DIM prevDest AS LONG, prevColor AS _UNSIGNED LONG
248.     STATIC colorSample AS LONG
249.  
250.     IF colorSample = 0 THEN
251.         colorSample = _NEWIMAGE(1, 1, 32)
252.     END IF
253.  
254.     prevDest = _DEST
255.     prevColor = _DEFAULTCOLOR
256.     _DEST colorSample
257.     PSET (0, 0), prevColor
258.     _DEST prevDest
259.  
260.     a = _ATAN2(y2 - y1, x2 - x1)
261.     a = a + _PI / 2
262.     x0 = 0.5 * lineWeight% * COS(a)
263.     y0 = 0.5 * lineWeight% * SIN(a)
264.  
265.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), colorSample TO(x1 - x0, y1 - y0)-(x1 + x0, y1 + y0)-(x2 + x0, y2 + y0), , _SMOOTH
266.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), colorSample TO(x1 - x0, y1 - y0)-(x2 + x0, y2 + y0)-(x2 - x0, y2 - y0), , _SMOOTH
267. END SUB