|
Post by aurelvz on Jun 26, 2023 18:49:11 GMT
if you want to load PNG images in any windows system then easy way is to use GDI+ api functions.
|
|
|
Post by bplus on Jun 26, 2023 19:21:48 GMT
if you want to load PNG images in any windows system then easy way is to use GDI+ api functions. What could possibly be easier than myImage& = _LoadImage("MyImageFile.png") The trick is to save just the right part of an image to a .png file so it can be loaded the above way.
|
|
Aaditya Parashar
Full Member
![*](//storage.proboards.com/forum/images/stars/star.png) ![*](//storage.proboards.com/forum/images/stars/star.png)
Just somebody with an abnormal coding routine.
Posts: 124
|
Post by Aaditya Parashar on Jul 12, 2023 11:36:54 GMT
New Subroutine for ico files!
|
|
|
Post by bplus on Jul 13, 2023 0:52:56 GMT
Aaditya Parashar Do you have some demos for that? Saving a PNG is different now, a function instead of a sub and needs a 3rd argument that is unknown to me. Feel free to use code from the 9th post in thread (June 24 3:28) testing the Save Image code for PNG.
|
|
Aaditya Parashar
Full Member
![*](//storage.proboards.com/forum/images/stars/star.png) ![*](//storage.proboards.com/forum/images/stars/star.png)
Just somebody with an abnormal coding routine.
Posts: 124
|
Post by Aaditya Parashar on Jul 13, 2023 13:24:19 GMT
Here you go:
a& = _NewImage(640,480,32) _Dest a& Cls , _RGB32(0,127,255) _Dest 0 tmp = PNG32("test.png", a&, PNGDATA$) 'saves to test.png 'you can save PNGDATA$ to a new PNG file tmp = PNG32("", a&, PNGDATA$) 'does not save to any file f = FreeFile Open "test2.png" For Binary As #f Put #f, , PNGDATA$ 'may be useful to copy the same png to many files Close
'icon files ICO32 "test.ico", a& System '$Include:'image.bm' New Syntax: Return_Code = PNG32([File Name], [Image Handle], [PNG File Contents]) Return Codes: 0 - File Saving Unsuccessful or when File Name is not given (an empty string) 1 - File Saved Successfully
|
|
|
Post by bplus on Jul 13, 2023 14:11:10 GMT
Aaditya Parashar Thankyou very much! That cleared things up fast! So PNGDATE$ is just an an extra output from the Function to save further copies, OK. I like how easy it is to make an an ico file and how brief this code is to my previous image saving code. next test is to see how QB64 likes those .ico's.
|
|
Aaditya Parashar
Full Member
![*](//storage.proboards.com/forum/images/stars/star.png) ![*](//storage.proboards.com/forum/images/stars/star.png)
Just somebody with an abnormal coding routine.
Posts: 124
|
Post by Aaditya Parashar on Jun 25, 2024 4:48:44 GMT
New Update: 4 times faster Function PNG32 (__FILENAME As String, __IMAGE As Long, __PNGDATA As String) Dim As String __PNGHEADER, __IHDR, __IDAT, __IMAGDATA, __IEND Dim As String __EXT Dim As Long __WIDTH, __HEIGHT, __F, __SOURCE, __OFFSET, __X, __Y, __P __PNGHEADER = MKL$(&H474E5089) + MKL$(&H0A1A0A0D) __WIDTH = _Width(__IMAGE): __HEIGHT = _Height(__IMAGE) __IHDR = "IHDR" + ReverseMKL$(__WIDTH) + ReverseMKL$(__HEIGHT) + MKI$(&H0608) + String$(3, 0) __IMAGDATA = String$((__HEIGHT + 1) * __WIDTH * 4, 0) __OFFSET = 1 __SOURCE = _Source _Source __IMAGE For __Y = 0 To __HEIGHT - 1 __OFFSET = __OFFSET + 1 For __X = 0 To __WIDTH - 1 __P = Point(__X, __Y) Asc(__IMAGDATA, __OFFSET) = _SHR(__P, 16) Asc(__IMAGDATA, __OFFSET + 1) = _SHR(__P, 8) Asc(__IMAGDATA, __OFFSET + 2) = __P Asc(__IMAGDATA, __OFFSET + 3) = _SHR(__P, 24) __OFFSET = __OFFSET + 4 Next __X Next __Y _Source __SOURCE __IDAT = "IDAT" + _Deflate$(__IMAGDATA) __PNGDATA = __PNGHEADER + ReverseMKL$(&H0D) + __IHDR + ReverseMKL$(crc32~&(__IHDR)) + ReverseMKL$(Len(__IDAT) - 4) + __IDAT + ReverseMKL$(crc32~&(__IDAT)) + String$(4, 0) + "IEND" + MKL$(&H826042AE) If Len(__FILENAME) Then __F = FreeFile If _StriCmp(Right$(__FILENAME, 4), ".png") Then __EXT = ".png" Else __EXT = "" If _FileExists(__FILENAME + __EXT) Then Kill __FILENAME + __EXT Open __FILENAME + __EXT For Binary As #__F Put #__F, , __PNGDATA Close #__F End If If _FileExists(__FILENAME) Then PNG32 = -1 Else PNG32 = 0 End Function Function PNG (__FILENAME As String, __IMAGE As Long, __PNGDATA As String) Dim As String __PNGHEADER, __IHDR, __IDAT, __IMAGDATA, __IEND Dim As String __EXT Dim As Long __WIDTH, __HEIGHT, __F, __SOURCE, __OFFSET, __X, __Y, __P __PNGHEADER = MKL$(&H474E5089) + MKL$(&H0A1A0A0D) __WIDTH = _Width(__IMAGE): __HEIGHT = _Height(__IMAGE) __IHDR = "IHDR" + ReverseMKL$(__WIDTH) + ReverseMKL$(__HEIGHT) + MKI$(&H0208) + String$(3, 0) __IMAGDATA = String$((__HEIGHT + 1) * __WIDTH * 3, 0) __OFFSET = 1 __SOURCE = _Source _Source __IMAGE For __Y = 0 To __HEIGHT - 1 __OFFSET = __OFFSET + 1 For __X = 0 To __WIDTH - 1 __P = Point(__X, __Y) Asc(__IMAGDATA, __OFFSET) = __P Asc(__IMAGDATA, __OFFSET + 1) = _SHR(__P, 16) Asc(__IMAGDATA, __OFFSET + 2) = _SHR(__P, 8) __OFFSET = __OFFSET + 3 Next __X Next __Y _Source __SOURCE __IDAT = "IDAT" + _Deflate$(__IMAGDATA) __PNGDATA = __PNGHEADER + ReverseMKL$(&H0D) + __IHDR + ReverseMKL$(crc32~&(__IHDR)) + ReverseMKL$(Len(__IDAT) - 4) + __IDAT + ReverseMKL$(crc32~&(__IDAT)) + String$(4, 0) + "IEND" + MKL$(&H826042AE) If Len(__FILENAME) Then __F = FreeFile If _StriCmp(Right$(__FILENAME, 4), ".png") Then __EXT = ".png" Else __EXT = "" If _FileExists(__FILENAME + __EXT) Then Kill __FILENAME + __EXT Open __FILENAME + __EXT For Binary As #__F Put #__F, , __PNGDATA Close #__F End If If _FileExists(__FILENAME) Then PNG = -1 Else PNG = 0 End Function Function PNG0 (__FILENAME As String, __IMAGE As Long, __PNGDATA As String) Dim As String __PNGHEADER, __IHDR, __IDAT, __IMAGDATA, __IEND Dim As String __EXT Dim As Long __WIDTH, __HEIGHT, __F, __SOURCE, __OFFSET, __X, __Y, __P __PNGHEADER = MKL$(&H474E5089) + MKL$(&H0A1A0A0D) __WIDTH = _Width(__IMAGE): __HEIGHT = _Height(__IMAGE) __IHDR = "IHDR" + ReverseMKL$(__WIDTH) + ReverseMKL$(__HEIGHT) + MKI$(&H08) + String$(3, 0) __IMAGDATA = String$((__HEIGHT + 1) * __WIDTH, 0) __OFFSET = 1 __SOURCE = _Source _Source __IMAGE For __Y = 0 To __HEIGHT - 1 __OFFSET = __OFFSET + 1 For __X = 0 To __WIDTH - 1 __P = Point(__X, __Y) Asc(__IMAGDATA, __OFFSET) = (_SHR(__P, 24) + _SHR(__P, 16) + _SHR(__P, 8)) \ 3 __OFFSET = __OFFSET + 1 Next __X Next __Y _Source __SOURCE __IDAT = "IDAT" + _Deflate$(__IMAGDATA) __PNGDATA = __PNGHEADER + ReverseMKL$(&H0D) + __IHDR + ReverseMKL$(crc32~&(__IHDR)) + ReverseMKL$(Len(__IDAT) - 4) + __IDAT + ReverseMKL$(crc32~&(__IDAT)) + String$(4, 0) + "IEND" + MKL$(&H826042AE) If Len(__FILENAME) Then __F = FreeFile If _StriCmp(Right$(__FILENAME, 4), ".png") Then __EXT = ".png" Else __EXT = "" If _FileExists(__FILENAME + __EXT) Then Kill __FILENAME + __EXT Open __FILENAME + __EXT For Binary As #__F Put #__F, , __PNGDATA Close #__F End If If _FileExists(__FILENAME) Then PNG0 = -1 Else PNG0 = 0 End Function Sub ICO32 (__FILENAME As String, __IMAGE As Long) Dim As Long __NEWIMAGE, __WIDTH, __HEIGHT, __DEST __WIDTH = _Width(__IMAGE) __HEIGHT = _Height(__IMAGE) If __WIDTH > 256 Then __WIDTH = 256 If __HEIGHT > 256 Then __HEIGHT = 256 __NEWIMAGE = _NewImage(__WIDTH, __HEIGHT, 32) __DEST = _Dest _Dest __NEWIMAGE _PutImage (0, 0)-(__WIDTH - 1, __HEIGHT - 1), __IMAGE _Dest __DEST Dim As String __ICO, __PNGDATA, __EXT __T = PNG32("", __NEWIMAGE, __PNGDATA) _FreeImage __NEWIMAGE If __WIDTH = 256 Then __WIDTH = 0 If __HEIGHT = 256 Then __HEIGHT = 0 __ICO = MKI$(0) + MKI$(1) + MKI$(1) + Chr$(__WIDTH) + Chr$(__HEIGHT) + MKI$(0) + MKI$(1) + MKI$(32) + MKL$(Len(__PNGDATA)) __ICO = __ICO + MKL$(Len(__ICO) + 4) + __PNGDATA __F = FreeFile If LCase$(Right$(__FILENAME, 4)) <> ".ico" Then __EXT = ".ico" Else __EXT = "" Open __FILENAME + __EXT For Output As #__F: Close #__F Open __FILENAME + __EXT For Binary As #__F Put #__F, , __ICO Close #__F End Sub Function ReverseMKL$ (__L~&) Dim __RMKL As String __RMKL = String$(4, 0) Asc(__RMKL, 1) = _SHR(__L~&, 24) Asc(__RMKL, 2) = _SHR(__L~&, 16) Asc(__RMKL, 3) = _SHR(__L~&, 8) Asc(__RMKL, 4) = __L~& ReverseMKL$ = __RMKL End Function Function crc32~& (__IN$) Dim As _Unsigned Long __CRC32_POLY, __CRC, __I Dim As _Unsigned _Byte __J __CRC32_POLY = &HEDB88320 __CRC = &HFFFFFFFF For __I = 1 To Len(__IN$) __CRC = __CRC Xor Asc(__IN$, __I) If __CRC And 1 Then __CRC = _SHR(__CRC, 1) Xor __CRC32_POLY Else __CRC = _SHR(__CRC, 1) If __CRC And 1 Then __CRC = _SHR(__CRC, 1) Xor __CRC32_POLY Else __CRC = _SHR(__CRC, 1) If __CRC And 1 Then __CRC = _SHR(__CRC, 1) Xor __CRC32_POLY Else __CRC = _SHR(__CRC, 1) If __CRC And 1 Then __CRC = _SHR(__CRC, 1) Xor __CRC32_POLY Else __CRC = _SHR(__CRC, 1) If __CRC And 1 Then __CRC = _SHR(__CRC, 1) Xor __CRC32_POLY Else __CRC = _SHR(__CRC, 1) If __CRC And 1 Then __CRC = _SHR(__CRC, 1) Xor __CRC32_POLY Else __CRC = _SHR(__CRC, 1) If __CRC And 1 Then __CRC = _SHR(__CRC, 1) Xor __CRC32_POLY Else __CRC = _SHR(__CRC, 1) If __CRC And 1 Then __CRC = _SHR(__CRC, 1) Xor __CRC32_POLY Else __CRC = _SHR(__CRC, 1) Next __I crc32~& = Not __CRC End Function Sub BMP (__filename As String, __image As Long) 'Code by Galleon __x& = _Width(__image) __y& = _Height(__image) __H$ = "BM????QB64????" + Chr$(&H7C) + String$(3, 0) + MKL$(__x&) + MKL$(__y&) + Chr$(&H01) + Chr$(0) + Chr$(&H20) + Chr$(0) + Chr$(&H03) + MKL$(0) + Chr$(&H8C) + Chr$(&H0A) + Chr$(0) + Chr$(&H13) + Chr$(&H0B) + MKI$(0) + Chr$(&H13) + Chr$(&H0B) + String$(12, 0) + Chr$(&HFF) + MKI$(0) + Chr$(&HFF) + MKI$(0) + Chr$(&HFF) + String$(6, 0) + Chr$(&HFF) + "BGRs" + String$(48, 0) + Chr$(&H02) + String$(15, 0) Mid$(__H$, 11, 4) = MKL$(Len(__H$)) __lastsource& = _Source _Source __image& __D$ = Space$(__x& * __y& * 4) For __py& = 0 To __y& - 1 Step 1 ' read JPG image pixel color data __R$ = Space$(__x& * 4) For __px& = 0 To __x& - 1 Mid$(__R$, __px& * 4 + 1, 4) = MKL$(Point(__px&, __py&)) Next __px& Mid$(__D$, (__y& - __py& - 1) * __x& * 4 + 1, __x& * 4) = __R$ Next __py& _Source l__astsource& Mid$(__H$, 35, 4) = MKL$(Len(__D$)) __B$ = __H$ + __D$ ' total file data bytes to create file Mid$(__B$, 3, 4) = MKL$(Len(__B$)) If LCase$(Right$(__filename, 4)) <> ".bmp" Then __ext$ = ".bmp" __f& = FreeFile Open __filename + __ext$ For Output As __f&: Close __f& ' erases an existing file Open __filename + __ext$ For Binary As __f& Put __f&, , __B$ Close __f& End Sub
|
|