unit Main;

{$MODE Delphi}

interface

uses
  LCLIntf, LCLType, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, WCamera, StdCtrls, ComCtrls, ColorBox;

type

  { TFormMain }

  TFormMain = class(TForm)
    PanelTop: TPanel;
    PanelRight: TPanel;
    PanelCenter: TPanel;
    WCamera: TWCamera;
    LabelCamera: TLabel;
    ComboBoxCamera: TComboBox;
    LabelFormat: TLabel;
    ComboBoxFormat: TComboBox;
    TrackBarBacklightCompensation: TTrackBar;
    LabelBacklightCompensation: TLabel;
    CheckBoxBacklightCompensation: TCheckBox;
    LabelBrightness: TLabel;
    TrackBarBrightness: TTrackBar;
    CheckBoxBrightness: TCheckBox;
    LabelColorEnable: TLabel;
    TrackBarColorEnable: TTrackBar;
    CheckBoxColorEnable: TCheckBox;
    LabelContrast: TLabel;
    TrackBarContrast: TTrackBar;
    CheckBoxContrast: TCheckBox;
    LabelExposure: TLabel;
    TrackBarExposure: TTrackBar;
    CheckBoxExposure: TCheckBox;
    LabelFocus: TLabel;
    TrackBarFocus: TTrackBar;
    CheckBoxFocus: TCheckBox;
    LabelGain: TLabel;
    TrackBarGain: TTrackBar;
    CheckBoxGain: TCheckBox;
    LabelGamma: TLabel;
    TrackBarGamma: TTrackBar;
    CheckBoxGamma: TCheckBox;
    LabelHue: TLabel;
    TrackBarHue: TTrackBar;
    CheckBoxHue: TCheckBox;
    LabelIris: TLabel;
    TrackBarIris: TTrackBar;
    CheckBoxIris: TCheckBox;
    LabelPan: TLabel;
    TrackBarPan: TTrackBar;
    CheckBoxPan: TCheckBox;
    LabelRoll: TLabel;
    TrackBarRoll: TTrackBar;
    CheckBoxRoll: TCheckBox;
    LabelSaturation: TLabel;
    TrackBarSaturation: TTrackBar;
    CheckBoxSaturation: TCheckBox;
    LabelSharpness: TLabel;
    TrackBarSharpness: TTrackBar;
    CheckBoxSharpness: TCheckBox;
    LabelTilt: TLabel;
    TrackBarTilt: TTrackBar;
    CheckBoxTilt: TCheckBox;
    LabelWhiteBalance: TLabel;
    TrackBarWhiteBalance: TTrackBar;
    CheckBoxWhiteBalance: TCheckBox;
    LabelZoom: TLabel;
    TrackBarZoom: TTrackBar;
    CheckBoxZoom: TCheckBox;
    CheckBoxAspectRatio: TCheckBox;
    ButtonSaveCurrentImage: TButton;
    ButtonDefaultValues: TButton;
    ColorBoxBorderColor: TColorBox;
    LabelBorderColor: TLabel;
    PaintBox: TPaintBox;
    CheckBoxStretch: TCheckBox;
    procedure ComboBoxCameraDropDown(Sender: TObject);
    procedure ComboBoxCameraChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ComboBoxFormatChange(Sender: TObject);
    procedure PanelCenterResize(Sender: TObject);
    procedure CheckBoxClick(Sender: TObject);
    procedure TrackBarChange(Sender: TObject);
    procedure ButtonSaveCurrentImageClick(Sender: TObject);
    procedure ButtonDefaultValuesClick(Sender: TObject);
    procedure ColorBoxBorderColorChange(Sender: TObject);
    procedure WCameraImageAvailable(Sender: TObject; SampleTime: Double);
    procedure FormDestroy(Sender: TObject);
    procedure PaintBoxPaint(Sender: TObject);
    procedure CheckBoxStretchClick(Sender: TObject);
    procedure CheckBoxAspectRatioClick(Sender: TObject);
  private
    { Private declarations }
    MemoryStream: TMemoryStream;
    Bitmap: TBitmap;
    Format: TWCameraFormat;
    procedure SetDevices;
    procedure SetFormats;
    procedure SetTrackBars;
    procedure StartDevice;
    procedure UpdateVideoPosition;
  public
    { Public declarations }
  end;

