0

I'm trying to create an app which takes the screenshot of running application. I've used code from this answer https://stackoverflow.com/a/11966931/2064205. I have a problem with the createBMPFile function, it saves black images. I've tried to create the similar app in C++, also has the same problem. I'm new in Haskell, do not pay attention to the code.

import Graphics.Win32.Window
import Graphics.Win32.GDI.Bitmap
import Graphics.Win32.GDI.HDC
import Graphics.Win32.GDI.Graphics2D
import Graphics.Win32.Window.ForegroundWindow
import Graphics.Win32.GDI.Types (HWND)
import Foreign.Ptr

    getValueFromMaybe :: Maybe HWND -> HWND
    getValueFromMaybe mx = 
        case mx of
            Just value -> value
            Nothing ->  nullPtr

    main = do 
          desktop   <- findWindowByName "slack" -- Grab the Hwnd of the window with title "slack", GetDC 0, GetDC NULL etc all work too
          setForegroundWindow . getValueFromMaybe $ desktop
          desktop   <- findWindowByName "slack"
          hdc       <- getWindowDC desktop -- Get the dc handle of the desktop
          (x,y,r,b) <- getWindowRect . getValueFromMaybe $ desktop -- Find the size of the desktop so we can know which size the destination bitmap should be
                                             -- (left, top, right, bottom)
          newDC     <- createCompatibleDC (Just hdc) -- Create a new DC to hold the copied image. It should be compatible with the source DC
          let width  = r - x -- Calculate the width
          let height = b - y -- Calculate the Height
          newBmp    <- createCompatibleBitmap hdc width height -- Create a new Bitmap which is compatible with the newly created DC
          selBmp    <- selectBitmap newDC newBmp -- Select the Bitmap into the DC, drawing on the DC now draws on the bitmap as well
          bitBlt newDC 0 0 width height hdc 0 0 sRCCOPY -- use SRCCOPY to copy the desktop DC into the newDC
          createBMPFile "Foo.bmp" newBmp newDC  -- Write out the new Bitmap file to Foo.bmp
          putStrLn "Bitmap image copied" -- Some debug message
          deleteBitmap selBmp -- Cleanup the selected bitmap
          deleteBitmap newBmp -- Cleanup the new bitmap
          deleteDC newDC      -- Cleanup the DC we created.
PleaseTwo
  • 368
  • 4
  • 6
  • What about some error checking? – zett42 Jun 27 '17 at 10:15
  • Win32 has error checking functionality, if something went wrong it raises an exception. During the execution of this function, I didn't get exceptions. – PleaseTwo Jun 27 '17 at 11:08
  • The actual error checking performed in `createBMPFile` is... sub-par: see https://github.com/haskell/win32/blob/master/cbits/dumpBMP.c – beerboy Jun 27 '17 at 23:04

0 Answers0