devreader.pas

human interface devices.zip 一套组件

unit DevReader;

interface

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

type
  TReport = packed record
    ReportID: Byte;
    Bytes: array [0..63] of Byte;
  end;

  TMainForm = class(TForm)
    DevListBox: TListBox;
    HistoryListBox: TListBox;
    ReadBtn: TSpeedButton;
    WriteBtn: TSpeedButton;
    SaveBtn: TSpeedButton;
    SaveDialog: TSaveDialog;
    ReportID: TEdit;
    Edit1: TEdit;
    Label1: TLabel;
    HidCtl: TJvHidDeviceController;
    InfoBtn: TSpeedButton;
    ClearBtn: TSpeedButton;
    procedure HidCtlDeviceChange(Sender: TObject);
    function HidCtlEnumerate(HidDev: TJvHidDevice;
      const Idx: Integer): Boolean;
    procedure ReadBtnClick(Sender: TObject);
    procedure DevListBoxClick(Sender: TObject);
    procedure SaveBtnClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure WriteBtnClick(Sender: TObject);
    procedure InfoBtnClick(Sender: TObject);
    procedure HidCtlDeviceDataError(HidDev: TJvHidDevice; Error: Cardinal);
    procedure HidCtlArrival(HidDev: TJvHidDevice);
    procedure HidCtlRemoval(HidDev: TJvHidDevice);
    procedure ClearBtnClick(Sender: TObject);
  public
    Edits: array [0..63] of TEdit;
    CurrentDevice: TJvHidDevice;
    function DeviceName(HidDev: TJvHidDevice): string;
    procedure ShowRead(HidDev: TJvHidDevice; ReportID: Byte;
      const Data: Pointer; Size: Word);
    procedure AddToHistory(Str: string);
  end;

var
  MainForm: TMainForm;

implementation

uses
  Info;

{$R *.dfm}

procedure TMainForm.HidCtlDeviceChange(Sender: TObject);
var
  Dev: TJvHidDevice;
  I: Integer;
begin
  ReadBtn.Down := False;
  ReadBtnClick(Self);
  for I := 0 to DevListBox.Items.Count - 1 do
  begin
    Dev := TJvHidDevice(DevListBox.Items.Objects[I]);
    Dev.Free;
  end;
  DevListBox.Items.Clear;
  HidCtl.Enumerate;
  if DevListBox.Items.Count > 0 then
  begin
    DevListBox.ItemIndex := 0;
    DevListBoxClick(Self);
  end;
end;

function TMainForm.DeviceName(HidDev: TJvHidDevice): string;
begin
  if HidDev.ProductName <> '' then
    Result := HidDev.ProductName
  else
    Result := Format('Device VID=%.4x PID=%.4x',
      [HidDev.Attributes.VendorID, HidDev.Attributes.ProductID]);
  if HidDev.SerialNumber <> '' then
    Result := Result + Format(' (Serial=%s)', [HidDev.SerialNumber]);
end;

function TMainForm.HidCtlEnumerate(HidDev: TJvHidDevice;
  const Idx: Integer): Boolean;
var
  N: Integer;
  Dev: TJvHidDevice;
begin
  N := DevListBox.Items.Add(DeviceName(HidDev));
  HidCtl.CheckOutByIndex(Dev, Idx);
  DevListBox.Items.Objects[N] := Dev;
  Result := True;
end;

procedure TMainForm.DevListBoxClick(Sender: TObject);
var
  I: Integer;
  Dev: TJvHidDevice;
begin
  ReadBtn.Down := False;
  ReadBtnClick(Self);
  if (DevListBox.Items.Count > 0) and (DevListBox.ItemIndex >= 0) then
  begin
    Dev := TJvHidDevice(DevListBox.Items.Objects[DevListBox.ItemIndex]);
    for I := Low(Edits) to High(Edits) do
      Edits[I].Visible := False;
    for I := 0 to Dev.Caps.OutputReportByteLength - 2 do
      Edits[I].Visible := True;
    WriteBtn.Enabled := Dev.Caps.OutputReportByteLength <> 0;
  end;
end;

procedure TMainForm.AddToHistory(Str: string);
var
  N: Integer;
begin
  HistoryListBox.Canvas.Font := HistoryListBox.Font;
  N := HistoryListBox.Canvas.TextWidth(Str) + 16;
  if HistoryListBox.ScrollWidth < N then
    HistoryListBox.ScrollWidth := N;
  HistoryListBox.ItemIndex := HistoryListBox.Items.Add(Str);
