procedure TForm2.Button1Click(Sender: TObject);
var
ScreenForm: TForm1;
begin
// создаем полупрозрачную форму оверлей
ScreenForm := TForm1.Create(nil);
try
// и растягиваем её на весь экран и позиционируем
ScreenForm.Width := Screen.DesktopWidth;
ScreenForm.Height := Screen.DesktopHeight;
ScreenForm.Left := Screen.DesktopLeft; // если 0 то программа работает только с 1 экраном - основным и корректно
ScreenForm.Top := Screen.DesktopTop; // если 0 то программа работает только с 1 экраном - основным и корректно
// дальше прячем основную форму
self.Hide;
Application.ShowMainForm := FALSE;
//показать форму оверлей
ScreenForm.ShowModal;
Image1.Picture.BitMap := ScreenForm.Bild;
ScrollBox1.HorzScrollBar.Range := Image1.Picture.Width;
ScrollBox1.VertScrollBar.Range := Image1.Picture.Height;
self.Show;
finally
ScreenForm.Free;
end;
end;
procedure NormRect(var aRect: TRect);
var tmp:Integer;
begin
if aRect.Left > aRect.Right then
begin
tmp:=aRect.Left;
aRect.Left:=aRect.Right;
aRect.Right:=tmp;
end;
if aRect.Top > aRect.Bottom then
begin
tmp:=aRect.Top;
aRect.Top:=aRect.Bottom;
aRect.Bottom:=tmp;
end;
end;
function CaptureScreenRect(aRect: TRect): TBitMap;
var
ScreenDC: HDC;
ActHandles:HWND;
begin
Result := TBitMap.Create;
with Result, aRect do
begin
Result.Free;
Result := TBitMap.Create;
NormRect(aRect); // исправить координаты выделенной области
Result.Width := aRect.Right - aRect.Left;
Result.Height :=aRect.Bottom - aRect.Top;
ActHandles := GetDesktopWindow;
ScreenDC := GetWindowDC(ActHandles);//GetDc(0); - пробовал так, но результат тот же
try
BitBlt(Result.Canvas.Handle, 0, 0, Result.Width, Result.Height, ScreenDC, aRect.Left, aRect.Top, SRCCOPY);
finally
ReleaseDC(ActHandles, ScreenDC);//ReleaseDC(0, ScreenDC); - пробовал так, но результат тот же
end;
end;
end;
r.Left := downX-screen.Width;
r.Top := downY;
r.Right := X-screen.Width;
r.Bottom := Y;
if Screen.DesktopLeft < 0 then
begin
r.Left := downX-screen.Width;
r.Right := X-screen.Width;
end
else
begin
r.Left := downX;
r.Right := X;
end;
if Screen.DesktopTop < 0 then
begin
r.Top := downY-screen.Height;
r.Bottom := Y-screen.Height;
end
else
begin
r.Top := downY;
r.Bottom := Y;
end;