{- 2012-05-16
ghc --make -optl-mwindows fileName.hs
option -mwindows is passed to the linker!
attempting to read from stdin with -mwindows may cause a runtime error
any output on stdout/stderr will be lost.
ghc links console app with stdout/stderr as default
-}
--import Graphics.Win32
import Graphics.Win32 hiding (messageBox, c_MessageBox) -- bugfix
import System.Win32.DLL
import Control.Exception (bracket)
import Foreign
import System.Exit
-- bugfix whole msg box
messageBox :: HWND -> String -> String -> MBStyle -> IO MBStatus
messageBox wnd text caption style =
withTString text $ \ c_text ->
withTString caption $ \ c_caption ->
failIfZero "MessageBox" $ c_MessageBox wnd c_text c_caption style
foreign import stdcall safe "windows.h MessageBoxW"
c_MessageBox :: HWND -> LPCTSTR -> LPCTSTR -> MBStyle -> IO MBStatus
main :: IO ()
main = do
mainInstance <- getModuleHandle Nothing
hwnd <- createWindow_ 200 200 wndProc mainInstance
createButton_ hwnd mainInstance
messagePump hwnd
wndProc :: HWND -> WindowMessage -> WPARAM -> LPARAM -> IO LRESULT
wndProc hwnd wmsg wParam lParam
| wmsg == wM_DESTROY = do
sendMessage hwnd wM_QUIT 1 0
return 0
| wmsg == wM_COMMAND && wParam == 3 = do
messageBox nullPtr "You pressed me." "Haskell msg" 0
return 0
| otherwise = defWindowProc (Just hwnd) wmsg wParam lParam
createWindow_ :: Int -> Int -> WindowClosure -> HINSTANCE -> IO HWND
createWindow_ width height wndProc mainInstance = do
let winClass = mkClassName "Window Empty"
icon <- loadIcon Nothing iDI_APPLICATION
cursor <- loadCursor Nothing iDC_ARROW
bgBrush <- createSolidBrush (rgb 255 0 0)
registerClass (cS_VREDRAW + cS_HREDRAW, mainInstance, Just icon, Just cursor, Just bgBrush, Nothing, winClass)
w <- createWindow winClass "Window Empty" wS_OVERLAPPEDWINDOW Nothing Nothing (Just width) (Just height) Nothing Nothing mainInstance wndProc
showWindow w sW_SHOWNORMAL
updateWindow w
return w
createButton_ :: HWND -> HINSTANCE -> IO ()
createButton_ hwnd mainInstance = do
hBtn <- createButton "Button test" wS_EX_CLIENTEDGE (bS_PUSHBUTTON + wS_VISIBLE + wS_CHILD) (Just 50) (Just 80) (Just 80) (Just 20) (Just hwnd) (Just (castUINTToPtr 3)) mainInstance
return ()
messagePump :: HWND -> IO ()
messagePump hwnd = allocaMessage $ \ msg ->
let pump = do
getMessage msg (Just hwnd) `catch` \ _ -> exitWith ExitSuccess
translateMessage msg
dispatchMessage msg
pump
in pump
原始链接在这里
用法:复制/粘贴代码,将其保存在一个文件中,使用它进行编译,ghc --make -optl-mwindows fileName.hs
它将创建一个漂亮的小窗口。这是基本的 C/C++ 像这里。
这个和下面的另外两个示例只是我可以找到用 Haskell 编写的原始createWindow 代码:(
我的反问:
我非常了解 C++ 过程。您创建来函数,如果某些 win_msg 为真,winProc 将调用它......
但是,这不是唯一的方法。很快,MS 就把它放在了 mfc 类中。我们有 EventListeners,它们基本上做同样的事情。而不是直接测试您创建/添加事件监听器的 win_msg,传递所需的函数并且它可以工作。
但是代码分组更好,更易于维护,并且更像 OO。Haskell 用于 Haskellising winProc 的方法是什么?可能有一些方法可以模仿 addEventListener(evt, my_func)。
那个代码会是什么样子?有多少种不同的解决方案?它可以使用吗?更重要的是,是否有一些我不知道的类似 Haskell 的(更好的)方式?
- 您可以通过哪些方式使用该代码,对其进行一些改进并创建类似 wxWidgets 或 gtk 的东西,但极其简化、易于理解等。