ScreenShot экрана

← →
ElRaki (2004-08-09 21:15) [0]

Не знает ли кто, как сделать скриншот экрана и сохранить его в файл? Только без манипуляций с буфером. Или вообще алгоритм сохранения Hbitmap в нормальном bmp. Заранее спасибо.

← →
AntiTroyan1 (2004-08-09 21:33) [1]

program Project1;

uses
Windows,SysUtils, Graphics,jpeg;

function ScreenWidth:Integer;
begin
Result := GetSystemMetrics(SM_CXSCREEN);
end;
function ScreenHeight:Integer;
begin
Result := GetSystemMetrics(SM_CYSCREEN);
end;

Var bmp1: TBitmap; jpg2:TJpegImage;FileName:String;
begin
if ParamCount<1 then
begin
FileName:=Paramstr(0);
delete(FileName,Length(FileName)-3,4);
FileName:=FileName+".jpg"
end else
FileName:=Paramstr(1);

bmp1 := TBitmap.Create;
jpg2 := TJpegImage.Create;
bmp1.Height := ScreenHeight;
bmp1.Width := ScreenWidth;
BitBlt(bmp1.Canvas.Handle, 0, 0, ScreenWidth, ScreenHeight, GetDC(GetDesktopWindow), 0, 0, SRCCopy);
jpg2.Assign(bmp1);
if ParamCount<>2 then
jpg2.CompressionQuality:=57 else
jpg2.CompressionQuality:=StrToInt(Paramstr(2));

jpg2.Compress;
jpg2.SaveToFile(FileName);
bmp1.Free; jpg2.Free;
end.

← →
AntiTroyan1 (2004-08-09 21:35) [2]

а вот и для bmp

program Project1;

uses
Windows,Kol;
Var
bmp: PBitmap;
FileName:string;
{$R *.res}

function ScreenWidth:Integer;
begin
Result := GetSystemMetrics(SM_CXSCREEN);
end;
function ScreenHeight:Integer;
begin
Result := GetSystemMetrics(SM_CYSCREEN);
end;

begin
if ParamCount<>1 then
begin
FileName:=Paramstr(0);
delete(FileName,Length(FileName)-3,4);
FileName:=FileName+".bmp"
end else
FileName:=Paramstr(1);
bmp:=NewBitmap(0,0);
bmp.Height := ScreenHeight;
bmp.Width := ScreenWidth;
BitBlt(bmp.Canvas.Handle, 0, 0, ScreenWidth, ScreenHeight, GetDC(GetDesktopWindow), 0, 0, SRCCopy);
bmp.SaveToFile(FileName);
bmp.Free;
end.

← →
AntiTroyan1 (2004-08-09 21:36) [3]

- во втором варианте программа имеет размер (после сжатия UPX"ом) около 9 кб (!)

← →
VMcL © (2004-08-09 23:16) [4]

>>AntiTroyan1 (09.08.04 21:36) [3]

>во втором варианте программа имеет размер (после сжатия UPX"ом) около 9 кб (!)

Wow.

← →
ElRaki (2004-08-09 23:33) [5]

Спасибо за код. Если честно, я пообещал написать прогу на чистом Api. KOL в мои планы не входил. Но видимо придется все-таки нарушить условия, я уже 3 дня клепаю код на WinApi. Безуспешно.

← →
Vetek_2 (2004-08-10 13:46) [6]

Сейчас "модно" писать программы с использованием Кол, так как это "Супер" - библиотека, в ней есть почти всё, и программы получаются небольшие по размеру :)
- ещё есть отличное дополнение к кол - библиотека AVL, но я не знаю, где достать её новую версию ..
- Я сам всегда пишу программы с использованием KOL+AVL получается очень здорово :)

Na shot KOL, ia programu nakatal po otsilke SMS soobshenii na KOL. Skaju chestno ochen klovaia biblioteka no .... tolko dla povishenia znani. A tak ochen slojno perehodit s VCL na KOL esli k primeru net znani v idee sozdania komponentov i samoe glavnoe (u mena etot nedostatok bil) Object Paskal.

Что, не можешь??? Просто возьми, создай канвас, поставь ему дц 0 и потом как хочешь сохраняй в файл.

ScreenShot экрана Найти похожие ветки