Последние записи
- TChromium (CEF3), сохранение изображений
- Как в Delphi XE обнулить таймер?
- Изменить цвет шрифта TextBox на форме
- Ресайз PNG без потери прозрачности
- Вывод на печать графического файла
- Взаимодействие через командную строку
- Перенести программу из Delphi в Lazarus
- Определить текущую ОС
- Автоматическая смена языка (раскладки клавиатуры)
- Сравнение языков на массивах. Часть 2
Интенсив по Python: Работа с API и фреймворками 24-26 ИЮНЯ 2022. Знаете Python, но хотите расширить свои навыки?
Slurm подготовили для вас особенный продукт! Оставить заявку по ссылке - https://slurm.club/3MeqNEk
Online-курс Java с оплатой после трудоустройства. Каждый выпускник получает предложение о работе
И зарплату на 30% выше ожидаемой, подробнее на сайте академии, ссылка - ttps://clck.ru/fCrQw
21st
Фев
Panic button — WinAPI графика
Posted by Chas under Журнал, Статьи
Здравствуйте, уважаемые читатели. Прочитав эту статью, Вы получите навыки создания «чистых» WinAPI приложений и управления графикой в среде разработки Lazarus.
Алексей Шишкин
by Alex Cones http://flsoft.ru
Что и для чего…
Ситуация первая. Итак, давайте представим две жизненные ситуации, которые помогут нам несколько улучшить наше виртуальное пространство, в котором мы живем (см. рисунок 1):
Рис. 1. Именно здесь мы и проводим жизнь
Вообразим себе рабочее место ИТ-сотрудника. Теперь представим себя на его месте. Работа работой, но, иногда, так хочется отвлечься. Руки сами собой тянутся к аське. Да не к той, что справа сидит, а к электронной. Проболтав минут пятнадцать, с нехорошим предчувствием слышим чьи-то шаги сзади…
Ситуация вторая. А теперь вообразим себе детскую комнату – стол и компьютер, в котором мальчик пубертатного возраста просматривает непристойные сайты. Звук поворачиваемой ручки двери…
Приготовимся к старту
Думаю, Вы уже уловили сходство ситуаций. В обоих случаях необходимо срочно очистить рабочий стол, свернув все окна. Для этого, как Вы знаете, существует кнопка на панели быстрого запуска, под обыденным названием «свернуть все окна». Но, есть две проблемы:
- она имеет очень малые размеры;
- если там больше одной кнопки, то не сразу сообразишь, где нужная.
Давайте решим эту проблему, создав собственную кнопку «Panic». Но так, как мы не хотим, чтобы она ела много памяти и процессорного времени – сотворим ее на чистом WinAPI.
Состав: яблочное пюре, сахар…
Что нам потребуется для данной задумки:
- GNU ObjectPascal IDE «Lazarus» [1];
- Изображение кнопки. Лично я использую изображение из коллекции своей панели быстрого запуска [2] (см. рисунок 2):
Рис. 2. Используйте изображение нужных размеров, но не забудьте, что оно должно иметь формат bmp
Запустим Lazarus. Как обычно он предложит нам создать новый проект, откроем новый unit. Зайдем в [Проект] ? [Убрать из проекта…] и уберем из проекта unit1.pas. Теперь, избавившись от формы, откроем файл проекта: [Вид] ? [Модули…].
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, LResources;
{$IFDEF WINDOWS}{$R project1.rc}{$ENDIF}
begin
{$I project1.lrs}
Application.Initialize;
Application.Run;
end.Syhi-подсветка кода
Теперь закроем окно редактирования unit1, так как он нам не понадобится и мы его исключили из проекта. А теперь приведем <project1.lpr> в следующий вид:
После этих нехитрых манипуляций создадим новый юнит: [Файл] ? [Создать юнит]. И удалим у него все модули из секции Uses. После этого подключим к нему модуль Windows. Нажмем на кнопку «Сохранить все». Сохраним модуль как UNTForm, а сам проект как pncbtn.
Создание
Итак, приступим к самой программе. Для этого в секции Type юнита UNTForm опишем следующие типы:
TImage = Record // Изображение на форме
Handle : HWND; // Хендл изображения
DC : HDC; // Контекст устройства
End;
TForm = Record // Форма
Handle : HWND; // Хендл формы
Left : Integer;
Top : Integer;
Width : Integer;
Height : Integer;
Image : TImage; // Изображение
End;
TApplication = Record // Приложение
WinClass: TWndClass; // Класс приложения
MSG : TMSG; // Сообщение для отработки
Handle : HWND; // Хендл приложения
End;
TTexture = Record // Текстура
Bitmap : HbitMap; // Битмап (обратите внимание — не TBitMap а HBitMap)
Width : LongInt; // Ширина текстуры
Height : LongInt; // Высота текстуры
End;
TBuffer = Record // Буфер вывода
DC : HDC; // Контекст буфера
Tex : TTexture; // Текстура буфера
End;
TWarehouse = Record // Склад текстур (полезно иметь такой)
Buffer : TBuffer; // Буфер
Button : TTexture; // Кнопка
End;Syhi-подсветка кода
Теперь опишем необходимые переменные:
Application : TApplication; // Зачем? А так удобнее!
Form : Tform; // Форма
Warehouse : TWarehouse; // СкладSyhi-подсветка кода
Настало время заняться изображением кнопки: я возьму изображение 64 х 64 и помещу его в папку с проектом программы с именем «Button.bmp». Теперь займемся самим кодом программы (данный код располагается в юните UNTForm):
Begin
BitBlt(Form.Image.DC, // Для нашего уровня знаний – это самый быстрый способ рисования
0, 0, 800, 600, Warehouse.Buffer.DC, 0, 0, SRCCOPY);
End;
Procedure Draw(Var T : TTexture; X,Y : Integer); // Этой процедурой мы будем рисовать текстуру на буфере
Var
Loc : HDC;
Begin
Loc := CreateCompatibleDC(Warehouse.Buffer.DC); // Создадим контекст
SelectObject(Loc, T.Bitmap); // Применим его к текстуре
BitBlt(Warehouse.Buffer.DC, X, Y, T.Width, T.Height, Loc, 0, 0, SRCCOPY); // Нарисуем его на буфере
DeleteDC(Loc); // Освободим контекст
End;
Procedure VirtualDraw(Var Source : Ttexture); // Эта процедура позволит нам определить размеры
Var // изображения, которое в нее загружено
Bit : BitMap;
Begin
GetObject(Source.Bitmap, SizeOf(Bit), @Bit); // Получим всю информацию о изображении
Source.Height := Bit.bmHeight; // Запомним высоту
Source.Width := Bit.bmWidth; // Запомним ширину
End;
Procedure LoadHB(FileName : PChar; Var Tex : Ttexture); // Эта процедура грузит битмап из файла
Begin
Tex.Bitmap := LoadImage(GetModuleHandle(Nil), FileName, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE);
VirtualDraw(Tex); // Узнаем параметры текстуры
End;Syhi-подсветка кода
В секции Interface разместим следующие процедуры:
Procedure Draw(Var T : TTexture; X,Y : Integer);
Procedure LoadHB(FileName : PChar; Var Tex : Ttexture);Syhi-подсветка кода
Итак, процедуры работы с графикой мы написали. Теперь напишем процедуры создания и обслуживания формы.
Begin
Form.Handle := CreateWindowEx(0, ‘TpanicForm’, »,
WS_POPUP, // Оно будет без бордюра и невидимым
Form.Left, // Его отступ слева
Form.Top, // Его отступ справа
Form.Width, // Его ширина
Form.Height, // его высота
0, 0,
Application.Handle, Nil);
Form.Image.Handle := CreateWindow(‘Static’, » ,// Создадим изображение на форме (TImage в VCL)
WS_CHILD Or SS_BITMAP Or WS_VISIBLE, // Оно видимое
0,
0,
Form.Width, // Размеры выставим по размерам формы
Form.Height,
Form.Handle, // Родителем укажем форму
0,
Application.Handle,
Nil);
SetClassLong(Form.Handle, GCL_HBRBACKGROUND, CreateSolidBrush($FF00FF));
// Закрасим фон формы розовым цветом – он будет прозрачным
SetWindowLong(Form.Handle,
GWL_EXSTYLE,
GetWindowLong(Form.Handle,
GWL_EXSTYLE) Or WS_EX_LAYERED Or WS_EX_TOOLWINDOW);
// Предыдущей командой мы убрали кнопку с панели задач и дали ему право иметь прозрачные цвета
SetLayeredWindowAttributes(Form.Handle,
$FF00FF,
0,
LWA_COLORKEY); // Задаем прозрачный цвет – розовый ($BBGGRR)
Form.Image.DC := GetDC(Form.Image.Handle); // Создадим контекст изображения
Warehouse.Buffer.DC := CreateCompatibleDC(Form.Image.DC); // И создадим контекст буфера
Warehouse.Buffer.Tex.Bitmap := CreateCompatibleBitmap(Form.Image.DC, // Создадим буфер
Form.Width, // Его размеры будут равны размерам формы
Form.Height);
VirtualDraw(Warehouse.Buffer.Tex); // «Виртуально» нарисуем буфер, узнаем его размеры
SelectObject(Warehouse.Buffer.DC, Warehouse.Buffer.Tex.Bitmap); // Применим текстуру буфера к нему
End;
Procedure MoveOnTop; // Переместим форму поверх всех окон
Begin
SetWindowPos(Form.Handle,
HWND_TOPMOST,
Form.Left,
Form.Top,
Form.Width,
Form.Height,
SWP_NOACTIVATE Or SWP_NOMOVE Or SWP_NOSIZE);
End;
Procedure HideAll; // Чтобы свернуть все окна просто эмулируем сокращение Win + D
Begin
Keybd_event(VK_LWIN,0,0,0); // Нажали Win
Keybd_event(VK_D ,0,0,0); // Нажали D
Keybd_event(VK_D ,0,KEYEVENTF_KEYUP,0); // Отпустили D
Keybd_event(VK_LWIN,0,KEYEVENTF_KEYUP,0); // Отпустили Win
End;
Procedure TimerProc(hwnd : HWND; uMsg, idEvent : UINT; dwTime : DWORD); StdCall; // Таймер
Begin
Draw(Warehouse.Button, 0, 0); // Нарисуем кнопку на буфере
DrawB; // Нарисуем буфер на экране
End;
Function WindowProc(Hand, Mess :LongWord; wParam, lParam: LongInt): LongInt; StdCall; // Обработчик
Begin
Result := DefWindowProc(Hand, Mess, wParam, lParam);
Case Mess Of
WM_DESTROY : ShutDown; // При уничтожении уничтожимся
WM_LBUTTONDOWN : HideAll; // При нажатии – свернем все
WM_PAINT : MoveOnTop; // При отрисовке – перенесем вверх
End;
End;
Procedure RegisterApp; // Регистрация приложения в системе
Begin
Application.Handle := GetModuleHandle(nil);
With Application.WinClass do
Begin
Style := CS_HREDRAW Or CS_VREDRAW; // Даем приложению право прозрачности и отрисовки
lpfnWndProc := @WindowProc; // Задаем обработчик формы
hInstance := Application.Handle;
hbrBackground := COLOR_BTNFACE + 1;
lpszClassName := ‘TPanicForm’;
hCursor := LoadCursor(0, IDC_ARROW);
End;
InitCommonControls; // Эта процедура нужна для возможности управления контролами Windows.
RegisterClass(Application.WinClass); // Зарегистрируем.
End;
Procedure ShutDown; // Выключение приложения
Begin
KillTimer(0, TimerVar); // Уничтожим таймер
DeleteDC(Warehouse.Buffer.DC); // Уничтожим контекст буфера
DeleteDC(Form.Image.DC); // Уничтожим контекст изображения
UnRegisterClass(‘TPanicForm’, Application.Handle); // Удалим класс из системы
ExitProcess(Application.Handle); // И самоуничтожимся
End;Syhi-подсветка кода
Не забудьте, что процедуры работы с окном должны располагаться после процедур работы с графикой – ведь мы используем их там. Теперь импортируем функцию InitCommonControls – ведь в модуле Windows ее нет.
Так же поместим в Interface следующие описания функций:
Procedure TimerProc(hwnd : HWND; uMsg, idEvent : UINT; dwTime : DWORD); StdCall;
Procedure RegisterApp;Syhi-подсветка кода
Теперь опишем переменную:
Эта переменная будет содержать указатель на таймер для отрисовки.
Плошки и плюшки
Все-таки, просто создав окно кнопки, мы кое-что упускаем – где будет располагаться окно? Давайте подумаем: лучшее место над кнопкой «Пуск». Как рассчитать координаты? Да очень просто! Для этого возьмем разрешение экрана (высоту) и вычтем из него высоту панели задач. Позвольте, это еще не все. Еще нужно будет вычесть высоту формы, которую мы создадим (см. рисунок 3):
Рис. 3. Формула расчета вертикальной позиции
Итак, создадим необходимую процедуру:
Var
R : Rect;
H : Handle;
W : Integer;
PH : Integer;
Begin
W := GetSystemMetrics(SM_CYSCREEN); // Простое получение высоты экрана
ZeroMemory(@R, SizeOf(R)); // На всякий случай уберем мусор из R
H := FindWindow(‘Shell_TrayWnd’, Nil); // Найдем хендл панели задач
GetWindowRect(H, R); // Получим размеры панели
PH := R.Bottom — R.Top; // вычислим высоту
Form.Top := W — PH — Form.Height; // И применим нашу «волшебную» формулу
End;Syhi-подсветка кода
Не забудем ее экспортировать:
Заполнение проекта
Настало время поработать с файлом pncbtn.lpr!
{$mode objfpc}{$H+}
uses
Windows,
UNTForm; // Подключим наш модуль
begin
LoadHB(PChar(‘button.bmp’), Warehouse.Button); // Загрузим изображение
Form.Width := Warehouse.Button.Width; // Возьмем размеры формы равные размерам изображения
Form.Height := Warehouse.Button.Height;
Form.Left := 0; // Форма располагается слева
CalculatePos; // Рассчитаем координаты
RegisterApp; // Зарегистрируем приложение
CreateMainWindow; // Создадим окно
ShowWindow(Form.Handle, SW_SHOW); // И покажем нашу кнопку на экране
TimerVar := SetTimer(0, 0, 1000, @TimerProc); // Создадим таймер для отрисовки.
// 1000 – это интервал обновления таймера ( в мс.) чем он меньше – тем чаще он будет выполняться.
// Нам хватит и раза в секунду.
While (GetMessage(Application.MSG, 0, 0, 0)) do // Теперь запустим цикл сбора сообщений
Begin
TranslateMessage(Application.MSG);
DispatchMessage(Application.MSG);
End;
end.Syhi-подсветка кода
Завершающий штрих
Что ж, осталось совершить один маленький штрих перед компиляцией – это обеспечить выключение кнопки. Добавим в WindowProc следующую строку:
Свойства проекта
Скомпилируем и запустим проект. Лично у меня он запустился и прекрасно исполняет свои функции – враг не пройдет. А если пройдет, то ничего не увидит 🙂 Но, кое-что мы упустили… Зайдите в папку с проектом и посмотрите на размер приложения (см. рисунок 4):
Рис. 4. Нехило, учитывая, что оно написано на чистом WinAPI
Пройдем в [Проект] ? [Параметры проекта…]. Там удалим из проекта иконку. И уберем галки с «Создавать application bundle» и «Создавать Manifest файл». Так же уберем галки с «Главный модуль имеет Application.Title и Application.CreateForm».
Пройдем в [Проект] ? [Параметры компилятора…]. Там выставим следующие параметры (возле каждого параметра в скобках стоит его обозначение):
-O3 // Уровень оптимизации
-Ou // Ненадежные оптимизации
-Os // Приоритет размера над скоростью
-gl // Показывать номера строк при компиляции с ошибками
-Xs // Вырезать символы из исполняемого файла
-Xg // Убирать отладочную информацию
-XX // Умное связывание
-WG // Графическое приложение
Скомпилируем приложение (см. рисунок 5):
Рис. 5. Почти прекрасно, но чего-то не хватает
Почти идеально. Берем в руки UPX и натравляем его на приложение со следующими параметрами:
Вот теперь идеально. Думаю, что лучше теперь сможет сделать только мастер ассемблера (см. рисунок 6):
Рис. 6. Само совершенство
Теперь добавим кнопку в автозагрузку – положим ярлык на нее в папку [Все программы] ? [Автозапуск].
Заключение
Все! Теперь вас будет проблематично захватить врасплох. Но помните, главное – мера. Даже, если Вы выполнили всю работу и сидите без дела, раскладывая пасьянс или удаляя шарики с поля, посматривайте – вдруг позади затаился шеф!
Ресурсы
- GNU ObjectPascal IDE «Lazarus» http://sourceforge.net/projects/lazarus/files
- Коллекция авторской панели быстрого запуска http://squary.ru
Статья из восьмого выпуска журнала «ПРОграммист».
Похожие статьи
Купить рекламу на сайте за 1000 руб
пишите сюда - alarforum@yandex.ru
Да и по любым другим вопросам пишите на почту
пеллетные котлы
Пеллетный котел Emtas
Наши форумы по программированию:
- Форум Web программирование (веб)
- Delphi форумы
- Форумы C (Си)
- Форум .NET Frameworks (точка нет фреймворки)
- Форум Java (джава)
- Форум низкоуровневое программирование
- Форум VBA (вба)
- Форум OpenGL
- Форум DirectX
- Форум CAD проектирование
- Форум по операционным системам
- Форум Software (Софт)
- Форум Hardware (Компьютерное железо)