end;

procedure TMainForm.ShowRead(HidDev: TJvHidDevice; ReportID: Byte;
  const Data: Pointer; Size: Word);
var
  I: Integer;
  Str: string;
begin
  Str := Format('R %.2x  ', [ReportID]);
  for I := 0 to Size - 1 do
    Str := Str + Format('%.2x ', [Cardinal(PChar(Data)[I])]);
  AddToHistory(Str);
end;

procedure TMainForm.HidCtlDeviceDataError(HidDev: TJvHidDevice; Error: Cardinal);
begin
  AddToHistory(Format('READ ERROR: %s (%x)', [SysErrorMessage(Error), Error]));
end;

procedure TMainForm.InfoBtnClick(Sender: TObject);
begin
  if (DevListBox.Items.Count > 0) and (DevListBox.ItemIndex >= 0) then
    with TInfoForm.Create(Self) do
    begin
      Dev := TJvHidDevice(DevListBox.Items.Objects[DevListBox.ItemIndex]);
      ShowModal;
      Free;
    end;
end;

procedure TMainForm.ReadBtnClick(Sender: TObject);
begin
  CurrentDevice := nil;
  if (DevListBox.Items.Count > 0) and (DevListBox.ItemIndex >= 0) then
  begin
    CurrentDevice := TJvHidDevice(DevListBox.Items.Objects[DevListBox.ItemIndex]);
    if not CurrentDevice.HasReadWriteAccess then
      ReadBtn.Down := False
    else
    if ReadBtn.Down then
      CurrentDevice.OnData := ShowRead
    else
      CurrentDevice.OnData := nil;
  end;
end;

procedure TMainForm.WriteBtnClick(Sender: TObject);
var
  I: Integer;
  Buf: array [0..64] of Byte;
  Written: Cardinal;
  ToWrite: Cardinal;
  Str: string;
  Err: DWORD;
begin
  if Assigned(CurrentDevice) then
  begin
    Buf[0] := StrToIntDef('$' + ReportID.Text, 0);
    ReportID.Text := Format('%.2x', [Buf[0]]);
    ToWrite := CurrentDevice.Caps.OutputReportByteLength;
    for I := 1 to ToWrite-1 do
    begin
      Buf[I] := StrToIntDef('$' + Edits[I-1].Text, 0);
      Edits[I-1].Text := Format('%.2x', [Buf[I]]);
    end;
    if not CurrentDevice.WriteFile(Buf, ToWrite, Written) then
    begin
      Err := GetLastError;
      AddToHistory(Format('WRITE ERROR: %s (%x)', [SysErrorMessage(Err), Err]));
    end
    else
    begin
      Str := Format('W %.2x  ', [Buf[0]]);
      for I := 1 to Written-1 do
        Str := Str + Format('%.2x ', [Buf[I]]);
      AddToHistory(Str);
    end;
  end;
end;

procedure TMainForm.SaveBtnClick(Sender: TObject);
begin
  ForceCurrentDirectory := True;
  if SaveDialog.Execute then
    HistoryListBox.Items.SaveToFile(SaveDialog.FileName);
end;

procedure TMainForm.FormActivate(Sender: TObject);
var
  I, J: Integer;
begin
  Edits[0] := Edit1;
  for I := 1 to High(Edits) do
    Edits[I] := TEdit.Create(Self);
  for J := 0 to 3 do
    for I := 0 to 15 do
      with Edits[J*16 + I] do
      begin
        Visible  := False;
        Left     := Edit1.Left + I*(Edit1.Width+2);
        Top      := Edit1.Top  + J*(Edit1.Height+2);
        Width    := Edit1.Width;
        Anchors  := Edit1.Anchors;
        if not Assigned(Parent) then
          Parent := Edit1.Parent;
        TabOrder := Edit1.TabOrder + J*16 + I;
      end;
  HidCtl.OnDeviceChange := HidCtlDeviceChange;
  DevListBoxClick(Self);
end;

procedure TMainForm.HidCtlArrival(HidDev: TJvHidDevice);
begin
  AddToHistory('Arrival of ' + DeviceName(HidDev));
end;

procedure TMainForm.HidCtlRemoval(HidDev: TJvHidDevice);
begin
  AddToHistory('Removal of ' + DeviceName(HidDev));
end;

procedure TMainForm.ClearBtnClick(Sender: TObject);
begin
  HistoryListBox.Items.Clear;
  HistoryListBox.ScrollWidth := 0;
end;

end.