Программирование для начинающих и не только

По материалам www.gigabyte.iatp.org.ua

Одна полезная программка

В начале месяца, я залезаю в Internet. После первых 10-ти минут работы на моем рабочем столе присутствуют: Opera, The Bat!, ReGet, ICQ, Far и т.п. Причем все они развернуты на максимум. И если переключатся между ними еще как-то можно, то добраться до самого рабочего стола, это уже подвиг. Вот если бы можно было запускать программы с рабочего стола, скажем через контекстное меню иконки в трее.

К чему клоню

Итак для начала запустим Delphi. После этого перетащим компонент заведующий иконкой в трейбаре и компонент TPopupMenu, а в реакцию "иконки в трейбаре" на нажатие правой кнопки мыши пишем:

procedure TForm1.TrayIcon1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
 var Result:Boolean;
 var Pt:TPoint;
begin
 Result:=False;
 Result:=((GetSystemMetrics(SM_SWAPBUTTON)=0) and (Button=mbLeft));
 Result:=Result or ((GetSystemMetrics(SM_SWAPBUTTON)>0) and (Button=mbRight));
 if Result then
  begin
   GetCursorPos(Pt);
   PopupMenu1.Popup(Pt.X,Pt.Y);
  end;
end;

О главном

Хорошо: Popup мы вышлепнем, но что нам в него запихнуть? Для ответа на этот вопрос вспомним модуль Delphi под названием ShlObj.pas. Этот очень полезный модуль содержит, кроме всего прочего, определения интерфейсов IShellFolder и IEnumIDList, которыми мы и воспользуемся. Кроме того нам понадобится еще функция:
function SHGetDesktopFolder(var ppshf: IShellFolder): HResult; stdcall;
которая возвратит нам ссылку на наш "Рабочий стол".

Далее мы должны использовать эту ссылку для того, чтоб вызвать метод
function EnumObjects(hwndOwner: HWND; grfFlags: DWORD;out EnumIDList: IEnumIDList): HResult; stdcall;
Который в свою очередь даст нам интерфейс IEnumIDList для перенумерации содержимого "Рабочего стола". В этом интерфейсе нам надо вызывать метод Next:
function Next(celt: ULONG; out rgelt: PItemIDList; var pceltFetched: ULONG): HResult; stdcall;
, до тех пор, пока он возвращает нам значение S_OK. Кроме этого метод Next также возвращает нам идентификаторы элементов(rgelt) находящихся на "Рабочем столе", и которые мы будем использовать ниже. После этого, нам остается только узнать пути к соответствующим объектам и оформить их в соответствующем пункте меню.

Путь к объекту можно узнать через метод:
function GetDisplayNameOf(pidl: PItemIDList; uFlags: DWORD;var lpName: TStrRet): HResult; stdcall;
Через него также можно узнать, какое значение передать свойству TMenuItem.Caption каждого элемента контекстного меню. Для этого надо только вызвать этот метод с соответствующими параметрами:
OleCheck(Root.GetDisplayNameOf(PID,SHGDN_NORMAL,StrRet));
для Caption и
OleCheck(Root.GetDisplayNameOf(PID,SHGDN_FORPARSING,StrRet));
для пути к файлу.

Естественно мы должны сохранить где-то эти данные. И наиболее эффективным будет создание своего класса - потомка TMenuItem с определенным своством Path, которое и будет хранить путь каждого элемента меню:

  TMyMenuItem = class(TMenuItem)
  private
   FPath:String;
  public
   procedure AfterConstruction;override;
   destructor Destroy;override;
  published
   property Path:String read FPath write FPath;
  end;

Изюминка

А теперь рассмотрим код самой процедуры заполнения контекстного меню:

procedure TForm1.FillMenuItems;
var Root:IShellFolder;
    Enum:IEnumIDList;
    PID:PItemIDList;
    Fetched:Cardinal;
    StrRet:_STRRET;
    Temp:TMyMenuItem;
    FI:TSHFileInfo;
    FAtt:Cardinal;
begin
FAtt:=0;
While PopupMenu1.Items.Count>0 do PopupMenu1.Items.Delete(0);
OleCheck(SHGetDesktopFolder(Root));
OleCheck(Root.EnumObjects(Self.Handle,SHCONTF_NONFOLDERS,Enum));
While Enum.Next(1,PID,Fetched)=S_OK do
 begin
  Temp:=TMyMenuItem.Create(Self);
  OleCheck(Root.GetDisplayNameOf(PID,SHGDN_NORMAL,StrRet));
  Temp.Caption:=StrPas(StrRet.cStr);
  OleCheck(Root.GetDisplayNameOf(PID,SHGDN_FORPARSING,StrRet));
  Temp.Path:=StrPas(StrRet.cStr);
  Temp.OnClick:=DoMenuClick;
  PopupMenu1.Items.Insert(0,Temp);
 end;
