Custom Edit Image, Save and Load with Turkey Hunt WIP Game

[bplus]

OK here's the story I started translating this guys tutorial for beginner Blitzmax here:
https://www.syntaxbomb.com/tutorials/learning-basic-for-total-beginners-blitzmax-ng/msg347053898/#msg347053898

Blitzmax code:

Code: [Select]

SuperStrict
Graphics 800,600
Global Land:TImage    = LoadImage("land.png")
Global Chicken:TImage = LoadImage("chicken.png")
Global Shot:TSound=LoadSound("fire.ogg")
Global cX:Int, cY:Int=300
Global mX:Int, mY:Int
Global Points:Int
Repeat
        Cls
        DrawImage Land    , 0 , 0
        'DrawImage Chicken , cX , cY
        '   comment out the original command, and use DrawRect instead:
        SetColor 111,0,0
        DrawRect cX, cY, 60,40
        cX = cX +2
        If GunFire() =True Then
                cX=-100
                Points=Points+1
        EndIf
        SetColor 255,255,255
        DrawRect mX-25, mY-1,50,3
        DrawRect mX-1, mY-25,3,50
        'HideMouse
        DrawText "Points: " + points, 700,550
        Flip
Until AppTerminate()
ShowMouse
 
 
Function GunFire:Int()
        mX=MouseX()
        mY=MouseY()   
        If MouseHit(1)
                PlaySound Shot
                If (mX>cX) And (mx<cX+60)
                        If (mY>cY) And (mY<cY+40)
                                ' collision
                                Return True
                        EndIf
                EndIf
        EndIf
        Return False
End Function

But the code didn't come with a chicken image so I thought I'd reuse the Turkey Cartoon from Turkey Run from Thanksgiving ie Turkey Day

OK but now the Turkey's background isn't working with the background for the Hunt. (I just used white to hide the turkey background mostly white in image in Turkey Day.)

So like Colonel Panic here: https://qb64forum.alephc.xyz/index.php?topic=4539.0
I got interested in custom editing and saving and loading a modified image.

So I reworked SMcNeill's quick demo for any image not just the screen got it working without _defalte$ _inflate with this code:

Code: QB64: [Select]

1. Option _Explicit
2. _Title "Edit image test" 'b+ 2021-12-29 sure would like to take an image and the subject wo background colors
3. ' from  C:\Users\marka\Desktop\QB64 work\000 work QB64\000 Test\More Saving Images
4. ' file "Fast Image Save and Load.bas" by SMcNeill 2021-12-07
5.  
6.  
7. ''Scn& = _NewImage(800, 600, 32)  'should not need these 2 lines if loadimage with 32
8. ''Screen Scn&
9. Dim image&: image& = _LoadImage("turkey run.jpg", 32) ' <<<<<<<<<<<<<<<<< Edit Image file name
10. ''Print image& ' OK -12   guess I forgot to save file before trying so in QB64 folder instead of project folder
11. ''Sleep
12.  
13. Dim Scn&: Scn& = _NewImage(_Width(image&), _Height(image&), 32)
14. Screen Scn&
15. _Source image& ' for using Point from image
16.  
17. ''_ClearColor Point(10, 10), image&  ' testing a know background point to make transparent
18. ''_PutImage , image&, 0 '
19. ''Print "Paint test, press any... ": Sleep
20. ''_PutImage , image&, 0 '
21. ''Paint (10, 10), &HFFFFFFFF, &HFF000000 ' nope "turkey run.jpg" has no pure black border enclosing the image
22. ''End
23.  
24. Dim mx, my, outRed, outGrn, outBlu, outAlp, x, y
25. Do
26.     Cls ' must clear screen to see what was cleared from image if anything
27.     _PutImage , image&, 0 '
28.     While _MouseInput: Wend ' poll mouse to show me where I am at
29.     mx = _MouseX: my = _MouseY
30.     Line (mx - 3, my - 3)-(mx + 3, my + 3), , B ' eraser block  black & white frame around eraser
31.     Line (mx - 4, my - 4)-(mx + 4, my + 4), &HFF000000, B ' eraser block
32.     cAnalysis Point(mx, my), outRed, outGrn, outBlu, outAlp
33.     Locate 1, 1: Print Space$((_Width - 1) / 8)
34.     Locate 1, 1: Print outRed; outGrn; outBlu; outAlp
35.     If _MouseButton(1) Then
36.         For y = my - 2 To my + 2
37.             For x = mx - 2 To mx + 2
38.                 _ClearColor Point(x, y), image&
39.             Next
40.         Next
41.     End If
42.     _Display
43.     _Limit 100
44. Loop Until _KeyDown(27)
45. _AutoDisplay
46. _Source 0
47. Cls 'get rid of mouse stuff before save image
48. _PutImage , image&, 0
49.  
50. 'Dim M As _MEM: M = _MemImage(Scn&)
51. 'Screengrab$ = Space$(M.SIZE)
52. '_MemGet M, M.OFFSET, Screengrab$
53.  
54. 'The above will:
55. 'Dim a mem block.  Point it to your screen's image.
56. 'Set a string that size.
57. 'Get the whole screen at once into that string.
58.  
59.  
60. 'Then to save to disk all at once:
61. 'Open "Test SaveLoad Image.bin" For Binary As #1
62. 'Put #1, , Screengrab$
63. 'Close
64. 'Open the file, put the data in one chunk, close the file.
65.  
66. ' hopefully the above has been encoded properly into a Sub
67. SaveCustomImage Scn&, "Test Save Turkey Run"
68.  
69. Cls
70. Print "Press any to test load image again... "
71. Sleep
72.  
73. 'Loading is the same, in reverse:
74. 'Open "Test SaveLoad Image.bin" For Binary As #1
75. 'Get #1, , Screengrab$
76. 'Close
77. 'And putting the data back to screen is also done all in one command:
78. '_MemPut M, M.OFFSET, Screengrab$
79.  
80. 'And hopefully the LoadCustomImage& Function gets the data back from file
81. Dim image2&: image2& = LoadCustomImage&("Test Save Turkey Run")
82. _PutImage , image2&, 0 ' put back on screen
83.  
84. Sub cAnalysis (c As _Unsigned Long, outRed, outGrn, outBlu, outAlp)
85.     outRed = _Red32(c): outGrn = _Green32(c): outBlu = _Blue32(c): outAlp = _Alpha32(c)
86. End Sub
87.  
88. 'this will create 2 files for Custom Image:
89. '1) FileName$ + "CI_DIM" for image dimensions
90. '2) FileName$ + "CI" for the Custom Image data
91. Sub SaveCustomImage (imgHdl&, fileSaveBaseName$) ' for any image setup by _newimage
92.     Dim As Long w, h: w = _Width(imgHdl&): h = _Height(imgHdl&)
93.     Dim M As _MEM: M = _MemImage(imgHdl&) 'Dim a mem block.  Point it to your screen's image.
94.     Dim screenGrab$: screenGrab$ = Space$(M.SIZE) 'Set a string that size.
95.     'screenGrab$ = _Deflate$(screenGrab$)
96.     _MemGet M, M.OFFSET, screenGrab$ 'Get the whole screen at once into that string.
97.     Open fileSaveBaseName$ + ".CI_DIM" For Output As #1
98.     Print #1, w
99.     Print #1, h
100.     Close #1
101.     Open fileSaveBaseName$ + ".CI" For Binary As #1
102.     Put #1, , screenGrab$
103.     Close
104. End Sub
105.  
106. ' Function returns Image Handle& (like _LoadFile)
107. Function LoadCustomImage& (fileLoadBaseName$) ' reverse the Save
108.     Dim As Long w, h
109.     Open fileLoadBaseName$ + ".CI_DIM" For Input As #1 ' get dimensions of custom image
110.     Input #1, w
111.     Input #1, h
112.     Close #1
113.     Dim imgHdl&: imgHdl& = _NewImage(w, h, 32) 'setup space and handle for it
114.     Dim M As _MEM: M = _MemImage(imgHdl&) ' put data into handle space reserved
115.     Dim screenGrab$: screenGrab$ = Space$(M.SIZE)
116.     Open fileLoadBaseName$ + ".CI" For Binary As #1 ' get data
117.     'screenGrab$ = Space$(LOF(1))
118.     Get #1, , screenGrab$
119.     Close #1
120.     'screenGrab$ = _Inflate$(screenGrab$)  ' doesn't work
121.     _MemPut M, M.OFFSET, screenGrab$
122.     LoadCustomImage& = imgHdl& ' finally assign the function
123. End Function
124.  

