Script Library: 1213 scripts
 

tray.r

REBOL [ File: %tray.r Date: 1-Sep-2009 Title: "Advanced Windows tray support" Version: 0.1.3 Author: "Richard Smolak aka Cyphre" Purpose: "Handler for advanced system tray features" Notes: { Done by Cyphre, sponsored by -pekr-, donated to the famous REBOL community :-) } History: [ 0.1.2 [1-Sep-2009 "First public release"] 0.1.3 [1-Sep-2009 "fixed issue with set-hook/unhook, added more generic SHOW wrapper"] ] Library: [ level: 'advanced platform: 'windows type: [tool module dialect] domain: [external-library win-api dialects extension parse user-interface] tested-under: [ view 2.7.6.3.1 on "Windows XP" by "Cyphre" ] support: ["Richard Smolak aka Cyphre"] license: 'bsd see-also: none ] ] ctx-tray: context [ shell32.dll: load/library %shell32.dll user32.dll: load/library %user32.dll kernel32.dll: load/library %kernel32.dll gdi32.dll: load/library %gdi32.dll make-char-array: func [ word-base [string!] length [integer!] /local result ][ result: copy [] repeat n length [ insert tail result reduce [to-word join word-base n [char]] ] result ] string-to-chars: func [ text [string!] /length ln [integer!] /local result ][ result: copy [] ln: any [ln length? text] repeat n ln [ insert tail result any [text/:n #"^@"] ] result ] create-window: make routine! [ dwExStyle [int] lpClassName [string!] lpWindowName [string!] dwStyle [int] x [int] y [int] nWidth [int] nHeight [int] hWndParent [int] hMenu [int] hInstance [int] lpParam [int] return: [int] ] user32.dll "CreateWindowExA" destroy-window: make routine! [ hwnd [int] ] user32.dll "DestroyWindow" BI_RGB: 0 DIB_RGB_COLORS: 0 NULL: 0 bmi-header-def: [ biSize [integer!] biWidth [integer!] biHeight [integer!] biPlanes [short] biBitCount [short] biCompression [integer!] biSizeImage [integer!] biXPelsPerMeter [integer!] biYPelsPerMeter [integer!] biClrUsed [integer!] biClrImportant [integer!] ] get-window-dc: make routine! [ hWnd [integer!] return: [integer!] ] user32.dll "GetWindowDC" release-dc: make routine! [ hWnd [integer!] hDC [integer!] ] user32.dll "ReleaseDC" create-dib-section: make routine! [ hdc [integer!] pbmi [struct! []] iusage [integer!] ppvbits [struct! []] hsection [integer!] dwOffset [integer!] return: [integer!] ] gdi32.dll "CreateDIBSection" delete-object: make routine! [ hObject [int] return: [int] ] gdi32.dll "DeleteObject" copy-memory: make routine! [ dest [int] src [binary!] length [int] ] kernel32.dll "RtlMoveMemory" create-dib: func [image [image!] /local img sx sy pix bitmap-info ppvbits hscreendc hbitmap][ img: copy #{} sx: image/size/x sy: image/size/y repeat n sx * sy [ pix: pick image n insert tail img to-binary reduce [ pix/3 pix/2 pix/1 255 - pix/4 ] ] bitmap-info: make struct! bmi-header-def none bitmap-info/biSize: length? third bitmap-info bitmap-info/biWidth: sx bitmap-info/biHeight: - sy bitmap-info/biPlanes: 1 bitmap-info/biBitCount: 32 bitmap-info/biCompression: BI_RGB bitmap-info/biSizeImage: 0 bitmap-info/biXPelsPerMeter: 0 bitmap-info/biYPelsPerMeter: 0 bitmap-info/biClrUsed: 0 bitmap-info/biClrImportant: 0 ppvbits: make struct! [i [integer!]] none hscreendc: get-window-dc NULL hbitmap: create-dib-section hscreendc bitmap-info DIB_RGB_COLORS ppvbits NULL 0 copy-memory ppvbits/i img sx * sy * 4 release-dc NULL hscreendc free bitmap-info free ppvbits return hbitmap ] ;----------------------- icon-info-def: [ fIcon [char] xHotspot [int] yHotspot [int] hbmMask [int] hbmColor [int] ] create-icon-indirect: make routine! compose/deep [ s [struct! [(icon-info-def)]] return: [int] ] user32.dll "CreateIconIndirect" create-bitmap: make routine! [ nWidth [int] nHeight [int] cPlanes [int] cBitsPerPel [int] lpvBits [binary!] return: [int] ] gdi32.dll "CreateBitmap" mask: create-bitmap 16 16 1 1 head insert/dup #{} to-char 0 16 * 16 create-icon: func [ img [image!] /local hbitmap result ii ][ if any [img/size/x <> 16 img/size/y <> 16][ img: draw make image! [16x16 0.0.0.255] [image img 0x0 16x16] ] hbitmap: create-dib img ii: make struct! icon-info-def reduce [to-char 1 0 0 mask hbitmap] result: create-icon-indirect ii delete-object hbitmap free ii return result ] ;----------------------- NIM_ADD: 0 NIM_MODIFY: 1 NIM_DELETE: 2 NIM_SETFOCUS: 3 NIM_SETVERSION: 4 NIF_MESSAGE: 1 NIF_ICON: 2 NIF_TIP: 4 NIF_STATE: 8 NIF_INFO: 16 NIF_GUID: 32 NIS_HIDDEN: 1 NIS_SHAREDICON: 2 NIIF_NONE: 0 NIIF_INFO: 1 NIIF_WARNING: 2 NIIF_ERROR: 3 NIIF_ICON_MASK: 15 NIIF_NOSOUND: 16 WM_CREATE: 1 WM_DESTROY: 2 WM_CLOSE: 16 WM_QUIT: 18 WM_APP: 32768 WM_TRAY: WM_APP SWM_ITEM: WM_APP + 17 WM_LBUTTONDOWN: 513 WM_LBUTTONDBLCLK: 515 WM_RBUTTONDOWN: 516 WM_RBUTTONDBLCLK: 518 WM_CONTEXTMENU: 123 MF_GRAYED: 1 MF_CHECKED: 8 MF_POPUP: 16 MF_BYPOSITION: 1024 MF_SEPARATOR: 2048 TPM_BOTTOMALIGN: 32 TPM_NONOTIFY: 128 TPM_RETURNCMD: 256 WH_KEYBOARD: 2 WH_CALLWNDPROC: 4 WH_MOUSE: 7 WH_MSGFILTER: -1 WH_SHELL: 10 WH_GETMESSAGE: 3 WH_CALLWNDPROCRET: 12 HC_ACTION: 0 msg-def: [ lParam [int] wParam [long] message [int] hwnd [int] ] point-def: [ x [long] y [long] ] get-thread: make routine! [ return: [int] ] kernel32.dll "GetCurrentThreadId" make-windows-hook-def: func [ cb [word!] ][ return make routine! compose/deep [ idHook [int] lpfn [(cb) [int int struct! [(msg-def)] return: [int]]] hMod [int] dwThreadId [int] return: [int] ] user32.dll "SetWindowsHookExA" ] if error? try [ set-windows-hook: make-windows-hook-def 'callback ][ set-windows-hook: make-windows-hook-def 'callback! ] call-next-hook: make routine! [ hhk [int] nCode [int] wParam [int] lParam [int] return: [int] ] user32.dll "CallNextHookEx" unhook-windows-hook: make routine! [ hhk [int] return: [int] ] user32.dll "UnhookWindowsHookEx" get-cursor-pos: make routine! compose/deep [ lpPoint [struct! [(point-def)]] return: [int] ] user32.dll "GetCursorPos" set-foreground-window: make routine! [ hwnd [int] return: [int] ] user32.dll "SetForegroundWindow" create-popup-menu: make routine! [ return: [int] ] user32.dll "CreatePopupMenu" destroy-menu: make routine! [ hMenu [int] return: [int] ] user32.dll "DestroyMenu" insert-menu: make routine! [ hMenu [int] uPosition [int] uFlags [int] uIDNewItem [int] lpNewItem [string!] return: [int] ] user32.dll "InsertMenuA" track-popup-menu: make routine! [ hMenu [int] uFlags [int] x [int] y [int] nReserved [int] hWnd [int] prcRect [int] return: [int] ] user32.dll "TrackPopupMenu" load-icon: make routine! [ hInstance [int] lpIconName [int] return: [int] ] user32.dll "LoadIconA" destroy-icon: make routine! [ hIcon [int] ] user32.dll "DestroyIcon" findwindow: make routine! [ class [int] name [string!] return: [int] ] user32.dll "FindWindowA" NOTIFYICONDATA-spec: compose [ cbSize [int] hWnd [int] uID [int] uFlags [int] uCallbackMessage [int] hIcon [int] (make-char-array "szTip" 64) ] shell-notify-icon: make routine! compose/deep [ dwMessage [int] lpdata [struct! [(NOTIFYICONDATA-spec)]] return: [int] ] shell32.dll "Shell_NotifyIcon" proc: func [nCode [integer!] wParam [integer!] lParam [struct!] /local tray err][ if nCode = HC_ACTION [ if find close-events lParam/message [ unhook foreach [msgid tray] trays [ shell-notify-icon NIM_DELETE tray/NOTIFYICONDATA ] ] if tray: select trays lParam/message [ if any [ lParam/lParam = WM_RBUTTONDOWN lParam/lParam = WM_CONTEXTMENU ][ unhook tray/on-alt-click if tray/menu [ if error? err: try [tray/show-menu][print ["show-menu error" newline mold disarm err] halt] ] set-hook ] if lParam/lParam = WM_LBUTTONDOWN [ tray/on-click ] if lParam/lParam = WM_LBUTTONDBLCLK [ tray/on-doubleclick ] if lParam/lParam = WM_RBUTTONDBLCLK [ tray/on-alt-doubleclick ] ] ] call-next-hook hook nCode wParam lParam ] set-hook: has [thread][ if not hook [ thread: get-thread hook: set-windows-hook WH_CALLWNDPROC :proc 0 thread ] ] unhook: does [ if hook [ unhook-windows-hook hook hook: none ] ] set 'remove-tray func [ tray [object!] /local tmp ][ if tmp: find trays tray [ shell-notify-icon NIM_DELETE tray/NOTIFYICONDATA insert free-tray-ids tray/NOTIFYICONDATA/uCallbackMessage free tray/NOTIFYICONDATA remove/part back tmp 2 return true ] return false ] set 'add-tray func [ tray-tip [string!] tray-icon [image! integer!] /local result ][ if empty? free-tray-ids [make error! "maximum number of trays exceeded"] set-hook result: context [ ;public stuff on-click: none on-alt-click: none on-doubleclick: none on-alt-doubleclick: none ;private stuff NOTIFYICONDATA: make struct! NOTIFYICONDATA-spec join [0 0 0 0 0 0] join string-to-chars/length tray-tip 63 to-char 0 tip: tray-tip icon: tray-icon menu: none items: copy [] selected-id: none get-tip: does [ first parse/all to-string at third NOTIFYICONDATA 25 "^@" ] set-tip: func [ tray-tip [string!] ][ tray-tip: copy/part tray-tip 63 clear at third NOTIFYICONDATA 25 change/part at third NOTIFYICONDATA 25 tray-tip length? tray-tip NOTIFYICONDATA/hIcon: either image? icon [create-icon icon][icon] shell-notify-icon NIM_MODIFY NOTIFYICONDATA destroy-icon NOTIFYICONDATA/hIcon NOTIFYICONDATA/hIcon: 0 ] set-icon: func [ tray-icon [image! integer!] ][ icon: tray-icon NOTIFYICONDATA/hIcon: either image? icon [create-icon icon][icon] shell-notify-icon NIM_MODIFY NOTIFYICONDATA destroy-icon NOTIFYICONDATA/hIcon NOTIFYICONDATA/hIcon: 0 ] selected: does [ second find items selected-id ] set-menu: func [ blk [block!] ][ menu: blk ] insert-item: func [ path [string!] item [block!] /local data ][ parse-items if data: find items path [ insert data/2 item ] ] remove-item: func [ path [string!] /local data ][ parse-items if data: find items path [ remove/part data/2 data/3 ] ] toggle-item: func [ path [string!] keyword [word!] /local data tmp ][ parse-items if data: find items path [ either tmp: find/part data/2 keyword data/3 [ remove tmp ][ insert at data/2 data/3 + 1 keyword ] ] ] parse-items: has [ rules lab sub-menu checked? grayed? mark mark2 idx path ][ idx: 0 path: [] clear items parse menu rules: [ some [ (grayed?: checked?: false) mark: set lab string! block! opt ['checked (checked?: true)] opt ['grayed (grayed?: true)] mark2: ( idx: idx + 1 insert tail items reduce [SWM_ITEM replace/all reform [path idx] " " "." mark (index? mark2) - (index? mark)] SWM_ITEM: SWM_ITEM + 1 ) | 'bar | mark: 'sub set lab string! set sub-menu block! mark2:( idx: idx + 1 insert tail items reduce [SWM_ITEM replace/all reform [path idx] " " "." mark (index? mark2) - (index? mark)] SWM_ITEM: SWM_ITEM + 1 insert tail path idx idx: 0 parse sub-menu rules idx: last path remove back tail path ) ] ] ] show-menu: has [ menu-id menus actions rules lab act sub-menu stack checked? grayed? mark mark2 idx path ][ get-cursor-pos pnt idx: 0 path: [] menus: copy [] actions: copy [] stack: copy [] clear items if not menu-id: create-popup-menu [ make error! "Cannot create tray menu" ] insert tail menus menu-id parse menu rules: [ some [ (grayed?: checked?: false) mark: set lab string! set act block! opt ['checked (checked?: true)] opt ['grayed (grayed?: true)] mark2: ( idx: idx + 1 insert-menu menu-id -1 MF_BYPOSITION or (either checked? [MF_CHECKED][0]) or (either grayed? [MF_GRAYED][0]) SWM_ITEM lab insert tail actions reduce [SWM_ITEM act] insert tail items reduce [SWM_ITEM replace/all reform [path idx] " " "." mark (index? mark2) - (index? mark)] SWM_ITEM: SWM_ITEM + 1 ) | 'bar ( insert-menu menu-id -1 MF_BYPOSITION or MF_SEPARATOR 0 "" ) | mark: 'sub set lab string! set sub-menu block! mark2:( idx: idx + 1 insert tail items reduce [SWM_ITEM replace/all reform [path idx] " " "." mark (index? mark2) - (index? mark)] SWM_ITEM: SWM_ITEM + 1 insert/only tail stack reduce [idx menu-id] insert tail path idx insert tail menus menu-id: create-popup-menu insert-menu second last stack -1 MF_BYPOSITION or MF_POPUP menu-id lab idx: 0 parse sub-menu rules idx: first last stack menu-id: second last stack remove back tail stack remove back tail path ) ] ] if not empty? menus [ set-foreground-window NOTIFYICONDATA/hWnd switch selected-id: track-popup-menu menus/1 TPM_BOTTOMALIGN or TPM_RETURNCMD or TPM_NONOTIFY pnt/x pnt/y 0 NOTIFYICONDATA/hWnd 0 actions foreach m menus [destroy-menu m] ] ] init: does [ id: id + 1 NOTIFYICONDATA/cbSize: length? third NOTIFYICONDATA NOTIFYICONDATA/hWnd: win NOTIFYICONDATA/uID: id NOTIFYICONDATA/uFlags: NIF_ICON or NIF_MESSAGE or NIF_TIP NOTIFYICONDATA/hIcon: either image? icon [create-icon icon][icon] NOTIFYICONDATA/uCallbackMessage: first free-tray-ids ; WM_TRAY: WM_TRAY + 1 remove free-tray-ids shell-notify-icon NIM_ADD NOTIFYICONDATA destroy-icon NOTIFYICONDATA/hIcon NOTIFYICONDATA/hIcon: 0 ] ] result/init insert tail trays reduce [result/NOTIFYICONDATA/uCallbackMessage result] return result ] ;public stuff close-to-tray?: true minimize-to-tray?: false default-icons: [ app 32512 hand 32513 question 32514 exclamation 32515 asterisk 32516 winlogo 32517 ] ;private stuff id: 1 trays: copy [] hook: none pnt: make struct! point-def none close-events: reduce [WM_QUIT WM_DESTROY] free-tray-ids: copy [] ;init stuff repeat n 16 [ insert tail free-tray-ids WM_TRAY WM_TRAY: WM_TRAY + 1 ] win: create-window 512 "REBOL" "" 0 0 0 0 0 0 0 0 0 any [ system/view/screen-face/feel system/view/screen-face/feel: make object! [ redraw: none detect: func [face event][ foreach evt-func event-funcs [ if not event? (evt-func: evt-func face event) [ return either evt-func [event] [none] ] ] event ] over: none engage: none event-funcs: [] ] ] insert-event-func func [f e][ if any [ all [ ctx-tray/close-to-tray? e/type = 'close ] all [ ctx-tray/minimize-to-tray? e/type = 'minimize ] ][ unview/only e/face do-events return none ] e ] ;little wrapper for SHOW use [show][ show: get in system/words 'show system/words/show: func [ "Display a face or block of faces." face [object! block!] ][ either any [ face = system/view/screen-face all [ block? face find face system/view/screen-face ] ][ unhook show face set-hook ][ show face ] ] ] ;little patch to quitting functions use [quit][ quit: get in system/words 'quit system/words/q: system/words/quit: func [ "Stops evaluation and exits the interpreter." /return "Returns a value (to OS command shell)" value [integer!] ][ unhook foreach [msgid tray] trays [ shell-notify-icon NIM_DELETE tray/NOTIFYICONDATA ] either return [ quit/return value ][ quit ] ] ] ];end ctx-tray
halt ;; to terminate script if DO'ne from webpage