procedure TForm1.ScreenShot(wnd: HWND; 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(wnd); 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(wnd, dc); end; (* ScreenShot *) #### procedure TForm1.ScreenShot2(wnd: HWND; x : integer; y : integer; Width : integer; Height : integer; bm : TBitMap); var dc: HDC; 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(wnd); if (dc = 0) then exit; {copy from the screen to the bitmap} BitBlt(bm.Canvas.Handle,0,0,Width,Height,Dc,x,y,SRCCOPY); {release the screen dc} ReleaseDc(wnd, dc); end; (* ScreenShot *)