Press escape when done erasing pixels and the image is saved and the loaded and displayed to test code in subs just as it was tested in Steve's original.

Then I ran the modified image in Turkey Hunt:

Code: QB64: [Select]

1. _Title "Turkey Shoot" 'b+ 2021-12-29   translate from BlitzMax to QB64 and modify, source:
2. '  https://www.syntaxbomb.com/tutorials/learning-basic-for-total-beginners-blitzmax-ng/msg347053898/#msg347053898
3. '  from MidiMaster tutorial on BlitzMax started Dec 22, 2021
4.  
5. ' single comments are BlitzMax code
6. '' double comments are added notes by bplus
7.  
8. 'SuperStrict
9. Option _Explicit ' must Dimension variables with types before using
10.  
11. '' current default type is single suffix ! not needed which is low precision float
12.  
13. 'Graphics 800,600
14. '' land.png the background is 1347 X 600 so let's use a screen in same proportion  shrink by 1.1225 so no distorion of background
15. Screen _NewImage(1200, 534, 32) ' << the 32 allows RGBA color, this sets up customized graphics screen
16. _ScreenMove 60, 100 '' centers screen in window
17.  
18. 'Global Land:TImage    = LoadImage("land.png")   '' dims 1347 x 600
19. Dim Land&: Land& = _LoadImage("land.png")
20.  
21. 'Global Chicken:TImage = LoadImage("chicken.png")
22. '' for Global use Shared keyword with Dim (or ReDim or Static for Subs to preserve values)
23. ''Dim Shared Turkey&: Turkey& = _LoadImage("turkey run.jpg")
24. '' remove background color OK this isn't the cleanest removal , BlizMax just drew a rectangle
25. ''_Source Turkey&
26. ''_ClearColor Point(10, 10), Turkey&
27. ''_ClearColor Point(64, 22), Turkey&
28. ''_ClearColor Point(86, 133), Turkey&
29. ''_PutImage (0, 0), Turkey&, 0
30.  
31. ''Do ' find points to make transparent
32. ''    While _MouseInput: Wend
33. ''    Locate 1, 1: Print Space$(40)
34. ''    Locate 1, 1: Print _MouseX, _MouseY, Point(_MouseX, _MouseY) \ 256, (Point(_MouseX, _MouseY) \ 256) \ 256, ((Point(_MouseX, _MouseY) \ 256) \ 256) \ 256
35. ''    _Display
36. ''    _Limit 100
37. ''Loop
38. ''End
39. ''_ClearColor Point(10, 10), Turkey&
40. ''_Source 0
41.  
42. ' the above block was replaced with a Custom Image Load
43. Dim Shared Turkey&: Turkey& = LoadCustomImage&("Test Save Turkey Run")
44. _ClearColor &HFF000000, Turkey&
45. _PutImage (100, 100), Turkey&, 0 ' I want to see how our image looks from custom load
46. Print "Here is our target, press any to continue..."
47. Sleep
48.  
49.  
50. Dim Shared TurkeyWidth&: TurkeyWidth& = 100 '     proportional to image
51. Dim Shared TurkeyHeight&: TurkeyHeight& = 83
52.  
53. 'Global Shot:TSound=LoadSound("fire.ogg")
54. Dim Shared Shot&: Shot& = _SndOpen("fire.ogg")
55.  
56. 'Global cX:Int, cY:Int=300
57. 'Global mX:Int, mY:Int
58. 'Global Points:Int
59. ' in QB64 you can Dim with suffix or say Type in DIM ststement
60. 'Since we are using a Turkey instead of a Chicken:
61. Dim Shared As Long TurkeyX, TurkeyY, MX, MY, Points
62. TurkeyY = 350 ' for now the other values are at 0
63.  
64. _MouseHide '
65.  
66. 'start turkey on right side of screen, this image can only run left
67. TurkeyX = _Width
68.  
69.  
70. 'Repeat
71. ' default drawing color is already white
72. Do
73.  
74.     'Cls '' not needed in QB64
75.  
76.     'DrawImage Land    , 0 , 0
77.     _PutImage , Land&, 0 ' stretch/shrink image to fit screen  This already CLS screen
78.  
79.     'DrawImage Chicken , cX , cY
80.     '   comment out the original command, and use DrawRect instead:
81.     '    SetColor 111,0,0
82.     '    DrawRect cX, cY, 60,40
83.  
84.     _PutImage (TurkeyX, TurkeyY)-Step(TurkeyWidth&, TurkeyHeight&), Turkey&, 0 ' shrink image into Box
85.  
86.  
87.     '    cX = cX +2
88.     TurkeyX = TurkeyX - Rnd * 20
89.  
90.     'if turkey lives to run outside of screen replace it on left side
91.     If TurkeyX + _Width(Turkey&) < 0 Then TurkeyX = _Width + 50
92.  
93.  
94.     'If GunFire() =True Then
95.     If GunFire& Then
96.  
97.         ' QB64 Bonus display turkey upside down!!!
98.         _PutImage , Land&, 0 ' stretch/shrink image to fit screen
99.         _PutImage (TurkeyX, TurkeyY)-Step(TurkeyWidth&, TurkeyHeight&), Turkey&, 0, (0, _Height(Turkey&))-Step(_Width(Turkey&), -_Height(Turkey&))
100.         _Display
101.         _Delay 1 ' ha, upside down
102.  
103.  
104.         '        cX=-100
105.         TurkeyX = _Width ' reset turkey to left side of screen
106.  
107.         Points = Points + 1 'same for both for next loop
108.  
109.     End If ' same
110.  
111.     'SetColor 255,255,255
112.     'DrawRect mX-25, mY-1,50,3
113.     'DrawRect mX-1, mY-25,3,50
114.  
115.     ' This is for mouse scope  (the gunFire call updates mouse info in loop)
116.     Line (MX - 20, MY)-Step(40, 0), &HFF000000
117.     Line (MX, MY - 20)-Step(0, 40), &HFF000000
118.     Circle (MX, MY), 8
119.     Circle (MX, MY), 14
120.     ''HideMouse
121.     'did this before starting loop
122.  
123.     'DrawText "Points: " + points, 700,550
124.     _PrintString (10, 10), " Points:" + Str$(Points) + " "
125.  
126.     'Flip
127.     _Display ' prevent blinking form CLS
128.     _Limit 60 ' 30 frames per second at most!
129.  
130.     'Until AppTerminate()
131. Loop Until _KeyDown(27) 'quit with escape, top right x click will also close window no matter what
132. 'ShowMouse
133. '_MouseShow not really needed
134.  
135.  
136. 'Function GunFire:Int()
137. '        mX=MouseX()
138. '        mY=MouseY()
139. '        If MouseHit(1)
140. '                PlaySound Shot
141. '                If (mX>cX) And (mx<cX+60)
142. '                        If (mY>cY) And (mY<cY+40)
143. '                                ' collision
144. '                                Return True
145. '                        EndIf
146. '                EndIf
147. '        EndIf
148. '        Return False
149. 'End Function
150.  
151. Function GunFire& () ' Long integer Type
152.     While _MouseInput: Wend ' poll mouse updates the mouse information in keyWords starting with _Mouse...
153.     MX = _MouseX: MY = _MouseY
154.     If _MouseButton(1) Then ' Left mouse button is down, might want to wait until released but we delay in main loop if hit
155.         _SndPlay Shot&
156.         If (MX > TurkeyX) And (MX < TurkeyX + TurkeyWidth&) Then
157.             If (MY > TurkeyY) And (MY < TurkeyY + TurkeyHeight&) Then
158.                 ' collision
159.                 ' return True value with Function name
160.                 GunFire& = -1 ' anything not 0 is true
161.             End If
162.         End If
163.     End If
164.     'else function returns 0
165. End Function
166.  
167. ' Function returns Image Handle& (like _LoadFile)
168. Function LoadCustomImage& (fileLoadBaseName$) ' reverse the Save
169.     Dim As Long w, h
170.     Open fileLoadBaseName$ + ".CI_DIM" For Input As #1 ' get dimensions of custom image
171.     Input #1, w
172.     Input #1, h
173.     Close #1
174.     Dim imgHdl&: imgHdl& = _NewImage(w, h, 32) 'setup space and handle for it
175.     Dim M As _MEM: M = _MemImage(imgHdl&) ' put data into handle space reserved
176.     Dim screenGrab$: screenGrab$ = Space$(M.SIZE)
177.     Open fileLoadBaseName$ + ".CI" For Binary As #1 ' get data
178.     Get #1, , screenGrab$
179.     Close #1
180.     _MemPut M, M.OFFSET, screenGrab$
181.     LoadCustomImage& = imgHdl& ' finally assign the function
182. End Function
183.  
184.  

