Save a screen shot to a JPEG file (Views: 28)
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; |