Transparency and bmp

Transparency and bmp I’m looking for codes to deal with transparent areas on BMP images. Any suggestion ?

Thanks !

----------------------------------------------------
Denis Pousseur
6 clos du Drossart
1180 Bruxelles, Belgique

Mail : denis.pousseur@compositeurs.be
Website : http://compositeurs.be
----------------------------------------------------

Re: Transparency and bmp

Denis Pousseur wrote:

> I’m looking for codes to deal with transparent areas on BMP images. 
> Any suggestion ?
>
> Thanks !
>
> ----------------------------------------------------
> Denis Pousseur
> 6 clos du Drossart
> 1180 Bruxelles, Belgique
>
> Mail : denis.pousseur@compositeurs.be
> Website : http://compositeurs.be
> ----------------------------------------------------
>
On LWW I use the Windows GDI Directly, in particular the GDI function
TransparentBlt. If you are looking for info for other LW platforms, the 
simple
answer is I do not know.

I ended up creating WINAPI and GDI packages (interface to the WIN32
library through the FFI). You can get the Window DC from a GP:GRAPHICS-PORT
so you can do normal WIN32 graphics operations.

There is (or was) the function 
gp:external-image-transparent-color-index, but
does not appear in the manual. I had trouble figuring out what it did
so I gave up. It took me a lot of time to do all this and other things,
but it has paid off in understanding the WIN32 API. The MSDN Library
goes into gory detail about dealing with transparency, but I just gave 
up trying
those methods and used the enhanced GDI functions.

Here is some example code, (I did not add enough for
everything to work ). The starting pace below is pixblt-image

With hundreds (if not thousands of lines deleted)....

There is screenshot of what all this code does, see

http://www3.telus.net/public/whumeniu/screenshot.bmp

Wade

---------------------------------------------------------------
(eval-when (:compile-toplevel :load-toplevel :execute)
(defstruct image
identifier
external-image
(memory-dc nil)
x
y
width
height
(transparent-color (gdi::rgb 0 0 0))))

(defconstant rgb-black (gdi::rgb 0 0 0))
(defconstant rgb-white (gdi::rgb 255 255 255))

