Добро пожаловать в форум, Guest  >>   Войти | Регистрация | Поиск | Правила | В избранное | Подписаться
Все форумы / Delphi Новый топик    Ответить
 Отрисовка курсора на скриншоте ломает сохранение картинки  [new]
SilverShield
Member

Откуда:
Сообщений: 49
Здравствуйте! Коллеги, нужен совет. Есть код на delphi XE3 который создает скриншот экрана и сохраняет его в bmp файл.
Сам код рабочий и проблем не вызывает. Но в него добавлена отрисовка указателя мыши (курсора) где он в момент принтскрина находился и через 6000-10000 выполнений, сохранение файлов прекращается. Ошибок нет, но и не создается файл.

Сам код отрисовки курсора отдельно:
CurInfo.cbSize := SizeOf(CurInfo);
        GetCursorInfo(CurInfo);

        ACursor := CurInfo.hCursor;
        Pt := CurInfo.ptScreenPos;

        GetIconInfo (ACursor,IcoInfo);

        DrawIcon(
        hdcMemDC,
        Pt.X - Integer(IcoInfo.xHotspot),
        Pt.Y - Integer(IcoInfo.yHotspot),
        ACursor
        );


Я явно что-то очевидное упускаю, но не могу сообразить что не так делаю.


Весь код процедуры создания принтскрина:
procedure MakeScreenShot;
var
  WM, HM, i: integer;
  Left, Top: Integer;
  LeftMax, TopMax: Integer;

  hdcScreen, hdcMemDC: hDC;

  hbmScreen: HBITMAP;
  bmpScreen: BITMAP;

  bmfHeader: BITMAPFILEHEADER;
  bi: BITMAPINFOHEADER;
  dwBmpSize: DWORD;
  hDIB: THANDLE;
  dwBytesWritten: DWORD;
  hFile: THANDLE;
  dwSizeofDIB: DWORD;
  lpbitmap: Pointer;

  atagBITMAPINFO: tagBITMAPINFO;

  BmpFileName: string;

  ACursor: HICON;
  Pt: TPoint;
  CurInfo: tagCURSORINFO;
  IcoInfo: _ICONINFO;
