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

X-Program ПО, новости сайта и программирование в Delphi7


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

Выпуск 30
НОВОГОДНИЙ

Как с нами связаться:
E-Mail
X-Program@mail.ru
SMS
+79046560786
ICQ
322284039
Форум по Delphi
http://narod.yandex.ru/userforum/?owner=x-program
Наш сайт
http://www.x-program.narod.ru



НОВОСТИ
**
28.12.04
Можно вас спросить, почему никто не пишет вопросов в форуме. Ведь там можно писать и ответы. Давайте создадим крутой форум!!!



P.S.: т.к. выпуск новогодний, то мы решили посвятить его украшению Вашего PC
Сегодня в выпуске:
1. Смена обоев на рабочем столе несколькими способами
2. Как установить цвет фона иконок на рабочем столе, либо сделать у них прозрачный фон
3. Shell своими руками - System Tray
4. Как изменить заголовок кнопки ПУСК



Смена обоев на рабочем столе несколькими способами
Это совсем не сложно! Вот несколько способов.
Способ №1

uses Registry, WinProcs;
{....................}
procedure SetWallpaper(sWallpaperBMPPath: string; bTile: boolean);
var
reg: TRegIniFile;
begin
// Изменяем ключи реестра
// HKEY_CURRENT_USER
// Control Panel\Desktop
// TileWallpaper (REG_SZ)
// Wallpaper (REG_SZ)
reg := TRegIniFile.Create('Control Panel\Desktop');
with reg do
begin
WriteString('', 'Wallpaper', sWallpaperBMPPath);
if (bTile) then
begin
WriteString('', 'TileWallpaper', '1');
end
else
begin
WriteString('', 'TileWallpaper', '0');
end;
end;
reg.Free;
// Оповещаем всех о том, что мы изменили системные настройки
SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, nil, SPIF_SENDWININICHANGE);
end;

Способ №2

uses ComObj, ShlObj;
{....................}
procedure ChangeActiveWallpaper;
const
CLSID_ActiveDesktop: TGUID = '{75048700-EF1F-11D0-9888-006097DEACF9}';
var
ActiveDesktop: IActiveDesktop;
begin
ActiveDesktop := CreateComObject(CLSID_ActiveDesktop)
as IActiveDesktop;
ActiveDesktop.SetWallpaper('c:\windows\forest.bmp', 0);
ActiveDesktop.ApplyChanges(AD_APPLY_ALL or AD_APPLY_FORCE);
end;


Как установить цвет фона иконок на рабочем столе, либо сделать у них прозрачный фон
Для этого нужно найти окно "SysListView32" (которое является списком, который содержит иконки рабочего стола).
Сперва будем искать главное родительское окно "Progman", которое содержит дочернее окно "SHELLDLL_DefView" , которое в свою очередь имеет дочернее окно "SysListView32".
Для этого можно воспользоваться API функцией FindWindow to. Когда Мы получим дескриптор окна "SysListView32", то можно будет воспользоваться макросами ListView_SetTextBkColor и ListView_SetTextColor для установки желаемого цвета.
Ниже приведена процедура, которая делает всё вышеперечисленное. Если параметр Trans равен true, то будет установлен прозрачный фон, иначе цвет фона будет равен Background.

unit DeskIcons;

interface
uses Graphics; // Будет использоваться TColor

procedure SetDesktopIconColor(Forground, Background: TColor; Trans: Boolean);
procedure SetDefaultIconColors;

implementation
uses Windows, CommCtrl; // будут использоваться HWND и ListView_XXXXX

procedure SetDesktopIconColor(Forground, Background: TColor; Trans: Boolean);
var
Window: HWND;
begin
// Находим нужное окно в три этапа
Window := FindWindow('Progman', 'Program Manager');
// Используем FindWindowEx для нахождения дочернего окна
Window := FindWindowEx(Window, HWND(nil), 'SHELLDLL_DefView', '');
// SysListView32, это список с иконками на рабочем столе
Window := FindWindowEx(Window, HWND(nil), 'SysListView32', '');
// Используем макрос для очистки цвета фона
if Trans then
ListView_SetTextBkColor(Window, $FFFFFFFF) // фоновый цвет
else
ListView_SetTextBkColor(Window, Background); // фоновый цвет
ListView_SetTextColor(Window, Forground); // передний цвет
// теперь перерисовываем иконки
ListView_RedrawItems(Window, 0, ListView_GetItemCount(Window) - 1);
UpdateWindow(Window); // даём команду "немедленно перерисовать"
end;

procedure SetDefaultIconColors;
{ Эта процедура устанавливает цвета, которые заданы в
windows по умолчанию }
var
Kind: Integer;
Color: TColor;
begin
Kind := COLOR_DESKTOP;
Color := GetSysColor(COLOR_DESKTOP);
SetSysColors(1, Kind, Color);
end;
end.


