Mouse pointers

[Petr]

Hello. I just wrote a program that reads some CUR format files. This program shows all the cursors you can draw and at the end one new cursor use. (just for this program, be no worries).

Code: QB64: [Select]

1. 'CUR file reader for read and draw cursor images from /windows/cursors dir. First version.
2. 'Writed wihtout format knowledge just only on base from https://en.wikipedia.org/wiki/ICO_(file_format)
3.  
4.  
5. 'can you find, how are writed some "unsupported" files?
6. 'known bug is bad draw Pen big xl.
7.  
8. 'writed for fun by Petr
9.  
10.  
11.  
12. REDIM CursorsList(0) AS STRING
13. Path$ = ENVIRON$("systemroot") + "\cursors\"
14. Mask$ = "*.CUR"
15. MakeCursorsList Path$, Mask$, CursorsList$()
16.  
17. Cursor$ = ENVIRON$("systemroot") + "\cursors\aero_arrow.cur"
18. Img& = LoadCursor&(Cursor$, x, y)
19.  
20. PRINT
21. PRINT "One cursor is loaded and will be used. This is Cursor loader info screen. Press any key...": SLEEP
22.  
23. my& = _NEWIMAGE(_DESKTOPWIDTH, _DESKTOPHEIGHT, 32): _FULLSCREEN
24. _DEST my&
25. CLS , _RGB32(128, 55, 220)
26. ShowUsableCursors CursorsList$(), my&
27.  
28. SCREEN my&
29. PCOPY _DISPLAY, 1
30. _MOUSEHIDE
31. DO
32.     PCOPY 1, _DISPLAY
33.     ViewCursor Img&, x, y
34.     _LIMIT 25
35. LOOP UNTIL _KEYHIT = 27
36. SYSTEM
37.  
38. SUB ShowUsableCursors (Cursors() AS STRING, ToScreen AS LONG)
39.     _DEST ToScreen&
40.     X = 100: y = 100
41.     FOR L = LBOUND(cursors) TO UBOUND(cursors)
42.         P$ = ENVIRON$("systemroot") + "\cursors\" + Cursors(L)
43.         i& = LoadCursor&(P$, a, b)
44.         _DEST ToScreen&
45.         IF i& >= 0 THEN GOSUB Unsupported: _CONTINUE
46.         _PUTIMAGE (X, y), i&, ToScreen&
47.         _FREEIMAGE i&
48.         COLOR _RGB32(255, 255, 254), _RGB32(128, 55, 220)
49.         _PRINTSTRING (X, y + 80), STR$(L) + ": " + Cursors(L), ToScreen&
50.         X = X + 300: IF X > _DESKTOPWIDTH - 300 THEN X = 100: y = y + 300
51.         IF y + 300 > _DESKTOPHEIGHT THEN
52.             SCREEN ToScreen&: _PRINTSTRING (20, _DESKTOPHEIGHT - 20), "Press any key for view next...", ToScreen&: SLEEP: CLS , _RGB32(128, 55, 220): X = 100: y = 100
53.             P$ = ""
54.         END IF
55.     NEXT L
56.     _PRINTSTRING (20, _DESKTOPHEIGHT - 20), "New cursor is now used. Press Esc for end.", ToScreen&
57.     EXIT SUB
58.  
59.     Unsupported:
60.     _PRINTSTRING (X + 20, y + 50), "Not supported", ToScreen&
61.     _PRINTSTRING (X, y + 80), STR$(L) + ": " + Cursors(L), ToScreen&
62.     X = X + 300: IF X > _DESKTOPWIDTH - 300 THEN X = 100: y = y + 300
63.     IF y + 300 > _DESKTOPHEIGHT THEN
64.         SCREEN ToScreen&: _PRINTSTRING (20, _DESKTOPHEIGHT - 20), "Press any key for view next...", ToScreen&: SLEEP: CLS , _RGB32(128, 55, 220): X = 100: y = 100
65.         P$ = ""
66.     END IF
67.     RETURN
68. END SUB
69.  
70. SUB MakeCursorsList (Path AS STRING, Mask AS STRING, ToArray() AS STRING)
71.     '    IF not win THEN PRINT "Error: MakeCursosList SUB is designed for Windows only.": SLEEP 1: END
72.     Current$ = _CWD$
73.     IF _DIREXISTS(Path$) THEN
74.         CHDIR Path$
75.         commandd$ = "DIR " + Mask$ + " /B > CursorsList.txt"
76.         SHELL _HIDE commandd$
77.         IF _FILEEXISTS("CursorsList.txt") THEN
78.             CH = FREEFILE
79.             OPEN "CursorsList.txt" FOR INPUT AS #CH
80.             DO WHILE NOT EOF(CH)
81.                 LINE INPUT #CH, crs$
82.                 REDIM _PRESERVE ToArray(i) AS STRING
83.                 ToArray$(i) = LEFT$(crs$, 20)
84.                 i = i + 1
85.             LOOP
86.             CLOSE #CH
87.         ELSE PRINT "Unknown error. File CursorsList.txt not created.": SLEEP 1: END
88.         END IF
89.     ELSE
90.         PRINT "Error (Sub MakeCursorList): Specified path not exists.": SLEEP 1
91.         EXIT SUB
92.     END IF
93. END SUB
94.  
95. SUB ViewCursor (Cursor AS LONG, ReductionX AS _BYTE, ReductionY AS _BYTE)
96.     _DEST 0
97.     _MOUSEHIDE
98.     WHILE _MOUSEINPUT: WEND
99.     _PUTIMAGE (_MOUSEX - ReductionX - 6, _MOUSEY - ReductionY), Cursor&, 0
100. END SUB
101.  
102. FUNCTION LoadCursor& (Cursor AS STRING, XReturned, YReturned)
103.     'returns: 1: File not exists, 2: Unsupported format, Value < 0 - valid cursor image
104.     TYPE CUR
105.         Reserved AS INTEGER '       2 bytes, always 00
106.         Image_Type AS INTEGER '     1 = ICO format, 2 = CUR format, others are invalid
107.         Number_images AS INTEGER '  number images in file
108.     END TYPE
109.  
110.     TYPE Structure
111.         Image_Width AS _UNSIGNED _BYTE
112.         Image_Height AS _UNSIGNED _BYTE
113.         Image_Color_Palette AS _UNSIGNED _BYTE
114.         Reserved AS _UNSIGNED _BYTE 'always zero
115.         Horizontal AS INTEGER '      In ICO format: Specifies color planes. Should be 0 or 1.
116.         '                            In CUR format: Specifies the horizontal coordinates of the hotspot in number of pixels from the left.
117.         Vertical AS INTEGER '        In ICO format: Specifies bits per pixel.
118.         '                            In CUR format: Specifies the vertical coordinates of the hotspot in number of pixels from the top.
119.         Size_of_image_data AS LONG
120.         Offset_from_begin AS LONG
121.     END TYPE
122.     SCREEN _NEWIMAGE(800, 600, 32)
123.     CLS
124.     ERc = 0
125.     DIM CUR AS CUR, Structure AS Structure
126.  
127.     IF _FILEEXISTS(Cursor$) THEN
128.         CLOSE #1
129.         OPEN Cursor$ FOR BINARY AS #1
130.  
131.  
132.         GET #1, , CUR
133.         PRINT "First 2 bytes (always 0):"; CUR.Reserved
134.         PRINT "Image type (1 = ICO, 2 = CUR):"; CUR.Image_Type
135.         PRINT "Number images in file:"; CUR.Number_images
136.  
137.         re:
138.         '   _DEST 0
139.         PRINT "======================================="; R
140.         PRINT "Position in file:"; SEEK(1)
141.         GET #1, , Structure
142.         PRINT "Image width:"; Structure.Image_Width
143.         PRINT "Image height:"; Structure.Image_Height
144.         PRINT "Image color palette: (0 = LONG truecolor, 2 = _UNSIGNED _BYTE?)"; Structure.Image_Color_Palette
145.         PRINT "Reserved (always zero):"; Structure.Reserved
146.         PRINT "Number image points from left:"; Structure.Horizontal
147.         PRINT "Number image points from top: "; Structure.Vertical
148.         PRINT "Size of image data: "; Structure.Size_of_image_data
149.         PRINT "Start offset: "; Structure.Offset_from_begin
150.  
151.         IF LOF(1) < 10000 AND Structure.Image_Color_Palette = 0 THEN LoadCursor& = 2: EXIT FUNCTION 'some CUR files contains record: Structure.Image_Color_Palette = 0 (LONG) but are saved as CASE 2. If is used CASE 2 program, is then cursor view VERY badly. :-/
152.  
153.         XReturned = Structure.Horizontal
154.         YReturned = Structure.Vertical
155.  
156.         A$ = SPACE$(Structure.Size_of_image_data)
157.         GET #1, , A$
158.         posice = Structure.Offset_from_begin - 1
159.  
160.         IF Structure.Image_Width > 1 AND Structure.Image_Height > 1 THEN
161.             SELECT CASE Structure.Image_Color_Palette '                                In file is writed 0, but it is 4 byte long depth. Interresting...
162.                 CASE 0
163.                     posice = Structure.Offset_from_begin - 1
164.                     LoadCursor& = _NEWIMAGE(Structure.Image_Width, Structure.Image_Height, 32)
165.                     _DEST LoadCursor&
166.                     FOR DrawY = Structure.Image_Height - 1 TO 0 STEP -1
167.                         FOR DrawX = 0 TO Structure.Image_Width - 1
168.                             IF ERc THEN EXIT FOR ' some files contains record as 4 bytes, but are 1 byte! (uses 256 colors, but not truecolor as is recorded in head)
169.                             Bod& = CVL(MID$(A$, posice, 4))
170.                             posice = posice + 4
171.                             PSET (DrawX, DrawY), Bod&
172.                     NEXT DrawX, DrawY
173.  
174.                 CASE 2
175.                     SEEK #1, posice + 50
176.                     GET #1, , A$
177.                     LoadCursor& = _NEWIMAGE(Structure.Image_Width, Structure.Image_Height, 256) ' 2 bit colored. My lovely. :-D
178.                     _DEST LoadCursor&
179.                     _CLEARCOLOR 15, LoadCursor&
180.                     DrawX = 0: DrawY = 1
181.                     FOR CursorDraw = 1 TO LEN(A$)
182.                         Bod = ASC(A$, CursorDraw)
183.                         Bin$ = DECtoBIN$(Bod)
184.                         FOR drr = 1 TO LEN(Bin$)
185.                             comand$ = MID$(Bin$, drr, 1)
186.                             IF comand$ = "1" THEN clr = 0 ELSE clr = 15
187.                             PSET (DrawX, Structure.Image_Height - DrawY), clr
188.                             DrawX = DrawX + 1: IF DrawX > Structure.Image_Width - 1 THEN DrawX = 0: DrawY = DrawY + 1
189.                         NEXT
190.                     NEXT
191.             END SELECT
192.         END IF
193.     ELSE LoadCursor& = 1: EXIT FUNCTION 'if file not exists
194.     END IF
195.     IF Structure.Image_Color_Palette = 0 THEN _SETALPHA 0, _RGB32(0, 0, 0), Cursor&
196.     CLOSE #1
197.     _DEST 0
198. END FUNCTION
199.  
200. FUNCTION DECtoBIN$ (vstup)
201.     FOR rj = 7 TO 0 STEP -1
202.         IF vstup AND 2 ^ rj THEN DECtoBIN$ = DECtoBIN$ + "1" ELSE DECtoBIN$ = DECtoBIN$ + "0"
203.     NEXT rj
204. END FUNCTION
205.  

