// ===================================================
// USB OSR FX Learn Kit Demo Project for nrComm Lib
// Copyright(C) Roman Novgorodov, DeepSoftware
// http://www.DeepSoftware.com
//----------------------------------------------------

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, nrcommbox, nrclasses, nrusb, ComCtrls, nrsemaphore,
  nrusbpipe, nrlogfile, nrusbdrvx64, nrusbdrvx32, nrusbdriver, XPMan;

type
  TForm1 = class(TForm)
    nrUSB1: TnrUSB;
    nrDeviceBox1: TnrDeviceBox;
    Label1: TLabel;
    bEject: TButton;
    lvProperties: TListView;
    bDescriptors: TButton;
    Label2: TLabel;
    GroupBox1: TGroupBox;
    nrGraphBar1: TnrSemaphore;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    CheckBox4: TCheckBox;
    CheckBox5: TCheckBox;
    CheckBox6: TCheckBox;
    CheckBox7: TCheckBox;
    CheckBox8: TCheckBox;
    nrGraphBar2: TnrSemaphore;
    nrGraphBar3: TnrSemaphore;
    nrGraphBar4: TnrSemaphore;
    nrGraphBar5: TnrSemaphore;
    nrGraphBar6: TnrSemaphore;
    nrGraphBar7: TnrSemaphore;
    nrGraphBar8: TnrSemaphore;
    nrLed1: TnrSemaphore;
    nrLed4: TnrSemaphore;
    nrLed7: TnrSemaphore;
    nrLed2: TnrSemaphore;
    nrLed3: TnrSemaphore;
    nrLed5: TnrSemaphore;
    nrLed6: TnrSemaphore;
    nrUSBPipePair1: TnrUSBPipePair;
    chActive: TCheckBox;
    nrLed8: TnrSemaphore;
    Button1: TButton;
    eSend: TEdit;
    Label3: TLabel;
    bSend: TButton;
    eInput: TMemo;
    Label4: TLabel;
    bInstall: TButton;
    nrUsbDriver1: TnrUsbDriver;
    nrUsbDriver32bit1: TnrUsbDriver32bit;
    nrUsbDriver64bit1: TnrUsbDriver64bit;
    nrLogFile1: TnrLogFile;
    XPManifest1: TXPManifest;
    chShowAll: TCheckBox;
    procedure bEjectClick(Sender: TObject);
    procedure nrDeviceBox1Change(Sender: TObject);
    procedure bDescriptorsClick(Sender: TObject);
    procedure nrGraphBar1Click(Sender: TObject);
    procedure chActiveClick(Sender: TObject);
    procedure nrLed1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure bSendClick(Sender: TObject);
    procedure nrUSBPipePair1AfterReceive(Com: TObject; Buffer: Pointer;
      Received: Cardinal);
    procedure bInstallClick(Sender: TObject);
    procedure chShowAllClick(Sender: TObject);
  private
    procedure SetOsrFxState(func:integer; value:byte);
    function GetOsrFxState(func:integer):byte;
    procedure AddInfo(sCapt, sVal: string);
    procedure SetBarGraph;
    procedure SetLed7;
    procedure GetStates;
    procedure UpdateControls; 
  public   { Public declarations }
    procedure WMDeviceChange(var Msg:TMessage); message WM_DEVICECHANGE;
  end;

var
  Form1: TForm1;

implementation
uses nrusbman, nrusbw32;

{$R *.dfm}

// OSR FX device constants ...

Const
  OSRFX_SET_BARGRAPH_DISPLAY  = $D8;
  OSRFX_READ_BARGRAPH_DISPLAY = $D7;
  OSRFX_SET_7SEGMENT_DISPLAY  = $DB;
  OSRFX_READ_7SEGMENT_DISPLAY = $D4;
  OSRFX_READ_SWITCHES         = $D6;

procedure TForm1.bEjectClick(Sender: TObject);
begin
  nrUSB1.Eject;
end;

procedure TForm1.AddInfo(sCapt, sVal: string);
var Itm:TListItem;
begin
  if Trim(sVal) = '' then exit;
  with lvProperties do begin
    Itm := Items.Add;
    Itm.Caption := sCapt;
    Itm.SubItems.Add(sVal);
  end;
end;

procedure TForm1.nrDeviceBox1Change(Sender: TObject);
var i:integer;
    Dev:TnrUsbDevice;
