Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: Petr on June 09, 2018, 09:14:14 am

Title: Mouse pointers
Post by: Petr on June 09, 2018, 09:14:14 am
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.  
  21. PRINT "One cursor is loaded and will be used. This is Cursor loader info screen. Press any key...": SLEEP
  22.  
  24. _DEST my&
  25. CLS , _RGB32(128, 55, 220)
  26. ShowUsableCursors CursorsList$(), my&
  27.  
  28. SCREEN my&
  32.     PCOPY 1, _DISPLAY
  33.     ViewCursor Img&, x, y
  34.     _LIMIT 25
  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
  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
  94.  
  95. SUB ViewCursor (Cursor AS LONG, ReductionX AS _BYTE, ReductionY AS _BYTE)
  96.     _DEST 0
  99.     _PUTIMAGE (_MOUSEX - ReductionX - 6, _MOUSEY - ReductionY), Cursor&, 0
  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
  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
  205.  
Title: Re: Mouse pointers
Post by: TempodiBasic on June 09, 2018, 10:48:50 am
Hi Petr

this is my feedback

very interesting idea... but i got this issue

Hoping that it is useful....
Title: Re: Mouse pointers
Post by: bplus on June 09, 2018, 11:51:36 am
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
  28.  

probably a coincidence as now it works with _HIDE command, say is that temp file "CursorList.txt" getting KILLED when done with it?
Title: Re: Mouse pointers
Post by: Ashish on June 09, 2018, 12:07:51 pm
Hi Petr! I get error message saying "Unknown error. File CursorsList.txt not created."
Title: Re: Mouse pointers
Post by: bplus on June 09, 2018, 12:12:42 pm
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.

Title: Re: Mouse pointers
Post by: bplus on June 09, 2018, 12:20:12 pm
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.
Title: Re: Mouse pointers
Post by: Ashish on June 09, 2018, 12:23:11 pm
Oh! It ran successfully with "Run with Administrator". Need not to worry.
Title: Re: Mouse pointers
Post by: bplus on June 09, 2018, 12:35:26 pm
Oh that worked! Thanks Ashish, that is handy tip!
Title: Re: Mouse pointers
Post by: Petr on June 09, 2018, 02:52:15 pm
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
Title: Re: Mouse pointers
Post by: Petr on June 09, 2018, 03:01:55 pm
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.  
  21. PRINT "One cursor is loaded and will be used. This is Cursor loader info screen. Press any key...": SLEEP
  22.  
  24. _DEST my&
  25. CLS , _RGB32(128, 55, 220)
  26. ShowUsableCursors CursorsList$(), my&
  27.  
  28. SCREEN my&
  32.     PCOPY 1, _DISPLAY
  33.     ViewCursor Img&, x, y
  34.     _LIMIT 25
  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
  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
  96.  
  97. SUB ViewCursor (Cursor AS LONG, ReductionX AS _BYTE, ReductionY AS _BYTE)
  98.     _DEST 0
  101.     _PUTIMAGE (_MOUSEX - ReductionX - 6, _MOUSEY - ReductionY), Cursor&, 0
  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
  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
  207.  

Title: Re: Mouse pointers
Post by: Petr on June 09, 2018, 03:27:38 pm
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
  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
  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:
  36. PRINT "======================================="; R
  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
  88.  
  90. IF Structure.Image_Color_Palette = 0 THEN _SETALPHA 0, _RGB32(0, 0, 0), cursor&
  92. 'SCREEN cursor&: SLEEP
  93.  
  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
  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
  108.  
Title: Re: Mouse pointers
Post by: bplus on June 09, 2018, 04:05:18 pm
Yep, works fine now for my system.
Title: Re: Mouse pointers
Post by: TempodiBasic on June 11, 2018, 10:08:20 am
So I can confirm that now it works fine...
Thank's
Title: Re: Mouse pointers
Post by: Petr on August 20, 2018, 03:39:28 pm
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)
  30.     Img& = LoadCursor&(_CWD$ + "/wait_m.cur", x, y) '           Linux - read cursors from program directory
  32.  
  33.  
  35. _DEST my&
  36. CLS , _RGB32(128, 55, 220)
  37. ShowUsableCursors CursorsList$(), my&
  38.  
  39. SCREEN my&
  40.  
  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
  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
  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
  113.  
  114. SUB ViewCursor (Cursor AS LONG, ReductionX AS _BYTE, ReductionY AS _BYTE)
  115.  
  116.     _DEST 0
  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
  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
  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
  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
  319.  
  321.     IF INSTR(_OS$, "WINDOWS") THEN WIN = 1 ELSE WIN = 0
  323.  
