安装新组件

看过一篇一个简单组件的制作过程：地址  http://www.openitpower.com/wenzhang/97/10420_1.html

安装组件如下（安装托盘组件为例）
1. 新建一个单元保存名称AppTrayIcon.pas ，复制如下代码到此单元中，保存。
2.Component—>install Component
Unit File name 就是刚才新建的单元AppTrayIcon.pas，点ok就可以了

unit AppTrayIcon;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs,Menus,ShellAPI;

type
  TRDownEvent  =  procedure (Sender: TObject;Pos:TPoint) of  object ;
  TAppTrayIcon  =  class(TComponent)
   private
    {  Private  declarations }
    FNotiFicationHandle : HWnd;
    FTrayIcon : TIcon;
    FShowHint :  Boolean ;
    FHint :  String ;
    FActive :  Boolean ;
    FCurrentlyActive :  Boolean ;
    FOnDblClick : TNotifyEvent;
    FOnRDown : TRDownEvent;
    FPopupMenu: TPopupMenu;

    Procedure NotificationWndProc(Var Message : TMessage);
    Procedure SetShowHint( Const  Value :  Boolean );
    Procedure SetHint( const  Value :  String );
    Procedure SetTrayIcon( const  Value : TIcon);
    Procedure SetActive( Const  Value :  Boolean );
    Procedure SetPopupMenu( const  Value :TPopupMenu);
//     Procedure SetPopUpPos( Const  Pos : TPoint);
  protected
    { Protected declarations }
    Procedure DoDblClick;
    Procedure DoRDown(pos:TPoint);
    Procedure Loaded;override;
    Procedure OnAppMinimize(Sender : TObject);
     Function  SendTrayMessage(AMessage:DWORD): Boolean ;

   public
    {  Public  declarations }
    Constructor Create(AOwner : TComponent);Override;
    Destructor Destroy;override;
    Procedure RemoveTrayIcon;
    Procedure RestoreApp;
    Procedure ShowTrayIcon;
    Procedure RemoveFromTaskBar;
    Procedure ShowInTaskBar;
  published
    { Published declarations }
     Property  Active :  Boolean  read FActive write SetActive;
     Property  Hint :  String  read FHint write SetHint;
     Property  OnDblClick : TNotifyEvent read FOnDblClick write FOnDblClick;
     Property  PopUpMenu : TPopupMenu read FPopupMenu write SetPopupMenu;
     Property  ShowHint :  Boolean  read FShowHint write SetShowHint;
     Property  TrayIcon : TIcon read FTrayIcon write SetTrayIcon;
     Property  OnRDown : TRDownEvent read FOnRDown write FOnRDown;
   end ;

procedure Register;

implementation

const
ID_TRAYICON  =   1 ;
UWM_TRAYICON  =  WM_USER  +   1 ;

procedure Register;
begin
  RegisterComponents( ' TrayIcon', [TAppTrayIcon]);
end ;

{ TAppTrayIcon }

constructor TAppTrayIcon.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FNotificationHandle : =  AllocateHWnd(NotificationWndProc);
  FTrayIcon : =  TIcon.Create;
  Application.OnMinimize : =  OnAppMinimize;
end ;

destructor TAppTrayIcon.Destroy;
begin
   if  FCurrentlyActive  then
    RemoveTrayIcon;

  FTrayIcon.Free;

   if  FNotificationHandle  <>   0   then
    DeallocateHWnd(FNotificationHandle);
  inherited Destroy;
end ;

procedure TAppTrayIcon.DoDblClick;
begin
   if  Assigned(OnDBlClick) then
    OnDblClick(Self);
end ;

procedure TAppTrayIcon.DoRDown(pos:TPoint);
begin
   if  Assigned(Onrdown) then
    OnRDown(Self,pos);
end ;

procedure TAppTrayIcon.Loaded;
begin
  inherited Loaded;
   if   not  (csDesigning in ComponentState)  then
  begin
     if  FTrayIcon.Handle  =   0   then
      FTrayIcon.Assign(Application.Icon)
   end ;

  SetTrayIcon(FTrayIcon);

   if  FActive  then
    ShowTrayIcon;
end ;

procedure TAppTrayIcon.NotificationWndProc(var Message: TMessage);
Var
  Pt:TPoint;
