CreateWindowEx(
WS_EX_TOPMOST, //поверх всех
'STATIC',
WinName, // const WinName = 'MainWClass';
SS_Center,
// стандартные горизонтальное, вертикальное положение, ширина и высота
Integer(CW_USEDEFAULT),
Integer(CW_USEDEFAULT),
Integer(CW_USEDEFAULT),
Integer(CW_USEDEFAULT),
0,//нет родительского окна
0,//нет меню
hInstance, // handle to application instance
nil); // no window-creation data
создание окна через CreateWindowEx
Хочу создать окно, которое будет содержать какой-то текст...ничего более. Мои цели :
1) Окно должно быть ПОВЕРХ всех окон
2) Не должно содержать названия (т.е. нужен просто текст.... как BorderStyle=bsNonе)
3) После создания через 2 секунды оно должно уничтожиться/скрыться.... (окно будет периодически показываться)
4) Желательно ещё, чтобы можно было менять цвет фона окна.
На данный момент пытаюсь сделать окно класса Static. (вроде бы подходит под мои требования.)
Пишу :
По 3-му пункту : окно создаётся в dll-ке, поэтому я не знаю, как быть..яж там никуда никакой компонент не запихну ,типа TTimer ((
В общем, подскажите, как выполнить 2-4 пункты ? !!!
1) Окно должно быть ПОВЕРХ всех окон
2) Не должно содержать названия (т.е. нужен просто текст.... как BorderStyle=bsNonе)
3) После создания через 2 секунды оно должно уничтожиться/скрыться.... (окно будет периодически показываться)
4) Желательно ещё, чтобы можно было менять цвет фона окна.
На данный момент пытаюсь сделать окно класса Static. (вроде бы подходит под мои требования.)
Пишу :
Код:
По 3-му пункту : окно создаётся в dll-ке, поэтому я не знаю, как быть..яж там никуда никакой компонент не запихну ,типа TTimer ((
В общем, подскажите, как выполнить 2-4 пункты ? !!!
[quote=SerMax]По 3-му пункту : окно создаётся в dll-ке, поэтому я не знаю, как быть..яж там никуда никакой компонент не запихну ,типа TTimer (([/quote]
Используй SetTimer
Используй SetTimer
А необходимость создавать окно через CreateWindowEx??? А если в ДЛЛ запихнуть форму с таймером и создать процедуру создания окна OpenForm типа Form1:=TForm1.Create(nil)??? А из программы вызывать эту процедуру (OpenForm)??? И вторую процедуру которая при вызове из программы будет уничтожать это окно???
Тут в одной из тем предыдущих выяснилось, что модуль SysUtils нежелателен в библиотеке, цепляющейся ко всем процессам. Так что пытаюсь без него. Да и просто интересно, как на WinApi это организовать всё-таки
цвет фона
wc.hbrBackground:=COLOR_BTNFACE;//присваивай что хочешь
wc.hbrBackground:=COLOR_BTNFACE;//присваивай что хочешь
Цитата: ahilles
цвет фона
wc.hbrBackground:=COLOR_BTNFACE;//присваивай что хочешь
wc.hbrBackground:=COLOR_BTNFACE;//присваивай что хочешь
Это делается ДО регистрации класса...а я ХОТЕЛ использовать уже существующий класс STATIC....но видать придётся всё-таки самому создавать свой класс
чтобы оно могло скзакрыться через некоторое время делай так
но это наиболее простой метод.....
удали стоки
While GetMessage(Mesg,0,0,0) do
begin
TranslateMessage(Mesg);
DispatchMessage(Mesg);
end;
вместо них напиши вот это
Delay(2000);
exitprocess(0);
только перед этим нормально обнови своё окно потому что потом оно не будет обновляться и сразу закроется
но это наиболее простой метод.....
Код:
procedure Delay;
var ev:THandle;
name:string;
begin
name:=IntToStr(random(1000000));
ev:=CreateEvent(nil,true,false,pchar(name));
WaitForSingleObject(ev,DelayTime);
CloseHandle(ev);
end;
var ev:THandle;
name:string;
begin
name:=IntToStr(random(1000000));
ev:=CreateEvent(nil,true,false,pchar(name));
WaitForSingleObject(ev,DelayTime);
CloseHandle(ev);
end;
удали стоки
While GetMessage(Mesg,0,0,0) do
begin
TranslateMessage(Mesg);
DispatchMessage(Mesg);
end;
вместо них напиши вот это
Delay(2000);
exitprocess(0);
только перед этим нормально обнови своё окно потому что потом оно не будет обновляться и сразу закроется
Цитата: SerMax
Это делается ДО регистрации класса...а я ХОТЕЛ использовать уже существующий класс STATIC....но видать придётся всё-таки самому создавать свой класс
Через SendMessage сообщение WM_SETFONT смотри справку
WM_SETFONT
Приложение отправляет сообщение WM_SETFONT для указания шрифта, который будет использовать элемент управления при выводе текста.
Так мне-то не шрифт надо установить свой, а фоновый цвет!
Приложение отправляет сообщение WM_SETFONT для указания шрифта, который будет использовать элемент управления при выводе текста.
Так мне-то не шрифт надо установить свой, а фоновый цвет!
хмммм...так...чувствую понаспотыкаюсь я на грабли ...и не раз
...что-то то-ли я туплю, то ли.....взял пример из DelphiWorld.
При создании окна выдаётся ошибка...что не так ?
...что-то то-ли я туплю, то ли.....взял пример из DelphiWorld.
Код:
var
hwndMain: THandle;
wc : TWndClassEx;
.......
wc.cbSize:=sizeof(wc);
wc.style:=cs_hredraw or cs_vredraw;
wc.lpfnWndProc:=@WindowProc; //функция, описана
wc.cbClsExtra:=0;
wc.cbWndExtra:=0;
wc.hInstance:=HInstance;
wc.hIcon:=LoadIcon(0,idi_application);
wc.hCursor:=LoadCursor(0,idc_arrow);
wc.hbrBackground:=COLOR_BTNFACE+1;
wc.lpszMenuName:=nil;
wc.lpszClassName:='My';
if RegisterClassEx (Wc) = 0 then
MessageBox (0, 'Invalid class registration',
'Error', MB_OK);
hwndMain := CreateWindowEx(
WS_EX_TOPMOST,
wc.lpszClassName, / 'My' как вариант...
WinName, // const WinName = 'MainWClass';
WS_POPUP,
Integer(CW_USEDEFAULT),
Integer(CW_USEDEFAULT),
Integer(CW_USEDEFAULT),
Integer(CW_USEDEFAULT),
0,
0,
hInstance, // handle to application instance
nil); // no window-creation data
hwndMain: THandle;
wc : TWndClassEx;
.......
wc.cbSize:=sizeof(wc);
wc.style:=cs_hredraw or cs_vredraw;
wc.lpfnWndProc:=@WindowProc; //функция, описана
wc.cbClsExtra:=0;
wc.cbWndExtra:=0;
wc.hInstance:=HInstance;
wc.hIcon:=LoadIcon(0,idi_application);
wc.hCursor:=LoadCursor(0,idc_arrow);
wc.hbrBackground:=COLOR_BTNFACE+1;
wc.lpszMenuName:=nil;
wc.lpszClassName:='My';
if RegisterClassEx (Wc) = 0 then
MessageBox (0, 'Invalid class registration',
'Error', MB_OK);
hwndMain := CreateWindowEx(
WS_EX_TOPMOST,
wc.lpszClassName, / 'My' как вариант...
WinName, // const WinName = 'MainWClass';
WS_POPUP,
Integer(CW_USEDEFAULT),
Integer(CW_USEDEFAULT),
Integer(CW_USEDEFAULT),
Integer(CW_USEDEFAULT),
0,
0,
hInstance, // handle to application instance
nil); // no window-creation data
При создании окна выдаётся ошибка...что не так ?
Чёрт! В этом DelphiWorld ещё и примеры с ошибками даны, что приходится сидеть и часами разбираться. В итоге ошибка оказывается элементарной, но малозаметной. Так что понял, в чём глюк был.
С одним разобрались....будем разбираться дальше.
С одним разобрались....будем разбираться дальше.
Так...вроде разобрался с созданием окна, теперь проблема с его уничтожением.
Есть глобальные переменные :
Я создаю окно ВНУТРИ библиотеки...при инициализации
Собственно, сама CreateWin
Моё созданное окно не умеет обрабатывать сообщения, т.к. у меня в библиотеке ещё есть клавиатурный хук...и ,след-но, до него сообщения просто не доходят (или я не знаю, как это сделать).
При выходе из программы выдаётся ошибка, связанная с памятью....Предполагаю, что неправильно освобождаю ресурсы, отведённые для класса/окна.
Наверное, что-то неправильно написал ? ...Просто с нуля всё это понимал, мало в этом разбираюсь.
Есть глобальные переменные :
Код:
hwndMain: THandle;
HDC:HWND;
wc : TWndClassEx;
HDC:HWND;
wc : TWndClassEx;
Я создаю окно ВНУТРИ библиотеки...при инициализации
Код:
begin
DLLProc:= @DLLEntryPoint;
DLLEntryPoint(DLL_PROCESS_ATTACH);
end.
DLLProc:= @DLLEntryPoint;
DLLEntryPoint(DLL_PROCESS_ATTACH);
end.
Код:
procedure DLLEntryPoint(dwReason: DWord); stdcall;
begin
case dwReason of
DLL_PROCESS_ATTACH: CreateWin;
DLL_PROCESS_DETACH:
begin
ReleaseDC(hwndMain,HDC);
CloseHandle(hwndMain);
UnRegisterClass(wc.lpszClassName,HInstance);
end;
end;
end;
begin
case dwReason of
DLL_PROCESS_ATTACH: CreateWin;
DLL_PROCESS_DETACH:
begin
ReleaseDC(hwndMain,HDC);
CloseHandle(hwndMain);
UnRegisterClass(wc.lpszClassName,HInstance);
end;
end;
end;
Собственно, сама CreateWin
Код:
procedure CreateWin;
begin
wc.cbSize:=sizeof(wc);
wc.style:=cs_hredraw or cs_vredraw;
wc.lpfnWndProc:=@MyProc;
wc.cbClsExtra:=0;
wc.cbWndExtra:=0;
wc.hInstance:=HInstance;
wc.hIcon:=LoadIcon(0,idi_application);
wc.hCursor:=LoadCursor(0,idc_arrow);
wc.hbrBackground:=2; // 0..25
wc.lpszMenuName:=nil;
wc.lpszClassName:='My';
if RegisterClassEx (wc) = 0 then
MessageBox (0, 'Invalid class registration','Plain API', MB_OK);
hwndMain := CreateWindowEx(
WS_EX_TOPMOST,
'My',
'',
WS_POPUP,
480,
0,
120,
30,
0,//нет родительского окна
0,//нет меню
hInstance, // handle to application instance
nil); // no window-creation data
HDC:=GetDC(hWndMain); //получаю контекст устройства.
// ShowWindow(hwndMain, SW_SHOW);
end;
begin
wc.cbSize:=sizeof(wc);
wc.style:=cs_hredraw or cs_vredraw;
wc.lpfnWndProc:=@MyProc;
wc.cbClsExtra:=0;
wc.cbWndExtra:=0;
wc.hInstance:=HInstance;
wc.hIcon:=LoadIcon(0,idi_application);
wc.hCursor:=LoadCursor(0,idc_arrow);
wc.hbrBackground:=2; // 0..25
wc.lpszMenuName:=nil;
wc.lpszClassName:='My';
if RegisterClassEx (wc) = 0 then
MessageBox (0, 'Invalid class registration','Plain API', MB_OK);
hwndMain := CreateWindowEx(
WS_EX_TOPMOST,
'My',
'',
WS_POPUP,
480,
0,
120,
30,
0,//нет родительского окна
0,//нет меню
hInstance, // handle to application instance
nil); // no window-creation data
HDC:=GetDC(hWndMain); //получаю контекст устройства.
// ShowWindow(hwndMain, SW_SHOW);
end;
Моё созданное окно не умеет обрабатывать сообщения, т.к. у меня в библиотеке ещё есть клавиатурный хук...и ,след-но, до него сообщения просто не доходят (или я не знаю, как это сделать).
При выходе из программы выдаётся ошибка, связанная с памятью....Предполагаю, что неправильно освобождаю ресурсы, отведённые для класса/окна.
Наверное, что-то неправильно написал ? ...Просто с нуля всё это понимал, мало в этом разбираюсь.
уничтожай через DestoyWindow
Ну как всегда - ошибка в том моменте, который я меньше всего понимаю...сделал через DestroyWindow(HANDLE);
Сначала всё равно были ошибки....потом посоветовали убрать StdCall в
О радость ! Заработало !! Может кто-нибудь объяснить, что это изменило ?? Ибо описание директивы StdCall :
Параметры помещаются в стек слева направо. Очистка стека осуществляется вызываемой процедурой. Этот вызов обеспечивает обработку фиксированного числа параметров
мне ни очём не говорит..не понимаю я эти моменты :(
Сначала всё равно были ошибки....потом посоветовали убрать StdCall в
Код:
procedure DLLEntryPoint(dwReason: DWord); stdcall;
begin
case dwReason of
DLL_PROCESS_ATTACH:
begin
CreateWin;
end;
DLL_PROCESS_DETACH:
..............
begin
case dwReason of
DLL_PROCESS_ATTACH:
begin
CreateWin;
end;
DLL_PROCESS_DETACH:
..............
О радость ! Заработало !! Может кто-нибудь объяснить, что это изменило ?? Ибо описание директивы StdCall :
Параметры помещаются в стек слева направо. Очистка стека осуществляется вызываемой процедурой. Этот вызов обеспечивает обработку фиксированного числа параметров
мне ни очём не говорит..не понимаю я эти моменты :(
Ох..да что-ж это такое. Коли не во время работы глючит, так в конце.
Замечен такой момент....код в библиотеке :
Запускаем программу из среды Delphi (компилируем в общем)...отмечу, что если тут же закрыть программУ, то всё ок. Но суть не в этом. Я нажимаю на кнопи (происходит обработка в самом хуке). После этого я закрываю программу. Ест-но появляется 2 окна...одно от Delphi32, другое от моей программы. В обоих по надписи
ShowMessage('do vihoda!');
Если я нажимаю всё в окне Delphi32, то после
ShowMessage('Posle Vsego!');
выводится ошибка (или даже не выводится) и Delphi просто закрывается и после закрытия точно ошибка вылазит, связанная с памятью. Если же нажимать сначала всё в окне моей программы (т.е. дать ей первой выгрузиться), то всё ок, Delphi спокойно выгружает из себя библиотеку.
Для чего всё это ?? Дело в том, что если пустить ан компиляцию без этих проверок, то при закрытии выдаётся ошибка Delphi (т.е. Delphi пытается выгрузить библиотеку раньше, чем это делает сама программа...в итоге ошибка).
НО..если я пускаю .EXE файл программы, то всё работает на ура. При выходе ни один проесс не даёт ошибки. Только вот при выключении компа Explorer выдаёт ту же ошибку, что и Delphi (опять же видать пытается сделать работу до того, как сама программа выполнит операции по своему закрытию).
Грешу на неправильность/неверность операций при выходе из программы.
Замечен такой момент....код в библиотеке :
Код:
DLL_PROCESS_DETACH:
begin
ShowMessage('do vihoda!');
ReleaseDC(hwndMain,HDC);
ShowMessage('Posle Release!');
DestroyWindow(hwndMain);
ShowMessage('Posle Destroy Window!');
UnRegisterClass(wc.lpszClassName,HInstance); //а что с этим..что без этого - глючит
ShowMessage('Posle Vsego!');
end;
begin
ShowMessage('do vihoda!');
ReleaseDC(hwndMain,HDC);
ShowMessage('Posle Release!');
DestroyWindow(hwndMain);
ShowMessage('Posle Destroy Window!');
UnRegisterClass(wc.lpszClassName,HInstance); //а что с этим..что без этого - глючит
ShowMessage('Posle Vsego!');
end;
Запускаем программу из среды Delphi (компилируем в общем)...отмечу, что если тут же закрыть программУ, то всё ок. Но суть не в этом. Я нажимаю на кнопи (происходит обработка в самом хуке). После этого я закрываю программу. Ест-но появляется 2 окна...одно от Delphi32, другое от моей программы. В обоих по надписи
ShowMessage('do vihoda!');
Если я нажимаю всё в окне Delphi32, то после
ShowMessage('Posle Vsego!');
выводится ошибка (или даже не выводится) и Delphi просто закрывается и после закрытия точно ошибка вылазит, связанная с памятью. Если же нажимать сначала всё в окне моей программы (т.е. дать ей первой выгрузиться), то всё ок, Delphi спокойно выгружает из себя библиотеку.
Для чего всё это ?? Дело в том, что если пустить ан компиляцию без этих проверок, то при закрытии выдаётся ошибка Delphi (т.е. Delphi пытается выгрузить библиотеку раньше, чем это делает сама программа...в итоге ошибка).
НО..если я пускаю .EXE файл программы, то всё работает на ура. При выходе ни один проесс не даёт ошибки. Только вот при выключении компа Explorer выдаёт ту же ошибку, что и Delphi (опять же видать пытается сделать работу до того, как сама программа выполнит операции по своему закрытию).
Грешу на неправильность/неверность операций при выходе из программы.
Собственно, процесс закрытия программы.
в основной форме :
А вот что в библиотеке :
Ну и на всякий сама обработка сообщения моего создаваемого через CreateWindow окна (hwndMain которое)
Директива StdCall стоит только у function MyProc. Если её оттуда убрать, то ошибка выдаётся через 5 секунд после пуска программы.
Я опять бессилен здесь... Получается, что иногда первой выгружается не сама программа (как правильно должно быть), а библиотека из какого-нибудь процесса...и вылетает ошибка.
Как можно это исправить ?
в основной форме :
Код:
procedure TChange_Volume.FormClose(Sender: TObject; var Action: TCloseAction);
begin
unhookwindowshookex(hookhandle); //убираю ловушку
freelibrary(hinstdll); //освобождаю из памяти мою dll
end;
begin
unhookwindowshookex(hookhandle); //убираю ловушку
freelibrary(hinstdll); //освобождаю из памяти мою dll
end;
А вот что в библиотеке :
Код:
procedure DLLEntryPoint(dwReason: DWord);
begin
case dwReason of
DLL_PROCESS_ATTACH:
begin
CreateWin;
end;
DLL_PROCESS_DETACH:
begin
ReleaseDC(hwndMain,HDC);
DestroyWindow(hwndMain);
UnRegisterClass(wc.lpszClassName,HInstance);
end;
end;
end;
begin
case dwReason of
DLL_PROCESS_ATTACH:
begin
CreateWin;
end;
DLL_PROCESS_DETACH:
begin
ReleaseDC(hwndMain,HDC);
DestroyWindow(hwndMain);
UnRegisterClass(wc.lpszClassName,HInstance);
end;
end;
end;
Ну и на всякий сама обработка сообщения моего создаваемого через CreateWindow окна (hwndMain которое)
Код:
function MyProc(Window: HWnd; AMessage, WParam, LParam: Longint): Longint; stdcall;
begin
//подпрограмма обработки сообщений
case AMessage of
WM_DESTROY:
begin
PostQuitMessage(0);
Result := 0;
end;
wm_Timer:
begin
ShowWindow(hwndMain, SW_HIDE);
end;
else
Result := DefWindowProc(Window, AMessage, WParam, LParam);
end;
end;
begin
//подпрограмма обработки сообщений
case AMessage of
WM_DESTROY:
begin
PostQuitMessage(0);
Result := 0;
end;
wm_Timer:
begin
ShowWindow(hwndMain, SW_HIDE);
end;
else
Result := DefWindowProc(Window, AMessage, WParam, LParam);
end;
end;
Директива StdCall стоит только у function MyProc. Если её оттуда убрать, то ошибка выдаётся через 5 секунд после пуска программы.
Я опять бессилен здесь... Получается, что иногда первой выгружается не сама программа (как правильно должно быть), а библиотека из какого-нибудь процесса...и вылетает ошибка.
Как можно это исправить ?
тебе какой порядок выгрузки нужен?
По идее...при выходе из программы самой (основной), сначала она выгружается..а потом всё выгружается из других процессов. Но видать и не так даже, т.к. ошибки вылазят, когда просто закываю приложение (аську, проигрыватель и т.п.)...в них выскакивает ошибка, а другие (вообще третьи приложения), просто тихо-мирно закрываются (агент например). Где-то видать ошибка в памяти ,которая сразу не видна...а потом даёт о себе знать.
Я могу дать всю программу,дабы понять проблему,там легко разобраться ,ничего сложного нет. Всё откомментированно..
Я могу дать всю программу,дабы понять проблему,там легко разобраться ,ничего сложного нет. Всё откомментированно..
Поступил, как предложили люди - стал сначала выгружать хук при выгрузке самой библиотеки. В Delphi перестала вылетать ошибка -кул. Но эт не всё.
Обнаружилось, что при выходе из основной программы, она выгружает из своего АП библиотеку...а в других процессаах она висит..это вполне могло быть всему причиной.
Я не понимаю...как ваще доходит до других процессов, что основная прога выгружена, и надо выгрузить из своего АП библиотеку ?? ...я выгружаю библиотеку из основной программы..а как до других программ доходит, что после этого нужно выгрузить и у себя её ? ??
Может выгружаю неправильно....при выходе из самой программы
из других процессов библиотека не выгружается....т.е. нету сигнала о том, чтобы они выгрузили библиотеку.... (обработчик выгрузки библиотеки есть...но до него даже дело не доходит..основная прога выгрузилась, а сообщить об этом други и не вздумала :( )
Обнаружилось, что при выходе из основной программы, она выгружает из своего АП библиотеку...а в других процессаах она висит..это вполне могло быть всему причиной.
Я не понимаю...как ваще доходит до других процессов, что основная прога выгружена, и надо выгрузить из своего АП библиотеку ?? ...я выгружаю библиотеку из основной программы..а как до других программ доходит, что после этого нужно выгрузить и у себя её ? ??
Может выгружаю неправильно....при выходе из самой программы
Код:
procedure TChange_Volume.FormClose(Sender: TObject; var Action: TCloseAction);
begin
freelibrary(hinstdll);
ExitProcess(0); //по идее и не нужно..но для верности
end;
begin
freelibrary(hinstdll);
ExitProcess(0); //по идее и не нужно..но для верности
end;
из других процессов библиотека не выгружается....т.е. нету сигнала о том, чтобы они выгрузили библиотеку.... (обработчик выгрузки библиотеки есть...но до него даже дело не доходит..основная прога выгрузилась, а сообщить об этом други и не вздумала :( )
если хук перестаёт обрабатываться то значит всё нормально,
а так если подумать..... пускай висит
а так если подумать..... пускай висит
Цитата: SerMax
Поступил, как предложили люди - стал сначала выгружать хук при выгрузке самой библиотеки.
т.е. если библиотека не выгружена, то и хук не выгружен !!!!! Да и в принципе это некрасивый стиль программирования получается. Если библиотека висит, значит dll-файл нельзя удалить (к примеру)...это уже нехорошо.