Title: Re: Mouse pointers
Post by: Petr on August 21, 2018, 12:24:20 pm
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)
  30.     Img& = LoadCursor&("wait_m.cur", x, y) '           Linux - read cursors from program directory
  31.     '  PRINT Img&: SLEEP
  33.  
  34.  
  36. _DEST my&
  37. CLS , _RGB32(128, 55, 220)
  38. ShowUsableCursors CursorsList$(), my&
  39.  
  40. SCREEN my&
  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
  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
  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
  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... ????
  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
  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
  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
  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
  328.  
  330.     IF INSTR(_OS$, "WINDOWS") THEN WIN = 1 ELSE WIN = 0
  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
  338.  
Title: Re: Mouse pointers
Post by: Petr on August 23, 2018, 03:13:12 pm
Today something similar, yet much more fun. The program will allow you to use animated ANI cursors (this first version know only one type, but of course this is not last version) What do you say about an animated Windows cursor under Linux?

Code: QB64: [Select]
  1. 'ANI reader - 32 bit files only.    Linux compatible.
  2.  
  3. file$ = "aero_working_xl.ani"
  4.  
  5.  
  6.  
  7. '1] Test, if this is ANI file
  8. '------------------------------
  9. TYPE ANI_Acon_Header
  10.     ID1 AS STRING * 4 'RIFF
  11.     Size AS LONG '     ?
  12.     ID2 AS STRING * 4 'ACON
  14. DIM Ani_Head AS ANI_Acon_Header
  16.     ch = FREEFILE
  17.     OPEN file$ FOR BINARY AS #ch
  18.     GET #ch, , Ani_Head
  19.     IF Ani_Head.ID1 = "RIFF" AND Ani_Head.ID2 = "ACON" THEN PRINT file$; " is valid. Size: "; Ani_Head.Size + 8
  20. ELSE PRINT file$; " not exists.": END
  22.  
  23. '2] Finding in file position for flag "anih" and reading this head
  24. '-----------------------------------------------------------------
  25. TYPE anih
  26.     ID AS STRING * 4 'anih
  27.     Width AS LONG
  28.     Height AS LONG
  29.     NumFrames AS LONG
  30.     NumSteps AS LONG
  31.     Frame_Size AS LONG
  32.     HeaderSize AS LONG
  33.     BitCount AS LONG
  34.     NumPlanes AS LONG 'always 1
  35.     DisplayRate AS LONG 'default rate = 60/anih.displayrate fps
  36.     Flags AS STRING * 4 'currently used 2 bits: bit 31 to 2 are reserved,
  37.     'bit 1: if true, then file contains sequence data,
  38.     'bit 0: True = Frames are icon or cursor dat, False: Frames are RAW data
  40. DIM anih AS anih
  41. REDIM a_rec(0)
  42. Scan file$, "anih", a_rec(), 1
  43. GET #ch, a_rec(0), anih
  44.  
  45. Frames = anih.NumFrames
  46. Width = anih.Width
  47. Height = anih.Height
  48. BpP = anih.BitCount
  49. Rate = anih.DisplayRate
  50.  
  51. '3] Finding start positions for all frames (search flag "icon")
  52. '--------------------------------------------------------------
  53. REDIM a_rec(0)
  54. Scan file$, "icon", a_rec(), Frames 'ok
  55.  
  56. '4] By the BpP (bites per pixel) value now i set output pixelsize and create array with frames. Record 0 contains video LIMIT between frames.
  57. '--------------------------------------------------------------------------------------------------------------------------------------------
  58. TYPE Icon
  59.     icon AS STRING * 4
  60.     cosi AS LONG
  61.     Reserved AS INTEGER '       2 bytes, always 00
  62.     Image_Type AS INTEGER '     1 = ICO format, 2 = CUR format, others are invalid
  63.     Number_images AS INTEGER '  number images in file
  65.  
  66. TYPE Structure '
  67.     Image_Width AS _UNSIGNED _BYTE
  68.     Image_Height AS _UNSIGNED _BYTE
  69.     Image_Color_Palette AS _UNSIGNED _BYTE
  70.     Reserved AS _UNSIGNED _BYTE 'always zero
  71.     Planes AS INTEGER '          In ICO format: Specifies color planes. Should be 0 or 1.
  72.     '                            In CUR format: Specifies the horizontal coordinates of the hotspot in number of pixels from the left.
  73.     Bpp AS INTEGER '             In ICO format: Specifies bits per pixel.
  74.     '                            In CUR format: Specifies the vertical coordinates of the hotspot in number of pixels from the top.
  75.     Size_of_image_data AS LONG
  76.     Offset_from_begin AS LONG
  78.  
  79. DIM icon AS Icon
  80. DIM structure AS Structure
  82.     CASE 32
  83.         DIM Video32(Frames) AS LONG
  84.         Video32(0) = 60 / Rate
  85.         FOR Create_all_frames = 1 TO Frames
  86.             SEEK #ch, a_rec(Create_all_frames - 1)
  87.             GET #ch, , icon
  88.             GET #ch, , structure
  89.             REDIM record AS LONG
  90.             Video32(Create_all_frames) = _NEWIMAGE(structure.Image_Width, structure.Image_Height, 32)
  91.             x = -structure.Image_Width / 4
  92.             Y = structure.Image_Height - 1
  93.             _DEST Video32(Create_all_frames)
  94.             CLS
  95.             FOR frm = 1 TO structure.Image_Height * structure.Image_Width * 4
  96.                 GET #ch, , record&
  97.                 PSET (x, Y), record&
  98.                 x = x + 1: IF x >= structure.Image_Width AND x MOD 4 = 0 THEN Y = Y - 1: x = 0
  99.             NEXT frm
  100.         NEXT
  101.         _DEST 0
  102.     CASE ELSE
  103.         PRINT "Support for other than 32 bit ANI i prepare.": SLEEP 2: END
  105. CLOSE #ch
  106.  
  107. '5] Is time for display it:
  108. '--------------------------
  109. SCREEN _NEWIMAGE(800, 600, 32)
  113.     CLS
  114.     showANI Video32(), _MOUSEX, _MOUSEY, structure.Image_Width, structure.Image_Height
  115.     _LIMIT Video32(0)
  116.     _DISPLAY
  118.  
  119. FOR Erase_memory = 1 TO UBOUND(video32)
  120.     _FREEIMAGE Video32(Erase_memory)
  124.  
  125.  
  126. SUB showANI (arr() AS LONG, x, y, Xres, Yres)
  127.     SHARED internalindex0
  128.     IF internalindex0 = 0 THEN internalindex0 = 1
  129.     _PUTIMAGE (x - (Xres / 2), y - (Yres / 2)), arr(internalindex0)
  130.     internalindex0 = internalindex0 + 1: IF internalindex0 > UBOUND(arr) THEN internalindex0 = 1
  132.  
  133. SUB Scan (file AS STRING, text AS STRING, result(), RECORDS) 'Records = number of records, which are searched
  134.     IF _FILEEXISTS(file$) THEN
  135.         g = FREEFILE
  136.         OPEN file$ FOR BINARY AS #g
  137.         content$ = SPACE$(LOF(g))
  138.         GET #g, , content$
  139.         REDIM result(0)
  140.         FOR S = 1 TO LEN(content$)
  141.             num = INSTR(S, content$, text$)
  142.             IF num THEN
  143.                 REDIM _PRESERVE result(i)
  144.                 result(i) = num
  145.                 S = num
  146.                 num = 0
  147.                 i = i + 1
  148.                 IF RECORDS = i THEN EXIT SUB
  149.             END IF
  150.         NEXT S
  151.         CLOSE #g
  152.     ELSE
  153.         PRINT "File "; file$; "not exist.": END
  154.     END IF
  155.     content$ = ""
  157.  
  158.  