Shell своими руками - System Tray
Иконку в трей помещают с помощью Shell_NotifyIconW. Интересено посмотреть на этот процесс с другой точки зрения.
Shell_NotifyIconW просто ищет окно с классом "Shell_TrayWnd" и посылает в него сообщение WM_COPYDATA. в качестве данных выступает простая структура TNIDMessage. возвращаясь к топику: если создать свое окно с классом "Shell_TrayWnd" и обрабатывать входящие сообщения WM_COPYDATA, то можно написать полный аналог system tray!
В первую очередь немаловажное замечание: сообщение посылается только одному окну, то есть наше приложение должно грузится первым. Разные там explorer'ы и другие подобные будут мешать.

Шаг первый:
Создаем окно "Shell_TrayWnd"

procedure TForm1.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.WinClassName := 'Shell_TrayWnd';
end;

Все. Окно класса "Shell_TrayWnd" имеем.

Шаг второй:
Ловим WM_COPYDATA

procedure TFORM1.WMCOPYDATA(var Msg: Tmessage);
var
pcd: PCopyDataStruct;
NID: PNotifyIconData;
begin
pcd := PCOPYDATASTRUCT(msg.lParam);
if pcd^.dwData = 1 then
begin
NID := pointer(integer(pcd.lpData) + 8);
case integer(pointer(integer(pcd.lpData) + 4)^) of
NIM_ADD: Msg.Result := NewTrayIcon(NID); // добавить иконку
NIM_DELETE: Msg.Result := DeleteTrayIcon(NID); // удалить иконку
NIM_MODIFY: Msg.Result := ModifyTrayIcon(NID);
// изменить иконку (или подсказку)
end;
exit;
end;
end;

Обратите внимание на Msg.Result.
Желательно чтобы NewTrayIcon, DeleteTrayIcon, ModifyTrayIcon возвращали Integer(True) или Integer(False) в зависимости от помещения/удаления иконки.
Некоторые приложения не проверяют этот результат, но если начнут проверять - то причины "глючного" поведения иконки того же AVP Monitor можно искать долго и безуспешно.

Шаг третий:
Поймали, и че с ним теперь делать?
А мы имеем очень интересную структуру -
NID.cbSize - размер записи, в принципе не интересен;
NID.Wnd - хендл окна (владельца иконки);
NID.uID - идентификатор иконки (если их в приложении несколько), для данной задачи нужен для отсылки обратного сообщения;
NID.uFlags - определяет, какие поля используются в сообщении. Параметр может быть любой комбинацией из флагов (0 - uCallbackMessage, 2 - hIcon, 4 - czTip);
NID.uCallbackMessage - номер сообщения, которое посылается окну, определяемому полем NID.Wnd (владельцу). lParam отсылаемого сообщения дожен равняться NID.uID, а wParam сообщение от мыши.

Пример:
PostMessage(NID.Wnd, NID.uCallBack, NID.uID, MOUSE_EVENT) где MOUSE_EVENT может принимать значения WM_LBUTTONDOWN, WM_LBUTTONUP, WM_LBUTTONDBLCLK и подобные для других кнопок мыши.
NID.hIcon - хендл иконки, которую собственно и предполагается отображать;
NID.szTip - строка, оканчивающаяся нулевым символом, содержит подсказку, которая должна выводится при наведении курсора на иконку.


В случаях ошибки нужно информировать приложения про необходимость поместить иконки обратно. Для этого послужат такие действия:
procedure TForm1.FormCreate(Sender: TObject); var WM_TASKBARCREATED: UINT; begin WM_TASKBARCREATED := RegisterWindowMessage('TaskbarCreated'); PostMessage(HWND_BROADCAST, WM_TASKBARCREATED, 0, 0); end;



Как изменить заголовок кнопки ПУСК
Для начала создайте какой-нибудь Bitmap, который вы будете натягивать на кнопку [т.к. такого понятия как "заголовок кнопки ПУСК" в действительности не существует], а та надпись, что находится на стартовой кнопке, является рисунком. Создавая рисунок, учитывайте размеры и то, что левая сторона должна быть "плоской", как у нас на рисунке слева, это связано с особенностями наложения.
Далее займёмся проектом. Сначала объявляем глобальные переменные

StartButton: hWnd;
OldBitmap: THandle;
NewImage: TPicture;

Затем описываем событие по создания окна [OnCreate]:

procedure TForm1.FormCreate(Sender: TObject);
begin
NewImage := TPicture.create;
NewImage.LoadFromFile('C:\Windows\delphi.BMP'); //здесь укажите путь к нужному файлу
StartButton := FindWindowEx(FindWindow('Shell_TrayWnd', nil), 0, 'Button', nil);
OldBitmap := SendMessage(StartButton, BM_SetImage, 0, NewImage.Bitmap.Handle);
end;

Если вы делаете это на своей машине, то можете всё восстанавливать по событию OnDestroy:

procedure TForm1.FormDestroy(Sender: TObject);
begin
SendMessage(StartButton, BM_SetImage, 0, OldBitmap);
NewImage.Free;
end;

http://subscribe.ru/
http://subscribe.ru/feedback/
Подписан адрес:
Код этой рассылки: comp.soft.prog.program
Отписаться

В избранное