Copyright | (c) Alastair Reid 1997-2003 |
---|---|
License | BSD-style (see the file libraries/base/LICENSE) |
Maintainer | Esa Ilari Vuokko <ei@vuokko.info> |
Stability | provisional |
Portability | portable |
Safe Haskell | Trustworthy |
Language | Haskell2010 |
A collection of FFI declarations for interfacing with Win32.
Synopsis
- type ClassName = LPCTSTR
- mkClassName :: String -> ClassName
- type ClassStyle = UINT
- cS_VREDRAW :: ClassStyle
- cS_HREDRAW :: ClassStyle
- cS_OWNDC :: ClassStyle
- cS_CLASSDC :: ClassStyle
- cS_PARENTDC :: ClassStyle
- cS_SAVEBITS :: ClassStyle
- cS_DBLCLKS :: ClassStyle
- cS_BYTEALIGNCLIENT :: ClassStyle
- cS_BYTEALIGNWINDOW :: ClassStyle
- cS_NOCLOSE :: ClassStyle
- cS_GLOBALCLASS :: ClassStyle
- type WNDCLASS = (ClassStyle, HINSTANCE, Maybe HICON, Maybe HCURSOR, Maybe HBRUSH, Maybe LPCTSTR, ClassName)
- withWNDCLASS :: WNDCLASS -> (Ptr WNDCLASS -> IO a) -> IO a
- genericWndProc_p :: FunPtr WindowClosure
- registerClass :: WNDCLASS -> IO (Maybe ATOM)
- c_RegisterClass :: Ptr WNDCLASS -> IO ATOM
- unregisterClass :: ClassName -> HINSTANCE -> IO ()
- type WindowStyle = DWORD
- wS_OVERLAPPED :: WindowStyle
- wS_POPUP :: WindowStyle
- wS_CHILD :: WindowStyle
- wS_CLIPSIBLINGS :: WindowStyle
- wS_CLIPCHILDREN :: WindowStyle
- wS_VISIBLE :: WindowStyle
- wS_DISABLED :: WindowStyle
- wS_MINIMIZE :: WindowStyle
- wS_MAXIMIZE :: WindowStyle
- wS_CAPTION :: WindowStyle
- wS_BORDER :: WindowStyle
- wS_DLGFRAME :: WindowStyle
- wS_VSCROLL :: WindowStyle
- wS_HSCROLL :: WindowStyle
- wS_SYSMENU :: WindowStyle
- type WindowStyleEx = DWORD
- wS_THICKFRAME :: WindowStyle
- wS_MINIMIZEBOX :: WindowStyle
- wS_EX_DLGMODALFRAME :: WindowStyleEx
- wS_MAXIMIZEBOX :: WindowStyle
- wS_EX_NOPARENTNOTIFY :: WindowStyleEx
- wS_GROUP :: WindowStyle
- wS_EX_TOPMOST :: WindowStyleEx
- wS_TABSTOP :: WindowStyle
- wS_EX_ACCEPTFILES :: WindowStyleEx
- wS_OVERLAPPEDWINDOW :: WindowStyle
- wS_EX_TRANSPARENT :: WindowStyleEx
- wS_POPUPWINDOW :: WindowStyle
- wS_EX_MDICHILD :: WindowStyleEx
- wS_CHILDWINDOW :: WindowStyle
- wS_EX_TOOLWINDOW :: WindowStyleEx
- wS_TILED :: WindowStyle
- wS_EX_WINDOWEDGE :: WindowStyleEx
- wS_ICONIC :: WindowStyle
- wS_EX_CLIENTEDGE :: WindowStyleEx
- wS_SIZEBOX :: WindowStyle
- wS_EX_CONTEXTHELP :: WindowStyleEx
- wS_TILEDWINDOW :: WindowStyle
- wS_EX_RIGHT :: WindowStyleEx
- wS_EX_LEFT :: WindowStyleEx
- wS_EX_RTLREADING :: WindowStyleEx
- cW_USEDEFAULT :: Pos
- wS_EX_LTRREADING :: WindowStyleEx
- wS_EX_LEFTSCROLLBAR :: WindowStyleEx
- wS_EX_RIGHTSCROLLBAR :: WindowStyleEx
- type Pos = Int
- wS_EX_CONTROLPARENT :: WindowStyleEx
- type MbPos = Maybe Pos
- wS_EX_STATICEDGE :: WindowStyleEx
- maybePos :: Maybe Pos -> Pos
- wS_EX_APPWINDOW :: WindowStyleEx
- wS_EX_OVERLAPPEDWINDOW :: WindowStyleEx
- type WindowClosure = HWND -> WindowMessage -> WPARAM -> LPARAM -> IO LRESULT
- wS_EX_PALETTEWINDOW :: WindowStyleEx
- mkWindowClosure :: WindowClosure -> IO (FunPtr WindowClosure)
- setWindowClosure :: HWND -> WindowClosure -> IO (Maybe (FunPtr WindowClosure))
- c_SetWindowLongPtr :: HWND -> INT -> Ptr LONG -> IO (Ptr LONG)
- c_GetWindowLongPtr :: HANDLE -> INT -> IO LONG_PTR
- createWindow :: ClassName -> String -> WindowStyle -> Maybe Pos -> Maybe Pos -> Maybe Pos -> Maybe Pos -> Maybe HWND -> Maybe HMENU -> HINSTANCE -> WindowClosure -> IO HWND
- createWindowEx :: WindowStyle -> ClassName -> String -> WindowStyle -> Maybe Pos -> Maybe Pos -> Maybe Pos -> Maybe Pos -> Maybe HWND -> Maybe HMENU -> HINSTANCE -> WindowClosure -> IO HWND
- c_CreateWindowEx :: WindowStyle -> ClassName -> LPCTSTR -> WindowStyle -> Pos -> Pos -> Pos -> Pos -> HWND -> HMENU -> HINSTANCE -> LPVOID -> IO HWND
- defWindowProc :: Maybe HWND -> WindowMessage -> WPARAM -> LPARAM -> IO LRESULT
- defWindowProcSafe :: Maybe HWND -> WindowMessage -> WPARAM -> LPARAM -> IO LRESULT
- c_DefWindowProc :: HWND -> WindowMessage -> WPARAM -> LPARAM -> IO LRESULT
- freeWindowProc :: HWND -> IO ()
- getClientRect :: HWND -> IO RECT
- c_GetClientRect :: HWND -> Ptr RECT -> IO Bool
- getWindowRect :: HWND -> IO RECT
- c_GetWindowRect :: HWND -> Ptr RECT -> IO Bool
- invalidateRect :: Maybe HWND -> Maybe LPRECT -> Bool -> IO ()
- c_InvalidateRect :: HWND -> LPRECT -> Bool -> IO Bool
- screenToClient :: HWND -> POINT -> IO POINT
- c_ScreenToClient :: HWND -> Ptr POINT -> IO Bool
- clientToScreen :: HWND -> POINT -> IO POINT
- c_ClientToScreen :: HWND -> Ptr POINT -> IO Bool
- setWindowText :: HWND -> String -> IO ()
- c_SetWindowText :: HWND -> LPCTSTR -> IO Bool
- getWindowText :: HWND -> Int -> IO String
- c_GetWindowText :: HWND -> LPTSTR -> Int -> IO Int
- getWindowTextLength :: HWND -> IO Int
- c_GetWindowTextLength :: HWND -> IO Int
- type PAINTSTRUCT = (HDC, Bool, RECT)
- type LPPAINTSTRUCT = Addr
- sizeofPAINTSTRUCT :: DWORD
- allocaPAINTSTRUCT :: (LPPAINTSTRUCT -> IO a) -> IO a
- beginPaint :: HWND -> LPPAINTSTRUCT -> IO HDC
- c_BeginPaint :: HWND -> LPPAINTSTRUCT -> IO HDC
- endPaint :: HWND -> LPPAINTSTRUCT -> IO ()
- type ShowWindowControl = DWORD
- sW_HIDE :: ShowWindowControl
- sW_SHOWNORMAL :: ShowWindowControl
- sW_SHOWMINIMIZED :: ShowWindowControl
- sW_SHOWMAXIMIZED :: ShowWindowControl
- sW_MAXIMIZE :: ShowWindowControl
- sW_SHOWNOACTIVATE :: ShowWindowControl
- sW_SHOW :: ShowWindowControl
- sW_MINIMIZE :: ShowWindowControl
- showWindow :: HWND -> ShowWindowControl -> IO Bool
- sW_SHOWMINNOACTIVE :: ShowWindowControl
- isWindowVisible :: HWND -> IO Bool
- sW_SHOWNA :: ShowWindowControl
- sW_RESTORE :: ShowWindowControl
- adjustWindowRect :: RECT -> WindowStyle -> Bool -> IO RECT
- c_AdjustWindowRect :: Ptr RECT -> WindowStyle -> Bool -> IO Bool
- adjustWindowRectEx :: RECT -> WindowStyle -> Bool -> WindowStyleEx -> IO RECT
- c_AdjustWindowRectEx :: Ptr RECT -> WindowStyle -> Bool -> WindowStyleEx -> IO Bool
- anyPopup :: IO Bool
- arrangeIconicWindows :: HWND -> IO ()
- c_ArrangeIconicWindows :: HWND -> IO Bool
- beginDeferWindowPos :: Int -> IO HDWP
- c_BeginDeferWindowPos :: Int -> IO HDWP
- bringWindowToTop :: HWND -> IO ()
- c_BringWindowToTop :: HWND -> IO Bool
- childWindowFromPoint :: HWND -> POINT -> IO (Maybe HWND)
- childWindowFromPointEx :: HWND -> POINT -> DWORD -> IO (Maybe HWND)
- closeWindow :: HWND -> IO ()
- deferWindowPos :: HDWP -> HWND -> HWND -> Int -> Int -> Int -> Int -> SetWindowPosFlags -> IO HDWP
- c_DeferWindowPos :: HDWP -> HWND -> HWND -> Int -> Int -> Int -> Int -> SetWindowPosFlags -> IO HDWP
- destroyWindow :: HWND -> IO ()
- c_DestroyWindow :: HWND -> IO Bool
- endDeferWindowPos :: HDWP -> IO ()
- c_EndDeferWindowPos :: HDWP -> IO Bool
- findWindow :: Maybe String -> Maybe String -> IO (Maybe HWND)
- findWindowByName :: String -> IO (Maybe HWND)
- c_FindWindow :: LPCTSTR -> LPCTSTR -> IO HWND
- findWindowEx :: Maybe HWND -> Maybe HWND -> Maybe String -> Maybe String -> IO (Maybe HWND)
- c_FindWindowEx :: HWND -> HWND -> LPCTSTR -> LPCTSTR -> IO HWND
- flashWindow :: HWND -> Bool -> IO Bool
- moveWindow :: HWND -> Int -> Int -> Int -> Int -> Bool -> IO ()
- c_MoveWindow :: HWND -> Int -> Int -> Int -> Int -> Bool -> IO Bool
- getDesktopWindow :: IO HWND
- getForegroundWindow :: IO HWND
- getParent :: HWND -> IO HWND
- c_GetParent :: HWND -> IO HWND
- getTopWindow :: HWND -> IO HWND
- c_GetTopWindow :: HWND -> IO HWND
- type SetWindowPosFlags = UINT
- sWP_NOSIZE :: SetWindowPosFlags
- sWP_NOMOVE :: SetWindowPosFlags
- sWP_NOZORDER :: SetWindowPosFlags
- sWP_NOREDRAW :: SetWindowPosFlags
- sWP_NOACTIVATE :: SetWindowPosFlags
- sWP_FRAMECHANGED :: SetWindowPosFlags
- sWP_SHOWWINDOW :: SetWindowPosFlags
- sWP_HIDEWINDOW :: SetWindowPosFlags
- sWP_NOCOPYBITS :: SetWindowPosFlags
- sWP_NOOWNERZORDER :: SetWindowPosFlags
- type GetDCExFlags = DWORD
- sWP_NOSENDCHANGING :: SetWindowPosFlags
- dCX_WINDOW :: GetDCExFlags
- sWP_DRAWFRAME :: SetWindowPosFlags
- dCX_CACHE :: GetDCExFlags
- sWP_NOREPOSITION :: SetWindowPosFlags
- dCX_CLIPCHILDREN :: GetDCExFlags
- dCX_CLIPSIBLINGS :: GetDCExFlags
- dCX_PARENTCLIP :: GetDCExFlags
- dCX_EXCLUDERGN :: GetDCExFlags
- dCX_INTERSECTRGN :: GetDCExFlags
- getDCEx :: HWND -> HRGN -> GetDCExFlags -> IO HDC
- dCX_LOCKWINDOWUPDATE :: GetDCExFlags
- c_GetDCEx :: HWND -> PRGN -> GetDCExFlags -> IO HDC
- getDC :: Maybe HWND -> IO HDC
- c_GetDC :: HWND -> IO HDC
- getWindowDC :: Maybe HWND -> IO HDC
- c_GetWindowDC :: HWND -> IO HDC
- releaseDC :: Maybe HWND -> HDC -> IO ()
- c_ReleaseDC :: HWND -> HDC -> IO Bool
- getDCOrgEx :: HDC -> IO POINT
- c_GetDCOrgEx :: HDC -> Ptr POINT -> IO Bool
- hideCaret :: HWND -> IO ()
- c_HideCaret :: HWND -> IO Bool
- showCaret :: HWND -> IO ()
- c_ShowCaret :: HWND -> IO Bool
- createCaret :: HWND -> HBITMAP -> Maybe INT -> Maybe INT -> IO ()
- c_CreateCaret :: HWND -> HBITMAP -> INT -> INT -> IO Bool
- destroyCaret :: IO ()
- c_DestroyCaret :: IO Bool
- getCaretPos :: IO POINT
- c_GetCaretPos :: Ptr POINT -> IO Bool
- setCaretPos :: POINT -> IO ()
- c_SetCaretPos :: LONG -> LONG -> IO Bool
- type LPMSG = Addr
- allocaMessage :: (LPMSG -> IO a) -> IO a
- getMessage :: LPMSG -> Maybe HWND -> IO Bool
- c_GetMessage :: LPMSG -> HWND -> UINT -> UINT -> IO LONG
- peekMessage :: LPMSG -> Maybe HWND -> UINT -> UINT -> UINT -> IO ()
- c_PeekMessage :: LPMSG -> HWND -> UINT -> UINT -> UINT -> IO LONG
- translateMessage :: LPMSG -> IO BOOL
- updateWindow :: HWND -> IO ()
- c_UpdateWindow :: HWND -> IO Bool
- dispatchMessage :: LPMSG -> IO LONG
- sendMessage :: HWND -> WindowMessage -> WPARAM -> LPARAM -> IO LRESULT
Documentation
mkClassName :: String -> ClassName Source #
type ClassStyle = UINT Source #
type WNDCLASS = (ClassStyle, HINSTANCE, Maybe HICON, Maybe HCURSOR, Maybe HBRUSH, Maybe LPCTSTR, ClassName) Source #
type WindowStyle = DWORD Source #
type WindowStyleEx = DWORD Source #
cW_USEDEFAULT :: Pos Source #
type WindowClosure = HWND -> WindowMessage -> WPARAM -> LPARAM -> IO LRESULT Source #
mkWindowClosure :: WindowClosure -> IO (FunPtr WindowClosure) Source #
setWindowClosure :: HWND -> WindowClosure -> IO (Maybe (FunPtr WindowClosure)) Source #
The standard C wndproc for every window class registered by
registerClass
is a C function pointer provided with this library. It in
turn delegates to a Haskell function pointer stored in gWLP_USERDATA
.
This action creates that function pointer. All Haskell function pointers
must be freed in order to allow the objects they close over to be garbage
collected. Consequently, if you are replacing a window closure previously
set via this method or indirectly with createWindow
or createWindowEx
you must free it. This action returns a function pointer to the old window
closure for you to free. The current window closure is freed automatically
by defWindowProc
when it receives wM_NCDESTROY
.
createWindow :: ClassName -> String -> WindowStyle -> Maybe Pos -> Maybe Pos -> Maybe Pos -> Maybe Pos -> Maybe HWND -> Maybe HMENU -> HINSTANCE -> WindowClosure -> IO HWND Source #
Creates a window with a default extended window style. If you create many
windows over the life of your program, WindowClosure may leak memory. Be
sure to delegate to defWindowProc
for wM_NCDESTROY
and see
defWindowProc
and setWindowClosure
for details.
createWindowEx :: WindowStyle -> ClassName -> String -> WindowStyle -> Maybe Pos -> Maybe Pos -> Maybe Pos -> Maybe Pos -> Maybe HWND -> Maybe HMENU -> HINSTANCE -> WindowClosure -> IO HWND Source #
Creates a window and allows your to specify the extended window style. If
you create many windows over the life of your program, WindowClosure may
leak memory. Be sure to delegate to defWindowProc
for wM_NCDESTROY
and see
defWindowProc
and setWindowClosure
for details.
c_CreateWindowEx :: WindowStyle -> ClassName -> LPCTSTR -> WindowStyle -> Pos -> Pos -> Pos -> Pos -> HWND -> HMENU -> HINSTANCE -> LPVOID -> IO HWND Source #
defWindowProc :: Maybe HWND -> WindowMessage -> WPARAM -> LPARAM -> IO LRESULT Source #
Delegates to the Win32 default window procedure. If you are using a
window created by createWindow
, createWindowEx
or on which you have
called setWindowClosure
, please note that the window will leak memory once
it is destroyed unless you call freeWindowProc
when it receives
wM_NCDESTROY
. If you wish to do this, instead of using this function
directly, you can delegate to defWindowProcSafe
which will handle it for
you. As an alternative, you can manually retrieve the window closure
function pointer and free it after the window has been destroyed. Check the
implementation of freeWindowProc
for a guide.
defWindowProcSafe :: Maybe HWND -> WindowMessage -> WPARAM -> LPARAM -> IO LRESULT Source #
Delegates to the standard default window procedure, but if it receives the
wM_NCDESTROY
message it first frees the window closure to allow the
closure and any objects it closes over to be garbage collected. wM_NCDESTROY
is
the last message a window receives prior to being deleted.
c_DefWindowProc :: HWND -> WindowMessage -> WPARAM -> LPARAM -> IO LRESULT Source #
freeWindowProc :: HWND -> IO () Source #
Frees a function pointer to the window closure which has been set
directly by setWindowClosure
or indirectly by createWindowEx
. You
should call this function in your window closure's wM_NCDESTROY
case
unless you delegate that case to defWindowProc
(e.g. as part of the
default).
type LPPAINTSTRUCT = Addr Source #
allocaPAINTSTRUCT :: (LPPAINTSTRUCT -> IO a) -> IO a Source #
beginPaint :: HWND -> LPPAINTSTRUCT -> IO HDC Source #
c_BeginPaint :: HWND -> LPPAINTSTRUCT -> IO HDC Source #
type ShowWindowControl = DWORD Source #
showWindow :: HWND -> ShowWindowControl -> IO Bool Source #
adjustWindowRect :: RECT -> WindowStyle -> Bool -> IO RECT Source #
c_AdjustWindowRect :: Ptr RECT -> WindowStyle -> Bool -> IO Bool Source #
adjustWindowRectEx :: RECT -> WindowStyle -> Bool -> WindowStyleEx -> IO RECT Source #
c_AdjustWindowRectEx :: Ptr RECT -> WindowStyle -> Bool -> WindowStyleEx -> IO Bool Source #
arrangeIconicWindows :: HWND -> IO () Source #
bringWindowToTop :: HWND -> IO () Source #
closeWindow :: HWND -> IO () Source #
deferWindowPos :: HDWP -> HWND -> HWND -> Int -> Int -> Int -> Int -> SetWindowPosFlags -> IO HDWP Source #
c_DeferWindowPos :: HDWP -> HWND -> HWND -> Int -> Int -> Int -> Int -> SetWindowPosFlags -> IO HDWP Source #
destroyWindow :: HWND -> IO () Source #
endDeferWindowPos :: HDWP -> IO () Source #
findWindowEx :: Maybe HWND -> Maybe HWND -> Maybe String -> Maybe String -> IO (Maybe HWND) Source #
type SetWindowPosFlags = UINT Source #
type GetDCExFlags = DWORD Source #
destroyCaret :: IO () Source #
c_DestroyCaret :: IO Bool Source #
getCaretPos :: IO POINT Source #
setCaretPos :: POINT -> IO () Source #
updateWindow :: HWND -> IO () Source #
sendMessage :: HWND -> WindowMessage -> WPARAM -> LPARAM -> IO LRESULT Source #