//---------------------------------------------------------------------
//
// Camera for Windows component
//
// Copyright (c) 2016-2021 WINSOFT
//
//---------------------------------------------------------------------

unit WCameraE;

{$ifdef VER140}
  {$define D6}
{$endif VER140}

{$ifdef CONDITIONALEXPRESSIONS}
  {$if CompilerVersion >= 15}
    {$define D7PLUS} // Delphi 7 or higher
  {$ifend}
{$endif}

interface

procedure Register;

implementation

{$ifdef FPC}
  uses Classes, Types, PropEdits, ComponentEditors, Dialogs, lresources, SysUtils, WCamera;
{$else}
  {$ifdef D6}
  uses Classes, Types, DesignIntf, DesignEditors, SysUtils, TypInfo, Dialogs, WCamera;
  {$else}
    {$ifdef D7PLUS}
      uses Classes, Types, DesignIntf, DesignEditors, SysUtils, TypInfo, Dialogs, WCamera;
    {$else}
      uses Classes, Types, DsgnIntf, SysUtils, TypInfo, Dialogs, WCamera;
    {$endif D7PLUS}
  {$endif D6}
{$endif FPC}

// TDeviceNameProperty

type
  TDeviceNameProperty = class(TStringProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetValues(Proc: TGetStrProc); override;
  end;

function TDeviceNameProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paValueList];
end;

procedure TDeviceNameProperty.GetValues(Proc: TGetStrProc);
var
  I: Integer;
  Devices: TWVideoCaptureDevices;
begin
  Devices := (GetComponent(0) as TWCamera).Devices;
  for I := 0 to Length(Devices) - 1 do
    Proc(Devices[I].Name);
end;

// TDevicePathProperty

type
  TDevicePathProperty = class(TStringProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetValues(Proc: TGetStrProc); override;
  end;

function TDevicePathProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paValueList];
end;

procedure TDevicePathProperty.GetValues(Proc: TGetStrProc);
var
  I: Integer;
  Devices: TWVideoCaptureDevices;
begin
  Devices := (GetComponent(0) as TWCamera).Devices;
  for I := 0 to Length(Devices) - 1 do
    Proc(Devices[I].Path);
end;

// TDeviceIndexProperty
{
type
  TDeviceIndexProperty = class(TIntegerProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetValues(Proc: TGetStrProc); override;
  end;

function TDeviceIndexProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paValueList];
end;

procedure TDeviceIndexProperty.GetValues(Proc: TGetStrProc);
var
  I: Integer;
  Devices: TWVideoCaptureDevices;
begin
  Devices := (GetComponent(0) as TWCamera).Devices;
  for I := 0 to Length(Devices) - 1 do
    Proc(IntToStr(I));
end;
}

// TAudioDeviceNameProperty

type
  TAudioDeviceNameProperty = class(TStringProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetValues(Proc: TGetStrProc); override;
  end;

function TAudioDeviceNameProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paValueList];
end;

procedure TAudioDeviceNameProperty.GetValues(Proc: TGetStrProc);
var
  I: Integer;
  Devices: TWAudioCaptureDevices;
begin
  Devices := (GetComponent(0) as TWCamera).AudioCaptureDevices;
  for I := 0 to Length(Devices) - 1 do
    Proc(Devices[I].Name);
end;

// TAudioDeviceIndexProperty
{
type
  TAudioDeviceIndexProperty = class(TIntegerProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetValues(Proc: TGetStrProc); override;
  end;

function TAudioDeviceIndexProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paValueList];
end;

procedure TAudioDeviceIndexProperty.GetValues(Proc: TGetStrProc);
var
  I: Integer;
  Devices: TWAudioCaptureDevices;
begin
  Devices := (GetComponent(0) as TWCamera).AudioCaptureDevices;
  for I := 0 to Length(Devices) - 1 do
    Proc(IntToStr(I));
end;
}

// TCompressorNameProperty

type
  TCompressorNameProperty = class(TStringProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetValues(Proc: TGetStrProc); override;
  end;

function TCompressorNameProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paValueList];
end;

procedure TCompressorNameProperty.GetValues(Proc: TGetStrProc);
var
  I: Integer;
  Compressors: TStringDynArray;
begin
  Compressors := (GetComponent(0) as TWCamera).Compressors;
  for I := 0 to Length(Compressors) - 1 do
    Proc(Compressors[I]);
end;

// TAudioCompressorNameProperty

type
  TAudioCompressorNameProperty = class(TStringProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetValues(Proc: TGetStrProc); override;
  end;

function TAudioCompressorNameProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paValueList];
end;

procedure TAudioCompressorNameProperty.GetValues(Proc: TGetStrProc);
var
  I: Integer;
  Compressors: TStringDynArray;
begin
  Compressors := (GetComponent(0) as TWCamera).AudioCompressors;
  for I := 0 to Length(Compressors) - 1 do
    Proc(Compressors[I]);
end;

// TOutputFileNameProperty

type
  TOutputFileNameProperty = class(TStringProperty)
  public
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
  end;

procedure TOutputFileNameProperty.Edit;
begin
  with TOpenDialog.Create(nil) do
  try
    Filename := GetValue;
    Filter := 'ASF files (*.asf)|*.asf|AVI files (*.avi)|*.avi|All files (*.*)|*.*';
    Options := Options + [ofNoValidate];
    if Execute then
      SetValue(Filename);
  finally
    Free;
  end;
end;

function TOutputFileNameProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog, paRevertable];
end;

// TWCameraEditor

type
  TWCameraEditor = class(TComponentEditor)
  private
    procedure ShowProperties;
  public
    procedure Edit; override;
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;

procedure TWCameraEditor.ShowProperties;
var Camera: TWCamera;
begin
  Camera := Component as TWCamera;
  Camera.ShowPropertyDialog;
end;

procedure TWCameraEditor.Edit;
begin
  ShowProperties;
end;

function TWCameraEditor.GetVerbCount: Integer;
begin
  Result := 1;
end;

function TWCameraEditor.GetVerb(Index: Integer): string;
begin
  case Index of
    0: Result := '&Properties...';
    else Result := '';
  end;
end;

procedure TWCameraEditor.ExecuteVerb(Index: Integer);
begin
  case Index of
    0: ShowProperties;
  end;
end;

procedure Register;
begin
  RegisterComponents('System', [TWCamera]);
  RegisterPropertyEditor(TypeInfo(WString), TWCamera, 'AudioCompressorName', TAudioCompressorNameProperty);
//  RegisterPropertyEditor(TypeInfo(Integer), TWCamera, 'AudioDeviceIndex', TAudioDeviceIndexProperty);
  RegisterPropertyEditor(TypeInfo(WString), TWCamera, 'AudioDeviceName', TAudioDeviceNameProperty);
  RegisterPropertyEditor(TypeInfo(WString), TWCamera, 'CompressorName', TCompressorNameProperty);
//  RegisterPropertyEditor(TypeInfo(Integer), TWCamera, 'DeviceIndex', TDeviceIndexProperty);
  RegisterPropertyEditor(TypeInfo(WString), TWCamera, 'DeviceName', TDeviceNameProperty);
  RegisterPropertyEditor(TypeInfo(WString), TWCamera, 'DevicePath', TDevicePathProperty);
  RegisterPropertyEditor(TypeInfo(WString), TWCamera, 'OutputFileName', TOutputFileNameProperty);
  RegisterComponentEditor(TWCamera, TWCameraEditor);
end;

{$ifdef FPC}
initialization
  {$i wcamerap.lrs}
{$endif FPC}
end.