var
  FormMain: TFormMain;

implementation

{$R *.lfm}

procedure TFormMain.SetDevices;
var
  CurrentDeviceName: string;
  CurrentDeviceIndex: Integer;
  Devices: TWVideoCaptureDevices;
  I: Integer;
begin
  ComboBoxCamera.Items.BeginUpdate;
  try
    CurrentDeviceName := ComboBoxCamera.Text;
    CurrentDeviceIndex := ComboBoxCamera.ItemIndex;
    ComboBoxCamera.Items.Clear;
    Devices := WCamera.Devices;
    for I := 0 to Length(Devices) - 1 do
      ComboBoxCamera.Items.Add(Devices[I].Name);

    if (CurrentDeviceIndex >= 0) and (CurrentDeviceIndex < ComboBoxCamera.Items.Count) then
      if ComboBoxCamera.Items[CurrentDeviceIndex] = CurrentDeviceName then
      begin
        ComboBoxCamera.ItemIndex := CurrentDeviceIndex;
        Exit;
      end;  

    ComboBoxCamera.ItemIndex := ComboBoxCamera.Items.IndexOf(CurrentDeviceName);
  finally
    ComboBoxCamera.Items.EndUpdate;
  end;
end;

procedure TFormMain.SetFormats;
var
  Formats: TWCameraFormats;
  I: Integer;
begin
  Formats := nil;
  ComboBoxFormat.Items.BeginUpdate;
  try
    ButtonSaveCurrentImage.Enabled := False;
    WCamera.Active := False;
    WCamera.DeviceIndex := ComboBoxCamera.ItemIndex;
    ComboBoxFormat.Items.Clear;
    ComboBoxFormat.Enabled := WCamera.DeviceIndex <> -1;
    if ComboBoxFormat.Enabled then
    begin
      Formats := WCamera.SupportedFormats;
      for I := 0 to Length(Formats) - 1 do
        if Formats[I].AvgTimePerFrame = 0 then
          ComboBoxFormat.Items.Add(IntToStr(Formats[I].Width) + 'x' + IntToStr(Formats[I].Height) + ' ' + IntToStr(Formats[I].BitsPerPixel) + 'bpp')
        else
          ComboBoxFormat.Items.Add(IntToStr(Formats[I].Width) + 'x' + IntToStr(Formats[I].Height) + ' ' + IntToStr(10000000 div Formats[I].AvgTimePerFrame) + 'Hz ' + IntToStr(Formats[I].BitsPerPixel) + 'bpp');
    end
  finally
    ComboBoxFormat.Items.EndUpdate;
  end;
end;

procedure InitTrackBar(TrackbarLabel: TLabel; TrackBar: TTrackBar; CheckBoxAuto: TCheckBox);
begin
  TrackbarLabel.Enabled := False;
  TrackBar.Enabled := False;
  CheckBoxAuto.Enabled := False;
end;

procedure SetTrackBar(TrackbarLabel: TLabel; TrackBar: TTrackBar; CheckBoxAuto: TCheckBox; Position: Integer; Range: TWRange; Auto: Boolean);
begin
  CheckBoxAuto.Checked := Auto;
  TrackBar.Min := Range.Min;
  TrackBar.Max := Range.Max;
  TrackBar.PageSize := Range.Delta;
  if (Range.Delta > 0) and ((Range.Max - Range.Min) div Range.Delta > 25) then
    TrackBar.Frequency := (Range.Max - Range.Min) div 25
  else
    TrackBar.Frequency := 1;
  TrackBar.Position := Position;

  TrackbarLabel.Enabled := True;
  CheckBoxAuto.Enabled := Range.Auto and Range.Manual;
  TrackBar.Enabled := not CheckBoxAuto.Checked;
end;

var TrackBarsSetting: Boolean;

