Question

我的问题是如何在我们的项目中使用如下的单位组件。我安装了以下组件，但我不能再使用它了。我做的所有事情是：1-创建一个包2-添加单元到包3-，右键单击其调色板中的包名称我选择构建，然后在下一步中我安装4-下一步我去组件菜单，我选择安装组件，而不是通过选择单位和存在包在下一页我添加包名称，然后单击完成。听起来所有的东西都很好，但是我无法调用它，安装后它不会出现在工具托盘中。

基本上我总是遇到安装和使用这样的组件的问题......

 unit U_Usb;

 interface

uses
Windows, Messages, SysUtils, Classes, Forms;

type

PDevBroadcastHdr = ^DEV_BROADCAST_HDR;
DEV_BROADCAST_HDR = packed record
dbch_size: DWORD;
dbch_devicetype: DWORD;
dbch_reserved: DWORD;
end;

PDevBroadcastDeviceInterface = ^DEV_BROADCAST_DEVICEINTERFACE;
 DEV_BROADCAST_DEVICEINTERFACE = record
 dbcc_size: DWORD;
 dbcc_devicetype: DWORD;
 dbcc_reserved: DWORD;
  dbcc_classguid: TGUID;
  dbcc_name: short;
 end;

const
  GUID_DEVINTERFACE_USB_DEVICE: TGUID = '{A5DCBF10-6530-11D2-901F-00C04FB951ED}';
  DBT_DEVICEARRIVAL = $8000; // system detected a new device
  DBT_DEVICEREMOVECOMPLETE = $8004; // device is gone
  DBT_DEVTYP_DEVICEINTERFACE = $00000005; // device interface class

type

 TComponentUSB = class(TComponent)
   private
   FWindowHandle: HWND;
   FOnUSBArrival: TNotifyEvent;
   FOnUSBRemove: TNotifyEvent;
   procedure WndProc(var Msg: TMessage);
   function USBRegister: Boolean;
   protected
   procedure WMDeviceChange(var Msg: TMessage); dynamic;
  public
  constructor Create(AOwner: TComponent); override;
  destructor Destroy; override;
  published
    property OnUSBArrival: TNotifyEvent read FOnUSBArrival write FOnUSBArrival;
    property OnUSBRemove: TNotifyEvent read FOnUSBRemove write FOnUSBRemove;
  end;

  implementation

constructor TComponentUSB.Create(AOwner: TComponent);
   begin
     inherited Create(AOwner);
     FWindowHandle := AllocateHWnd(WndProc);
     USBRegister;
   end;

   destructor TComponentUSB.Destroy;
    begin
   DeallocateHWnd(FWindowHandle);
    inherited Destroy;
   end;

 procedure TComponentUSB.WndProc(var Msg: TMessage);
     begin
     if (Msg.Msg = WM_DEVICECHANGE) then
      begin
      try
      WMDeviceChange(Msg);
    except
  Application.HandleException(Self);
   end;
   end
  else
     Msg.Result := DefWindowProc(FWindowHandle, Msg.Msg, Msg.wParam, Msg.lParam);
   end;

  procedure TComponentUSB.WMDeviceChange(var Msg: TMessage);
   var
   devType: Integer;
     Datos: PDevBroadcastHdr;
   begin
    if (Msg.wParam = DBT_DEVICEARRIVAL) or (Msg.wParam = DBT_DEVICEREMOVECOMPLETE) then
    begin
  Datos := PDevBroadcastHdr(Msg.lParam);
    devType := Datos^.dbch_devicetype;
     if devType = DBT_DEVTYP_DEVICEINTERFACE then
    begin // USB Device
     if Msg.wParam = DBT_DEVICEARRIVAL then
     begin
      if Assigned(FOnUSBArrival) then
       FOnUSBArrival(Self);
       end
        else
      begin
     if Assigned(FOnUSBRemove) then
      FOnUSBRemove(Self);
   end;
  end;
   end;
  end;

  function TComponentUSB.USBRegister: Boolean;
    var
      dbi: DEV_BROADCAST_DEVICEINTERFACE;
       Size: Integer;
     r: Pointer;
      begin
     Result := False;
     Size := SizeOf(DEV_BROADCAST_DEVICEINTERFACE);
      ZeroMemory(@dbi, Size);
      dbi.dbcc_size := Size;
      dbi.dbcc_devicetype := DBT_DEVTYP_DEVICEINTERFACE;
     dbi.dbcc_reserved := 0;
     dbi.dbcc_classguid := GUID_DEVINTERFACE_USB_DEVICE;
     dbi.dbcc_name := 0;

     r := RegisterDeviceNotification(FWindowHandle, @dbi,
      DEVICE_NOTIFY_WINDOW_HANDLE
     );
      if Assigned(r) then Result := True;
    end;

    end.

Answer 1

您所拥有的单位没有Register程序。这是一个能够将组件安装到IDE中的要求。

安装软件包时，任何在界面中找到Register过程的单元将在“安装”软件包时调用此Register过程。在那里，然后调用RegisterComponents来实际将组件安装到IDE中。

看起来应该是这样的：

...

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('My Components', [TComponentUSB]);
end;

...

请记住，Register程序不一定需要在同一个单元中。具有许多组件的包的正常设计是在设计时包中具有单个单元，其具有唯一的Register过程。其余具有实际组件的单元可能是设计时包需要的单独运行时包的一部分。

此外，您可以在一个单元中包含许多组件。只有您RegisterComponents调用的那些内容才会安装到您的IDE中。

不要忘记在IDE的Library Path中包含此单元的位置。

安装单个单元类型

1 个答案: