Systray - colocar programa lah sem usar nenhum form

Top Previous Next

// exemplo 1/3

// este ocupa pouco espaco em disco: 40K

program teste1;

uses

Windows,

Messages,

ShellAPI,

sysutils;

{$R *.RES}

const

AppName = 'DeskTop Hide by Brian Slack';

var

x: integer;

tid: TNotifyIconData;

WndClass: array[0..50] of char;

procedure Panic (szMessage: PChar);

begin

if szMessage <> Nil then

MessageBox (0, szMessage, AppName, mb_ok);

Halt (0);

end;

procedure HandleCommand (Wnd: hWnd; Cmd: Word);

begin

case Cmd of

Ord ('E'): PostMessage (Wnd, wm_Close, 0, 0);

end;

function DummyWindowProc (Wnd: hWnd; Msg, wParam: Word; lParam: LongInt):

LongInt; stdcall;

var

TrayHandle: THandle;

dc: hDC;

//i: Integer;

pm: HMenu;

pt: TPoint;

begin

DummyWindowProc := 0;

StrPCopy(@WndClass[0], 'Progman');

TrayHandle := FindWindow(@WndClass[0], nil);

case Msg of

wm_Create: // Program initialisation - just set up a tray icon

begin

tid.cbSize := sizeof (tid);

tid.Wnd := Wnd;

tid.uID := 1;

tid.uFlags := nif_Message or nif_Icon or nif_Tip;

tid.uCallBackMessage := wm_User;

tid.hIcon := LoadIcon (hInstance, 'MAINICON');

lstrcpy (tid.szTip,'Desktop is on');

Shell_NotifyIcon (nim_Add, @tid);

end;

wm_Destroy:

begin

Shell_NotifyIcon (nim_Delete, @tid);

PostQuitMessage (0);

ShowWindow(TrayHandle, SW_RESTORE);

// SetDefaultIconColors; ?????

end;

wm_Command: // Command notification

begin

HandleCommand (Wnd, LoWord (wParam));

Exit;

end;

wm_User: // Had a tray notification - see what to do

if (lParam = wm_LButtonDown) then

begin

if x = 0 then

begin

ShowWindow(TrayHandle, SW_HIDE);

tid.hIcon := LoadIcon (hInstance, 'offICON');

lstrcpy (tid.szTip,'Desktop is off');

Shell_NotifyIcon (NIM_MODIFY, @tid);

x:=1

end else

begin

ShowWindow(TrayHandle, SW_RESTORE);

tid.hIcon := LoadIcon (hInstance, 'ONICON');

lstrcpy (tid.szTip,'Desktop is on');

Shell_NotifyIcon (NIM_MODIFY, @tid);

x:= 0;

end;

end else

if (lParam = wm_RButtonDown) then

begin

GetCursorPos (pt);

pm := CreatePopupMenu;

AppendMenu (pm, 0, Ord ('A'), 'About DeskTop Hide...');

AppendMenu (pm, mf_Separator, 0, Nil);

AppendMenu (pm, 0, Ord ('E'), 'Exit DeskTop Hide');

SetForegroundWindow (Wnd);

dc := GetDC (0);

if TrackPopupMenu (pm, tpm_BottomAlign or tpm_RightAlign,

pt.x,GetDeviceCaps(dc,HORZRES){pt.y}, 0, Wnd, Nil) then

SetForegroundWindow (Wnd);

DestroyMenu (pm)

end;

DummyWindowProc := DefWindowProc (Wnd, Msg, wParam, lParam);

end;

procedure WinMain;

var

Wnd: hWnd;

Msg: TMsg;

cls: TWndClass;

begin

{ Previous instance running ? If so, exit }

if FindWindow (AppName, Nil) <> 0 then Panic (AppName + ' is already running.');

{ Register the window class }

FillChar (cls, sizeof (cls), 0);

cls.lpfnWndProc := @DummyWindowProc;

cls.hInstance := hInstance;

cls.lpszClassName := AppName;

RegisterClass (cls);

{ Now create the dummy window }

Wnd := CreateWindow (AppName, AppName, ws_OverlappedWindow,

4, 4, 4, 4,

0, 0, hInstance, Nil);

x:= 0;

if Wnd <> 0 then

begin

ShowWindow (Wnd, sw_Hide);

while GetMessage (Msg, 0, 0, 0) do

begin

TranslateMessage (Msg);

DispatchMessage (Msg);

end;

begin

WinMain;

end.

//////////////////////////// exemplo 2/////////////////////////////////

