|
|
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
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
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
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 |
|
