[Gareth]

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

[dr. F.I.N.]

Во-первых:
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;

[Gareth]

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


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

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

[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).

[Gareth]

Сообщение от 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).

окошко делает скрин самой себя

[dr. F.I.N.]

Если Вы оставили параметры без изменений, то логично - на экране по этим координатам сама форма . Сдвиньте координаты. Но в любом случае скрин делается. Значит надо смотреть дальше по коду в какой момент изображение "ломается".