procedure TFormMain.SetTrackBars;
begin
  if not TrackBarsSetting then
  try
    TrackBarsSetting := True;
    InitTrackBar(LabelBacklightCompensation, TrackBarBacklightCompensation, CheckBoxBacklightCompensation);
    InitTrackBar(LabelBrightness, TrackBarBrightness, CheckBoxBrightness);
    InitTrackBar(LabelColorEnable, TrackBarColorEnable, CheckBoxColorEnable);
    InitTrackBar(LabelContrast, TrackBarContrast, CheckBoxContrast);
    InitTrackBar(LabelExposure, TrackBarExposure, CheckBoxExposure);
    InitTrackBar(LabelFocus, TrackBarFocus, CheckBoxFocus);
    InitTrackBar(LabelGain, TrackBarGain, CheckBoxGain);
    InitTrackBar(LabelGamma, TrackBarGamma, CheckBoxGamma);
    InitTrackBar(LabelHue, TrackBarHue, CheckBoxHue);
    InitTrackBar(LabelIris, TrackBarIris, CheckBoxIris);
    InitTrackBar(LabelPan, TrackBarPan, CheckBoxPan);
    InitTrackBar(LabelRoll, TrackBarRoll, CheckBoxRoll);
    InitTrackBar(LabelSaturation, TrackBarSaturation, CheckBoxSaturation);
    InitTrackBar(LabelSharpness, TrackBarSharpness, CheckBoxSharpness);
    InitTrackBar(LabelTilt, TrackBarTilt, CheckBoxTilt);
    InitTrackBar(LabelWhiteBalance, TrackBarWhiteBalance, CheckBoxWhiteBalance);
    InitTrackBar(LabelZoom, TrackBarZoom, CheckBoxZoom);

    if WCamera.DeviceIndex <> -1 then
    begin
      if WCamera.BacklightCompensationSupported then
        SetTrackBar(LabelBacklightCompensation, TrackBarBacklightCompensation, CheckBoxBacklightCompensation, WCamera.BacklightCompensation, WCamera.BacklightCompensationRange, WCamera.BacklightCompensationAuto);

      if WCamera.BrightnessSupported then
        SetTrackBar(LabelBrightness, TrackBarBrightness, CheckBoxBrightness, WCamera.Brightness, WCamera.BrightnessRange, WCamera.BrightnessAuto);

      if WCamera.ColorEnableSupported then
        SetTrackBar(LabelColorEnable, TrackBarColorEnable, CheckBoxColorEnable, WCamera.ColorEnable, WCamera.ColorEnableRange, WCamera.ColorEnableAuto);

      if WCamera.ContrastSupported then
        SetTrackBar(LabelContrast, TrackBarContrast, CheckBoxContrast, WCamera.Contrast, WCamera.ContrastRange, WCamera.ContrastAuto);

      if WCamera.ExposureSupported then
        SetTrackBar(LabelExposure, TrackBarExposure, CheckBoxExposure, WCamera.Exposure, WCamera.ExposureRange, WCamera.ExposureAuto);

      if WCamera.FocusSupported then
        SetTrackBar(LabelFocus, TrackBarFocus, CheckBoxFocus, WCamera.Focus, WCamera.FocusRange, WCamera.FocusAuto);

      if WCamera.GainSupported then
        SetTrackBar(LabelGain, TrackBarGain, CheckBoxGain, WCamera.Gain, WCamera.GainRange, WCamera.GainAuto);

      if WCamera.GammaSupported then
        SetTrackBar(LabelGamma, TrackBarGamma, CheckBoxGamma, WCamera.Gamma, WCamera.GammaRange, WCamera.GammaAuto);

      if WCamera.HueSupported then
        SetTrackBar(LabelHue, TrackBarHue, CheckBoxHue, WCamera.Hue, WCamera.HueRange, WCamera.HueAuto);

      if WCamera.IrisSupported then
        SetTrackBar(LabelIris, TrackBarIris, CheckBoxIris, WCamera.Iris, WCamera.IrisRange, WCamera.IrisAuto);

      if WCamera.PanSupported then
        SetTrackBar(LabelPan, TrackBarPan, CheckBoxPan, WCamera.Pan, WCamera.PanRange, WCamera.PanAuto);

      if WCamera.RollSupported then
        SetTrackBar(LabelRoll, TrackBarRoll, CheckBoxRoll, WCamera.Roll, WCamera.RollRange, WCamera.RollAuto);

      if WCamera.SaturationSupported then
        SetTrackBar(LabelSaturation, TrackBarSaturation, CheckBoxSaturation, WCamera.Saturation, WCamera.SaturationRange, WCamera.SaturationAuto);

      if WCamera.SharpnessSupported then
        SetTrackBar(LabelSharpness, TrackBarSharpness, CheckBoxSharpness, WCamera.Sharpness, WCamera.SharpnessRange, WCamera.SharpnessAuto);

      if WCamera.TiltSupported then
        SetTrackBar(LabelTilt, TrackBarTilt, CheckBoxTilt, WCamera.Tilt, WCamera.TiltRange, WCamera.TiltAuto);

      if WCamera.WhiteBalanceSupported then
        SetTrackBar(LabelWhiteBalance, TrackBarWhiteBalance, CheckBoxWhiteBalance, WCamera.WhiteBalance, WCamera.WhiteBalanceRange, WCamera.WhiteBalanceAuto);

      if WCamera.ZoomSupported then
        SetTrackBar(LabelZoom, TrackBarZoom, CheckBoxZoom, WCamera.Zoom, WCamera.ZoomRange, WCamera.ZoomAuto);
    end
  finally
    TrackBarsSetting := False;
  end;
