Tray Programm ohne VCL

[madtom]

Hallo,
hier ist ein bißchen älterer Code, den ich vor längerer Zeit mal aus einer Newsgroup kopiert habe, funktioniert aber immer noch (bei mir Windoes 7 32bit). Eine Resourcendatei Icons.res für das Programm-Icon wird vorausgesetzt. Vielleicht kannst Du das Programm ja für deine Zwecke modifizieren.

Delphi-Quellcode:

program DeskPop;

uses
  Windows, Messages, ShellAPI, SysUtils;

{$R *.RES}
{$R ICONS.RES}

const
  AppName = 'DeskTop Hide';

var
  x: Integer;
  NID: 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('A'):
      MessageBox(0, 'Freeware [e-mail] 1997', AppName, MB_OK);
    Ord('E'):
      PostMessage(Wnd, WM_CLOSE, 0, 0);
  end;
end;

function DummyWindowProc(Wnd: HWND; Msg, wParam: Word; lParam: LongInt): LongInt; stdcall;
var
  TrayHandle: THandle;
  DC: HDC;
  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
        NID.cbSize := SizeOf(NID);
        NID.Wnd := Wnd;
        NID.uID := 1;
        NID.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
        NID.uCallBackMessage := WM_USER;
        NID.hIcon := LoadIcon(hInstance, 'MAINICON');
        lstrcpy(NID.szTip, 'Desktop is on');
        Shell_NotifyIcon(NIM_ADD, @NID);
      end;
    WM_DESTROY:
      begin
        Shell_NotifyIcon(nim_Delete, @NID);
        PostQuitMessage(0);
        ShowWindow(TrayHandle, SW_RESTORE);
      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);
          NID.hIcon := LoadIcon(hInstance, 'offICON');
          lstrcpy(NID.szTip, 'Desktop is off');
          Shell_NotifyIcon(NIM_MODIFY, @NID);
          x := 1
        end
        else
        begin
          ShowWindow(TrayHandle, SW_RESTORE);
          NID.hIcon := LoadIcon(hInstance, 'ONICON');
          lstrcpy(NID.szTip, 'Desktop is on');
          Shell_NotifyIcon(NIM_MODIFY, @NID);
          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;
  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, CW_USEDEFAULT, CW_USEDEFAULT,
    CW_USEDEFAULT, CW_USEDEFAULT, 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;
  end;
end;

begin
  WinMain;
end.