Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > [ "Начинающим" ]
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 15.05.2018, 16:10
Gareth Gareth вне форума
Активный
 
Регистрация: 21.03.2013
Адрес: Приднестровье
Сообщения: 202
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию Не делает скриншот на 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;
Функция 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

Последний раз редактировалось Gareth, 15.05.2018 в 16:13.
Ответить с цитированием
  #2  
Старый 15.05.2018, 17:42
Аватар для dr. F.I.N.
dr. F.I.N. dr. F.I.N. вне форума
I Like it!
 
Регистрация: 12.12.2009
Адрес: Россия, г. Новосибирск
Сообщения: 660
Версия Delphi: D6/D7
Репутация: 26643
По умолчанию

Во-первых:
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  
Старый 15.05.2018, 18:48
Gareth Gareth вне форума
Активный
 
Регистрация: 21.03.2013
Адрес: Приднестровье
Сообщения: 202
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию

Проверил, создается битая картинка. Ни один просмотрщик картинок не видит её, и хостинг картинок не может её загрузить. Открыл через пикаса, и сделал скрин:


Ну ведь тот же код, на д7 работает как нормально)
убрал переменную в unit1.
создаю (Bild := Tbitmap.Create при открытии второй формы
при закрытии второй формы присваиваю Image.Picture.Bitmap := Bild;
потом Bild.Free.

всё так и осталось

Последний раз редактировалось Gareth, 15.05.2018 в 18:55.
Ответить с цитированием
  #4  
Старый 15.05.2018, 18:52
Аватар для dr. F.I.N.
dr. F.I.N. dr. F.I.N. вне форума
I Like it!
 
Регистрация: 12.12.2009
Адрес: Россия, г. Новосибирск
Сообщения: 660
Версия Delphi: D6/D7
Репутация: 26643
По умолчанию

Тогда на чистом проекте попробуйте:
Код:
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;
На чистой форме должно отобразиться то, что заскриншотится (без промежуточных TBitmap).
__________________
Грамотно поставленный вопрос содержит не менее 50% ответа.
Грамотно поставленная речь вызывает уважение, а у некоторых даже зависть.
Ответить с цитированием
Этот пользователь сказал Спасибо dr. F.I.N. за это полезное сообщение:
Gareth (15.05.2018)
  #5  
Старый 15.05.2018, 19:06
Gareth Gareth вне форума
Активный
 
Регистрация: 21.03.2013
Адрес: Приднестровье
Сообщения: 202
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию

Цитата:
Сообщение от dr. F.I.N.
Тогда на чистом проекте попробуйте:
Код:
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;
На чистой форме должно отобразиться то, что заскриншотится (без промежуточных TBitmap).

окошко делает скрин самой себя
Ответить с цитированием
  #6  
Старый 15.05.2018, 19:17
Аватар для dr. F.I.N.
dr. F.I.N. dr. F.I.N. вне форума
I Like it!
 
Регистрация: 12.12.2009
Адрес: Россия, г. Новосибирск
Сообщения: 660
Версия Delphi: D6/D7
Репутация: 26643
По умолчанию

Если Вы оставили параметры без изменений, то логично - на экране по этим координатам сама форма . Сдвиньте координаты. Но в любом случае скрин делается. Значит надо смотреть дальше по коду в какой момент изображение "ломается".
__________________
Грамотно поставленный вопрос содержит не менее 50% ответа.
Грамотно поставленная речь вызывает уважение, а у некоторых даже зависть.
Ответить с цитированием
Этот пользователь сказал Спасибо dr. F.I.N. за это полезное сообщение:
Gareth (15.05.2018)
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра
Комбинированный вид Комбинированный вид

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 19:03.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter