|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
|||
|
|||
Веб камера - изменить разрешение снимка
Всем добрый день, поиском пользовался по моей задаче ответа не нашел, надеюсь тут мне помогут.
Моя программа изображение выводит на 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. |