?
Solved

My component dosent work

Posted on 2003-02-21
6
Medium Priority
?
593 Views
Last Modified: 2007-12-19
Hi..
I'm working on a komponent who should add a icon to systray and stuff like that..=)

I can add a icon but not delete my icon
I dont understand why cause my code work when i dont have it in a komponent..

here my code:

unit sysIcong;

interface

uses
 Windows, Messages, SysUtils, Classes,ShellApi,Menus;
     const WM_ICONTRAY = WM_USER + 1;
type
 TsysIcong = class(Tcomponent)
 private
   TrayIcon : TNotifyIconData;
   popup1:TPopupMenu;
   procedure TrayMessage(var Msg: TMessage); message WM_ICONTRAY;
 protected
 public
  procedure Add(icon: HICON;tooltiptext:string;hwnd:Thandle;popupmeny:TPopupMenu);
 published
 end;

procedure Register;

implementation

procedure Register;
begin
 RegisterComponents('bjs', [TsysIcong]);
end;

{ TsysIcong }

procedure TsysIcong.Add(icon: HICON; tooltiptext:string;hwnd:Thandle;popupmeny:TPopupMenu);
begin
//do i really have to show how i add my icon? ;)
end;


procedure TsysIcong.TrayMessage(var Msg: TMessage);
begin
 case Msg.lParam of
   WM_LBUTTONDOWN:
   begin
     Shell_NotifyIcon(NIM_DELETE,@TrayIcon);
   end;
 end;
end;

end.

/bj
www.pellesoft.nu
0
Comment
Question by:beji
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 4
6 Comments
 
LVL 9

Expert Comment

by:mocarts
ID: 7993584
when debugging - do you receive that WM_LBUTTONDOWN message?
if not - check how you register icon i.e. ensure all parameters (hwnd, id (must be unique in context of app), callback, etc.) are valid
wbr, mo.
0
 

Author Comment

by:beji
ID: 7994536
procedure TsysIcong.Add(icon: HICON; tooltiptext:string;hwnd:Thandle;popupmeny:TPopupMenu);
begin
   Trayicon.cbSize := SizeOf(TNotifyIconData);
   Trayicon.Wnd := hwnd;
   Trayicon.szTip  := 'hmm';
   Trayicon.uID := 1;
   TrayIcon.hIcon := icon;
   TrayIcon.uCallbackMessage := WM_ICONTRAY;
   Trayicon.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
      Shell_NotifyIcon(NIM_ADD,@trayicon);
//for menu later:
      popup1 := popupmeny;
end;

there how i add my icon..

and one more question:
i cant do like this:
   Trayicon.szTip  := tooltiptext;
how should i do to get my text on "szTip" ?

/bj
www.pellesoft.nu
0
 

Author Comment

by:beji
ID: 7994548
ohh.. i forgot:

sysIcong1.Add(application.Icon.Handle,'text',form1.Handle,nil);

thats how i use my "add" procedure...;)

/bj
www.pellesoft.nu
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 

Author Comment

by:beji
ID: 7994635
ohh.. i forgot:

sysIcong1.Add(application.Icon.Handle,'text',form1.Handle,nil);

thats how i use my "add" procedure...;)

/bj
www.pellesoft.nu
0
 
LVL 34

Accepted Solution

by:
Slick812 earned 600 total points
ID: 7995600
hello beji, you may not get ANY windows messages in a TComponent, since it is not a WinControl. . .  you will need to get the messages from a WinControl or TForm or TApplication, , I used subclassing to get the messages, , here is some code for a Tray icon, maybe you can get some Ideas from it, I had trouble getting the Main Form to Subclass during creation, so I subclassed the Application




unit MyTrayIcon;

interface

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

type
  TMyTrayIcon = class(TComponent)
  private
    OldWndProc, NewWndProc: Pointer;
    fShow: Boolean;
    fTrayIcon: TIcon;
    fTrayMenu: TPopupMenu;
    fNIconData: TNotifyIconData;
    fOnLeftClick: TNotifyEvent;
    fOnDoubleClick: TNotifyEvent;
    procedure TrayWndProc(var Msg: TMessage);

  protected
    procedure SetShow(Value: Boolean);
    procedure SetIcon(Value: TIcon);
    procedure IconChange(Sender: TObject);
    procedure SetTrayHint(Value: String);
    function GetTrayHint: String;
    procedure SetTrayMenu(Value: TPopupMenu);
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Show: Boolean read fShow write SetShow default False;
    property TrayIcon: TIcon read fTrayIcon write SetIcon;
    property TrayHint: string read GetTrayHint write SetTrayHint;
    property TrayPopup: TPopupMenu read fTrayMenu write SetTrayMenu;
    property OnLeftClick: TNotifyEvent read fOnLeftClick write fOnLeftClick;
    property OnDoubleClick: TNotifyEvent read fOnDoubleClick write fOnDoubleClick;
  end;

procedure Register;

implementation

const
  WM_TrayMessage = WM_USER +543;

var
  CompCounterTMTI: Integer;