Which is nice start but begging for refinements ;-))

So my question (mostly to @SMcNeill) is can the sub and function be modified to use _deflate and _inflate from the Editing app?  I left in comments to the code I tried but the playback is ending up blank without any errors flagged, so I uncommented the working save and load that I could use in Turkey Hunt.

Oh here is a zip with code, images and exes for Windows 10-64. The sound and images are for forum use only for discussion.

[SMcNeill]

Give this a quick test run:

Code: QB64: [Select]

1. Option _Explicit
2. _Title "Edit image test" 'b+ 2021-12-29 sure would like to take an image and the subject wo background colors
3. ' from  C:\Users\marka\Desktop\QB64 work\000 work QB64\000 Test\More Saving Images
4. ' file "Fast Image Save and Load.bas" by SMcNeill 2021-12-07
5.  
6.  
7. ''Scn& = _NewImage(800, 600, 32)  'should not need these 2 lines if loadimage with 32
8. ''Screen Scn&
9. Dim image&: image& = _LoadImage("turkey run.jpg", 32) ' <<<<<<<<<<<<<<<<< Edit Image file name
10. ''Print image& ' OK -12   guess I forgot to save file before trying so in QB64 folder instead of project folder
11. ''Sleep
12.  
13. Dim Scn&: Scn& = _NewImage(_Width(image&), _Height(image&), 32)
14. Screen Scn&
15. _Source image& ' for using Point from image
16.  
17. ''_ClearColor Point(10, 10), image&  ' testing a know background point to make transparent
18. ''_PutImage , image&, 0 '
19. ''Print "Paint test, press any... ": Sleep
20. ''_PutImage , image&, 0 '
21. ''Paint (10, 10), &HFFFFFFFF, &HFF000000 ' nope "turkey run.jpg" has no pure black border enclosing the image
22. ''End
23.  
24. Dim mx, my, outRed, outGrn, outBlu, outAlp, x, y
25. Do
26.     Cls ' must clear screen to see what was cleared from image if anything
27.     _PutImage , image&, 0 '
28.     While _MouseInput: Wend ' poll mouse to show me where I am at
29.     mx = _MouseX: my = _MouseY
30.     Line (mx - 3, my - 3)-(mx + 3, my + 3), , B ' eraser block  black & white frame around eraser
31.     Line (mx - 4, my - 4)-(mx + 4, my + 4), &HFF000000, B ' eraser block
32.     cAnalysis Point(mx, my), outRed, outGrn, outBlu, outAlp
33.     Locate 1, 1: Print Space$((_Width - 1) / 8)
34.     Locate 1, 1: Print outRed; outGrn; outBlu; outAlp
35.     If _MouseButton(1) Then
36.         For y = my - 2 To my + 2
37.             For x = mx - 2 To mx + 2
38.                 _ClearColor Point(x, y), image&
39.             Next
40.         Next
41.     End If
42.     _Display
43.     _Limit 100
44. Loop Until _KeyDown(27)
45. _AutoDisplay
46. _Source 0
47. Cls 'get rid of mouse stuff before save image
48. _PutImage , image&, 0
49.  
50. 'Dim M As _MEM: M = _MemImage(Scn&)
51. 'Screengrab$ = Space$(M.SIZE)
52. '_MemGet M, M.OFFSET, Screengrab$
53.  
54. 'The above will:
55. 'Dim a mem block.  Point it to your screen's image.
56. 'Set a string that size.
57. 'Get the whole screen at once into that string.
58.  
59.  
60. 'Then to save to disk all at once:
61. 'Open "Test SaveLoad Image.bin" For Binary As #1
62. 'Put #1, , Screengrab$
63. 'Close
64. 'Open the file, put the data in one chunk, close the file.
65.  
66. ' hopefully the above has been encoded properly into a Sub
67. SaveCustomImage Scn&, "Test Save Turkey Run"
68.  
69. Cls
70. Print "Press any to test load image again... "
71. Sleep
72.  
73. 'Loading is the same, in reverse:
74. 'Open "Test SaveLoad Image.bin" For Binary As #1
75. 'Get #1, , Screengrab$
76. 'Close
77. 'And putting the data back to screen is also done all in one command:
78. '_MemPut M, M.OFFSET, Screengrab$
79.  
80. 'And hopefully the LoadCustomImage& Function gets the data back from file
81. Dim image2&: image2& = LoadCustomImage&("Test Save Turkey Run")
82. _PutImage , image2&, 0 ' put back on screen
83.  
84. Sub cAnalysis (c As _Unsigned Long, outRed, outGrn, outBlu, outAlp)
85.     outRed = _Red32(c): outGrn = _Green32(c): outBlu = _Blue32(c): outAlp = _Alpha32(c)
86. End Sub
87.  
88. 'this will create 2 files for Custom Image:
89. '1) FileName$ + "CI_DIM" for image dimensions
90. '2) FileName$ + "CI" for the Custom Image data
91. Sub SaveCustomImage (imgHdl&, fileSaveBaseName$) ' for any image setup by _newimage
92.     Dim As Long w, h: w = _Width(imgHdl&): h = _Height(imgHdl&)
93.     Dim M As _MEM: M = _MemImage(imgHdl&) 'Dim a mem block.  Point it to your screen's image.
94.     Dim screenGrab$: screenGrab$ = Space$(M.SIZE) 'Set a string that size.
95.     Dim compressed$
96.     'screenGrab$ = _Deflate$(screenGrab$)
97.     _MemGet M, M.OFFSET, screenGrab$ 'Get the whole screen at once into that string.
98.     Open fileSaveBaseName$ + ".CI_DIM" For Output As #1
99.     Print #1, w
100.     Print #1, h
101.     Close #1
102.     Open fileSaveBaseName$ + ".CI" For Binary As #1
103.     compressed$ = _Deflate$(screenGrab$)
104.     Put #1, , screenGrab$
105.     Close
106. End Sub
107.  
108. ' Function returns Image Handle& (like _LoadFile)
109. Function LoadCustomImage& (fileLoadBaseName$) ' reverse the Save
110.     Dim As Long w, h
111.     Open fileLoadBaseName$ + ".CI_DIM" For Input As #1 ' get dimensions of custom image
112.     Dim compressed$
113.     Input #1, w
114.     Input #1, h
115.     Close #1
116.     Dim imgHdl&: imgHdl& = _NewImage(w, h, 32) 'setup space and handle for it
117.     Dim M As _MEM: M = _MemImage(imgHdl&) ' put data into handle space reserved
118.     Dim screenGrab$: screenGrab$ = Space$(M.SIZE)
119.     Open fileLoadBaseName$ + ".CI" For Binary As #1 ' get data
120.     'screenGrab$ = Space$(LOF(1))
121.     compressed$ = Space$(LOF(1) - 8) 'You're not getting the whole length of your file -- you're getting what's left after the width and height are accounted for
122.     Get #1, , compressed$
123.     screenGrab$ = _Inflate$(compressed$)
124.     Close #1
125.     'screenGrab$ = _Inflate$(screenGrab$)  ' doesn't work
126.     _MemPut M, M.OFFSET, screenGrab$
127.     LoadCustomImage& = imgHdl& ' finally assign the function
128. End Function
129.  

