Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > Мультимедиа
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 07.12.2015, 09:26
st.audio st.audio вне форума
Прохожий
 
Регистрация: 07.12.2015
Сообщения: 5
Версия Delphi: Delphi 10
Репутация: 10
По умолчанию Веб камера - изменить разрешение снимка

Всем добрый день, поиском пользовался по моей задаче ответа не нашел, надеюсь тут мне помогут.

Моя программа изображение выводит на Panel, при нажатии кнопки Фото изображение сжимает до нужных размеров, переводит bmp в jpg и сохраняет в базу.

Проблема заключается в том что на Panel изображение с камеры выводится слишком большое, если просто менять размеры Panel то на нее понятное дело выводится только кусок изображения с камеры, а нужно чтобы изображение при выводе сжималось до маленьких размеров. Подскажите пожалуйста как это реализовать ?

Заранее спасибо большое.


Код:
unit Unit1;

interface

uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, ShellAPI, JPEG, Data.DB, Data.Win.ADODB,
  Vcl.DBCtrls;

type
TPanel = class (ExtCtrls.TPanel)
    public
      property Canvas;   //подключаем convac компоненту Panel чтоб могли с него забирать изображение
  end;
  TFormMain = class(TForm)
    PanelVideo: TPanel;
    RefreshingTimer: TTimer;
    Button1: TButton;
    Image1: TImage;
    Label1: TLabel;
    ADOConnection1: TADOConnection;
    ADOQuery1: TADOQuery;
    Button2: TButton;
    Label2: TLabel;
    DataSource1: TDataSource;
    Image2: TImage;
    Button3: TButton;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure RefreshingTimerTimer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
    FormMain: TFormMain;
    hWndC: THandle;
    bmp,bmp2: TBitmap;
    jpg: TJpegImage;

implementation


const
   WM_CAP_START = WM_USER;
   WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10;
   WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11;
   WM_CAP_SAVEDIB = WM_CAP_START + 25;
   WM_CAP_GRAB_FRAME = WM_CAP_START + 60;


{$R *.dfm}

function capCreateCaptureWindowA(lpszWindowName: PCHAR;
    dwStyle: longint;
    x: integer;
    y: integer;
    nWidth: integer;
    nHeight: integer;
    ParentWin: HWND;
    nId: integer): HWND;
    stdcall; external 'AVICAP32.DLL';


procedure TFormMain.Button1Click(Sender: TObject);  //сохраняем изображение с Panel в переменную, затем сжимаем и переводим в jpg

begin
    bmp := TBitmap.Create;
    bmp.Width := PanelVideo.Width;
    bmp.Height:=PanelVideo.Height;
    bmp.Canvas.CopyRect(Rect(0,0,PanelVideo.Width, PanelVideo.Height), PanelVideo.Canvas, Rect(0,0,PanelVideo.Width, PanelVideo.Height));

    bmp2 := TBitmap.Create;
    bmp2.Width := 160;
    bmp2.Height:= 120;
    bmp2.Canvas.StretchDraw(Rect(0, 0, 160, 120), bmp);
    Image1.Picture.Bitmap:=bmp2;

    jpg:=TJpegImage.Create;
    jpg.Assign(Image1.Picture.Bitmap);
    jpg.SaveToFile('test.jpg');  //для теста
end;


procedure TFormMain.Button2Click(Sender: TObject); //сохраняем готовое изображение в базу
var image:TmemoryStream;
begin
    image:=TmemoryStream.Create;
    jpg.SaveToStream(image);
    ADOQuery1.Insert;
    (ADOQuery1.FieldByName('image') as TBlobField).LoadFromStream(image);
    ADOQuery1.Post;
end;

procedure TFormMain.Button3Click(Sender: TObject); //выводим изображение из базы на image2 для теста
var MS: TStream;
    bitmap: Tbitmap;
    jpeg:TJpegImage;
begin
    MS := ADOQuery1.CreateBlobStream(ADOQuery1.FieldByName('image'), bmRead);
    jpeg:= Tjpegimage.Create;
    bitmap:= tbitmap.Create;
    jpeg.LoadFromStream(ms);
    bitmap.Assign(jpeg);
    image2.Picture.Bitmap:=Bitmap;
end;

procedure TFormMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    SendMessage(hWndC, WM_CAP_DRIVER_DISCONNECT, 0, 0); //отключение от драйвера камеры при выходе из программы
end;

procedure TFormMain.FormShow(Sender: TObject);
begin
    ADOQuery1.Open;
  hWndC := capCreateCaptureWindowA('My Capture Window',
    WS_CHILD or WS_VISIBLE,
    PanelVideo.Left,
    PanelVideo.Top,
    PanelVideo.Width,
    PanelVideo.Height,
    FormMain.Handle, 0);
  if hWndC <> 0 then
    begin
      SendMessage(hWndC, WM_CAP_DRIVER_CONNECT, 0, 0);  //подключение к драйверу камеры
      RefreshingTimer.Enabled := True;     // Включение таймера обновления кадра.
    end;
