Component TrayIcon

When I use this command on my program:

procedure TNucleo_TrayIcon.ShowBalloonTips(Titulo, MSG : String);
begin
  FData.cbSize := SizeOf(FData);
  FData.uFlags := NIF_INFO;
  strPLCopy(FData.szInfo, MSG, SizeOf(FData.szInfo) - 1);
  FData.DUMMYUNIONNAME.uTimeout := 3000;
  strPLCopy(FData.szInfoTitle, Titulo, SizeOf(FData.szInfoTitle) - 1);
  FData.dwInfoFlags := NIIF_INFO;     //NIIF_ERROR;  //NIIF_WARNING;
  Shell_NotifyIcon(NIM_MODIFY, @FData);
  FData.DUMMYUNIONNAME.uVersion := NOTIFYICON_VERSION;
  if not Shell_NotifyIcon(NIM_SETVERSION, @FData) then
  begin
    //ShowMessage('setversion fail');
  end;
end;


Before use this command above, it work normally but when i use it, Then this command below stop working:

  TrayIcon.MudaIcon(LoadIcon(hInstance,'CONECTADO'));

procedure TNucleo_TrayIcon.ModifyIcon;
begin
  if not (csDesigning in ComponentState) then
    Shell_NotifyIcon(NIM_MODIFY, @fData);
end;

Procedure TNucleo_TrayIcon.MudaIcon(Icon : HICON);
begin
    fData.hIcon := Icon;
    ModifyIcon;
end;
LVL 1
rafaelrglAsked:
Who is Participating?
 
mokuleCommented:
I've seen something like this

function GetIEVersion: Integer;
var
      Reg: HKey;
      s : String;
begin
      Result := 0;
      Reg := RegKeyOpenRead(HKEY_LOCAL_MACHINE,'Software\Microsoft\Internet Explorer');
      if Reg <> 0 then begin
            s := RegKeyGetStr(Reg,'Version');
            if Length(s) >= 1 then Result := Integer(s[1]);
            RegKeyClose(Reg);
      end;
end;


if GetIEVersion >= 6 then
begin
  // You can use new notify icon structure
end;

0
 
mokuleCommented:
Are You sure You've got proper IE version?
0
 
rafaelrglAuthor Commented:
no, how can i make shure about that?
0
Cloud Class® Course: C++ 11 Fundamentals

This course will introduce you to C++ 11 and teach you about syntax fundamentals.

 
rafaelrglAuthor Commented:
sorry for the late, so how will be this on my component code below mokule?

unit NTrayIcon;

interface

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

const
  NIF_INFO = $10;
  NIF_MESSAGE = 1;
  NIF_ICON = 2;
  NOTIFYICON_VERSION = 3;
  NIF_TIP = 4;
  NIM_SETVERSION = $00000004;
  NIM_SETFOCUS = $00000003;
  NIIF_INFO = $00000001;
  NIIF_WARNING = $00000002;
  NIIF_ERROR = $00000003;

  NIN_BALLOONSHOW = WM_USER + 2;
  NIN_BALLOONHIDE = WM_USER + 3;
  NIN_BALLOONTIMEOUT = WM_USER + 4;
  NIN_BALLOONUSERCLICK = WM_USER + 5;
  NIN_SELECT = WM_USER + 0;
  NINF_KEY = $1;
  NIN_KEYSELECT = NIN_SELECT or NINF_KEY;


  WM_CALLBACK_MESSAGE = WM_USER + 1;

 {new NotifyIconData structure definition}
type
  PNewNotifyIconData = ^TNewNotifyIconData;
  TDUMMYUNIONNAME    = record
    case Integer of
      0: (uTimeout: UINT);
      1: (uVersion: UINT);
  end;

  TNewNotifyIconData = record
    cbSize: DWORD;
    Wnd: HWND;
    uID: UINT;
    uFlags: UINT;
    uCallbackMessage: UINT;
    hIcon: HICON;
   //Version 5.0 is 128 chars, old ver is 64 chars
    szTip: array [0..127] of Char;
    dwState: DWORD; //Version 5.0
    dwStateMask: DWORD; //Version 5.0
    szInfo: array [0..255] of Char; //Version 5.0
    DUMMYUNIONNAME: TDUMMYUNIONNAME;
    szInfoTitle: array [0..63] of Char; //Version 5.0
    dwInfoFlags: DWORD;   //Version 5.0
  end;
 

