powered by simpleCommunicator - 2.0.59     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Отрисовка курсора на скриншоте ломает сохранение картинки
8 сообщений из 8, страница 1 из 1
Отрисовка курсора на скриншоте ломает сохранение картинки
    #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
Отрисовка курсора на скриншоте ломает сохранение картинки
    #40058968
asviridenkov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SilverShield,

код не читал, но цифра 10 тыс наводит на мысль что теряется какой-то GDI хендл.
...
Рейтинг: 0 / 0
Отрисовка курсора на скриншоте ломает сохранение картинки
    #40058969
white_nigger
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Посмотри хэндлы в таскменеджере. Ещё вариант, комп за это время не лочится/в спячку не уходит?
...
Рейтинг: 0 / 0
Отрисовка курсора на скриншоте ломает сохранение картинки
    #40058977
Фотография JayDi
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Когда компьютер лочится или отключается по бездействию, то пользователь теряет доступ к рабочему столу, соответственно никаких скриншотов сделать нельзя.
...
Рейтинг: 0 / 0
Отрисовка курсора на скриншоте ломает сохранение картинки
    #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
Отрисовка курсора на скриншоте ломает сохранение картинки
    #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
Отрисовка курсора на скриншоте ломает сохранение картинки
    #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
Отрисовка курсора на скриншоте ломает сохранение картинки
    #40059115
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SilverShield
Как тут будет правильно освободить хэндл и bitmap?
DeleteObject()
...
Рейтинг: 0 / 0
8 сообщений из 8, страница 1 из 1
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Отрисовка курсора на скриншоте ломает сохранение картинки
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


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