I was too lazy to supply an actual image for loading and testing, but everything looks proper to me with the above.  If it doesn't work, I'll be more thorough and see what the heck I did wrong with it, but I *think* the above is what you're looking for as far as compressing and decompressing the image file is concerned.


I think your basic problem was you forgot to account for your width and height offset in the file:

    'screenGrab$ = Space$(LOF(1))
    compressed$ = Space$(LOF(1) - 8) 'You're not getting the whole length of your file -- you're getting what's left after the width and height are accounted for
    Get #1, , compressed$

[bplus]

Hi Steve,

Thanks but nope, didn't work, still blank in final test of load and show.

I did account for w x h of image in a separate file for creating a newImage handle with proper space.

But I save the compressed screenGrab$ string so when I load from Binary, I _inflate the string from Binary which should in my mind then be what it was before compressed and then ready to MemPut into _newImage handle created for that size.

Did you see that I saved the Width and Height of image in a different File .CI_DIM? This is so I could save just the pure image data in the .CI file. (CI is for Custom Image)

Update: For the record, Turkey Hunt will load the Edited image from your code With the supposedly compressed string with my code to load the image that assumes no compressed string!

[SMcNeill]

I'm out for a pizza run into town ATM, but I'll dig into this with a fine tooth comb when I get home in a few hours and I'll post you an update later tonight.  ;)

[bplus]

Thanks, enjoy your pizza.

I'm trying Keto, tonight chicken thigh and buttered broccoli with bits of bacon and bacon grease, cashews for desert.

[SMcNeill]

I'm embarassed to admit WHY what I posted didn't work for you.  By all rights, it *should* have, and yet, after actually loading an image and testing it, it didn't...

Here's why (feel free to GPL -- Giggle, Point, and Laugh) at me all you want):

    compressed$ = _Deflate$(screenGrab$)
    Put #1, , screenGrab$

Well, I compress my screen just peachy fine....
And then I promptly put the uncompressed information to file..... 

I also failed to notice that you'd decided to use 2 files for the images, so I wasn't even allocating the full space for the compressed data:

    compressed$ = Space$(LOF(1) - 8)

So, it's no wonder that the dang thing didn't decompress my uncompressed data, and then fail to work properly!

I can post the code with the relevant changes, if you need, but I thought you might want to go in and make them for yourself so you can see exactly where and why it doesn't work as I shared it.  Fix those little DUH-glitches, and it'll work and compress for you as it should.  ;)


Now, for my saving grace, I get to GPL at you for doing something just as bad:

    'screenGrab$ = _Deflate$(screenGrab$)
    _MemGet M, M.OFFSET, screenGrab$ 'Get the whole screen at once into that string.

Look at the order of those two statements as you have them written...

Let's compress our data, BEFORE we get it from the screen!!

Hang your head with me.  We'll both wear DUH-caps for a while this evening!  LOL!!

[bplus]

Yep! That was quite blunderful of me.

@SMcNeill thanks so much for 2nd pair of eyes and straightening me out.  :)  << happy camper

[bplus]

OK I was able to workup a satisfactory Edit of that Turkey Run image by building a Paint4 sub routine that paints around a given point if that point is "Near" in color to one specified. How near is near enough? You get to say how much RGB difference you will allow with Paint4's parameters ie Paint4 x, y, PaintColor, NearColor, 1-254

So I could turn this image:
 

To this:
 

Without having to work through this:
 

Here the test code for Edit 2:

Code: QB64: [Select]

