|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
|
#1
|
|||
|
|||
Не делает скриншот на XE10, на D7 всё ок
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; Код:
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 Последний раз редактировалось Gareth, 15.05.2018 в 16:13. |
#2
|
||||
|
||||
Во-первых:
1. При создании формы2 Form2Create Вы создаете битмап Bild:=TBitMap.Create; 2. При скриншоте вы опять создаете битмап Result := TBitMap.Create; И присваиваете новый битмап к Bild 3. При уничтожении формы Вы удаляете созданный битмап Bild.Free; Проверяем работу: Тест №1 1. Запуск программы -> создали битмап 2. Закрыли программу -> удалили битмап Тест №2 1. Запуск программы -> создали битмап 2. Сделали скриншот -> создали еще битмап и присвоили ссылку на него в bild 3. Закрыли программу -> удалили битмап Вопрос: сколько битмапов создано и сколько удалено? А если скриншот сделали 10 раз, сколько создано и сколько битмапов удалено? Во-вторых: Проверьте что у Вас скриншотится: Код:
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; result.SaveToFile('<some_file_name.bmp>'); // <<< посмотрите что сохранится на диск end; Грамотно поставленный вопрос содержит не менее 50% ответа. Грамотно поставленная речь вызывает уважение, а у некоторых даже зависть. |
Этот пользователь сказал Спасибо dr. F.I.N. за это полезное сообщение: | ||
Gareth (15.05.2018)
|
#3
|
|||
|
|||
Проверил, создается битая картинка. Ни один просмотрщик картинок не видит её, и хостинг картинок не может её загрузить. Открыл через пикаса, и сделал скрин:
Ну ведь тот же код, на д7 работает как нормально) убрал переменную в unit1. создаю (Bild := Tbitmap.Create при открытии второй формы при закрытии второй формы присваиваю Image.Picture.Bitmap := Bild; потом Bild.Free. всё так и осталось Последний раз редактировалось Gareth, 15.05.2018 в 18:55. |
#4
|
||||
|
||||
Тогда на чистом проекте попробуйте:
Код:
propcedure TForm1.Button1Click(Sender: TObject); begin ScreenDC := GetDC(0); try BitBlt(Form1.Canvas.Handle, 0, 0, <Width>, <Height>, ScreenDC, <Left>, <Top>, SRCCOPY); finally ReleaseDC(0, ScreenDC); end; end; Грамотно поставленный вопрос содержит не менее 50% ответа. Грамотно поставленная речь вызывает уважение, а у некоторых даже зависть. |
Этот пользователь сказал Спасибо dr. F.I.N. за это полезное сообщение: | ||
Gareth (15.05.2018)
|
#5
|
|||
|
|||
Цитата:
окошко делает скрин самой себя |
#6
|
||||
|
||||
Если Вы оставили параметры без изменений, то логично - на экране по этим координатам сама форма . Сдвиньте координаты. Но в любом случае скрин делается. Значит надо смотреть дальше по коду в какой момент изображение "ломается".
Грамотно поставленный вопрос содержит не менее 50% ответа. Грамотно поставленная речь вызывает уважение, а у некоторых даже зависть. |
Этот пользователь сказал Спасибо dr. F.I.N. за это полезное сообщение: | ||
Gareth (15.05.2018)
|