[TempodiBasic]

Hi Petr

this is my feedback

very interesting idea... but i got this issue

Hoping that it is useful....

[bplus]

Hi Petr and Tempodibasic,

I had the same report as Tempodibasic so I started tracking down problem.

Things started to work when I removed _HIDE from the SHELL command

Code: QB64: [Select]

1. SUB MakeCursorsList (Path AS STRING, Mask AS STRING, ToArray() AS STRING)
2.     '    IF not win THEN PRINT "Error: MakeCursosList SUB is designed for Windows only.": SLEEP 1: END
3.     Current$ = _CWD$
4.     'PRINT Path   'OK
5.     IF _DIREXISTS(Path$) THEN
6.         'CHDIR Path$   'OK
7.         PRINT _CWD$
8.         commandd$ = "DIR " + Mask$ + " /B > CursorsList.txt"
9.         SHELL commandd$ '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> remove _Hide   aha! now it works
10.         IF _FILEEXISTS("CursorsList.txt") THEN
11.             CH = FREEFILE
12.             OPEN "CursorsList.txt" FOR INPUT AS #CH
13.             DO WHILE NOT EOF(CH)
14.                 LINE INPUT #CH, crs$
15.                 REDIM _PRESERVE ToArray(i) AS STRING
16.                 ToArray$(i) = LEFT$(crs$, 20)
17.                 i = i + 1
18.             LOOP
19.             CLOSE #CH
20.         ELSE
21.             PRINT "Unknown error. File CursorsList.txt not created.": SLEEP 1: END
22.         END IF
23.     ELSE
24.         PRINT "Error (Sub MakeCursorList): Specified path not exists.": SLEEP 1
25.         EXIT SUB
26.     END IF
27. END SUB
28.  

probably a coincidence as now it works with _HIDE command, say is that temp file "CursorList.txt" getting KILLED when done with it?

[Ashish]

Hi Petr! I get error message saying "Unknown error. File CursorsList.txt not created."

[bplus]

Yeah there still is a problem after file is found, it is empty (being created in same folder as Petr's bas source as Windows wont let you write files in it's folders that I know of...)

So these are screens that follow with an empty cursorlist file and the newimage adjusted to 800x600 so I can access my tool bar. (Man I dislike it immensely when you guys test stuff in full screen!)

PS in test screen there is also giant mouse pointer.

[bplus]

Oh dang, it started working because I still had CHDIR commented out, foo!

What if we try and make the cursorlist.txt file in the bas source? That might fix Windows forbidden file making in it's folders.

[Ashish]

Oh! It ran successfully with "Run with Administrator". Need not to worry.

[bplus]

Oh that worked! Thanks Ashish, that is handy tip!

[Petr]

Thank you for all your reactions. Good idea, Ashish, I still neglect the possibilities of using hardware images, I will be able to think more about this possibility. I did not think it would be a problem with writing a file in a protected area of windows, I have set my IDE up so that she can do what she wants. But of course, there is no problem and i write this file at source. The only difference is that the file will contain the whole path, not just the .CUR file name. I will issue another source code where this will be fixed (about an hour).

I put it here and went away -  your interest is enjoying me. Stop writing this, i go repair it :-D

[Petr]

Repaired. Duration cca 1 minute. Small repair in sub MakeCursorList. File contain names, loader (ShowUsableCursors SUB) but use full path returned from ENVIRON$:

Code: QB64: [Select]