end;

procedure TFormMain.RefreshingTimerTimer(Sender: TObject);
begin
    SendMessage(hWndC, WM_CAP_GRAB_FRAME, 0, 0); // Обновление кадра.
end;

end.
Ответить с цитированием
  #2  
Старый 07.12.2015, 14:15
Аватар для Alegun
Alegun Alegun вне форума
LMD-DML
 
Регистрация: 12.07.2009
Адрес: Богородское
Сообщения: 3,025
Версия Delphi: D7E
Репутация: 1834
По умолчанию

Можно картинку вывести сначало на другую "скрытую" панельку, она как буфер, обработать, а затем показать на основной, в нужном масштабе
Ответить с цитированием
  #3  
Старый 07.12.2015, 15:53
st.audio st.audio вне форума
Прохожий
 
Регистрация: 07.12.2015
Сообщения: 5
Версия Delphi: Delphi 10
Репутация: 10
По умолчанию

Цитата:
Сообщение от Alegun
Можно картинку вывести сначало на другую "скрытую" панельку, она как буфер, обработать, а затем показать на основной, в нужном масштабе
Я вроде бы пробовал, но если панель скрыта то картинки в итоге нету. Или может не так что-то делал.

Думаю существует другой способ - может задать веб камере разрешение в котором она будет работать. В этом примере есть кнопочка нажав которую открывается системное меню веб камеры где можно выбрать разрешение из поддержываемых камерой, только я не смог разобраться как там это реализовано.
Ответить с цитированием
  #4  
Старый 07.12.2015, 16:00
Аватар для Alegun
Alegun Alegun вне форума
LMD-DML
 
Регистрация: 12.07.2009
Адрес: Богородское
Сообщения: 3,025
Версия Delphi: D7E
Репутация: 1834
По умолчанию

Можно ведь вместо панели задействовать холст имиджа, или сразу напрямую в него картинку грузить, в его picture
Ответить с цитированием
  #5  
Старый 07.12.2015, 18:27
st.audio st.audio вне форума
Прохожий
 
Регистрация: 07.12.2015
Сообщения: 5
Версия Delphi: Delphi 10
Репутация: 10
По умолчанию

Цитата:
Сообщение от Alegun
Можно ведь вместо панели задействовать холст имиджа, или сразу напрямую в него картинку грузить, в его picture
Ну если использовать холст имиджа как уже при выводе изображения его сжать в размерах?

Сейчас программа работает так - на панель идет видео с камеры (фото через таймер с задержкой 100 мс), когда кнопку фото наживаешь - текущий кадр который на манели переносится в переменную, в ней он сжимается и потом уже с ним можно делать что хочешь. Дак вот это самое видео которе идет с камеры как сделать меньшим размером то, даже если на имедже....
Ответить с цитированием
  #6  
Старый 07.12.2015, 20:46
Аватар для Alegun
Alegun Alegun вне форума
LMD-DML
 
Регистрация: 12.07.2009
Адрес: Богородское
Сообщения: 3,025
Версия Delphi: D7E
Репутация: 1834
По умолчанию

Цитата:
Сообщение от st.audio
...Дак вот это самое видео которе идет с камеры как сделать меньшим размером то, даже если на имедже....
Так ведь вроде Image1.Stretch\Proportional = true, и уменьшится, или нет?
Ответить с цитированием
  #7  
Старый 08.12.2015, 18:46
st.audio st.audio вне форума
Прохожий
 
Регистрация: 07.12.2015
Сообщения: 5
Версия Delphi: Delphi 10
Репутация: 10
По умолчанию

