04.07.2018, 04:26
|
|
LMD-DML
|
|
Регистрация: 12.07.2009
Адрес: Богородское
Сообщения: 3,025
Версия Delphi: D7E
Репутация: 1834
|
|
Да как-то слишком уж изьяшно окошко фоткается - сначало область определяется, и затем только из целой снимки рабочего стола кусман с её размерами выкусывается, а при масштабировании окно немного по-другому место на экране занимает и кусок видимо поэтому от целой картинки отличается, вот может вдруг такой вариант для скриншотки больше подойдёт
Код:
procedure ScreenShot(hWnd: HWND; bm: TBitmap);
var
RLeft, RTop, RWidth, RHeight: Word;
R: TRect;
dc: HDC;
lpPal: PLogPalette;
begin
dc:= GetDC(0);
try
if (not IsWindow(hWnd)) or (dc = 0) then Exit;
GetWindowRect(hWnd, R);
RLeft:= R.Left;
RTop:= R.Top;
RWidth:= R.Right-RLeft;
RHeight:= R.Bottom-RTop;
bm.Width:= RWidth;
bm.Height:= RHeight;
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 bm.Palette:= CreatePalette(lpPal^);
FreeMem(lpPal, SizeOf(TLogPalette) + (255 * SizeOf(TPaletteEntry)));
end;
BitBlt(bm.Canvas.Handle, 0, 0, RWidth, RHeight, dc, RLeft, RTop, SRCCOPY);
finally
ReleaseDc(0, dc);
end;
end;
|