/ КОМПЬЮТЕРЫ И ПО / Языки программирования / Delphi

Выпуск № 1029
от 09.01.2008, 10:35

Вопрос № 116.709

Доброго времени суток! Будьте добры, киньтесь примером кода на Дельфи, позволяющим определить активность пользователя, т.е. как это сделано в скринсейвере, если скажем 30 сек нет перемещения мыши или нажатия клавиш - то вызвать какое-либо событие.

Отправлен: 03.01.2008, 10:50 Вопрос задал: Remnew Anatoliy (статус: 1-ый класс) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Drbear Здравствуйте, Remnew Anatoliy! Вам, скорее всего, необходим hook, т.е. "ловушки" на события системы. Попробуйте использовать Hook-функции: CallMsgFilter CallNextHookEx CallWndProc CallWndRetProc CBTProc DebugProc ForegroundIdleProc GetMsgProc JournalPlaybackProc JournalRecordProc KeyboardProc MessageProc MouseProc SetWindowsHookEx ShellProc SysMsgProc UnhookWindowsHookEx есть еще пример кода (программа Sendkeys). Код не мой и не проверен, найден когда-то в интернете. Приложение: program Project1; uses Forms, Unit1 in '..Hooks1Unit1.pas' {Form1}; {$R *.RES} begin Application.Initialize; Application.CreateForm(TForm1, Form1); Application.Run; end. // *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* // library SendKey; uses SysUtils, Classes, Windows, Messages; const {пользовательские сообщения} wm_LeftShow_Event = wm_User + 133; wm_RightShow_Event = wm_User + 134; wm_UpShow_Event = wm_User + 135; wm_DownShow_Event = wm_User + 136; {handle для ловушки} HookHandle: hHook = 0; var SaveExitProc: Pointer; {собственно ловушка} function Key_Hook(Code: integer; wParam: word; lParam: Longint): Longint; stdcall; export; var H: HWND; begin {если Code>=0, то ловушка может обработать событие} if (Code >= 0) and (lParam and $40000000 = 0) then begin {ищем окно по имени класса и по заголовку (Caption формы управляющей программы должен быть равен 'XXX' !!!!)} H := FindWindow('TForm1', 'XXX'); {это те клавиши?} case wParam of VK_Left: SendMessage(H, wm_LeftShow_Event, 0, 0); VK_Right: SendMessage(H, wm_RightShow_Event, 0, 0); VK_Up: SendMessage(H, wm_UpShow_Event, 0, 0); VK_Down: SendMessage(H, wm_DownShow_Event, 0, 0); end; {если 0, то система должна дальше обработать это событие} {если 1 - нет} Result := 0; end else if Code < 0 {если Code<0, то нужно вызвать следующую ловушку} then Result := CallNextHookEx(HookHandle, Code, wParam, lParam); end; {при выгрузке DLL надо снять ловушку} procedure LocalExitProc; far; begin if HookHandle <> 0 then begin UnhookWindowsHookEx(HookHandle); ExitProc := SaveExitProc; end; end; exports Key_Hook; {инициализация DLL при загрузке ее в память} begin {устанавливаем ловушку} HookHandle := SetWindowsHookEx(wh_Keyboard, @Key_Hook, hInstance, 0); if HookHandle = 0 then MessageBox(0, 'Unable to set hook!', 'Error', mb_Ok) else begin SaveExitProc := ExitProc; ExitProc := @LocalExitProc; end; end. // *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* // object Form1: TForm1 Left = 200 Top = 104 Width = 544 Height = 375 Caption = 'XXX' Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.style="[]" PixelsPerInch = 96 TextHeight = 13 object Label1: TLabel Left = 128 Top = 68 Width = 32 Height = 13 Caption = 'Label1' end end // *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* // unit Unit1; interface uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; {пользовательские сообщения} const wm_LeftShow_Event = wm_User + 133; wm_RightShow_Event = wm_User + 134; wm_UpShow_Event = wm_User + 135; wm_DownShow_Event = wm_User + 136; type TForm1 = class(TForm) Label1: TLabel; procedure FormCreate(Sender: TObject); private //Обработчики сообщений procedure WM_LeftMSG(var M: TMessage); message wm_LeftShow_Event; procedure WM_RightMSG(var M: TMessage); message wm_RightShow_Event; procedure WM_UpMSG(var M: TMessage); message wm_UpShow_Event; procedure WM_DownMSG(var M: TMessage); message wm_DownShow_Event; end; var Form1: TForm1; P: Pointer; implementation {$R *.DFM} //Загрузка DLL function Key_Hook(Code: integer; wParam: word; lParam: Longint): Longint; stdcall; external 'SendKey' name 'Key_Hook'; procedure TForm1.WM_LefttMSG(var M: TMessage); begin Label1.Caption := 'Left'; end; procedure TForm1.WM_RightMSG(var M: TMessage); begin Label1.Caption := 'Right'; end; procedure TForm1.WM_UptMSG(var M: TMessage); begin Label1.Caption := 'Up'; end; procedure TForm1.WM_DownMSG(var M: TMessage); begin Label1.Caption := 'Down'; end; procedure TForm1.FormCreate(Sender: TObject); begin {если не использовать вызов процедуры из DLL в программе, то компилятор удалит загрузку DLL из программы} P := @Key_Hook; end; end.