1. Option _Explicit
2. _Title "Edit image test 2" 'b+ 2021-12-29 sure would like to take an image and the subject wo background colors
3. ' from  C:\Users\marka\Desktop\QB64 work\000 work QB64\000 Test\More Saving Images
4. ' file "Fast Image Save and Load.bas" by SMcNeill 2021-12-07
5.  
6. ' posted 2021-12-30 with question about _inflate, _deflate
7. ' here: https://qb64forum.alephc.xyz/index.php?topic=4541.msg139518#msg139518
8. ' fixed with _deflate, _inflate thanks SMcNeil!
9.  
10. ' "Edit image test 2" 2021-12-31 still working on that Turkey image I have created Paint4
11. ' that should paint everything a color if it is near another color, hopefully this will
12. ' eliminate all the light pixels around the border of the turkey.
13. ' The turkey run image needs the print at the bottom blacked out or the image reframed smaller
14. ' all the near white around the turkey made black so I cam use one _clearColor (black here).
15.  
16.  
17. ''Scn& = _NewImage(800, 600, 32)  'should not need these 2 lines if loadimage with 32
18. ''Screen Scn&
19. Dim image&: image& = _LoadImage("turkey run.jpg", 32) ' <<<<<<<<<<<<<<<<< Edit Image file name
20. 'Print image& ' OK -12   guess I forgot to save file before trying so in QB64 folder instead of project folder
21. 'Sleep
22.  
23. Dim Scn&: Scn& = _NewImage(_Width(image&), _Height(image&), 32)
24. Screen Scn&
25. _Source image& ' for using Point from image
26.  
27. Dim mx, my, snap&
28.  
29. _Title "Escape finshes Blackout Then use Paint4"
30. Cls ' must clear screen to see what was cleared from image if anything
31. _PutImage , image&, 0 '
32. snap& = _NewImage(_Width, _Height, 32)
33. _PutImage , 0, snap&
34. Do
35.     _PutImage , snap&, 0
36.     While _MouseInput: Wend ' poll mouse to show me where I am at
37.     mx = _MouseX: my = _MouseY
38.     Line (mx - 5, my - 5)-(mx + 5, my + 5), , B ' eraser block  black & white frame around eraser
39.     Line (mx - 6, my - 6)-(mx + 6, my + 6), &HFF000000, B ' eraser block
40.     If _MouseButton(1) Then
41.         _PutImage , snap&, 0 'clear mouse
42.         Line (mx - 4, my - 4)-(mx + 4, my + 4), &HFF000000, BF
43.         _Display
44.         _PutImage , 0, snap& 'grab while mouse gone
45.     End If
46.     _Display
47.     _Limit 100
48. Loop Until _KeyDown(27)
49. _Title "Spacebar finshes Paint4" ' Paint4 paints everything around a given point a color
50. '                                  if the points around it are close to another given color
51. '                                  How close is close? You get to say in an amount of RGB.
52. Do
53.     _PutImage , snap&, 0
54.     While _MouseInput: Wend ' poll mouse to show me where I am at
55.     mx = _MouseX: my = _MouseY
56.     Circle (mx, my), 2, &HFFFFFFFF
57.     Circle (mx, my), 3, &HFF000000
58.     If _MouseButton(1) Then
59.         _PutImage , snap&, 0 'clear mouse
60.         paint4 mx, my, _RGB32(0, 0, 0), _RGB32(245, 245, 245), 186
61.         _Display
62.         _PutImage , 0, snap& 'grab while mouse gone
63.     End If
64.     _Display
65.     _Limit 100
66. Loop Until _KeyDown(32)
67. _AutoDisplay
68. ' hopefully the above has been encoded properly into a Sub
69. SaveCustomImage snap&, "Test Save Turkey Run"
70. Cls
71. Print "Press any to test load image again... "
72. Sleep
73. 'And hopefully the LoadCustomImage& Function gets the data back from file
74. Dim image2&: image2& = LoadCustomImage&("Test Save Turkey Run")
75. _PutImage , image2&, 0 ' put back on screen
76.  
77.  
78. 'this will create 2 files for Custom Image:
79. '1) FileName$ + "CI_DIM" for image dimensions
80. '2) FileName$ + "CI" for the Custom Image data
81. Sub SaveCustomImage (imgHdl&, fileSaveBaseName$) ' for any image setup by _newimage
82.     Dim As Long w, h: w = _Width(imgHdl&): h = _Height(imgHdl&)
83.     Dim M As _MEM: M = _MemImage(imgHdl&) 'Dim a mem block.  Point it to your screen's image.
84.     Dim screenGrab$: screenGrab$ = Space$(M.SIZE) 'Set a string that size.
85.     _MemGet M, M.OFFSET, screenGrab$ 'Get the whole screen at once into that string.
86.     screenGrab$ = _Deflate$(screenGrab$) ' << heh dummy put this after you get screen grab!
87.     Open fileSaveBaseName$ + ".CI_DIM" For Output As #1
88.     Print #1, w
89.     Print #1, h
90.     Close #1
91.     Open fileSaveBaseName$ + ".CI" For Binary As #1
92.     Put #1, , screenGrab$
93.     Close
94. End Sub
95.  
96. ' Function returns Image Handle& (like _LoadFile)
97. Function LoadCustomImage& (fileLoadBaseName$) ' reverse the Save
98.     Dim As Long w, h
99.     Open fileLoadBaseName$ + ".CI_DIM" For Input As #1 ' get dimensions of custom image
100.     Input #1, w
101.     Input #1, h
102.     Close #1
103.     Dim imgHdl&: imgHdl& = _NewImage(w, h, 32) 'setup space and handle for it
104.     Dim M As _MEM: M = _MemImage(imgHdl&) ' put data into handle space reserved
105.     Dim screenGrab$: screenGrab$ = Space$(M.SIZE)
106.     Open fileLoadBaseName$ + ".CI" For Binary As #1 ' get data
107.     screenGrab$ = Space$(LOF(1))
108.     Get #1, , screenGrab$
109.     Close #1
110.     screenGrab$ = _Inflate$(screenGrab$) ' fixed ?
111.     _MemPut M, M.OFFSET, screenGrab$
112.     LoadCustomImage& = imgHdl& ' finally assign the function
113. End Function
114.  
115. ' test Paint4 here
116. ' this function needs:  Function IsNear& (colr As _Unsigned Long, nearColr As _Unsigned Long)
117. ' this function needs:  Sub cAnalysis (c As _Unsigned Long, outRed, outGrn, outBlu, outAlp)
118. ' this function needs:  Function min (n1, n2)
119. ' this function needs:  Function max (n1, n2)
120. Sub paint4 (x0, y0, PaintColor As _Unsigned Long, NearColor As _Unsigned Long, nearness As Long) ' needs max, min functions
121.     Dim W, H, parentF, tick, ystart, ystop, xstart, xstop, x, y
122.     If IsNear&(Point(x0, y0), NearColor, nearness) Then
123.         PSet (x0, y0), PaintColor
124.         W = _Width - 1: H = _Height - 1
125.         Dim temp(W, H)
126.         temp(x0, y0) = 1: parentF = 1
127.         While parentF = 1
128.             parentF = 0: tick = tick + 1
129.             ystart = max(y0 - tick, 0): ystop = min(y0 + tick, H)
130.             y = ystart
131.             While y <= ystop
132.                 xstart = max(x0 - tick, 0): xstop = min(x0 + tick, W)
133.                 x = xstart
134.                 While x <= xstop
135.                     If (IsNear&(Point(x, y), NearColor, nearness) = -1) And (temp(x, y) = 0) Then
136.                         If temp(max(0, x - 1), y) Then
137.                             temp(x, y) = 1: parentF = 1: PSet (x, y), PaintColor
138.                         ElseIf temp(min(x + 1, W), y) Then
139.                             temp(x, y) = 1: parentF = 1: PSet (x, y), PaintColor
140.                         ElseIf temp(x, max(y - 1, 0)) Then
141.                             temp(x, y) = 1: parentF = 1: PSet (x, y), PaintColor
142.                         ElseIf temp(x, min(y + 1, H)) Then
143.                             temp(x, y) = 1: parentF = 1: PSet (x, y), PaintColor
144.                         End If
145.                     End If
146.                     x = x + 1
147.                 Wend
148.                 y = y + 1
149.             Wend
150.         Wend
151.     End If
152. End Sub
153.  
154. Function min (n1, n2)
155.     If n1 > n2 Then min = n2 Else min = n1
156. End Function
157.  
158. Function max (n1, n2)
159.     If n1 < n2 Then max = n2 Else max = n1
160. End Function
161.  
162. Sub cAnalysis (c As _Unsigned Long, outRed As Long, outGrn As Long, outBlu As Long, outAlp As Long)
163.     outRed = _Red32(c): outGrn = _Green32(c): outBlu = _Blue32(c): outAlp = _Alpha32(c)
164.     'Print "cAnalysis says:"; outRed; outGrn; outBlu; outAlp
165. End Sub
166.  
167. 'this function needs: cAnalysis (c As _Unsigned Long, outRed as long, outGrn as long, outBlu as long, outAlp as long)
168. Function IsNear& (colr As _Unsigned Long, nearColr As _Unsigned Long, nearness As Long)
169.     'try color +-5 on RGB as near
170.     Dim As Long cRed, cGrn, cBlu, dummy, nRed, nGrn, nBlu
171.     cAnalysis colr, cRed, cGrn, cBlu, dummy
172.     'Print cRed, cGrn, cBlu
173.     cAnalysis nearColr, nRed, nGrn, nBlu, dummy
174.     'Print nRed, nGrn, nBlu
175.     If Abs(cRed - nRed) <= nearness Then
176.         If Abs(cGrn - nGrn) <= nearness Then
177.             If Abs(cBlu - nBlu) <= nearness Then IsNear& = -1
178.         End If
179.     End If
180. End Function

