Mailing List Archive: 49091 messages
  • Home
  • Script library
  • AltME Archive
  • Mailing list
  • Articles Index
  • Site search

[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