Grid-a-Pic (a peck o' pickled peppers...)

[OldMoses]

I haven't done much contributing here lately, as I've been obsessing over my bucket list project, and I'm about the slowest coder on the planet. So I thought I'd share this errant bit of knavery, which I came up with while taking a break from the "bucket..." project.

It's made possible, thanks to Steve's Save Image library, so I included that in the zip.

In keeping with my leanings towards RPG gamemaster utilities, it loads a picture, overlays a hex or square grid which can be shifted and resized. Adjust a grid to a map legend, or grid a picture for tracing, or whatever else one can dream up to do with it.

Mouse or hotkey interface.
Arrow keys pan around the image or drag with mouse in large display.
Change grid size with "+"/"-" or use size buttons
Offset the grid by half in four directions with "ADWZ" or rocker.
Change from hex to box grid with "HB" or buttons. Click or press active again to turn it off.
Save it once it's acceptable.

It kind of works OK, for a quickie.

Code: QB64: [Select]

1. '$INCLUDE:'SaveImage.BI'
2.  
3. 'Grid-a-Pic
4.  
5. TYPE object
6.     x AS INTEGER
7.     y AS INTEGER
8. END TYPE
9.  
10. 'GLOBAL VARIABLES
11. DIM SHARED camera AS object
12. DIM dWidth AS INTEGER
13. DIM dHeight AS INTEGER
14. DIM mWidth AS INTEGER
15. DIM mHeight AS INTEGER
16. DIM SHARED wWidth AS INTEGER
17. DIM SHARED wHeight AS INTEGER
18. DIM mF AS SINGLE
19. DIM SHARED gsiz AS INTEGER
20. DIM SHARED hOff AS INTEGER
21. DIM SHARED vOff AS INTEGER
22. DIM SHARED gtog AS _BYTE
23. DIM SHARED mp AS LONG
24. DIM SHARED main&
25. DIM SHARED grid&
26. DIM SHARED arw&
27. DIM SHARED abyt AS _UNSIGNED _BYTE
28. DIM SHARED rbyt AS _UNSIGNED _BYTE
29. DIM SHARED gbyt AS _UNSIGNED _BYTE
30. DIM SHARED bbyt AS _UNSIGNED _BYTE
31.  
32. CONST keyUP = 18432
33. CONST keyDOWN = 20480
34. CONST keyLEFT = 19200
35. CONST keyRIGHT = 19712
36. CONST PLUS = 43
37. CONST MINUS = 45
38. CONST ESC = 27
39. CONST keyB = 98
40. CONST keyH = 104
41. CONST keyO = 111
42. CONST keyQ = 113
43. CONST keyA = 97
44. CONST keyS = 115
45. CONST keyD = 100
46. CONST keyW = 119
47. CONST keyZ = 122
48.  
49. 'INITIAL PARAMETERS
50. dWidth = _DESKTOPWIDTH '                                        Display size
51. dHeight = _DESKTOPHEIGHT - 80 '                                 leave room for task bar
52. wWidth = dWidth - 401 '                                         Window size
53. wHeight = dHeight
54. mp = _NEWIMAGE(wWidth, wHeight, 32)
55. mWidth = _WIDTH(mp) '                                           Map/pic size
56. mHeight = _HEIGHT(mp)
57. gsiz = 35: hOff = 0: vOff = 0
58. abyt = 127: rbyt = 127: gbyt = 127: bbyt = 127
59. main& = _NEWIMAGE(dWidth, dHeight, 32)
60. grid& = _NEWIMAGE(mWidth, mHeight, 32)
61. arw& = _NEWIMAGE(30, 30, 32)
62. Make_Arrow
63. SCREEN main&
64. DO UNTIL _SCREENEXISTS
65. LOOP
66. _TITLE "GridPic (esc to quit, arrows to pan, +/- to resize grid, 'h' for hex grid, 'b' for box grid)"
67. _SCREENMOVE 0, 0
68.  
69. DO
70.     IF _KEYDOWN(keyB) THEN
71.         IF _READBIT(gtog, 1) THEN
72.             IF _READBIT(gtog, 0) THEN
73.                 gtog = _RESETBIT(gtog, 0)
74.             ELSE
75.                 gtog = _TOGGLEBIT(gtog, 1)
76.             END IF
77.         ELSE
78.             gtog = _RESETBIT(gtog, 0): gtog = _TOGGLEBIT(gtog, 1)
79.         END IF
80.         _DELAY .2
81.     END IF
82.     IF _KEYDOWN(keyH) THEN
83.         IF _READBIT(gtog, 1) THEN
84.             IF NOT _READBIT(gtog, 0) THEN
85.                 gtog = _SETBIT(gtog, 0)
86.             ELSE
87.                 gtog = _TOGGLEBIT(gtog, 1)
88.             END IF
89.         ELSE
90.             gtog = _SETBIT(gtog, 0): gtog = _TOGGLEBIT(gtog, 1): _DELAY .2
91.         END IF
92.         _DELAY .2
93.     END IF
94.     IF _KEYDOWN(keyS) THEN Save_Gridpic
95.     IF _KEYDOWN(keyO) THEN Load_Image
96.     IF _KEYDOWN(PLUS) THEN gsiz = gsiz + 1
97.     IF _KEYDOWN(MINUS) THEN gsiz = gsiz - 1
98.     IF _KEYDOWN(keyUP) THEN camera.y = camera.y - 10
99.     IF _KEYDOWN(keyDOWN) THEN camera.y = camera.y + 10
100.     IF _KEYDOWN(keyLEFT) THEN camera.x = camera.x - 10
101.     IF _KEYDOWN(keyRIGHT) THEN camera.x = camera.x + 10
102.     IF _KEYDOWN(ESC) THEN SYSTEM
103.     IF _KEYDOWN(keyQ) THEN SYSTEM
104.     IF _KEYDOWN(keyA) AND hOff > -gsiz / 2 THEN hOff = hOff - 1
105.     IF _KEYDOWN(keyD) AND hOff < gsiz / 2 THEN hOff = hOff + 1
106.     IF _KEYDOWN(keyW) AND vOff > -gsiz / 2 THEN vOff = vOff - 1
107.     IF _KEYDOWN(keyZ) AND vOff < gsiz / 2 THEN vOff = vOff + 1
108.  
109.     IF gsiz < 2 THEN gsiz = 2
110.     IF camera.x < 0 THEN camera.x = 0
111.     IF camera.y < 0 THEN camera.y = 0
112.     IF camera.x > _WIDTH(mp) - wWidth THEN camera.x = _WIDTH(mp) - wWidth
113.     IF camera.y > _HEIGHT(mp) - wHeight THEN camera.y = _HEIGHT(mp) - wHeight
114.  
115.     WHILE _MOUSEINPUT
116.     WEND
117.     IF _MOUSEBUTTON(1) THEN
118.         Mouse_Ops _MOUSEX, _MOUSEY
119.     END IF
120.  
121.     _DEST grid&
122.     CLS
123.     IF _READBIT(gtog, 1) THEN
124.         IF _READBIT(gtog, 0) THEN
125.             Hex_Grid gsiz, hOff, vOff
126.         ELSE
127.             Box_Grid gsiz, hOff, vOff
128.         END IF
129.     END IF
130.     _CLEARCOLOR _RGB32(0, 0, 0)
131.     _DEST main&
132.     'place finished image in screen window
133.     CLS
134.     _PUTIMAGE (400, 0), mp, main&, (camera.x, camera.y)-(camera.x + wWidth, camera.y + wHeight) 'map
135.     _PUTIMAGE (400, 0), grid&, main&, (camera.x, camera.y)-(camera.x + wWidth, camera.y + wHeight) 'grid overlay
136.     mF = 400 / _WIDTH(mp)
137.     _PUTIMAGE (0, _HEIGHT(main&) - 1 - mF * _HEIGHT(mp))-(399, _HEIGHT(main&) - 1), mp 'mini map
138.     'draw red box on mini map with limits of window display
139.     LINE (camera.x * mF, _HEIGHT(main&) - 1 - (mF * _HEIGHT(mp)) + camera.y * mF)-_
140.         ((camera.x + wWidth) * mF, _HEIGHT(main&) - 1 - (mF * _HEIGHT(mp)) + camera.y * mF + wHeight * mF), &HFFFF0000, B
141.     LINE (camera.x * mF + 1, _HEIGHT(main&) - (mF * _HEIGHT(mp)) + camera.y * mF)-_
142.         ((camera.x + wWidth) * mF - 1, _HEIGHT(main&) - 2 - (mF * _HEIGHT(mp)) + camera.y * mF + wHeight * mF), &HFFFF0000, B
143.  
144.     Para_Disp
145.     _LIMIT 30
146.     _DISPLAY
147. LOOP
148. '                                                               END: MAIN MODULE / BEGIN SUBROUTINES
149.  
150.  
151. SUB Box_Grid (siz AS INTEGER, h AS INTEGER, v AS INTEGER)
152.  
153.     DIM s, ho, vo
154.     COLOR _RGBA32(rbyt, gbyt, bbyt, abyt)
155.     s = siz
156.     ho = 0
157.     DO 'vertical lines
158.         LINE (ho * s + h, 0)-(ho * s + h, _HEIGHT(grid&) - 1)
159.         ho = ho + 1
160.     LOOP UNTIL ho * s > _WIDTH(grid&)
161.     vo = 0
162.     DO 'horizontal lines
163.         LINE (0, vo * s + v)-(_WIDTH(grid&) - 1, vo * s + v)
164.         vo = vo + 1
165.     LOOP UNTIL vo * s + v > _HEIGHT(grid&)
166.  
167. END SUB 'Box_Grid
168.  
169.  
170. SUB Con_Blok (xpos AS INTEGER, ypos AS INTEGER, xsiz AS INTEGER, ysiz AS INTEGER, label AS STRING, high AS INTEGER, col AS _UNSIGNED LONG)
171.  
172.     'Create control block
173.     DIM CN&, x, p, sx, sy
174.     CN& = _NEWIMAGE(xsiz, ysiz, 32)
175.     _DEST CN&
176.     COLOR , col
177.     CLS
178.     _PRINTMODE _KEEPBACKGROUND
179.     x = LEN(label)
180.     sx = xsiz / 2 - x * 4: sy = ysiz / 2 - 8
181.     FOR p = 1 TO x '                                            iterate through label characters
182.         IF p = high THEN '                                      print hotkey highlight color (red) else (black)
183.             IF col = &HFFFF0000 THEN
184.                 COLOR &HFFFFFFFF
185.             ELSE
186.                 COLOR &HFFFF0000
187.             END IF
188.         ELSE
189.             COLOR &HFF000000
190.         END IF
191.         _PRINTSTRING (sx + (p - 1) * 8, sy), MID$(label, p, 1)
192.     NEXT p
193.     _PUTIMAGE (xpos, ypos), CN&, main&
194.     _FREEIMAGE CN&
195.  
196. END SUB 'Con_Blok
197.  
198.  
199. SUB DialogBox (heading AS STRING, xsiz AS INTEGER, ysiz AS INTEGER, ypos AS INTEGER, bcol AS _UNSIGNED LONG, tcol AS _UNSIGNED LONG)
200.  
201.     'superimpose a screen centered input box for various input routines
202.     T& = _NEWIMAGE(xsiz, ysiz, 32) '                            define box
203.     _DEST T&
204.     COLOR tcol, &HFF000000 '                                    set text color with black background
205.     CLS
206.     FOR x = 0 TO 5 '                                            draw bounding box 6 pixels thick
207.         IF x < 2 THEN
208.             LINE (0 + x, 0 + x)-(_WIDTH(T&) - 1 - x, _HEIGHT(T&) - 1 - x), &HFF000000, B
209.         ELSE
210.             LINE (0 + x, 0 + x)-(_WIDTH(T&) - 1 - x, _HEIGHT(T&) - 1 - x), bcol, B
211.         END IF
212.     NEXT x
213.     l = _WIDTH(T&) / 2 - (LEN(heading) * 8) / 2 '                set heading position
214.     _PRINTSTRING (l, 31), heading, T& '                         print heading
215.     _PUTIMAGE (_WIDTH(main&) / 2 - _WIDTH(T&) / 2, ypos), T&, main& 'display box
216.     _DEST main&
217.     _FREEIMAGE T&
218.  
219. END SUB 'DialogBox
220.  
221.  
222. SUB Hex_Grid (siz AS INTEGER, h AS INTEGER, v AS INTEGER)
223.  
224.     DIM s, sb, ho, vo, ro, col, of
225.     CLS
226.     s = siz / (2 * SIN(_PI / 3)) '                                  side length
227.     sb = s / 2
228.     ho = s + (s * COS(_PI / 3)) '                                   horizontal offset
229.     vo = 2 * (s * SIN(_PI / 3)) '                                   vertical offset
230.     COLOR _RGBA32(rbyt, gbyt, bbyt, abyt)
231.     ro = -1
232.     DO 'x row loop
233.         col = -1
234.         DO 'y column loop
235.             IF ro MOD 2 = 0 THEN of = vo / 2 ELSE of = 0
236.             LINE (ro * ho - sb + h, col * vo + of + v)-(ro * ho + s - sb + h, col * vo + of + v) 'hex horizontal
237.             LINE (ro * ho + s - sb + h, col * vo + of + v)-(ro * ho + s + ho - s - sb + h, col * vo + of - (vo / 2) + v) 'hex up leg
238.             LINE (ro * ho + s - sb + h, col * vo + of + v)-(ro * ho + s + ho - s - sb + h, col * vo + of + (vo / 2) + v) 'hex down leg
239.             col = col + 1
240.         LOOP UNTIL (col - 1) * vo > _HEIGHT(grid&)
241.         ro = ro + 1
242.     LOOP UNTIL (ro - 1) * ho > _WIDTH(grid&)
243.  
244. END SUB 'Hex_Grid
245.  
246.  
247. SUB Load_Image
248.  
249.     DialogBox "Load Image", 600, 400, 50, &HFF00FF00, &HFFFFFFFF
250.     _PRINTSTRING (_WIDTH(main&) / 2 - 140, 116), "Input path \ filename and extension", 0
251.     _DISPLAY
252.     _KEYCLEAR
253.     LOCATE 148 \ 16, (_WIDTH(main&) / 2 - 120) \ 8
254.     INPUT ": ", fn$: fn$ = _TRIM$(fn$)
255.     IF _FILEEXISTS(fn$) THEN
256.         _FREEIMAGE (mp)
257.         _FREEIMAGE (grid&)
258.         mp = _LOADIMAGE(fn$, 32)
259.         mwidth = _WIDTH(mp)
260.         mheight = _HEIGHT(mp)
261.         grid& = _NEWIMAGE(mwidth, mheight, 32)
262.     ELSE
263.     END IF
264.  
265. END SUB 'Load_Image
266.  
267.  
268. SUB Make_Arrow
269.  
270.     _DEST arw&
271.     CLS
272.     _CLEARCOLOR &HF000000
273.     COLOR &HFF00FF00
274.     LINE (15, 5)-(25, 25)
275.     LINE (25, 25)-(15, 16)
276.     LINE (15, 16)-(5, 25)
277.     LINE (5, 25)-(15, 5)
278.     _DEST 0
279.  
280. END SUB 'Make_Arrow
281.  
282.  
283. FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
284.  
285.     map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
286.  
287. END FUNCTION 'map!
288.  
289.  
290. SUB Mouse_Ops (xpos AS INTEGER, ypos AS INTEGER)
291.  
292.     SELECT CASE xpos
293.         CASE IS < 400 '                                         left screen cases
294.             SELECT CASE ypos
295.                 CASE IS < 25
296.                     SELECT CASE xpos
297.                         CASE 0 TO 39 '                          open
298.                             Load_Image
299.                         CASE 50 TO 89 '                         save
300.                             Save_Gridpic
301.                         CASE 100 TO 139: SYSTEM
302.                         CASE 200 TO 239 '                       hex button click
303.                             IF _READBIT(gtog, 1) THEN '         if grid active
304.                                 IF NOT _READBIT(gtog, 0) THEN ' and box
305.                                     gtog = _SETBIT(gtog, 0) '   change to hex
306.                                 ELSE '                          otherwise
307.                                     gtog = _RESETBIT(gtog, 1) ' make grid inactive
308.                                 END IF
309.                             ELSE '                              otherwise if grid inactive
310.                                 gtog = _SETBIT(gtog, 1) '       activate it
311.                                 gtog = _SETBIT(gtog, 0) '       as a hex
312.                             END IF
313.                             _DELAY .2
314.                         CASE 250 TO 289 '                       box button click
315.                             IF _READBIT(gtog, 1) THEN '         if grid active
316.                                 IF _READBIT(gtog, 0) THEN '     and hex
317.                                     gtog = _RESETBIT(gtog, 0) ' change to box
318.                                 ELSE
319.                                     gtog = _RESETBIT(gtog, 1) ' make grid inactive
320.                                 END IF
321.                             ELSE '                              otherwise
322.                                 gtog = _SETBIT(gtog, 1) '       activate it
323.                                 gtog = _RESETBIT(gtog, 0) '     as a box
324.                             END IF
325.                             _DELAY .2
326.                     END SELECT
327.                 CASE IS > 24 '                                  color, size & offset
328.                     SELECT CASE xpos
329.                         CASE 5 TO 200 '                         color block
330.                             SELECT CASE ypos
331.                                 CASE 50 TO 60 '                 alpha
332.                                     abyt = map!(xpos, 5, 200, 1, 255)
333.                                 CASE 90 TO 100 '                red
334.                                     rbyt = map!(xpos, 5, 200, 1, 255)
335.                                 CASE 130 TO 140 '               green
336.                                     gbyt = map!(xpos, 5, 200, 1, 255)
337.                                 CASE 170 TO 180 '               blue
338.                                     bbyt = map!(xpos, 5, 200, 1, 255)
339.                             END SELECT
340.                         CASE IS > 200 '                         size & offset cross
341.                             SELECT CASE ypos
342.                                 CASE 46 TO 70
343.                                     SELECT CASE xpos
344.                                         CASE 225 TO 257
345.                                             gsiz = gsiz - 1
346.                                         CASE 343 TO 375
347.                                             gsiz = gsiz + 1
348.                                     END SELECT
349.                                 CASE 90 TO 120
350.                                     SELECT CASE xpos
351.                                         CASE 286 TO 314 '       offset up
352.                                             IF vOff > -gsiz / 2 THEN vOff = vOff - 1
353.                                     END SELECT
354.                                 CASE 121 TO 149
355.                                     SELECT CASE xpos
356.                                         CASE 255 TO 285 '       offset left
357.                                             IF hOff > -gsiz / 2 THEN hOff = hOff - 1
358.                                         CASE 286 TO 314 '       offset to (0, 0)
359.                                             hOff = 0: vOff = 0
360.                                         CASE 315 TO 345 '       offset right
361.                                             IF hOff < gsiz / 2 THEN hOff = hOff + 1
362.                                     END SELECT
363.                                 CASE 150 TO 180
364.                                     SELECT CASE xpos
365.                                         CASE 286 TO 314 '       offset down
366.                                             IF vOff < gsiz / 2 THEN vOff = vOff + 1
367.                                     END SELECT
368.                             END SELECT
369.  
370.                     END SELECT
371.             END SELECT '                                        end: left screen ypos cases
372.         CASE ELSE
373.             _MOUSEMOVE 400 + wWidth / 2, wHeight / 2
374.             camera.x = camera.x - (xpos - 400 - wWidth / 2)
375.             camera.y = camera.y - (ypos - wHeight / 2)
376.     END SELECT
377.  
378. END SUB 'Mouse_Ops
379.  
380.  
381. SUB Panel_Blank (xpos AS INTEGER, ypos AS INTEGER, xsiz AS INTEGER, ysiz AS INTEGER, col AS LONG)
382.  
383.     'Background blank to mark and mask button use and/or changes
384.     DIM CN&
385.     CN& = _NEWIMAGE(xsiz, ysiz, 32) '                           active button overlay
386.     _DEST CN&
387.     COLOR , col '                                               set overlay background color
388.     CLS
389.     _PUTIMAGE (xpos, ypos), CN&, main& '                        cover button
390.     _FREEIMAGE CN&
391.  
392. END SUB 'Panel_Blank
393.  
394.  
395. SUB Para_Disp
396.  
397.     'Display available parameters and controls
398.     Con_Blok 0, 0, 40, 24, "Open", 1, &HFF00FF00
399.     Con_Blok 50, 0, 40, 24, "Save", 1, &HFF0000FF
400.     Con_Blok 100, 0, 40, 24, "Quit", 1, &HFFFF0000
401.     Con_Blok 200, 0, 40, 24, "Hex", 1, &HFFF0F0F0
402.     Con_Blok 250, 0, 40, 24, "Box", 1, &HFFF0F0F0
403.     IF _READBIT(gtog, 1) THEN
404.         IF _READBIT(gtog, 0) THEN
405.             Panel_Blank 250, 0, 40, 24, &H9F000000
406.         ELSE
407.             Panel_Blank 200, 0, 40, 24, &H9F000000
408.         END IF
409.     ELSE
410.         Panel_Blank 200, 0, 40, 24, &H9F000000
411.         Panel_Blank 250, 0, 40, 24, &H9F000000
412.     END IF
413.  
414.     _PRINTSTRING (5, 30), "Alpha " + STR$(abyt) '               color bars
415.     LINE (5, 50)-(200, 60), &HFF7F7F7F, B
416.     LINE (5, 50)-(map!(abyt, 1, 255, 5, 200), 60), &HFF7F7F7F, BF
417.     _PRINTSTRING (5, 70), "Red " + STR$(rbyt)
418.     LINE (5, 90)-(200, 100), &HFF7F0000, B
419.     LINE (5, 90)-(map!(rbyt, 1, 255, 5, 200), 100), &HFF7F0000, BF
420.     _PRINTSTRING (5, 110), "Green " + STR$(gbyt)
421.     LINE (5, 130)-(200, 140), &HFF007F00, B
422.     LINE (5, 130)-(map!(gbyt, 1, 255, 5, 200), 140), &HFF007F00, BF
423.     _PRINTSTRING (5, 150), "Blue " + STR$(bbyt)
424.     LINE (5, 170)-(200, 180), &HFF0000FF, B
425.     LINE (5, 170)-(map!(bbyt, 1, 255, 5, 200), 180), &HFF0000FF, BF
426.  
427.     _PRINTSTRING (284, 30), "Size" '                            size buttons
428.     Con_Blok 225, 46, 32, 24, "-", 1, &HFF00007F
429.     Con_Blok 343, 46, 32, 24, "+", 1, &HFF00007F
430.     _PRINTSTRING (284, 48), STR$(gsiz)
431.  
432.     LINE (285, 90)-(315, 180), &HFFFFFFFF, B '                  offset cross
433.     LINE (255, 120)-(345, 150), &HFFFFFFFF, B
434.     CIRCLE (300, 135), 8, &HFFFF0000
435.     LINE (290, 135)-(310, 135), &HFFFF0000
436.     LINE (300, 125)-(300, 145), &HFFFF0000
437.     RotoZoom3 285 + _WIDTH(arw&) / 2, 90 + _HEIGHT(arw&) / 2, arw&, 1, 1, 0
438.     RotoZoom3 255 + _WIDTH(arw&) / 2, 120 + _HEIGHT(arw&) / 2, arw&, 1, 1, _PI * 3 / 2
439.     RotoZoom3 315 + _WIDTH(arw&) / 2, 120 + _HEIGHT(arw&) / 2, arw&, 1, 1, _PI / 2
440.     RotoZoom3 285 + _WIDTH(arw&) / 2, 150 + _HEIGHT(arw&) / 2, arw&, 1, 1, _PI
441.  
442. END SUB 'Para_Disp
443.  
444.  
445. SUB RotoZoom3 (X AS LONG, Y AS LONG, Image AS LONG, xScale AS SINGLE, yScale AS SINGLE, radianRotation AS SINGLE)
446.  
447.     ' Thanks be to Galleon and Bplus for this SUB, wish I was this good...
448.     ' This assumes you have set your drawing location with _DEST or default to screen.
449.     ' X, Y - is where you want to put the middle of the image
450.     ' Image - is the handle assigned to the image to be rotated
451.     ' xScale, yScale - are shrinkage < 1 or magnification > 1 on the given axis, 1 just uses image size.
452.     ' These are multipliers so .5 will create image .5 size on given axis and 2 for twice image size.
453.     ' radianRotation is the Angle in Radian units to rotate the image
454.     ' note: Radian units for rotation because it matches angle units of other Basic Trig functions
455.     '       and saves a little time converting from degree.
456.     '       Use the _D2R() function if you prefer to work in degree units for angles.
457.  
458.     DIM px(3) AS SINGLE: DIM py(3) AS SINGLE '                  simple arrays for x, y to hold the 4 corners of image
459.     DIM W&, H&, sinr!, cosr!, i&, x2&, y2& '                    variables for image manipulation
460.     W& = _WIDTH(Image&): H& = _HEIGHT(Image&)
461.     px(0) = -W& / 2: py(0) = -H& / 2 '                          left top corner
462.     px(1) = -W& / 2: py(1) = H& / 2 '                           left bottom corner
463.     px(2) = W& / 2: py(2) = H& / 2 '                            right bottom
464.     px(3) = W& / 2: py(3) = -H& / 2 '                           right top
465.     sinr! = SIN(-radianRotation): cosr! = COS(-radianRotation) 'rotation helpers
466.     FOR i& = 0 TO 3 '                                           calc new point locations with rotation and zoom
467.         x2& = xScale * (px(i&) * cosr! + sinr! * py(i&)) + X: y2& = yScale * (py(i&) * cosr! - px(i&) * sinr!) + Y
468.         px(i&) = x2&: py(i&) = y2&
469.     NEXT
470.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image TO(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
471.     _MAPTRIANGLE _SEAMLESS(0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image TO(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
472.  
473. END SUB 'RotoZoom3
474.  
475.  
476. SUB Save_Gridpic
477.  
478.     DIM si&, fn$, fn1$, r
479.     DialogBox "Save Image", 600, 400, 50, &HFF0000FF, &HFFFFFFFF
480.     si& = _COPYIMAGE(mp&, 32)
481.     _PUTIMAGE , grid&, si&
482.     _PRINTSTRING (_WIDTH(main&) / 2 - 140, 116), "Input path \ filename and extension", 0
483.     _DISPLAY
484.     LOCATE 148 \ 16, (_WIDTH(main&) / 2 - 120) \ 8
485.     INPUT ": ", fn$: fn$ = _TRIM$(fn$)
486.     r = SaveImage(fn$, si&, 0, 0, _WIDTH(si&) - 1, _HEIGHT(si&) - 1)
487.     IF r = 1 THEN
488.         fn1$ = "grid_" + fn$
489.         r = SaveImage(fn1$, si&, 0, 0, _WIDTH(si&) - 1, _HEIGHT(si&) - 1)
490.     END IF
491.     IF r < 0 THEN
492.         _PRINTSTRING (_WIDTH(main&) / 2 - 68, 300), "successful export", 0
493.         _DISPLAY
494.         SLEEP 2
495.     END IF
496.     _FREEIMAGE si&
497.  
498. END SUB 'Save_Gridpic
499.  
500. '$INCLUDE:'SaveImage.BM'
501.  

 

Gridpic.zip