For the Turkey Run image found in the above OP zip, I had to Black the writing at the bottom then click white points to Black out, there are a couple of inner light colored island that need clicking to paint Black too.

The point of all this is to have just one color to _ClearColor when load image into app.

My next Edit Image version will allow reframing the image so the Blackout of text show here wont be necessary.

[bplus]

Code: QB64: [Select]

1. Sub paint4 (x0, y0, PaintColor As _Unsigned Long, NearColor As _Unsigned Long, nearness As Long)

Here is another image I managed to isolate with Edit Image 2 but took a little tweaking to get the NearColor, nearness numbers optimized. Flying in a blue sky I settled on:

Code: QB64: [Select]

1. paint4 mx, my, _RGB32(0, 128, 0), _RGB32(175, 175, 200), 56

 

As shown in the Turkey Hunt Game with the green _ClearColor'd

[Petr]

Hi @bplus,

Only now have I looked into this thread. I use this solution to remove artifacts (but it's not as effective as your Super Paint 4), this is definitely a great topic and a useful thing to do. You will need SaveImage to try it out.

My procedure for using this utility: Scan an image. Then save it as a PNG. Then run it through this program (after reducing it to the required size). Left-click on the color you want to remove. What does not redraw it can be marked with the left mouse button. The output creates a GIF file that contains a yellow background. This is then removed in the program using _CLEARCOLOR
 &HFFFFFF00, handle &.

There's also room for improvement, such as running SUB SP as many times as you look for color (so when you clean an image from RGB32(255)  to RGB32(235) so 20 times and not just once, as it is now).

Code: QB64: [Select]

1. '$include:'saveimage.bi'
2. Input "Insert File Name:"; File$
3. img = _LoadImage(File$, 32)
4. _Dest 0
5. Dim As _MEM m, n
6. newimg = _NewImage(_Width(img), _Height(img), 32)
7. Dim As _Unsigned _Byte R, G, B, A
8. Dim As Long Counter
9. m = _MemImage(img)
10. n = _MemImage(newimg)
11. Do Until Counter = m.SIZE - 4
12.     _MemGet m, m.OFFSET + Counter, B
13.     _MemGet m, m.OFFSET + Counter + 1, G
14.     _MemGet m, m.OFFSET + Counter + 2, R
15.     _MemGet m, m.OFFSET + Counter + 3, A
16.  
17.     D = 245
18.     ND = 255
19.     If R > D And G > D And B > D Then R = ND: G = ND: B = ND
20.     _MemPut n, n.OFFSET + Counter, B
21.     _MemPut n, n.OFFSET + Counter + 1, G
22.     _MemPut n, n.OFFSET + Counter + 2, R
23.     _MemPut n, n.OFFSET + Counter + 3, A
24.     Counter = Counter + 4
25. Loop
26.  
27.  
28. Screen newimg
29. _FullScreen
30.  
31. Do Until k& = 27
32.     k& = _KeyHit
33.     GetMouse X, Y, LB, RB
34.     If LB Then sp X, Y, &HFFFFFF00
35. Loop
36.  
37. nfile$ = "NEW " + Left$(File$, Len(File$) - 4) + ".gif"
38. Result = SaveImage(nfile$, 0, 0, 0, _Width - 1, _Height - 1)
39.  
40. Sub sp (x, y, c~&)
41.     W = _Width: H = _Height
42.     Virtual = _NewImage(W, H, 32)
43.  
44.     Dim m As _MEM, n As _MEM, Bck As _Unsigned Long
45.     m = _MemImage(_Source)
46.     n = _MemImage(Virtual)
47.  
48.     'create mask (2 color image)
49.     position& = (y * W + x) * 4
50.     _MemGet m, m.OFFSET + position&, Bck
51.     Clr2~& = _RGB32(_Red32(Bck) - 1, _Green32(Bck) - 1, _Blue32(Bck) - 1)
52.     D& = 0
53.     Do Until D& = n.SIZE
54.         CLR~& = _MemGet(m, m.OFFSET + D&, _Unsigned Long)
55.         If CLR~& = Bck~& Then _MemPut n, n.OFFSET + D&, CLR~& Else _MemPut n, n.OFFSET + D&, Clr2~&
56.         D& = D& + 4
57.     Loop
58.  
59.     d = _Dest
60.     _Dest Virtual
61.     Paint (x, y), c~&, Clr2~&
62.     _Dest d
63.     _ClearColor Clr2~&, Virtual
64.     _PutImage , Virtual, d
65.     _MemFree m
66.     _MemFree n
67.     _FreeImage Virtual
68. End Sub
69.  
70. Sub ValC (variable, min, max)
71.     If variable < min Then variable = min
72.     If variable > max Then variable = max
73. End Sub
74.  
75. Sub GetMouse (MX, MY, LB, RB)
76.     While _MouseInput: Wend
77.     MX = _MouseX
78.     MY = _MouseY
79.     LB = _MouseButton(1)
80.     RB = _MouseButton(2)
81. End Sub
82. '$include:'saveimage.bm'
83.  

[bplus]

Hi @Petr

Glad you see the value of what I am attempting. In your code, what does "sp" for sp sub stand for? Possibly Special Paint? I see allot of mem manipulations so will take me awhile to study. But if it is about removing colors or changing a color, I have that maybe using memory too from @Qwerkey, Pi in the Sky (still a great graphics demo IMHO) if only for changing a color in an image.

I do like this sub already!

Code: QB64: [Select]

1. Sub ValC (variable, min, max)
2.     If variable < min Then variable = min
3.     If variable > max Then variable = max
4. End Sub

I think we could change it into a function and be rid of my two Max, Min functions.

Coming up:
I am considering adding the color intended to be made transparent when loading a .CI (Custom Image file) ie
in .CI_DIM file (so handy to have image Width and Height for reading independent of .CI data) the simple File input listing will be:
 Width
 Height
 Color intended to be made transparent

I am hoping I can do this in the sub while loading the CI data and not have to tell the app using the loading sub to read the color to make _ClearColor for the Handle& returned from the loading sub, this may make loading a CI image a little more handy than _LoadImage.

So now that's 2 changes for Edit Image 3, cropping and handling _ClearColor Plus start a more formal editor with buttons and menus so there will be a screen work space for image and controls for manipulating...

Here we go:

Code: QB64: [Select]

1. _Title "Between Function test" 'b+ 2022-01-01 (first function written this year!
2. For i = 0 To 20
3.     Print i; Between&(5, 15, i)
4. Next
5.  
6. Function Between& (min, max, variable) ' since this is a function we dont have to worry about changing a variable value
7.     If variable < min Then
8.         Between& = min
9.     ElseIf variable > max Then
10.         Between& = max
11.     Else
12.         Between& = variable
13.     End If
14. End Function
15.  

[Petr]

@bplus

To line 25 there is a solution for all pixels close to the value D to be overwritten to the value ND. Basically it's the same as this https://qb64forum.alephc.xyz/index.php?topic=4432.msg138555#msg138555

SP is an abbreviated name for the sub SuperPaint, its original purpose is to color the image no matter what colored borders delimit the colored area.

[bplus]

@bplus

To line 25 there is a solution for all pixels close to the value D to be overwritten to the value ND. Basically it's the same as this https://qb64forum.alephc.xyz/index.php?topic=4432.msg138555#msg138555

SP is an abbreviated name for the sub SuperPaint, its original purpose is to color the image no matter what colored borders delimit the colored area.

SP, I was close :)

