unit Interval_Shot;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, StrUtils;

type
  TForm1 = class(TForm)
    btnConnectClick: TButton;
    btnCaptureClick: TButton;
    CaptureImage: TImage;
    Label1: TLabel;
    UpDownHour: TUpDown;
    UpDownMinute: TUpDown;
    UpDownSecond: TUpDown;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Timer1: TTimer;
    Label002: TLabel;
    Label004: TLabel;
    Timer2: TTimer;
    Label001: TLabel;
    Label003: TLabel;
    Label005: TLabel;
    Label006: TLabel;
    Timer3: TTimer;
    procedure btnConnectClickClick(Sender: TObject);
    procedure btnCaptureClickClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure Timer3Timer(Sender: TObject);
  private
    { Private 宣言 }

  public
    { Public 宣言 }

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

    WM_CAP_EDIT_COPY         = WM_USER +30;

    WM_CAP_SET_SCALE         = WM_USER +53;
    WM_CAP_SET_PREVIEWRATE   = WM_USER +52;
    WM_CAP_SET_PREVIEW       = WM_USER +50;

    SWP_NOMOVE   = $2;
    SWP_NOSIZE   = 1;
    SWP_NOZORDER = $4;
    HWND_BOTTOM  = 1;

  end;

var
  Form1: TForm1;
  CaptureWnd   :Integer;
  CaptureLeft  :Integer;
  CaptureTop   :Integer;
  CaptureWidth :Integer;
  CaptureHeight:Integer;
  myTimeStart  :TDateTime;
  myTimeuntil  :TDateTime;
  myPhotoCounter :Integer;

implementation
uses
 Jpeg;
{$R *.dfm}
function capCreateCaptureWindowA(WindowName: PChar;
    dwStyle: Cardinal; x,y, nWidth,nHeight: Integer;
    ParentWin: HWnd; nID: Integer): HWnd; stdcall;
     external 'AVICAP32.DLL';

function capGetDriverDescriptionA(wDriverIndex: Short;
    lpszName: String; cbName : Integer;
    lpszVer : String; cbVer  : Integer): Boolean; stdcall;
     external 'AVICAP32.DLL';

procedure TForm1.btnConnectClickClick(Sender: TObject);
  const
    str_Connect = 'Webカメラに接続';
    str_Disconn = '接続解除';
  begin
    if (Sender as TButton).Caption = str_Connect then
    begin
       CaptureWnd := capCreateCaptureWindowA('0',
       WS_CHILD or WS_VISIBLE, CaptureLeft, CaptureTop,
       CaptureWidth, CaptureHeight,Handle,0);
       if CaptureWnd<>0 then
       begin
          //デバイスへの接続
          SendMessageA(CaptureWnd,WM_CAP_DRIVER_CONNECT,0,0);
          //プレビュースケール
          SendMessageA(CaptureWnd,WM_CAP_SET_SCALE,-1,0);
          //プレビューのコマ数（ミリ秒）
          SendMessageA(CaptureWnd,WM_CAP_SET_PREVIEWRATE,30,0);
          // プレビュー開始
          SendMessageA(CaptureWnd,WM_CAP_SET_PREVIEW,-1,0);
          //
          SetWindowPos(CaptureWnd,HWND_BOTTOM, 0, 0,
           CaptureImage.Width,CaptureImage.Height,
           SWP_NOMOVE or SWP_NOZORDER);

       end;
       (Sender as TButton).Caption:= str_Disconn

    end
    else
    begin
      //if CaptureWnd<>0 then
        SendMessage(CaptureWnd,WM_CAP_DRIVER_DISCONNECT,0,0);
        DestroyWindow(CaptureWnd);
        CaptureWnd := 0;
        (Sender as TButton).Caption:= str_Connect;

      end
  end;

procedure subSaveBMP();
  begin
    if CaptureWnd<>0  then
    begin
      SendMessage(CaptureWnd,TForm1.WM_CAP_DRIVER_CONNECT,0,0);
    end;
    SendMessage(CaptureWnd,TForm1.WM_CAP_SAVEDIB, 0,cardinal(PChar('savedib.bmp')));
  end;


