mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-10 10:49:22 +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/fpcdrawh.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/fpditherer.pas svneol=native#text/plain
|
||||
fcl/image/fpfont.inc svneol=native#text/plain
|
||||
fcl/image/fphandler.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/fppen.inc 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/fpreadjpeg.pas 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
|
||||
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
|
||||
PACKAGEDIR_MAIN:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /fcl/Makefile.fpc,$(PACKAGESDIR))))))
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
ifeq ($(FULL_TARGET),i386-linux)
|
||||
override TARGET_RSTS+=pscanvas
|
||||
|
||||
@ -12,7 +12,7 @@ packages=paszlib pasjpeg
|
||||
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
|
||||
targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer
|
||||
units_win32=freetypeh freetype ftfont
|
||||
units_linux=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