The link is just color changing everything in an image (or rect area of it).

My solution paints until nothing paintable in an area around a point click, so say I am painting everything close to white eg in turkey run image but I don't want to paint white eye parts or white teeth part, Paint4 leaves them alone (unless I click those areas) because those areas are surrounded by dark colors, so Paint4 wont fill to those points. Maybe you got that already (but then why are you showing the link?), as I said I already have nice color changing code.

The Wild Turkey was painted green all around with one click once I got the numbers tweaked. Could still be shades of blue sky mixed in with those feathers.

[Qwerkey]

if it is about removing colors or changing a color, I have that maybe using memory too from @Qwerkey, Pi in the Sky (still a great graphics demo IMHO) if only for changing a color in an image.

@bplus You were always too kind about Pi-in-the-Sky.  It certainly had a certain degree of quirkiness, but all members have that individual creativity.  Thank you, again!

[Petr]

I tried to speed up the original BPlus program (mainly because it returns perfect results). Here is my edit. I pulled it out of the original 16.26 seconds to 8.78 seconds.

Interestingly, if you enter the color with the mouse in the left third of the image, it is even three seconds faster. But I don't see the reason.


So to put it bluntly ... I have a my new picture in my profile rightly ... I had a badly set start time measurement, so the acceleration is there, but only about 30 - 40 percent.

Code: QB64: [Select]

