win xp style bobler i systray

prøv den her :
unit TrayStuff;

interface

uses
  SysUtils, Windows, ShellAPI;


type
  NotifyIconData_50 = record // defined in shellapi.h
    cbSize: DWORD;
    Wnd: HWND;
    uID: UINT;
    uFlags: UINT;
    uCallbackMessage: UINT;
    hIcon: HICON;
    szTip: array[0..MAXCHAR] of AnsiChar;
    dwState: DWORD;
    dwStateMask: DWORD;
    szInfo: array[0..MAXBYTE] of AnsiChar;
    uTimeout: UINT; // union with uVersion: UINT;
    szInfoTitle: array[0..63] of AnsiChar;
    dwInfoFlags: DWORD;
  end{record};

const
  NIF_INFO      =      $00000010;
  NIIF_NONE    =      $00000000;
  NIIF_INFO    =      $00000001;
  NIIF_WARNING  =      $00000002;
  NIIF_ERROR    =      $00000003;



type
  TBalloonTimeout = 10..30{seconds};
  TBalloonIconType = (bitNone,    // no icon
                      bitInfo,    // information icon (blue)
                      bitWarning, // exclamation icon (yellow)
                      bitError);  // error icon (red)

function RemoveTrayIcon((*const Window: HWND;*) const IconID: Byte): Boolean;
function AddTrayIconMsg(const Window: HWND; const IconID: Byte; const Icon: HICON; const Msg: Cardinal; const Hint: String = ''): Boolean;
function AddTrayIcon(const Window: HWND; const IconID: Byte; const Icon: HICON; const Hint: String = ''): Boolean;
function BalloonTrayIcon(const Timeout: TBalloonTimeout; const BalloonText, BalloonTitle: String; const BalloonIconType: TBalloonIconType): Boolean;

var
  NID_50 : NotifyIconData_50;

implementation


function AddTrayIcon(const Window: HWND; const IconID: Byte; const Icon: HICON; const Hint: String = ''): Boolean;
begin
  FillChar(NID_50, SizeOf(NotifyIconData_50), 0);
  with NID_50 do
  begin
    cbSize := SizeOf(NotifyIconData_50);
    Wnd := Window;
    uID := IconID;
    if Hint = '' then begin
      uFlags := NIF_ICON;
    end{if} else begin
      uFlags := NIF_ICON or NIF_TIP;
      StrPCopy(szTip, Hint);
    end{else};
    hIcon := Icon;
  end{with};
  Result := Shell_NotifyIcon(NIM_ADD, @NID_50);
end;

function AddTrayIconMsg(const Window: HWND; const IconID: Byte; const Icon: HICON; const Msg: Cardinal; const Hint: String = ''): Boolean;
begin
  FillChar(NID_50, SizeOf(NotifyIconData_50), 0);
  with NID_50 do
  begin
    cbSize := SizeOf(NotifyIconData_50);
    Wnd := Window;
    uID := IconID;
    if Hint = '' then
    begin
      uFlags := NIF_ICON or NIF_MESSAGE;
    end{if}
    else
    begin
      uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
      StrPCopy(szTip, Hint);
    end{else};
    uCallbackMessage := Msg;
    hIcon := Icon;
  end{with};
  Result := Shell_NotifyIcon(NIM_ADD, @NID_50);
end;

{removes an icon}
function RemoveTrayIcon((*const Window: HWND;*) const IconID: Byte): Boolean;
begin
///  FillChar(NID, SizeOf(NotifyIconData), 0);
  with NID_50 do
  begin
//    cbSize := SizeOf(NotifyIconData);
//    Wnd := Window;
    uID := IconID;
  end{with};
  Result := Shell_NotifyIcon(NIM_DELETE, @NID_50);
end;


function BalloonTrayIcon(const Timeout: TBalloonTimeout; const BalloonText, BalloonTitle: String; const BalloonIconType: TBalloonIconType): Boolean;
const
  aBalloonIconTypes : array[TBalloonIconType] of Byte = (NIIF_NONE, NIIF_INFO, NIIF_WARNING, NIIF_ERROR);
begin
// FillChar(NID_50, SizeOf(NotifyIconData_50), 0);
  with NID_50 do
  begin