begin

    Left := 0;
    Top := 0;
    LeftMax := 0;
    TopMax := 0;

    WM := 0;
    HM := 0;

      Screen.MonitorFromWindow(0, mdNull);
      if assigned(Screen) then
      begin
        for i := 0 to Screen.MonitorCount - 1 do
        begin
          if Screen.Monitors[i].Left < Left then
            Left := Screen.Monitors[i].Left;

          if Screen.Monitors[i].Top < Top then
            Top := Screen.Monitors[i].Top;

          if (Screen.Monitors[i].Left + Screen.Monitors[i].Width) > LeftMax then
            LeftMax := (Screen.Monitors[i].Left + Screen.Monitors[i].Width);

          if (Screen.Monitors[i].Top + Screen.Monitors[i].Height) > TopMax then
            TopMax := (Screen.Monitors[i].Top + Screen.Monitors[i].Height);
        end;

        WM := LeftMax - Left;
        HM := TopMax - Top;
      end
      else
      begin
        LogMessage('not assigned Screen');
        WM := 0;
        HM := 0;
      end;
    end;
    

    FLock.Enter;
    try
      // Retrieve the handle to a display device context for the client
      // area of the window.
      hdcScreen := GetDC(0);
      if (hdcScreen = 0) then
        LogMessage('GetDC(0) - fails.' + SysErrorMessage(GetLastError));


      // Create a compatible DC which is used in a BitBlt from the window DC
      hdcMemDC := CreateCompatibleDC(hdcScreen);
      if (hdcMemDC = 0) then
      begin
        LogMessage(SysErrorMessage(GetLastError));
        ReleaseDC(0, hdcScreen);
        Exit;
      end;

      // Create a compatible bitmap from the Window DC
      hbmScreen := CreateCompatibleBitmap(hdcScreen, WM,
        HM);
      if (hbmScreen = 0 ) then
      begin
        LogMessage(SysErrorMessage(GetLastError) + '-' +
          IntToStr(GetLastError));
        LogMessage('WM - ' + IntToStr(WM));
        LogMessage('HM - ' + IntToStr(HM));
        DeleteObject(hdcMemDC);
        ReleaseDC(0, hdcScreen);
        Exit;
      end;

      // Select the compatible bitmap into the compatible memory DC.
      SelectObject(hdcMemDC, hbmScreen);

      // Bit block transfer into our compatible memory DC.
      if(not BitBlt(hdcMemDC,
                 0 , 0,
                 WM, HM,
                 hdcScreen,
                 Left, Top,
                 SRCCOPY)) then
      begin
        LogMessage(SysErrorMessage(GetLastError));

        DeleteObject(hbmScreen);
        DeleteObject(hdcMemDC);
        ReleaseDC(0, hdcScreen);
        Exit;
      end;

      // -- курсор
        CurInfo.cbSize := SizeOf(CurInfo);
        GetCursorInfo(CurInfo);

        ACursor := CurInfo.hCursor;
        Pt := CurInfo.ptScreenPos;

        GetIconInfo (ACursor,IcoInfo);

        DrawIcon(
        hdcMemDC,
        Pt.X - Integer(IcoInfo.xHotspot),
        Pt.Y - Integer(IcoInfo.yHotspot),
        ACursor
        );


      // Get the BITMAP from the HBITMAP
      if GetObject(hbmScreen, sizeof(BITMAP), @bmpScreen) = 0 then
      begin
        LogMessage(IntToStr(GetLastError) + ' ' +
          SysErrorMessage(GetLastError));

        LogMessage('Get the BITMAP from the HBITMAP');
      end;

      bi.biSize := sizeof(BITMAPINFOHEADER);
      bi.biWidth := bmpScreen.bmWidth;
      bi.biHeight := bmpScreen.bmHeight;
      bi.biPlanes := 1;
      bi.biBitCount := 32;
      bi.biCompression := BI_RGB;
      bi.biSizeImage := 0;
      bi.biXPelsPerMeter := 0;
      bi.biYPelsPerMeter := 0;
      bi.biClrUsed := 0;
      bi.biClrImportant := 0;

      dwBmpSize := trunc(((bmpScreen.bmWidth * bi.biBitCount + 31) / 32) * 4 * bmpScreen.bmHeight);

      // Starting with 32-bit Windows, GlobalAlloc and LocalAlloc are implemented as wrapper functions that
      // call HeapAlloc using a handle to the process's default heap. Therefore, GlobalAlloc and LocalAlloc
      // have greater overhead than HeapAlloc.
      hDIB := GlobalAlloc(GHND, dwBmpSize);
      PChar(lpbitmap) := PChar(GlobalLock(hDIB));

      atagBITMAPINFO.bmiHeader := bi;

      //Получение самих бит картинки     
      GetDIBits(hdcScreen, hbmScreen, 0,
        bmpScreen.bmHeight,
        lpbitmap,
        atagBITMAPINFO, DIB_RGB_COLORS);

      if (lpbitmap = NIL) then
      begin
        LogMessage(IntToStr(GetLastError) + ' ' +
          SysErrorMessage(GetLastError));

        LogMessage('BITMAP не скопирован. конец истории');
        Exit;
      end;

      BmpFileName := GetTempFN;

      // A file is created, this is where we will save the screen capture.
      hFile := CreateFile(PWideChar(BmpFileName),
          GENERIC_WRITE,
          0,
          NIL,
          CREATE_ALWAYS,
          FILE_ATTRIBUTE_NORMAL, 0);

      try
        // Add the size of the headers to the size of the bitmap to get the total file size
        dwSizeofDIB := dwBmpSize + sizeof(BITMAPFILEHEADER) + sizeof(BITMAPINFOHEADER);

        //Offset to where the actual bitmap bits start.
        bmfHeader.bfOffBits := DWORD(sizeof(BITMAPFILEHEADER)) + DWORD(sizeof(BITMAPINFOHEADER));

        //Size of the file
        bmfHeader.bfSize := dwSizeofDIB;

        //bfType must always be BM for Bitmaps
        bmfHeader.bfType := $4D42; //BM

        dwBytesWritten := 0;

        if not WriteFile(hFile, bmfHeader, sizeof(BITMAPFILEHEADER), dwBytesWritten, NIL) then
          LogMessage(IntToStr(GetLastError) + SysErrorMessage(GetLastError));

        if not WriteFile(hFile, bi, sizeof(BITMAPINFOHEADER), dwBytesWritten, NIL) then
          LogMessage(IntToStr(GetLastError) + SysErrorMessage(GetLastError));

        if not WriteFile(hFile, lpbitmap^, dwBmpSize, dwBytesWritten, NIL) then
          LogMessage(IntToStr(GetLastError) + SysErrorMessage(GetLastError));

        //Unlock and Free the DIB from the heap
        GlobalUnlock(hDIB);
        GlobalFree(hDIB);

      finally
        //Close the handle for the file that was created
        CloseHandle(hFile);
      end;

      DeleteObject(hbmScreen);
      DeleteObject(hdcMemDC);
      ReleaseDC(0, hdcScreen);

    finally
      FLock.Leave;
    end;
  