Enum:=nil;
Root:=nil;
end;

Теперь нам только осталось разобраться с реакцией контекстного меню на нажатие:

procedure TForm1.DoMenuClick(Sender:TObject);
begin
 ShellExecute(Handle,nil,PChar((Sender as TMyMenuItem).Path),nil,nil,SW_NORMAL);
end;

Обновление меню

Итак, контекстное меню создано. Но как нам быть, если содержимое Рабочего стола изменится? Нам придется обновлять наше меню. Как лучше это сделать? Сразу же напрашивается решение: "закинуть на форму таймер и по таймеру обновлять" или "поставить в меню пункт "обновить"". И одно, и другое решение допустимое, но первое из них пожирает слишком много ресурсов системы, а второе - это дополнительная работа руками (что также недопустимо).

Я же предлагаю использовать для этих целей специальные функции Windows по отслеживанию за изменениями в папках: FindFirstChangeNotification, FindNextChangeNotification и FindCloseChangeNotification.

Для начала создадим поток, в котором и будет происходить отслеживание изменений в папке. Определим его следующим образом:

  TFolderWatchThread = class(TThread)
  private
   FPath:String;
   procedure UpdateItems;
  public
   constructor Create(Path:String);
     procedure Execute;override;
  end;

Реализация этих методов выглядит следующим образом:

constructor TFolderWatchThread.Create(Path:String);
begin
 inherited Create(True);
 FreeOnTerminate:=True;
 FPath:=Path;
 Self.Priority:=tpHigher;
 Resume;
end;

procedure TFolderWatchThread.UpdateItems;
begin
 Form1.FillMenuItems;
 Form1.PopupMenu1.Items.Add(Form1.UnLoad);
end;

procedure TFolderWatchThread.Execute;
 var Signal:THandle;
begin
Signal:=FindFirstChangeNotification(PChar(FPath),False,FILE_NOTIFY_CHANGE_FILE_NAME or FILE_NOTIFY_CHANGE_DIR_NAME);
 Win32Check(Signal<>INVALID_HANDLE_VALUE);
 while not Terminated do
  begin
   Synchronize(UpdateItems);
   FindNextChangeNotification(Signal);
   WaitForSingleObject(Signal,INFINITE);
  end;
 FindCloseChangeNotification(Signal);
end;

Что здесь написано:
Во первых в конструкторе идет заполнение необходимых свойств объекта и запуск нити. Далее в методе UpdateItems идет стандартное обновление контекстного меню (такое же как и при запуске программы). В методе Execute идет отслеживание содержимого папки FPath и вызов метода обновления при возникновении каких либо изменений.

Описание функций FindFirstChangeNotification, FindNextChangeNotification и FindCloseChangeNotification. Подано в таблице.1

P.S.

Ничто не стоит на месте, и исходные коды тоже. Так я теперь тружусь (время от времени) над тем, чтобы это контекстное меню отображало иконки соответствующих программ, хотя пока безрезультатно. Так что если в листинге найдете что-то лишнее, пожалуйста не обижайтесь.

Если же у вас нет компонента для работы с треем, то предлагаю использовать мой

//Листинг

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Menus, TrayIcon,ShellApi;

type
  TFolderWatchThread = class;

  TForm1 = class(TForm)
    TrayIcon1: TTrayIcon;
    PopupMenu1: TPopupMenu;
    procedure TrayIcon1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    UnLoad:TMenuItem;
    FolderWatch:TFolderWatchThread;
    procedure DoMenuClick(Sender:TObject);
    procedure FillMenuItems;
    procedure DoUnload(Sender:TObject);
    procedure DoAppMin(Sender:TObject);
    { Private declarations }
  public
    { Public declarations }
  end;

  TMyMenuItem = class(TMenuItem)
  private
   FPath:String;
   FPicture:TPicture;
  public
   procedure AfterConstruction;override;
   destructor Destroy;override;
  published
   property Path:String read FPath write FPath;
   property Picture:TPicture read FPicture write FPicture;
  end;

  TFolderWatchThread = class(TThread)
  private
   FPath:String;
   procedure UpdateItems;
  public
   constructor Create(Path:String);
     procedure Execute;override;
  end;

var
  Form1: TForm1;

implementation
uses ShlObj,ComObj,Math,DebugUnit;

