Главная » Soft

Обновлено: 02 декабря, 2018

Программа CopyScreen в Delphi

Описание программы

Программа CopyScreen предназначена для снятия снимков экрана, последующего их редактирования и отправки их в интернет (протокол ftp). Программа позволяет захватывать изображение с экрана, снимать скриншоты и публиковать их в сети интернет. Реализована возможность делать пометки на скриншоте в виде текста, либо обычных линий (например, если надо подчеркнуть какую-нибудь область). После запуска программа устанавливается в tray, и ждет нажатия клавиши PrintScreen. При нажатии PrintScreen на появившемся окне можно делать пометки, двойным кликом добавлять на скриншот текст. Клавиша F6 — отправляет выделенную область экрана в буфер обмена, F5 — отправляет снимок экрана в сеть.

Код реализации

Настройка компонентов, модулей и переменных

Кидаем на форму 4 компонента: текстовое поле TEdit — Edit1, компонент для работы с ftp TIdFTP — IdFTP, и два компонента для изображений TImage — Image1 и Image2. Image1 растягиваем на всю ширину экрана с помощью установки свойства Align в AlClient, а также устанавливаем для Image1 свойство Cursor равным crCross.

Настройки Image
1. Настройка компонента Image

Подключим необходимые для дальнейшей работы модули: 

Uses
    ...,IdFTP,Registry,Clipbrd;
...

В pirvate прописываем процедуры для обработки горячих клавиш (в нашем случае это клавиша PrintScreen) и процедуры минимизации приложения: 

...
private
    { Private declarations }
procedure WMHotKey(var Msg : TWMHotKey); message WM_HOTKEY;
procedure Minimize(var msg: TMessage); message WM_SYSCOMMAND;
...

Также нам понадобятся некоторые глобальные переменные. Объявим их: 

...
Var
  IconData: NotifyIconData;
  MousePos: TPoint;
  drawing:boolean;
  kk:word;
  xsave,ysave: word;  
  Origin, MovePt: TPoint;
  t:tstringlist;
implementation
...

Объявим файл ресурса для отображения иконки: 

..
implementation
{$R *.DFM}
{$R tray.res}
..

И объявим константу — код клавиши PrintScreen 

..
const id_SnapShot = 101;
..

Инициализация переменных

В процедуре создания формы инициализируем переменные, выставляем значения для кисти, регистрируем обработчик для клавиши PrintScreen и отправляем приложение в tray: 

...
procedure TForm1.FormCreate(Sender: TObject);
begin
  t:=tstringlist.Create; // создаем список с настройками
  if fileexists(getcurrentdir()+'\settings.txt') then // проверяем наличие файла settings.txt в папке с программой
    t.LoadFromFile(getcurrentdir()+'\settings.txt') // если есть - загружаем настройки доступа к ftp в список настроек, если нет - на выход
  else
  begin
    ShowMessage('Файл settings.txt не найден');
    exit;
  end;
  drawing:=false;
  try
  with IconData do // отрисовываем иконку приложения
  begin
    cbSize:=Sizeof(IconData);
    Wnd:=Form1.Handle;
    hIcon:=LoadIcon(hInstance,'TRAYP');
    uFlags:=NIF_ICON or NIF_TIP or NIF_MESSAGE;
    szTip:=APP_NAME;
    uCallbackMessage:=WM_TRAYMSG;
  end;
  Shell_NotifyIcon(NIM_ADD,@IconData); // посылаем ее в tray
  except
    Shell_NotifyIcon(NIM_DELETE,@IconData);
    PostQuitMessage(0);
  end;
  RegisterHotKey(Form1.Handle,id_SnapShot,0,VK_SNAPSHOT); // регистрируем горячую клавишу printscreen
  Image2.Canvas.Pen.Width:=4; // устанавливаем параметры кисти, который будем делать пометки на скриншоте
  image2.Canvas.Pen.Color:=clRed;
  Image1.Canvas.Brush.Style := bsClear;
  Image1.Canvas.Pen.Width:=1;
end;
...

Сворачиваем программу в Трей

После запуска приложения, окно свернется в tray и его можно будет вызвать либо нажатием клавиши prinsceen, либо кликом по иконке изображения:

Программа в Tray
2. Программа в Tray

В обработчике сообщений посылаемых окну приложения проверяем нажатие левой клавиши мыши по иконке приложения, свернутого в трее: 

...
procedure TForm1.WMTrayMsg(var msg: TMsg);
begin
  case msg.wParam of
    WM_LBUTTONDBLCLK: N1Click(nil); // если нажали левой клавишей мыши
  end;
end;
...

Обработчик нажатия левой клавиши мыши на иконке приложения в tray: 

...
procedure TForm1.N1Click(Sender: TObject);
var
  Desktopcanvas :TCanvas ;
  BitMap  :TBitMap;
