[REBOL] Update: Read *and* Write images against Windows Clipboard
From: greggirwin::mindspring::com at: 21-Sep-2002 12:07
Here's an upated version of win-clip that let's you read *and* write images.
The implementation is very basic, using an old, obsolete, API call
(GetBitmapBits) as an initial test. The more "modern" approach (i.e.
GetDIBIts) will be quite a bit more work. If you need a more flexible,
powerful, up-to-date function (e.g. for palette mapping, bitmap conversions,
direct JPG support, etc.), that would be the way to go. In any case, I'd
love to hear if this works for people, or if you have any problems on
specific versions fo Windows or REBOL.
Same disclaimer(s) as before:
Requires View/Pro or Command (for library access).
Doesn't work on View 1.2.1. Looks like you can't use an image! as a routine
parameter under that version.
In light of the recent thread on the pros and cons of cross-platform support
in scripts, let me say that this particular bit of functionality, along with
some other Windows-specific stuff, is required for a project I'm working on.
The target platform is Windows and integration with some other software is
required. In this kind of scenario, I could do one of three things:
a) Try to talk them out of Windows as a target. In this case,
I think they're making the right choice. Supporting other
platforms doesn't make any business sense at this point.
b) Use another tool for the project. That would mean going to
a Windows specific tool in my case because that's where my
background is and how I would be most effective.
c) Use REBOL, promote it, and design things to make going
cross-platform possible in the future.
I chose option C.
--Gregg
P.S. Watch for wrap!
REBOL [
Title: "Windows Clipboard Library"
File: %win-clip.r
Date: 21-Sep-2002
Author: "Gregg Irwin"
eMail: [greggirwin--acm--org]
]
win-clip: context [
win-user: load/library %user32.dll
win-gdi: load/library %gdi32.dll
null-buff: func [
{Returns a null-filled string buffer of the specified length.}
len [integer!]
][
head insert/dup make string! len #"^@" len
]
BITMAP: make struct! [
Type [integer!]
Width [integer!]
Height [integer!]
WidthBytes [integer!]
Planes-BPP [integer!]
;Planes [integer!] ; WORD needs to be 2 bytes
;BitsPixel [integer!] ; WORD needs to be 2 bytes
Bits [char*] ; LPVOID
] none
; This is an obsolete function, but it may work for us.
get-bitmap-bits: make routine! [
hbmp [integer!]
cbBuffer [integer!] ;// number of bytes to copy
lpvBits [image!] ;// pointer to buffer to receive bits
return: [integer!]
] win-gdi "GetBitmapBits"
create-bitmap: make routine! [
width [integer!]
height [integer!]
planes [integer!]
bits-per-pel [integer!]
lpv-bits [image!]
return: [integer!] ; HBMP on success, 0 on failure
] win-gdi "CreateBitmap"
get-bitmap-object: make routine! [
hgdiobj [integer!] ;// handle to graphics object of interest
cbBuffer [integer!] ;// size of buffer for object information
lpvObject [struct! [(first BITMAP)]] ;// pointer to buffer for
object information
return: [integer!]
] win-gdi "GetObjectA"
; 0 on failure
CF_TEXT: 1
CF_BITMAP: 2
_open: make routine! [
hwnd-owner [integer!]
return: [integer!]
] win-user "OpenClipboard"
; Returns 0 on failure
open: does [
either 0 <> _open 0 [true][false]
]
close: make routine! [
return: [integer!]
] win-user "CloseClipboard"
; Returns 0 on failure
clear: make routine! [
return: [integer!]
] win-user "EmptyClipboard"
; Returns 0 on failure
get-data: make routine! [
format [integer!]
return: [integer!]
] win-user "GetClipboardData"
; Returns 0 on failure; hData on success
; After SetClipboardData is called, the system owns the object
; identified by the hMem parameter. The application can read
; the data, but must not free the handle or leave it locked.
set-data: make routine! [
format [integer!]
hMem [integer!]
return: [integer!]
] win-user "SetClipboardData"
is-clipboard-format-available?: make routine! [
format [integer!]
return: [integer!]
] win-user "IsClipboardFormatAvailable"
; Returns 0 if format is not available
is-format-available?: func [format [integer!]] [
either 0 = is-clipboard-format-available? format [false][true]
]
; It looks like we either need to clear the clipboard, or write
; some text to it via the clipboard scheme, in order for image stuff
; to work. What happens is that the DIB rendering format doesn't
; update if we don't do that and that is what gets pasted into most,
; if not all, apps (even though the BITMAP format is in the clipboard
; with our data.
write: func [data] [
either not image? data [
system/words/write clipboard:// form data
][
if open [
clear
set-data CF_BITMAP create-bitmap data/size/x data/size/y 1
32 data
close
]
]
]
read: func [
{Returns a string! for CF_TEXT values and an image! for CF_BITMAP
values. Right now, the old GetBitmapBits API, which is tagged as
obsolete, is used to get the image data. It was easy to implement
and test, whereas the more up-to-date approach would be to use
GetDIBits, but that entails a lot more work.}
format [integer!] {Only CF_TEXT and CF_BITMAP do anything reasonably
useful at this time. Other formats will return the handle of a
clipboard object in the specified format.}
/local result hbmp bmo
][
either format = CF_TEXT [
system/words/read clipboard://
][
result: none
if all [open is-format-available? format] [
result: get-data format
if format = CF_BITMAP [
hbmp: result
bmo: make struct! BITMAP none ; bmo = BitMap Object
either 0 <> get-bitmap-object hbmp length? third bmo bmo
[
result: make image! to pair! reduce [bmo/width
bmo/height]
get-bitmap-bits hbmp length? result result
][
result: none
]
]
close
]
result
]
]
]
;win-clip/write "abc"
;win-clip/write to image! layout [button]
;wait .1 ; need to wait here for some reason, or sometimes it doesn't
; see the data we just wrote.
if win-clip/is-format-available? win-clip/CF_BITMAP [
if img: win-clip/read win-clip/CF_BITMAP [
view layout [image img]
]
]
;halt
