Скачать: CL | DM;

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 получается очень здорово :)

---

← →
Delphi5.01 ©   (2004-08-10 14:11) [7]

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.

---

← →
OSokin ©   (2004-08-10 20:22) [8]

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

---

Страницы: 1 вся ветка

Скачать: CL | DM;



Память: 0.47 MB
Время: 0.021 c