#if __GLASGOW_HASKELL__ >= 709
{-# LANGUAGE Safe #-}
#else
{-# LANGUAGE Trustworthy #-}
#endif
module Graphics.Win32.Icon where
import Graphics.Win32.GDI.Types
import System.Win32.Types
#include "windows_cconv.h"
copyIcon :: HICON -> IO HICON
copyIcon :: HICON -> IO HICON
copyIcon HICON
icon =
String -> IO HICON -> IO HICON
forall a. String -> IO (Ptr a) -> IO (Ptr a)
failIfNull String
"CopyIcon" (IO HICON -> IO HICON) -> IO HICON -> IO HICON
forall a b. (a -> b) -> a -> b
$ HICON -> IO HICON
c_CopyIcon HICON
icon
foreign import WINDOWS_CCONV unsafe "windows.h CopyIcon"
c_CopyIcon :: HICON -> IO HICON
drawIcon :: HDC -> Int -> Int -> HICON -> IO ()
drawIcon :: HICON -> Int -> Int -> HICON -> IO ()
drawIcon HICON
dc Int
x Int
y HICON
icon =
String -> IO Bool -> IO ()
failIfFalse_ String
"DrawIcon" (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ HICON -> Int -> Int -> HICON -> IO Bool
c_DrawIcon HICON
dc Int
x Int
y HICON
icon
foreign import WINDOWS_CCONV unsafe "windows.h DrawIcon"
c_DrawIcon :: HDC -> Int -> Int -> HICON -> IO Bool
destroyIcon :: HICON -> IO ()
destroyIcon :: HICON -> IO ()
destroyIcon HICON
icon =
String -> IO Bool -> IO ()
failIfFalse_ String
"DestroyIcon" (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ HICON -> IO Bool
c_DestroyIcon HICON
icon
foreign import WINDOWS_CCONV unsafe "windows.h DestroyIcon"
c_DestroyIcon :: HICON -> IO Bool