1. 'CUR file reader for read and draw cursor images from /windows/cursors dir. First version.
2. 'Writed wihtout format knowledge just only on base from https://en.wikipedia.org/wiki/ICO_(file_format)
3.  
4.  
5. 'can you find, how are writed some "unsupported" files?
6. 'known bug is bad draw Pen big xl.
7.  
8. 'writed for fun by Petr
9.  
10.  
11.  
12. REDIM CursorsList(0) AS STRING
13. Path$ = ENVIRON$("systemroot") + "\cursors\"
14. Mask$ = "*.CUR"
15. MakeCursorsList Path$, Mask$, CursorsList$()
16.  
17. Cursor$ = ENVIRON$("systemroot") + "\cursors\aero_arrow.cur"
18. Img& = LoadCursor&(Cursor$, x, y)
19.  
20. PRINT
21. PRINT "One cursor is loaded and will be used. This is Cursor loader info screen. Press any key...": SLEEP
22.  
23. my& = _NEWIMAGE(_DESKTOPWIDTH, _DESKTOPHEIGHT, 32): _FULLSCREEN
24. _DEST my&
25. CLS , _RGB32(128, 55, 220)
26. ShowUsableCursors CursorsList$(), my&
27.  
28. SCREEN my&
29. PCOPY _DISPLAY, 1
30. _MOUSEHIDE
31. DO
32.     PCOPY 1, _DISPLAY
33.     ViewCursor Img&, x, y
34.     _LIMIT 25
35. LOOP UNTIL _KEYHIT = 27
36. SYSTEM
37.  
38. SUB ShowUsableCursors (Cursors() AS STRING, ToScreen AS LONG)
39.     _DEST ToScreen&
40.     X = 100: y = 100
41.     FOR L = LBOUND(cursors) TO UBOUND(cursors)
42.         P$ = ENVIRON$("systemroot") + "\cursors\" + Cursors(L)
43.         i& = LoadCursor&(P$, a, b)
44.         _DEST ToScreen&
45.         IF i& >= 0 THEN GOSUB Unsupported: _CONTINUE
46.         _PUTIMAGE (X, y), i&, ToScreen&
47.         _FREEIMAGE i&
48.         COLOR _RGB32(255, 255, 254), _RGB32(128, 55, 220)
49.         _PRINTSTRING (X, y + 80), STR$(L) + ": " + Cursors(L), ToScreen&
50.         X = X + 300: IF X > _DESKTOPWIDTH - 300 THEN X = 100: y = y + 300
51.         IF y + 300 > _DESKTOPHEIGHT THEN
52.             SCREEN ToScreen&: _PRINTSTRING (20, _DESKTOPHEIGHT - 20), "Press any key for view next...", ToScreen&: SLEEP: CLS , _RGB32(128, 55, 220): X = 100: y = 100
53.             P$ = ""
54.         END IF
55.     NEXT L
56.     _PRINTSTRING (20, _DESKTOPHEIGHT - 20), "New cursor is now used. Press Esc for end.", ToScreen&
57.     EXIT SUB
58.  
59.     Unsupported:
60.     _PRINTSTRING (X + 20, y + 50), "Not supported", ToScreen&
61.     _PRINTSTRING (X, y + 80), STR$(L) + ": " + Cursors(L), ToScreen&
62.     X = X + 300: IF X > _DESKTOPWIDTH - 300 THEN X = 100: y = y + 300
63.     IF y + 300 > _DESKTOPHEIGHT THEN
64.         SCREEN ToScreen&: _PRINTSTRING (20, _DESKTOPHEIGHT - 20), "Press any key for view next...", ToScreen&: SLEEP: CLS , _RGB32(128, 55, 220): X = 100: y = 100
65.         P$ = ""
66.     END IF
67.     RETURN
68. END SUB
69.  
70. SUB MakeCursorsList (Path AS STRING, Mask AS STRING, ToArray() AS STRING)
71.     '    IF not win THEN PRINT "Error: MakeCursosList SUB is designed for Windows only.": SLEEP 1: END
72.     Current$ = _CWD$
73.     IF _DIREXISTS(Path$) THEN
74.         'CHDIR Path$
75.         commandd$ = "DIR " + Path$ + Mask$ + " /B > CursorsList.txt"
76.         SHELL _HIDE commandd$
77.         IF _FILEEXISTS("CursorsList.txt") THEN
78.             CH = FREEFILE
79.             OPEN "CursorsList.txt" FOR INPUT AS #CH
80.             DO WHILE NOT EOF(CH)
81.                 LINE INPUT #CH, crs$
82.                 REDIM _PRESERVE ToArray(i) AS STRING
83.  
84.  
85.                 ToArray$(i) = LEFT$(crs$, 20)
86.                 i = i + 1
87.             LOOP
88.             CLOSE #CH
89.         ELSE PRINT "Unknown error. File CursorsList.txt not created.": SLEEP 1: END
90.         END IF
91.     ELSE
92.         PRINT "Error (Sub MakeCursorList): Specified path not exists.": SLEEP 1
93.         EXIT SUB
94.     END IF
95. END SUB
96.  
97. SUB ViewCursor (Cursor AS LONG, ReductionX AS _BYTE, ReductionY AS _BYTE)
98.     _DEST 0
99.     _MOUSEHIDE
100.     WHILE _MOUSEINPUT: WEND
101.     _PUTIMAGE (_MOUSEX - ReductionX - 6, _MOUSEY - ReductionY), Cursor&, 0
102. END SUB
103.  
104. FUNCTION LoadCursor& (Cursor AS STRING, XReturned, YReturned)
105.     'returns: 1: File not exists, 2: Unsupported format, Value < 0 - valid cursor image
106.     TYPE CUR
107.         Reserved AS INTEGER '       2 bytes, always 00
108.         Image_Type AS INTEGER '     1 = ICO format, 2 = CUR format, others are invalid
109.         Number_images AS INTEGER '  number images in file
110.     END TYPE
111.  
112.     TYPE Structure
113.         Image_Width AS _UNSIGNED _BYTE
114.         Image_Height AS _UNSIGNED _BYTE
115.         Image_Color_Palette AS _UNSIGNED _BYTE
116.         Reserved AS _UNSIGNED _BYTE 'always zero
117.         Horizontal AS INTEGER '      In ICO format: Specifies color planes. Should be 0 or 1.
118.         '                            In CUR format: Specifies the horizontal coordinates of the hotspot in number of pixels from the left.
119.         Vertical AS INTEGER '        In ICO format: Specifies bits per pixel.
120.         '                            In CUR format: Specifies the vertical coordinates of the hotspot in number of pixels from the top.
121.         Size_of_image_data AS LONG
122.         Offset_from_begin AS LONG
123.     END TYPE
124.     SCREEN _NEWIMAGE(800, 600, 32)
125.     CLS
126.     ERc = 0
127.     DIM CUR AS CUR, Structure AS Structure
128.  
129.     IF _FILEEXISTS(Cursor$) THEN
130.         CLOSE #1
131.         OPEN Cursor$ FOR BINARY AS #1
132.  
133.  
134.         GET #1, , CUR
135.         PRINT "First 2 bytes (always 0):"; CUR.Reserved
136.         PRINT "Image type (1 = ICO, 2 = CUR):"; CUR.Image_Type
137.         PRINT "Number images in file:"; CUR.Number_images
138.  
139.         re:
140.         '   _DEST 0
141.         PRINT "======================================="; R
142.         PRINT "Position in file:"; SEEK(1)
143.         GET #1, , Structure
144.         PRINT "Image width:"; Structure.Image_Width
145.         PRINT "Image height:"; Structure.Image_Height
146.         PRINT "Image color palette: (0 = LONG truecolor, 2 = _UNSIGNED _BYTE?)"; Structure.Image_Color_Palette
147.         PRINT "Reserved (always zero):"; Structure.Reserved
148.         PRINT "Number image points from left:"; Structure.Horizontal
149.         PRINT "Number image points from top: "; Structure.Vertical
150.         PRINT "Size of image data: "; Structure.Size_of_image_data
151.         PRINT "Start offset: "; Structure.Offset_from_begin
152.  
153.         IF LOF(1) < 10000 AND Structure.Image_Color_Palette = 0 THEN LoadCursor& = 2: EXIT FUNCTION 'some CUR files contains record: Structure.Image_Color_Palette = 0 (LONG) but are saved as CASE 2. If is used CASE 2 program, is then cursor view VERY badly. :-/
154.  
155.         XReturned = Structure.Horizontal
156.         YReturned = Structure.Vertical
157.  
158.         A$ = SPACE$(Structure.Size_of_image_data)
159.         GET #1, , A$
160.         posice = Structure.Offset_from_begin - 1
161.  
162.         IF Structure.Image_Width > 1 AND Structure.Image_Height > 1 THEN
163.             SELECT CASE Structure.Image_Color_Palette '                                In file is writed 0, but it is 4 byte long depth. Interresting...
164.                 CASE 0
165.                     posice = Structure.Offset_from_begin - 1
166.                     LoadCursor& = _NEWIMAGE(Structure.Image_Width, Structure.Image_Height, 32)
167.                     _DEST LoadCursor&
168.                     FOR DrawY = Structure.Image_Height - 1 TO 0 STEP -1
169.                         FOR DrawX = 0 TO Structure.Image_Width - 1
170.                             IF ERc THEN EXIT FOR ' some files contains record as 4 bytes, but are 1 byte! (uses 256 colors, but not truecolor as is recorded in head)
171.                             Bod& = CVL(MID$(A$, posice, 4))
172.                             posice = posice + 4
173.                             PSET (DrawX, DrawY), Bod&
174.                     NEXT DrawX, DrawY
175.  
176.                 CASE 2
177.                     SEEK #1, posice + 50
178.                     GET #1, , A$
179.                     LoadCursor& = _NEWIMAGE(Structure.Image_Width, Structure.Image_Height, 256) ' 2 bit colored. My lovely. :-D
180.                     _DEST LoadCursor&
181.                     _CLEARCOLOR 15, LoadCursor&
182.                     DrawX = 0: DrawY = 1
183.                     FOR CursorDraw = 1 TO LEN(A$)
184.                         Bod = ASC(A$, CursorDraw)
185.                         Bin$ = DECtoBIN$(Bod)
186.                         FOR drr = 1 TO LEN(Bin$)
187.                             comand$ = MID$(Bin$, drr, 1)
188.                             IF comand$ = "1" THEN clr = 0 ELSE clr = 15
189.                             PSET (DrawX, Structure.Image_Height - DrawY), clr
190.                             DrawX = DrawX + 1: IF DrawX > Structure.Image_Width - 1 THEN DrawX = 0: DrawY = DrawY + 1
191.                         NEXT
192.                     NEXT
193.             END SELECT
194.         END IF
195.     ELSE LoadCursor& = 1: EXIT FUNCTION 'if file not exists
196.     END IF
197.     IF Structure.Image_Color_Palette = 0 THEN _SETALPHA 0, _RGB32(0, 0, 0), Cursor&
198.     CLOSE #1
199.     _DEST 0
200. END FUNCTION
201.  
202. FUNCTION DECtoBIN$ (vstup)
203.     FOR rj = 7 TO 0 STEP -1
204.         IF vstup AND 2 ^ rj THEN DECtoBIN$ = DECtoBIN$ + "1" ELSE DECtoBIN$ = DECtoBIN$ + "0"
205.     NEXT rj
206. END FUNCTION
207.  