Цитата:
Сообщение от Alegun
Так ведь вроде Image1.Stretch\Proportional = true, и уменьшится, или нет?
Попробовал, галочки поставил, не помогло. Выводит только кусок изображения с камеры ((
Ответить с цитированием
  #8  
Старый 08.12.2015, 19:51
st.audio st.audio вне форума
Прохожий
 
Регистрация: 07.12.2015
Сообщения: 5
Версия Delphi: Delphi 10
Репутация: 10
По умолчанию

Вот тут нашел пример как изменить разрешение веб камеры, но не смог разобраться как там это реализовани и как это у себя применить, может кто поможет ??

http://www.programmersclub.ru/%D0%92...%D0%B7-avicap/

Спасибо
Ответить с цитированием
  #9  
Старый 09.12.2015, 04:02
Аватар для Alegun
Alegun Alegun вне форума
LMD-DML
 
Регистрация: 12.07.2009
Адрес: Богородское
Сообщения: 3,025
Версия Delphi: D7E
Репутация: 1834
По умолчанию

Похоже так задаётся формат
Код:
    SendMessage(h_cam, WM_CAP_GET_VIDEOFORMAT, SizeOf(Bt), LongInt(@Bt));
    Bt.bmiHeader.biWidth    := 320;
    Bt.bmiHeader.biHeight   := 240;
    Bt.bmiHeader.biSize     := SizeOf(Bt.bmiHeader);
    Bt.bmiHeader.biPlanes   := 1;
    Bt.bmiHeader.biBitCount := 24;
    SendMessage(h_cam, WM_CAP_SET_VIDEOFORMAT, SizeOf(Bt), LongInt(@Bt));
кстати, там есть ссыль на пример вывода картинки сразу на имидж
Ответить с цитированием
  #10  
Старый 03.04.2016, 13:47
-=#PupaJr#=- -=#PupaJr#=- вне форума
Новичок
 
Регистрация: 17.08.2010
Сообщения: 74
Репутация: 518
По умолчанию

Подниму старую тему, поскольку задача похожая и ссылки наверное будут те же.
Мне нужно наоборот максимальное разрешение которое позволяет делать камера (желательно всё таки управляемое )) ) при этом отключить в изображении все каналы кроме R (возможно уже после получения кадров), так как след на стене рисует красный лазер, и в потоке максимального FPS кадр за кадром смотреть искажения, возникающие под следом луча.
Понятно что делфи для таких задач "не очень", но всё таки функции DirectХ и OpenGL есть и они должны сработать здесь.
Но.. опыта нет. хелп ).
Ответить с цитированием
  #11  
Старый 05.04.2016, 20:48
AlexSku AlexSku вне форума
Специалист
 
Регистрация: 07.05.2007
Адрес: Москва
Сообщения: 884
Репутация: 21699
По умолчанию

Кстати, у меня камера выдавала не RGB, а YUV формат, поэтому отключить красный можно только после преобразования.
Ответить с цитированием
  #12  
Старый 07.10.2016, 16:09
-=#PupaJr#=- -=#PupaJr#=- вне форума
Новичок
 
Регистрация: 17.08.2010
Сообщения: 74
Репутация: 518
По умолчанию И снова разрешение камеры

Извиняюсь что снова влез в старую тему... Просто наконец-то купил USB камеру высокого разрешения 8Мп
Работаю в XPprof32 delphi6

В начале есть ссылка на ресурс - поиск его не выдавал мне но он по истине крутой - работа с веб камерой - есть всё!

http://http://www.delphibasics.info/...captureexample

Все работают через DSpack или DirectShow9 а тут как-то всё просто и всё открывается и главное устанавливаются параметры.

1)В Uses есть компанент VFrames - что это за компанент и откуда он взялся - у себя найти не могу, гугл что-то тупит по этому поводу..
Гланое код компилится и работает )))
2)Есть в примерах окна свойств - их я получал через OleCreatePropertyFrame - как описано в некоторых примерах (настройки яркости, цвета, гаммы... итп), есть окно разрешения/кадры и типа цвета MJPG/YUY2 - тоже получал через OleCreatePropertyFrame но установка параметра выдавала ошибку. В этих примерах НЕТ ошибки и работает!!!
- откуда эти свойства беруться, ведь даже сама винда не выдаёт этих окон при просмотре свойств видеоустройства в панели управления
3) Сама винда отлично работает и быстро!! через диспетчер "камеры и сканеры" - "мастер работы со сканером и камерой" маленькая превьюшка довольно шустрая и по умолчанию делает (нет настроек!!) 8Мпикс снимок!! а в примерах это просто ТОРМОЗА страшенные. По указанной ссылке пример работает боле-менее быстро 2 кадра/с с YUY2 типом и качество лучше картинки чем MJPG.

ну вот, 3 вопроса 3 коммента, если можно )))

пс с 1 разобрался, он подтягивает папку Common c корня примеров - в ней и лежит VFrames основанный на том же DirectShow9, но более полно проработан потому и работает.

Последний раз редактировалось -=#PupaJr#=-, 07.10.2016 в 16:22.
Ответить с цитированием
  #13  
Старый 07.10.2016, 16:39
Аватар для Alegun
Alegun Alegun вне форума
LMD-DML
 
Регистрация: 12.07.2009
Адрес: Богородское
Сообщения: 3,025
Версия Delphi: D7E
Репутация: 1834
По умолчанию

Не открывается ссыль, вот другая на экземпл

1) Насчёт VFrames.pas, это адаптация на паскаль апи directX-овой набора компонентов для AVICAP32.DLL, она здесь вроде
Ответить с цитированием
  #14  
Старый 07.10.2016, 17:33
-=#PupaJr#=- -=#PupaJr#=- вне форума
Новичок
 
Регистрация: 17.08.2010
Сообщения: 74
Репутация: 518
По умолчанию

Да, ссылка глючит, хотя копировал прямо с браузера...
С фреймом всё понял... жалко что там нет записи ещё видео, а только снимок.
Ответить с цитированием
Ответ


Delphi Sources

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

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

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

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


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


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

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

ВКонтакте   Facebook   Twitter