ScreenShot direto para jpg
04/11/2005
0
Usei o código do imageserver dos exemplos Indy do delphi 6 para carregar imagens de uma determinada máquina (IP), porém ele salva em um ´.bmp´ de quase 3Mb o que está deixando o tempo entre um screenshot e outro muito grande.
Tentei transformar este mesmo ´.bmp´ em ´.jpg´, mas só o tempo de geração do arquivo já está tornando complicada a visualização pelo cliente.
Existe uma maneira de gerar um screenshot direto para um arquivo jpg ?
Extou usando o seguinte código:
---------------------------------------
procedure TfrmServer.ScreenShot(x : integer; y : integer; Width : integer; Height : integer; bm : TBitMap);
var
dc: HDC; lpPal : PLOGPALETTE;
begin
{test width and height}
if ((Width = 0) OR (Height = 0)) then exit;
bm.Width := Width;
bm.Height := Height;
{get the screen dc}
dc := GetDc(0);
if (dc = 0) then exit;
{do we have a palette device?}
if (GetDeviceCaps(dc, RASTERCAPS) AND
RC_PALETTE = RC_PALETTE) then
begin
{allocate memory for a logical palette}
GetMem(lpPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
{zero it out to be neat}
FillChar(lpPal^, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)), #0);
{fill in the palette version}
lpPal^.palVersion := $300;
{grab the system palette entries}
lpPal^.palNumEntries :=
GetSystemPaletteEntries(dc,0,256,lpPal^.palPalEntry);
if (lpPal^.PalNumEntries <> 0) then
begin
{create the palette}
bm.Palette := CreatePalette(lpPal^);
end;
FreeMem(lpPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
end;
{copy from the screen to the bitmap}
BitBlt(bm.Canvas.Handle,0,0,Width,Height,Dc,x,y,SRCCOPY);
{release the screen dc}
ReleaseDc(0, dc);
end;
------------------------------------------------
Desde já obrigado.
Paulocesar1301
Posts
04/11/2005
Motta
program Captura;
uses
Windows, Messages, SysUtils, Graphics,clipbrd, jpeg,
StdCtrls, ExtCtrls, Forms ,Dialogs, FileCtrl;
{$R *.RES}
var
tela: tBitmap;
jpg: TJpegImage;
dia,mes,ano,hora,min,seg,mseg : word;
function fillstrL (s: string; l: byte; c:char): string;
begin
while length(s) < l do
s:= c+s;
result:= s;
end;
begin
Application.Initialize;
Application.Run;
//
clipboard.Clear;
//keybd_event(VK_SNAPSHOT,0,0,0); //tela toda
keybd_event(VK_SNAPSHOT,1,0,0); //form ativo
Application.ProcessMessages;
tela := TBitmap.Create;
try
tela.LoadFromClipboardFormat(CF_BITMAP,clipboard.GetAsHandle(CF_BITMAP),0);
jpg := TJPEGImage.Create;
jpg.Assign(tela);
ForceDirectories(´c:\captura´);
DecodeDate(Now,ano,mes,dia);
DecodeTime(Now,hora,min,seg,mseg);
jpg.SaveToFile(´c:\captura\´ +
IntToStr(ano) +
fillstrl(IntToStr(mes),2,´0´) +
fillstrl(IntToStr(dia),2,´0´) +
fillstrl(IntToStr(hora),2,´0´) +
fillstrl(IntToStr(min),2,´0´) +
fillstrl(IntToStr(seg),2,´0´) +
fillstrl(IntToStr(mseg),3,´0´) + ´.jpg´);
except
on e:exception do
begin
ShowMessage(e.message);
end;
end;
Application.Terminate;
end.
04/11/2005
Paulocesar1301
24/02/2006
Motta
Desculpem o ´resgate´.
-----------------------------------------------------------
13/06/2006
Motta
Grato
23/11/2006
Motta
grato
Clique aqui para fazer login e interagir na Comunidade :)