begin
  UpdateControls;
  
  Dev := nrUSB1.UsbDevice;

  lvProperties.Items.BeginUpdate;
  lvProperties.Clear;

  if Dev <> nil then begin
    AddInfo('Description',Dev.Description);
    AddInfo('Max Power',IntToStr(Dev.MaxPower)+' mA');
    AddInfo('Max Packet Size',IntToStr(Dev.MaxPacketSize));
    AddInfo('S/N',Dev.SerialNumber);
    AddInfo('Vendor ID',IntToHex(Dev.VendorID,4)+'h');
    AddInfo('Product ID',IntToHex(Dev.ProductID,4)+'h');
    AddInfo('Is Wake Up',BoolToStr(Dev.IsWakeUp,True));
    AddInfo('Is Self Power',BoolToStr(Dev.IsSelfPower,True));
    AddInfo('Is Bus Power',BoolToStr(Dev.IsBusPower,True));
    AddInfo('USB Version',IntToStr(Dev.VerHi) + '.' + IntToStr(Dev.VerLo));
    AddInfo('Speed (Low,Full,High)',strUSBSpeeds[Dev.Speed]+' ');
    AddInfo('Pipe Count',IntToStr(Dev.PipeCount));
    AddInfo('Service',Dev.Service);
    AddInfo('Disk''s',Dev.DriverLetters);
    for i := 0 to Dev.Descriptors.Count - 1
      do AddInfo('String Descriptor ['+IntToStr(i+1) + ']', Dev.Descriptors[i]);
  end;

  lvProperties.Items.EndUpdate;

  chActive.Enabled := Dev <> nil;
  
end;

procedure TForm1.WMDeviceChange(var Msg: TMessage);
var i:integer;
begin
  Screen.Cursor := crHourGlass;
  i := nrUsb1.DeviceIndex;
  nrUsb1.WMDeviceChange(Msg);
  nrUsb1.DeviceIndex := i;
  nrDeviceBox1Change(Self);
  Screen.Cursor := crDefault;
end;

procedure TForm1.bDescriptorsClick(Sender: TObject);
begin
  if nrUsb1.UsbDevice <> nil then begin
    Screen.Cursor := crHourGlass;
    nrUsb1.UsbDevice.UpdateDescriptors;
    nrDeviceBox1Change(Self);
    Screen.Cursor := crDefault;
  end;
end;

procedure TForm1.chActiveClick(Sender: TObject);
begin
  try
    nrUSB1.Active := chActive.Checked;
    nrUSBPipePair1.Active := nrUSB1.Active;
  except
    on e:Exception do begin
       ShowMessage(e.Message);
       nrUSB1.Active := false;
     end;
  end;
  UpdateControls;
end;

procedure TForm1.nrGraphBar1Click(Sender: TObject);
begin
  TnrSemaphore(Sender).Checked := not TnrSemaphore(Sender).Checked;
  SetBarGraph;
end;

procedure TForm1.nrLed1Click(Sender: TObject);
begin
  TnrSemaphore(Sender).Checked := not TnrSemaphore(Sender).Checked;
  SetLed7;
end;

procedure TForm1.SetBarGraph;
var i:integer;
    lights : byte;
begin
  // prepare bitmap value for checked lights
  lights := 0;
  for i := 0 to GroupBox1.ControlCount - 1 do
    if Pos('nrGraphBar', GroupBox1.Controls[i].Name) > 0
      then
        if TnrSemaphore(GroupBox1.Controls[i]).Checked
          then lights := lights or GroupBox1.Controls[i].Tag;

  SetOsrFxState(OSRFX_SET_BARGRAPH_DISPLAY, lights);
end;

procedure TForm1.SetLed7;
var i:integer;
    lights : byte;
begin
  // prepare bitmap value for checked lights
  lights := 0;
  for i := 0 to GroupBox1.ControlCount - 1 do
    if Pos('nrLed', GroupBox1.Controls[i].Name) > 0
      then
        if TnrSemaphore(GroupBox1.Controls[i]).Checked
          then lights := lights or GroupBox1.Controls[i].Tag;

  SetOsrFxState(OSRFX_SET_7SEGMENT_DISPLAY, lights);
end;

procedure TForm1.GetStates;
var i:integer;
    state : byte;
