203 lines
6.3 KiB
Text
203 lines
6.3 KiB
Text
|
|
sub savebinaryppm (imagehandle as long,filename as string)
|
|
dim r as _unsigned _byte
|
|
dim g as _unsigned _byte
|
|
dim b as _unsigned _byte
|
|
dim filehandle as integer
|
|
dim w as _unsigned long
|
|
dim h as _unsigned long
|
|
dim head as string
|
|
dim fileout as string
|
|
dim image as _mem
|
|
dim filebuffer as _mem
|
|
dim inposition as _offset
|
|
dim outposition as _offset
|
|
dim length as _offset
|
|
image=_memimage(imagehandle)
|
|
inposition=image.offset
|
|
w=_width(imagehandle)
|
|
h=_height(imagehandle)
|
|
length=inposition+w*h*4
|
|
head="P6"+chr$(10)
|
|
head=head+"# Created with Pixler"+chr$(10)
|
|
head=head+ltrim$(str$(w)+str$(h))+chr$(10)
|
|
head=head+"255"+chr$(10)
|
|
filebuffer=_memnew(w*h*3)
|
|
outposition=filebuffer.offset
|
|
do
|
|
b=_memget(image,inposition,_unsigned _byte)
|
|
g=_memget(image,inposition+1,_unsigned _byte)
|
|
r=_memget(image,inposition+2,_unsigned _byte)
|
|
_memput filebuffer,outposition,r as _unsigned _byte
|
|
_memput filebuffer,outposition+1,g as _unsigned _byte
|
|
_memput filebuffer,outposition+2,b as _unsigned _byte
|
|
inposition=inposition+4
|
|
outposition=outposition+3
|
|
loop until inposition=length
|
|
fileout=space$(w*h*3)
|
|
_memget filebuffer,filebuffer.offset,fileout
|
|
filehandle=freefile
|
|
open filename for binary as filehandle
|
|
put filehandle,,head
|
|
put filehandle,,fileout
|
|
close filehandle
|
|
_memfree image
|
|
_memfree filebuffer
|
|
end sub
|
|
|
|
sub save24bitbmp (imagehandle as long,filename as string)
|
|
dim osource as long
|
|
dim ff as long
|
|
dim x as long,y as long
|
|
dim header as string*54
|
|
dim outbytes as string*3
|
|
dim padding as string
|
|
osource=_source
|
|
_source imagehandle
|
|
|
|
header="BM"+mkl$(_width*_height*3+54)+_
|
|
string$(4,0)+mkl$(54)+mkl$(40)+_
|
|
mkl$(_width)+mkl$(_height)+_
|
|
mki$(1)+mki$(24)+mkl$(0)+mkl$(0)+_
|
|
mkl$(11811)+mkl$(11811)+mkl$(0)+mkl$(0)
|
|
|
|
if ((_width*3) mod 4) then padding$=string$(4-((_width*3) mod 4),0)
|
|
|
|
ff=freefile
|
|
open filename for binary as ff
|
|
put ff,,header
|
|
for y=_height-1 to 0 step -1
|
|
for x=0 to _width-1
|
|
outbytes=left$(mkl$(point(x,y)),3)
|
|
put #ff,,outbytes
|
|
next
|
|
put #ff,,padding
|
|
next
|
|
close ff
|
|
_source osource
|
|
end sub
|
|
|
|
sub save8bitpng (imagehandle as long,filename as string)
|
|
dim pngheader as string
|
|
dim ihdr as string
|
|
dim idat as string
|
|
dim iend as string
|
|
dim plte as string
|
|
dim x as _unsigned long,y as _unsigned long
|
|
dim colorvalue as _unsigned long
|
|
dim chunksize as string
|
|
dim ff as long
|
|
dim imagedata as string
|
|
dim sourcemem as _mem
|
|
dim c as _unsigned _byte
|
|
sourcemem=_memimage(imagehandle)
|
|
pngheader=chr$(137)+"PNG"+chr$(13)+chr$(10)+chr$(26)+chr$(10)
|
|
ihdr="IHDR"+mkl$(flipbytes(_width(imagehandle)))+mkl$(flipbytes(_height(imagehandle)))+chr$(8)+chr$(3)+string$(3,0)
|
|
ihdr=mkl$(flipbytes(&h0d))+ihdr+mkl$(flipbytes(crc32(ihdr)))
|
|
iend=mkl$(0)+"IEND"+mkl$(flipbytes(&hae426082))
|
|
plte="PLTE"
|
|
for c=0 to 255
|
|
plte=plte+chr$(_red32(_palettecolor(c)))
|
|
plte=plte+chr$(_green32(_palettecolor(c)))
|
|
plte=plte+chr$(_blue32(_palettecolor(c)))
|
|
next
|
|
plte=mkl$(flipbytes(256*3))+plte+mkl$(flipbytes(crc32(plte)))
|
|
|
|
imagedata=string$(_height(imagehandle)*_width(imagehandle)+_height(imagehandle),0)
|
|
|
|
for y=0 to _height(imagehandle)-1
|
|
for x=0 to _width(imagehandle)-1
|
|
c=_memget(sourcemem,sourcemem.offset+bytecount+0,_unsigned _byte)
|
|
asc(imagedata,bytecount+y+2)=c
|
|
bytecount=bytecount+1
|
|
next x
|
|
next y
|
|
_memfree sourcemem
|
|
idat=_deflate$(imagedata)
|
|
chunksize=mkl$(flipbytes(len(idat)))
|
|
idat="IDAT"+idat
|
|
idat=idat+mkl$(flipbytes(crc32(idat)))
|
|
idat=chunksize+idat
|
|
ff=freefile
|
|
open filename for output as ff:close ff
|
|
open filename for binary as ff
|
|
put ff,,pngheader
|
|
put ff,,ihdr
|
|
put ff,,plte
|
|
put ff,,idat
|
|
put ff,,iend
|
|
close ff
|
|
end sub
|
|
|
|
sub save32bitpng (imagehandle as long,filename as string)
|
|
dim pngheader as string
|
|
dim ihdr as string
|
|
dim idat as string
|
|
dim iend as string
|
|
dim x as _unsigned long,y as _unsigned long
|
|
dim colorvalue as _unsigned long
|
|
dim chunksize as string
|
|
dim ff as long
|
|
dim imagedata as string
|
|
dim sourcemem as _mem
|
|
dim as _unsigned _byte r,g,b
|
|
sourcemem=_memimage(imagehandle)
|
|
pngheader=chr$(137)+"PNG"+chr$(13)+chr$(10)+chr$(26)+chr$(10)
|
|
ihdr="IHDR"+mkl$(flipbytes(_width(imagehandle)))+mkl$(flipbytes(_height(imagehandle)))+chr$(8)+chr$(6)+string$(3,0)
|
|
ihdr=mkl$(flipbytes(&h0d))+ihdr+mkl$(flipbytes(crc32(ihdr)))
|
|
iend=mkl$(0)+"IEND"+mkl$(flipbytes(&hae426082))
|
|
imagedata=string$(_height(imagehandle)*_width(imagehandle)*4+_height(imagehandle),0)
|
|
|
|
for y=0 to _height(imagehandle)-1
|
|
for x=0 to _width(imagehandle)-1
|
|
b=_memget(sourcemem,sourcemem.offset+bytecount+0,_unsigned _byte)
|
|
g=_memget(sourcemem,sourcemem.offset+bytecount+1,_unsigned _byte)
|
|
r=_memget(sourcemem,sourcemem.offset+bytecount+2,_unsigned _byte)
|
|
a=_memget(sourcemem,sourcemem.offset+bytecount+3,_unsigned _byte)
|
|
|
|
asc(imagedata,bytecount+y+2)=r
|
|
asc(imagedata,bytecount+y+3)=g
|
|
asc(imagedata,bytecount+y+4)=b
|
|
asc(imagedata,bytecount+y+5)=a
|
|
bytecount=bytecount+4
|
|
next x
|
|
next y
|
|
_memfree sourcemem
|
|
idat=_deflate$(imagedata)
|
|
chunksize=mkl$(flipbytes(len(idat)))
|
|
idat="IDAT"+idat
|
|
idat=idat+mkl$(flipbytes(crc32(idat)))
|
|
idat=chunksize+idat
|
|
ff=freefile
|
|
open filename for output as ff:close ff
|
|
open filename for binary as ff
|
|
put ff,,pngheader
|
|
put ff,,ihdr
|
|
put ff,,idat
|
|
put ff,,iend
|
|
close ff
|
|
end sub
|
|
|
|
function flipbytes~& (value as _unsigned long)
|
|
flipbytes~&=(value \ 16777216)_
|
|
or (value*16777216)_
|
|
or ((value and 16711680) \ 256)_
|
|
or ((value and 65280)*256)
|
|
end function
|
|
|
|
function crc32~& (in$)
|
|
dim as _unsigned long crc32_poly,crc
|
|
crc32_poly=&hedb88320
|
|
crc=&hffffffff
|
|
for i=1 to len(in$)
|
|
crc=crc xor asc(in$,i)
|
|
for j=1 to 8
|
|
if crc and 1 then
|
|
crc=(crc \ 2) xor crc32_poly
|
|
else
|
|
crc=crc \ 2
|
|
end if
|
|
next j
|
|
next i
|
|
crc32~&=not crc
|
|
end function
|