[Petr]

Here is ancestor CUR viewer. Maybe its easyest. Just rewrite CUR file name on line 25:

Code: QB64: [Select]

1. 'CUR file reader for read ind draw cursor images from /windows/cursors dir. First version, just for fun.
2. 'Writed on base https://en.wikipedia.org/wiki/ICO_(file_format)
3. TYPE CUR
4.     Reserved AS INTEGER '       2 bytes, always 00
5.     Image_Type AS INTEGER '     1 = ICO format, 2 = CUR format, others are invalid
6.     Number_images AS INTEGER '  number images in file
7. END TYPE
8.  
9. TYPE Structure
10.     Image_Width AS _UNSIGNED _BYTE
11.     Image_Height AS _UNSIGNED _BYTE
12.     Image_Color_Palette AS _UNSIGNED _BYTE
13.     Reserved AS _UNSIGNED _BYTE 'always zero
14.     Horizontal AS INTEGER '      In ICO format: Specifies color planes. Should be 0 or 1.
15.     '                            In CUR format: Specifies the horizontal coordinates of the hotspot in number of pixels from the left.
16.     Vertical AS INTEGER '        In ICO format: Specifies bits per pixel.
17.     '                            In CUR format: Specifies the vertical coordinates of the hotspot in number of pixels from the top.
18.     Size_of_image_data AS LONG
19.     Offset_from_begin AS LONG
20. END TYPE
21. SCREEN _NEWIMAGE(800, 600, 32)
22. CLS , _RGB32(128, 100, 250)
23. ERc = 0
24. DIM CUR AS CUR, Structure AS Structure
25. Cursor$ = ENVIRON$("systemroot") + "\cursors\up_i.cur"
26. OPEN Cursor$ FOR BINARY AS #1
27.  
28.  
29. GET #1, , CUR
30. PRINT "First 2 bytes (always 0):"; CUR.Reserved
31. PRINT "Image type (1 = ICO, 2 = CUR):"; CUR.Image_Type
32. PRINT "Number images in file:"; CUR.Number_images
33.  
34. re:
35. _DEST 0
36. PRINT "======================================="; R
37. PRINT SEEK(1)
38. GET #1, , Structure
39. PRINT "Image width:"; Structure.Image_Width
40. PRINT "Image height:"; Structure.Image_Height
41. PRINT "Image color palette: (0 = LONG truecolor, 2 = _UNSIGNED _BYTE?)"; Structure.Image_Color_Palette
42. PRINT "Reserved (always zero):"; Structure.Reserved
43. PRINT "Number image points from left:"; Structure.Horizontal
44. PRINT "Number image points from top: "; Structure.Vertical
45. PRINT "Size of image data: "; Structure.Size_of_image_data
46. PRINT "Start offset: "; Structure.Offset_from_begin
47.  
48. IF LOF(1) < 10000 AND Structure.Image_Color_Palette = 0 THEN PRINT "Unsupported file format": END
49.  
50. A$ = SPACE$(Structure.Size_of_image_data)
51. GET #1, , A$
52. posice = Structure.Offset_from_begin - 1
53.  
54. IF Structure.Image_Width > 1 AND Structure.Image_Height > 1 THEN
55.     SELECT CASE Structure.Image_Color_Palette '                                  File write 0, but it is 4 byte long depth. Interresting...
56.         CASE 0
57.             posice = Structure.Offset_from_begin - 1
58.             cursor& = _NEWIMAGE(Structure.Image_Width, Structure.Image_Height, 32)
59.             _DEST cursor&
60.             FOR DrawY = Structure.Image_Height - 1 TO 0 STEP -1
61.                 FOR DrawX = 0 TO Structure.Image_Width - 1
62.                     IF ERc THEN EXIT FOR ' some files contains record as 4 bytes, but are 1 byte! (uses 256 colors, but not truecolor as is recorded in head)
63.                     Bod& = CVL(MID$(A$, posice, 4))
64.                     posice = posice + 4
65.                     PSET (DrawX, DrawY), Bod&
66.             NEXT DrawX, DrawY
67.  
68.  
69.         CASE 2
70.             SEEK #1, posice + 50
71.             GET #1, , A$
72.             cursor& = _NEWIMAGE(Structure.Image_Width, Structure.Image_Height, 256) ' 2 bit colored. My lovely. :-D
73.             _DEST cursor&
74.             _CLEARCOLOR 15, cursor&
75.             DrawX = 0: DrawY = 1
76.             FOR CursorDraw = 1 TO LEN(A$)
77.                 Bod = ASC(A$, CursorDraw)
78.                 Bin$ = DECtoBIN$(Bod)
79.                 FOR drr = 1 TO LEN(Bin$)
80.                     comand$ = MID$(Bin$, drr, 1)
81.                     IF comand$ = "1" THEN clr = 0 ELSE clr = 15
82.                     PSET (DrawX, Structure.Image_Height - DrawY), clr
83.                     DrawX = DrawX + 1: IF DrawX > Structure.Image_Width - 1 THEN DrawX = 0: DrawY = DrawY + 1
84.                 NEXT
85.             NEXT
86.     END SELECT
87. END IF
88.  
89. _MOUSEHIDE
90. IF Structure.Image_Color_Palette = 0 THEN _SETALPHA 0, _RGB32(0, 0, 0), cursor&
91. PCOPY _DISPLAY, 1
92. 'SCREEN cursor&: SLEEP
93.  
94. DO
95.     WHILE _MOUSEINPUT: WEND
96.     PCOPY 1, _DISPLAY
97.     Cx = Structure.Image_Width / 2: Cy = Structure.Image_Height / 2
98.     _PUTIMAGE (_MOUSEX - Cx, _MOUSEY - Cy), cursor&, 0
99.     _DISPLAY
100.     _LIMIT 25
101. LOOP UNTIL _KEYHIT = 27
102.  
103. FUNCTION DECtoBIN$ (vstup) 'DEC to BIN ok vystup je string, vstup je integer          decimal to binary number convertor   -   FROM QB64WIKI
104.     FOR rj = 7 TO 0 STEP -1
105.         IF vstup AND 2 ^ rj THEN DECtoBIN$ = DECtoBIN$ + "1" ELSE DECtoBIN$ = DECtoBIN$ + "0"
106.     NEXT rj
107. END FUNCTION
108.  

[bplus]

Yep, works fine now for my system.

[TempodiBasic]

So I can confirm that now it works fine...
Thank's

[Petr]

Here's another version. Tested under Windows and under Linux MINT. Unfortunately, in Linux, an unknown thing causes the program not hide the mouse pointer and not show a new pointer, but it gets stuck. That's why I've enabled the setting of the pointer under Windows only. I'm a newbie under Linux and I just know not why in Linux it works not. The error is in something in the SUB VIEWCURSOR, if someone wanted to advise me. The attachment contains CUR files for Linux users. Windows users do not need this attachment, in Windows it is read from the Windows \ Cursors folder.

This version supports more CUR file types.

Code: QB64: [Select]

