[Gareth]

7привет)

решил переделать свой скриншотер, написанный на delphi 7.
щас юзаю xe10 seattle.
один и тот же код, не работает на xe10, хотя на д7 всё ок.
нюанс, скрин то делает, но если попытаться сделать скрин выделенной области, ничего не происходит.
мне кажется проблема с переменной Bild : tbitmap;
вставлял image1.picture.bitmap := Bild; куда угодно - image как был чистый, так и остаётся..
на форме image и button
по кнопке открывается вторая форма, где уже и происходит выделение нужной области.
вот код :

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28

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

вторая форма

Код:

1 2 3 4 5 6 7 8 9 10 11

procedure TForm2.FormCreate(Sender: TObject); begin     //создаем объект Bild     Bild:=TBitMap.Create; end;   procedure TForm2.FormDestroy(Sender: TObject); begin     //освобождаем объект Bild    Bild.Free; end;

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50

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 выводит область экрана, зная координаты этой области:

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21

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 раз, сколько создано и сколько битмапов удалено?

Во-вторых: Проверьте что у Вас скриншотится:

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22

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.]

Тогда на чистом проекте попробуйте:

Код:

1 2 3 4 5 6 7 8 9

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.

Тогда на чистом проекте попробуйте:

Код:

На чистой форме должно отобразиться то, что заскриншотится (без промежуточных TBitmap).

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

[dr. F.I.N.]

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