2011-09-05 18 views
5
import Graphics.Win32 
import System.Win32.DLL 
import Control.Exception (bracket) 
import Foreign 
import System.Exit 
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 == 1 = do 
     messageBox nullPtr "Yahoo!!" "Message box" 0 -- Error! Why? :(
     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 "ButtonExampleWindow" 
    icon <- loadIcon Nothing iDI_APPLICATION 
    cursor <- loadCursor Nothing iDC_ARROW 
    bgBrush <- createSolidBrush (rgb 240 240 240) 
    registerClass (cS_VREDRAW + cS_HREDRAW, mainInstance, Just icon, Just cursor, Just bgBrush, Nothing, winClass) 
    w <- createWindow winClass "Button example" 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 "Press me" wS_EX_CLIENTEDGE (bS_PUSHBUTTON + wS_VISIBLE + wS_CHILD) (Just 50) (Just 80) (Just 80) (Just 20) (Just hwnd) (Just (castUINTToPtr 1)) 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 

Ecco un'applicazione GUI semplice win32 con un pulsante, ma quando clicco il tasto ci deve essere una finestra di messaggio (22 linee), ma non v'è errore:finestra di messaggio di errore: importazione estera non sicuro

pulsanti .exe: pianificazione: reinserito in modo non sicuro. Forse un 'importazione estera non sicura' dovrebbe essere 'sicuro'?

Come posso risolvere il problema?

+3

posso' t rispondi a come risolverlo, ma questo sembra un bug. Probabilmente dovresti lamentarti con il manutentore del pacchetto che fornisce Graphics.Win32. –

risposta

5

Come ha commentato Daniel Wagner, si tratta di un bug nel pacchetto Win32. MessageBoxW deve essere importato in sicurezza, a causa dei numerosi effetti collaterali che ha.

La funzione messageBox è un wrapper per la funzione importata "non sicura" MessageBoxW. Quando una funzione di funzione importata in modo non sicuro viene importata in modo non sicuro, Haskell presuppone che il thread non chiami alcun codice Haskell finché non ritorna. Tuttavia, se chiami MessageBoxW, Windows invierà alcuni messaggi di finestra alla finestra creata nella riga 30, quindi il codice Haskell verrà eseguito mentre ti trovi in ​​una funzione straniera non sicura. Questo è anche il motivo per cui le chiamate a messageBox funzioneranno allo fino al che la finestra è stata creata.

Una possibile soluzione è semplicemente correggere la funzione da soli. In primo luogo, modificare

import Graphics.Win32 

a

import Graphics.Win32 hiding (messageBox, c_MessageBox) 

Quindi, copiare le definizioni di messageBox e c_MessageBox dal modulo Graphics.Win32.Misc, con unsafe rimossi e/o safe aggiunto:

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 
+0

Grande risposta Tinctorio! Domande successive: – CoR

+0

1. dove posso trovare Graphics.Win32.Misc in Haskell dir? Ho solo i file .hi nella cartella lib. 2. Questo è l'ultimo bug di yers. Ti chiedi perché non è stato risolto nel pacchetto Haskel? – CoR

+1

1) È possibile copiare la definizione da [qui] (https://github.com/Tinctorius/win32/blob/5fc830d7e956ad890ec12d0ed29bcae6662625bd/Graphics/Win32/Misc.hsc#L127); questa versione è già stata corretta. In alternativa, si potrebbe dire 'cabal unpack win32' al prompt dei comandi (che creerà una cartella chiamata" win32 "nella directory corrente, e scaricherà e decomprimerà la libreria win32 lì) e poi la cercherà. 2) Il maintainer originale non ha mai risposto alla mia e-mail. Ho inviato [una richiesta pull tramite Github] (https://github.com/haskell/win32/pull/5) ora, che dovrebbe essere risolto molto più velocemente :) –