• Что бы вступить в ряды "Принятый кодер" Вам нужно:
    Написать 10 полезных сообщений или тем и Получить 10 симпатий.
    Для того кто не хочет терять время,может пожертвовать средства для поддержки сервеса, и вступить в ряды VIP на месяц, дополнительная информация в лс.

  • Пользаватели которые будут спамить, уходят в бан без предупреждения. Спам сообщения определяется администрацией и модератором.

  • Гость, Что бы Вы хотели увидеть на нашем Форуме? Изложить свои идеи и пожелания по улучшению форума Вы можете поделиться с нами здесь. ----> Перейдите сюда
  • Все пользователи не прошедшие проверку электронной почты будут заблокированы. Все вопросы с разблокировкой обращайтесь по адресу электронной почте : info@guardianelinks.com . Не пришло сообщение о проверке или о сбросе также сообщите нам.

Снимаем Скрин Окна Своей Проги

Lomanu4 Оффлайн

Lomanu4

Команда форума
Администратор
Регистрация
1 Мар 2015
Сообщения
1,481
Баллы
155
Часто бывает нужно иметь скрин окна своей проги, например, чтобы куда-нибудь запостить.

Делать prntScr и править в паинте утомительно, поэтому я как-то раз набрал вот такой код:
Код:
procedure TForm1.Button2Click(Sender: TObject);
var
   GetScreenDC: HDC;
   GetScreenBMP: TBitmap;
begin
   GetScreenDC := GetwindowDC(form1.Handle); // получаем указатель на канву окна
   GetScreenBMP:= TBitmap.Create;            // создаем заготовку картинки
   GetScreenBMP.Width:=form1.Width;      
   GetScreenBMP.Height:=form1.Height;
   // переносим битовую маску на канву картинки
   bitblt(GetScreenBMP.Canvas.Handle, 0, 0, form1.Width, form1.Height,GetScreenDC, 0, 0, SRCCOPY);
   getscreenbmp.SaveToFile('C:\4324324234.bmp');  // сохраняем картинку в файл и освобождаем ресурсы.
   GetScreenBMP.Free;
end;
 
zloy Оффлайн

zloy

Принятый Кодер
Регистрация
9 Янв 2016
Сообщения
38
Баллы
50
проверил работает добавил сохранение в jpeg - файлы меньше, генерация имени по дате чтоб последовательно лежали рядом с ехе
Код:
uses Jpeg;
//преобразование в jpeg
procedure BmpToJpeg(Source, Dest: String);
var
  jpgImg: TJPEGImage;
  bmp: TBitmap;
begin
  try
    bmp := TBitmap.Create;
    jpgImg := TJPEGImage.Create;
    bmp.LoadFromFile(Source);
    jpgImg.Assign(bmp);
    jpgImg.SaveToFile(Dest);
  finally
    DeleteFile(Source);
    bmp.Free;
    jpgImg.Free;
  end;
end;

// фоткаем
procedure TForm1.btnClick(Sender: TObject);
var
   GetScreenDC: HDC;
   GetScreenBMP: TBitmap;
   filename: string;
begin
   GetScreenDC := GetwindowDC(form1.Handle); // получаем указатель на канву окна
   GetScreenBMP:= TBitmap.Create;            // создаем заготовку картинки
   GetScreenBMP.Width:=form1.Width;
   GetScreenBMP.Height:=form1.Height;
   // переносим битовую маску на канву картинки
   bitblt(GetScreenBMP.Canvas.Handle, 0, 0, form1.Width, form1.Height,GetScreenDC, 0, 0, SRCCOPY);
   //filename := IntToStr(Random(999999));
   DateTimeToString(filename, 'yymmddhhnnss', Now);
   getscreenbmp.SaveToFile(filename+'.bmp');  // сохраняем картинку в файл и освобождаем ресурсы.
   BmpToJpeg(filename+'.bmp', filename+'.jpg');
   GetScreenBMP.Free;
end;
 
Последнее редактирование:
Вверх Снизу