constructor TMyTrayIcon.Create(AOwner: TComponent);
begin
  // check if already created
Inc (CompCounterTMTI);
if CompCounterTMTI > 1 then
  raise Exception.Create('Only ONE TMyTrayIcon component is allowed');
inherited Create(AOwner);

  fShow := False;
  fTrayIcon := TIcon.Create;
  fTrayIcon.OnChange := IconChange;
  with fNIconData do
    begin
    cbSize := sizeof (fNIconData);
    Wnd := Application.Handle;
    uID := 1;
    uCallBackMessage := WM_TrayMessage;
    hIcon := Application.Icon.Handle;
    StrLCopy(szTip, PChar('Tip'), 64);
    uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
    end;

if not (csDesigning in ComponentState) then
  begin
  {subclass the Application to get Tray Message}
  NewWndProc := MakeObjectInstance(TrayWndProc);
  OldWndProc := Pointer(SetWindowLong(Application.Handle, GWL_WndProc, Integer(NewWndProc)));
  end else
  begin
  NewWndProc := nil;
  OldWndPRoc := nil;
  end;
end;

destructor TMyTrayIcon.Destroy;
begin
if Assigned(OldWndProc) then
SetWindowLong(Application.Handle, GWL_WndProc, Integer(OldWndProc));
Dec(CompCounterTMTI);
if fShow then
  Shell_NotifyIcon (NIM_DELETE, @fNIconData);
fTrayIcon.Free;
Inherited Destroy;
end;

procedure TMyTrayIcon.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
Inherited Notification (AComponent, Operation);
if (Operation = opRemove) and (AComponent = fTrayMenu) then
  fTrayMenu := nil;
end;

procedure TMyTrayIcon.SetShow(Value: Boolean);
begin
if Value <> fShow then
  begin
  fShow := Value;
  if not (csDesigning in ComponentState) then
    begin
    if fShow then
      Shell_NotifyIcon(NIM_ADD, @fNIconData)
      else
      Shell_NotifyIcon(NIM_DELETE, @fNIconData);
    end;
  end;
end;

procedure TMyTrayIcon.SetIcon(Value: TIcon);
begin
fTrayIcon.Assign(Value);
end;

procedure TMyTrayIcon.IconChange(Sender: TObject);
begin
if not (fTrayIcon.Empty) then
  fNIconData.hIcon := fTrayIcon.Handle
  else
  fNIconData.hIcon := Application.MainForm.Icon.Handle;
if fShow and not (csDesigning in ComponentState) then
    Shell_NotifyIcon (NIM_MODIFY, @fNIconData);
end;

function TMyTrayIcon.GetTrayHint: String;
begin
  Result := String(fNIconData.szTip);
end;

procedure TMyTrayIcon.SetTrayHint(Value: string);
begin
StrLCopy(fNIconData.szTip, PChar(Value), 64);
if fShow and not (csDesigning in ComponentState) then
  Shell_NotifyIcon(NIM_MODIFY, @fNIconData);
end;

procedure TMyTrayIcon.SetTrayMenu(Value: TPopupMenu);
begin
if Value <> fTrayMenu then
  begin
  fTrayMenu := Value;
  if Assigned (fTrayMenu) then
    fTrayMenu.FreeNotification(self);
  end;
end;

procedure TMyTrayIcon.TrayWndProc(var Msg: TMessage);
var
  Pnt1: TPoint;
begin
if (Msg.Msg = WM_TrayMessage) then
  begin
  if (Msg.lParam = WM_RButtonDown) and Assigned(fTrayMenu) then
    begin
    GetCursorPos (Pnt1);
    fTrayMenu.Popup (Pnt1.x, Pnt1.y);
    end;
  if (Msg.lParam = WM_LBUTTONUP) and Assigned(fOnLeftClick) then
    begin
    SetForegroundWindow(Application.MainForm.Handle);
    fOnLeftClick(Self);
    end;
  if (Msg.lParam = WM_LBUTTONDBLCLK) and Assigned(fOnDoubleClick) then
    begin
    SetForegroundWindow(Application.MainForm.Handle);
    fOnDoubleClick(Self);
    end;
  end;

Msg.Result := CallWindowProc(OldWndProc,
          Application.Handle, Msg.Msg, Msg.WParam, Msg.LParam);
end;

procedure Register;
begin
  RegisterComponents('Samples', [TMyTrayIcon]);
end;

initialization
  CompCounterTMTI := 0;
end.




- - - - - - - - - - - - - - - - - - - - -  -

Ask questions if you need more info
0
 

Author Comment

by:beji
ID: 7996229
I fixed with 5lines code..;)
thx Slick812 =D

/bj
www.pellesoft.nu
0

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
In this video you will find out how to export Office 365 mailboxes using the built in eDiscovery tool. Bear in mind that although this method might be useful in some cases, using PST files as Office 365 backup is troublesome in a long run (more on t…
Have you created a query with information for a calendar? ... and then, abra-cadabra, the calendar is done?! I am going to show you how to make that happen. Visualize your data!  ... really see it To use the code to create a calendar from a q…
Suggested Courses

752 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