// programa no systray SEM FORM ocupa apenas 1924 de RAM.

// depois deste exemplo tem um outro que ocupa só 40 K porém

// tem algum bug pois nao tem menu...

program teste1;

uses

Windows,

SysUtils,

Messages,

ShellApi,

Menus;

{$R *.RES}

const

AppName = 'No Form APP';

var

Wnd: hWnd;

tid: TNotifyIconData;

WndClass : array[0..50] of char;

TimerID :integer;

Hint : PChar;

MainMenu : TPopupMenu;

NewItem : TMenuItem;

procedure ClickProc;

Begin

//case Item of

// 1: PostMessage (Wnd, WM_CLOSE, 0, 0);

// end;

End;

function DummyWindowProc (Wnd: hWnd; Msg, wParam: Word; lParam: LongInt): LongInt; stdcall;

var

TrayHandle: THandle;

PMN : TPoint;

begin

DummyWindowProc := 0;

StrPCopy(@WndClass[0], 'Progman');

TrayHandle := FindWindow(@WndClass[0], nil);

case Msg of

WM_CREATE: // Program initialisation - just set up a tray icon

begin

Hint := 'Ola';

tid.cbSize := sizeof (tid);

tid.Wnd := Wnd;

tid.uID := 1;

tid.uFlags := nif_Message or nif_Icon or nif_Tip;

tid.uCallBackMessage := wm_User;

tid.hIcon := LoadIcon (hInstance, 'MAINICON');

lstrcpy (tid.szTip,Hint);

Shell_NotifyIcon (nim_Add, @tid);

end;

WM_DESTROY:

begin

Shell_NotifyIcon (nim_Delete, @tid);

PostQuitMessage (0);

ShowWindow(TrayHandle, SW_RESTORE);

end;

WM_COMMAND: // Command notification

begin

Exit;

end;

WM_USER: // Had a tray notification - see what to do

begin

if (lParam = WM_RBUTTONUP) then

begin

PostMessage (Wnd, WM_CLOSE, 0, 0);

end;

if (lParam = WM_LBUTTONUP) then

Begin

// Create Menu

MainMenu := TPopupMenu.Create(nil); // main popup

Try

// Add Itens - First Item

NewItem := TMenuItem.Create(MainMenu);

// New Item Properties

NewItem.Caption := '&Sair';

NewItem.Default := True;

// NewItem.OnClick := ClickProc; // No work ???

NewItem.Tag := 1;

// Append to Menu

MainMenu.Items.Add(NewItem);

// Second Item

NewItem := TMenuItem.Create(MainMenu);

// New Item Properties

NewItem.Caption := '-';

NewItem.Tag := 2;

// Append to Menu

MainMenu.Items.Add(NewItem);

// 3rd Item

NewItem := TMenuItem.Create(MainMenu);

// New Item Properties

NewItem.Caption := '&Auto Start';

NewItem.Checked := True;

NewItem.Tag := 3;

// NewItem.OnClick := ClickProc; // No work ???

// Append to Menu

MainMenu.Items.Add(NewItem);

//Show Popup Menu

SetForegroundWindow(Wnd);

GetCursorPos(PMN);

MainMenu.Popup(PMN.x, PMN.y);

PostMessage(Wnd, WM_NULL, 0, 0);

Finally

MainMenu.Free;

End; // Try.. Finally

End;

end;

DummyWindowProc := DefWindowProc (Wnd, Msg, wParam, lParam);

end;

procedure TimerProc(Wnd: HWND; uMsg: UINT; idEvent: UINT; dwTime: DWORD);pascal;

begin

//If you need timed events to check

end;

procedure WinMain;

var

// Wnd: hWnd;

Msg: TMsg;

cls: TWndClass;

begin

{ Register the window class }

FillChar (cls, sizeof (cls), 0);

cls.lpfnWndProc := @DummyWindowProc;

cls.hInstance := hInstance;

cls.lpszClassName := AppName;

Windows.RegisterClass (cls);

{ Now create the dummy window }

Wnd := CreateWindow (AppName, AppName, ws_OverlappedWindow, 4, 4, 4, 4,0, 0, hInstance, Nil);

TimerID := Windows.SetTimer(0,3,60000,@TimerProc); //60 Seconds

if Wnd <> 0 then

begin

ShowWindow (Wnd, sw_Hide);

while GetMessage (Msg, 0, 0, 0) do

begin

TranslateMessage (Msg);

DispatchMessage (Msg);

end;

begin

if FindWindow (AppName, nil) <> 0 then

