mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-12 09:29:07 +02:00
+ Added ditheres and quantizers by Giulio Bernardi
git-svn-id: trunk@1184 -
This commit is contained in:
michael
parent
2f011934ef
commit
3043828803
3
.gitattributes
vendored
3
.gitattributes
vendored
@ -733,7 +733,9 @@ fcl/image/fpcanvas.inc svneol=native#text/plain
|
|||||||
fcl/image/fpcanvas.pp svneol=native#text/plain
|
fcl/image/fpcanvas.pp svneol=native#text/plain
|
||||||
fcl/image/fpcdrawh.inc svneol=native#text/plain
|
fcl/image/fpcdrawh.inc svneol=native#text/plain
|
||||||
fcl/image/fpcolcnv.inc svneol=native#text/plain
|
fcl/image/fpcolcnv.inc svneol=native#text/plain
|
||||||
|
fcl/image/fpcolhash.pas svneol=native#text/plain
|
||||||
fcl/image/fpcolors.inc svneol=native#text/plain
|
fcl/image/fpcolors.inc svneol=native#text/plain
|
||||||
|
fcl/image/fpditherer.pas svneol=native#text/plain
|
||||||
fcl/image/fpfont.inc svneol=native#text/plain
|
fcl/image/fpfont.inc svneol=native#text/plain
|
||||||
fcl/image/fphandler.inc svneol=native#text/plain
|
fcl/image/fphandler.inc svneol=native#text/plain
|
||||||
fcl/image/fphelper.inc svneol=native#text/plain
|
fcl/image/fphelper.inc svneol=native#text/plain
|
||||||
@ -746,6 +748,7 @@ fcl/image/fpmake.pp svneol=native#text/plain
|
|||||||
fcl/image/fppalette.inc svneol=native#text/plain
|
fcl/image/fppalette.inc svneol=native#text/plain
|
||||||
fcl/image/fppen.inc svneol=native#text/plain
|
fcl/image/fppen.inc svneol=native#text/plain
|
||||||
fcl/image/fppixlcanv.pp svneol=native#text/plain
|
fcl/image/fppixlcanv.pp svneol=native#text/plain
|
||||||
|
fcl/image/fpquantizer.pas svneol=native#text/plain
|
||||||
fcl/image/fpreadbmp.pp svneol=native#text/plain
|
fcl/image/fpreadbmp.pp svneol=native#text/plain
|
||||||
fcl/image/fpreadjpeg.pas svneol=native#text/plain
|
fcl/image/fpreadjpeg.pas svneol=native#text/plain
|
||||||
fcl/image/fpreadpng.pp svneol=native#text/plain
|
fcl/image/fpreadpng.pp svneol=native#text/plain
|
||||||
|
|||||||
@ -1,5 +1,5 @@
|
|||||||
#
|
#
|
||||||
# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/08/10]
|
# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/09/25]
|
||||||
#
|
#
|
||||||
default: all
|
default: all
|
||||||
MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc i386-wince m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd x86_64-win64 arm-linux arm-wince
|
MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc i386-wince m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd x86_64-win64 arm-linux arm-wince
|
||||||
@ -233,112 +233,112 @@ PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/ext
|
|||||||
override PACKAGE_NAME=fcl
|
override PACKAGE_NAME=fcl
|
||||||
PACKAGEDIR_MAIN:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /fcl/Makefile.fpc,$(PACKAGESDIR))))))
|
PACKAGEDIR_MAIN:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /fcl/Makefile.fpc,$(PACKAGESDIR))))))
|
||||||
ifeq ($(FULL_TARGET),i386-linux)
|
ifeq ($(FULL_TARGET),i386-linux)
|
||||||
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses freetypeh freetype ftfont
|
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer freetypeh freetype ftfont
|
||||||
endif
|
endif
|
||||||
ifeq ($(FULL_TARGET),i386-go32v2)
|
ifeq ($(FULL_TARGET),i386-go32v2)
|
||||||
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses
|
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer
|
||||||
endif
|
endif
|
||||||
ifeq ($(FULL_TARGET),i386-win32)
|
ifeq ($(FULL_TARGET),i386-win32)
|
||||||
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses freetypeh freetype ftfont
|
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer freetypeh freetype ftfont
|
||||||
endif
|
endif
|
||||||
ifeq ($(FULL_TARGET),i386-os2)
|
ifeq ($(FULL_TARGET),i386-os2)
|
||||||
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses
|
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer
|
||||||
endif
|
endif
|
||||||
ifeq ($(FULL_TARGET),i386-freebsd)
|
ifeq ($(FULL_TARGET),i386-freebsd)
|
||||||
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses freetypeh freetype ftfont
|
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer freetypeh freetype ftfont
|
||||||
endif
|
endif
|
||||||
ifeq ($(FULL_TARGET),i386-beos)
|
ifeq ($(FULL_TARGET),i386-beos)
|
||||||
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses
|
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer
|
||||||
endif
|
endif
|
||||||
ifeq ($(FULL_TARGET),i386-netbsd)
|
ifeq ($(FULL_TARGET),i386-netbsd)
|
||||||
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses
|
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer
|
||||||
endif
|
endif
|
||||||
ifeq ($(FULL_TARGET),i386-solaris)
|
ifeq ($(FULL_TARGET),i386-solaris)
|
||||||
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses
|
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer
|
||||||
endif
|
endif
|
||||||
ifeq ($(FULL_TARGET),i386-qnx)
|
ifeq ($(FULL_TARGET),i386-qnx)
|
||||||
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses
|
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer
|
||||||
endif
|
endif
|
||||||
ifeq ($(FULL_TARGET),i386-netware)
|
ifeq ($(FULL_TARGET),i386-netware)
|
||||||
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses
|
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer
|
||||||
endif
|
endif
|
||||||
ifeq ($(FULL_TARGET),i386-openbsd)
|
ifeq ($(FULL_TARGET),i386-openbsd)
|
||||||
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses
|
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer
|
||||||
endif
|
endif
|
||||||
ifeq ($(FULL_TARGET),i386-wdosx)
|
ifeq ($(FULL_TARGET),i386-wdosx)
|
||||||
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses
|
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer
|
||||||
endif
|
endif
|
||||||
ifeq ($(FULL_TARGET),i386-emx)
|
ifeq ($(FULL_TARGET),i386-emx)
|
||||||
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses
|
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer
|
||||||
endif
|
endif
|
||||||
ifeq ($(FULL_TARGET),i386-watcom)
|
ifeq ($(FULL_TARGET),i386-watcom)
|
||||||
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses
|
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer
|
||||||
endif
|
endif
|
||||||
ifeq ($(FULL_TARGET),i386-netwlibc)
|
ifeq ($(FULL_TARGET),i386-netwlibc)
|
||||||
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses
|
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer
|
||||||
endif
|
endif
|
||||||
ifeq ($(FULL_TARGET),i386-wince)
|
ifeq ($(FULL_TARGET),i386-wince)
|
||||||
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses
|
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer
|
||||||
endif
|
endif
|
||||||
ifeq ($(FULL_TARGET),m68k-linux)
|
ifeq ($(FULL_TARGET),m68k-linux)
|
||||||
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses freetypeh freetype ftfont
|
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer freetypeh freetype ftfont
|
||||||
endif
|
endif
|
||||||
ifeq ($(FULL_TARGET),m68k-freebsd)
|
ifeq ($(FULL_TARGET),m68k-freebsd)
|
||||||
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses freetypeh freetype ftfont
|
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer freetypeh freetype ftfont
|
||||||
endif
|
endif
|
||||||
ifeq ($(FULL_TARGET),m68k-netbsd)
|
ifeq ($(FULL_TARGET),m68k-netbsd)
|
||||||
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses
|
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer
|
||||||
endif
|
endif
|
||||||
ifeq ($(FULL_TARGET),m68k-amiga)
|
ifeq ($(FULL_TARGET),m68k-amiga)
|
||||||
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses
|
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer
|
||||||
endif
|
endif
|
||||||
ifeq ($(FULL_TARGET),m68k-atari)
|
ifeq ($(FULL_TARGET),m68k-atari)
|
||||||
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses
|
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer
|
||||||
endif
|
endif
|
||||||
ifeq ($(FULL_TARGET),m68k-openbsd)
|
ifeq ($(FULL_TARGET),m68k-openbsd)
|
||||||
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses
|
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer
|
||||||
endif
|
endif
|
||||||
ifeq ($(FULL_TARGET),m68k-palmos)
|
ifeq ($(FULL_TARGET),m68k-palmos)
|
||||||
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses
|
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer
|
||||||
endif
|
endif
|
||||||
ifeq ($(FULL_TARGET),powerpc-linux)
|
ifeq ($(FULL_TARGET),powerpc-linux)
|
||||||
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses freetypeh freetype ftfont
|
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer freetypeh freetype ftfont
|
||||||
endif
|
endif
|
||||||
ifeq ($(FULL_TARGET),powerpc-netbsd)
|
ifeq ($(FULL_TARGET),powerpc-netbsd)
|
||||||
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses
|
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer
|
||||||
endif
|
endif
|
||||||
ifeq ($(FULL_TARGET),powerpc-macos)
|
ifeq ($(FULL_TARGET),powerpc-macos)
|
||||||
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses
|
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer
|
||||||
endif
|
endif
|
||||||
ifeq ($(FULL_TARGET),powerpc-darwin)
|
ifeq ($(FULL_TARGET),powerpc-darwin)
|
||||||
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses
|
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer
|
||||||
endif
|
endif
|
||||||
ifeq ($(FULL_TARGET),powerpc-morphos)
|
ifeq ($(FULL_TARGET),powerpc-morphos)
|
||||||
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses
|
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer
|
||||||
endif
|
endif
|
||||||
ifeq ($(FULL_TARGET),sparc-linux)
|
ifeq ($(FULL_TARGET),sparc-linux)
|
||||||
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses freetypeh freetype ftfont
|
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer freetypeh freetype ftfont
|
||||||
endif
|
endif
|
||||||
ifeq ($(FULL_TARGET),sparc-netbsd)
|
ifeq ($(FULL_TARGET),sparc-netbsd)
|
||||||
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses
|
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer
|
||||||
endif
|
endif
|
||||||
ifeq ($(FULL_TARGET),sparc-solaris)
|
ifeq ($(FULL_TARGET),sparc-solaris)
|
||||||
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses
|
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer
|
||||||
endif
|
endif
|
||||||
ifeq ($(FULL_TARGET),x86_64-linux)
|
ifeq ($(FULL_TARGET),x86_64-linux)
|
||||||
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses freetypeh freetype ftfont
|
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer freetypeh freetype ftfont
|
||||||
endif
|
endif
|
||||||
ifeq ($(FULL_TARGET),x86_64-freebsd)
|
ifeq ($(FULL_TARGET),x86_64-freebsd)
|
||||||
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses freetypeh freetype ftfont
|
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer freetypeh freetype ftfont
|
||||||
endif
|
endif
|
||||||
ifeq ($(FULL_TARGET),x86_64-win64)
|
ifeq ($(FULL_TARGET),x86_64-win64)
|
||||||
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses
|
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer
|
||||||
endif
|
endif
|
||||||
ifeq ($(FULL_TARGET),arm-linux)
|
ifeq ($(FULL_TARGET),arm-linux)
|
||||||
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses freetypeh freetype ftfont
|
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer freetypeh freetype ftfont
|
||||||
endif
|
endif
|
||||||
ifeq ($(FULL_TARGET),arm-wince)
|
ifeq ($(FULL_TARGET),arm-wince)
|
||||||
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses
|
override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer
|
||||||
endif
|
endif
|
||||||
ifeq ($(FULL_TARGET),i386-linux)
|
ifeq ($(FULL_TARGET),i386-linux)
|
||||||
override TARGET_RSTS+=pscanvas
|
override TARGET_RSTS+=pscanvas
|
||||||
|
|||||||
@ -12,7 +12,7 @@ packages=paszlib pasjpeg
|
|||||||
units=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm \
|
units=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm \
|
||||||
clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp \
|
clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp \
|
||||||
fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg \
|
fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg \
|
||||||
targacmn fpreadtga fpwritetga ellipses
|
targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer
|
||||||
units_win32=freetypeh freetype ftfont
|
units_win32=freetypeh freetype ftfont
|
||||||
units_linux=freetypeh freetype ftfont
|
units_linux=freetypeh freetype ftfont
|
||||||
units_freebsd=freetypeh freetype ftfont
|
units_freebsd=freetypeh freetype ftfont
|
||||||
|
|||||||
412
fcl/image/fpcolhash.pas
Normal file
412
fcl/image/fpcolhash.pas
Normal file
@ -0,0 +1,412 @@
|
|||||||
|
{*****************************************************************************}
|
||||||
|
{
|
||||||
|
This file is part of the Free Pascal's "Free Components Library".
|
||||||
|
Copyright (c) 2005 by Giulio Bernardi
|
||||||
|
|
||||||
|
This file contains a color hash table.
|
||||||
|
|
||||||
|
See the file COPYING.FPC, included in this distribution,
|
||||||
|
for details about the copyright.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful,
|
||||||
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||||
|
}
|
||||||
|
{*****************************************************************************}
|
||||||
|
{$mode objfpc}{$h+}
|
||||||
|
unit FPColHash;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses sysutils, classes, fpimage;
|
||||||
|
|
||||||
|
type TFPColorHashException = class(Exception);
|
||||||
|
|
||||||
|
type
|
||||||
|
PColHashSubNode = ^TColHashSubNode;
|
||||||
|
TColHashSubNode = packed record
|
||||||
|
index : byte;
|
||||||
|
data : pointer;
|
||||||
|
next : PColHashSubNode;
|
||||||
|
end;
|
||||||
|
|
||||||
|
type
|
||||||
|
PColHashMainNode = ^TColHashMainNode;
|
||||||
|
TColHashMainNode = packed record
|
||||||
|
childs : array[0..16] of pointer; { can be either another MainNode or a SubNode }
|
||||||
|
end;
|
||||||
|
|
||||||
|
{
|
||||||
|
HashMap configuration:
|
||||||
|
childs[MSN(A)] level 0
|
||||||
|
|_childs[LSN(A)] level 1
|
||||||
|
|_childs[LSN(R)] level 2
|
||||||
|
|_childs[LSN(G)] level 3
|
||||||
|
|_childs[LSN(B)] level 4
|
||||||
|
|_childs[(MSN(R) MSN(G) MSN (B)) div 256] level 5
|
||||||
|
|_element [(MSN(R) MSN(G) MSN (B)) mod 256]
|
||||||
|
Very low accesses to reach an element, not much memory occupation if alpha is rarely used, event with
|
||||||
|
images with 500.000 colors.
|
||||||
|
For extremely colorful images (near 2^24 colors used) using only 5 bits per channel keeps the map
|
||||||
|
small and efficient
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
type
|
||||||
|
TFPPackedColor = record
|
||||||
|
R, G, B, A : byte;
|
||||||
|
end;
|
||||||
|
|
||||||
|
type
|
||||||
|
TFPColorWeight = record
|
||||||
|
Col : TFPPackedColor;
|
||||||
|
Num : integer;
|
||||||
|
end;
|
||||||
|
PFPColorWeight = ^TFPColorWeight;
|
||||||
|
TFPColorWeightArray = array of PFPColorWeight;
|
||||||
|
|
||||||
|
|
||||||
|
type
|
||||||
|
TFPColorHashTable = class
|
||||||
|
private
|
||||||
|
Root : PColHashMainNode;
|
||||||
|
AllIntegers : boolean;
|
||||||
|
procedure FreeAllData;
|
||||||
|
FCount : longword;
|
||||||
|
function AllocateMainNode : PColHashMainNode;
|
||||||
|
function AllocateSubNode : PColHashSubNode;
|
||||||
|
procedure DeallocateLinkedList(node : PColHashSubNode);
|
||||||
|
procedure DeallocateMainNode(node : PColHashMainNode; level : byte);
|
||||||
|
procedure CalculateIndexes(Col : TFPPackedColor; var ahi, alo, ri, gi, bi, partial, sub : byte);
|
||||||
|
function CalculateColor(const ahi, alo, ri, gi, bi, partial, sub : byte) : TFPPackedColor;
|
||||||
|
function SearchSubNode(start : PColHashSubNode; const index : byte ) : PColHashSubNode;
|
||||||
|
function SearchSubNodeAllocate(var start : PColHashSubNode; const index : byte ) : PColHashSubNode;
|
||||||
|
function Search(const Col : TFPPackedColor) : PColHashSubNode;
|
||||||
|
function SearchAllocate(const Col : TFPPackedColor) : PColHashSubNode;
|
||||||
|
protected
|
||||||
|
public
|
||||||
|
procedure Insert(const Col : TFPColor; const Value : integer);
|
||||||
|
procedure Insert(const Col : TFPColor; const Value : pointer);
|
||||||
|
procedure Add(const Col : TFPColor; const Value : integer);
|
||||||
|
function Get(const Col : TFPColor) : pointer;
|
||||||
|
procedure Clear;
|
||||||
|
function GetArray : TFPColorWeightArray;
|
||||||
|
property Count : longword read FCount;
|
||||||
|
constructor Create;
|
||||||
|
destructor Destroy; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function FPColor2Packed(Col : TFPColor) : TFPPackedColor;
|
||||||
|
function Packed2FPColor(Col : TFPPackedColor) : TFPColor;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
function FPColor2Packed(Col : TFPColor) : TFPPackedColor;
|
||||||
|
begin
|
||||||
|
Result.R:=(Col.Red and $FF00) shr 8;
|
||||||
|
Result.G:=(Col.Green and $FF00) shr 8;
|
||||||
|
Result.B:=(Col.Blue and $FF00) shr 8;
|
||||||
|
Result.A:=(Col.Alpha and $FF00) shr 8;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function Packed2FPColor(Col : TFPPackedColor) : TFPColor;
|
||||||
|
begin
|
||||||
|
Result.Red:=(Col.R shl 8) + Col.R;
|
||||||
|
Result.Green:=(Col.G shl 8) + Col.G;
|
||||||
|
Result.Blue:=(Col.B shl 8) + Col.B;
|
||||||
|
Result.Alpha:=(Col.A shl 8) + Col.A;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TFPColorHashTable.Create;
|
||||||
|
begin
|
||||||
|
Fcount:=0;
|
||||||
|
AllIntegers:=true;
|
||||||
|
Root:=nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TFPColorHashTable.Destroy;
|
||||||
|
begin
|
||||||
|
FreeAllData;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFPColorHashTable.CalculateIndexes(Col : TFPPackedColor; var ahi, alo, ri, gi, bi, partial, sub : byte);
|
||||||
|
var tmp : longword;
|
||||||
|
begin
|
||||||
|
ahi := (Col.A and $F0) shr 4;
|
||||||
|
alo := (Col.A and $F);
|
||||||
|
ri := (Col.R and $F);
|
||||||
|
gi := (Col.G and $F);
|
||||||
|
bi := (Col.B and $F);
|
||||||
|
tmp:=((Col.R and $F0) shl 4) or (Col.G and $F0) or ((Col.B and $F0) shr 4);
|
||||||
|
partial:=tmp div 256;
|
||||||
|
sub:=tmp mod 256;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TFPColorHashTable.CalculateColor(const ahi, alo, ri, gi, bi, partial, sub : byte) : TFPPackedColor;
|
||||||
|
var tmp : longword;
|
||||||
|
col : TFPPackedColor;
|
||||||
|
begin
|
||||||
|
tmp:=(partial shl 8) + sub; //partial*256 + sub;
|
||||||
|
col.A:=(ahi shl 4) or alo;
|
||||||
|
col.R:=((tmp and $F00) shr 4) + ri;
|
||||||
|
col.G:=(tmp and $0F0) + gi;
|
||||||
|
col.B:=((tmp and $00F) shl 4) + bi;
|
||||||
|
Result:=col;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFPColorHashTable.FreeAllData;
|
||||||
|
begin
|
||||||
|
DeallocateMainNode(Root,0);
|
||||||
|
Root:=nil;
|
||||||
|
FCount:=0;
|
||||||
|
AllIntegers:=true;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TFPColorHashTable.AllocateMainNode : PColHashMainNode;
|
||||||
|
var tmp : PColHashMainNode;
|
||||||
|
i : byte;
|
||||||
|
begin
|
||||||
|
Result:=nil;
|
||||||
|
tmp:=getmem(sizeof(TColHashMainNode));
|
||||||
|
if tmp=nil then raise TFPColorHashException.Create('Out of memory');
|
||||||
|
for i:=0 to high(tmp^.childs) do
|
||||||
|
tmp^.childs[i]:=nil;
|
||||||
|
Result:=tmp;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TFPColorHashTable.AllocateSubNode : PColHashSubNode;
|
||||||
|
var tmp : PColHashSubNode;
|
||||||
|
begin
|
||||||
|
Result:=nil;
|
||||||
|
tmp:=getmem(sizeof(TColHashSubNode));
|
||||||
|
if tmp=nil then raise TFPColorHashException.Create('Out of memory');
|
||||||
|
tmp^.index:=0;
|
||||||
|
tmp^.data:=nil;
|
||||||
|
tmp^.next:=nil;
|
||||||
|
inc(FCount);
|
||||||
|
Result:=tmp;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFPColorHashTable.DeallocateLinkedList(node : PColHashSubNode);
|
||||||
|
var tmp : PColHashSubNode;
|
||||||
|
begin
|
||||||
|
while (node<>nil) do
|
||||||
|
begin
|
||||||
|
tmp:=node^.next;
|
||||||
|
if node^.data<>nil then
|
||||||
|
FreeMem(node^.data);
|
||||||
|
FreeMem(node);
|
||||||
|
node:=tmp;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFPColorHashTable.DeallocateMainNode(node : PColHashMainNode; level : byte);
|
||||||
|
var i : byte;
|
||||||
|
begin
|
||||||
|
if node=nil then exit;
|
||||||
|
if level=5 then
|
||||||
|
begin
|
||||||
|
for i:=0 to high(node^.childs) do
|
||||||
|
DeallocateLinkedList(node^.childs[i]);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
for i:=0 to high(node^.childs) do
|
||||||
|
DeallocateMainNode(node^.childs[i],level+1);
|
||||||
|
FreeMem(node);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TFPColorHashTable.SearchSubNode(start : PColHashSubNode; const index : byte ) : PColHashSubNode;
|
||||||
|
var cur : PColHashSubNode;
|
||||||
|
begin
|
||||||
|
Result:=nil;
|
||||||
|
cur:=start;
|
||||||
|
while cur<>nil do
|
||||||
|
begin
|
||||||
|
if cur^.index=index then break
|
||||||
|
else if cur^.index>index then exit; { exit and returns nil}
|
||||||
|
cur:=cur^.next;
|
||||||
|
end;
|
||||||
|
Result:=cur;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TFPColorHashTable.SearchSubNodeAllocate(var start : PColHashSubNode; const index : byte ) : PColHashSubNode;
|
||||||
|
var tmp, cur, prev : PColHashSubNode;
|
||||||
|
begin
|
||||||
|
Result:=nil;
|
||||||
|
prev:=nil;
|
||||||
|
cur:=start;
|
||||||
|
while cur<>nil do
|
||||||
|
begin
|
||||||
|
if cur^.index=index then break
|
||||||
|
else if cur^.index>index then {whoops, we must insert the new node before this one}
|
||||||
|
begin
|
||||||
|
tmp:=AllocateSubNode;
|
||||||
|
tmp^.index:=index;
|
||||||
|
tmp^.next:=cur;
|
||||||
|
if prev<>nil then prev^.next:=tmp
|
||||||
|
else start:=tmp;
|
||||||
|
cur:=tmp;
|
||||||
|
break;
|
||||||
|
end;
|
||||||
|
prev:=cur;
|
||||||
|
cur:=cur^.next;
|
||||||
|
end;
|
||||||
|
if cur=nil then { not found! append to the end }
|
||||||
|
begin
|
||||||
|
cur:=AllocateSubNode;
|
||||||
|
cur^.index:=index;
|
||||||
|
prev^.next:=cur { start is always <> nil}
|
||||||
|
end;
|
||||||
|
Result:=cur;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TFPColorHashTable.Search(const Col : TFPPackedColor) : PColHashSubNode;
|
||||||
|
var ahi, alo, ri, gi, bi, partial, sub : byte;
|
||||||
|
tmpmain : PColHashMainNode;
|
||||||
|
begin
|
||||||
|
Result:=nil;
|
||||||
|
CalculateIndexes(Col, ahi, alo, ri, gi, bi, partial, sub);
|
||||||
|
if Root=nil then exit;
|
||||||
|
if Root^.childs[ahi]=nil then exit;
|
||||||
|
tmpmain:=Root^.childs[ahi];
|
||||||
|
if tmpmain^.childs[alo]=nil then exit;
|
||||||
|
tmpmain:=tmpmain^.childs[alo];
|
||||||
|
if tmpmain^.childs[ri]=nil then exit;
|
||||||
|
tmpmain:=tmpmain^.childs[ri];
|
||||||
|
if tmpmain^.childs[gi]=nil then exit;
|
||||||
|
tmpmain:=tmpmain^.childs[gi];
|
||||||
|
if tmpmain^.childs[bi]=nil then exit;
|
||||||
|
tmpmain:=tmpmain^.childs[bi];
|
||||||
|
|
||||||
|
if tmpmain^.childs[partial]=nil then exit;
|
||||||
|
Result:=SearchSubNode(tmpmain^.childs[partial],sub);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ get the node; if there isn't, build the part of the tree }
|
||||||
|
function TFPColorHashTable.SearchAllocate(const Col : TFPPackedColor) : PColHashSubNode;
|
||||||
|
var ahi, alo, ri, gi, bi, partial, sub : byte;
|
||||||
|
tmpmain : PColHashMainNode;
|
||||||
|
begin
|
||||||
|
Result:=nil;
|
||||||
|
CalculateIndexes(Col, ahi, alo, ri, gi, bi, partial, sub);
|
||||||
|
if Root=nil then Root:=AllocateMainNode;
|
||||||
|
if Root^.childs[ahi]=nil then Root^.childs[ahi]:=AllocateMainNode;
|
||||||
|
tmpmain:=Root^.childs[ahi];
|
||||||
|
if tmpmain^.childs[alo]=nil then tmpmain^.childs[alo]:=AllocateMainNode;
|
||||||
|
tmpmain:=tmpmain^.childs[alo];
|
||||||
|
if tmpmain^.childs[ri]=nil then tmpmain^.childs[ri]:=AllocateMainNode;
|
||||||
|
tmpmain:=tmpmain^.childs[ri];
|
||||||
|
if tmpmain^.childs[gi]=nil then tmpmain^.childs[gi]:=AllocateMainNode;
|
||||||
|
tmpmain:=tmpmain^.childs[gi];
|
||||||
|
if tmpmain^.childs[bi]=nil then tmpmain^.childs[bi]:=AllocateMainNode;
|
||||||
|
tmpmain:=tmpmain^.childs[bi];
|
||||||
|
|
||||||
|
if tmpmain^.childs[partial]=nil then { newly-created linked list. }
|
||||||
|
begin
|
||||||
|
tmpmain^.childs[partial]:=AllocateSubNode;
|
||||||
|
Result:=tmpmain^.childs[partial];
|
||||||
|
Result^.index:=sub;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
Result:=SearchSubNodeAllocate(tmpmain^.childs[partial],sub)
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFPColorHashTable.Insert(const Col : TFPColor; const Value : integer);
|
||||||
|
var node : PColHashSubNode;
|
||||||
|
begin
|
||||||
|
node:=SearchAllocate(FPColor2Packed(col));
|
||||||
|
node^.data:=getmem(sizeof(Value));
|
||||||
|
integer(node^.data^):=value;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFPColorHashTable.Insert(const Col : TFPColor; const Value : pointer);
|
||||||
|
var node : PColHashSubNode;
|
||||||
|
begin
|
||||||
|
node:=SearchAllocate(FPColor2Packed(col));
|
||||||
|
node^.data:=Value;
|
||||||
|
AllIntegers:=false;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFPColorHashTable.Add(const Col : TFPColor; const Value : integer);
|
||||||
|
var node : PColHashSubNode;
|
||||||
|
begin
|
||||||
|
node:=SearchAllocate(FPColor2Packed(col));
|
||||||
|
if node^.data=nil then
|
||||||
|
begin
|
||||||
|
node^.data:=getmem(sizeof(Value));
|
||||||
|
integer(node^.data^):=0;
|
||||||
|
end;
|
||||||
|
inc(integer(node^.data^),value);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TFPColorHashTable.Get(const Col : TFPColor) : pointer;
|
||||||
|
var node : PColHashSubNode;
|
||||||
|
begin
|
||||||
|
node:=Search(FPColor2Packed(col));
|
||||||
|
if node<>nil then
|
||||||
|
Result:=node^.data
|
||||||
|
else
|
||||||
|
Result:=nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFPColorHashTable.Clear;
|
||||||
|
begin
|
||||||
|
FreeAllData;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TFPColorHashTable.GetArray : TFPColorWeightArray;
|
||||||
|
var ahi, alo, ri, gi, bi, partial : byte;
|
||||||
|
node : PColHashSubNode;
|
||||||
|
i : longword;
|
||||||
|
cw : PFPColorWeight;
|
||||||
|
tmp1,tmp2,tmp3,tmp4,tmp5 : PColHashMainNode;
|
||||||
|
begin
|
||||||
|
if not AllIntegers then
|
||||||
|
raise TFPColorHashException.Create('Hashtable data is not made by integers.');
|
||||||
|
SetLength(Result,FCount);
|
||||||
|
if Root=nil then exit;
|
||||||
|
i:=0;
|
||||||
|
for ahi:=0 to 15 do
|
||||||
|
begin
|
||||||
|
if Root^.childs[ahi]=nil then continue;
|
||||||
|
tmp1:=Root^.childs[ahi];
|
||||||
|
for alo:=0 to 15 do
|
||||||
|
begin
|
||||||
|
if tmp1^.childs[alo]=nil then continue;
|
||||||
|
tmp2:=tmp1^.childs[alo];
|
||||||
|
for ri:=0 to 15 do
|
||||||
|
begin
|
||||||
|
if tmp2^.childs[ri]=nil then continue;
|
||||||
|
tmp3:=tmp2^.childs[ri];
|
||||||
|
for gi:=0 to 15 do
|
||||||
|
begin
|
||||||
|
if tmp3^.childs[gi]=nil then continue;
|
||||||
|
tmp4:=tmp3^.childs[gi];
|
||||||
|
for bi:=0 to 15 do
|
||||||
|
begin
|
||||||
|
if tmp4^.childs[bi]=nil then continue;
|
||||||
|
tmp5:=tmp4^.childs[bi];
|
||||||
|
for partial:=0 to 15 do
|
||||||
|
begin
|
||||||
|
node:=tmp5^.childs[partial];
|
||||||
|
while (node<>nil) do
|
||||||
|
begin
|
||||||
|
getmem(cw,sizeof(TFPColorWeight));
|
||||||
|
if cw=nil then
|
||||||
|
raise TFPColorHashException.Create('Out of memory');
|
||||||
|
cw^.Col:=CalculateColor(ahi,alo,ri,gi,bi,partial,node^.index);
|
||||||
|
cw^.Num:=integer(node^.data^);
|
||||||
|
Result[i]:=cw;
|
||||||
|
inc(i);
|
||||||
|
node:=node^.next;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
544
fcl/image/fpditherer.pas
Normal file
544
fcl/image/fpditherer.pas
Normal file
@ -0,0 +1,544 @@
|
|||||||
|
{*****************************************************************************}
|
||||||
|
{
|
||||||
|
This file is part of the Free Pascal's "Free Components Library".
|
||||||
|
Copyright (c) 2005 by Giulio Bernardi
|
||||||
|
|
||||||
|
This file contains classes used to dither images.
|
||||||
|
|
||||||
|
See the file COPYING.FPC, included in this distribution,
|
||||||
|
for details about the copyright.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful,
|
||||||
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||||
|
}
|
||||||
|
{*****************************************************************************}
|
||||||
|
|
||||||
|
{$mode objfpc}{$h+}
|
||||||
|
unit FPDitherer;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses sysutils, classes, fpimage, fpcolhash;
|
||||||
|
|
||||||
|
type
|
||||||
|
FPDithererException = class (exception);
|
||||||
|
|
||||||
|
type
|
||||||
|
TFPDithererProgressEvent = procedure (Sender: TObject; Stage: TFPImgProgressStage; PercentDone: Byte;
|
||||||
|
const Msg: AnsiString; var Continue : Boolean) of object;
|
||||||
|
|
||||||
|
type
|
||||||
|
TFPBaseDitherer = class
|
||||||
|
private
|
||||||
|
FPalette : TFPPalette;
|
||||||
|
FOnProgress : TFPDithererProgressEvent;
|
||||||
|
procedure QuickSort(const l, r : integer);
|
||||||
|
protected
|
||||||
|
FImage : TFPCustomImage;
|
||||||
|
FHashMap : TFPColorHashTable;
|
||||||
|
FSorted : boolean;
|
||||||
|
FUseHash : boolean;
|
||||||
|
FUseAlpha : boolean;
|
||||||
|
function ColorCompare(const c1, c2 : TFPColor) : shortint;
|
||||||
|
function GetColorDinst(const c1, c2 : TFPColor) : integer;
|
||||||
|
function SubtractColorInt(const c1, c2 : TFPColor) : int64;
|
||||||
|
function SubtractColor(const c1, c2 : TFPColor) : TFPColor;
|
||||||
|
procedure InternalDither(const Source : TFPCustomImage; Dest : TFPCustomImage); virtual;
|
||||||
|
function FindBestColor(OrigColor : TFPColor; var PalIndex : integer) : integer; virtual;
|
||||||
|
procedure Progress (Sender: TObject; Stage: TFPImgProgressStage; PercentDone: Byte; const Msg: AnsiString; var Continue : Boolean); virtual;
|
||||||
|
procedure SetUseHash(Value : boolean); virtual;
|
||||||
|
procedure SetSorted(Value : boolean); virtual;
|
||||||
|
public
|
||||||
|
property OnProgress : TFPDithererProgressEvent read FOnProgress write FOnProgress;
|
||||||
|
property Palette : TFPPalette read FPalette;
|
||||||
|
property PaletteSorted : boolean read FSorted write SetSorted;
|
||||||
|
property UseHashMap : boolean read FUseHash write SetUseHash;
|
||||||
|
property UseAlpha : boolean read FUseAlpha write FUseAlpha;
|
||||||
|
procedure Dither(const Source : TFPCustomImage; Dest : TFPCustomImage);
|
||||||
|
procedure SortPalette; virtual;
|
||||||
|
constructor Create(ThePalette : TFPPalette); virtual;
|
||||||
|
destructor Destroy; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
type
|
||||||
|
PFPPixelReal = ^TFPPixelReal;
|
||||||
|
TFPPixelReal = record { pixel in real form }
|
||||||
|
a, r, g, b : real;
|
||||||
|
end;
|
||||||
|
|
||||||
|
PFSPixelLine = ^TFSPixelLine;
|
||||||
|
TFSPixelLine = record
|
||||||
|
pixels : PFPPixelReal; { a line of pixels }
|
||||||
|
Next : PFSPixelLine; { next line of pixels }
|
||||||
|
end;
|
||||||
|
|
||||||
|
type
|
||||||
|
TFPFloydSteinbergDitherer = class(TFPBaseDitherer)
|
||||||
|
private
|
||||||
|
Lines : PFSPixelLine;
|
||||||
|
function Color2Real(const c : TFPColor) : TFPPixelReal;
|
||||||
|
function Real2Color(r : TFPPixelReal) : TFPColor;
|
||||||
|
procedure CreatePixelLine(var line : PFSPixelLine; const row : integer);
|
||||||
|
function GetError(const c1, c2 : TFPColor) : TFPPixelReal;
|
||||||
|
procedure DistributeErrors(var line : PFSPixelLine; const row : integer; Img : TFPCustomImage);
|
||||||
|
procedure DeleteAllPixelLines(var line : PFSPixelLine);
|
||||||
|
protected
|
||||||
|
procedure InternalDither(const Source : TFPCustomImage; Dest : TFPCustomImage); override;
|
||||||
|
public
|
||||||
|
constructor Create(ThePalette : TFPPalette); override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{ TFPBaseDitherer }
|
||||||
|
|
||||||
|
procedure TFPBaseDitherer.Dither(const Source : TFPCustomImage; Dest : TFPCustomImage);
|
||||||
|
begin
|
||||||
|
if FPalette.Count=0 then
|
||||||
|
raise FPDithererException.Create('Palette is empty');
|
||||||
|
if Source=Dest then
|
||||||
|
raise FPDithererException.Create('Source and Destination images must be different');
|
||||||
|
InternalDither(Source,Dest);
|
||||||
|
if FUseHash then
|
||||||
|
FHashMap.Clear;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TFPBaseDitherer.Create(ThePalette : TFPPalette);
|
||||||
|
begin
|
||||||
|
FSorted:=false;
|
||||||
|
FUseAlpha:=false;
|
||||||
|
FImage:=nil;
|
||||||
|
FPalette:=ThePalette;
|
||||||
|
FUseHash:=true;
|
||||||
|
FHashMap:=TFPColorHashTable.Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TFPBaseDitherer.Destroy;
|
||||||
|
begin
|
||||||
|
if Assigned(FHashMap) then
|
||||||
|
FHashMap.Free;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFPBaseDitherer.SetUseHash(Value : boolean);
|
||||||
|
begin
|
||||||
|
if Value=FUseHash then exit;
|
||||||
|
if Value then
|
||||||
|
FHashMap:=TFPColorHashTable.Create
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
FHashMap.Free;
|
||||||
|
FHashMap:=nil;
|
||||||
|
end;
|
||||||
|
FUseHash:=Value;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFPBaseDitherer.SetSorted(Value : boolean);
|
||||||
|
begin
|
||||||
|
FSorted:=Value;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFPBaseDitherer.Progress(Sender: TObject; Stage: TFPImgProgressStage; PercentDone: Byte; const Msg: AnsiString; var Continue : Boolean);
|
||||||
|
begin
|
||||||
|
if Assigned(FOnProgress) then
|
||||||
|
FOnProgress(Sender,Stage,PercentDone,Msg,Continue);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ rgb triplets are considered like a number having msb in msb(r) and lsb in lsb(b) }
|
||||||
|
|
||||||
|
function TFPBaseDitherer.SubtractColorInt(const c1, c2 : TFPColor) : int64;
|
||||||
|
var whole1, whole2 : int64;
|
||||||
|
begin
|
||||||
|
whole1:= ((c1.Red and $FF00) shl 8) or (c1.Green and $FF00) or ((c1.Blue and $FF00) shr 8);
|
||||||
|
whole2:= ((c2.Red and $FF00) shl 8) or (c2.Green and $FF00) or ((c2.Blue and $FF00) shr 8);
|
||||||
|
if FUseAlpha then
|
||||||
|
begin
|
||||||
|
whole1:=whole1 or ((c1.Alpha and $FF00) shl 16);
|
||||||
|
whole2:=whole2 or ((c2.Alpha and $FF00) shl 16);
|
||||||
|
end;
|
||||||
|
Result:= whole1 - whole2;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ this is more efficient than calling subtractcolorint and then extracting r g b values }
|
||||||
|
function TFPBaseDitherer.GetColorDinst(const c1, c2 : TFPColor) : integer;
|
||||||
|
var dinst : integer;
|
||||||
|
begin
|
||||||
|
dinst:=abs(((c1.Red and $FF00) shr 8) - ((c2.Red and $FF00) shr 8));
|
||||||
|
dinst:=dinst+abs(((c1.Green and $FF00) shr 8) - ((c2.Green and $FF00) shr 8));
|
||||||
|
dinst:=dinst+abs(((c1.Blue and $FF00) shr 8) - ((c2.Blue and $FF00) shr 8));
|
||||||
|
if FUseAlpha then
|
||||||
|
dinst:=dinst+abs(((c1.Alpha and $FF00) shr 8) - ((c2.Alpha and $FF00) shr 8));
|
||||||
|
Result:= dinst;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TFPBaseDitherer.SubtractColor(const c1, c2 : TFPColor) : TFPColor;
|
||||||
|
var whole : int64;
|
||||||
|
begin
|
||||||
|
whole:=abs(SubtractColorInt(c1,c2));
|
||||||
|
if FUseALpha then
|
||||||
|
Result.Alpha:=(whole and $FF000000) shr 16
|
||||||
|
else
|
||||||
|
Result.Alpha:=AlphaOpaque;
|
||||||
|
Result.Red:=(whole and $00FF0000) shr 8;
|
||||||
|
Result.Green:=(whole and $0000FF00);
|
||||||
|
Result.Blue:=(whole and $000000FF) shl 8;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TFPBaseDitherer.ColorCompare(const c1, c2 : TFPColor) : shortint;
|
||||||
|
var whole : int64;
|
||||||
|
begin
|
||||||
|
whole:=SubtractColorInt(c1,c2);
|
||||||
|
if whole>0 then Result:=1
|
||||||
|
else if whole<0 then Result:=-1
|
||||||
|
else Result:=0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFPBaseDitherer.QuickSort(const l, r : integer);
|
||||||
|
var i, j : integer;
|
||||||
|
pivot, temp : TFPColor;
|
||||||
|
begin
|
||||||
|
if l<r then
|
||||||
|
begin
|
||||||
|
pivot:=FPalette[l];
|
||||||
|
i:=l+1;
|
||||||
|
j:=r;
|
||||||
|
repeat
|
||||||
|
while ((i<=r) and (ColorCompare(FPalette[i],pivot)<=0)) do
|
||||||
|
inc(i);
|
||||||
|
while (ColorCompare(FPalette[j],pivot)=1) do
|
||||||
|
dec(j);
|
||||||
|
if i<j then
|
||||||
|
begin
|
||||||
|
temp:=FPalette[i];
|
||||||
|
FPalette[i]:=FPalette[j];
|
||||||
|
FPalette[j]:=temp;
|
||||||
|
end;
|
||||||
|
until i > j;
|
||||||
|
{ don't swap if they are equal }
|
||||||
|
if ColorCompare(FPalette[j],pivot)<>0 then
|
||||||
|
begin
|
||||||
|
Fpalette[l]:=Fpalette[j];
|
||||||
|
Fpalette[j]:=pivot;
|
||||||
|
end;
|
||||||
|
Quicksort(l,j-1);
|
||||||
|
Quicksort(i,r);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFPBaseDitherer.SortPalette;
|
||||||
|
begin
|
||||||
|
QuickSort(0,FPalette.Count-1);
|
||||||
|
FSorted:=true;
|
||||||
|
end;
|
||||||
|
|
||||||
|
type
|
||||||
|
PBestColorData = ^TBestColorData;
|
||||||
|
TBestColorData = record
|
||||||
|
palindex, dinst : integer;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TFPBaseDitherer.FindBestColor(OrigColor : TFPColor; var PalIndex : integer) : integer;
|
||||||
|
var i, curr, dinst, tmpdinst, top, bottom : integer;
|
||||||
|
hashval : PBestColorData;
|
||||||
|
begin
|
||||||
|
dinst:=$7FFFFFFF;
|
||||||
|
curr:=0;
|
||||||
|
|
||||||
|
if FUseHash then { use the hashmap to improve speed }
|
||||||
|
begin
|
||||||
|
hashval:=FHashMap.Get(OrigColor);
|
||||||
|
if hashval<>nil then
|
||||||
|
begin
|
||||||
|
PalIndex:=hashval^.palindex;
|
||||||
|
Result:=hashval^.dinst;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ with a sorted palette, proceed by binary search. this is more efficient with large images or large palettes }
|
||||||
|
if FSorted then
|
||||||
|
begin
|
||||||
|
top:=0;
|
||||||
|
bottom:=FPalette.Count-1;
|
||||||
|
while top<=bottom do
|
||||||
|
begin
|
||||||
|
i:=(bottom+top) div 2;
|
||||||
|
tmpdinst:=ColorCompare(OrigColor,Fpalette[i]);
|
||||||
|
if tmpdinst<0 then bottom:=i-1
|
||||||
|
else if tmpdinst>0 then top:=i+1
|
||||||
|
else break; { we found it }
|
||||||
|
end;
|
||||||
|
curr:=i;
|
||||||
|
dinst:=GetColorDinst(OrigColor,Fpalette[i]);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
for i:=0 to FPalette.Count-1 do
|
||||||
|
begin
|
||||||
|
tmpdinst:=GetColorDinst(OrigColor,FPalette[i]);
|
||||||
|
if tmpdinst<dinst then
|
||||||
|
begin
|
||||||
|
dinst:=tmpdinst;
|
||||||
|
curr:=i;
|
||||||
|
end;
|
||||||
|
if tmpdinst=0 then break; { There can't be anything better, stop searching }
|
||||||
|
end;
|
||||||
|
|
||||||
|
if FUseHash then { if we are using a hashmap, remember this value}
|
||||||
|
begin
|
||||||
|
hashval:=GetMem(sizeof(TBestColorData));
|
||||||
|
if hashval=nil then
|
||||||
|
raise FPDithererException.Create('Out of memory');
|
||||||
|
hashval^.PalIndex:=curr;
|
||||||
|
hashval^.dinst:=dinst;
|
||||||
|
FHashMap.Insert(OrigColor,hashval);
|
||||||
|
end;
|
||||||
|
PalIndex:=curr;
|
||||||
|
Result:=dinst;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFPBaseDitherer.InternalDither(const Source : TFPCustomImage; Dest : TFPCustomImage);
|
||||||
|
var i,j, palindex : integer;
|
||||||
|
percent : byte;
|
||||||
|
percentinterval : longword;
|
||||||
|
percentacc : longword;
|
||||||
|
FContinue : boolean;
|
||||||
|
begin
|
||||||
|
FImage:=Source;
|
||||||
|
percent:=0;
|
||||||
|
percentinterval:=(FImage.Width*FImage.Height*4) div 100;
|
||||||
|
if percentinterval=0 then percentinterval:=$FFFFFFFF;
|
||||||
|
percentacc:=0;
|
||||||
|
FContinue:=true;
|
||||||
|
Progress (self,psStarting,0,'',FContinue);
|
||||||
|
Dest.SetSize(0,0);
|
||||||
|
Dest.UsePalette:=true;
|
||||||
|
Dest.Palette.Clear;
|
||||||
|
Dest.Palette.Merge(FPalette);
|
||||||
|
Dest.SetSize(FImage.Width,FImage.Height);
|
||||||
|
for j:=0 to FImage.Height-1 do
|
||||||
|
for i:=0 to FImage.Width-1 do
|
||||||
|
begin
|
||||||
|
FindBestColor(FImage[i,j], palindex);
|
||||||
|
Dest.Pixels[i,j]:=palindex;
|
||||||
|
inc(percentacc,4);
|
||||||
|
if percentacc>=percentinterval then
|
||||||
|
begin
|
||||||
|
percent:=percent+(percentacc div percentinterval);
|
||||||
|
percentacc:=percentacc mod percentinterval;
|
||||||
|
Progress (self,psRunning,percent,'',FContinue);
|
||||||
|
if not fcontinue then exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
Progress (self,psEnding,100,'',FContinue);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TFPFloydSteinbergDitherer }
|
||||||
|
|
||||||
|
const FSNullPixel : TFPPixelReal = (a : 0.0; r : 0.0; g : 0.0; b : 0.0);
|
||||||
|
|
||||||
|
constructor TFPFloydSteinbergDitherer.Create(ThePalette : TFPPalette);
|
||||||
|
begin
|
||||||
|
inherited Create(ThePalette);
|
||||||
|
Lines:=nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TFPFloydSteinbergDitherer.GetError(const c1, c2 : TFPColor) : TFPPixelReal;
|
||||||
|
var temp : TFPPixelReal;
|
||||||
|
begin
|
||||||
|
if FUseAlpha then
|
||||||
|
temp.a:=((c1.Alpha and $FF00) shr 8) - ((c2.Alpha and $FF00) shr 8);
|
||||||
|
temp.r:=((c1.Red and $FF00) shr 8) - ((c2.Red and $FF00) shr 8);
|
||||||
|
temp.g:=((c1.Green and $FF00) shr 8) - ((c2.Green and $FF00) shr 8);
|
||||||
|
temp.b:=((c1.Blue and $FF00) shr 8) - ((c2.Blue and $FF00) shr 8);
|
||||||
|
Result:=temp;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TFPFloydSteinbergDitherer.Color2Real(const c : TFPColor) : TFPPixelReal;
|
||||||
|
var temp : TFPPixelReal;
|
||||||
|
begin
|
||||||
|
if FUseAlpha then
|
||||||
|
temp.a:=((c.Alpha and $FF00) shr 8);
|
||||||
|
temp.r:=((c.Red and $FF00) shr 8);
|
||||||
|
temp.g:=((c.Green and $FF00) shr 8);
|
||||||
|
temp.b:=((c.Blue and $FF00) shr 8);
|
||||||
|
Result:=temp;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TFPFloydSteinbergDitherer.Real2Color(r : TFPPixelReal) : TFPColor;
|
||||||
|
var temp : TFPColor;
|
||||||
|
begin
|
||||||
|
{ adjust overflows and underflows }
|
||||||
|
if r.r> 255 then r.r:=255; if r.r<0 then r.r:=0;
|
||||||
|
if r.g> 255 then r.g:=255; if r.g<0 then r.g:=0;
|
||||||
|
if r.b> 255 then r.b:=255; if r.b<0 then r.b:=0;
|
||||||
|
if FUseAlpha then
|
||||||
|
begin
|
||||||
|
if r.a> 255 then r.a:=255; if r.a<0 then r.a:=0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
temp.Red:=round(r.r);
|
||||||
|
temp.Red:=(temp.Red shl 8) + temp.Red;
|
||||||
|
temp.Green:=round(r.g);
|
||||||
|
temp.Green:=(temp.Green shl 8) + temp.Green;
|
||||||
|
temp.Blue:=round(r.b);
|
||||||
|
temp.Blue:=(temp.Blue shl 8) + temp.Blue;
|
||||||
|
if FUseAlpha then
|
||||||
|
begin
|
||||||
|
temp.Alpha:=round(r.a);
|
||||||
|
temp.Alpha:=(temp.Alpha shl 8) + temp.Alpha;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
temp.Alpha:=AlphaOpaque;
|
||||||
|
Result:=temp;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFPFloydSteinbergDitherer.CreatePixelLine(var line : PFSPixelLine; const row : integer);
|
||||||
|
var i : integer;
|
||||||
|
begin
|
||||||
|
line:=GetMem(sizeof(TFSPixelLine));
|
||||||
|
if line=nil then
|
||||||
|
raise FPDithererException.Create('Out of memory');
|
||||||
|
line^.next:=nil;
|
||||||
|
{ two extra pixels so we don't have to check if the pixel is on start or end of line }
|
||||||
|
getmem(line^.pixels,sizeof(TFPPixelReal)*(FImage.Width+2));
|
||||||
|
if line^.pixels=nil then
|
||||||
|
raise FPDithererException.Create('Out of memory');
|
||||||
|
if row<FImage.Height-1 then
|
||||||
|
begin
|
||||||
|
line^.pixels[0]:=FSNullPixel;
|
||||||
|
line^.pixels[FImage.Width+1]:=FSNullPixel;
|
||||||
|
for i:=0 to FImage.Width-1 do
|
||||||
|
line^.pixels[i+1]:=Color2Real(FImage[i,row]);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
for i:=0 to FImage.Width+1 do
|
||||||
|
line^.pixels[i]:=FSNullPixel;
|
||||||
|
end;
|
||||||
|
|
||||||
|
const e716 = 0.4375;
|
||||||
|
e516 = 0.3125;
|
||||||
|
e316 = 0.1875;
|
||||||
|
e116 = 0.0625;
|
||||||
|
|
||||||
|
procedure TFPFloydSteinbergDitherer.DistributeErrors(var line : PFSPixelLine; const row : integer; Img : TFPCustomImage);
|
||||||
|
var i, width : integer;
|
||||||
|
palindex : integer;
|
||||||
|
OldColor : TFPColor;
|
||||||
|
dir : shortint;
|
||||||
|
nextline : PFSPixelLine;
|
||||||
|
begin
|
||||||
|
width:=FImage.Width;
|
||||||
|
if (row mod 2)=0 then
|
||||||
|
begin
|
||||||
|
dir:=1;
|
||||||
|
i:=1;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
dir:=-1;
|
||||||
|
i:=width;
|
||||||
|
end;
|
||||||
|
if width<1 then exit;
|
||||||
|
|
||||||
|
repeat
|
||||||
|
OldColor:=Real2Color(line^.pixels[i]);
|
||||||
|
FindBestColor(OldColor, palindex);
|
||||||
|
Img.Pixels[i-1,row]:=palindex; { we use this color for this pixel... }
|
||||||
|
line^.pixels[i]:=GetError(OldColor,Palette[palindex]);
|
||||||
|
{ now distribute this error to the other pixels, in this way: }
|
||||||
|
{ note: for odd lines this is mirrored and we start from right}
|
||||||
|
{ 0 0 0 }
|
||||||
|
{ 0 X 7/16 }
|
||||||
|
{ 3/16 5/16 1/16 }
|
||||||
|
line^.pixels[i+dir].r:=line^.pixels[i+dir].r+(line^.pixels[i].r*e716);
|
||||||
|
line^.pixels[i+dir].g:=line^.pixels[i+dir].g+(line^.pixels[i].g*e716);
|
||||||
|
line^.pixels[i+dir].b:=line^.pixels[i+dir].b+(line^.pixels[i].b*e716);
|
||||||
|
if FUseAlpha then
|
||||||
|
line^.pixels[i+dir].a:=line^.pixels[i+dir].a+(line^.pixels[i].a*e716);
|
||||||
|
nextline:=line^.next;
|
||||||
|
|
||||||
|
nextline^.pixels[i].r:=nextline^.pixels[i].r+(line^.pixels[i].r*e516);
|
||||||
|
nextline^.pixels[i].g:=nextline^.pixels[i].g+(line^.pixels[i].g*e516);
|
||||||
|
nextline^.pixels[i].b:=nextline^.pixels[i].b+(line^.pixels[i].b*e516);
|
||||||
|
if FUseAlpha then
|
||||||
|
nextline^.pixels[i].a:=nextline^.pixels[i].a+(line^.pixels[i].a*e516);
|
||||||
|
|
||||||
|
nextline^.pixels[i+dir].r:=nextline^.pixels[i+dir].r+(line^.pixels[i].r*e116);
|
||||||
|
nextline^.pixels[i+dir].g:=nextline^.pixels[i+dir].g+(line^.pixels[i].g*e116);
|
||||||
|
nextline^.pixels[i+dir].b:=nextline^.pixels[i+dir].b+(line^.pixels[i].b*e116);
|
||||||
|
if FUseAlpha then
|
||||||
|
nextline^.pixels[i+dir].a:=nextline^.pixels[i+dir].a+(line^.pixels[i].a*e116);
|
||||||
|
|
||||||
|
nextline^.pixels[i-dir].r:=nextline^.pixels[i-dir].r+(line^.pixels[i].r*e316);
|
||||||
|
nextline^.pixels[i-dir].g:=nextline^.pixels[i-dir].g+(line^.pixels[i].g*e316);
|
||||||
|
nextline^.pixels[i-dir].b:=nextline^.pixels[i-dir].b+(line^.pixels[i].b*e316);
|
||||||
|
if FUseAlpha then
|
||||||
|
nextline^.pixels[i-dir].a:=nextline^.pixels[i-dir].a+(line^.pixels[i].a*e316);
|
||||||
|
|
||||||
|
i:=i+dir;
|
||||||
|
until ((i<1) or (i>width));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFPFloydSteinbergDitherer.DeleteAllPixelLines(var line : PFSPixelLine);
|
||||||
|
var tmp : PFSPixelLine;
|
||||||
|
begin
|
||||||
|
while line<>nil do
|
||||||
|
begin
|
||||||
|
tmp:=line^.next;
|
||||||
|
FreeMem(line^.pixels);
|
||||||
|
FreeMem(line);
|
||||||
|
line:=tmp;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFPFloydSteinbergDitherer.InternalDither(const Source : TFPCustomImage; Dest : TFPCustomImage);
|
||||||
|
var i : integer;
|
||||||
|
tmpline : PFSPixelLine;
|
||||||
|
percent : byte;
|
||||||
|
percentinterval : longword;
|
||||||
|
percentacc : longword;
|
||||||
|
FContinue : boolean;
|
||||||
|
begin
|
||||||
|
FImage:=Source;
|
||||||
|
if FImage.Height=0 then exit;
|
||||||
|
Dest.SetSize(0,0);
|
||||||
|
try
|
||||||
|
Dest.UsePalette:=true;
|
||||||
|
Dest.Palette.Clear;
|
||||||
|
Dest.Palette.Merge(FPalette);
|
||||||
|
Dest.SetSize(FImage.Width,FImage.Height);
|
||||||
|
percent:=0;
|
||||||
|
percentinterval:=(FImage.Height*4) div 100;
|
||||||
|
if percentinterval=0 then percentinterval:=$FFFFFFFF;
|
||||||
|
percentacc:=0;
|
||||||
|
FContinue:=true;
|
||||||
|
Progress (self,psStarting,0,'',FContinue);
|
||||||
|
if not FContinue then exit;
|
||||||
|
CreatePixelLine(Lines,0);
|
||||||
|
CreatePixelLine(Lines^.next,1);
|
||||||
|
|
||||||
|
for i:=0 to FImage.Height-1 do
|
||||||
|
begin
|
||||||
|
DistributeErrors(Lines, i, Dest);
|
||||||
|
tmpline:=Lines;
|
||||||
|
Lines:=Lines^.next;
|
||||||
|
FreeMem(tmpline^.pixels);
|
||||||
|
FreeMem(tmpline);
|
||||||
|
CreatePixelLine(Lines^.next,i+2);
|
||||||
|
inc(percentacc,4);
|
||||||
|
if percentacc>=percentinterval then
|
||||||
|
begin
|
||||||
|
percent:=percent+(percentacc div percentinterval);
|
||||||
|
percentacc:=percentacc mod percentinterval;
|
||||||
|
Progress (self,psRunning,percent,'',FContinue);
|
||||||
|
if not FContinue then exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
Progress (self,psEnding,100,'',FContinue);
|
||||||
|
finally
|
||||||
|
DeleteAllPixelLines(lines);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
end.
|
||||||
787
fcl/image/fpquantizer.pas
Normal file
787
fcl/image/fpquantizer.pas
Normal file
@ -0,0 +1,787 @@
|
|||||||
|
{*****************************************************************************}
|
||||||
|
{
|
||||||
|
This file is part of the Free Pascal's "Free Components Library".
|
||||||
|
Copyright (c) 2005 by Giulio Bernardi
|
||||||
|
|
||||||
|
This file contains classes used to quantize images.
|
||||||
|
|
||||||
|
See the file COPYING.FPC, included in this distribution,
|
||||||
|
for details about the copyright.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful,
|
||||||
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||||
|
}
|
||||||
|
{*****************************************************************************}
|
||||||
|
|
||||||
|
{$mode objfpc}{$h+}
|
||||||
|
unit FPQuantizer;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses sysutils, classes, fpimage, fpcolhash;
|
||||||
|
|
||||||
|
type
|
||||||
|
FPQuantizerException = class (exception);
|
||||||
|
|
||||||
|
type
|
||||||
|
TFPQuantizerProgressEvent = procedure (Sender: TObject; Stage: TFPImgProgressStage; PercentDone: Byte;
|
||||||
|
const Msg: AnsiString; var Continue : Boolean) of object;
|
||||||
|
|
||||||
|
type
|
||||||
|
TFPColorQuantizer = class
|
||||||
|
private
|
||||||
|
FOnProgress : TFPQuantizerProgressEvent;
|
||||||
|
protected
|
||||||
|
FColNum : longword;
|
||||||
|
FSupportsAlpha : boolean;
|
||||||
|
FImages : array of TFPCustomImage;
|
||||||
|
FCount : integer;
|
||||||
|
function InternalQuantize : TFPPalette; virtual; abstract;
|
||||||
|
procedure SetColNum(AColNum : longword); virtual;
|
||||||
|
procedure Progress (Sender: TObject; Stage: TFPImgProgressStage; PercentDone: Byte; const Msg: AnsiString; var Continue : Boolean); virtual;
|
||||||
|
function GetImage(Index : integer) : TFPCustomImage;
|
||||||
|
procedure SetImage(Index : integer; const Img : TFPCustomImage);
|
||||||
|
procedure SetCount(Value : integer);
|
||||||
|
public
|
||||||
|
property OnProgress : TFPQuantizerProgressEvent read FOnProgress write FOnProgress;
|
||||||
|
property Images[Index : integer] : TFPCustomImage read GetImage write SetImage;
|
||||||
|
property Count : integer read FCount write SetCount;
|
||||||
|
property ColorNumber : longword read FColNum write SetColNum;
|
||||||
|
property SupportsAlpha : boolean read FSupportsAlpha;
|
||||||
|
procedure Clear;
|
||||||
|
procedure Add(const Img : TFPCustomImage);
|
||||||
|
function Quantize : TFPPalette;
|
||||||
|
constructor Create; virtual;
|
||||||
|
destructor Destroy; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
type
|
||||||
|
POctreeQNode = ^TOctreeQNode;
|
||||||
|
TOctreeQChilds = array[0..7] of POctreeQNode;
|
||||||
|
TOctreeQNode = record
|
||||||
|
isleaf : boolean;
|
||||||
|
count : longword;
|
||||||
|
R, G, B : longword;
|
||||||
|
Next : POctreeQNode; //used in the reduction list.
|
||||||
|
Childs : TOctreeQChilds;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
type
|
||||||
|
TFPOctreeQuantizer = class(TFPColorQuantizer)
|
||||||
|
private
|
||||||
|
Root : POctreeQNode;
|
||||||
|
ReductionList : TOctreeQChilds;
|
||||||
|
LeafTot, MaxLeaf : longword;
|
||||||
|
percent : byte; { these values are used to call OnProgress event }
|
||||||
|
percentinterval : longword;
|
||||||
|
percentacc : longword;
|
||||||
|
FContinue : boolean;
|
||||||
|
procedure DisposeNode(var Node : POctreeQNode);
|
||||||
|
procedure AddColor(var Node : POctreeQNode; const R, G, B, Level : byte);
|
||||||
|
procedure AddToPalette(var Node : POctreeQNode; Palette : TFPPalette; var Current : integer);
|
||||||
|
procedure Reduce;
|
||||||
|
function BuildPalette : TFPPalette;
|
||||||
|
protected
|
||||||
|
function InternalQuantize : TFPPalette; override;
|
||||||
|
public
|
||||||
|
end;
|
||||||
|
|
||||||
|
type
|
||||||
|
TMCBox = record
|
||||||
|
total, startindex, endindex : longword;
|
||||||
|
end;
|
||||||
|
|
||||||
|
const mcSlow = 0;
|
||||||
|
mcNormal = 1;
|
||||||
|
mcFast = 2;
|
||||||
|
|
||||||
|
type
|
||||||
|
TFPMedianCutQuantizer = class(TFPColorQuantizer)
|
||||||
|
private
|
||||||
|
HashTable, palcache : TFPColorHashTable;
|
||||||
|
arr : TFPColorWeightArray;
|
||||||
|
boxes : array of TMCBox;
|
||||||
|
Used : integer;
|
||||||
|
percent : byte; { these values are used to call OnProgress event }
|
||||||
|
percentinterval : longword;
|
||||||
|
percentacc : longword;
|
||||||
|
FContinue : boolean;
|
||||||
|
FMode : byte;
|
||||||
|
function ColorCompare(const c1, c2 : TFPPackedColor; const Dim : byte) : shortint;
|
||||||
|
function FindLargestDimension(const Box : TMCBox) : byte;
|
||||||
|
procedure QuickSort(const l, r : integer; const Dim : byte);
|
||||||
|
procedure QuickSortBoxes(const l, r : integer);
|
||||||
|
function MeanBox(const box : TMCBox) : TFPColor;
|
||||||
|
function BuildPalette : TFPPalette;
|
||||||
|
procedure SetMode(const Amode : byte);
|
||||||
|
function MaskColor(const col : TFPColor) : TFPColor;
|
||||||
|
protected
|
||||||
|
function InternalQuantize : TFPPalette; override;
|
||||||
|
public
|
||||||
|
constructor Create; override;
|
||||||
|
property Mode : byte read FMode write SetMode;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
function RGB2FPColor(const R, G, B : longword) : TFPColor;
|
||||||
|
begin
|
||||||
|
Result.Red:=(R shl 8) + R;
|
||||||
|
Result.Green:=(G shl 8) + G;
|
||||||
|
Result.Blue:=(B shl 8) + B;
|
||||||
|
Result.Alpha := AlphaOpaque;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TFPColorQuantizer }
|
||||||
|
|
||||||
|
function TFPColorQuantizer.Quantize : TFPPalette;
|
||||||
|
begin
|
||||||
|
Result:=InternalQuantize;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TFPColorQuantizer.Create;
|
||||||
|
begin
|
||||||
|
FSupportsAlpha:=false;
|
||||||
|
FColNum:=256; //default setting.
|
||||||
|
FCount:=0;
|
||||||
|
setlength(FImages,0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TFPColorQuantizer.Destroy;
|
||||||
|
begin
|
||||||
|
Setlength(FImages,0);
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFPColorQuantizer.SetColNum(AColNum : longword);
|
||||||
|
begin
|
||||||
|
if AColNum<2 then
|
||||||
|
raise FPQuantizerException.Create('Invalid color depth: '+IntToStr(AColNum));
|
||||||
|
FColNum:=AColNum;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFPColorQuantizer.Progress(Sender: TObject; Stage: TFPImgProgressStage; PercentDone: Byte; const Msg: AnsiString; var Continue : Boolean);
|
||||||
|
begin
|
||||||
|
if Assigned(FOnProgress) then
|
||||||
|
FOnProgress(Sender,Stage,PercentDone,Msg,Continue);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TFPColorQuantizer.GetImage(Index : integer) : TFPCustomImage;
|
||||||
|
begin
|
||||||
|
if Index>=FCount then
|
||||||
|
raise FPQuantizerException.Create('Invalid image index: '+IntToStr(Index));
|
||||||
|
Result:=FImages[index];
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFPColorQuantizer.SetImage(Index : integer; const Img : TFPCustomImage);
|
||||||
|
begin
|
||||||
|
if Index>=FCount then
|
||||||
|
raise FPQuantizerException.Create('Invalid image index: '+IntToStr(Index));
|
||||||
|
FImages[Index]:=Img;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFPColorQuantizer.SetCount(Value : integer);
|
||||||
|
var old, i : integer;
|
||||||
|
begin
|
||||||
|
old:=FCount;
|
||||||
|
setlength(FImages,Value);
|
||||||
|
for i:=old to Value-1 do
|
||||||
|
FImages[i]:=nil;
|
||||||
|
FCount:=Value;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFPColorQuantizer.Clear;
|
||||||
|
begin
|
||||||
|
setlength(FImages,0);
|
||||||
|
FCount:=0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFPColorQuantizer.Add(const Img : TFPCustomImage);
|
||||||
|
var i : integer;
|
||||||
|
begin
|
||||||
|
{ Find first unused slot }
|
||||||
|
for i:=0 to FCount-1 do
|
||||||
|
if FImages[i]=nil then
|
||||||
|
begin
|
||||||
|
Fimages[i]:=Img;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
{ If we reached this point there are no unused slot: let's enlarge the array }
|
||||||
|
SetCount(Fcount+1);
|
||||||
|
FImages[FCount-1]:=Img;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TFPOctreeQuantizer }
|
||||||
|
|
||||||
|
const Mask : array[0..7] of byte = ($80, $40, $20, $10, $08, $04, $02, $01);
|
||||||
|
|
||||||
|
procedure TFPOctreeQuantizer.AddColor(var Node : POctreeQNode; const R, G, B, Level : byte);
|
||||||
|
var index, shift : byte;
|
||||||
|
begin
|
||||||
|
if Node=nil then
|
||||||
|
begin
|
||||||
|
Node:=getmem(sizeof(TOctreeQNode));
|
||||||
|
if Node=nil then
|
||||||
|
raise FPQuantizerException.Create('Out of memory');
|
||||||
|
FillByte(Node^,sizeof(TOctreeQNode),0);
|
||||||
|
if level=7 then
|
||||||
|
begin
|
||||||
|
Node^.isleaf:=true;
|
||||||
|
inc(LeafTot); { we just created a new leaf }
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin { we don't put leaves in reduction list since this is unuseful }
|
||||||
|
Node^.isleaf:=false;
|
||||||
|
Node^.Next:=ReductionList[level]; { added on top of the reduction list for its level }
|
||||||
|
ReductionList[level]:=Node;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
if Node^.isleaf then
|
||||||
|
begin
|
||||||
|
inc(Node^.R,R);
|
||||||
|
inc(Node^.G,G);
|
||||||
|
inc(Node^.B,B);
|
||||||
|
inc(Node^.count);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
shift:=7-level;
|
||||||
|
index:=((R and mask[level]) shr shift) shl 2;
|
||||||
|
index:=index+((G and mask[level]) shr shift) shl 1;
|
||||||
|
index:=index+((B and mask[level]) shr shift);
|
||||||
|
AddColor(Node^.Childs[index],R,G,B,Level+1);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFPOctreeQuantizer.DisposeNode(var Node : POctreeQNode);
|
||||||
|
var i : integer;
|
||||||
|
begin
|
||||||
|
if Node=nil then exit;
|
||||||
|
if not (Node^.isleaf) then
|
||||||
|
for i:=0 to 7 do
|
||||||
|
if Node^.childs[i]<>nil then
|
||||||
|
DisposeNode(Node^.childs[i]);
|
||||||
|
FreeMem(Node);
|
||||||
|
Node:=nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFPOctreeQuantizer.Reduce;
|
||||||
|
var i : integer;
|
||||||
|
Node : POctreeQNode;
|
||||||
|
begin
|
||||||
|
i:=6; { level 7 nodes don't have childs, start from 6 and go backward }
|
||||||
|
while ((i>0) and (ReductionList[i]=nil)) do
|
||||||
|
dec(i);
|
||||||
|
|
||||||
|
{ remove this node from the list}
|
||||||
|
Node:=ReductionList[i];
|
||||||
|
ReductionList[i]:=Node^.Next;
|
||||||
|
|
||||||
|
for i:=0 to 7 do
|
||||||
|
if Node^.childs[i]<>nil then
|
||||||
|
begin
|
||||||
|
inc(Node^.count,Node^.childs[i]^.count);
|
||||||
|
inc(Node^.r,Node^.childs[i]^.r);
|
||||||
|
inc(Node^.g,Node^.childs[i]^.g);
|
||||||
|
inc(Node^.b,Node^.childs[i]^.b);
|
||||||
|
DisposeNode(Node^.childs[i]);
|
||||||
|
dec(LeafTot);
|
||||||
|
end;
|
||||||
|
Node^.isleaf:=true;
|
||||||
|
inc(LeafTot); { this node is now a leaf! }
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFPOctreeQuantizer.AddToPalette(var Node : POctreeQNode; Palette : TFPPalette; var Current : integer);
|
||||||
|
var i : byte;
|
||||||
|
begin
|
||||||
|
if not FContinue then exit;
|
||||||
|
|
||||||
|
if Node^.isleaf then
|
||||||
|
begin
|
||||||
|
if (current >= LeafTot) then
|
||||||
|
raise FPQuantizerException.Create('Octree Quantizer internal error: palette index too high.');
|
||||||
|
Node^.r:= Node^.r div Node^.count;
|
||||||
|
Node^.g:= Node^.g div Node^.count;
|
||||||
|
Node^.b:= Node^.b div Node^.count;
|
||||||
|
Palette.Color[Current]:=RGB2FPColor(Node^.r,Node^.g,Node^.b);
|
||||||
|
inc(current);
|
||||||
|
|
||||||
|
{ ************************************************ }
|
||||||
|
inc(percentacc);
|
||||||
|
if percentacc>=percentinterval then
|
||||||
|
begin
|
||||||
|
dec(percentacc,percentinterval);
|
||||||
|
inc(percent);
|
||||||
|
Progress(self,psRunning,percent,'',FContinue);
|
||||||
|
end;
|
||||||
|
{ ************************************************ }
|
||||||
|
|
||||||
|
end
|
||||||
|
else
|
||||||
|
for i:=0 to 7 do
|
||||||
|
if Node^.childs[i]<>nil then
|
||||||
|
AddToPalette(Node^.childs[i],Palette,Current);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TFPOctreeQuantizer.BuildPalette : TFPPalette;
|
||||||
|
var pal : TFPPalette;
|
||||||
|
i : integer;
|
||||||
|
begin
|
||||||
|
if Root=nil then exit;
|
||||||
|
pal:=TFPPalette.Create(LeafTot);
|
||||||
|
i:=0;
|
||||||
|
try
|
||||||
|
AddToPalette(Root,pal,i);
|
||||||
|
except
|
||||||
|
pal.Free;
|
||||||
|
pal:=nil;
|
||||||
|
raise;
|
||||||
|
end;
|
||||||
|
if not FContinue then
|
||||||
|
begin
|
||||||
|
pal.Free;
|
||||||
|
pal:=nil;
|
||||||
|
end;
|
||||||
|
Result:=pal;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TFPOctreeQuantizer.InternalQuantize : TFPPalette;
|
||||||
|
var i, j, k : integer;
|
||||||
|
color : TFPColor;
|
||||||
|
begin
|
||||||
|
Root:=nil;
|
||||||
|
for i:=0 to high(ReductionList) do
|
||||||
|
ReductionList[i]:=nil;
|
||||||
|
LeafTot:=0;
|
||||||
|
MaxLeaf:=FColNum;
|
||||||
|
|
||||||
|
{ ************************************************************** }
|
||||||
|
{ set up some values useful when calling OnProgress event }
|
||||||
|
{ number of operations is: }
|
||||||
|
{ width*heigth for population }
|
||||||
|
{ initial palette count - final palette count for reduction }
|
||||||
|
{ final palette count for building the palette }
|
||||||
|
{ total: width*heigth+initial palette count. }
|
||||||
|
{ if source image doesn't have a palette assume palette count as }
|
||||||
|
{ width*height (worst scenario) if it is < 2^24, or 2^24 else }
|
||||||
|
percentinterval:=0;
|
||||||
|
percentacc:=0;
|
||||||
|
for i:=0 to FCount-1 do
|
||||||
|
if FImages[i]<>nil then
|
||||||
|
begin
|
||||||
|
percentinterval:=percentinterval+FImages[i].Width*FImages[i].Height;
|
||||||
|
if FImages[i].UsePalette then
|
||||||
|
percentacc:=percentacc+FImages[i].Palette.Count
|
||||||
|
else
|
||||||
|
percentacc:=percentacc+FImages[i].Width*FImages[i].Height;
|
||||||
|
end;
|
||||||
|
if percentacc>$1000000 then percentacc:=$1000000;
|
||||||
|
|
||||||
|
percentinterval:=(percentacc+percentinterval) div 100; { how many operations for 1% }
|
||||||
|
if percentinterval=0 then percentinterval:=$FFFFFFFF; { it's quick, call progress only when starting and ending }
|
||||||
|
percent:=0;
|
||||||
|
percentacc:=0;
|
||||||
|
FContinue:=true;
|
||||||
|
Progress (self,psStarting,0,'',FContinue);
|
||||||
|
Result:=nil;
|
||||||
|
if not FContinue then exit;
|
||||||
|
{ ************************************************************** }
|
||||||
|
|
||||||
|
{ populate the octree with colors }
|
||||||
|
try
|
||||||
|
for k:=0 to FCount-1 do
|
||||||
|
if FImages[k]<>nil then
|
||||||
|
for j:=0 to FImages[k].Height-1 do
|
||||||
|
for i:=0 to FImages[k].Width-1 do
|
||||||
|
begin
|
||||||
|
Color:=FImages[k][i,j];
|
||||||
|
AddColor(Root,(Color.Red and $FF00) shr 8,(Color.Green and $FF00) shr 8,(Color.Blue and $FF00) shr 8,0);
|
||||||
|
{ ************************************************* }
|
||||||
|
inc(percentacc);
|
||||||
|
if percentacc>=percentinterval then
|
||||||
|
begin
|
||||||
|
dec(percentacc,percentinterval);
|
||||||
|
inc(percent);
|
||||||
|
Progress(self,psRunning,percent,'',FContinue);
|
||||||
|
if not FContinue then exit;
|
||||||
|
end;
|
||||||
|
{ ************************************************* }
|
||||||
|
end;
|
||||||
|
{ reduce number of colors until it is <= MaxLeaf }
|
||||||
|
while LeafTot > MaxLeaf do
|
||||||
|
begin
|
||||||
|
Reduce;
|
||||||
|
{ ************************************************* }
|
||||||
|
inc(percentacc);
|
||||||
|
if percentacc>=percentinterval then
|
||||||
|
begin
|
||||||
|
dec(percentacc,percentinterval);
|
||||||
|
inc(percent);
|
||||||
|
Progress(self,psRunning,percent,'',FContinue);
|
||||||
|
if not FContinue then exit;
|
||||||
|
end;
|
||||||
|
{ ************************************************* }
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ build the palette }
|
||||||
|
Result:=BuildPalette;
|
||||||
|
if FContinue then Progress (self,psEnding,100,'',FContinue);
|
||||||
|
finally
|
||||||
|
DisposeNode(Root);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TFPMedianCutQuantizer }
|
||||||
|
|
||||||
|
const DIM_ALPHA = 0;
|
||||||
|
DIM_RED = 1;
|
||||||
|
DIM_GREEN = 2;
|
||||||
|
DIM_BLUE = 3;
|
||||||
|
|
||||||
|
constructor TFPMedianCutQuantizer.Create;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FSupportsAlpha:=true;
|
||||||
|
FMode:=mcNormal;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFPMedianCutQuantizer.SetMode(const Amode : byte);
|
||||||
|
begin
|
||||||
|
if not (Amode in [mcSlow,mcNormal,mcFast]) then
|
||||||
|
raise FPQuantizerException.Create('Invalid quantizer mode: '+IntToStr(Amode));
|
||||||
|
FMode:=Amode;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TFPMedianCutQuantizer.FindLargestDimension(const Box : TMCBox) : byte;
|
||||||
|
var i : longword;
|
||||||
|
col : TFPPackedColor;
|
||||||
|
maxa, mina, maxr, minr, maxg, ming, maxb, minb : byte;
|
||||||
|
begin
|
||||||
|
maxa:=0; maxr:=0; maxg:=0; maxb:=0;
|
||||||
|
mina:=$FF; minr:=$FF; ming:=$FF; minb:=$FF;
|
||||||
|
for i:=box.startindex to box.endindex do
|
||||||
|
begin
|
||||||
|
col:=arr[i]^.Col;
|
||||||
|
if col.A<mina then mina:=col.A;
|
||||||
|
if col.A>maxa then maxa:=col.A;
|
||||||
|
if col.R<minr then minr:=col.R;
|
||||||
|
if col.R>maxr then maxr:=col.R;
|
||||||
|
if col.G<ming then ming:=col.G;
|
||||||
|
if col.G>maxg then maxg:=col.G;
|
||||||
|
if col.B<minb then minb:=col.B;
|
||||||
|
if col.B>maxb then maxb:=col.B;
|
||||||
|
end;
|
||||||
|
maxa:=maxa-mina;
|
||||||
|
maxr:=maxr-minr;
|
||||||
|
maxg:=maxg-ming;
|
||||||
|
maxb:=maxb-minb;
|
||||||
|
if ((maxa>maxr) and (maxa>maxg) and (maxa>maxb)) then Result:=DIM_ALPHA
|
||||||
|
else if ((maxr>maxa) and (maxr>maxg) and (maxr>maxb)) then Result:=DIM_RED
|
||||||
|
else if ((maxg>maxa) and (maxg>maxr) and (maxg>maxb)) then Result:=DIM_GREEN
|
||||||
|
else Result:=DIM_BLUE;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TFPMedianCutQuantizer.ColorCompare(const c1, c2 : TFPPackedColor; const Dim : byte) : shortint;
|
||||||
|
var tmp : integer;
|
||||||
|
begin
|
||||||
|
case Dim of
|
||||||
|
DIM_ALPHA : tmp:=(c1.A-c2.A);
|
||||||
|
DIM_RED : tmp:=(c1.R-c2.R);
|
||||||
|
DIM_GREEN : tmp:=(c1.G-c2.G);
|
||||||
|
DIM_BLUE : tmp:=(c1.B-c2.B)
|
||||||
|
else raise FPQuantizerException.Create('Invalid dimension: '+IntToStr(Dim));
|
||||||
|
end;
|
||||||
|
if tmp>0 then Result:=1
|
||||||
|
else if tmp<0 then Result:=-1
|
||||||
|
else Result:=0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFPMedianCutQuantizer.QuickSort(const l, r : integer; const Dim : byte);
|
||||||
|
var i, j : integer;
|
||||||
|
pivot, temp : PFPColorWeight;
|
||||||
|
begin
|
||||||
|
if l<r then
|
||||||
|
begin
|
||||||
|
pivot:=arr[l];
|
||||||
|
i:=l+1;
|
||||||
|
j:=r;
|
||||||
|
repeat
|
||||||
|
while ((i<=r) and (ColorCompare(arr[i]^.Col,pivot^.Col,dim)<=0)) do
|
||||||
|
inc(i);
|
||||||
|
while (ColorCompare(arr[j]^.Col,pivot^.Col,dim)=1) do
|
||||||
|
dec(j);
|
||||||
|
if i<j then
|
||||||
|
begin
|
||||||
|
temp:=arr[i];
|
||||||
|
arr[i]:=arr[j];
|
||||||
|
arr[j]:=temp;
|
||||||
|
end;
|
||||||
|
until i > j;
|
||||||
|
{ don't swap if they are equal }
|
||||||
|
if ColorCompare(arr[j]^.Col,pivot^.Col,dim)<>0 then
|
||||||
|
begin
|
||||||
|
arr[l]:=arr[j];
|
||||||
|
arr[j]:=pivot;
|
||||||
|
end;
|
||||||
|
Quicksort(l,j-1,dim);
|
||||||
|
Quicksort(i,r,dim);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFPMedianCutQuantizer.QuickSortBoxes(const l, r : integer);
|
||||||
|
var i, j : integer;
|
||||||
|
pivot, temp : TMCBox;
|
||||||
|
begin
|
||||||
|
if l<r then
|
||||||
|
begin
|
||||||
|
pivot:=boxes[l];
|
||||||
|
i:=l+1;
|
||||||
|
j:=r;
|
||||||
|
repeat
|
||||||
|
while ((i<=r) and (boxes[i].total>=pivot.total)) do
|
||||||
|
inc(i);
|
||||||
|
while (boxes[j].total<pivot.total) do
|
||||||
|
dec(j);
|
||||||
|
if i<j then
|
||||||
|
begin
|
||||||
|
temp:=boxes[i];
|
||||||
|
boxes[i]:=boxes[j];
|
||||||
|
boxes[j]:=temp;
|
||||||
|
end;
|
||||||
|
until i > j;
|
||||||
|
{ don't swap if they are equal }
|
||||||
|
if boxes[j].total<>pivot.total then
|
||||||
|
begin
|
||||||
|
boxes[l]:=boxes[j];
|
||||||
|
boxes[j]:=pivot;
|
||||||
|
end;
|
||||||
|
QuicksortBoxes(l,j-1);
|
||||||
|
QuicksortBoxes(i,r);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TFPMedianCutQuantizer.MeanBox(const box : TMCBox) : TFPColor;
|
||||||
|
var tota,totr,totg,totb, pixcount : longword;
|
||||||
|
i : integer;
|
||||||
|
col : TFPPackedColor;
|
||||||
|
fpcol : TFPColor;
|
||||||
|
begin
|
||||||
|
tota:=0; totr:=0; totg:=0; totb:=0; pixcount:=0;
|
||||||
|
for i:=box.startindex to box.endindex do
|
||||||
|
begin
|
||||||
|
tota:=tota+(arr[i]^.Col.A*arr[i]^.Num);
|
||||||
|
totr:=totr+(arr[i]^.Col.R*arr[i]^.Num);
|
||||||
|
totg:=totg+(arr[i]^.Col.G*arr[i]^.Num);
|
||||||
|
totb:=totb+(arr[i]^.Col.B*arr[i]^.Num);
|
||||||
|
inc(pixcount,arr[i]^.Num);
|
||||||
|
end;
|
||||||
|
tota:=round(tota / pixcount);
|
||||||
|
totr:=round(totr / pixcount);
|
||||||
|
totg:=round(totg / pixcount);
|
||||||
|
totb:=round(totb / pixcount);
|
||||||
|
if tota>$FF then tota:=$FF;
|
||||||
|
if totr>$FF then totr:=$FF;
|
||||||
|
if totg>$FF then totg:=$FF;
|
||||||
|
if totb>$FF then totb:=$FF;
|
||||||
|
col.a:=tota;
|
||||||
|
col.r:=totr;
|
||||||
|
col.g:=totg;
|
||||||
|
col.b:=totb;
|
||||||
|
fpcol:=Packed2FPColor(col);
|
||||||
|
if palcache.Get(fpcol)<>nil then { already found, try the middle color }
|
||||||
|
begin
|
||||||
|
fpcol:=Packed2FPColor(arr[(box.startindex+box.endindex) div 2]^.Col);
|
||||||
|
if palcache.Get(fpcol)<>nil then { already found, try the first unused color }
|
||||||
|
for i:=box.startindex to box.endindex do
|
||||||
|
begin
|
||||||
|
col.a:=arr[i]^.Col.A;
|
||||||
|
col.r:=arr[i]^.Col.R;
|
||||||
|
col.g:=arr[i]^.Col.G;
|
||||||
|
col.b:=arr[i]^.Col.B;
|
||||||
|
fpcol:=Packed2FPColor(col);
|
||||||
|
if palcache.Get(fpcol)=nil then break;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
palcache.Insert(fpcol,nil);
|
||||||
|
Result:=fpcol;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TFPMedianCutQuantizer.BuildPalette : TFPPalette;
|
||||||
|
var pal : TFPPalette;
|
||||||
|
i : integer;
|
||||||
|
begin
|
||||||
|
pal:=TFPPalette.Create(Used);
|
||||||
|
try
|
||||||
|
palcache:=TFPColorHashTable.Create;
|
||||||
|
try
|
||||||
|
for i:=0 to Used-1 do
|
||||||
|
begin
|
||||||
|
pal.Color[i]:=MeanBox(boxes[i]);
|
||||||
|
{ ************************************************* }
|
||||||
|
inc(percentacc);
|
||||||
|
if percentacc>=percentinterval then
|
||||||
|
begin
|
||||||
|
percentacc:=percentacc mod percentinterval;
|
||||||
|
inc(percent);
|
||||||
|
Progress(self,psRunning,percent,'',FContinue);
|
||||||
|
if not FContinue then exit;
|
||||||
|
end;
|
||||||
|
{ ************************************************* }
|
||||||
|
end
|
||||||
|
finally
|
||||||
|
palcache.Free;
|
||||||
|
end;
|
||||||
|
except
|
||||||
|
pal.Free;
|
||||||
|
raise;
|
||||||
|
end;
|
||||||
|
Result:=pal;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ slow mode: no filtering
|
||||||
|
normal mode: 8 bit r, 6 bit g, 6 bit b
|
||||||
|
fast mode: 5 bit r, 5 bit g, 5 bit b }
|
||||||
|
|
||||||
|
const mask_r_normal = $FFFF;
|
||||||
|
mask_g_normal = $FCFC;
|
||||||
|
mask_b_normal = $FCFC;
|
||||||
|
mask_r_fast = $F8F8;
|
||||||
|
mask_g_fast = $F8F8;
|
||||||
|
mask_b_fast = $F8F8;
|
||||||
|
|
||||||
|
function TFPMedianCutQuantizer.MaskColor(const col : TFPColor) : TFPColor;
|
||||||
|
begin
|
||||||
|
case FMode of
|
||||||
|
mcNormal:
|
||||||
|
begin
|
||||||
|
Result.Red:=Col.Red and mask_r_normal;
|
||||||
|
Result.Green:=Col.Green and mask_g_normal;
|
||||||
|
Result.Blue:=Col.Blue and mask_b_normal;
|
||||||
|
end;
|
||||||
|
mcFast:
|
||||||
|
begin
|
||||||
|
Result.Red:=Col.Red and mask_r_fast;
|
||||||
|
Result.Green:=Col.Green and mask_g_fast;
|
||||||
|
Result.Blue:=Col.Blue and mask_b_fast;
|
||||||
|
end
|
||||||
|
else Result:=Col;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TFPMedianCutQuantizer.InternalQuantize : TFPPalette;
|
||||||
|
var box : ^TMCBox;
|
||||||
|
i, j, k : integer;
|
||||||
|
dim : byte;
|
||||||
|
boxpercent : longword;
|
||||||
|
begin
|
||||||
|
HashTable:=TFPColorHashTable.Create;
|
||||||
|
try
|
||||||
|
{ *****************************************************************************
|
||||||
|
Operations:
|
||||||
|
width*height of each image (populate the hash table)
|
||||||
|
number of desired colors for the box creation process (this should weight as the previous step)
|
||||||
|
number of desired colors for building the palette.
|
||||||
|
}
|
||||||
|
percentinterval:=0;
|
||||||
|
for k:=0 to FCount-1 do
|
||||||
|
if FImages[k]<>nil then
|
||||||
|
percentinterval:=percentinterval+FImages[k].Height*FImages[k].Width;
|
||||||
|
boxpercent:=percentinterval div FColNum;
|
||||||
|
percentinterval:=percentinterval*2+FColNum;
|
||||||
|
|
||||||
|
percentinterval:=percentinterval div 100; { how many operations for 1% }
|
||||||
|
if percentinterval=0 then percentinterval:=$FFFFFFFF; { it's quick, call progress only when starting and ending }
|
||||||
|
percent:=0;
|
||||||
|
percentacc:=0;
|
||||||
|
FContinue:=true;
|
||||||
|
Progress (self,psStarting,0,'',FContinue);
|
||||||
|
if not FContinue then exit;
|
||||||
|
{ ***************************************************************************** }
|
||||||
|
|
||||||
|
{ For every color in the images, count how many pixels use it}
|
||||||
|
for k:=0 to FCount-1 do
|
||||||
|
if FImages[k]<>nil then
|
||||||
|
for j:=0 to FImages[k].Height-1 do
|
||||||
|
for i:=0 to FImages[k].Width-1 do
|
||||||
|
begin
|
||||||
|
HashTable.Add(MaskColor(FImages[k][i,j]),1);
|
||||||
|
{ ************************************************* }
|
||||||
|
inc(percentacc);
|
||||||
|
if percentacc>=percentinterval then
|
||||||
|
begin
|
||||||
|
percentacc:=percentacc mod percentinterval;
|
||||||
|
inc(percent);
|
||||||
|
Progress(self,psRunning,percent,'',FContinue);
|
||||||
|
if not FContinue then exit;
|
||||||
|
end;
|
||||||
|
{ ************************************************* }
|
||||||
|
end;
|
||||||
|
{ Then let's have the list in array form }
|
||||||
|
setlength(arr,0);
|
||||||
|
arr:=HashTable.GetArray;
|
||||||
|
try
|
||||||
|
HashTable.Clear; { free some resources }
|
||||||
|
|
||||||
|
setlength(boxes,FColNum);
|
||||||
|
boxes[0].startindex:=0;
|
||||||
|
boxes[0].endindex:=length(arr)-1;
|
||||||
|
boxes[0].total:=boxes[0].endindex+1;
|
||||||
|
Used:=1;
|
||||||
|
|
||||||
|
while (used<FColNum) do
|
||||||
|
begin
|
||||||
|
box:=nil;
|
||||||
|
{ find a box with at least 2 colors }
|
||||||
|
for i:=0 to Used-1 do
|
||||||
|
if (boxes[i].total)>=2 then
|
||||||
|
begin
|
||||||
|
box:=@boxes[i];
|
||||||
|
break;
|
||||||
|
end;
|
||||||
|
if box=nil then break;
|
||||||
|
|
||||||
|
dim:=FindLargestDimension(box^);
|
||||||
|
{ sort the colors of the box along the largest dimension }
|
||||||
|
QuickSort(box^.startindex,box^.endindex,dim);
|
||||||
|
|
||||||
|
{ Split the box: half of the colors in the first one, the rest in the second one }
|
||||||
|
j:=(box^.startindex+box^.endindex) div 2;
|
||||||
|
{ This is the second box }
|
||||||
|
boxes[Used].startindex:=j+1;
|
||||||
|
boxes[Used].endindex:=box^.endindex;
|
||||||
|
boxes[Used].total:=box^.endindex-j;
|
||||||
|
{ And here we update the first box }
|
||||||
|
box^.endindex:=j;
|
||||||
|
box^.total:=box^.endindex-box^.startindex+1;
|
||||||
|
{ Sort the boxes so that the first one is the one with higher number of colors }
|
||||||
|
QuickSortBoxes(0,Used);
|
||||||
|
inc(Used);
|
||||||
|
|
||||||
|
{ ************************************************* }
|
||||||
|
inc(percentacc,boxpercent);
|
||||||
|
if percentacc>=percentinterval then
|
||||||
|
begin
|
||||||
|
inc(percent,percentacc div percentinterval);
|
||||||
|
percentacc:=percentacc mod percentinterval;
|
||||||
|
Progress(self,psRunning,percent,'',FContinue);
|
||||||
|
if not FContinue then exit;
|
||||||
|
end;
|
||||||
|
{ ************************************************* }
|
||||||
|
end;
|
||||||
|
Result:=BuildPalette;
|
||||||
|
if FContinue then Progress (self,psEnding,100,'',FContinue);
|
||||||
|
finally
|
||||||
|
setlength(boxes,0);
|
||||||
|
for i:=0 to length(arr)-1 do
|
||||||
|
FreeMem(arr[i]);
|
||||||
|
setlength(arr,0);
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
HashTable.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
Loading…
Reference in New Issue
Block a user