Кнопка приложения на панели задач

Code:

// Это необходимо объявить в секции public в верхней части вашего pas-файла

procedure TForm1.IconCallBackMessage( var Mess : TMessage ); message WM_USER + 100;

procedure TForm1.FormCreate(Sender: TObject);

var

nid: TNotifyIconData;

begin

with nid do

begin

   cbSize := SizeOf(TNotifyIconData);

   Wnd := Form1.Handle;

   uID := 1;

   uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;

   uCallbackMessage := WM_USER + 100;

   hIcon := Application.Icon.Handle;

   szTip := 'Текст всплывающей подсказки';

end;

Shell_NotifyIcon(NIM_ADD, @nid);

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

var

nid: TNotifyIconData;

begin

with nid do

begin

   cbSize := SizeOf(TNotifyIconData);

   Wnd := Form1.Handle;

   uID := 1;

   uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;

   uCallbackMessage := WM_USER + 100;

   hIcon := Application.Icon.Handle;

   szTip := 'Текст всплывающей подсказки';

   // Все, что указано выше, не является обязательным

end;

Shell_NotifyIcon(NIM_DELETE, @nid);

end;

procedure TForm1.IconCallBackMessage(var Mess: TMessage);

var

sEventLog: string;

begin

case Mess.lParam of

   // Сделайте здесь все что вы хотите. Например,

   // вызов контекстного меню при нажатии правой кнопки мыши.

   WM_LBUTTONDBLCLK: sEventLog := 'Двойной щелчок левой кнопкой';

   WM_LBUTTONDOWN: sEventLog := 'Нажатие левой кнопки мыши';

   WM_LBUTTONUP: sEventLog := 'Отжатие левой кнопки мыши';

   WM_MBUTTONDBLCLK: sEventLog := 'Двойной щелчок мышью';

   WM_MBUTTONDOWN: sEventLog := 'Нажатие кнопки мыши';

   WM_MBUTTONUP: sEventLog := 'Отжатие кнопки мыши';

   WM_MOUSEMOVE: sEventLog := 'перемещение мыши';

   WM_MOUSEWHEEL: sEventLog := 'Вращение колесика мыши';

   WM_RBUTTONDBLCLK: sEventLog := 'Двойной щелчок правой кнопкой';

   WM_RBUTTONDOWN: sEventLog := 'Нажатие правой кнопки мыши';

   WM_RBUTTONUP: sEventLog := 'Отжатие правой кнопки мыши';

end;

end;

Code:

procedure TForm1.Timer1Timer(Sender: TObject);

begin

FlashWindow(Application.Handle, True);

end;

Code:

procedure TMyForm.CreateParams(var Params :TCreateParams); {override;}

begin

inherited CreateParams(Params); {CreateWindowEx}

Params.ExStyle := Params.ExStyle or WS_Ex_AppWindow;

end;

Code:

unit TNA;

interface

uses

  Windows, Messages, SysUtils, Classes, Controls, Forms, ExtCtrls,

  ShellApi, Menus;

const

  k_WM_TASKMSG = WM_APP + 100;  //die "100" ist ein frei wahlbarer Wert

type

  TForm1 = class(TForm)

    TPopupMenu1: TPopupMenu;

    procedure FormCreate(Sender: TObject);

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    procedure FormDblClick(Sender: TObject);

    procedure PopupMenuClick(Sender: TObject);

  private

    { Private-Deklarationen }

    tTNA: TNotifyIconData;

    procedure WMTaskMsg(var Msg: TMessage); message k_WM_TASKMSG;

    procedure AppActive;

    procedure AppDeactivate;

    procedure ShowIcon;

    procedure ChangeIcon;

  public

    { Public-Deklarationen }

  end;

var

  Form1: TForm1;

implementation

{$R *.DFM}

{$R TNA.RES} //eine Resource mit 2 Icons oder Bitmaps

procedure TForm1.FormCreate(Sender: TObject);

begin

  {la?t die Form schon bei Programmstart verschwinden}

  Application.ShowMainForm := False;

  {Symbol im TNA anzeigen}

  Self.ShowIcon;

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

  {Symbol aus dem TNA entfernen}

  Shell_NotifyIcon(NIM_DELETE, @tTNA);

end;

procedure TForm1.FormDblClick(Sender: TObject);

begin

  {lassen wir doch die Form wieder verschwinden ...}

  Self.AppDeactivate;

  {... und andern das Symbol in dem TNA}

  Self.ChangeIcon;

end;

procedure TForm1.PopupMenuClick(Sender: TObject);

begin

  case TPopupMenu(Sender).Tag of

    {hier steht dann die Auswahl was getan werden soll}

    {wenn auf das erschienene Popupmenu geklickt wurde}

  end;

end;

procedure TForm1.WMTaskMsg(var Msg: TMessage);

var

  rCursor: TPoint;

begin

  {wenn die Nachricht aus unserem definierten Bereich kommt dann ...}

  if Msg.wParam = tTNA.uID then

  begin

    {... tu was wenn das Ereignis ein ...}

    case Msg.lParam of

      {... rechter Mausklick ist oder ...}

      WM_RBUTTONDOWN:

        begin

          {aktuelle Cursoposition holen}

          GetCursorPos(rCursor);

          {ACHTUNG!!!!! Der folgende Aufruf ist an dieser Stelle ganz wichtig!!!!}

{Erst durch diese API-Funktion wird das Popupmenu dazu bewegt zu verschwinden

wenn ein Klick au?erhalb des Popupmenus erfolgt}

          SetForegroundWindow(Self.Handle);

          {Also, nicht vergessen!!!}

          {Das Popupmenu erscheint an der gewunschten Position in dem TNA}

          TPopupMenu1.Popup(rCursor.x, rCursor.y);

        end;

      {... ein linker doppelter Mausklick ist}

      WM_LBUTTONDBLCLK: Self.AppActive;

    end;

  end;

