Форум по 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.
Ответить с цитированием
 


Delphi Sources

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

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

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

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


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


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

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

ВКонтакте   Facebook   Twitter