end;

procedure TFormMain.StartDevice;
begin
  SetTrackBars;
  if ComboBoxFormat.ItemIndex <> -1 then
  begin
    WCamera.Active := False;
    Format := WCamera.SupportedFormats[ComboBoxFormat.ItemIndex];
    WCamera.Format := Format;
    WCamera.Active := True;
    UpdateVideoPosition;
    WCamera.Run;
    PaintBox.Visible := WCamera.CaptureType = ctGrabber;
    ButtonSaveCurrentImage.Enabled := True;
  end
end;

procedure TFormMain.ComboBoxCameraDropDown(Sender: TObject);
begin
  SetDevices;
end;

procedure TFormMain.ComboBoxCameraChange(Sender: TObject);
begin
  SetFormats;
  SetTrackBars;
  ButtonDefaultValues.Enabled := WCamera.DeviceIndex <> -1;
end;

procedure TFormMain.FormCreate(Sender: TObject);
begin
  WCamera.OnImageAvailable := WCameraImageAvailable; //!!! can't be set in Object Inspector
  PanelCenter.DoubleBuffered := True;
  MemoryStream := TMemoryStream.Create;
  Bitmap := TBitmap.Create;
  SetTrackBars;
end;

procedure TFormMain.FormDestroy(Sender: TObject);
begin
  WCamera.Active := False;
  Bitmap.Free;
  MemoryStream.Free;
end;

procedure TFormMain.ComboBoxFormatChange(Sender: TObject);
begin
  StartDevice;
end;

procedure TFormMain.UpdateVideoPosition;
var Rect: TRect;
begin
  if WCamera.Active and (WCamera.CaptureType = ctVmr9) then
  begin
    if CheckBoxStretch.Checked then
    begin
      WCamera.AspectRatio := CheckBoxAspectRatio.Checked;
      WCamera.VideoPositionDest := PanelCenter.ClientRect;
    end
    else
    begin
      Rect.Left := (PanelCenter.Width - Format.Width) div 2;
      Rect.Top := (PanelCenter.Height - Format.Height) div 2;
      Rect.Right := Rect.Left + Format.Width;
      Rect.Bottom := Rect.Top + Format.Height;
      WCamera.VideoPositionDest := Rect;
    end;
    PanelCenter.Invalidate;
  end;
end;

procedure TFormMain.PanelCenterResize(Sender: TObject);
begin
  UpdateVideoPosition;
end;