begin
  // "фотографируем" экран 
  DesktopCanvas:=TCanvas.Create;
  DesktopCanvas.Handle:=GetDC(Hwnd_Desktop);
  BitMap := TBitMap.Create;
  BitMap.Width := Screen.Width;
  BitMap.Height:=Screen.Height;
  Bitmap.Canvas.CopyRect(Bitmap.Canvas.ClipRect,
  DesktopCanvas, DesktopCanvas.ClipRect);
  // сохраняем скриншот в файле
  bitmap.SaveToFile('c:\screen.bmp');
  // загружаем изображение в image (для возможности рисовать - делать пометки)
  image1.Picture.LoadFromFile('c:\screen.bmp');
 
  Form1.Show; // показываем форму
  SwitchToThisWindow(Application.Handle,true); // привлекаем внимание к окну
end;
...

Обработчик сворачивания приложения — при минимизации окна, скрываем его, при закрытии — удаляем иконку из трея: 

...
procedure TForm1.Minimize(var msg: TMessage);
begin
  inherited;
  case msg.WParam of
    SC_MINIMIZE: Form1.Hide; // прячем окно при минимизации окна
    SC_CLOSE: begin
                Shell_NotifyIcon(NIM_DELETE,@IconData);  // удаляем иконку при закрытии приложения
                PostQuitMessage(0);
              end;
  end;
end;
...

Обработчик нажатия горячей клавиши

В обработчике нажатия на горячую клавишу проверяем — если нажали на printScreen запускаем основную процедуру N1Click. 

procedure TForm1.WMHotKey (var Msg : TWMHotKey);
begin
  if Msg.HotKey = id_SnapShot then N1Click(form1);
end;

Обработчик уничтожения формы

В обработчике уничтожения формы — удаляем горячие клавиши приложения (в нашем случае printsceen из реестра) и удаляем иконку из трея: 

...
procedure TForm1.FormDestroy(Sender: TObject);
begin
  Shell_NotifyIcon(NIM_DELETE,@IconData);
  UnRegisterHotKey (Form1.Handle, id_SnapShot);
end;
...

Захватываем область экрана

Следующие процедуры (обработчики нажатия клавиши и движения мыши на image1) позволяют выделять нужную область скриншота: при нажатии клавиши мыши запоминаем координаты курсора, устанавливаем глобальную переменную drawing в true. В обработчике движения мыши проверяем, установлена ли переменная drawing в true, и если установлена (другими словами если клавиша мыши находится в нажатом состоянии) — на скриншоте отрисовывается прямоугольная прозрачная область. Когда отпускаем клавишу мыши — глобальную переменную drawing устанавливаем в false и конечную отрисованную область сохраняем в image2. 

...
{-------- нажали на клавишу мыши -----------}
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  image1.Canvas.MoveTo(x,y);
  Origin := Point(X, Y);
  MovePt := Origin;
  drawing:=true;
end;
 
{-------- мышь в движении -----------}
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if drawing  then
  begin
    Image1.Canvas.Brush.Style := bsClear;
    Image1.Canvas.Pen.Mode:=pmNotXor;
    Image1.Canvas.Rectangle(Origin.x, Origin.y,MovePt.X,MovePt.y);
    MovePt := Point(X, Y);
    Image1.Canvas.Rectangle(Origin.x, Origin.y,MovePt.X,MovePt.y);
  end;
end;
 
{-------- отпустили клавишу мыши -----------}
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  drawing:=false;
  image2.Width:=x-Origin.X;
  image2.Height:=y-Origin.y;
  image2.Canvas.CopyRect(rect(0,0,image2.Width,image2.Height),image1.Canvas,rect(Origin.X,Origin.y,x,y));
  form1.Width:=x-Origin.X+4;
  form1.Height:=y-Origin.y+4;
  form1.WindowState:=wsNormal;
  form1.BorderStyle:=bsDialog;
  form1.Position:=poScreenCenter;
  image1.Visible:=false;
  image2.Visible:=true;
end;
...

Делаем пометки в выделенной области

Следующие процедуры (обработчики нажатия клавиши и движения мыши на image2) — позволяют на выделенной ранее области делать пометки — рисовать линии (нажать на левую клавишу мыши — и тянуть в нужную область), делать текстовые пометки (в нужной области — двойной клик). Параметры кисти для рисования и отображения текста мы задали ранее в процедуре FormCreate. 

...
{-------- мышь в движении -----------}
procedure TForm1.Image2MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if drawing  then image2.Canvas.LineTo(x,y);
end;
 
{-------- нажали на клавишу мыши -----------}
procedure TForm1.Image2MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  xsave:=x;
  ysave:=y;
  image2.Canvas.MoveTo(x,y);
  drawing:=true;
end;
 
{-------- отпустили клавишу мыши -----------}
procedure TForm1.Image2MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  drawing:=false;
end;
 
{-------- двойной клик -----------}
procedure TForm1.Image2DblClick(Sender: TObject);
begin
  // устанавливаем координаты текстового поля в текущее место курсора и показываем поле для ввода текста
  edit1.Left:=xsave;
  edit1.Top:=ysave;
  edit1.Visible:=true;
  edit1.SetFocus;
end;
 