Ответ отправил: Drbear (статус: 4-ый класс) Ответ отправлен: 03.01.2008, 11:03 Оценка за ответ: 4 Комментарий оценки: Спасибо за пример, но хотелось бы более простое решение.

Отвечает: Mishell Здравствуйте, Remnew Anatoliy! можно по таймеру проверять активность пользователя с пом. ф-ции GetLastInputInfo - см. пример в приложении Приложение: procedure TfmMain.Timer1Timer(Sender: TObject); var LII:TLastInputInfo; begin try FillChar(LII,SizeOf(LII),0); LII.cbSize:=SizeOf(LII); GetLastInputInfo(LII); if GetTickCount-LII.dwTime<1000 then begin // пользователь активен. // тут можно выставлять флаг активности // или инициировать некое событие ... end; except end; end;

Ответ отправил: Mishell (статус: 8-ой класс) Ответ отправлен: 03.01.2008, 11:13 Оценка за ответ: 4 Комментарий оценки: Спасибо, дали толчок в нужном направлении.

Вопрос № 116.745

Здравствуйте, уважаемые эксперты! Помогите, пожалуйста! Задача такова: дана вещественный массив, размещенный в StringGrid. Необходимо заменить все исходные элементы массива, кроме первого и последнего, по формуле Xi= (Xi-1+Xi+Xi+1)/3, т.е. брать по три элемента массива (1,2,3...2,3,4...3,4,5,...) и заменять их на их среднее арифметическое, помещая его соответственно на место элемента (2,3,4,...). Причем использовать при этом только старые значения массива. Большое спасибо!

