2008. április 3., csütörtök

Save a screen shot to a JPEG file


Problem/Question/Abstract:

How can I write a screen capture not to a bitmap file but to a JPEG file?

Answer:

procedure 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
  begin
    exit;
  end;
  bm.Width := Width;
  bm.Height := Height;
  {get the screen dc}
  dc := GetDc(0);
  if (dc = 0) then
  begin
    exit;
  end;
  {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;

procedure TForm1.Button1Click(Sender: TObject);
var
  bm: TBitmap;
  jp: TJPEGImage;
begin
  bm := TBitmap.Create;
  ScreenShot(0, 0, Screen.Width, Screen.Height, bm);
  jp := TJPEGImage.Create;
  jp.Assign(bm);
  bm.free;
  jp.SaveToFile('Test.jpg');
  jp.Free;
end;

Nincsenek megjegyzések:

Megjegyzés küldése