procedure subSaveJpeg;
  var
    PanelDC: HDC;
    Stream: TFileStream;
    myString : String;
  begin
    if CaptureWnd<>0 then
    begin
      SendMessageA(CaptureWnd,TForm1.WM_CAP_DRIVER_CONNECT,0,0);
      //SendMessage(CaptureWnd,WM_CAP_GRAB_FRAME,0,0);
      if Form1.CaptureImage.Picture.Bitmap.Width<> CaptureWidth then
        Form1.CaptureImage.Picture.Bitmap:= TBitmap.Create;
        begin
          Form1.CaptureImage.Picture.Bitmap.Width:= CaptureWidth;
          Form1.CaptureImage.Picture.Bitmap.Height:= CaptureHeight;
          PanelDC := GetDC(Form1.Handle);
          try
            BitBlt(Form1.CaptureImage.Picture.Bitmap.Canvas.Handle,0,0,
              CaptureWidth,CaptureHeight,PanelDC,CaptureLeft,CaptureTop, SRCCOPY);
          finally
            ReleaseDC(Form1.Handle, PanelDC);
          end;
          With TJPEGImage.Create do
          try
            myString := AnsiReplaceStr(DateToStr(Now),'/','');
            myString := myString + AnsiReplaceStr(TimeToStr(Now),':','');
            Assign(Form1.CaptureImage.Picture.Bitmap);
            CompressionQuality :=100;
            Stream:= TFileStream.Create(myString +'.jpg',fmCreate);
            myPhotoCounter :=myPhotoCounter + 1;
            Form1.Label005.Caption := '撮影回数　' + IntToStr(myPhotoCounter) +'回';
            Form1.Label006.Visible := True;
            Form1.Timer3.Interval  :=900;
            Form1.Timer3.Enabled   := True;
            try
              SaveToStream(Stream);
             finally
              Stream.Free;
            end;
          finally
            Free;
          end;
        end;
    end;
  end;

procedure TForm1.btnCaptureClickClick(Sender: TObject);
  begin
    if btnCaptureClick.Caption='撮影開始' then
    begin
      btnCaptureClick.Caption:= '停止';
      myTimeStart :=StrToTime(Edit1.Text + ':' + Edit2.Text + ':' + Edit3.Text);
      myTimeuntil := Now +myTimeStart;
      Label002.Caption := DateTimeToStr(myTimeuntil);
      subSaveJpeg;

      Timer2.Enabled := False;
      Timer1.Interval := 100;
      Timer1.Enabled := True;
    end
    else
    begin
      btnCaptureClick.Caption :='撮影開始';
      Timer1.Enabled := False;
      Timer2.Enabled := True;
    end;
  end;


procedure TForm1.FormCreate(Sender: TObject);
  begin
    CaptureLeft     :=160;
    CaptureTop      :=  8;
    CaptureWidth    :=640;
    CaptureHeight   :=480;
    UpDownSecond.Position:=10;
    Timer1.Interval := 100;
    Timer1.Enabled := False;
    Timer2.Interval := 200;
    Timer2.Enabled := True;
    Label005.Caption:='';
    myPhotoCounter := 0;
    Label006.Visible := False;
  end;

procedure TForm1.Timer1Timer(Sender: TObject);
  begin
    if Edit3.Text ='' then
    begin
      Edit3.Text :='0';
    end;
    Label002.Caption := DateTimeToStr(Now);
    if Now >= myTimeuntil  then
    begin
      subSaveJpeg;
      myTimeStart :=StrToTime(Edit1.Text + ':' + Edit2.Text + ':' + Edit3.Text);
      myTimeuntil := Now +myTimeStart;
      Label004.Caption := DateTimeToStr(myTimeuntil);
    end;
  end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
    if Edit3.Text ='' then
    begin
      Edit3.Text :='0';
    end;
    Label002.Caption := DateTimeToStr(Now);
    myTimeStart :=StrToTime(Edit1.Text + ':' + Edit2.Text + ':' + Edit3.Text);
    myTimeuntil := Now +myTimeStart;
    Label004.Caption := DateTimeToStr(myTimeuntil);
end;

procedure TForm1.Timer3Timer(Sender: TObject);
  begin
    Label006.Visible := False;
    Timer3.Enabled   := False;
  end;

end.