{-------- нажали на клавишу клавиатуры -----------}
procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
 if key=13 then // если нажали на "Enter" - рисуем на image2 введенный текст
 begin
   image2.Canvas.Font.Size:=10;
   image2.Canvas.Font.Color:=clred;
   image2.Canvas.Font.Style:=[fsbold,fsunderline];
   Image2.Canvas.Brush.Style := bsClear;
   Image2.Canvas.textout(edit1.Left,edit1.Top,edit1.Text);
   edit1.Visible:=false;
 end;
end;
...

Делаем пометки в выделенной области
3. Делаем пометки в выделенной области

Отправляем результат в веб

После того как мы провели все необходимые действия с выделенной областью скриншота (добавили пометки и т.д.) — нам необходимо отправить получившиеся изображение в сеть, либо скопировать изображение в буфер обмена. Логично что делать мы это будем в процедуре обработки нажатия клавиши клавиатуры: 

...
{-------- процедура обработки нажатия клавиши -----------}
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
var
  dt: TDateTime;
  s: string;
  jpg: TJpegImage;
begin
  // -- сохраняем файл и отправляем в сеть (F5) --
  if key=116 then
  begin
    dt := Now;
    DateTimeToString( s, 'dd-mm-yy_hh-mm', dt );
    s:=s+'.jpg';
    jpg := TJpegImage.Create;
    jpg.Assign(image2.picture.graphic);
    jpg.CompressionQuality := 90;   // устанавливаем степень сжатия 1..100
    jpg.Compress;
    jpg.SaveToFile(getcurrentdir+'\'+s);
    jpg.free;
    sendfileftp(getcurrentdir+'\'+s,s);  // отправляем данные в сеть
    DeleteFile(getcurrentdir+'\'+s); // удаляем файл
    runbrowser(t.strings[4]+s); // открываем браузер установленный по умолчанию
  end;
  // -- копируем изображение в буфер (F6) --
  if key=117 then
  begin
    Clipboard.Assign(image2.picture);
  end;
  application.Terminate;
end;
{-------- отправляем данные в сеть -----------}
procedure tform1.sendfileftp(sFrom:string;sTo:string);
var
  ftp: TIdFTP;
  ms:  TMemoryStream;
begin
  ftp:=TIdFTP.Create(Application);
  ms:=TMemoryStream.Create;
  try
    try
      ftp.Host:=t.Strings[0];// ftp адрес сервера
      ftp.Port:=21;
      ftp.Username:=t.Strings[1];//login
      ftp.Password:=t.Strings[2];// пароль
 
      ftp.Connect(true, 2000);
      AssErt(ftp.Connected);
      ftp.ChangeDir(t.Strings[3]);//установить папку на сервере - например /domains/prog-example.ru/
      ftp.Put(sfrom,sto,false); //файл откуда куда
    finally
      ms.Free; ftp.Free;
    end;
  except
    ShowMessage('не удалось получить файл');
  end;
end; 
...

Настройки ftp сервера должны хранится в файле settings.txt, и который должен храниться в папке с программой. Структура файла settings.txt должна быть следующей: 

ip-адрес ftp-сервера
логин
пароль
полный путь к папке на сервере, в которую копируем скрин
url папки, в которую скопировали скрин

Пример:

82.175.142.132
admin
123
/domains/prog-example.ru/images/ 
https://prog-example.ru/images/

Права доступа к папке куда копируем скриншот должны позволять записывать файл стороннему пользователю.

Отображение результата в браузере

После отправки файла в сеть, процедурой RunBrowser открываем получившуюся ссылку в браузере. Для того чтобы узнать какой браузер установлен по умолчанию, используем реестр: 

...
{-------- процедура открытия URL в браузере по умолчанию -----------}
procedure RunBrowser(URL: String);
var
  Browser: string;
begin
  Browser := '';
  with TRegistry.Create do
  try
    RootKey := HKEY_CLASSES_ROOT;
    Access := KEY_QUERY_VALUE;
    if OpenKey('\HTTP\shell\open\command', False) then
      Browser := ReadString('');
    CloseKey;
  finally
    Free;
  end;
  if Browser <> '' then
  begin
    Browser := Copy(Browser, Pos(':\', Browser) - 1, Length(Browser)) ;
    if (Pos('.exe', Browser)>0) then
      Browser := Copy(Browser, 1, Pos('.exe', Browser) + 3) ;
    if (Pos('.EXE', Browser)>0) then
      Browser := Copy(Browser, 1, Pos('.EXE', Browser) + 3) ;
    ShellExecute(0, 'open', PChar(Browser), PChar(URL), nil, SW_SHOWNORMAL) ;
  end;
end;

Скачать исходник

Скачать исходник данной программы можно здесь.

Рейтинг автора
Автор статьи
Юрий
Программист Delphi, MySQL. Образование: высшее. Специальность: программное обеспечение информационных технологий.
Написано статей
439
1 Звезда2 Звезды3 Звезды4 Звезды5 Звезд (10 оценок, среднее: 5,00 из 5)
Загрузка...
0 713 просмотров
Вам также может быть интересно