begin
   if  Message.Msg  =  UWM_TRAYICON  then
  begin
     case  Message.LParam of
      WM_LBUTTONDBLCLK:
        DoDblClick;
      WM_RBUTTONDOWN:
      begin
        GetCursorPos(Pt);
         if  Assigned(FPopupMenu)  then
        begin
           // RestoreApp;
          GetCursorPos(Pt);
          FPopupMenu.Popup(Pt.X ,Pt.Y);
         end ;
        DoRDown(Pt);
       end ;
     end ;
   end ;
end ;

procedure TAppTrayIcon.OnAppMinimize(Sender: TObject);
begin
   if  FCurrentlyActive  then
    RemoveFromTaskBar;
end ;

procedure TAppTrayIcon.RemoveFromTaskBar;
begin
   if   not (csDesigning in ComponentState)  then
  begin
    SendTrayMessage(NIM_ADD);
    ShowWindow(Application.Handle,SW_HIDE);
    ShowWindow(Application.MainForm.Handle,SW_HIDE);
   end ;
end ;

procedure TAppTrayIcon.RemoveTrayIcon;
begin
   if  FCurrentlyActive  then
     if  SendTrayMessage(NIM_DELETE)  then
    begin
      FCurrentlyActive : =   False ;
      ShowInTaskBar;
     end ;
end ;

procedure TAppTrayIcon.RestoreApp;
var
  wnd: HWND;
  child: HWND;
begin
  ShowInTaskBar;
  Application.MainForm.Visible : =   True ;
  child : =  Application.MainForm.Handle;
  wnd : =  child;
   while  child  <>   0   do
  begin
    wnd : =  child;
    child : =  GetTopWindow(wnd);
   end ;
  SetForeGroundWindow(wnd);
  BringWindowToTop(wnd);
  Application.BringToFront;
  SetFocus(Application.MainForm.Handle);
end ;

function  TAppTrayIcon.SendTrayMessage(AMessage: DWORD):  Boolean ;
Var
  Flags :  Integer ;
  NotifyIconData : TNotifyIconData;
begin
  Result : =   True ;
   if  csDesigning in ComponentState  then
     exit ;
  Flags : =  NIF_MESSAGE  or  NIF_ICON;
   if  FShowHint  then
    Flags : =  Flags  or  NIF_TIP;
  FillChar(NOtifyIconData,Sizeof(NotifyIconData), 0 );
   with  NotifyIconData  do
  begin
    cbSize : =  sizeof(TNotifyIconData);
    Wnd : =  FNotificationHandle;
    uID : =  ID_TRAYICON;
    uFlags : =  Flags;
    uCallBackMessage : =  UWM_TRAYICON;
    hIcon : =  FTrayIcon.Handle;
    StrLCopy(szTip,PChar(FHint),Sizeof(szTip));
   end ;
  Result : =  Shell_NotifyIcon(AMessage,@NotifyIconData);
end ;

procedure TAppTrayIcon.SetActive( const  Value:  Boolean );
begin
  FActive : =  Value;
   if  FActive  then
    ShowTrayIcon
   else
    RemoveTrayIcon;
end ;

procedure TAppTrayIcon.SetHint( const  Value:  String );
begin
  FHint : =  Value;
  SendTrayMessage(NIM_MODIFY);
end ;

procedure TAppTrayIcon.SetPopupMenu( const  Value: TPopupMenu);
begin
  FPopupMenu : =  Value;
end ;

procedure TAppTrayIcon.SetShowHint( const  Value:  Boolean );
begin
  FShowHint : =  Value;
  SendTrayMessage(NIM_MODIFY);
end ;

procedure TAppTrayIcon.SetTrayIcon( const  Value: TIcon);
begin
  FTrayIcon.Assign(Value);
  SendTrayMessage(NIM_MODIFY);
end ;

procedure TAppTrayIcon.ShowInTaskBar;
begin
   if   Not (csDesigning in ComponentState)  then
  begin
     if  Application.MainForm  <>  nil  then
      ShowWindow(Application.MainForm.Handle,SW_SHOWNORMAL);
  //    ShowWindow(Application.Handle,SW_RESTORE);
    ShowWindow(Application.Handle,SW_SHOWNORMAL);
   end ;
end ;

procedure TAppTrayIcon.ShowTrayIcon;
begin
   if  SendTrayMessage(NIM_ADD)  then
    FCurrentlyActive : =   True ;
end ;

end .

转载于:https://www.cnblogs.com/sideandside/archive/2007/04/12/710603.html