Мастера DELPHI (документация, исходники, скачать)

Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

ScreenShot экрана [D7, WinXP]

ElRaki © (2004-08-09 21:15:00)
Не знает ли кто, как сделать скриншот экрана и сохранить его в файл? Только без манипуляций с буфером. Или вообще алгоритм сохранения Hbitmap в нормальном bmp. Заранее спасибо.

OSokin (2004-08-10 20:22:00) [1]
Что, не можешь??? Просто возьми, создай канвас, поставь ему дц 0 и потом как хочешь сохраняй в файл.

Delphi5.01 (2004-08-10 14:11:00) [2]
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.

Vetek_2 (2004-08-10 13:46:00) [3]
Сейчас "модно" писать программы с использованием Кол, так как это "Супер" - библиотека, в ней есть почти всё, и программы получаются небольшие по размеру :)
- ещё есть отличное дополнение к кол - библиотека AVL, но я не знаю, где достать её новую версию ..
- Я сам всегда пишу программы с использованием KOL+AVL получается очень здорово :)

ElRaki (2004-08-09 23:33:00) [4]
Спасибо за код. Если честно, я пообещал написать прогу на чистом Api. KOL в мои планы не входил. Но видимо придется все-таки нарушить условия, я уже 3 дня клепаю код на WinApi. Безуспешно.

VMcL (2004-08-09 23:16:00) [5]
>> AntiTroyan1 (09.08.04 21:36) [3]

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

Wow.

AntiTroyan1 (2004-08-09 21:36:00) [6]
- во втором варианте программа имеет размер (после сжатия UPX'ом) около 9 кб (!)

AntiTroyan1 (2004-08-09 21:35:00) [7]
а вот и для 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:33:00) [8]
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.

Наверх

	« предыдущая ветвь \| форум \| следующая ветвь »