procedure TFormMain.CheckBoxClick(Sender: TObject);
begin
  if not TrackBarsSetting then
  begin
    if Sender = CheckBoxBacklightCompensation then
      WCamera.BacklightCompensationAuto := CheckBoxBacklightCompensation.Checked
    else if Sender = CheckBoxBrightness then
      WCamera.BrightnessAuto := CheckBoxBrightness.Checked
    else if Sender = CheckBoxColorEnable then
      WCamera.ColorEnableAuto := CheckBoxColorEnable.Checked
    else if Sender = CheckBoxContrast then
      WCamera.ContrastAuto := CheckBoxContrast.Checked
    else if Sender = CheckBoxExposure then
      WCamera.ExposureAuto := CheckBoxExposure.Checked
    else if Sender = CheckBoxFocus then
      WCamera.FocusAuto := CheckBoxFocus.Checked
    else if Sender = CheckBoxGain then
      WCamera.GainAuto := CheckBoxGain.Checked
    else if Sender = CheckBoxGamma then
      WCamera.GammaAuto := CheckBoxGamma.Checked
    else if Sender = CheckBoxHue then
      WCamera.HueAuto := CheckBoxHue.Checked
    else if Sender = CheckBoxIris then
      WCamera.IrisAuto := CheckBoxIris.Checked
    else if Sender = CheckBoxPan then
      WCamera.PanAuto := CheckBoxPan.Checked
    else if Sender = CheckBoxRoll then
      WCamera.RollAuto := CheckBoxRoll.Checked
    else if Sender = CheckBoxSaturation then
      WCamera.SaturationAuto := CheckBoxSaturation.Checked
    else if Sender = CheckBoxSharpness then
      WCamera.SharpnessAuto := CheckBoxSharpness.Checked
    else if Sender = CheckBoxTilt then
      WCamera.TiltAuto := CheckBoxTilt.Checked
    else if Sender = CheckBoxWhiteBalance then
      WCamera.WhiteBalanceAuto := CheckBoxWhiteBalance.Checked
    else if Sender = CheckBoxZoom then
      WCamera.ZoomAuto := CheckBoxZoom.Checked;
    SetTrackBars;
  end
end;

procedure TFormMain.TrackBarChange(Sender: TObject);
begin
  if not TrackBarsSetting then
    if Sender = TrackBarBacklightCompensation then
      WCamera.BacklightCompensation := TrackBarBacklightCompensation.Position
    else if Sender = TrackBarBrightness then
      WCamera.Brightness := TrackBarBrightness.Position
    else if Sender = TrackBarColorEnable then
      WCamera.ColorEnable := TrackBarColorEnable.Position
    else if Sender = TrackBarContrast then
      WCamera.Contrast := TrackBarContrast.Position
    else if Sender = TrackBarExposure then
      WCamera.Exposure := TrackBarExposure.Position
    else if Sender = TrackBarFocus then
      WCamera.Focus := TrackBarFocus.Position
    else if Sender = TrackBarGain then
      WCamera.Gain := TrackBarGain.Position
    else if Sender = TrackBarGamma then
      WCamera.Gamma := TrackBarGamma.Position
    else if Sender = TrackBarHue then
      WCamera.Hue := TrackBarHue.Position
    else if Sender = TrackBarIris then
      WCamera.Iris := TrackBarIris.Position
    else if Sender = TrackBarPan then
      WCamera.Pan := TrackBarPan.Position
    else if Sender = TrackBarRoll then
      WCamera.Roll := TrackBarRoll.Position
    else if Sender = TrackBarSaturation then
      WCamera.Saturation := TrackBarSaturation.Position
    else if Sender = TrackBarSharpness then
      WCamera.Sharpness := TrackBarSharpness.Position
    else if Sender = TrackBarTilt then
      WCamera.Tilt := TrackBarTilt.Position
    else if Sender = TrackBarWhiteBalance then
      WCamera.WhiteBalance := TrackBarWhiteBalance.Position
    else if Sender = TrackBarZoom then
      WCamera.Zoom := TrackBarZoom.Position;
end;

procedure TFormMain.CheckBoxStretchClick(Sender: TObject);
begin
  CheckBoxAspectRatio.Enabled := CheckBoxStretch.Checked;
  UpdateVideoPosition;
end;

procedure TFormMain.CheckBoxAspectRatioClick(Sender: TObject);
begin
  UpdateVideoPosition;
end;

procedure TFormMain.ButtonSaveCurrentImageClick(Sender: TObject);
begin
  if WCamera.CurrentImageToFile('image.bmp') = ifJpeg then
    RenameFile('image.bmp', 'image.jpg')
end;