type
  TNucleo_TrayIcon = class(TComponent)
  private
    fData: TNewNotifyIconData;
    fIcon: TIcon;
    fHint: string;
    fActiveTrayIcon : Boolean;
    fShowTrayIcon : Boolean;
    fPopupMenu: TPopupMenu;
    fOnClick: TNotifyEvent;
    fOnDblClick: TNotifyEvent;
    fOnMinimize: TNotifyEvent;
    fOnRestore: TNotifyEvent;

    fActivePosition : Boolean;
    procedure AddTrayIcon;
    procedure DeleteTrayIcon;
    { Private declarations }
  protected
    procedure SetHint(const Hint: string); virtual;
    procedure SetIcon(Icon: TIcon); virtual;
    procedure SetShowTrayIcon(Value : Boolean); virtual;
    procedure SetActiveTrayIcon(Value : Boolean); virtual;
    procedure AppMinimize(Sender: TObject);
    procedure AppRestore(Sender: TObject);
    procedure FormOpen;
    procedure FormClose;
    procedure DoMenu; virtual;
    procedure Click; virtual;
    procedure DblClick; virtual;
    procedure OnMessage(var Msg: TMessage); virtual;
    procedure EndSession; virtual;
    procedure SetActivePosition(Value : Boolean); virtual;
    procedure ModifyIcon; virtual;  //procedure Changed; virtual;
    property Data: TNewNotifyIconData read fData;


    { Protected declarations }
  public
     constructor create(aOwner : TComponent); override;
     destructor destroy; override;
     procedure MudaIcon(Icon : HICON);
     procedure Minimize; virtual;
     procedure Restore; virtual;
     procedure tbLoadFormStatus(Form: TForm; const Section: string);
     procedure tbSaveFormStatus(Form: TForm; const Section: string);
        //como usar///
        //tbLoadFormStatus(aOwner as TForm, (aOwner as TForm).Name);
        //tbSaveFormStatus(aOwner as TForm, (aOwner as TForm).Name);
        /////////////
     procedure ShowBalloonTips(Titulo, MSG : String);
     { Public declarations }
  published
    property ActiveTrayIcon : boolean read fActiveTrayIcon write SetActiveTrayIcon;
    property ShowTrayIcon : boolean read fShowTrayIcon write SetShowTrayIcon;
    property ActivePosition : boolean read fActivePosition write SetActivePosition;
    property Hint: string read fHint write SetHint;
    property Icon: TIcon read fIcon write SetIcon;
    property PopupMenu: TPopupMenu read fPopupMenu write fPopupMenu;
    property OnClick: TNotifyEvent read fOnClick write fOnClick;
    property OnDblClick: TNotifyEvent read fOnDblClick write fOnDblClick;
    property OnMinimize: TNotifyEvent read fOnMinimize write fOnMinimize;
    property OnRestore: TNotifyEvent read fOnRestore write fOnRestore;
    { Published declarations }
  end;

procedure Register;

implementation

constructor TNucleo_TrayIcon.Create(aOwner : TComponent);
begin
  inherited create(aOwner);
  If FactiveTrayIcon = True Then
  Begin
     AddTrayIcon;
     Application.OnMinimize := AppMinimize;
     Application.OnRestore  := AppRestore;
  End;
end;

destructor TNucleo_TrayIcon.destroy;
begin
  If FactiveTrayIcon = True Then
  Begin
     DeleteTrayIcon;
  End;  
  inherited destroy;
end;

procedure TNucleo_TrayIcon.FormOpen;
begin

end;

procedure TNucleo_TrayIcon.FormClose;
begin

end;

procedure TNucleo_TrayIcon.tbSaveFormStatus(Form: TForm; const Section: string);
var
  Ini: TIniFile;
  Maximized: boolean;
begin
  If not (csDesigning in ComponentState) Then
  Begin
     Ini := TIniFile.Create(ChangeFileExt(
     ExtractFileName(ParamStr(0)),'.INI'));
     try
        Maximized := Form.WindowState = wsMaximized;
        Ini.WriteBool(Section, 'Maximized', Maximized);
        if not Maximized then
        begin
           Ini.WriteInteger(Section, 'Left', Form.Left);
           Ini.WriteInteger(Section, 'Top', Form.Top);
           Ini.WriteInteger(Section, 'Width', Form.Width);
           Ini.WriteInteger(Section, 'Height', Form.Height);
        end;
     finally
        Ini.Free;
     end;
  end;
end;