1. 'CUR file reader for read and draw cursor images from /windows/cursors dir. First version.
2. 'Writed wihtout format knowledge just only on base from https://en.wikipedia.org/wiki/ICO_(file_format)
3.  
4.  
5. 'can you find, how are writed some "unsupported" files?      Upgraded (type 16 supported uncorrectly), type 0, 2 already supported
6. 'known bug is bad draw Pen big xl.                           Repaired
7. 'is added LINUX SUPPORT.   (tested in Linux MINT)...
8. 'known bug: Can not correctly draw structure color palette type 16. Its set to optimal output, but picture, as is set in file is then returned in different width and height image. (help_il.cur, help_im.cur)
9.  
10.  
11.  
12. 'writed for fun by Petr
13.  
14.  
15.  
16. DIM SHARED ACTIVE ' variable, which memorize new mouse cursor usage. Used in ViewCursor SUB
17.  
18. REDIM CursorsList(0) AS STRING
19. IF WIN THEN Path$ = ENVIRON$("systemroot") + "\cursors\" ELSE Path$ = _CWD$
20. Mask$ = "*.cur"
21.  
22.  
23.  
24.  
25. MakeCursorsList Path$, Mask$, CursorsList$() '                  show all cursors on screen
26. IF WIN THEN
27.     Cursor$ = ENVIRON$("systemroot") + "\cursors\wait_m.cur" '  Windows - read cursors from Your Windows path\Cursors\
28.     Img& = LoadCursor&(Cursor$, x, y)
29. ELSE
30.     Img& = LoadCursor&(_CWD$ + "/wait_m.cur", x, y) '           Linux - read cursors from program directory
31. END IF
32.  
33.  
34. my& = _NEWIMAGE(_DESKTOPWIDTH, _DESKTOPHEIGHT, 32): _FULLSCREEN
35. _DEST my&
36. CLS , _RGB32(128, 55, 220)
37. ShowUsableCursors CursorsList$(), my&
38.  
39. SCREEN my&
40.  
41. PCOPY _DISPLAY, 1
42. _MOUSEHIDE
43. DO
44.     K& = _KEYDOWN(27)
45.     PCOPY 1, _DISPLAY
46.     IF WIN THEN ViewCursor Img&, x, y 'in LINUX is here something wrong. Program then show not new mouse cursor and gets stuck. WHY?
47.     _LIMIT 25
48. LOOP UNTIL K&
49. SYSTEM
50.  
51. SUB ShowUsableCursors (Cursors() AS STRING, ToScreen AS LONG)
52.     _DEST ToScreen&
53.     X = 100: y = 100
54.     FOR L = LBOUND(cursors) TO UBOUND(cursors)
55.  
56.         i& = LoadCursor&(Cursors(L), A, b)
57.         _DEST ToScreen&
58.         IF i& >= 0 THEN GOSUB Unsupported: _CONTINUE
59.         _PUTIMAGE (X, y), i&, ToScreen&
60.         _FREEIMAGE i&
61.         COLOR _RGB32(255, 255, 254), _RGB32(128, 55, 220)
62.         _PRINTSTRING (X, y + 80), STR$(L) + ": " + Cursors(L), ToScreen&
63.         X = X + 300: IF X > _DESKTOPWIDTH - 300 THEN X = 100: y = y + 300
64.         IF y + 300 > _DESKTOPHEIGHT THEN
65.             SCREEN ToScreen&: _PRINTSTRING (20, _DESKTOPHEIGHT - 20), "Press any key for view next...", ToScreen&: SLEEP: CLS , _RGB32(128, 55, 220): X = 100: y = 100
66.             P$ = ""
67.         END IF
68.     NEXT L
69.     _PRINTSTRING (20, _DESKTOPHEIGHT - 20), "New cursor is now used. Press Esc for end.", ToScreen&
70.     EXIT SUB
71.  
72.     Unsupported:
73.     _PRINTSTRING (X + 20, y + 50), "Not supported", ToScreen&
74.     _PRINTSTRING (X, y + 80), STR$(L) + ": " + Cursors(L), ToScreen&
75.     X = X + 300: IF X > _DESKTOPWIDTH - 300 THEN X = 100: y = y + 300
76.     IF y + 300 > _DESKTOPHEIGHT THEN
77.         SCREEN ToScreen&: _PRINTSTRING (20, _DESKTOPHEIGHT - 20), "Press any key for view next...", ToScreen&: SLEEP: CLS , _RGB32(128, 55, 220): X = 100: y = 100
78.         P$ = ""
79.     END IF
80.     RETURN
81. END SUB
82.  
83. SUB MakeCursorsList (Path AS STRING, Mask AS STRING, ToArray() AS STRING)
84.     '    IF not win THEN PRINT "Error: MakeCursosList SUB is designed for Windows only.": SLEEP 1: END     'now supported.
85.     Current$ = _CWD$
86.     IF _DIREXISTS(Path$) THEN
87.         CHDIR Path$
88.         IF WIN THEN commandd$ = "DIR " + Mask$ + " /B > CursorsList.txt" ELSE commandd$ = "ls " + Mask$ + "> CursorsList.txt"
89.         '        PRINT commandd$
90.         '       SLEEP
91.         SHELL commandd$
92.  
93.         ' SLEEP
94.         IF _FILEEXISTS("CursorsList.txt") THEN
95.             CH = FREEFILE
96.             OPEN "CursorsList.txt" FOR INPUT AS #CH
97.             DO WHILE NOT EOF(CH)
98.                 LINE INPUT #CH, crs$
99.                 REDIM _PRESERVE ToArray(i) AS STRING
100.  
101.  
102.                 ToArray$(i) = LEFT$(crs$, 20)
103.                 i = i + 1
104.             LOOP
105.             CLOSE #CH
106.         ELSE PRINT "Unknown error. File CursorsList.txt not created.": SLEEP 1: END
107.         END IF
108.     ELSE
109.         PRINT "Error (Sub MakeCursorList): Specified path not exists.": SLEEP 1
110.         EXIT SUB
111.     END IF
112. END SUB
113.  
114. SUB ViewCursor (Cursor AS LONG, ReductionX AS _BYTE, ReductionY AS _BYTE)
115.  
116.     _DEST 0
117.     _MOUSEHIDE
118.     WHILE _MOUSEINPUT: WEND
119.     IF ACTIVE = 0 THEN ACTIVE = 1: _MOUSEMOVE _MOUSEX, _MOUSEY ' because without mouse moving is not _MOUSEHIDE accepted after call _MOUSEHIDE
120.     _PUTIMAGE (_MOUSEX - ReductionX - 6, _MOUSEY - ReductionY), Cursor&, 0
121. END SUB
122.  
123. FUNCTION LoadCursor& (Cursor AS STRING, XReturned, YReturned)
124.     IF LoadCursor& THEN _FREEIMAGE LoadCursor&
125.     'returns: 1: File not exists, 2: Unsupported format, Value < 0 - valid cursor image
126.     TYPE CUR
127.         Reserved AS INTEGER '       2 bytes, always 00
128.         Image_Type AS INTEGER '     1 = ICO format, 2 = CUR format, others are invalid
129.         Number_images AS INTEGER '  number images in file
130.     END TYPE
131.  
132.     TYPE Structure
133.         Image_Width AS _UNSIGNED _BYTE
134.         Image_Height AS _UNSIGNED _BYTE
135.         Image_Color_Palette AS _BYTE '_UNSIGNED _BYTE
136.         Reserved AS _UNSIGNED _BYTE 'always zero
137.         Horizontal AS INTEGER '      In ICO format: Specifies color planes. Should be 0 or 1.
138.         '                            In CUR format: Specifies the horizontal coordinates of the hotspot in number of pixels from the left.
139.         Vertical AS INTEGER '        In ICO format: Specifies bits per pixel.
140.         '                            In CUR format: Specifies the vertical coordinates of the hotspot in number of pixels from the top.
141.         Size_of_image_data AS LONG
142.         Offset_from_begin AS LONG
143.     END TYPE
144.  
145.     TYPE ClrMask ' Thanks to LINUX i see difference. THIS area is not mentoied in my source materials...
146.         Bb AS _UNSIGNED _BYTE
147.         Gb AS _UNSIGNED _BYTE
148.         Rb AS _UNSIGNED _BYTE 'colors use 3 colors, not alpha. Background color.
149.         Bf AS _UNSIGNED _BYTE
150.         Gf AS _UNSIGNED _BYTE
151.         Rf AS _UNSIGNED _BYTE '                                Foreground color.
152.     END TYPE
153.     DIM Mask AS ClrMask
154.  
155.     SCREEN _NEWIMAGE(800, 600, 32)
156.     CLS
157.     ERc = 0
158.     DIM CUR AS CUR, Structure AS Structure
159.  
160.     IF _FILEEXISTS(Cursor$) THEN
161.         CLOSE #1
162.  
163.         SHARED po: po = po + 1
164.         OPEN Cursor$ FOR BINARY AS #1
165.  
166.         GET #1, , CUR
167.         PRINT "First 2 bytes (always 0):"; CUR.Reserved
168.         PRINT "Image type (1 = ICO, 2 = CUR):"; CUR.Image_Type
169.         PRINT "Number images in file:"; CUR.Number_images
170.  
171.         re:
172.  
173.         PRINT "======================================="; R
174.         PRINT "File: "; Cursor$; po - 2
175.         PRINT "Position in file:"; SEEK(1)
176.         GET #1, , Structure
177.         PRINT "Image width:"; Structure.Image_Width
178.         PRINT "Image height:"; Structure.Image_Height
179.         PRINT "Image color palette: (0 = LONG truecolor, 2 = _UNSIGNED _BYTE?)"; Structure.Image_Color_Palette
180.         PRINT "Reserved (always zero):"; Structure.Reserved
181.         PRINT "Number image points from left:"; Structure.Horizontal
182.         PRINT "Number image points from top: "; Structure.Vertical
183.         PRINT "Size of image data: "; Structure.Size_of_image_data
184.         PRINT "Start offset: "; Structure.Offset_from_begin
185.         PRINT " Palette:"; Structure.Image_Color_Palette
186.         PRINT "File size: "; LOF(1)
187.  
188.  
189.  
190.         FOR all_images = 1 TO CUR.Number_images
191.             GET #1, , Mask
192.             PRINT "Image: "; all_images
193.             PRINT "Color mask - foreground: "; Mask.Rf; Mask.Gf; Mask.Bf
194.             PRINT "Color mask - background: "; Mask.Rb; Mask.Gb; Mask.Bb
195.             _DELAY .1
196.  
197.  
198.             XReturned = Structure.Horizontal
199.             YReturned = Structure.Vertical
200.  
201.             A$ = SPACE$(Structure.Size_of_image_data)
202.             posice = Structure.Offset_from_begin + 1
203.  
204.             IF Structure.Image_Width > 1 AND Structure.Image_Height > 1 THEN
205.                 SELECT CASE Structure.Image_Color_Palette '                                In file is writed 0, but it is 4 byte long depth. Interresting...
206.                     CASE 0
207.                         SEEK #1, Structure.Offset_from_begin + 1
208.                         GET #1, , A$
209.                         posice = Structure.Offset_from_begin - 1
210.                         IF Structure.Size_of_image_data < (Structure.Image_Width * Structure.Image_Height) THEN ClrDepth = 256 ELSE ClrDepth = 32
211.                         LoadCursor& = _NEWIMAGE(Structure.Image_Width + 1, Structure.Image_Height + 1, ClrDepth)
212.  
213.  
214.                         _DEST LoadCursor&
215.                         IF drawy = 0 THEN drawy = Structure.Image_Height
216.                         IF ClrDepth = 32 THEN
217.                             DO WHILE drawy <> 0 AND drawx <> Structure.Image_Width
218.                                 posice = posice + 4
219.                                 Bod& = CVL(MID$(A$, posice, 4))
220.                                 PSET (drawx, drawy), Bod&
221.                                 drawx = drawx + 1
222.                                 IF drawx = Structure.Image_Width AND drawx MOD 4 = 0 THEN drawx = 0: drawy = drawy - 1
223.                             LOOP
224.                         ELSE
225.                             'upgrade
226.                             SEEK #1, Structure.Offset_from_begin
227.                             GET #1, , A$
228.                             drawy = -2
229.                             LoadCursor& = _NEWIMAGE(Structure.Image_Width + 1, Structure.Image_Height + 1, 256) ' 2 bit color
230.                             _DEST LoadCursor&
231.                             _PALETTECOLOR 1, _RGB32(Mask.Rf, Mask.Gf, Mask.Bf)
232.                             _PALETTECOLOR 15, _RGB32(Mask.Rb, Mask.Gb, Mask.Bb)
233.                             _CLEARCOLOR 1, LoadCursor&
234.                             drawx = -8: drawy = -6
235.                             FOR CursorDraw = 1 TO LEN(A$)
236.                                 bod = ASC(A$, CursorDraw)
237.                                 Bin$ = DECtoBIN$(bod)
238.                                 FOR drr = 1 TO LEN(Bin$)
239.                                     comand$ = MID$(Bin$, drr, 1)
240.                                     IF comand$ = "1" THEN clr = 15 ELSE clr = 1
241.  
242.                                     IF drawy < 0 THEN clr = 1
243.                                     IF drawy > -2 THEN PSET (drawx, (Structure.Image_Height - 1) - drawy), clr
244.                                     drawx = drawx + 1: IF drawx >= Structure.Image_Width AND drawx MOD 32 = 0 THEN drawx = 0: drawy = drawy + 1
245.                                 NEXT
246.                             NEXT
247.                         END IF
248.  
249.                     CASE 2
250.                         SEEK #1, Structure.Offset_from_begin + 45
251.                         GET #1, , A$
252.                         LoadCursor& = _NEWIMAGE(Structure.Image_Width, Structure.Image_Height, 256) ' 2 bit colored. My lovely. :-D
253.                         _DEST LoadCursor&
254.  
255.                         _PALETTECOLOR 1, _RGB32(Mask.Rf, Mask.Gf, Mask.Bf)
256.                         _PALETTECOLOR 15, _RGB32(Mask.Rb, Mask.Gb, Mask.Bb)
257.  
258.  
259.                         _CLEARCOLOR 1, LoadCursor&
260.                         drawx = 0: drawy = 0
261.                         FOR CursorDraw = 1 TO LEN(A$)
262.                             bod = ASC(A$, CursorDraw)
263.                             Bin$ = DECtoBIN$(bod)
264.                             FOR drr = 1 TO LEN(Bin$)
265.                                 comand$ = MID$(Bin$, drr, 1)
266.                                 IF comand$ = "1" THEN clr = 15 ELSE clr = 1
267.                                 PSET (drawx, Structure.Image_Height - drawy), clr
268.                                 drawx = drawx + 1: IF drawx > Structure.Image_Width - 1 AND drawx MOD 32 = 0 THEN drawx = 0: drawy = drawy + 1
269.                             NEXT
270.                         NEXT
271.  
272.                     CASE 16
273.                         SEEK #1, Structure.Offset_from_begin + 817 'i have none informations about file area between color palette record and image data record...
274.  
275.                         GET #1, , A$
276.                         A$ = LEFT$(A$, Structure.Image_Width * Structure.Image_Height)
277.                         LoadCursor& = _NEWIMAGE(Structure.Image_Width + 12, Structure.Image_Height + 5, 256) '
278.                         _DEST LoadCursor&
279.                         _PALETTECOLOR 15, _RGB32(Mask.Rf, Mask.Gf, Mask.Bf)
280.                         _PALETTECOLOR 1, _RGB32(Mask.Rb, Mask.Gb, Mask.Bb)
281.                         _CLEARCOLOR 1, LoadCursor&
282.  
283.                         drawx = -3: drawy = -4 'Structure.Vertical
284.                         FOR CursorDraw = 1 TO LEN(A$)
285.                             bod = ASC(A$, CursorDraw)
286.                             Bin$ = DECtoBIN$(bod)
287.                             FOR drr = 1 TO LEN(Bin$)
288.                                 comand$ = MID$(Bin$, drr, 1)
289.                                 IF comand$ = "1" THEN clr = 15 ELSE clr = 1
290.                                 PSET (drawx, Structure.Image_Height - drawy), clr
291.                                 drawx = drawx + 1: IF drawx > Structure.Image_Width AND drawx MOD 32 = 0 THEN drawx = 0: drawy = drawy + 1
292.                             NEXT
293.                         NEXT
294.                 END SELECT
295.             END IF
296.         NEXT ' color palette settings
297.  
298.     ELSE LoadCursor& = 1: EXIT FUNCTION 'if file not exists
299.     END IF
300.     IF Structure.Image_Color_Palette = 0 THEN _SETALPHA 0, _RGB32(0, 0, 0), cursor&
301.     CLOSE #1
302.     _DEST 0
303. END FUNCTION
304.  
305. FUNCTION DECtoBIN$ (vstup)
306.     FOR rj = 7 TO 0 STEP -1
307.         IF vstup AND 2 ^ rj THEN DECtoBIN$ = DECtoBIN$ + "1" ELSE DECtoBIN$ = DECtoBIN$ + "0"
308.     NEXT rj
309. END FUNCTION
310.  
311. FUNCTION BINtoDEC (b AS STRING)
312.     FOR Si = 1 TO LEN(b)
313.         e$ = MID$(b$, Si, 1)
314.         c = VAL(e$) '
315.         Sj = LEN(b) - Si
316.         BINtoDEC = BINtoDEC + (c * 2 ^ Sj)
317.     NEXT Si
318. END FUNCTION
319.  
320. FUNCTION WIN
321.     IF INSTR(_OS$, "WINDOWS") THEN WIN = 1 ELSE WIN = 0
322. END FUNCTION
323.  

