Итак, первая шутка заключается в наложении ограничения на диапазон движения мыши:
сurs:= Rect(0, 0, Screen.Width div 2, Screen.Height);
ClipCursor(@curs);
После этого указатель мыши можно будет перемещать только в одной половине экрана.
Шутка №2 — отключение кнопок мыши
Вторая шутка будет более радикальной: используя перехваты функций, отключим кнопки мыши — ни левая, ни правая, ни средняя кнопка не будут выполнять никаких действий. Для этого напишите в разделе implementation следующую функцию:
function KbHook(code: Integer; wparam: Word; lparam: LongInt): LongInt; stdcall;
begin
if code < 0 then
Result:= CallNextHookEx(oldKbHook, code, wparam, lparam)
else
Result:= 1;
end;
После этого напишите код для второй шутки:
SystemParametersInfo(SPI_SETFASTTASKSWITCH, 1, @Dummy,0);
SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, @Dummy, 0);
OldKbHook:= SetWindowsHookEx(WH_mouse, @KbHook, HInstance, 0);
После этого ни одна из кнопок мыши функционировать не будет.
Шутка №3 — отключение клавиатуры
Используя функцию для отключения мыши, можно написать код для отключения клавиатуры. Напишите такой код для третьей шутки:
SystemParametersInfo(SPI_SETFASTTASKSWITCH, 1, @Dummy, 0);
SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, @Dummy, 0);
OldKbHook:= SetWindowsHookEx(WH_KEYBOARD, @KbHook, HInstance, 0);
Здесь вызывается та же функция, только вместо параметра WH_MOUSE ей передается WH_KEYBOARD. После этого клавиши на клавиатуре перестанут функционировать.
Шутка №4 — очистка буфера обмена
Четвертая шутка будет очищать буфер обмена и помещать туда собственный текст. Ее код:
ClipBoard.Open;//открываем буфер обмена
ClipBoard.Clear;//очищаем буфер обмена
//Помещаем в буфер обмена свой текст
Clipboard.asText:= 'Буфер обмена временно не работает!';
ClipBoard.Close; //закрываем буфер обмена
Для работы с буфером обмена необходимо добавить в раздел use ссылку на модуль clipbrd.
Шутка №5 — назначение фона для Рабочего стола
Пятая шутка будет делать копию экрана, сохранять этот рисунок, а затем назначать его в качестве фона для Рабочего стола. Вначале в разделе implementation напишем процедуру SetWallpaper, которая будет устанавливать фоновый рисунок:
procedure SetWallpaper(sWallpaperBMPPath: String; bTile: boolean);
begin
reg:= TRegistry.Create;
reg.RootKey:= hkey_current_user;
if reg.OpenKey('Control PanelDesktop', True) then
reg.WriteString('Wallpaper', sWallpaperBMPPath); {ключ содержащий путь к bmp-файлу}
//растянуть рисунок на весь экран
reg.WriteString('TileWallpaper', '1');
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;
Информацию о фоновом рисунке Рабочего стола можно найти в реестре в ветке HKEY_CURRENT_USER по пути Control PanelDesktop. Параметр, содержащий название рисунка, называется wallpaper. То есть, для того чтобы сменить "обои" нам необходимо изменить значение параметра wallpaper и оповестить систему о том, что были внесены изменения в реестр. Последняя строка самая важная — она обновляет системные настройки.
Функция SystemParametersInfo имеет следующие параметры:
• действие, которое необходимо выполнить (в нашем случае SPI_SETDESKWALLPAPER — установка обоев);
• зависит от значения первого параметра;
• в нашем случае — путь к файлу с рисунком;
• в последнем параметре указывается, что необходимо сделать по сле выполнения всех действий. В данном случае мы должны обновить настройки системы — для этого выбираем SPIF_SENDWININICHANGE.
Код шутки в обработчике события таймера имеет следующий вид:
ВМР1:= Graphics.TBitmap.Create;
//задаем размеры рисунка такие же,как размеры экрана
BMP1.Height:= Screen.Height;
BMP1.Width:= Screen.Width;
DC1:=GetDC(0);
//Делаем копию экрана
BitBlt(BMP1.Canvas.Handle, 0, 0, Screen.Width, Screen.Height, DC1, 0, 0, SRCCOPY);
Form1.Visible:= True;//восстанавливаем окно нашей программы
Image1:= TImage.Create(nil);
BMP1.IgnorePalette:= True;
Image1.Picture.Assign(BMP1);
BMP1.SaveToFile('с:1.bmp'); //сохраняем снимок в файл 1.bmp
SetWallpaper('с:1.bmp', False); //назначаем снимок, как фон
Repaint; //обновляем
Здесь мы делаем копию экрана, сохраняем ее в файл и, вызывая процедуру SetWallPaper, назначаем в качестве фона Рабочего стола.
Шутка №6 — выбор фона случайным образом
Раз уж мы написали процедуру, которая устанавливает фоновый рисунок, почему бы не использовать ее в нашей следующей шутке?
Шестая шутка будет заключаться в том, чтобы выбрать случайным образом рисунок из каталога Windows и сделать его фоновым:
endval:= Random(10) + 5; //для случайности выбора рисунка
//ищем все файлы с расширением *.bmp в каталоге Windows
Finds:= FindFirst('С:Windows*.bmp', faAnyFile, fn);
Finds:= Random(2); //случайное число, 0 или 1
//если выпала 1, то устанавливаем первый попавшийся рисунок
if Finds = 1 then SetWallpaper(fn.Name, False);
if Finds = 0 then begin //иначе…
for i:=1 to endval do begin
Finds:= FindNext(fn); // …ищем другие рисунки
//выбираем любой другой рисунок и делаем его фоновым
if i = endval – 3 then SetWallpaper(fn.Name, False);
end;
end;
FindClose(fn); //завершаем поиск
Здесь мы перебираем все рисунки в каталоге Windows и случайным образом выбираем один из них в качестве фонового. Затем мы устанавливаем фон с помощью ранее созданной процедуры SetWallpaper.
Шутка №7 — выключение монитора
Седьмая шутка будет выключать монитор. Для этого достаточно написать одну строку кода:
SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 1);
Шутка №8 — сообщение об ошибке, содержащее "мусор"
Восьмая шутка будет выводить сообщение об ошибке, но не простое, а содержащее огромное количество случайных чисел. Код этой шутки:
for i:=1 to 200 do begin
case i of
//после каждого 25-го числа – перенос на новую строку
25,50,75,100,125,150,175,199: err_str:= err_str + #13#10;
end;
//текст "ошибки"
err_str:= err_str + IntToStr(Random(99999));
end;
MessageDlg(errstr, mtError, [mbOk], 0); //выводим сообщение
В цикле от 1 до 200 выбирается случайное число от 0 до 99999. Все числа преобразовываются к символьному виду и добавляются к строковой переменной errstr. На каждом 25-м числе происходит перенос строки. В результате выдается примерно такое сообщение об "ошибке" как на рис. 14.1.
Рис. 14.1. Сообщение об "ошибке"
Шутка №9 — открытие браузера Internet Explorer
В девятой шутке мы будем открывать несколько (от 5 до 15) окон браузера Internet Explorer с попыткой зайти на сайт www.heel.nm.ru.
Код этой шутки:
for i:=1 to Random(10)+ 5 do //случайное число от 5 до 15.
ShellExecute(0, 'open', 'C:Program Fileslnternet Explorer' +
'IEXPLORE.EXE', 'www.heel.nm.ru', 0, SW_MAXIMIZE);
Чтобы использовать функцию ShellExecute, необходимо добавить в раздел uses ссылку на модуль ShellApi.
Шутка №10 — сброс системной даты/времени
Последняя, десятая шутка будет устанавливать текущую дату 01.01.2000, и изменять текущее время на 00:00:01. Код этой шутки:
GetLocalTime(tm); //узнаем текущую дату и время
tm.wYear:= 2000; //устанавливаем год
tm.wMonth:= 01; //месяц
tm.wDay:= 01; //день
tm.wHour:= 0; //часы
tm.wMinute:= 0; //минуты
tm.wSecond := 1; //секунды
tm.wMilliseconds := 0; //мс
SetLocalTime(tm); //устанавливаем новую дату и время
Полный исходный код модуля
Полный код программного модуля генератора шуток представлен в листинге 14.1.
Листинг 14.1. Программный модуль генератора шуток
unit Unit1;