Наши преимущества

скриншот в дельфи

nave

Турист
Credits
0
господа программисты,
есть вопрос: что-бы такое написать в коде программы (delphi), чтобы во время её выполнения делались скриншоты и сохранялись в какое-то определенное место?
помогите, пожалуйста!
 
procedure CopyScreen(FileName:string);
var
widthscreen, heightscreen, i:Integer;
hdc1, dib, hdc, nb, hf:cardinal;
bmf:tagBITMAPINFO;
bmfh:tagBITMAPFILEHEADER;
adr:pointer;
buf:byte;
buff:array of byte;
str:_OFSTRUCT;
begin
widthscreen:=GetSystemMetrics(SM_CXSCREEN);//ширина экрана
heightscreen:=GetSystemMetrics(SM_CYSCREEN);//высота экрана
hdc:=GetDC(0);//контекст экрана
hdc1:=CreateCompatibleDC(hdc);//совместимый контекст
bmf.bmiHeader.biSize:=SizeOf(bmf.bmiHeader);
bmf.bmiHeader.biWidth:=widthscreen;
bmf.bmiHeader.biHeight:=heightscreen;
bmf.bmiHeader.biPlanes:=1;
bmf.bmiHeader.biBitCount:=24;
bmf.bmiHeader.biCompression:=BI_RGB;
bmf.bmiHeader.biSizeImage:=((widthscreen*3+3) and $FFFFFFFC)*heightscreen;
dib:=CreateDibSection(hdc1, bmf, DIB_RGB_COLORS, adr, 0, 0);
SelectObject(hdc1, dib);
BitBlt(hdc1, 0, 0, widthscreen, heightscreen, hdc, 0, 0, SRCCOPY);
bmfh.bfType:=$4D42;
bmfh.bfSize:=SizeOf(bmfh)+40+bmf.bmiHeader.biSizeImage;
bmfh.bfOffBits:=SizeOf(bmfh)+40;
SetLength(buff, bmf.bmiHeader.biSizeImage);
GetDiBits(hdc1, dib, 1, heightscreen, @buff[0], bmf, DIB_PAL_COLORS);
hf:=OpenFile(PChar(FileName), str, OF_CREATE or OF_READWRITE);
WriteFile(hf, bmfh.bfType, 2, nb, nil);
WriteFile(hf, bmfh.bfSize, 4, nb, nil);
buf:=0;
For i:=1 to 4 do
WriteFile(hf, buf, 1, nb, nil);
WriteFile(hf, bmfh.bfOffBits, 4, nb, nil);
WriteFile(hf, bmf.bmiHeader.biSize, 4, nb, nil);
WriteFile(hf, bmf.bmiHeader.biWidth, 4, nb, nil);
WriteFile(hf, bmf.bmiHeader.biHeight, 4, nb, nil);
WriteFile(hf, bmf.bmiHeader.biPlanes, 2, nb, nil);
WriteFile(hf, bmf.bmiHeader.biBitCount, 2, nb, nil);
WriteFile(hf, bmf.bmiHeader.biCompression, 4, nb, nil);
WriteFile(hf, bmf.bmiHeader.biSizeImage, 4, nb, nil);
For i:=1 to 16 do
WriteFile(hf, buf, 1, nb, nil);
WriteFile(hf, buff[0], bmf.bmiHeader.biSizeImage, nb, nil);
buff:=nil;
CloseHandle(hf);
DeleteObject(hdc1);
DeleteObject(dib);
end;
Взял здесь:
_http://forum.codeby.net/lofiversion/index.php/t5425.html
сам не проовал.

Вот еще нашел без API, но, вроде, попроще:
_http://darkshurik.fatal.ru/delphi/copy_desktop.php
 
Последнее редактирование модератором:
  • Like
Реакции: nave
Обязательно из своей проги такое делать? Сторонним ПО воспользоватья можно?
 
nave,
отпишись хоть, чего получилось и как. Нам же тоже интересно :)
 
Ognev
с радостью.
зашла к темному шурику по твоей последней ссылке. в следующий раз сама повнимательнее поищу, прежде чем спрашивать:). ну да это не в тему. короче, все получилось! спасибо тебе большое.
 
nave,
может бросишь здесь для истории рабочий код. Тем более, что та ссылка сдохла.
 
Верх