Отправляет email-рассылки с помощью сервиса Sendsay

Карьера и развитие для начинающих программистов

Рассылка закрыта

При закрытии подписчики были переданы в рассылку "О карьере и профессиональном развитии IT-специалистов" на которую и рекомендуем вам подписаться.

Вы можете найти рассылки сходной тематики в Каталоге рассылок.

←   Август 2004   →
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Автор
Вячеслав Панкратов

Статистика

3.166 подписчиков
-4 за неделю
←   Все выпуски   →

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


Информационный Канал Subscribe.Ru
©Gigabyte 2004

По материалам сайта 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;
Для чего сделан GetSystemMetrics? Для того, чтоб левшам было удобно пользоваться. Дальше же идет простое вышлёпывание Popupa.

О главном

Хорошо: 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;
в методах AfterConstruction и Destroy я просто обнуляю поле FPath, хотя это и необязательно (сила привычки однако).

Изюминка

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


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;
Небольшое объяснение:
Сперва мы все обнуляем. После этого запрашиваем ссылку на "Рабочий стол"; далее используем ее для определения указателя на интерфейс IEnumIDList при помощи которого заполняем Имена и Пути элементов контекстного меню, которые и добавляем к нашему PopupMenu1. Ну а под конец, мы обнуляем ссылки на интерфейсы IShellFolder и IEnumIDList, чтоб те не засоряли память.

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


procedure TForm1.DoMenuClick(Sender:TObject);
begin
 ShellExecute(Handle,nil,PChar((Sender as TMyMenuItem).Path),nil,nil,SW_NORMAL);
end;
Можно также использовать WinExec, но если вы пишете под Win95/98/NT4/2000/XP, то лучше все же ShellExecute т.к. "Microsoft рекомендует".

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

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

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

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


  TFolderWatchThread = class(TThread)
  private
   FPath:String;
   procedure UpdateItems;
  public
   constructor Create(Path:String);
     procedure Execute;override;
  end;
Здесь метод Create будет проводить начальную настройку потока: запонение поля FPath, установка приоритета выполнения потока и т.п.; метод Execute - содержит главный код потока, а UpdateItems - будет проводить обновление меню.

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


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

Таблица.1
ФункцияОписание
function FindFirstChangeNotification( lpPathName: PChar; bWatchSubtree: BOOL; dwNotifyFilter: DWORD): THandle; stdcall;Начать отслеживать изменения в папке lpPathName. Отслеживать подкаталог, если bWatchSubtree = True. Отслеживать изменения заданные маской dwNotifyFilter. Результат - идентификатор объекта, который отслеживает изменения в папке.
function FindNextChangeNotification( hChangeHandle: THandle): BOOL; stdcall;Отследить следующее изменение в папке. hChangeHandle - значение результата FindFirstChangeNotification. Результат - true если есть изменения, False - изменений нет, или возникла ошибка(подробнее см. GetLastError)
function FindCloseChangeNotification( hChangeHandle: THandle): BOOL; stdcall;Завершение отслеживания изменений и удаление объекта hChangeHandle. Результат - true если все прошло нормально, false - возникла ошибка (подробнее см.GetLastError)

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.
©Gigabyte 2004
http://subscribe.ru/
http://subscribe.ru/feedback/		 Адрес подписки
 Отписаться
В избранное