(defparameter *next-badge-image*
(make-image :identifier :next-badge
:external-image (gdi::load-bitmap #p"RUNNING:Images;Next-Badge.bmp")
:transparent-color rgb-black
:x (- 72 24) :y (- 84 24) :width 24 :height 24))

(defmethod pixblt-image (badge (image image))
(if (image-memory-dc image)
(winapi::|TransparentBlt| (gdi::hdc badge)
(image-x image)
(image-y image)
(image-width image) (image-height image)
(image-memory-dc image) 0 0 (image-width image) (image-height image)
(image-transparent-color image))
(progn
(setf (image-memory-dc image)
(gdi::create-memory-dc-with-bitmap (gdi::hdc badge) 
(image-external-image image)))
(pixblt-image badge image))))

(defclass badge (capi:output-pane)
((entries :initform nil :initarg :entries :accessor entries :type list)
(current-entry-position :initform 0 :initarg :current-entry :accessor 
current-entry-position)
(date :initform (calendar:current-date) :initarg :date :accessor badge-date)
(milestone :initform nil :initarg :milestone :accessor milestone))
(:default-initargs
:visible-border nil
:background 'win32:color_3dface
:foreground :black
:input-model '(((:button-1 :press) simple-badge-select)
((:button-1 :second-press) details-badge-select)
(:post-menu popup-badge-menu))
:visible-min-width 72 :visible-max-width 72
:visible-min-height 84 :visible-max-height 84
:display-callback #'draw-badge))

----------------------------------------------------------
(in-package :winapi)

(eval-when (:compile-toplevel :load-toplevel :execute)
(fli:register-module :msimg32 :real-name "msimg32"))

(fli:define-c-typedef handle (:unsigned :long))
(fli:define-c-typedef colorref (:unsigned :long))
(fli:define-c-typedef dword (:unsigned :long))
(fli:define-c-typedef word (:unsigned :short))

(defmacro winapi-function (name args result-type &key (module "gdi32") 
(export t))
`(progn
(fli:define-foreign-function (,name ,(symbol-name name))
,args
:result-type ,result-type
:calling-convention :stdcall
:module ,module)
(when ,export (export ',name))))

(winapi-function |TransparentBlt|
((hdcDest handle)
(nXOriginDest :int)
(nYOriginDest :int)
(nWidthDest :int)
(hHeightDest :int)
(hdcSrc handle)
(nXOriginSrc :int)
(nYOriginSrc :int)
(nWidthSrc :int)
(nHeightSrc :int)
(crTransparent colorref))
:boolean
:module :msimg32)
-----------------------------------------------------
(in-package :gdi)

(defmacro hwnd (gp)
`(slot-value (slot-value ,gp 'gp::representation) 'win32:hwnd))
(defmacro hdc (gp)
`(slot-value (slot-value (slot-value ,gp 'gp::representation) 
'capi-win32-lib::dc) 'win32:hdc))

------------------------------------------------------
(in-package :gdi)

(eval-when (:compile-toplevel :load-toplevel :execute)
(defun rgb (red green blue)
(let ((rgb #x00000000))
(setf (ldb (byte 8 0) rgb) red)
(setf (ldb (byte 8 8) rgb) green)
(setf (ldb (byte 8 16) rgb) blue)
rgb)))

(defun convert-color-ref-to-rgb (color-ref)
(rgb
(round (* (color:color-red color-ref) 255))
(round (* (color:color-green color-ref) 255))
(round (* (color:color-blue color-ref) 255))))

(defun colorref (color)
(typecase color
(symbol
(let ((rgb (gethash color *color-database*)))
(if rgb
rgb
;; Also search LispWorks Color Database
(let ((color-spec (color:get-color-spec color)))
(if color-spec
(convert-color-ref-to-rgb color-spec)
(error "GDI: Could Not Find Color ~S" color))))))
(integer color)
(vector
;; Assume LispWorks color spec
(convert-color-ref-to-rgb color))))

(defun load-bitmap (path)
(with-open-file (file path :direction :input :element-type 
'(unsigned-byte 8))
(let* ((length (file-length file))
(bitmap-array (make-array length :element-type '(unsigned-byte 8))))
(read-sequence bitmap-array file)
bitmap-array)))

(defun read-long (byte-array offset)
(let ((long 0))
(setf (ldb (byte 8 0) long) (aref byte-array offset)
(ldb (byte 8 8) long) (aref byte-array (+ offset 1))
(ldb (byte 8 16) long) (aref byte-array (+ offset 2))
(ldb (byte 8 24) long) (aref byte-array (+ offset 3)))
long))

(defun byte-swapped-word (word)
(let ((swapped 0))
(setf (ldb (byte 8 0) swapped) (ldb (byte 8 8) word)
(ldb (byte 8 8) swapped) (ldb (byte 8 0) word))
swapped))

(defun write-long-to-byte-array (array integer &optional (offset 0))
(setf (aref array offset) (ldb (byte 8 0) integer)
(aref array (+ offset 1))(ldb (byte 8 8) integer)
(aref array (+ offset 2))(ldb (byte 8 16) integer)
(aref array (+ offset 3))(ldb (byte 8 24) integer)))

(defconstant +offset-file-size+ 2)
(defconstant +offset-offset-bits+ 10)
(defconstant +offset-info-header+ 14)
(defconstant +offset-to-bitmap-width+ 18)
(defconstant +offset-to-bitmap-height+ 22)

(defun bitmap-file-size (raw-bitmap)
(read-long raw-bitmap +offset-file-size+))
(defun bitmap-width (raw-bitmap)
(read-long raw-bitmap +offset-to-bitmap-width+))
(defun bitmap-height (raw-bitmap)
(read-long raw-bitmap +offset-to-bitmap-height+))
(defun bitmap-offset-bits (raw-bitmap)
(read-long raw-bitmap +offset-offset-bits+))

(defun create-memory-dc-with-bitmap (hdc raw-bitmap)
(let* ((width (bitmap-width raw-bitmap))
(height (bitmap-height raw-bitmap))
(size (bitmap-file-size raw-bitmap))
(offset-bits (bitmap-offset-bits raw-bitmap))
(hcdc (winapi:|CreateCompatibleDC| hdc))
(hbitmap (winapi:|CreateCompatibleBitmap| hdc width height)))
(winapi:|SelectObject| hcdc hbitmap)
(fli:with-dynamic-foreign-objects ()
(let* ((c-raw-bitmap (fli:allocate-dynamic-foreign-object :type :byte 
:nelems size))
(bitmap-bits (fli:copy-pointer c-raw-bitmap))
(info (fli:copy-pointer c-raw-bitmap)))
(loop for byte from 0 below size
do
(setf (fli:dereference c-raw-bitmap :index byte) (aref raw-bitmap byte)))
(fli:incf-pointer bitmap-bits offset-bits)
(fli:incf-pointer info +offset-info-header+)
(winapi:|SetDIBits| hcdc hbitmap 0 height bitmap-bits info 
winapi::DIB_RGB_COLORS))
hcdc)))

Re: Transparency and bmp

Unfortunately I'm on Mac...
But finally I found that the image functions of Lispworks now accept GIF and
PNG formats (I was on 4.3 and recently upgrade), so the transparency is
simply and perfectly supported.

Anyway, thank's for your answer

Denis 

Le 24/09/05 23:12, « Wade Humeniuk » <whumeniu@telus.net> a écrit :

> Denis Pousseur wrote:
> 
>> I¹m looking for codes to deal with transparent areas on BMP images.
>> Any suggestion ?
>> 
>> Thanks !
>> 
>> ----------------------------------------------------
>> Denis Pousseur
>> 6 clos du Drossart
>> 1180 Bruxelles, Belgique
>> 
>> Mail : denis.pousseur@compositeurs.be
>> Website : http://compositeurs.be
>> ----------------------------------------------------
>> 
> On LWW I use the Windows GDI Directly, in particular the GDI function
> TransparentBlt. If you are looking for info for other LW platforms, the
> simple
> answer is I do not know.
> 
> I ended up creating WINAPI and GDI packages (interface to the WIN32
> library through the FFI). You can get the Window DC from a GP:GRAPHICS-PORT
> so you can do normal WIN32 graphics operations.
> 
> There is (or was) the function
> gp:external-image-transparent-color-index, but
> does not appear in the manual. I had trouble figuring out what it did
> so I gave up. It took me a lot of time to do all this and other things,
> but it has paid off in understanding the WIN32 API. The MSDN Library
> goes into gory detail about dealing with transparency, but I just gave
> up trying
> those methods and used the enhanced GDI functions.
> 
> Here is some example code, (I did not add enough for
> everything to work ). The starting pace below is pixblt-image
> 
> With hundreds (if not thousands of lines deleted)....
> 
> There is screenshot of what all this code does, see
> 
> http://www3.telus.net/public/whumeniu/screenshot.bmp
> 
> Wade
> 
> ---------------------------------------------------------------
> (eval-when (:compile-toplevel :load-toplevel :execute)
> (defstruct image
> identifier
> external-image
> (memory-dc nil)
> x
> y
> width
> height
> (transparent-color (gdi::rgb 0 0 0))))
> 
> (defconstant rgb-black (gdi::rgb 0 0 0))
> (defconstant rgb-white (gdi::rgb 255 255 255))
> 
> (defparameter *next-badge-image*
> (make-image :identifier :next-badge
> :external-image (gdi::load-bitmap #p"RUNNING:Images;Next-Badge.bmp")
> :transparent-color rgb-black
> :x (- 72 24) :y (- 84 24) :width 24 :height 24))
> 
> (defmethod pixblt-image (badge (image image))
> (if (image-memory-dc image)
> (winapi::|TransparentBlt| (gdi::hdc badge)
> (image-x image)
> (image-y image)
> (image-width image) (image-height image)
> (image-memory-dc image) 0 0 (image-width image) (image-height image)
> (image-transparent-color image))
> (progn
> (setf (image-memory-dc image)
> (gdi::create-memory-dc-with-bitmap (gdi::hdc badge)
> (image-external-image image)))
> (pixblt-image badge image))))
> 
> (defclass badge (capi:output-pane)
> ((entries :initform nil :initarg :entries :accessor entries :type list)
> (current-entry-position :initform 0 :initarg :current-entry :accessor
> current-entry-position)
> (date :initform (calendar:current-date) :initarg :date :accessor badge-date)
> (milestone :initform nil :initarg :milestone :accessor milestone))
> (:default-initargs
> :visible-border nil
> :background 'win32:color_3dface
> :foreground :black
> :input-model '(((:button-1 :press) simple-badge-select)
> ((:button-1 :second-press) details-badge-select)
> (:post-menu popup-badge-menu))
> :visible-min-width 72 :visible-max-width 72
> :visible-min-height 84 :visible-max-height 84
> :display-callback #'draw-badge))
> 
> ----------------------------------------------------------
> (in-package :winapi)
> 
> (eval-when (:compile-toplevel :load-toplevel :execute)
> (fli:register-module :msimg32 :real-name "msimg32"))
> 
> (fli:define-c-typedef handle (:unsigned :long))
> (fli:define-c-typedef colorref (:unsigned :long))
> (fli:define-c-typedef dword (:unsigned :long))
> (fli:define-c-typedef word (:unsigned :short))
> 
> (defmacro winapi-function (name args result-type &key (module "gdi32")
> (export t))
> `(progn
> (fli:define-foreign-function (,name ,(symbol-name name))
> ,args
> :result-type ,result-type
> :calling-convention :stdcall
> :module ,module)
> (when ,export (export ',name))))
> 
> (winapi-function |TransparentBlt|
> ((hdcDest handle)
> (nXOriginDest :int)
> (nYOriginDest :int)
> (nWidthDest :int)
> (hHeightDest :int)
> (hdcSrc handle)
> (nXOriginSrc :int)
> (nYOriginSrc :int)
> (nWidthSrc :int)
> (nHeightSrc :int)
> (crTransparent colorref))
> :boolean
> :module :msimg32)
> -----------------------------------------------------
> (in-package :gdi)
> 
> (defmacro hwnd (gp)
> `(slot-value (slot-value ,gp 'gp::representation) 'win32:hwnd))
> (defmacro hdc (gp)
> `(slot-value (slot-value (slot-value ,gp 'gp::representation)
> 'capi-win32-lib::dc) 'win32:hdc))
> 
> ------------------------------------------------------
> (in-package :gdi)
> 
> (eval-when (:compile-toplevel :load-toplevel :execute)
> (defun rgb (red green blue)
> (let ((rgb #x00000000))
> (setf (ldb (byte 8 0) rgb) red)
> (setf (ldb (byte 8 8) rgb) green)
> (setf (ldb (byte 8 16) rgb) blue)
> rgb)))
> 
> (defun convert-color-ref-to-rgb (color-ref)
> (rgb
> (round (* (color:color-red color-ref) 255))
> (round (* (color:color-green color-ref) 255))
> (round (* (color:color-blue color-ref) 255))))
> 
> (defun colorref (color)
> (typecase color
> (symbol
> (let ((rgb (gethash color *color-database*)))
> (if rgb
> rgb
> ;; Also search LispWorks Color Database
> (let ((color-spec (color:get-color-spec color)))
> (if color-spec
> (convert-color-ref-to-rgb color-spec)
> (error "GDI: Could Not Find Color ~S" color))))))
> (integer color)
> (vector
> ;; Assume LispWorks color spec
> (convert-color-ref-to-rgb color))))
> 
> (defun load-bitmap (path)
> (with-open-file (file path :direction :input :element-type
> '(unsigned-byte 8))
> (let* ((length (file-length file))
> (bitmap-array (make-array length :element-type '(unsigned-byte 8))))
> (read-sequence bitmap-array file)
> bitmap-array)))
> 
> (defun read-long (byte-array offset)
> (let ((long 0))
> (setf (ldb (byte 8 0) long) (aref byte-array offset)
> (ldb (byte 8 8) long) (aref byte-array (+ offset 1))
> (ldb (byte 8 16) long) (aref byte-array (+ offset 2))
> (ldb (byte 8 24) long) (aref byte-array (+ offset 3)))
> long))
> 
> (defun byte-swapped-word (word)
> (let ((swapped 0))
> (setf (ldb (byte 8 0) swapped) (ldb (byte 8 8) word)
> (ldb (byte 8 8) swapped) (ldb (byte 8 0) word))
> swapped))
> 
> (defun write-long-to-byte-array (array integer &optional (offset 0))
> (setf (aref array offset) (ldb (byte 8 0) integer)
> (aref array (+ offset 1))(ldb (byte 8 8) integer)
> (aref array (+ offset 2))(ldb (byte 8 16) integer)
> (aref array (+ offset 3))(ldb (byte 8 24) integer)))
> 
> (defconstant +offset-file-size+ 2)
> (defconstant +offset-offset-bits+ 10)
> (defconstant +offset-info-header+ 14)
> (defconstant +offset-to-bitmap-width+ 18)
> (defconstant +offset-to-bitmap-height+ 22)
> 
> (defun bitmap-file-size (raw-bitmap)
> (read-long raw-bitmap +offset-file-size+))
> (defun bitmap-width (raw-bitmap)
> (read-long raw-bitmap +offset-to-bitmap-width+))
> (defun bitmap-height (raw-bitmap)
> (read-long raw-bitmap +offset-to-bitmap-height+))
> (defun bitmap-offset-bits (raw-bitmap)
> (read-long raw-bitmap +offset-offset-bits+))
> 
> (defun create-memory-dc-with-bitmap (hdc raw-bitmap)
> (let* ((width (bitmap-width raw-bitmap))
> (height (bitmap-height raw-bitmap))
> (size (bitmap-file-size raw-bitmap))
> (offset-bits (bitmap-offset-bits raw-bitmap))
> (hcdc (winapi:|CreateCompatibleDC| hdc))
> (hbitmap (winapi:|CreateCompatibleBitmap| hdc width height)))
> (winapi:|SelectObject| hcdc hbitmap)
> (fli:with-dynamic-foreign-objects ()
> (let* ((c-raw-bitmap (fli:allocate-dynamic-foreign-object :type :byte
> :nelems size))
> (bitmap-bits (fli:copy-pointer c-raw-bitmap))
> (info (fli:copy-pointer c-raw-bitmap)))
> (loop for byte from 0 below size
> do
> (setf (fli:dereference c-raw-bitmap :index byte) (aref raw-bitmap byte)))
> (fli:incf-pointer bitmap-bits offset-bits)
> (fli:incf-pointer info +offset-info-header+)
> (winapi:|SetDIBits| hcdc hbitmap 0 height bitmap-bits info
> winapi::DIB_RGB_COLORS))
> hcdc)))
> 



----------------------------------------------------
Denis Pousseur
6 clos du Drossart
1180 Bruxelles, Belgique

Mail :  denis.pousseur@compositeurs.be
Website : http://compositeurs.be
----------------------------------------------------