suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

win32: get default frame icon from application

Browse Source 
Also, clean up icon- and cursor-loading code
This commit is contained in:
Matthew Flatt 2011-11-16 14:31:04 -07:00
parent 243332f429
commit 63f3a51ae6
8 changed files with 58 additions and 107 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/mred/private/wx/win32/const.rkt
View File

@ -623,4 +623,3 @@
(define CBN_DROPDOWN 7)
(define CBN_CLOSEUP 8)
(define CBN_SELENDCANCEL 10)

20
collects/mred/private/wx/win32/cursor.rkt
View File

@ -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

33
collects/mred/private/wx/win32/icons.rkt
View File

@ -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))

42
collects/mred/private/wx/win32/message.rkt
View File

@ -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)

29
collects/mred/private/wx/win32/wndclass.rkt
View File

@ -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

6
src/worksp/gracket/gracket.rc
View File

@ -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"
/////////////////////////////////////////////////////////////////////////////

18
src/worksp/racket/racket.rc
View File

@ -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

16
src/worksp/racket/resource.h
View File

@ -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