Exit;

// INI

WinMain;

end.

///////////////////////////// este precisa só de 40K

program teste1;

uses

Windows, SysUtils, Messages, ShellApi;

{$R *.RES}

const

AppName = 'APP WITHOUT FORM';

wID_Auto = WM_USER + 11;

wID_Close = WM_USER + 12;

var

tid: TNotifyIconData;

WndClass: array[0..50] of char;

TimerID:integer;

hPopUp: HMenu;

Wnd: hWnd;

Hint : PChar;

Procedure TrackPopUpWin(hWindow: HWnd);

Var

P: TPoint;

Begin

//Show Popup Menu

SetForegroundWindow(hWindow);

GetCursorPos( P );

TrackPopupMenu( hPopUp, TPM_CENTERALIGN, P.x, P.y, 0, hWindow, NIL );

PostMessage(hWindow, WM_NULL, 0, 0);

End;

Procedure CreateMenuPopUp;

Var

mItem: TMENUITEMINFO;

Begin

hPopUp := CreatePopUpMenu;

mItem.cbSize := SizeOF( MENUITEMINFO );

mItem.fMask := MIIM_CHECKMARKS or MIIM_DATA or MIIM_ID or

MIIM_STATE or MIIM_SUBMENU or MIIM_TYPE;

mItem.fType := mft_String;

mItem.wID := wID_Close;

mItem.dwItemData := wID_Close;

mItem.dwTypeData := PChar( 'Sair' );

mItem.cch := Length( 'Sair' );

InsertMenuItem( hPopUp, wID_Close, False, mItem );

mItem.wID := wID_Auto;

mItem.dwItemData := wID_Auto;

mItem.dwTypeData := PChar( 'Auto Start' );

mItem.cch := Length( 'Auto Start' );

InsertMenuItem( hPopUp, wID_Auto, False, mItem );

End;

function DummyWindowProc (Wnd: hWnd; Msg, wParam: Word; lParam: LongInt): LongInt; stdcall;

var

TrayHandle: THandle;

begin

DummyWindowProc := 0;

StrPCopy(@WndClass[0], 'Progman');

TrayHandle := FindWindow(@WndClass[0], nil);

case Msg of

WM_CREATE: // Program initialisation - just set up a tray icon

begin

tid.cbSize := sizeof (tid);

tid.Wnd := Wnd;

tid.uID := 1;

tid.uFlags := nif_Message or nif_Icon or nif_Tip;

tid.uCallBackMessage := WM_USER;

tid.hIcon := LoadIcon (hInstance, 'MAINICON');

lstrcpy (tid.szTip,Hint);

// Create Menu

CreateMenuPopUp;

Shell_NotifyIcon (nim_Add, @tid);

end;

WM_DESTROY:

begin

Shell_NotifyIcon (nim_Delete, @tid);

PostQuitMessage (0);

ShowWindow(TrayHandle, SW_RESTORE);

end;

WM_COMMAND: // Command notification

begin

Exit;

end;

WM_USER: // Had a tray notification - see what to do

begin

if (lParam = WM_RBUTTONUP) then

begin

PostMessage (Wnd, WM_CLOSE, 0, 0);

end;

if (lParam = WM_LBUTTONUP) then

begin

//do something

TrackPopUpWin(Wnd);

end;

DummyWindowProc := DefWindowProc (Wnd, Msg, wParam, lParam);

end;

procedure TimerProc(Wnd: HWND; uMsg: UINT; idEvent: UINT; dwTime: DWORD);pascal;

begin

//If you need timed events to check

end;

procedure WinMain;

var

Msg: TMsg;

cls: TWndClass;

begin

{ Register the window class }

FillChar (cls, sizeof (cls), 0);

cls.lpfnWndProc := @DummyWindowProc;

cls.hInstance := hInstance;

cls.lpszClassName := AppName;

Windows.RegisterClass (cls);

{ Now create the dummy window }

Wnd := CreateWindow (AppName, AppName, ws_OverlappedWindow, 4, 4, 4, 4,0, 0, hInstance, Nil);

TimerID := Windows.SetTimer(0,3,60000,@TimerProc); //60 Seconds

if Wnd <> 0 then

begin

ShowWindow (Wnd, SW_HIDE);

while GetMessage (Msg, 0, 0, 0) do

begin

TranslateMessage (Msg);

DispatchMessage (Msg);

end;

begin

Hint := '127.0.0.1';

if FindWindow (AppName, nil) <> 0 then

Exit;

// INI

WinMain;

end.