procedure TNucleo_TrayIcon.tbLoadFormStatus(Form: TForm; const Section: string);
var
 Ini: TIniFile;
 Maximized: boolean;
begin
  If not (csDesigning in ComponentState) Then
  Begin
    Maximized := false; { Evita msg do compilador }
    Ini := TIniFile.Create(ChangeFileExt(
    ExtractFileName(ParamStr(0)),'.INI'));
    try
      Maximized := Ini.ReadBool(Section, 'Maximized', Maximized);
      Form.Left := Ini.ReadInteger(Section, 'Left', Form.Left);
      Form.Top := Ini.ReadInteger(Section, 'Top', Form.Top);
      Form.Width := Ini.ReadInteger(Section, 'Width', Form.Width);
      Form.Height := Ini.ReadInteger(Section, 'Height', Form.Height);
      if Maximized then
         Form.Perform(WM_SIZE, SIZE_MAXIMIZED, 0);
     finally
         Ini.Free;
     end;
  end;
end;


procedure TNucleo_TrayIcon.SetActivePosition(Value : Boolean);
begin
  //if (value <> fActivePosition) and not (csDesigning in ComponentState) then
  if value <> fActivePosition then
  Begin
      fActivePosition := Value;
  end;
end;

procedure TNucleo_TrayIcon.SetActiveTrayIcon(Value : Boolean);
begin
  if value <> fActiveTrayIcon then
  Begin
      fActiveTrayIcon := Value;
      If fActiveTrayIcon = True Then
      Begin
          AddTrayIcon;
      End Else Begin
          DeleteTrayIcon;
      End;
  end;
end;

procedure TNucleo_TrayIcon.ShowBalloonTips(Titulo, MSG : String);
begin
  FData.cbSize := SizeOf(FData);
  FData.uFlags := NIF_INFO;
  strPLCopy(FData.szInfo, MSG, SizeOf(FData.szInfo) - 1);
  FData.DUMMYUNIONNAME.uTimeout := 3000;
  strPLCopy(FData.szInfoTitle, Titulo, SizeOf(FData.szInfoTitle) - 1);
  FData.dwInfoFlags := NIIF_INFO;     //NIIF_ERROR;  //NIIF_WARNING;
  Shell_NotifyIcon(NIM_MODIFY, @FData);
  FData.DUMMYUNIONNAME.uVersion := NOTIFYICON_VERSION;
  if not Shell_NotifyIcon(NIM_SETVERSION, @FData) then
  begin
    //ShowMessage('setversion fail');
  end;
end;

procedure TNucleo_TrayIcon.EndSession;
begin
  Shell_NotifyIcon(Nim_Delete, @fData);
end;

procedure TNucleo_TrayIcon.OnMessage(var Msg: TMessage);
begin
  case Msg.Msg of
     Wm_QueryEndSession:
         Msg.Result := 1;
     Wm_EndSession:
         if TWmEndSession(Msg).EndSession then
             EndSession;
     Wm_Callback_Message:
         case Msg.lParam of
             WM_MOUSEMOVE:;
             WM_LBUTTONDOWN:;
             WM_LBUTTONUP:;
             WM_LBUTTONDBLCLK:
                 Begin
                    DblClick;
                 End;
             WM_RBUTTONDOWN:
                 Begin
                    DoMenu;
                 End;  
             WM_RBUTTONUP:;
             WM_RBUTTONDBLCLK:
                 Begin
                    DblClick;
                 End;
            WM_MBUTTONDBLCLK:
                 Begin
                    DblClick;
                 End;
             //followed by the new messages
             NIN_BALLOONSHOW:;
             {Sent when the balloon is shown}
             NIN_BALLOONHIDE:;
             {Sent when the balloon disappears?Rwhen the icon is deleted,
             for example. This message is not sent if the balloon is dismissed because of
             a timeout or mouse click by the user. }
             // ShowMessage('NIN_BALLOONHIDE');
             NIN_BALLOONTIMEOUT:;
             {Sent when the balloon is dismissed because of a timeout.}
             NIN_BALLOONUSERCLICK:
             {Sent when the balloon is dismissed because the user clicked the mouse.
             Note: in XP there's Close button on he balloon tips, when click the button,
             send NIN_BALLOONTIMEOUT message actually.}
             // ShowMessage('NIN_BALLOONUSERCLICK');
         end;
  end;
end;


procedure TNucleo_TrayIcon.AppMinimize(Sender: TObject);
begin
  Minimize;
