トップ > Haskell > wxHaskell で IME を制御する。(WIN32API)

wxHaskell で IME を制御する。(WIN32API)

Haskell MS-Windows wxHaskell

  • 最初、wxHaskell で HWND を取得する方法が分からず、WIN32APIを呼ぼうとしましたが、うまくいきませんでした。wxHaskell で HWND をとる方法を見つけてwxHaskell で出来るのを知りました。


ボタンを押すたびにIMEのオン、オフ状態が切り替わります。「英数」、「全角かな」の切り替えならこれでも大丈夫そうです。

{-# LANGUAGE ForeignFunctionInterface #-}

-- ghc -Wall --make -fno-warn-wrong-do-bind -optl-mwindows onoffime.hs -limm32 -o onoffime.exe
module Main where

import Graphics.UI.WX
import Graphics.UI.WXCore
import Foreign.Ptr
import Foreign.C.Types

main :: IO ()
main
  = start gui

gui :: IO ()
gui
  = do f      <- frame  [text := "IME test"]
       p      <- panel  f []
       xinput <- textEntry p []
       ok     <- button p [text := "Close" , on command := close f]
       can    <- button p [text := "change", on command := changeIMEonOff xinput]

       set f [defaultButton := ok
             ,layout := container p $
                        margin 10 $
                        column 5 [boxed "IME 制御" (grid 3 5 [[label "input:", hfill $ widget xinput]])
                                 ,floatBottomRight $ row 5 [widget ok,widget can]]
             ]
       focusOn xinput
       return ()

isCTrue :: Int -> Bool
isCTrue x = not (x==0) 

cShow :: Int -> String
cShow 0 = "False"
cShow _ = "True"


changeIMEonOff :: Window a -> IO ()
changeIMEonOff tCtrl = do
  tHWND   <- windowGetHandle tCtrl
  tHIMC   <- cImmGetContext tHWND
  openSTS <- cImmGetOpenStatus tHIMC
  if isCTrue openSTS then setOpenStatus tHIMC False
                     else setOpenStatus tHIMC True
  _ <- cImmReleaseContext tHWND tHIMC
  focusOn tCtrl
  return()

setOpenStatus :: HIMC -> Bool -> IO()
setOpenStatus tHIMC True  = cImmSetOpenStatus tHIMC 0x0001 >>= \_ -> return()
setOpenStatus tHIMC False = cImmSetOpenStatus tHIMC 0x0000 >>= \_ -> return()

type HWND = Ptr ()
type HIMC = Ptr ()
foreign import stdcall "windows.h ImmGetContext"     cImmGetContext     :: HWND -> IO HIMC
foreign import stdcall "windows.h ImmGetOpenStatus"  cImmGetOpenStatus  :: HIMC -> IO Int
foreign import stdcall "windows.h ImmSetOpenStatus"  cImmSetOpenStatus  :: HIMC -> CUInt -> IO Int
foreign import stdcall "windows.h ImmReleaseContext" cImmReleaseContext :: HWND -> HIMC -> IO Int

「英数MODE」、「全角MODE」のボタンで入力モードが切り替わります。

setConversionStatus 関数の中でputStrLn を使って値を表示しています。
ダブルクリックではなく、コマンドプロンプトからプログラムを立ち上げ、TextCtrlの漢字モードを変更するたびに値を表示ます。

{-# LANGUAGE ForeignFunctionInterface #-}

-- ghc -Wall --make -fno-warn-wrong-do-bind -optl-mwindows showime.hs -limm32 -o showime.exe
module Main where

import Graphics.UI.WX
import Graphics.UI.WXCore
import Control.Monad
import Foreign.Ptr
import Foreign.C.Types
import Foreign.Marshal.Alloc
import Foreign.Storable
import System.IO
import Numeric

main :: IO ()
main
  = start gui

gui :: IO ()
gui
  = do f       <- frame  [text := "IME test"]
       p       <- panel  f []
       xinput  <- textEntry p []
       han     <- button p [text := "英数MODE", on command := toEisuu   xinput]
       zen     <- button p [text := "全角MODE", on command := toZenkaku xinput]
       frameCenter f
       set f [defaultButton := han
             ,layout := container p $
                        margin 10 $
                        column 5 [boxed "IME 制御" (grid 3 5 [[label "input:", hfill $ widget xinput]])
                                 ,floatBottomRight $ row 5 [widget han,widget zen]]
             ]
       focusOn xinput
       return ()

isCTrue :: Int -> Bool
isCTrue x = not (x==0) 

cShow :: Int -> String
cShow 0 = "False"
cShow _ = "True"

toEisuu :: Window a -> IO ()  -- 0x0000:IME_CMODE_ALPHANUMERIC
                              -- 0x0008:IME_SMODE_PHRASEPREDICT
toEisuu tCtrl = setConversionStatus tCtrl 0x0000 0x0008

toZenkaku :: Window a -> IO () -- 0x0001:IME_CMODE_NATIVE | 0x0008:IME_CMODE_FULLSHAPE
                               -- 0x0008:IME_SMODE_PHRASEPREDICT
toZenkaku tCtrl = setConversionStatus tCtrl 0x0009 0x008

setConversionStatus :: Window a -> CUInt ->  CUInt -> IO ()
setConversionStatus tCtrl inputm convm = do
  tHWND   <- windowGetHandle tCtrl
  tHIMC   <- cImmGetContext tHWND
  openSTS <- cImmGetOpenStatus tHIMC
  unless (isCTrue openSTS) (setOpenStatus tHIMC True)
  setSTS  <- cImmSetConversionStatus tHIMC inputm convm
  -- =============== 以下は表示のためなのでいらない =======================
  putStrLn ("cImmSetConversionStatus:" ++ cShow setSTS) >> hFlush stdout
  lpfdwConversion <- (malloc::IO (Ptr CUInt))
  lpfdwSentence   <- (malloc::IO (Ptr CUInt))
  getSTS  <- cImmGetConversionStatus tHIMC lpfdwConversion lpfdwSentence
  putStrLn ("cImmGetConversionStatus:" ++ cShow getSTS) >> hFlush stdout
  inputMODE      <- peek lpfdwConversion
  conversionMODE <- peek lpfdwSentence
  putStrLn ("inputMODE     :" ++ showHex inputMODE "")      >> hFlush stdout  
  putStrLn ("conversionMODE:" ++ showHex conversionMODE "") >> hFlush stdout  
  free lpfdwConversion >> free lpfdwSentence
  -- ================ ここまで ======================
  _ <- cImmReleaseContext tHWND tHIMC
  focusOn tCtrl
  return()

setOpenStatus :: HIMC -> Bool -> IO()
setOpenStatus tHIMC True  = cImmSetOpenStatus tHIMC 0x0001 >>= \_ -> return()
setOpenStatus tHIMC False = cImmSetOpenStatus tHIMC 0x0000 >>= \_ -> return()

type HWND = Ptr ()
type HIMC = Ptr ()
foreign import stdcall "windows.h ImmGetContext"          cImmGetContext     :: HWND -> IO HIMC
foreign import stdcall "windows.h ImmGetOpenStatus"       cImmGetOpenStatus  :: HIMC -> IO Int
foreign import stdcall "windows.h ImmSetOpenStatus"       cImmSetOpenStatus  :: HIMC -> CUInt -> IO Int
foreign import stdcall "windows.h ImmGetConversionStatus" cImmGetConversionStatus :: HIMC -> Ptr CUInt -> Ptr CUInt -> IO Int
foreign import stdcall "windows.h ImmSetConversionStatus" cImmSetConversionStatus :: HIMC -> CUInt -> CUInt -> IO Int
foreign import stdcall "windows.h ImmReleaseContext"      cImmReleaseContext :: HWND -> HIMC -> IO Int

参考