diff --git a/collects/mred/private/wx/win32/const.rkt b/collects/mred/private/wx/win32/const.rkt index 79110a1a60..7b96f9f6ab 100644 --- a/collects/mred/private/wx/win32/const.rkt +++ b/collects/mred/private/wx/win32/const.rkt @@ -623,4 +623,3 @@ (define CBN_DROPDOWN 7) (define CBN_CLOSEUP 8) (define CBN_SELENDCANCEL 10) - diff --git a/collects/mred/private/wx/win32/cursor.rkt b/collects/mred/private/wx/win32/cursor.rkt index b49bec95c1..c9808bba83 100644 --- a/collects/mred/private/wx/win32/cursor.rkt +++ b/collects/mred/private/wx/win32/cursor.rkt @@ -5,6 +5,7 @@ "types.rkt" "const.rkt" "wndclass.rkt" + "icons.rkt" "../common/cursor-draw.rkt" "../../syntax.rkt") @@ -13,25 +14,6 @@ get-arrow-cursor get-wait-cursor)) -(define (MAKEINTRESOURCE v) v) - -(define IDC_ARROW (MAKEINTRESOURCE 32512)) -(define IDC_IBEAM (MAKEINTRESOURCE 32513)) -(define IDC_WAIT (MAKEINTRESOURCE 32514)) -(define IDC_APPSTARTING (MAKEINTRESOURCE 32650)) -(define IDC_CROSS (MAKEINTRESOURCE 32515)) -(define IDC_UPARROW (MAKEINTRESOURCE 32516)) -(define IDC_SIZENWSE (MAKEINTRESOURCE 32642)) -(define IDC_SIZENESW (MAKEINTRESOURCE 32643)) -(define IDC_SIZEWE (MAKEINTRESOURCE 32644)) -(define IDC_SIZENS (MAKEINTRESOURCE 32645)) -(define IDC_SIZEALL (MAKEINTRESOURCE 32646)) -(define IDC_NO (MAKEINTRESOURCE 32648)) -(define IDC_HAND (MAKEINTRESOURCE 32649)) -(define IDC_HELP (MAKEINTRESOURCE 32651)) - -(define-user32 LoadCursorW (_wfun _HINSTANCE _LONG -> _HCURSOR)) - (define-user32 CreateCursor (_wfun _HINSTANCE _int ; x _int ; y diff --git a/collects/mred/private/wx/win32/icons.rkt b/collects/mred/private/wx/win32/icons.rkt index 6fd15f9915..161252c358 100644 --- a/collects/mred/private/wx/win32/icons.rkt +++ b/collects/mred/private/wx/win32/icons.rkt @@ -1,13 +1,34 @@ #lang racket/base -(require ffi/unsafe) +(require ffi/unsafe + "types.rkt" + "utils.rkt") -(provide IDC_ARROW IDC_CROSS - IDI_APPLICATION IDI_HAND IDI_QUESTION IDI_WINLOGO) +(provide (protect-out (all-defined-out))) + +(define-user32 LoadCursorW (_wfun _HINSTANCE _intptr -> _HCURSOR)) +(define-user32 LoadIconW (_wfun _HINSTANCE _intptr -> _HICON)) + +(define (MAKEINTRESOURCE n) n) -(define (MAKEINTRESOURCE n) (ptr-add #f n)) -(define IDC_ARROW (MAKEINTRESOURCE 32512)) -(define IDC_CROSS (MAKEINTRESOURCE 32515)) (define IDI_APPLICATION (MAKEINTRESOURCE 32512)) (define IDI_HAND (MAKEINTRESOURCE 32513)) (define IDI_QUESTION (MAKEINTRESOURCE 32514)) +(define IDI_EXCLAMATION (MAKEINTRESOURCE 32515)) (define IDI_WINLOGO (MAKEINTRESOURCE 32517)) +(define IDI_WARNING IDI_EXCLAMATION) +(define IDI_ERROR IDI_HAND) + +(define IDC_ARROW (MAKEINTRESOURCE 32512)) +(define IDC_CROSS (MAKEINTRESOURCE 32515)) +(define IDC_HAND (MAKEINTRESOURCE 32649)) +(define IDC_IBEAM (MAKEINTRESOURCE 32513)) +(define IDC_WAIT (MAKEINTRESOURCE 32514)) +(define IDC_APPSTARTING (MAKEINTRESOURCE 32650)) +(define IDC_UPARROW (MAKEINTRESOURCE 32516)) +(define IDC_SIZENWSE (MAKEINTRESOURCE 32642)) +(define IDC_SIZENESW (MAKEINTRESOURCE 32643)) +(define IDC_SIZEWE (MAKEINTRESOURCE 32644)) +(define IDC_SIZENS (MAKEINTRESOURCE 32645)) +(define IDC_SIZEALL (MAKEINTRESOURCE 32646)) +(define IDC_NO (MAKEINTRESOURCE 32648)) +(define IDC_HELP (MAKEINTRESOURCE 32651)) diff --git a/collects/mred/private/wx/win32/message.rkt b/collects/mred/private/wx/win32/message.rkt index 31729bace7..05e3fbad64 100644 --- a/collects/mred/private/wx/win32/message.rkt +++ b/collects/mred/private/wx/win32/message.rkt @@ -11,7 +11,8 @@ "window.rkt" "wndclass.rkt" "hbitmap.rkt" - "types.rkt") + "types.rkt" + "icons.rkt") (provide (protect-out message%)) @@ -23,39 +24,8 @@ (define SS_BITMAP #x0000000E) (define SS_ICON #x00000003) -(define IDI_APPLICATION 32512) -(define IDI_HAND 32513) -(define IDI_QUESTION 32514) -(define IDI_EXCLAMATION 32515) -(define IDI_WARNING IDI_EXCLAMATION) -(define IDI_ERROR IDI_HAND) - (define IMAGE_ICON 1) -(define-user32 LoadIconW (_wfun _HINSTANCE _LONG -> _HICON)) -(define-kernel32 GetModuleFileNameW (_wfun _pointer _pointer _DWORD -> _DWORD)) - -(define-shell32 ExtractIconW (_wfun _HINSTANCE _string/utf-16 _UINT -> (r : _HICON) - -> (or r (failed 'ExtractIconW)))) - -(define ERROR_INSUFFICIENT_BUFFER 122) - -(define app-icon - (delay - (let () - (let ([path - (let loop ([size 1024]) - (let ([p (make-bytes (* (ctype-sizeof _WCHAR) 1024))]) - (let ([r (GetModuleFileNameW #f p size)]) - (cond - [(and (or (zero? r) (= r size)) - (= (GetLastError) ERROR_INSUFFICIENT_BUFFER)) - (loop (* size 2))] - [(zero? r) (failed 'GetModuleFileNameW)] - [else (cast p _gcpointer _string/utf-16)]))))]) - (if path - (ExtractIconW hInstance path 0) - (LoadIconW #f IDI_APPLICATION)))))) (define warning-icon (delay (LoadIconW #f IDI_WARNING))) @@ -108,10 +78,10 @@ (when (symbol? label) (SendMessageW (get-hwnd) STM_SETIMAGE IMAGE_ICON - (cast (force (case label - [(caution) warning-icon] - [(stop) error-icon] - [else app-icon])) + (cast (case label + [(caution) (force warning-icon)] + [(stop) (force error-icon)] + [else app-icon]) _HICON _LPARAM))) (set-control-font font) diff --git a/collects/mred/private/wx/win32/wndclass.rkt b/collects/mred/private/wx/win32/wndclass.rkt index 127bbea1b6..485b4a1f29 100644 --- a/collects/mred/private/wx/win32/wndclass.rkt +++ b/collects/mred/private/wx/win32/wndclass.rkt @@ -22,7 +22,8 @@ CreateDialogIndirectParamW dialog-proc clean-up-destroyed MessageBoxW - _WndProc)) + _WndProc + app-icon)) ;; ---------------------------------------- ;; We use the "user data" field of an HWND to @@ -226,8 +227,6 @@ (define-user32 RegisterClassW (_wfun _WNDCLASS-pointer -> _ATOM)) (define-kernel32 GetModuleHandleW (_wfun _pointer -> _HINSTANCE)) -(define-user32 LoadCursorW (_wfun _HINSTANCE _pointer -> _HCURSOR)) -(define-user32 LoadIconW (_wfun _HINSTANCE _string/utf-16 -> _HICON)) (define-user32 GetClassInfoW (_wfun _HINSTANCE _string/utf-16 (i : (_ptr o _WNDCLASS)) -> (r : _BOOL) -> (if r i (failed 'GetClassInfoW)))) @@ -243,13 +242,33 @@ (define background-hbrush (let ([p (ptr-add #f (+ COLOR_BTNFACE 1))]) (cpointer-push-tag! p 'HBRUSH) p)) - + +(define-kernel32 GetModuleFileNameW (_wfun _pointer _pointer _DWORD -> _DWORD)) +(define ERROR_INSUFFICIENT_BUFFER 122) +(define-shell32 ExtractIconW (_wfun _HINSTANCE _string/utf-16 _UINT -> (r : _HICON) + -> (or r (failed 'ExtractIconW)))) + +(define app-icon + (let ([path + (let loop ([size 1024]) + (let ([p (make-bytes (* (ctype-sizeof _WCHAR) 1024))]) + (let ([r (GetModuleFileNameW #f p size)]) + (cond + [(and (or (zero? r) (= r size)) + (= (GetLastError) ERROR_INSUFFICIENT_BUFFER)) + (loop (* size 2))] + [(zero? r) (failed 'GetModuleFileNameW)] + [else (cast p _gcpointer _string/utf-16)]))))]) + (if path + (ExtractIconW hInstance path 0) + (LoadIconW #f IDI_APPLICATION)))) + (void (RegisterClassW (make-WNDCLASS CS_OWNDC wind-proc-ptr 0 0 hInstance - (LoadIconW hInstance "WXSTD_FRAME") + app-icon #f background-hbrush #f ; menu diff --git a/src/worksp/gracket/gracket.rc b/src/worksp/gracket/gracket.rc index fd5e65e41d..e758586f07 100644 --- a/src/worksp/gracket/gracket.rc +++ b/src/worksp/gracket/gracket.rc @@ -1,14 +1,8 @@ - ///////////////////////////////////////////////////////////////////////////// // // Icon // -// Icon with lowest ID value placed first to ensure application icon -// remains consistent on all systems. -WXSTD_FRAME ICON DISCARDABLE "gracket.ico" -WXSTD_MDICHILDFRAME ICON DISCARDABLE "gracket.ico" -WXSTD_MDIPARENTFRAME ICON DISCARDABLE "gracket.ico" APPLICATION ICON DISCARDABLE "gracket.ico" ///////////////////////////////////////////////////////////////////////////// diff --git a/src/worksp/racket/racket.rc b/src/worksp/racket/racket.rc index d37d1521d0..19d688eef2 100644 --- a/src/worksp/racket/racket.rc +++ b/src/worksp/racket/racket.rc @@ -1,28 +1,10 @@ -//Microsoft Developer Studio generated resource script. - -// - -#include "resource.h" - - - ///////////////////////////////////////////////////////////////////////////// - // - // Icon - // - - -// Icon with lowest ID value placed first to ensure application icon - -// remains consistent on all systems. - APPLICATION ICON DISCARDABLE "racket.ico" - ///////////////////////////////////////////////////////////////////////////// // // Version diff --git a/src/worksp/racket/resource.h b/src/worksp/racket/resource.h deleted file mode 100644 index 26d79893bd..0000000000 --- a/src/worksp/racket/resource.h +++ /dev/null @@ -1,16 +0,0 @@ -//{{NO_DEPENDENCIES}} -// Microsoft Developer Studio generated include file. -// Used by racket.rc -// -#define APPLICATION 101 - -// Next default values for new objects -// -#ifdef APSTUDIO_INVOKED -#ifndef APSTUDIO_READONLY_SYMBOLS -#define _APS_NEXT_RESOURCE_VALUE 102 -#define _APS_NEXT_COMMAND_VALUE 40001 -#define _APS_NEXT_CONTROL_VALUE 1000 -#define _APS_NEXT_SYMED_VALUE 101 -#endif -#endif