end;

procedure TForm1.AppActive;

var

  hOwner: THandle;

begin

  {Form einblenden}

  SendMessage(Self.Handle, WM_SYSCOMMAND, SC_RESTORE, 0);

  ShowWindow(Self.Handle, SW_SHOW);

  SetForegroundWindow(Self.Handle);

  {Symbol in der Taskbar einblenden}

  hOwner := GetWindow(Self.Handle, GW_OWNER);

  SendMessage(hOwner, WM_SYSCOMMAND, SC_RESTORE, 0);

  ShowWindow(hOwner, SW_SHOW);

end;

procedure TForm1.AppDeactivate;

begin

  {Form ausblenden}

  ShowWindow(Self.Handle, SW_HIDE);

  {Symbol in der Taskbar ausblenden}

  ShowWindow(GetWindow(Self.Handle, GW_OWNER), SW_HIDE);

end;

procedure TForm1.ShowIcon;

begin

  tTNA.cbSize := SizeOf(tTNA);

  tTNA.Wnd    := Self.Handle;

  tTNA.uID    := 24112000;                     //frei wahlbarer Wert zur Identifizierung

tTNA.uCallbackMessage := k_WM_TASKMSG;

  tTNA.hIcon  := LoadIcon(hInstance, 'xxx');

  //xxx ist die Bezeichnung eines Icons aus "TNA.res"

StrCopy(tTNA.szTip, 'Hallo');             //Hint

tTNA.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;

  {CB Symbol in dem TNA einrichten CE}

  Shell_NotifyIcon(NIM_ADD, @tTNA);

end;

procedure TForm1.ChangeIcon;

begin

  tTNA.cbSize := SizeOf(tTNA);

  tTNA.hIcon  := LoadIcon(hInstance, 'yyy');

  //yyy ist die Bezeichnung eines weiteren Icons aus "TNA.res"

StrCopy(tTNA.szTip, 'Welt');              //Hint

{CB Symbol im TNA andern CE}

  Shell_NotifyIcon(NIM_MODIFY, @tTNA);

end;

end.

Code:

uses CommCtrl;

{©Drkb v.3}

function GetModuleFileNameExW(hProcess:THandle; hModule:HMODULE; lpFilename:PWideChar; nSize:DWORD):DWORD; stdcall; external 'PSAPI.DLL';

const

ICON_SMALL2 = 2;

function WindowGetEXE(wnd:HWND):string;

var

wt:array[0..MAX_PATH-1] of WChar;

r:integer;

prc:THandle;

prcID:cardinal;

begin

result:='';

if GetWindowThreadProcessID(wnd,prcID)<>0 then

begin

prc:=OpenProcess(PROCESS_ALL_ACCESS,false,prcID);

if prc<>0 then

try

   r:=GetModuleFileNameExW(prc,0,wt,MAX_PATH*2);

  if r<>0 then result:=wt;

finally

  CloseHandle(prc)

end

end

end;

function WindowGetIcon(wnd:HWND; fSmall:boolean):Cardinal;

var

defIcon:HICON;

r,iType1,iType2: integer;

begin

   defIcon:=LoadIcon(0,IDI_APPLICATION);

   if fSmall then

   begin iType1:=ICON_SMALL2; iType2:= GCL_HICONSM; end else

   begin iType1:=ICON_BIG; iType2:= GCL_HICON; end;

  r:=SendMessageTimeOut(wnd,WM_GETICON,iType1,0,SMTO_ABORTIFHUNG or SMTO_NOTIMEOUTIFNOTHUNG, 100, result);

  if (r=0) then result:=defIcon else

  begin

   if (result=0) then result:=GetClassLong(wnd,iType2);

   if (result=0) then result:=defIcon

  end;

end;

function EnumWindowsProc(wnd:HWND; lParam: LPARAM):BOOL; stdcall;

var

wn:array[0..MAX_PATH-1] of char;

begin

result:=true;

if IsWindowVisible(wnd) and (GetParent(wnd)=0) and (GetWindow(wnd,GW_OWNER)=0) and

((GetWindowLong(wnd,GWL_EXSTYLE) and WS_EX_TOOLWINDOW)=0)  then

begin

GetWindowText(wnd,wn,MAX_PATH);

with Form1.ListView1.Items.Add do

begin

   Caption :=wn; // заголовок

   SubItems.Add(IntToStr(wnd)); // дескриптор

   SubItems.Add(WindowGetEXE(wnd)); // exe

   SubItems.Add(' '); // колонка для большой иконки

   ImageIndex:=ImageList_AddIcon(Form1.ImageList1.Handle,WindowGetIcon(wnd,true)); // маленькая иконка

   SubItemImages[2] := ImageList_AddIcon(Form1.ImageList2.Handle,WindowGetIcon(wnd,false)); // большая иконка

end;

end;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

ListView1.Clear;

ImageList1.Clear;

ImageList2.Clear;

EnumWindows(@EnumWindowsProc,0);

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

// ImageList1 - 16x16;  ImageList2 - 32x32;

ListView1.SmallImages:=ImageList1;

ListView1.LargeImages:=ImageList2;

end;

Code:

void __fastcall CreateParams(TCreateParams &Params);

...

void __fastcall TForm1::CreateParams(TCreateParams &Params)

{

TForm::CreateParams(Params);

Params.ExStyle |= WS_EX_APPWINDOW;

Params.WndParent = GetDesktopWindow();

}