Author: Tomas Rutkauskas

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

Answer:
1   
2   procedure ScreenShot(x: integer; y: integer; Width: integer; Height: integer; bm: 
3   TBitmap);
4   var
5     dc: HDC;
6     lpPal: PLOGPALETTE;
7   begin
8     {test width and height}
9     if ((Width = 0) or (Height = 0)) then
10    begin
11      exit;
12    end;
13    bm.Width := Width;
14    bm.Height := Height;
15    {get the screen dc}
16    dc := GetDc(0);
17    if (dc = 0) then
18    begin
19      exit;
20    end;
21    {do we have a palette device?}
22    if (GetDeviceCaps(dc, RASTERCAPS) and RC_PALETTE = RC_PALETTE) then
23    begin
24      {allocate memory for a logical palette}
25      GetMem(lpPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
26      {zero it out to be neat}
27      FillChar(lpPal^, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)), #0);
28      {fill in the palette version}
29      lpPal^.palVersion := $300;
30      {grab the system palette entries}
31      lpPal^.palNumEntries := GetSystemPaletteEntries(dc, 0, 256, lpPal^.palPalEntry);
32      if (lpPal^.PalNumEntries < > 0) then
33      begin
34        {create the palette}
35        bm.Palette := CreatePalette(lpPal^);
36      end;
37      FreeMem(lpPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
38    end;
39    {copy from the screen to the bitmap}
40    BitBlt(bm.Canvas.Handle, 0, 0, Width, Height, Dc, x, y, SRCCOPY);
41    {release the screen dc}
42    ReleaseDc(0, dc);
43  end;
44  
45  procedure TForm1.Button1Click(Sender: TObject);
46  var
47    bm: TBitmap;
48    jp: TJPEGImage;
49  begin
50    bm := TBitmap.Create;
51    ScreenShot(0, 0, Screen.Width, Screen.Height, bm);
52    jp := TJPEGImage.Create;
53    jp.Assign(bm);
54    bm.free;
55    jp.SaveToFile('Test.jpg');
56    jp.Free;
57  end;