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 :)