begin
  state := GetOsrFxState(OSRFX_READ_SWITCHES);

  for i := 0 to GroupBox1.ControlCount - 1 do
    if GroupBox1.Controls[i] is TCheckBox
      then TCheckBox(GroupBox1.Controls[i]).Checked := (GroupBox1.Controls[i].Tag and state) <> 0;


  state := GetOsrFxState(OSRFX_READ_7SEGMENT_DISPLAY);

  for i := 0 to GroupBox1.ControlCount - 1 do
    if Pos('nrLed', GroupBox1.Controls[i].Name) > 0
      then
        TnrSemaphore(GroupBox1.Controls[i]).Checked := (GroupBox1.Controls[i].Tag and state)  <> 0;

  state := GetOsrFxState(OSRFX_READ_BARGRAPH_DISPLAY);

  for i := 0 to GroupBox1.ControlCount - 1 do
    if Pos('nrGraphBar', GroupBox1.Controls[i].Name) > 0
      then
        TnrSemaphore(GroupBox1.Controls[i]).Checked := (GroupBox1.Controls[i].Tag and state)  <> 0;

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  GetStates;
end;

procedure TForm1.UpdateControls;
var i : integer;
begin

  bDescriptors.Enabled := nrUSB1.UsbDevice <> nil;
  bEject.Enabled := bDescriptors.Enabled;

  bInstall.Enabled := bDescriptors.Enabled and not nrUSB1.Active;

  for i := 0 to GroupBox1.ControlCount - 1 do begin
    GroupBox1.Controls[i].Enabled := nrUSB1.Active and not( GroupBox1.Controls[i] is TCheckBox);
    if not nrUSB1.Active then begin
      if GroupBox1.Controls[i] is TnrSemaphore
        then TnrSemaphore(GroupBox1.Controls[i]).Checked := false;
      if GroupBox1.Controls[i] is TCheckBox
        then TCheckBox(GroupBox1.Controls[i]).Checked := false;
    end;
  end;
  nrDeviceBox1.Enabled := not nrUSB1.Active;
  chActive.Enabled := nrUSB1.DeviceIndex >= 0;
  GroupBox1.Enabled := nrUSB1.Active;
  if nrUSB1.Active then GetStates

end;

function TForm1.GetOsrFxState(func: integer): byte;
var request : TnrUsbRequest;
begin
  // prepare request ...
  request.ReqType := urtVendor;
  request.ReqDirection := urdDeviceToHost;
  request.ReqRecipient := urrEndpoint;
  request.Index := 0;
  request.Value := 0;
  request.Request := func;
  request.Length := sizeof(result);
  request.Data := @result;

  // send request to device
  nrUSB1.ControlRequest(request);

end;

procedure TForm1.SetOsrFxState(func: integer; value: byte);
var request : TnrUsbRequest;
begin
  // prepare request ...
  request.ReqType := urtStandard;
  request.ReqDirection := urdHostToDevice;
  request.ReqRecipient := urrDevice;
  request.Request := func;
  request.Length := sizeof(value);
  request.Data := @value;
  request.Index := 0;
  request.Value := 0;
  // send request to device
  nrUSB1.ControlRequest(request);
end;

procedure TForm1.bSendClick(Sender: TObject);
begin
  nrUSBPipePair1.SendString(eSend.Text);
end;

procedure TForm1.nrUSBPipePair1AfterReceive(Com: TObject; Buffer: Pointer;
  Received: Cardinal);
var s :string;
    i:integer;
begin
  s := '';
  for i := 0 to Received - 1
    do s := s + Char(PAnsiChar(Buffer)[i]);
  eInput.Text := eInput.Text + s; 
end;

procedure TForm1.bInstallClick(Sender: TObject);
begin

  if nrUSB1.UsbDevice = nil then exit;

  if Lowercase(nrUSB1.UsbDevice.Service) = 'winusb' then begin
    if Application.MessageBox('Device already has installed WinUSB driver! Do you want install it again?',
                              'Warning!', MB_YESNO + MB_ICONWARNING) <> IDYES
      then exit;
  end
  else
    if Application.MessageBox('WinUSB driver will be installed on selected device. Are you sure?',
                              'Warning!', MB_YESNO + MB_ICONWARNING) <> IDYES
      then exit;

  Cursor := crHourGlass;
  try
    nrUsbDriver1.Install();
  finally
    Cursor := crDefault;
  end;

end;

procedure TForm1.chShowAllClick(Sender: TObject);
begin
  Screen.Cursor := crHourGlass;
  try
    if chShowAll.Checked then begin
      nrUSB1.IdVendor := 0;
      nrUSB1.IdProduct := 0;
    end else begin
      nrUSB1.IdVendor := 1351; // ID's of OSR USB LEarcn kit
      nrUSB1.IdProduct := 4098;
    end;
    nrUSB1.Update;
    nrDeviceBox1Change(Sender);
    nrDeviceBox1.DroppedDown := True;
  finally
    Screen.Cursor := crDefault;
  end;

end;

end.
