Гость
Целевая тема:
Создать новую тему:
Автор:
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Отрисовка курсора на скриншоте ломает сохранение картинки / 8 сообщений из 8, страница 1 из 1
01.04.2021, 21:31
    #40058967
SilverShield
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Отрисовка курсора на скриншоте ломает сохранение картинки
Здравствуйте! Коллеги, нужен совет. Есть код на delphi XE3 который создает скриншот экрана и сохраняет его в bmp файл.
Сам код рабочий и проблем не вызывает. Но в него добавлена отрисовка указателя мыши (курсора) где он в момент принтскрина находился и через 6000-10000 выполнений, сохранение файлов прекращается. Ошибок нет, но и не создается файл.

Сам код отрисовки курсора отдельно:
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
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
        );



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


Весь код процедуры создания принтскрина:
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
198.
199.
200.
201.
202.
203.
204.
205.
206.
207.
208.
209.
210.
211.
212.
213.
214.
215.
216.
217.
218.
219.
220.
221.
222.
223.
224.
225.
226.
227.
228.
229.
230.
231.
232.
233.
234.
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 тыс. снимков перестают создаваться.

Если код отрисовки курсора убрать, то все работает хорошо.
...
Рейтинг: 0 / 0
01.04.2021, 21:38
    #40058968
asviridenkov
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Отрисовка курсора на скриншоте ломает сохранение картинки
SilverShield,

код не читал, но цифра 10 тыс наводит на мысль что теряется какой-то GDI хендл.
...
Рейтинг: 0 / 0
01.04.2021, 21:45
    #40058969
white_nigger
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Отрисовка курсора на скриншоте ломает сохранение картинки
Посмотри хэндлы в таскменеджере. Ещё вариант, комп за это время не лочится/в спячку не уходит?
...
Рейтинг: 0 / 0
01.04.2021, 23:25
    #40058977
JayDi
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Отрисовка курсора на скриншоте ломает сохранение картинки
Когда компьютер лочится или отключается по бездействию, то пользователь теряет доступ к рабочему столу, соответственно никаких скриншотов сделать нельзя.
...
Рейтинг: 0 / 0
01.04.2021, 23:35
    #40058979
_Vasilisk_
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Отрисовка курсора на скриншоте ломает сохранение картинки
Выкинуть этот и подобный код
SilverShield
Код: pascal
1.
2.
3.
4.
5.
6.
7.
      hdcMemDC := CreateCompatibleDC(hdcScreen);
      if (hdcMemDC = 0) then
      begin
        LogMessage(SysErrorMessage(GetLastError));
        ReleaseDC(0, hdcScreen);
        Exit;
      end;

и заменить на
Код: pascal
1.
2.
3.
4.
5.
6.
7.
hdcMemDC := CreateCompatibleDC(hdcScreen);
Win32Check(hdcMemDC <> 0);
try
  ........
finally
  DeleteObject(hdcMemDC);
end;


На каждое создание объекта свой вложенный try-finally, снаружи один try-except
...
Рейтинг: 0 / 0
02.04.2021, 09:36
    #40059005
Aniskin
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Отрисовка курсора на скриншоте ломает сохранение картинки
msdnGetIconInfo 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 .
...
Рейтинг: 0 / 0
02.04.2021, 14:28
    #40059114
SilverShield
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Отрисовка курсора на скриншоте ломает сохранение картинки
Коллеги, благодарю за ответы!

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

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
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?
...
Рейтинг: 0 / 0
02.04.2021, 14:32
    #40059115
_Vasilisk_
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Отрисовка курсора на скриншоте ломает сохранение картинки
SilverShield
Как тут будет правильно освободить хэндл и bitmap?
DeleteObject()
...
Рейтинг: 0 / 0
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Отрисовка курсора на скриншоте ломает сохранение картинки / 8 сообщений из 8, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]