procedure TFormMain.ButtonDefaultValuesClick(Sender: TObject);
begin
  try
    if WCamera.BacklightCompensationSupported then
      WCamera.BacklightCompensation := WCamera.BacklightCompensationRange.Default;

    if WCamera.BrightnessSupported then
      WCamera.Brightness := WCamera.BrightnessRange.Default;

    if WCamera.ColorEnableSupported then
      WCamera.ColorEnable := WCamera.ColorEnableRange.Default;

    if WCamera.ContrastSupported then
      WCamera.Contrast := WCamera.ContrastRange.Default;

    if WCamera.ExposureSupported then
      WCamera.Exposure := WCamera.ExposureRange.Default;

    if WCamera.FocusSupported then
      WCamera.Focus := WCamera.FocusRange.Default;

    if WCamera.GainSupported then
      WCamera.Gain := WCamera.GainRange.Default;

    if WCamera.GammaSupported then
      WCamera.Gamma := WCamera.GammaRange.Default;

    if WCamera.HueSupported then
      WCamera.Hue := WCamera.HueRange.Default;

    if WCamera.IrisSupported then
      WCamera.Iris := WCamera.IrisRange.Default;

    if WCamera.PanSupported then
      WCamera.Pan := WCamera.PanRange.Default;

    if WCamera.RollSupported then
      WCamera.Roll := WCamera.RollRange.Default;

    if WCamera.SaturationSupported then
      WCamera.Saturation := WCamera.SaturationRange.Default;

    if WCamera.SharpnessSupported then
      WCamera.Sharpness := WCamera.SharpnessRange.Default;

    if WCamera.TiltSupported then
      WCamera.Tilt := WCamera.TiltRange.Default;

    if WCamera.WhiteBalanceSupported then
      WCamera.WhiteBalance := WCamera.WhiteBalanceRange.Default;

    if WCamera.ZoomSupported then
      WCamera.Zoom := WCamera.ZoomRange.Default;
  finally
    SetTrackBars;
  end
end;

procedure TFormMain.ColorBoxBorderColorChange(Sender: TObject);
begin
  PanelCenter.Color := ColorBoxBorderColor.Selected;
  if WCamera.CaptureType = ctVmr9 then
  begin
    WCamera.BorderColor := ColorBoxBorderColor.Selected;
    if WCamera.Active then
      StartDevice;
  end;
end;

procedure TFormMain.WCameraImageAvailable(Sender: TObject; SampleTime: Double);
begin
  PaintBox.Invalidate;
end;

procedure TFormMain.PaintBoxPaint(Sender: TObject);
var
  AspectRatio: Double;
  Height, Width: Integer;
  Rect: TRect;
begin
  if WCamera.Active and (WCamera.CaptureType = ctGrabber) then
  try
    if not WCamera.CurrentImageToBitmap(Bitmap, MemoryStream) then
      Exit;

    if CheckBoxStretch.Checked then
    begin
      if CheckBoxAspectRatio.Checked then
      begin
        if Bitmap.Width / Bitmap.Height >= PaintBox.Width / PaintBox.Height then
        begin
          AspectRatio := PaintBox.Width / Bitmap.Width;
          Height := Round(AspectRatio * Bitmap.Height);
          Rect.Left := 0;
          Rect.Top := (PaintBox.Height - Height) div 2;
          Rect.Right := PaintBox.Width;
          Rect.Bottom := Rect.Top + Height;
        end
        else
        begin
          AspectRatio := PaintBox.Height / Bitmap.Height;
          Width := Round(AspectRatio * Bitmap.Width);
          Rect.Left := (PaintBox.Width - Width) div 2;
          Rect.Top := 0;
          Rect.Right := Rect.Left + Width;
          Rect.Bottom := PaintBox.Height;
        end;

        PaintBox.Canvas.StretchDraw(Rect,  Bitmap);
      end
      else
        Rect := PaintBox.ClientRect;

      PaintBox.Canvas.StretchDraw(Rect, Bitmap);
    end
    else
    begin
      PaintBox.Canvas.Draw(
        (PaintBox.Width - Bitmap.Width) div 2,
        (PaintBox.Height - Bitmap.Height) div 2,
        Bitmap);
    end;
  except
  end;
end;

end.