Title: Re: Mouse pointers
Post by: bplus on August 23, 2018, 06:47:07 pm
Hi Petr,

This is weird, I have a perpetual circle circling over the screen. Is this OK to run on Windows?

I was hoping to see an animated cursor.

Oh maybe that's it, the animation? Ha! I thought it was stuck processing...
Title: Re: Mouse pointers
Post by: Petr on August 24, 2018, 12:38:03 pm
Hi BPlus,
what you see is not the work of windows, but the result of a program that uses an ANI file that contains just this animated icon. I think it's good to be able to use CUR and ANI files in programs. Soon I will release both versions with the support of 16 color icons. There is bad documentation, so I often have to look for connections. But this is fun for me.
Title: Re: Mouse pointers
Post by: FellippeHeitor on August 24, 2018, 01:22:57 pm
Very good job on this one, Petr. It's similar to what Zom-B did for viewing animated GIF files.

https://qb64.org/wiki/GIF_Images

Do you think you could streamline your code so it'd behave more like a library? Maybe a reduced set of methods like Load, Display, Unload, so that the actual inner workings could be hidden away in a $INCLUDE file? That'd be interesting to have.

I have added Zom-B's code to the next release of InForm. Here's the readme that'll come with Beta 8 showing how to display animated GIFs in a form: https://github.com/FellippeHeitor/InForm/blob/Beta8/InForm/extensions/README%20-%20gifplay.txt

