?
Solved

Component TrayIcon

Posted on 2007-07-23
6
Medium Priority
?
318 Views
Last Modified: 2010-04-05
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;
0
Comment
Question by:rafaelrgl
  • 4
  • 2
6 Comments
 
LVL 17

Expert Comment

by:mokule
ID: 19554996
Are You sure You've got proper IE version?
0
 
LVL 1

Author Comment

by:rafaelrgl
ID: 19560821
no, how can i make shure about that?
0
 
LVL 17

Accepted Solution

by:
mokule earned 2000 total points
ID: 19563437
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
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
LVL 1

Author Comment

by:rafaelrgl
ID: 19640256
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
 
LVL 1

Author Comment

by:rafaelrgl
ID: 19687449
i'm waiting answer.
0
 
LVL 1

Author Comment

by:rafaelrgl
ID: 19731488
mokule, waiting comments...
0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
This video shows how to quickly and easily deploy an email signature for all users in Office 365 and prevent it from being added to replies and forwards. (the resulting signature is applied on the server level in Exchange Online) The email signat…
Is your data getting by on basic protection measures? In today’s climate of debilitating malware and ransomware—like WannaCry—that may not be enough. You need to establish more than basics, like a recovery plan that protects both data and endpoints.…
Suggested Courses
Course of the Month16 days, 7 hours left to enroll

862 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question