Форум по 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.
Ответить с цитированием
 


Delphi Sources

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

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

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

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


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


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

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

ВКонтакте   Facebook   Twitter