traycreate.~pas

SMGSession,一个短信网关接口代码

unit TrayCreate;

interface

Uses
  Windows, Messages,shellapi,SysUtils,Classes,Controls, Forms,Menus,Graphics;

const
  WM_SMAS_TRAYMESSAGE=WM_USER+999;

type
    TSetTray=class(TComponent)
    private
      FHandle:THandle;
      FPopMenu:TPopupMenu;
      FForm:TForm;
      FIcon:TIcon;
      FHint:String;
      FVisible:Boolean;
      TrayStru:TNotifyIconData;
      IsSetTray:boolean;

      procedure SetIcon(aIcon:TIcon);
      procedure DoWinExitMsg(var Msg:TMessage);message   WM_QUERYENDSESSION ;
      procedure DoTrayClickMsg(var Msg:TMessage);message WM_SMAS_TRAYMESSAGE;
      procedure OnFormCreate(sender:TObject);
    protected
      procedure WndProc(var Msg:TMessage);
    published
      property PopupMenu:TPopupMenu read FPopMenu write FPopMenu stored true;
      property Icon:TIcon read FIcon write SetIcon  stored true;
      property Hint:string read FHint write FHint;
      property MainForm:TForm read FForm write FForm;
      property Visible:Boolean read FVisible write FVisible;
    public
      property Handle:THandle read FHandle;
      procedure SetTray;
      procedure IniTray;
      Constructor Create(AOwner:TComponent);override;
      destructor Destroy;override;
  end;

implementation

uses IDDef;
{ TSetTray }
constructor TSetTray.create(AOwner: TComponent);
begin
  inherited;
  FHandle:=AllocateHwnd(WndProc);

  FIcon := TIcon.Create;
  FIcon.Width := GetSystemMetrics(SM_CXSMICON);
  FIcon.Height := GetSystemMetrics(SM_CYSMICON);
  FIcon.Assign(Application.Icon);
  FVisible:=true;

  if AOwner is TForm then
    FForm:=AOwner as TForm
  else raise Exception.Create('这个控件只能放在主窗体上！');

  IsSetTray:=false;
end;

destructor TSetTray.Destroy;
begin
  if IsSetTray then
    Shell_NotifyIcon(NIM_DELETE,@TrayStru);

  if FHandle<>0 then
    DeallocateHWnd(FHandle);
  inherited;
end;

procedure TSetTray.DoTrayClickMsg(var Msg: TMessage);
 var
  pos:TPoint;
begin
  case Msg.LParam of
    WM_RBUTTONDOWN:begin
                     if PopupMenu<>nil then
                     begin
                       GetCursorPos(pos);
                       PopupMenu.Popup(pos.x,pos.y);
                     end;
                   end;

    WM_LBUTTONDBLCLK:begin
                       if (FForm<>nil) and Visible then
                       begin
                         GetCursorPos(pos);
                         FForm.Left:=pos.X-FForm.Width;
                         FForm.Top:=pos.Y-FForm.Height;
                         FForm.Visible:=not FForm.Visible;
                       end;
                     end;
  end;
end;

procedure TSetTray.DoWinExitMsg(var Msg: TMessage);
begin
  Msg.Result :=1;
  Application.Terminate;
end;

procedure TSetTray.IniTray;
begin
  SetTray;
  FForm.Visible:=False;
  Application.ShowMainForm:=False;
  SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);
end;

procedure TSetTray.OnFormCreate(sender: TObject);
var
  oldCreate:TNotifyEvent;
begin
  IniTray;

  FForm.OnCreate(FForm);
end;

procedure TSetTray.SetIcon(aIcon: TIcon);
begin
  FIcon.Assign(aIcon);
  if not (csDesigning in Self.ComponentState) then
    SetTray;
end;

procedure TSetTray.SetTray;
begin
  with TrayStru do
  begin
    cbSize:=sizeof(TNotifyIconData);
    Wnd:=Handle;
    uID:=1;
    uFlags:=NIF_ICON or NIF_TIP or NIF_MESSAGE;
    uCallbackMessage:=WM_SMAS_TRAYMESSAGE;
    hIcon:=Icon.Handle;
    Move(Pointer(@Hint[1])^,szTip,Length(Trim(Hint)));
  end;
  Shell_NotifyIcon(NIM_ADD,@TrayStru);

  IsSetTray:=true;
end;

procedure TSetTray.WndProc(var Msg: TMessage);
begin
  try
    Dispatch(Msg);
  except
    Application.HandleException(Self);
  end;
end;


end.