end;

procedure TNucleo_TrayIcon.AppRestore(Sender: TObject);
begin
  Restore;
end;


procedure TNucleo_TrayIcon.SetHint(const Hint: string);
begin
  if fHint <> Hint then
  begin
    fHint := Hint;
    StrPLCopy(fData.szTip, Hint, SizeOf(fData.szTip) - 1);
    if Hint <> '' then
    begin
      fData.uFlags := fData.uFlags or Nif_Tip
    end else begin
      fData.uFlags := fData.uFlags and not Nif_Tip;
    end;
    ModifyIcon;
  end;
end;

procedure TNucleo_TrayIcon.SetIcon(Icon: TIcon);
begin
  if fIcon <> Icon then
  begin
    fIcon.Assign(Icon);
    fData.hIcon := Icon.Handle;
    ModifyIcon;
  end;
end;

procedure TNucleo_TrayIcon.DoMenu;
var
  Pt: TPoint;
begin
  if (fPopupMenu <> nil) and not IsWindowVisible(Application.Handle) then
  begin
    GetCursorPos(Pt);
    fPopupMenu.Popup(Pt.X, Pt.Y);
  end;
end;

procedure TNucleo_TrayIcon.Click;
begin
  if Assigned(fOnClick) then
    fOnClick(Self);
end;

procedure TNucleo_TrayIcon.DblClick;
begin
  if Assigned(fOnDblClick) then
    fOnDblClick(Self);
end;



procedure TNucleo_TrayIcon.Minimize;
begin
  If FActiveTrayIcon = True Then
  Begin
      ShowWindow(Application.Handle, SW_HIDE);
      if Assigned(fOnMinimize) then
      begin
         fOnMinimize(Self);
      End;
  End;
end;

procedure TNucleo_TrayIcon.Restore;
begin
  If FActiveTrayIcon = True Then
  Begin
     ShowWindow(Application.Handle, SW_RESTORE);
     if Assigned(fOnRestore) then
     begin
        fOnRestore(Self);
        Application.BringToFront;
     end;
  End;
end;


procedure TNucleo_TrayIcon.ModifyIcon;
begin
  if not (csDesigning in ComponentState) then
    Shell_NotifyIcon(NIM_MODIFY, @fData);
end;

procedure TNucleo_TrayIcon.SetShowTrayIcon(Value : Boolean);
begin
  if value <> fShowTrayIcon then
  Begin
     fShowTrayIcon := Value;
     If not (csDesigning in ComponentState) then
     Begin
        If FShowTrayIcon = True Then
        Begin
           Shell_NotifyIcon(NIM_ADD,@FData);
        End Else Begin
           Shell_NotifyIcon(NIM_DELETE, @fData);
        End;
        //ModifyIcon;
     End;
   End;

end;

procedure TNucleo_TrayIcon.AddTrayIcon;
Begin
  if not (csDesigning in ComponentState) then
  begin
    fIcon := TIcon.Create;
    fIcon.Assign(Application.Icon);
    FillChar(fData, SizeOf(fData), 0);
    fData.cbSize := SizeOf(fData);
    fData.Wnd  := AllocateHwnd(OnMessage);
    fData.hIcon  := Icon.Handle;
    StrPLCopy(fData.szTip, Application.Title, SizeOf(fData.szTip) - 1);
    fData.uFlags := Nif_Icon or Nif_Message;
    if Application.Title <> '' then
      fData.uFlags := fData.uFlags or Nif_Tip;
    fData.uCallbackMessage := WM_CALLBACK_MESSAGE;
    if not Shell_NotifyIcon(NIM_ADD, @fData) then
      raise EOutOfResources.Create('Nao foi possivel criar icone no Shell');
  end;
End;

procedure TNucleo_TrayIcon.DeleteTrayIcon;
Begin
  if not (csDesigning in ComponentState) then
  begin
    fIcon.Free;
    Shell_NotifyIcon(Nim_Delete, @fData);
  end;
End;

Procedure TNucleo_TrayIcon.MudaIcon(Icon : HICON);
begin
    fData.hIcon := Icon;
    ModifyIcon;
end;


procedure Register;
begin
  RegisterComponents('Nucleo', [TNucleo_TrayIcon]);
end;

end.
 
0
 
rafaelrglAuthor Commented:
i'm waiting answer.
0
 
rafaelrglAuthor Commented:
mokule, waiting comments...
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.