//    cbSize := SizeOf(NotifyIconData_50);
//    Wnd := Window;
//    uID := IconID;
    uFlags := NIF_INFO;
    StrPCopy(szInfo, BalloonText);
    uTimeout := Timeout * 1000;
    StrPCopy(szInfoTitle, BalloonTitle);
    dwInfoFlags := aBalloonIconTypes[BalloonIconType];
  end{with};
  Result := Shell_NotifyIcon(NIM_MODIFY, @NID_50);
end;


end.

Jens b

NÅ HER ER SÅ EN LILLE BRUGS VEJLEDNING :

1)
  uses TrayStuff
2)
  Definer en konstant i toppen af din unit med din form :
const
  WM_ICONMESSAGE = WM_USER + 1;

3)
  Lave en Message handler for WM_ICONMESSAGE

type
  TMain = class(TJBForm)
  .....
  private
    ...
    procedure IconTray(var Msg: TMessage); message WM_ICONMESSAGE;
  public
    ....
  end;

4)
  Impelmter din message handler. Hvis du vil have dit icon til reagere på museklik så noget alla det her :

procedure TMain.IconTray(var Msg: TMessage);
var
  Pt: TPoint;
begin
  case Msg.lParam of
    WM_LBUTTONDBLCLK:
      begin
        Show;
        SetWindowPos(Application.Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_SHOWWINDOW);
      end;
    WM_RBUTTONDOWN:
      begin
        GetCursorPos(Pt);
        PopupMenu1.Popup(Pt.x, Pt.y);
      end;
  end;
end;
 
5)
  i form create  skrives fx :
 
  AddTrayIconMsg(Handle, 1, Application.Icon.Handle, WM_ICONMESSAGE, 'Hest');
  BalloonTrayIcon(10, 'Heste er sjove', 'Hest & Co.', bitInfo);

6)
  Lav en onclose handler der gemmer din applikation :

procedure TMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Hide;
end;

7)
  i From destroy skal du lige huske at ryde op :
procedure TMain.FormDestroy(Sender: TObject);
begin
  RemoveTrayIcon(1);
end;


Jens B

hmm, ikonet fungerer fint, også ballonen, men msghandlingen ikke, den eneste forskel jeg har fra din implementation, er at TMain = class(TForm)

virker denne i din egen implementation? Jeg kan desværre ikke bruge denne løsning til noget, hvis eventhandling ikke fungerer.

Nu er det svært at afhjælpe et problem man ikke kan få at vide hvad er ....

Jeg prøver lige min egen fremgangs måde .... Hvis det virker har vi lokaliseret fejlen !

Jens B

Det fungerer over alt forventning !!!

Du skal selv komme en Popupmenu på ! Og Du skla selv finde ud af hvad der skal være af menu punkter !

Her er min test :

unit Unit1;

interface

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

const
  WM_ICONMESSAGE = WM_USER + 1;

type
  TForm1 = class(TForm)
    PopupMenu1: TPopupMenu;
    EMessage1: TMenuItem;
    N2: TMenuItem;
    ShowEMessage1: TMenuItem;
    Hide1: TMenuItem;
    Close1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDestroy(Sender: TObject);
  private
    procedure IconTray(var Msg: TMessage); message WM_ICONMESSAGE;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

procedure TForm1.IconTray(var Msg: TMessage);
var
  Pt: TPoint;
begin
  case Msg.lParam of
    WM_LBUTTONDBLCLK:
      begin
        Show;
        SetWindowPos(Application.Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_SHOWWINDOW);
      end;
    WM_RBUTTONDOWN:
      begin
        GetCursorPos(Pt);
        PopupMenu1.Popup(Pt.x, Pt.y);
      end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  AddTrayIconMsg(Handle, 1, Application.Icon.Handle, WM_ICONMESSAGE, 'Hest');
  BalloonTrayIcon(10, 'Heste er sjove', 'Hest & Co.', bitInfo);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Hide;
  Action := caNone;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  RemoveTrayIcon(1);
end;

end.


Jens B

Hent CoolTrayIcon fra torry.net. Det kan både lave (animerede) trayikoner og ballon ting.

Hilsen Mark

Prøv at kigge lidt på THTMLHint fra www.tmssoftware.com