[Petr]

I am sorry, but i found bug.... after test program in windows and linux (and some repairs in linux) i test it not again in windows.... here is repaired version

Code: QB64: [Select]

1. 'CUR file reader for read and draw cursor images from /windows/cursors dir. First version.
2. 'Writed wihtout format knowledge just only on base from https://en.wikipedia.org/wiki/ICO_(file_format)
3.  
4.  
5. 'can you find, how are writed some "unsupported" files?      Upgraded (type 16 supported uncorrectly), type 0, 2 already supported
6. 'known bug is bad draw Pen big xl.                           Repaired
7. 'is added LINUX SUPPORT.   (tested in Linux MINT)...
8. 'known bug: Can not correctly draw structure color palette type 16. Its set to optimal output, but picture, as is set in file is then returned in different width and height image. (help_il.cur, help_im.cur)
9.  
10. 'Retested in Windows, repaired under Linux.
11.  
12. 'writed for fun by Petr
13.  
14.  
15.  
16. DIM SHARED ACTIVE ' variable, which memorize new mouse cursor usage. Used in ViewCursor SUB
17.  
18. REDIM CursorsList(0) AS STRING
19. IF WIN THEN Path$ = ENVIRON$("systemroot") + "\cursors\" ELSE Path$ = _CWD$
20. Mask$ = "*.cur"
21.  
22.  
23.  
24.  
25. MakeCursorsList Path$, Mask$, CursorsList$() '                  show all cursors on screen
26. IF WIN THEN
27.     Cursor$ = ENVIRON$("systemroot") + "\cursors\wait_m.cur" '  Windows - read cursors from Your Windows path\Cursors\
28.     Img& = LoadCursor&(Cursor$, x, y)
29. ELSE
30.     Img& = LoadCursor&("wait_m.cur", x, y) '           Linux - read cursors from program directory
31.     '  PRINT Img&: SLEEP
32. END IF
33.  
34.  
35. my& = _NEWIMAGE(_DESKTOPWIDTH, _DESKTOPHEIGHT, 32): _FULLSCREEN
36. _DEST my&
37. CLS , _RGB32(128, 55, 220)
38. ShowUsableCursors CursorsList$(), my&
39.  
40. SCREEN my&
41. _AUTODISPLAY
42. PCOPY _DISPLAY, 1
43. _MOUSEHIDE
44. DO
45.     K& = _KEYDOWN(27)
46.     PCOPY 1, _DISPLAY
47.     ViewCursor Img&, x, y 'in LINUX is here something wrong. Program then show not new mouse cursor and gets stuck. WHY?
48.     _LIMIT 25
49. LOOP UNTIL K&
50. SYSTEM
51.  
52. SUB ShowUsableCursors (Cursors() AS STRING, ToScreen AS LONG)
53.     _DEST ToScreen&
54.     X = 100: y = 100
55.     FOR L = LBOUND(cursors) TO UBOUND(cursors)
56.  
57.         i& = LoadCursor&(Cursors(L), A, b)
58.         _DEST ToScreen&
59.         IF i& >= 0 THEN GOSUB Unsupported: _CONTINUE
60.         _PUTIMAGE (X, y), i&, ToScreen&
61.         _FREEIMAGE i&
62.         COLOR _RGB32(255, 255, 254), _RGB32(128, 55, 220)
63.  
64.         Lp = LastPos(Cursors(L), CHR$(92))
65.  
66.         fname$ = MID$(Cursors(L), Lp)
67.         _PRINTSTRING (X, y + 80), STR$(L) + ": " + fname$, ToScreen&
68.         X = X + 300: IF X > _DESKTOPWIDTH - 300 THEN X = 100: y = y + 300
69.         IF y + 300 > _DESKTOPHEIGHT THEN
70.             SCREEN ToScreen&: _PRINTSTRING (20, _DESKTOPHEIGHT - 20), "Press any key for view next...", ToScreen&: SLEEP: CLS , _RGB32(128, 55, 220): X = 100: y = 100
71.             P$ = ""
72.         END IF
73.     NEXT L
74.     _PRINTSTRING (20, _DESKTOPHEIGHT - 20), "New cursor is now used. Press Esc for end.", ToScreen&
75.     EXIT SUB
76.  
77.     Unsupported:
78.     _PRINTSTRING (X + 20, y + 50), "Not supported", ToScreen&
79.     _PRINTSTRING (X, y + 80), STR$(L) + ": " + Cursors(L), ToScreen&
80.     X = X + 300: IF X > _DESKTOPWIDTH - 300 THEN X = 100: y = y + 300
81.     IF y + 300 > _DESKTOPHEIGHT THEN
82.         SCREEN ToScreen&: _PRINTSTRING (20, _DESKTOPHEIGHT - 20), "Press any key for view next...", ToScreen&: SLEEP: CLS , _RGB32(128, 55, 220): X = 100: y = 100
83.         P$ = ""
84.     END IF
85.     RETURN
86. END SUB
87.  
88. SUB MakeCursorsList (Path AS STRING, Mask AS STRING, ToArray() AS STRING)
89.     '    IF not win THEN PRINT "Error: MakeCursosList SUB is designed for Windows only.": SLEEP 1: END     'now supported.
90.     Current$ = _CWD$
91.     IF _DIREXISTS(Path$) THEN
92.         '        CHDIR Path$
93.         IF WIN THEN commandd$ = "DIR " + Path$ + Mask$ + " /B >CursorsList.txt" ELSE commandd$ = "ls " + Mask$ + "> CursorsList.txt"
94.         SHELL commandd$
95.  
96.  
97.         IF _FILEEXISTS("CursorsList.txt") THEN
98.             CH = FREEFILE
99.             OPEN "CursorsList.txt" FOR INPUT AS #CH
100.             DO WHILE NOT EOF(CH)
101.                 LINE INPUT #CH, crs$
102.                 REDIM _PRESERVE ToArray(i) AS STRING
103.  
104.  
105.                 IF WIN THEN
106.                     ToArray$(i) = Path$ + LEFT$(crs$, 20)
107.                 ELSE ToArray$(i) = LEFT$(crs$, 20)
108.                 END IF
109.  
110.  
111.  
112.                 i = i + 1
113.             LOOP
114.             CLOSE #CH
115.         ELSE PRINT "Unknown error. File CursorsList.txt not created.": SLEEP 1: END
116.         END IF
117.     ELSE
118.         PRINT "Error (Sub MakeCursorList): Specified path not exists.": SLEEP 1
119.         EXIT SUB
120.     END IF
121. END SUB
122.  
123. SUB ViewCursor (Cursor AS LONG, ReductionX AS _BYTE, ReductionY AS _BYTE)
124.  
125.     _DEST 0
126.     IF WIN THEN _MOUSEHIDE ' this create program working fail. Program not respond and can not be killed in LINUX   - but is called in my loop and there works under Linux... ????
127.     WHILE _MOUSEINPUT: WEND
128.     IF ACTIVE = 0 AND WIN THEN ACTIVE = 1: _MOUSEMOVE _MOUSEX, _MOUSEY ' because without mouse moving is not _MOUSEHIDE accepted after call _MOUSEHIDE. If is call in Linux, nothing is viewed, but program can be killed.
129.     _PUTIMAGE (_MOUSEX - ReductionX - 6, _MOUSEY - ReductionY), Cursor&, 0
130. END SUB
131.  
132. FUNCTION LoadCursor& (Cursor AS STRING, XReturned, YReturned)
133.     '    IF LoadCursor& THEN _FREEIMAGE LoadCursor&      'This.... in linux it kill cursor image. In windows it KILL NOT cursor image (image in end)
134.     'returns: 1: File not exists, 2: Unsupported format, Value < 0 - valid cursor image
135.     TYPE CUR
136.         Reserved AS INTEGER '       2 bytes, always 00
137.         Image_Type AS INTEGER '     1 = ICO format, 2 = CUR format, others are invalid
138.         Number_images AS INTEGER '  number images in file
139.     END TYPE
140.  
141.     TYPE Structure
142.         Image_Width AS _UNSIGNED _BYTE
143.         Image_Height AS _UNSIGNED _BYTE
144.         Image_Color_Palette AS _BYTE '_UNSIGNED _BYTE
145.         Reserved AS _UNSIGNED _BYTE 'always zero
146.         Horizontal AS INTEGER '      In ICO format: Specifies color planes. Should be 0 or 1.
147.         '                            In CUR format: Specifies the horizontal coordinates of the hotspot in number of pixels from the left.
148.         Vertical AS INTEGER '        In ICO format: Specifies bits per pixel.
149.         '                            In CUR format: Specifies the vertical coordinates of the hotspot in number of pixels from the top.
150.         Size_of_image_data AS LONG
151.         Offset_from_begin AS LONG
152.     END TYPE
153.  
154.     TYPE ClrMask ' Thanks to LINUX i see difference. THIS area is not mentoied in my source materials...
155.         Bb AS _UNSIGNED _BYTE
156.         Gb AS _UNSIGNED _BYTE
157.         Rb AS _UNSIGNED _BYTE 'colors use 3 colors, not alpha. Background color.
158.         Bf AS _UNSIGNED _BYTE
159.         Gf AS _UNSIGNED _BYTE
160.         Rf AS _UNSIGNED _BYTE '                                Foreground color.
161.     END TYPE
162.     DIM Mask AS ClrMask
163.  
164.     SCREEN _NEWIMAGE(800, 600, 32)
165.     CLS
166.     ERc = 0
167.     DIM CUR AS CUR, Structure AS Structure
168.  
169.     IF _FILEEXISTS(Cursor$) THEN
170.         CLOSE #1
171.  
172.         SHARED po: po = po + 1
173.         OPEN Cursor$ FOR BINARY AS #1
174.  
175.         GET #1, , CUR
176.         PRINT "First 2 bytes (always 0):"; CUR.Reserved
177.         PRINT "Image type (1 = ICO, 2 = CUR):"; CUR.Image_Type
178.         PRINT "Number images in file:"; CUR.Number_images
179.  
180.         re:
181.  
182.         PRINT "======================================="; R
183.         PRINT "File: "; Cursor$; po - 2
184.         PRINT "Position in file:"; SEEK(1)
185.         GET #1, , Structure
186.         PRINT "Image width:"; Structure.Image_Width
187.         PRINT "Image height:"; Structure.Image_Height
188.         PRINT "Image color palette: (0 = LONG truecolor, 2 = _UNSIGNED _BYTE?)"; Structure.Image_Color_Palette
189.         PRINT "Reserved (always zero):"; Structure.Reserved
190.         PRINT "Number image points from left:"; Structure.Horizontal
191.         PRINT "Number image points from top: "; Structure.Vertical
192.         PRINT "Size of image data: "; Structure.Size_of_image_data
193.         PRINT "Start offset: "; Structure.Offset_from_begin
194.         PRINT " Palette:"; Structure.Image_Color_Palette
195.         PRINT "File size: "; LOF(1)
196.  
197.  
198.  
199.         FOR all_images = 1 TO CUR.Number_images
200.             GET #1, , Mask
201.             PRINT "Image: "; all_images
202.             PRINT "Color mask - foreground: "; Mask.Rf; Mask.Gf; Mask.Bf
203.             PRINT "Color mask - background: "; Mask.Rb; Mask.Gb; Mask.Bb
204.             _DELAY .1
205.  
206.  
207.             XReturned = Structure.Horizontal
208.             YReturned = Structure.Vertical
209.  
210.             A$ = SPACE$(Structure.Size_of_image_data)
211.             posice = Structure.Offset_from_begin + 1
212.  
213.             IF Structure.Image_Width > 1 AND Structure.Image_Height > 1 THEN
214.                 SELECT CASE Structure.Image_Color_Palette '                                In file is writed 0, but it is 4 byte long depth. Interresting...
215.                     CASE 0
216.                         SEEK #1, Structure.Offset_from_begin + 1
217.                         GET #1, , A$
218.                         posice = Structure.Offset_from_begin - 1
219.                         IF Structure.Size_of_image_data < (Structure.Image_Width * Structure.Image_Height) THEN ClrDepth = 256 ELSE ClrDepth = 32
220.                         LoadCursor& = _NEWIMAGE(Structure.Image_Width + 1, Structure.Image_Height + 1, ClrDepth)
221.  
222.  
223.                         _DEST LoadCursor&
224.                         IF drawy = 0 THEN drawy = Structure.Image_Height
225.                         IF ClrDepth = 32 THEN
226.                             DO WHILE drawy <> 0 AND drawx <> Structure.Image_Width
227.                                 posice = posice + 4
228.                                 Bod& = CVL(MID$(A$, posice, 4))
229.                                 PSET (drawx, drawy), Bod&
230.                                 drawx = drawx + 1
231.                                 IF drawx = Structure.Image_Width AND drawx MOD 4 = 0 THEN drawx = 0: drawy = drawy - 1
232.                             LOOP
233.                         ELSE
234.                             'upgrade
235.                             SEEK #1, Structure.Offset_from_begin
236.                             GET #1, , A$
237.                             drawy = -2
238.                             LoadCursor& = _NEWIMAGE(Structure.Image_Width + 1, Structure.Image_Height + 1, 256) ' 2 bit color
239.                             _DEST LoadCursor&
240.                             _PALETTECOLOR 1, _RGB32(Mask.Rf, Mask.Gf, Mask.Bf)
241.                             _PALETTECOLOR 15, _RGB32(Mask.Rb, Mask.Gb, Mask.Bb)
242.                             _CLEARCOLOR 1, LoadCursor&
243.                             drawx = -8: drawy = -6
244.                             FOR CursorDraw = 1 TO LEN(A$)
245.                                 bod = ASC(A$, CursorDraw)
246.                                 Bin$ = DECtoBIN$(bod)
247.                                 FOR drr = 1 TO LEN(Bin$)
248.                                     comand$ = MID$(Bin$, drr, 1)
249.                                     IF comand$ = "1" THEN clr = 15 ELSE clr = 1
250.  
251.                                     IF drawy < 0 THEN clr = 1
252.                                     IF drawy > -2 THEN PSET (drawx, (Structure.Image_Height - 1) - drawy), clr
253.                                     drawx = drawx + 1: IF drawx >= Structure.Image_Width AND drawx MOD 32 = 0 THEN drawx = 0: drawy = drawy + 1
254.                                 NEXT
255.                             NEXT
256.                         END IF
257.  
258.                     CASE 2
259.                         SEEK #1, Structure.Offset_from_begin + 45
260.                         GET #1, , A$
261.                         LoadCursor& = _NEWIMAGE(Structure.Image_Width, Structure.Image_Height, 256) ' 2 bit colored. My lovely. :-D
262.                         _DEST LoadCursor&
263.  
264.                         _PALETTECOLOR 1, _RGB32(Mask.Rf, Mask.Gf, Mask.Bf)
265.                         _PALETTECOLOR 15, _RGB32(Mask.Rb, Mask.Gb, Mask.Bb)
266.  
267.  
268.                         _CLEARCOLOR 1, LoadCursor&
269.                         drawx = 0: drawy = 0
270.                         FOR CursorDraw = 1 TO LEN(A$)
271.                             bod = ASC(A$, CursorDraw)
272.                             Bin$ = DECtoBIN$(bod)
273.                             FOR drr = 1 TO LEN(Bin$)
274.                                 comand$ = MID$(Bin$, drr, 1)
275.                                 IF comand$ = "1" THEN clr = 15 ELSE clr = 1
276.                                 PSET (drawx, Structure.Image_Height - drawy), clr
277.                                 drawx = drawx + 1: IF drawx > Structure.Image_Width - 1 AND drawx MOD 32 = 0 THEN drawx = 0: drawy = drawy + 1
278.                             NEXT
279.                         NEXT
280.  
281.                     CASE 16
282.                         SEEK #1, Structure.Offset_from_begin + 817 'i have none informations about file area between color palette record and image data record...
283.  
284.                         GET #1, , A$
285.                         A$ = LEFT$(A$, Structure.Image_Width * Structure.Image_Height)
286.                         LoadCursor& = _NEWIMAGE(Structure.Image_Width + 12, Structure.Image_Height + 5, 256) '
287.                         _DEST LoadCursor&
288.                         _PALETTECOLOR 15, _RGB32(Mask.Rf, Mask.Gf, Mask.Bf)
289.                         _PALETTECOLOR 1, _RGB32(Mask.Rb, Mask.Gb, Mask.Bb)
290.                         _CLEARCOLOR 1, LoadCursor&
291.  
292.                         drawx = -3: drawy = -4 'Structure.Vertical
293.                         FOR CursorDraw = 1 TO LEN(A$)
294.                             bod = ASC(A$, CursorDraw)
295.                             Bin$ = DECtoBIN$(bod)
296.                             FOR drr = 1 TO LEN(Bin$)
297.                                 comand$ = MID$(Bin$, drr, 1)
298.                                 IF comand$ = "1" THEN clr = 15 ELSE clr = 1
299.                                 PSET (drawx, Structure.Image_Height - drawy), clr
300.                                 drawx = drawx + 1: IF drawx > Structure.Image_Width AND drawx MOD 32 = 0 THEN drawx = 0: drawy = drawy + 1
301.                             NEXT
302.                         NEXT
303.                 END SELECT
304.             END IF
305.         NEXT ' color palette settings
306.  
307.     ELSE LoadCursor& = 1: EXIT FUNCTION 'if file not exists
308.     END IF
309.     IF Structure.Image_Color_Palette = 0 THEN _SETALPHA 0, _RGB32(0, 0, 0), cursor&
310.     CLOSE #1
311.     _DEST 0
312. END FUNCTION
313.  
314. FUNCTION DECtoBIN$ (vstup)
315.     FOR rj = 7 TO 0 STEP -1
316.         IF vstup AND 2 ^ rj THEN DECtoBIN$ = DECtoBIN$ + "1" ELSE DECtoBIN$ = DECtoBIN$ + "0"
317.     NEXT rj
318. END FUNCTION
319.  
320. FUNCTION BINtoDEC (b AS STRING)
321.     FOR Si = 1 TO LEN(b)
322.         e$ = MID$(b$, Si, 1)
323.         c = VAL(e$) '
324.         Sj = LEN(b) - Si
325.         BINtoDEC = BINtoDEC + (c * 2 ^ Sj)
326.     NEXT Si
327. END FUNCTION
328.  
329. FUNCTION WIN
330.     IF INSTR(_OS$, "WINDOWS") THEN WIN = 1 ELSE WIN = 0
331. END FUNCTION
332.  
333. FUNCTION LastPos (bases AS STRING, search AS STRING)
334.     FOR e = LEN(bases) TO 1 STEP -1
335.         IF ASC(bases, e) = ASC(search) THEN LastPos = e + 1: EXIT FUNCTION
336.     NEXT e
337. END FUNCTION
338.