Probably not, I think there are more recent versions of fbpng (which saves and loads PNGs into FB.Image buffers, and can be used on both Windows and Linux). Here is the thread for the project; you can download it, along with examples and documentation, from there.
http://www.freebasic.net/forum/viewtopic.php?t=8024
PNG SCREENshot function
-
notthecheatr
- Posts: 1759
- Joined: May 23, 2007 21:52
- Location: Cut Bank, MT
- Contact:
-
counting_pine
- Site Admin
- Posts: 6323
- Joined: Jul 05, 2005 17:32
- Location: Manchester, Lancs
It's been a while since I wrote this. If I were to write it again from scratch, I'd probably do it differently now.
But it still works quite well, apart from the Next typos.
Anyway, I've updated it a little. Now it allows the saving of FB Images, and optionally saves the alpha channel as well.
And obviously, I've removed the silly Next typos as well.
But it still works quite well, apart from the Next typos.
Anyway, I've updated it a little. Now it allows the saving of FB Images, and optionally saves the alpha channel as well.
And obviously, I've removed the silly Next typos as well.
Code: Select all
#include "zlib.bi"
declare function savepng( _
byref filename as string = "screenshot.png", _
byval image as any ptr = 0, _
byval save_alpha as integer = 0) as integer
const PNG_HEADER as string = !"\137PNG\r\n\26\n"
const IHDR_CRC0 as uinteger = &ha8a1ae0a 'crc32(0, @"IHDR", 4)
const PLTE_CRC0 as uinteger = &h4ba88955 'crc32(0, @"PLTE", 4)
const IDAT_CRC0 as uinteger = &h35af061e 'crc32(0, @"IDAT", 4)
const IEND_CRC0 as uinteger = &hae426082 'crc32(0, @"IEND", 4)
type struct_ihdr field = 1
width as uinteger
height as uinteger
bitdepth as ubyte
colortype as ubyte
compression as ubyte
filter as ubyte
interlace as ubyte
end type
const IHDR_SIZE as uinteger = sizeof( struct_ihdr )
function bswap(byval n as uinteger) as uinteger
return (n and &h000000ff) shl 24 or _
(n and &h0000ff00) shl 8 or _
(n and &h00ff0000) shr 8 or _
(n and &hff000000) shr 24
end function
function savepng( _
byref filename as string = "screenshot.png", _
byval image as any ptr = 0, _
byval save_alpha as integer = 0) as integer
dim as uinteger w, h, depth
dim as integer f = freefile()
dim as integer e
if image <> 0 then
if imageinfo( image, w, h, depth ) < 0 then return -1
depth *= 8
else
if screenptr = 0 then return -1
screeninfo( w, h, depth )
end if
if depth <> 32 then save_alpha = 0
select case as const depth
case 1 to 8
scope
dim ihdr as struct_ihdr = (bswap(w), bswap(h), 8, 3, 0, 0, 0)
dim as uinteger ihdr_crc32 = crc32(IHDR_CRC0, cptr(ubyte ptr, @ihdr), sizeof(ihdr))
dim palsize as uinteger = 1 shl depth
dim pltesize as uinteger = palsize * 3
dim plte(0 to 767) as ubyte
dim plte_crc32 as uinteger
dim as uinteger l = w + 1
dim as uinteger imgsize = l * h
dim as uinteger idatsize = imgsize + 11 + 5 * (imgsize \ 16383)
dim imgdata(0 to imgsize - 1) as ubyte
dim idat(0 to idatsize - 1) as ubyte
dim as uinteger idat_crc32
dim as uinteger x, y, col, r, g, b
dim as uinteger index
index = 0
for col = 0 to palsize - 1
palette get col, r, g, b
plte(index) = r : index += 1
plte(index) = g : index += 1
plte(index) = b : index += 1
next col
plte_crc32 = crc32(PLTE_CRC0, @plte(0), pltesize)
index = 0
if image <> 0 then
for y = 0 to h - 1
imgdata(index) = 0 : index += 1
for x = 0 to w - 1
col = point(x, y, image)
imgdata(index) = col : index += 1
next x
next y
else
screenlock
for y = 0 to h - 1
imgdata(index) = 0 : index += 1
for x = 0 to w - 1
col = point(x, y)
imgdata(index) = col : index += 1
next x
next y
screenunlock
end if
if compress2(@idat(0), @idatsize, @imgdata(0), imgsize, 9) then return -1
idat_crc32 = crc32(IDAT_CRC0, @idat(0), idatsize)
if open (filename for output as #f) then return -1
e = put( #f, 1, PNG_HEADER )
e orelse= put( #f, , bswap(IHDR_SIZE) )
e orelse= put( #f, , "IHDR" )
e orelse= put( #f, , ihdr )
e orelse= put( #f, , bswap(ihdr_crc32) )
e orelse= put( #f, , bswap(pltesize) )
e orelse= put( #f, , "PLTE" )
e orelse= put( #f, , plte(0), 3 * (1 shl depth) )
e orelse= put( #f, , bswap(plte_crc32) )
e orelse= put( #f, , bswap(idatsize) )
e orelse= put( #f, , "IDAT" )
e orelse= put( #f, , idat(0), idatsize )
e orelse= put( #f, , bswap(idat_crc32) )
e orelse= put( #f, , bswap(0) )
e orelse= put( #f, , "IEND" )
e orelse= put( #f, , bswap(IEND_CRC0) )
close #f
return e
end scope
case 9 to 32
scope
dim ihdr as struct_ihdr = (bswap(w), bswap(h), 8, iif( save_alpha, 6, 2), 0, 0, 0)
dim as uinteger ihdr_crc32 = crc32(IHDR_CRC0, cptr(ubyte ptr, @ihdr), sizeof(ihdr))
dim as uinteger l = iif(save_alpha, (w * 4) + 1, (w * 3) + 1)
dim as uinteger imgsize = l * h
dim as uinteger idatsize = imgsize + 11 + 5 * (imgsize \ 16383)
dim imgdata(0 to imgsize - 1) as ubyte
dim idat(0 to idatsize - 1) as ubyte
dim as uinteger idat_crc32
dim as uinteger x, y, col, r, g, b, a
dim as uinteger index
dim as integer ret
index = 0
if image <> 0 then
for y = 0 to h - 1
imgdata(index) = 0 : index += 1
for x = 0 to w - 1
col = point(x, y, image)
r = col shr 16 and 255
g = col shr 8 and 255
b = col and 255
imgdata(index) = r : index += 1
imgdata(index) = g : index += 1
imgdata(index) = b : index += 1
if save_alpha then
a = col shr 24
imgdata(index) = a : index += 1
end if
next x
next y
else
screenlock
for y = 0 to h - 1
imgdata(index) = 0 : index += 1
for x = 0 to w - 1
col = point(x, y)
r = col shr 16 and 255
g = col shr 8 and 255
b = col and 255
imgdata(index) = r : index += 1
imgdata(index) = g : index += 1
imgdata(index) = b : index += 1
if save_alpha then
a = col shr 24
imgdata(index) = a : index += 1
end if
next x
next y
screenunlock
end if
if compress2(@idat(0), @idatsize, @imgdata(0), imgsize, 9) then return -1
idat_crc32 = crc32(IDAT_CRC0, @idat(0), idatsize)
if open (filename for output as #f) then return -1
e = put( #f, 1, PNG_HEADER )
e orelse= put( #f, , bswap(IHDR_SIZE) )
e orelse= put( #f, , "IHDR" )
e orelse= put( #f, , ihdr )
e orelse= put( #f, , bswap(ihdr_crc32) )
e orelse= put( #f, , bswap(idatsize) )
e orelse= put( #f, , "IDAT" )
e orelse= put( #f, , idat(0), idatsize )
e orelse= put( #f, , bswap(idat_crc32) )
e orelse= put( #f, , bswap(0) )
e orelse= put( #f, , "IEND" )
e orelse= put( #f, , bswap(IEND_CRC0) )
close #f
return e
end scope
case else
return -1
end select
end function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
screenres 320, 200, 32
dim as any ptr p = imagecreate(64, 48)
dim as string filename = "screenshot.png"
for y as integer = 0 to 47: var y2 = (y * 256) \ 48
for x as integer = 0 to 63: var x2 = (x * 256) \ 64
pset p, (x, y), (x2 * y2 or y2 shl 8 or x2 shl 16 or y2 shl 24)
next x
next y
put (10, 10), p
if savepng( filename, p, 1 ) = 0 then
print "Image saved to " & filename
else
print "There was a problem saving the image."
end if
imagedestroy p
sleep
Last edited by counting_pine on Sep 09, 2008 17:25, edited 1 time in total.
counting_pine wrote:
:-)In a sudden fit of spontaneousnessness, I decided to create a function to save screenshots in PNG format; basically it's a PNG version of bsave.
Of course not. It produces, like Ext-Lib of Sir_Mud, simple valid PNG's, using "filter 0". Maximal PNG optimization is a much harder work (find best filter, optimize the deflate, reduce bitdepth if possible).agamemnus wrote:Is this currently the latest in PNG technology?
Missed one ?notthecheatr wrote:more recent versions of fbpng (which saves and loads PNGs into FB.Image buffers, and can be used on both Windows and Linux
Anyway, tested counting_pine's code on DOS, after minor adjustments ("screenres 113, 115, 32" -> "screenres 640, 480, 32", "screenshot.png" -> "SHOT.PNG") it works. :-)
However the example image drawn and saved is very "bad" :
- counting_pine's PNG size: 10'996 bytes (f0)
- optimized PNG size: 1'549 bytes (f5)
- uncompressed BMP size: 12'342 bytes
-
counting_pine
- Site Admin
- Posts: 6323
- Joined: Jul 05, 2005 17:32
- Location: Manchester, Lancs