Отправлен: 03.01.2008, 16:34 Вопрос задал: Mangoost (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Drbear Здравствуйте, Mangoost! Может быть такой код спасет Вас (написано на коленке, непроверено): на форме StringGrid и Button. Приложение: procedure TForm1.FormCreate(Sender: TObject); var x, y: Integer; begin StringGrid1.RowCount := 10; StringGrid1.ColCount := 10; StringGrid1.FixedCols := 0; StringGrid1.FixedRows := 0; Randomize; // i := 0; for y := 0 to StringGrid1.RowCount - 1 do begin for x := 0 to StringGrid1.ColCount - 1 do begin // выравниваем ячейки (для красоты) if y = 0 then StringGrid1.ColWidths[x] := StringGrid1.RowHeights[y]; // заполним грид случайными значениями StringGrid1.Cells[x, y] := IntToStr(Random(100)); // i := i + 1; end; end; end; procedure TForm1.Button1Click(Sender: TObject); var aInt: Array of Extended; aIntNew: Array of Extended; x, y, i, z: Integer; begin // размерность массива i := StringGrid1.ColCount * StringGrid1.RowCount; // зададим массивы SetLength(aInt, i); SetLength(aIntNew, i); // запишем старые данные z := 0; for y := 0 to StringGrid1.RowCount - 1 do for x := 0 to StringGrid1.ColCount - 1 do begin aInt[z] := StrToFloat(StringGrid1.Cells[x, y]); z := z + 1; end; // обнулим for y := 0 to i do aIntNew[y] := 0; // сосчитаем for y := 0 to i - 1 do begin if (y = 0) or (y = i - 1) then aIntNew[y] := aInt[y] else begin aIntNew[y] := (aInt[y - 1] + aInt[y] + aInt[y + 1]) / 3; end; end; // сохраним z := 0; for y := 0 to StringGrid1.RowCount - 1 do for x := 0 to StringGrid1.ColCount - 1 do begin StringGrid1.Cells[x, y] := FloatToStr(aIntNew[z]); z := z + 1; end; end;

Ответ отправил: Drbear (статус: 4-ый класс) Ответ отправлен: 03.01.2008, 17:35

Вопрос № 116.771

Здравствуйте уважаемые кодеры (ПРОГРАММИСТЫ)! У меня к вам срочный вопрос помогите пожалуйста: Помогите сделать программу, которая будет регистрировать мой сайт в поисковике yandex.ru(любой сайт необязательно мой)! Буду очень благодарен... (помогите - это очень важно)

Отправлен: 03.01.2008, 19:40 Вопрос задал: Invisible people (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Raptor3 Здравствуйте, Invisible people! Вот один из вариантов через TWebBrowser на форму бросаем TwebBrowser - вызываем Webbrowser1.navigate('http://webmaster.yandex.ru/'); по окончании загрузки сайта - нужно заполнить форму - через ниже приведенную функцию (найдена на просторах инета) FillForm(WebBrowser1,'url','http://ваш_сайт.ru'): Далее - самый сложный момент - это капча - тут два варианта - либо писать суперсистему разпознования - либо тока ручками вводить(тут можно сделать вывод картинки прямо в приложение в image1 и ввод вручную в edit1) FillForm(WebBrowser1,'repl',edit1.Text); Далее вызываем click на кнопку добавить нужно подправить функцию - заменив if FormItem.Item(j).Name = FieldName then begin FormItem.Item(j).Value := Value; Result := True; end; на if FormItem.Item(j).Value = Value then begin FormItem.Item(j).Click; Result := True; end; FillForm(WebBrowser1,'url','http://ваш_сайт.ru'): Приложение: function FillForm(WebBrowser: TWebBrowser; FieldName: string; Value: string): Boolean; var i, j: Integer; FormItem: Variant; begin Result := False; //no form on document if WebBrowser.OleObject.Document.all.tags('FORM').Length = 0 then begin Exit; end; //count forms on document for I := 0 to WebBrowser.OleObject.Document.forms.Length - 1 do begin FormItem := WebBrowser.OleObject.Document.forms.Item(I); for j := 0 to FormItem.Length - 1 do begin try //when the fieldname is found, try to fill out if FormItem.Item(j).Name = FieldName then begin FormItem.Item(j).Value := Value; Result := True; end; except Exit; end; end; end; end; --------- Программист - это человек который решает проблему, о которой вы не знаете, способом который вы не понимаете

Ответ отправил: Raptor3 (статус: 3-ий класс) Ответ отправлен: 04.01.2008, 09:59 Оценка за ответ: 5 Комментарий оценки: Спасибо большое! В душе облегчение! Отличный ответ! Может кто через idhttp предложет?

Вопрос № 116.791

Здравствуйте!!! Можно ли как-нибудь средствами BDS 2006 изменить скин окон Windows, например как в StyleXP, т.е. не обычные серебряные или оливковые скины, а свои ?

Отправлен: 03.01.2008, 21:54 Вопрос задал: Киреев Тимур (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Selya !!! Здравствуйте, Киреев Тимур! Есть такой коммерческий набор компонентов DevExpress http://www.devexpress.com/ Там можно создавать свой стиль или использовать предуставнвленный (Flat, OfficeXP, Office2003 и т.д.) Не уверен, что сможешь его купить удалено ссылка на варез ----- ∙ Отредактировал: BuhCIA (Профессионал) ∙ Дата редактирования: 06.01.2008, 10:40

Ответ отправил: Selya (статус: 3-ий класс) Ответ отправлен: 04.01.2008, 11:57

Вопрос № 116.797

Еще раз здравствуйте! Как программно получить список названий видимых окон в windows?

Отправлен: 03.01.2008, 22:12 Вопрос задал: Киреев Тимур (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Николай Владимирович / Н.В. Здравствуйте, Киреев Тимур! Посмотрите эту статью. Удачи!

Ответ отправил: Николай Владимирович / Н.В. (статус: Практикант) Ответ отправлен: 03.01.2008, 22:23 Оценка за ответ: 4

Отвечает: Selya Здравствуйте, Киреев Тимур! Если считать окна только от твоего приложения, то их список получить очень просто: Приложение: with Screen do for I := 0 to FormCount - 1 do Memo1.Lines.Add(Forms[I].Name);

Ответ отправил: Selya (статус: 3-ий класс) Ответ отправлен: 04.01.2008, 12:07 Оценка за ответ: 3 Комментарий оценки: Мне нужно все окна из Windows

Вопрос № 116.825

Здравствуйте! Помогите решить следующую задачу. Обеспечить двойным нажатием левой клавиши вычитание из первого целого числа второго целого числа. Результат вводится вместо превого целого числа. Нажатием клавиши "Esc" восстановить исходное первое целое число. Не удается найти функцию восстановления исходного первого числа и как её использовать в решении этой задачи. Приложение: procedure TForm1.Button1Click(Sender: TObject) var a,b:integer; begin Edit1.Text:=IntToStr(a); Edit2.Text:=IntToStr(b); end; procedure TForm1.DoubleClick(Sender: TObject); var a,b,c:integer; a:=StyrToInt(Edit1.Text); b:=StrToInt(Edit2.Text); c:=a+b; Edit1.Text:=IntToStr(c); end; procedure TForm.FormKeyDown(Sender: TObject; var: Word: Shift: TShiftState); begin if Key = VK_ESCAPE then ShowMessage('Escape down'); end;

Отправлен: 04.01.2008, 05:40 Вопрос задал: Спиридонов Данил Сергеевич (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Gh0stik Здравствуйте, Спиридонов Данил Сергеевич! Для начала рекомендую Вам переменные a и b описать как глобальные: var Form1: TForm1; a,b:integer; В режиме конструирования формы в поля Edit1 и Edit2 изначально внесем какие-либо произвольные числовые значения. И соответственно при создании формы определим (присвоим) наши значения для a и b. procedure TForm1.FormCreate(Sender: TObject); begin   a:=StrToInt(Edit1.Text);   b:=StrToInt(Edit2.Text); ... end; Для того чтобы была возможна обработка нажатия клавиш в диспетчере объектов для формы устанавливаем значение KeyPreview = True. Создаем обработчик двойного нажатия на форме и записываем в него соответствующие операторы (Обеспечить двойным нажатием левой клавиши вычитание из первого целого числа второго целого числа): procedure TForm1.Form DblClick(Sender: TObject); begin   Edit1.Text:=IntToStr(StrToInt(Edit1.Text)-b); end; Данная процедура немного усовершенствована, мы при каждом двойном нажатии на форму из текущего значению поля Edit1 вычитаем значение переменной b. И конечно же нам осталось создать обработчик восстановления измененного значения в исходное состояние: procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;   Shift: TShiftState); begin   if Key = VK_ESCAPE then  Edit1.Text:=IntToStr(a); end; Полный код вы сможете увидеть в исходниках прикрепленных к ответу. Good Luck!!! Прикреплённый файл: Загрузить >> Срок хранения файла на сервере RusFAQ.ru составляет 30 суток с момента отправки ответа. --------- Господь Бог - это всего лишь сверхмощный генератор случайных чисел, в соответствии с которыми сочетаются события на Земле. Генератор случайных чисел - и только.

Ответ отправил: Gh0stik (статус: Академик) Украина, Славянск Организация: Славянский государственный педагогический университет (Кафедра алгебры) WWW: http://gh0stik.rusfaq.ru/ ICQ: 289363162 ---- Ответ отправлен: 04.01.2008, 11:16

Отвечает: Denisss Здравствуйте, Спиридонов Данил Сергеевич! См. пример в приложении. Некоторые пояснения: - В Вашем примере (в приложении к ответу) переменные a, b и c объявляются как локальные (доступные только в самой функции или процедуре). Я объявил их как частные для класса формы (частные доступны во всех функциях и процедурах класса, в котором они объявлены). Благодаря этому, значения переменных запоминаются до уничтожения формы, т.е. до завершения работы программы. - Введен "флаг редактирования" - этот флаг нужен, чтобы определить того, кто редактирует поле Edit1 - пользователь или программа. Если редактирует пользователь, значит он меняет число а, и оно не должно восстанавливаться по нажатию Esc. Прим.: В Вашем примере допущена грубая ошибка в обработчике Button1.OnClick - а и b у Вас объявлены как локальные переменные. Вы их ничем не заполняете, потому в функции IntToStr они Вам будут выдавать нео пределенные (можно сказать, случайные) значения. С уважением, Denisss Приложение: unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) Edit1: TEdit; Edit2: TEdit; procedure FormCreate(Sender: TObject); procedure FormDblClick(Sender: TObject); procedure Edit1Change(Sender: TObject); procedure EditKeyPress(Sender: TObject; var Key: Char); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); private { Private declarations } a, b, c: Integer; fEditing: Boolean; public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.FormCreate(Sender: TObject); // Событие Form1.OnCreate begin // Берем начальные значения a и b // (у меня это нули, установленные в // Edit1 и Edit2) a:= StrToInt(Edit1.Text); b:= StrToInt(Edit2.Text); // Сбрасываем флаг редактирования fEditing:= False; // Чтобы обрабатывать события нажатия кнопок // даже в Edit-ах Self.KeyPreview:= True; end; procedure TForm1.FormDblClick(Sender: TObject); // Событие Form1.OnDblClick begin // Получаем значения a и b a:= StrToInt(Edit1.Text); b:= StrToInt(Edit2.Text); // Вычитание c:= a - b; // Устанавливаем флаг редактирования fEditing:= True; // Присваиваем первому Edit-у результат Edit1.Text:= IntToStr(c); end; procedure TForm1.Edit1Change(Sender: TObject); // Событие Edit1.OnChange // Срабатывает, когда изменяется // значение Edit1 begin inherited; // Если значение изменилось в результате // суммирования, то сбрасываем значение // fEditing и выходим из процедуры if fEditing then begin // Сбрасываем флаг редактирования fEditing:= False; // Выходим из обработчика события Exit; end; // На всякий случай запоминаем a if (Edit1.Text <> '') then a:= StrToInt(Edit1.Text); end; procedure TForm1.EditKeyPress(Sender: TObject; var Key: Char); // Событие Edit1.OnKeyPress и Edit2.OnKeyPress // Нужно, чтобы пользователь мог вводить // только целые числа и не мог вводить // символы begin if not (Key in ['0'..'9', #8, #13]) then Key:= #0; // #8 - это кнопка BackSpace // #13 - Enter end; procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); // Событие Form1.OnKeyDown begin if (Key = VK_ESCAPE) then Edit1.Text:= IntToStr(a); end; end. --------- Будь осторожен, когда молишься ради чего-то, потому что можешь это получить...

Ответ отправил: Denisss (статус: Профессионал) Россия, Москва ---- Ответ отправлен: 04.01.2008, 11:20

© 2001-2007, Портал RusFAQ.ru, Россия, Москва. Авторское право: ООО "Мастер-Эксперт Про" Техподдержка портала, тел.: +7 (926) 535-23-31 Хостинг: "Московский хостер" Поддержка: "Московский дизайнер" Авторские права | Реклама на портале Версия системы: 4.69 от 06.01.2008
RusFAQ.ru | MosHoster.ru | MosDesigner.ru | RusIRC.ru Kalashnikoff.ru | RadioLeader.ru | RusFUCK.ru