1.  
2. _Title "Edit image test 2" 'b+ 2021-12-29 sure would like to take an image and the subject wo background colors
3. ' from  C:\Users\marka\Desktop\QB64 work\000 work QB64\000 Test\More Saving Images
4. ' file "Fast Image Save and Load.bas" by SMcNeill 2021-12-07
5.  
6. ' posted 2021-12-30 with question about _inflate, _deflate
7. ' here: https://qb64forum.alephc.xyz/index.php?topic=4541.msg139518#msg139518
8. ' fixed with _deflate, _inflate thanks SMcNeil!
9.  
10. ' "Edit image test 2" 2021-12-31 still working on that Turkey image I have created Paint4
11. ' that should paint everything a color if it is near another color, hopefully this will
12. ' eliminate all the light pixels around the border of the turkey.
13. ' The turkey run image needs the print at the bottom blacked out or the image reframed smaller
14. ' all the near white around the turkey made black so I cam use one _clearColor (black here).
15.  
16.  
17. ''Scn& = _NewImage(800, 600, 32)  'should not need these 2 lines if loadimage with 32
18. ''Screen Scn&
19. Dim image&: image& = _LoadImage("turkey run snap.png", 32) ' <<<<<<<<<<<<<<<<< Edit Image file name
20. 'Print image& ' OK -12   guess I forgot to save file before trying so in QB64 folder instead of project folder
21. 'Sleep
22.  
23. 'Petr's speed up attempt:
24. '16.26 seconds original, now 8.78 seconds, on left side 4.87 seconds!
25.  
26. Dim Scn&: Scn& = _NewImage(_Width(image&), _Height(image&), 32)
27. 'Dim Shared Temp(_Width(image&) - 1, _Height(image&) - 1)
28. Dim Shared As _Unsigned _Byte NRed, NGreen, NBlue
29. Type RGB
30.     As _Unsigned _Byte R, G, B
31. End Type
32. Dim Shared RGB(_Width(image&) * _Height(image&)) As RGB
33.  
34. Screen Scn&
35. _Source image& ' for using Point from image
36.  
37. Dim mx, my, snap&
38.  
39. _Title "Escape finshes Blackout Then use Paint4"
40. Cls ' must clear screen to see what was cleared from image if anything
41. _PutImage , image&, 0 '
42. snap& = _NewImage(_Width, _Height, 32)
43. _PutImage , 0, snap&
44. Do
45.     _PutImage , snap&, 0
46.     While _MouseInput: Wend ' poll mouse to show me where I am at
47.     mx = _MouseX: my = _MouseY
48.     Line (mx - 5, my - 5)-(mx + 5, my + 5), , B ' eraser block  black & white frame around eraser
49.     Line (mx - 6, my - 6)-(mx + 6, my + 6), &HFF000000, B ' eraser block
50.     If _MouseButton(1) Then
51.         _PutImage , snap&, 0 'clear mouse
52.         Line (mx - 4, my - 4)-(mx + 4, my + 4), &HFF000000, BF
53.         _Display
54.         _PutImage , 0, snap& 'grab while mouse gone
55.     End If
56.     _Display
57.     _Limit 100
58. Loop Until _KeyDown(27)
59. _Title "Spacebar finishes Paint4" ' Paint4 paints everything around a given point a color
60. '                                  if the points around it are close to another given color
61. '                                  How close is close? You get to say in an amount of RGB.
62. Do
63.     _PutImage , snap&, 0
64.     While _MouseInput: Wend ' poll mouse to show me where I am at
65.     mx = _MouseX: my = _MouseY
66.     Circle (mx, my), 2, &HFFFFFFFF
67.     Circle (mx, my), 3, &HFF000000
68.     If _MouseButton(1) Then
69.      T = Timer  
70.     _PutImage , snap&, 0 'clear mouse
71.         paint4 mx, my, _RGB32(0, 0, 0), _RGB32(245, 245, 245), 186
72.         _Display
73.         _PutImage , 0, snap& 'grab while mouse gone
74.         If oTimer = 0 Then oTimer = Timer
75.     End If
76.  
77.     If oTimer Then Print oTimer - T
78.     _Display
79.     _Limit 100
80. Loop Until _KeyDown(32)
81. _AutoDisplay
82. ' hopefully the above has been encoded properly into a Sub
83. SaveCustomImage snap&, "Test Save Turkey Run"
84. Cls
85. Print "Press any to test load image again... "
86. Sleep
87. 'And hopefully the LoadCustomImage& Function gets the data back from file
88. Dim image2&: image2& = LoadCustomImage&("Test Save Turkey Run")
89. _PutImage , image2&, 0 ' put back on screen
90.  
91.  
92. 'this will create 2 files for Custom Image:
93. '1) FileName$ + "CI_DIM" for image dimensions
94. '2) FileName$ + "CI" for the Custom Image data
95. Sub SaveCustomImage (imgHdl&, fileSaveBaseName$) ' for any image setup by _newimage
96.     Dim As Long w, h: w = _Width(imgHdl&): h = _Height(imgHdl&)
97.     Dim M As _MEM: M = _MemImage(imgHdl&) 'Dim a mem block.  Point it to your screen's image.
98.     Dim screenGrab$: screenGrab$ = Space$(M.SIZE) 'Set a string that size.
99.     _MemGet M, M.OFFSET, screenGrab$ 'Get the whole screen at once into that string.
100.     screenGrab$ = _Deflate$(screenGrab$) ' << heh dummy put this after you get screen grab!
101.     Open fileSaveBaseName$ + ".CI_DIM" For Output As #1
102.     Print #1, w
103.     Print #1, h
104.     Close #1
105.     Open fileSaveBaseName$ + ".CI" For Binary As #1
106.     Put #1, , screenGrab$
107.     Close
108. End Sub
109.  
110. ' Function returns Image Handle& (like _LoadFile)
111. Function LoadCustomImage& (fileLoadBaseName$) ' reverse the Save
112.     Dim As Long w, h
113.     Open fileLoadBaseName$ + ".CI_DIM" For Input As #1 ' get dimensions of custom image
114.     Input #1, w
115.     Input #1, h
116.     Close #1
117.     Dim imgHdl&: imgHdl& = _NewImage(w, h, 32) 'setup space and handle for it
118.     Dim M As _MEM: M = _MemImage(imgHdl&) ' put data into handle space reserved
119.     Dim screenGrab$: screenGrab$ = Space$(M.SIZE)
120.     Open fileLoadBaseName$ + ".CI" For Binary As #1 ' get data
121.     screenGrab$ = Space$(LOF(1))
122.     Get #1, , screenGrab$
123.     Close #1
124.     screenGrab$ = _Inflate$(screenGrab$) ' fixed ?
125.     _MemPut M, M.OFFSET, screenGrab$
126.     LoadCustomImage& = imgHdl& ' finally assign the function
127. End Function
128.  
129. ' test Paint4 here
130. ' this function needs:  Function IsNear2& (color offset, nearColr As _Unsigned Long, nearness)
131. ' this function needs:  Function min (n1, n2)
132. ' this function needs:  Function max (n1, n2)
133. Sub paint4 (x0, y0, PaintColor As _Unsigned Long, NearColor As _Unsigned Long, nearness As _Unsigned _Byte) ' needs max, min functions
134.     Dim oW, W, H, parentF, tick, ystart, ystop, xstart, xstop, x, y As _Unsigned Integer
135.     Dim m As _MEM
136.     m = _MemImage(_Dest)
137.     oW = _Width
138.     'new color global shared values
139.     NRed = _Red32(NearColor)
140.     NGreen = _Green32(NearColor)
141.     NBlue = _Blue32(NearColor)
142.     'save all points in image to global shared array in format .R, .G, .B
143.     Do Until clrs& = m.SIZE
144.         RGB(i).B = _MemGet(m, m.OFFSET + clrs&, _Unsigned _Byte)
145.         RGB(i).G = _MemGet(m, m.OFFSET + clrs& + 1, _Unsigned _Byte)
146.         RGB(i).R = _MemGet(m, m.OFFSET + clrs& + 2, _Unsigned _Byte)
147.         '+3 = alpha
148.         clrs& = clrs& + 4
149.         i = i + 1
150.     Loop
151.  
152.     If IsNear2((y0 * oW + x0), NearColor, nearness) Then
153.         _MemPut m, m.OFFSET + (y0 * oW + x0) * 4, PaintColor ' PSet (x, y), PaintColor
154.         W = _Width - 1: H = _Height - 1
155.         Dim Temp(W, H)
156.         Temp(x0, y0) = 1: parentF = 1
157.         While parentF = 1
158.             parentF = 0: tick = tick + 1
159.             ystart = max(y0 - tick, 0): ystop = min(y0 + tick, H)
160.             y = ystart
161.             While y <= ystop
162.                 xstart = max(x0 - tick, 0): xstop = min(x0 + tick, W)
163.                 x = xstart
164.                 While x <= xstop
165.                     ' If (IsNear&(Point(x, y), NearColor, nearness) = -1) And (temp(x, y) = 0) Then
166.                     If (IsNear2((y * oW + x), NearColor, nearness) = 1) And (Temp(x, y) = 0) Then
167.                         If Temp(max(0, x - 1), y) Then
168.                             Temp(x, y) = 1: parentF = 1: _MemPut m, m.OFFSET + (y * oW + x) * 4, PaintColor 'PSet (x, y), PaintColor
169.                         ElseIf Temp(min(x + 1, W), y) Then
170.                             Temp(x, y) = 1: parentF = 1: _MemPut m, m.OFFSET + (y * oW + x) * 4, PaintColor 'PSet (x, y), PaintColor
171.                         ElseIf Temp(x, max(y - 1, 0)) Then
172.                             Temp(x, y) = 1: parentF = 1: _MemPut m, m.OFFSET + (y * oW + x) * 4, PaintColor ' PSet (x, y), PaintColor
173.                         ElseIf Temp(x, min(y + 1, H)) Then
174.                             Temp(x, y) = 1: parentF = 1: _MemPut m, m.OFFSET + (y * oW + x) * 4, PaintColor 'PSet (x, y), PaintColor
175.                         End If
176.                     End If
177.                     x = x + 1
178.                 Wend
179.                 y = y + 1
180.             Wend
181.         Wend
182.     End If
183.     _MemFree m
184. End Sub
185.  
186. Function min~% (n1, n2)
187.     If n1 > n2 Then min = n2 Else min = n1
188. End Function
189.  
190. Function max~% (n1, n2)
191.     If n1 < n2 Then max = n2 Else max = n1
192. End Function
193.  
194. Function IsNear2~% (colr As _Unsigned Long, nearColr As _Unsigned Long, nearness As _Unsigned _Byte) 'cAnalysis is not need
195.     If Abs(RGB(colr).R - NRed) <= nearness Then
196.         If Abs(RGB(colr).G - NGreen) <= nearness Then
197.             If Abs(RGB(colr).B - NBlue) <= nearness Then IsNear2~% = 1
198.         End If
199.     End If
200. End Function
201.