Please see the methods I describe in the document above for an idea of what I mean about your animated cursors code.
Title: Re: Mouse pointers
Post by: Petr on August 24, 2018, 02:58:45 pm
Hi Fellippe,
Yes, I have such an idea. However, it will be necessary to use the BI file at the beginning and the BM at the end due to the input field declarations. Now, during development, I need to get as many CUR and ANI files as possible for thorough testing. It has the following features: Cursor& = LOADCUR ("curfile_name.cur") and then PlayCUR Cursor&,x, y   the same for ANI files. In Inform I'll look at how it's done there.
I could open a detective office literally because it has happened many times that the content that is mentioned in various sources for these files did not correspond to reality.
Of course, the correct placement of the cursor will also be very important.
This version are "direct", but finaly version i write as BI and BM (and then re-testing it in Win and Linux).

I am glad for your reaction.
 
Title: Re: Mouse pointers
Post by: FellippeHeitor on August 24, 2018, 03:06:55 pm
You don't even need to worry about InForm specifics. If it becomes a detachable library, a user of InForm would be able to use it as is, probably.

Again, good investigation job.
Title: Re: Mouse pointers
Post by: Petr on August 26, 2018, 03:58:10 pm
Hi. So you say, make it as easy and user-friendly as possible. I tried it. Here is the result, the same thing I do for CUR files, this here is for ANI files. It supports the 16 color ANI and Truecolor ANI, but I have a few ANI files, that do not work right, so I still do it.
I do not have the speed between frames of the shot correct, but that's exactly what I'm doing now.

Code: QB64: [Select]
  1. '$include:'ani.bi'
  2.  
  3. FileA$ = "coin.ani"
  4. FileB$ = "dinosau2.ani"
  5. FileC$ = "horse.ani"
  6.  
  7. A& = LoadAni(FileA$)
  8. B& = LoadAni(FileB$)
  9. C& = LoadAni(FileC$)
  10.  
  11. SCREEN _NEWIMAGE(800, 600, 32)
  12. 'program know playing ANIs and EXTRACT FRAMES from ANI:
  13.  
  14. FOR Extract = 1 TO FrameAni(A&) '               function return number frames in file
  15.     Image& = ExtractAni(A&, Extract) '          function return decoded image
  16.     _PUTIMAGE (50 + Extract * 50, 100), Image&
  17. NEXT Extract
  19. 'this is just option, normal you need not, but it is here for you.
  20.  
  21.  
  24.     PCOPY 1, _DISPLAY
  25.     PutAni A&, 100, 200
  26.     PutAni B&, 300, 500
  28.     PutAni C&, _MOUSEX, _MOUSEY
  29.     _DISPLAY
  30.     _LIMIT 20
  33.  
  34. FreeAni A& 'clear it from memory
  35. FreeAni B&
  36. FreeAni C&
  37.  
  38. '$include:'ani.bm'
  39.  
Title: Re: Mouse pointers
Post by: FellippeHeitor on August 26, 2018, 04:53:03 pm
Nice, Petr!

Quote from: Petr on August 26, 2018, 03:58:10 pm
I do not have the speed between frames of the shot correct, but that's exactly what I'm doing now.

Maybe you'll need to keep track of the last time a frame is served, store TIMER for reference, and only serve a new frame after that frame's delay is reached.
Title: Re: Mouse pointers
Post by: Petr on August 31, 2018, 03:50:40 pm
Hi all,
This version is beta. If some CUR or ANI file is not displayed correctly, send it here and i look at it.Program allow using CUR (static mouse cursors) or ANI (animated mouse cursors), extracting frames from ANI and do some experiments.
Usage:
CursorA& = LOADCURSOR("Cursor.cur")
CursorsB& = LOADCURSOR("CursorB.ani")
load cursors to memory. If CursorA& or CursorB& return -1, is something wrong (file not exist?)

For inserting it to screen use PUTCURSOR CursorA&, coordinate X, coordinate Y
For erase it from memory use FREECURSOR CursorB&

If loaded cursor is ANI file, you can extract frames:
LENCURSOR return number of frames in ANI file, DECOMPOSECURSOR (source&, frame_number) return image.

So is possible easy all frames view:

For Show = 1 to LENCURSOR(CursorA&)
Image& = DECOMPOSECURSOR(Show)
_PUTIMAGE (100,100), image&,0
SLEEP
NEXT

If you call LENCURSOR or DECOMPOSECURSOR to CUR file, it return always -1 as error code.

In attachment is BAS file, BI file, BM file and folder CURSORS contains all CUR and ANI files, on which i test this program. So if you found some, which is not right displayed, please send it
here. Thank you.




Text Only | Text with Attachments