{$R *.dfm}
constructor TFolderWatchThread.Create(Path:String);
begin
inherited Create(True);
FreeOnTerminate:=True;
FPath:=Path;
Self.Priority:=tpHigher;
Resume;
end;

procedure TFolderWatchThread.UpdateItems;
begin
Form1.FillMenuItems;
Form1.PopupMenu1.Items.Add(Form1.UnLoad);
end;

procedure TFolderWatchThread.Execute;
var Signal:THandle;
begin
Signal:=FindFirstChangeNotification(PChar(FPath),False,FILE_NOTIFY_CHANGE_FILE_NAME or FILE_NOTIFY_CHANGE_DIR_NAME);
Win32Check(Signal<>INVALID_HANDLE_VALUE);
while not Terminated do
 begin
  Synchronize(UpdateItems);
  FindNextChangeNotification(Signal);
  WaitForSingleObject(Signal,INFINITE);
 end;
FindCloseChangeNotification(Signal);
end;

procedure TMyMenuItem.AfterConstruction;
begin
inherited AfterConstruction;
FPicture:=TPicture.Create;
end;

destructor TMyMenuItem.Destroy;
begin
inherited Destroy;
if Assigned(Picture) then Picture.Free;
end;

procedure TForm1.DoMenuClick(Sender:TObject);
begin
ShellExecute(Handle,nil,PChar((Sender as TMyMenuItem).Path),nil,nil,SW_NORMAL);
end;

procedure TForm1.FillMenuItems;
var Root:IShellFolder;
    Enum:IEnumIDList;
    PID:PItemIDList;
    Fetched:Cardinal;
    StrRet:_STRRET;
    Temp:TMyMenuItem;
    FI:TSHFileInfo;
    FAtt:Cardinal;
    Icon:TIcon;
begin
FAtt:=0;
While PopupMenu1.Items.Count>0 do PopupMenu1.Items.Delete(0);
OleCheck(SHGetDesktopFolder(Root));
OleCheck(Root.EnumObjects(Self.Handle,SHCONTF_NONFOLDERS,Enum));
While Enum.Next(1,PID,Fetched)=S_OK do
 begin
  Temp:=TMyMenuItem.Create(Self);
  OleCheck(Root.GetDisplayNameOf(PID,SHGDN_NORMAL,StrRet));
  Temp.Caption:=StrPas(StrRet.cStr);
  OleCheck(Root.GetDisplayNameOf(PID,SHGDN_FORPARSING,StrRet));
  Temp.Path:=StrPas(StrRet.cStr);
  FillChar(FI,SizeOf(FI),0);
  Icon:=TIcon.Create;
  Icon.ReleaseHandle;
  Icon.Handle:=FI.hIcon;
  Temp.Picture.Assign(Icon);
  Temp.OnClick:=DoMenuClick;
  PopupMenu1.Items.Insert(0,Temp);
 end;
Enum:=nil;
Root:=nil;
end;

procedure TForm1.TrayIcon1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var Result:Boolean;
var Pt:TPoint;
begin
Result:=False;
Result:=((GetSystemMetrics(SM_SWAPBUTTON)=0) and (Button=mbLeft));
Result:=Result or ((GetSystemMetrics(SM_SWAPBUTTON)>0) and (Button=mbRight));
if Result then
 begin
  GetCursorPos(Pt);
  PopupMenu1.Popup(Pt.X,Pt.Y);
 end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var DesktopPath:Array[0..MAX_PATH] of Char;
begin
TrayIcon1.Icon:=Application.Icon;
TrayIcon1.Enabled:=True;
FillMenuItems;
UnLoad:=TMenuItem.Create(self);
UnLoad.OnClick:=DoUnload;
UnLoad.Break:=mbBarBreak;
UnLoad.Caption:='Выход';
PopupMenu1.Items.Add(Unload);
if SHGetSpecialFolderPath(Self.Handle,DesktopPath,CSIDL_DESKTOPDIRECTORY,False) then
FolderWatch:=TFolderWatchThread.Create(DesktopPath) else ShowMessage('Desktop path not found');
Application.OnMinimize:=DoAppMin;
Self.WindowState:=wsMinimized;
end;

procedure TForm1.DoUnload(Sender:TObject);
begin
Application.Terminate;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
TrayIcon1.Enabled:=False;
FolderWatch.Terminate;
end;

procedure TForm1.DoAppMin(Sender:TObject);
begin
ShowWindow(Application.Handle,SW_Hide);
ShowWindow(Application.MainForm.Handle,SW_Hide);
end;

end.