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)=0then

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:

Application.CreateHandle;

ShowWindow(Application.Handle, SW_HIDE);

Application.ShowMainForm := FALSE;

 

 

Code:

void __fastcall CreateParams(TCreateParams &Params);

 

...

 

void __fastcall TForm1::CreateParams(TCreateParams &Params)

{

TForm::CreateParams(Params);

Params.ExStyle |= WS_EX_APPWINDOW;

Params.WndParent = GetDesktopWindow();

}

 

 

 

Code:

procedure TForm1.Timer1Timer(Sender: TObject);

begin

FlashWindow(Application.Handle, True);

end;

 

 

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 WMQueryOpen(var Msg: TWMQueryOpen);

message WM_QUERYOPEN;

 

// ... и ее реализация

procedure TMainForm.WMQueryOpen(var Msg: TWMQueryOpen);

begin

Msg.Result := 0;

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.

 

 

 

 

Дело-то вот в чем: Главным окном программы дельфийской является не главная форма, а окно TApplication, которое имеет нулевые размеры, поэтому его не видно. Именно для него показывается иконка на панели задач. Когда пользователь нажимает кнопку минимизации на главной форме, команда минимизации передается этому окну, и сворачивается именно оно, а для остальных просто делается hide. А так как окно TApplication имеет нулевые размеры, то и анимации никакой не видно.

В этой статье я хотел бы описать полезную недокументированную  функцию GetTaskmanWindow. Функция GetTaskmanWindow возвращает дескриптор

окна, которое владеет кнопками панели задач. Вот цитата о панели задач из Microsoft MSDN:  "Программа Microsoft® для Windows® интерфейс, включающий приложение

панель называется панелью задач. Панель задач может использоваться для выполнения таких задач, как переключение между открытыми Windows и запуск новых приложений..." и "панель задач содержит меню Пуск, кнопки панели задач,  контекстное меню и панель состояния...". К сожалению, Win32 API не содержит документированных функций, которые могут быть использованы для доступа к задач, поэтому мы должны снова использовать недокументированный способ.

 

Code:

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

begin

inherited CreateParams(Params); {CreateWindowEx}

Params.ExStyle := Params.ExStyle or WS_Ex_AppWindow;

end;

 

 

Есть ли у кого пример рисования на иконке минимизированного приложения с помощью Delphi?

 Когда Delphi-приложение минимизировано, иконка, которая вы видите - реальное главное окно, объект TApplication, поэтому вам необходимо использовать переменную Application. Таким образом, чтобы удостовериться что приложение минимизировано, вызовите IsIconic(Application.Handle). Если функция возвратит True, значит так оно и есть. Для рисования на иконке создайте обработчик события Application.OnMessage. Здесь вы можете проверять наличие сообщения WM_Paint и при его нахождении отрисовывать иконку. Это должно выглядеть приблизительно так: