unit Interval_Double_Shot;

interface

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

type
  TForm1 = class(TForm)
    btnConnectClick0: TButton;
    btnCaptureClick: TButton;
    CaptureImage0: TImage;
    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;
    Label7: TLabel;
    Label8: TLabel;
    btnConnectClick1: TButton;
    CaptureImage1: TImage;
    lblMessage0: TLabel;
    lblMessage1: TLabel;
    lblMessage2: TLabel;
    lblMessage3: TLabel;
    procedure btnConnectClick0Click(Sender: TObject);
    procedure btnCaptureClickClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure Timer3Timer(Sender: TObject);
    procedure btnConnectClick1Click(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;
  CaptureWnd0   :Integer;
  CaptureLeft0  :Integer;
  CaptureTop0   :Integer;
  CaptureWidth0 :Integer;
  CaptureHeight0:Integer;

  CaptureWnd1   :Integer;
  CaptureLeft1  :Integer;
  CaptureTop1   :Integer;
  CaptureWidth1 :Integer;
  CaptureHeight1:Integer;


  myTimeStart  :TDateTime;
  myTimeuntil  :TDateTime;
  myPhotoCounter :Integer;
  myString : String;

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.btnConnectClick0Click(Sender: TObject);
  const
    str_Connect = '(A) Webカメラに接続';
    str_Disconn = '(A) 接続解除';
  begin
    if (Sender as TButton).Caption = str_Connect then
    begin
       CaptureWnd0 := capCreateCaptureWindowA('0',
       WS_CHILD or WS_VISIBLE, CaptureLeft0, CaptureTop0,
       CaptureWidth0, CaptureHeight0,Handle,0);
       if CaptureWnd0 <>0 then
       begin
          //デバイスへの接続
          SendMessageA(CaptureWnd0,WM_CAP_DRIVER_CONNECT,0,0);
          //プレビュースケール
          SendMessageA(CaptureWnd0,WM_CAP_SET_SCALE,-1,0);
          //プレビューのコマ数（ミリ秒）
          SendMessageA(CaptureWnd0,WM_CAP_SET_PREVIEWRATE,15,0);
          // プレビュー開始
          SendMessageA(CaptureWnd0,WM_CAP_SET_PREVIEW,-1,0);
          //
          SetWindowPos(CaptureWnd0,HWND_BOTTOM, 0, 0,
           CaptureImage0.Width,CaptureImage0.Height,
           SWP_NOMOVE or SWP_NOZORDER);

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

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

      end
  end;

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

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

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

    end

end;


procedure subSaveJpeg0;
  var
    PanelDC: HDC;
    Stream: TFileStream;
  begin
    if CaptureWnd0 <>0 then
    begin
      SendMessageA(CaptureWnd0,TForm1.WM_CAP_DRIVER_CONNECT,0,0);
      //SendMessage(CaptureWnd,WM_CAP_GRAB_FRAME,0,0);
      if Form1.CaptureImage0.Picture.Bitmap.Width<> CaptureWidth0 then
        Form1.CaptureImage0.Picture.Bitmap:= TBitmap.Create;
        begin
          Form1.CaptureImage0.Picture.Bitmap.Width:= CaptureWidth0;
          Form1.CaptureImage0.Picture.Bitmap.Height:= CaptureHeight0;
          PanelDC := GetDC(Form1.Handle);
          try
            BitBlt(Form1.CaptureImage0.Picture.Bitmap.Canvas.Handle,0,0,
              CaptureWidth0,CaptureHeight0,PanelDC,CaptureLeft0,CaptureTop0, SRCCOPY);
          finally
            ReleaseDC(Form1.Handle, PanelDC);
          end;
          With TJPEGImage.Create do
          try
            myString := AnsiReplaceStr(DateToStr(Now),'/','');
            myString := myString + AnsiReplaceStr(TimeToStr(Now),':','');
            Assign(Form1.CaptureImage0.Picture.Bitmap);
            CompressionQuality :=100;
            Stream:= TFileStream.Create('A_'+ myString +'.jpg',fmCreate);
            myPhotoCounter :=myPhotoCounter + 1;
            Form1.Label005.Caption := '撮影回数　' + IntToStr(myPhotoCounter) +'回 ×2画面';
            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 subSaveJpeg1;
  var
    PanelDC: HDC;
    Stream: TFileStream;
  begin
    if CaptureWnd0 <>0 then
    begin
      SendMessageA(CaptureWnd0,TForm1.WM_CAP_DRIVER_CONNECT,0,0);
      //SendMessage(CaptureWnd,WM_CAP_GRAB_FRAME,0,0);
      if Form1.CaptureImage0.Picture.Bitmap.Width<> CaptureWidth0 then
        Form1.CaptureImage0.Picture.Bitmap:= TBitmap.Create;
        begin
          Form1.CaptureImage0.Picture.Bitmap.Width:= CaptureWidth0;
          Form1.CaptureImage0.Picture.Bitmap.Height:= CaptureHeight0;
          PanelDC := GetDC(Form1.Handle);
          try
            BitBlt(Form1.CaptureImage0.Picture.Bitmap.Canvas.Handle,0,0,
              CaptureWidth0,CaptureHeight0,PanelDC,CaptureLeft0,CaptureTop1, SRCCOPY);
          finally
            ReleaseDC(Form1.Handle, PanelDC);
          end;
          With TJPEGImage.Create do
          try
            Assign(Form1.CaptureImage0.Picture.Bitmap);
            CompressionQuality :=100;
            Stream:= TFileStream.Create('B_'+ myString +'.jpg',fmCreate);
            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);
      subSaveJpeg0;
      subSaveJpeg1;

      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
    CaptureLeft0     :=220;
    CaptureTop0      :=  6;
    CaptureWidth0    :=320;
    CaptureHeight0   :=240;
    CaptureLeft1     :=220;
    CaptureTop1      :=250;
    CaptureWidth0    :=320;
    CaptureHeight0   :=240;
    UpDownSecond.Position:=10;
    Timer1.Interval := 100;
    Timer1.Enabled := False;
    Timer2.Interval := 200;
    Timer2.Enabled := True;
    Label005.Caption:='';
    myPhotoCounter := 0;
    Label006.Visible := False;
    lblMessage0.Caption:='1 「（Ａ）Webカメラに接続」をクリック' + #13+#10
                   + '　→ビデオデバイスの選択' + #13+#10
                   + '※画面が表示されるまで約10秒' + #13+#10 +'かかります';
    lblMessage1.Caption:='2 「（Ｂ）Webカメラに接続」をクリック' + #13+#10
                   + '　→Ａとは異なるビデオデバイスの選択' + #13+#10
                   + '※画面が表示されるまで約10秒' + #13+#10 +'かかります';
    lblMessage2.Caption:='　緑色や黒色の画面が表示される場合' + #13+#10
                   + '　には接続に失敗しています' + #13+#10
                   + '　ソフトを終了してください' + #13+#10 + #13+#10
                   + '　カメラ以外のUSB機器をすべて取り' + #13+#10
                   + '　外してソフトを動かしてください' + #13+#10
                   + '　(USBメモリも不可です)' + #13+#10;

  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
      subSaveJpeg0;
      subSaveJpeg1;
      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.