⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 iomain.pas

📁 human interface devices.zip 一套组件
💻 PAS
字号:
unit IOMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, StdCtrls, JvHidControllerClass;

const
  cCodeMercenariesVID = $07C0;
  cIOWarrior40PID     = $1500;
  cIOWarrior24PID     = $1501;

type
  TIOWarriorIOReport = packed record
    ReportID: Byte;                // all reports have a ReportID
    IOBits: array [0..3] of Byte;  // 32 bits to read and write
  end;

  TMainForm = class(TForm)
    LED0: TSpeedButton;
    LED1: TSpeedButton;
    LED2: TSpeedButton;
    LED3: TSpeedButton;
    LED4: TSpeedButton;
    LED5: TSpeedButton;
    LED6: TSpeedButton;
    LED7: TSpeedButton;
    IOWarriorDetected: TLabel;
    InputBits: TLabel;
    BlockingRead: TSpeedButton;
    HidCtl: TJvHidDeviceController;
    procedure FormCreate(Sender: TObject);
    procedure HidCtlDeviceChange(Sender: TObject);
    procedure LEDClick(Sender: TObject);
    procedure BlockingReadClick(Sender: TObject);
  public
    LEDs: array [0..7] of TSpeedButton;
    IOWarrior: TJvHidDevice;
    IOWarriorOutputReport: TIOWarriorIOReport;
    procedure UpdateControls;
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

// this function has been extracted from the Jedi Code Library
// http://sourceforge.net/projects/jcl

function OrdToBinary(const Value: Byte): string;
const
  BitsPerByte = 8;
var
  I: Integer;
  B: Byte;
  P: PChar;
begin
  SetLength(Result, BitsPerByte);
  P := PChar(Result) + ((BitsPerByte - 1) * SizeOf(Char));
  B := Value;
  for I := 0 to BitsPerByte - 1 do
  begin
    P^ := Chr(48 + (B and $00000001));
    Dec(P);
    B := B shr 1;
  end;
end;

procedure TMainForm.FormCreate(Sender: TObject);
var
  I: Integer;
begin
  // place the SpeedButtons in an array for indexed access
  // mark them with their array index
  for I := Low(LEDs) to High(LEDs) do
  begin
    LEDs[I] := TSpeedButton(FindComponent(Format('LED%d', [I])));
    LEDs[I].Tag := I;
  end;
  // otherwise the LEDs would not be assigned yet
  HidCtl.OnDeviceChange := HidCtlDeviceChange;
end;

procedure TMainForm.UpdateControls;
var
  I: Integer;
begin
  // enable/disable the controls
  for I := Low(LEDs) to High(LEDs) do
  begin
    LEDs[I].Enabled := Assigned(IOWarrior);
    if not Assigned(IOWarrior) then
      LEDs[I].Down := False;
  end;
  BlockingRead.Enabled := Assigned(IOWarrior);

  if Assigned(IOWarriorDetected) then
    if Assigned(IOWarrior) then
    begin
      if IOWarrior.Attributes.ProductID = cIOWarrior24PID then
        IOWarriorDetected.Caption := 'IO-Warrior 24 is plugged in'
      else
        IOWarriorDetected.Caption := 'IO-Warrior 40 is plugged in';
    end
    else
      IOWarriorDetected.Caption := 'No IO-Warrior is plugged in';
end;

function FindIOWarrior(HidDev: TJvHidDevice): Boolean; stdcall;
begin
  // the IO-Warrior shows up as two devices
  // we want access to the IO-Warrior device for the IO pins
  // the other one with a InputReportByteLength of 8 is for access to
  // the optional LCD module
  Result :=
    (HidDev.Attributes.VendorID = cCodeMercenariesVID) and
    ((HidDev.Attributes.ProductID = cIOWarrior24PID) and
    (HidDev.Caps.InputReportByteLength = 3)) or
    ((HidDev.Attributes.ProductID = cIOWarrior40PID) and
    (HidDev.Caps.InputReportByteLength = 5));
end;

procedure TMainForm.HidCtlDeviceChange(Sender: TObject);
var
  I: Integer;
  BytesWritten: Cardinal;
begin
  // Free the device object if it has been unplugged
  if Assigned(IOWarrior) and not IOWarrior.IsPluggedIn then
    FreeAndNil(IOWarrior);

  // if no IO-Warrior in use yet then search for one
  if not Assigned(IOWarrior) then
    if HidCtl.CheckOutByCallback(IOWarrior, FindIOWarrior) then
    begin
      // initialize the output report
      IOWarriorOutputReport.ReportID := 0;
      // the IO-Warrior LEDs use negative logic
      for I := Low(IOWarriorOutputReport.IOBits) to High(IOWarriorOutputReport.IOBits) do
        IOWarriorOutputReport.IOBits[I] := $FF;
      // write the bits to the IO-Warrior to reset the LEDs
      IOWarrior.WriteFile(IOWarriorOutputReport, IOWarrior.Caps.OutputReportByteLength, BytesWritten);
    end;

  // update the controls on the form
  UpdateControls;
end;

procedure TMainForm.LEDClick(Sender: TObject);
var
  LEDIdx: Integer;
  LEDByte: Integer;
  BytesWritten: Cardinal;
begin
  // use the Tag assigned in FormCreate
  LEDIdx := (Sender as TSpeedButton).Tag;

  if IOWarrior.Attributes.ProductID = cIOWarrior24PID then
    LEDByte := 0
  else
    LEDByte := 3;
  // translate SpeedButton state into correct bit in IOBits
  // IO-Warrior uses negative logic
  if LEDs[LEDIdx].Down then
    // set the bit to 0 to switch the LED on
    IOWarriorOutputReport.IOBits[LEDByte] := IOWarriorOutputReport.IOBits[LEDByte] and not (1 shl LEDIdx)
  else
    // set the bit to 1 to switch the LED off
    IOWarriorOutputReport.IOBits[LEDByte] := IOWarriorOutputReport.IOBits[LEDByte] or (1 shl LEDIdx);

  // write the bits to the IO-Warrior
  IOWarrior.WriteFile(IOWarriorOutputReport, IOWarrior.Caps.OutputReportByteLength, BytesWritten);
end;

procedure TMainForm.BlockingReadClick(Sender: TObject);
var
  I: Integer;
  BytesRead: Cardinal;
  IOWarriorInputReport: TIOWarriorIOReport;
begin
  InputBits.Caption := '';
  if IOWarrior.ReadFile(IOWarriorInputReport, IOWarrior.Caps.InputReportByteLength, BytesRead) then
    for I := Low(IOWarriorInputReport.IOBits) to High(IOWarriorInputReport.IOBits) do
      InputBits.Caption := InputBits.Caption + OrdToBinary(IOWarriorInputReport.IOBits[I]);
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -