unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, ExtCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
BitBtn1: TBitBtn;
procedure BitBtn1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure ScreenShot(x : integer;
y : integer;
Width : integer;
Height : integer;
bm : TBitMap);
var
dc: HDC;
lpPal: PLOGPALETTE;
begin
if ((Width = 0) or
(Height = 0)) then
begin
exit;
end;
bm.Width := Width;
bm.Height := Height;
dc := GetDc(0);
if (dc = 0) then
begin
exit;
end;
if (GetDeviceCaps(dc, RASTERCAPS) and
RC_PALETTE = RC_PALETTE) then
begin
GetMem(lpPal,
sizeof(TLOGPALETTE) +
(255 * sizeof(TPALETTEENTRY)));
FillChar(lpPal^,
sizeof(TLOGPALETTE) +
(255 * sizeof(TPALETTEENTRY)),
#0);
lpPal^.palVersion := $300;
lpPal^.palNumEntries :=
GetSystemPaletteEntries(dc,
0,
256,
lpPal^.palPalEntry);
if (lpPal^.PalNumEntries <> 0) then
begin
bm.Palette := CreatePalette(lpPal^);
end;
FreeMem(lpPal, sizeof(TLOGPALETTE) +
(255 * sizeof(TPALETTEENTRY)));
end;
BitBlt(bm.Canvas.Handle,
0,
0,
Width,
Height,
Dc,
x,
y,
SRCCOPY);
ReleaseDc(0, dc);
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
ScreenShot(0,
0,
150,
100,
Image1.Picture.Bitmap);
end;
end. |
|