end;


В коде ключевые места с проверками на пустые значения и обвязаны логированием, но ошибок не пишется, а файлы картинок через в среднем 6-10 тыс. снимков перестают создаваться.

Если код отрисовки курсора убрать, то все работает хорошо.
1 апр 21, 21:31    [22303134]     Ответить | Цитировать Сообщить модератору
 Re: Отрисовка курсора на скриншоте ломает сохранение картинки  [new]
asviridenkov
Member

Откуда:
Сообщений: 4031
SilverShield,

код не читал, но цифра 10 тыс наводит на мысль что теряется какой-то GDI хендл.
1 апр 21, 21:38    [22303135]     Ответить | Цитировать Сообщить модератору
 Re: Отрисовка курсора на скриншоте ломает сохранение картинки  [new]
white_nigger
Member

Откуда: Тула
Сообщений: 2520
Посмотри хэндлы в таскменеджере. Ещё вариант, комп за это время не лочится/в спячку не уходит?
1 апр 21, 21:45    [22303143]     Ответить | Цитировать Сообщить модератору
 Re: Отрисовка курсора на скриншоте ломает сохранение картинки  [new]
JayDi
Member

Откуда: Сызрань, Россия
Сообщений: 4173
Когда компьютер лочится или отключается по бездействию, то пользователь теряет доступ к рабочему столу, соответственно никаких скриншотов сделать нельзя.
1 апр 21, 23:25    [22303184]     Ответить | Цитировать Сообщить модератору
 Re: Отрисовка курсора на скриншоте ломает сохранение картинки  [new]
_Vasilisk_
Member

Откуда: Украина, Харьков
Сообщений: 12789
Выкинуть этот и подобный код
SilverShield
      hdcMemDC := CreateCompatibleDC(hdcScreen);
      if (hdcMemDC = 0) then
      begin
        LogMessage(SysErrorMessage(GetLastError));
        ReleaseDC(0, hdcScreen);
        Exit;
      end;
и заменить на
hdcMemDC := CreateCompatibleDC(hdcScreen);
Win32Check(hdcMemDC <> 0);
try
  ........
finally
  DeleteObject(hdcMemDC);
end;

На каждое создание объекта свой вложенный try-finally, снаружи один try-except

Сообщение было отредактировано: 1 апр 21, 23:28
1 апр 21, 23:35    [22303189]     Ответить | Цитировать Сообщить модератору
 Re: Отрисовка курсора на скриншоте ломает сохранение картинки  [new]
Aniskin
Member

Откуда:
Сообщений: 334
msdn
GetIconInfo creates bitmaps for the hbmMask and hbmColor members of ICONINFO. The calling application must manage these bitmaps and delete them when they are no longer necessary.
2 апр 21, 09:36    [22303233]     Ответить | Цитировать Сообщить модератору
 Re: Отрисовка курсора на скриншоте ломает сохранение картинки  [new]
SilverShield
Member

Откуда:
Сообщений: 49
Коллеги, благодарю за ответы!

Комп не лочится, там похоже что на самом деле хэндлы переполняются.
Но без отрисовки курсора код стабильно работает и десятками тысяч снимков и больше. Значит именно для структуры курсора я неправильно обрабатываю.

CurInfo.cbSize := SizeOf(CurInfo);
        GetCursorInfo(CurInfo);

        ACursor := CurInfo.hCursor;
        Pt := CurInfo.ptScreenPos;

        GetIconInfo (ACursor,IcoInfo);

        DrawIcon(
        hdcMemDC,
        Pt.X - Integer(IcoInfo.xHotspot),
        Pt.Y - Integer(IcoInfo.yHotspot),
        ACursor
        );


Как тут будет правильно освободить хэндл и bitmap?
2 апр 21, 14:28    [22303399]     Ответить | Цитировать Сообщить модератору
 Re: Отрисовка курсора на скриншоте ломает сохранение картинки  [new]
_Vasilisk_
Member

Откуда: Украина, Харьков
Сообщений: 12789
SilverShield
Как тут будет правильно освободить хэндл и bitmap?
DeleteObject()
2 апр 21, 14:32    [22303401]     Ответить | Цитировать Сообщить модератору
Все форумы / Delphi Ответить