7привет)
решил переделать свой скриншотер, написанный на delphi 7.
щас юзаю xe10 seattle.
один и тот же код, не работает на xe10, хотя на д7 всё ок.
нюанс, скрин то делает, но если попытаться сделать скрин выделенной области, ничего не происходит.
мне кажется проблема с переменной Bild : tbitmap;
вставлял image1.picture.bitmap := Bild; куда угодно - image как был чистый, так и остаётся..
на форме image и button
по кнопке открывается вторая форма, где уже и происходит выделение нужной области.
вот код :
Код:
procedure TForm1.Button3Click(Sender: TObject);
var
ScreenForm: TForm2;
begin
// создаем нашу полупрозрачную форму
ScreenForm := TForm2.Create(nil);
try
// и растягиваем её на весь экран
ScreenForm.Width := Screen.DesktopWidth;
ScreenForm.Height := Screen.DesktopHeight;
ScreenForm.Left := 0;
ScreenForm.Top := 0;
// дальше прячем основную форму
self.Hide;
// показываем полупрозрачную ”заливку”
ScreenForm.ShowModal;
// и выводим полученную область экрана
Image1.Picture.BitMap := ScreenForm.Bild;
self.Show;
finally
ScreenForm.Free;
end;
end
вторая форма
Код:
procedure TForm2.FormCreate(Sender: TObject);
begin
//создаем объект Bild
Bild:=TBitMap.Create;
end;
procedure TForm2.FormDestroy(Sender: TObject);
begin
//освобождаем объект Bild
Bild.Free;
end;
Код:
procedure TForm2.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
// устанавливаем флаг нажатия мыши в true
isDown := true;
// и запоминаем текущие координаты
downX := X;
downY := Y;
end;
procedure TForm2.FormMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
// если нажата клавиша мыши, то мы рисуем рамку выделения
if isDown then
begin
// перерисовываем форму
Self.Repaint;
// тут мы рисуем пунктирную рамку красного цвета
Self.Canvas.Pen.Color := clRed;
Self.Canvas.Pen.Width := 1;
Self.Canvas.Pen.Style := psDot;
// вот здесь мы заливаем область зеленым цветом, благодаря чему она становиться прозрачной
Self.Canvas.Brush.Color := clGreen;
Self.Canvas.Rectangle(downX, downY, X, Y);
end;
end;
procedure TForm2.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
r: TRect;
begin
// сбрасываем флаг
isDown := false;
// сохраняем координаты области
r.Left := downX;
r.Top := downY;
r.Right := X;
r.Bottom := Y;
// в переменную Bild выводим область экрана
Bild := CaptureScreenRect(r);
// и закрываем форму
Self.Close;
end;
Функция CaptureScreenRect выводит область экрана, зная координаты этой области:
Код:
function CaptureScreenRect(aRect: TRect): TBitMap;
var
ScreenDC: HDC;
begin
Result := TBitMap.Create;
with Result, aRect do
begin
// Устанавливаем размеры выводимого изображения равными выделенной области
Width := Right - Left;
Height := Bottom - Top;
// Получаем Хендл рабочего окна
ScreenDC := GetDC(0);
try
// и копируем нужную область экрана
BitBlt(Canvas.Handle, 0, 0, Width, Height, ScreenDC, Left, Top, SRCCOPY);
finally
ReleaseDC(0, ScreenDC);
end;
end;
end;
исходник статьи
http://delphiexpert.ru/sozdanie-skri...na-delphi.html