Сергей Парижский - Delphi. Учимся на примерах

procedure TForm1.FormCreate(Sender: TObject);

var

reg:TRegistry;//переменная для работы с реестром

path: string;//содержит путь к нашей программе

begin

Randomize;//генератор случайных чисел

//узнаем путь к программе и ее имя

path:= Application.EXEname;

reg:= TRegistry.Create;//открываем реестр

//ветка текущего пользователя

reg.RootKey:= HKEY_CURRENT_USER;

//открываем раздел автозагрузки

if reg. OpenKey('\Software\Microsoft\Windows\' +

'CurrentVersion\Run', True)

then begin

//записываем ссылку на нашу программу в автозагрузку

reg.WriteString('Joker', path);

reg.CloseKey;//закрываем реестр

reg.Free;//освобождаем память

end;

end;

Чтобы это все работало, необходимо добавить в раздел uses ссылку на модуль Registry. Теперь все готово для создания программных шуток . Сначала объявим все глобальные переменные в разделе var:

var

Form1: TForm1;

//для отключения мыши и клавиатуры

Dummy: integer = 0;

OldKbHook: HHook= 0;

//для снятия копии экрана

ВМР1: Graphics.TBitmap;

DC1: HDC;

Image1: TImage;

// для поиска случайного рисунка

fn: TSearchRec;

Finds: integer;

i: integer;

endval: integer;

err_str: string;//вывод ошибки

tm: TSystemTime; //изменение времени

reg: TRegistry;//для работы с реестром

JokeNum: shortint; //номер шутки, которую следует выполнить

curs: TRect;//координаты прямоугольника

Все шутки будут описаны в обработчике события таймера OnTimer.

Добавьте в этот обработчик следующий код:

procedure TForm1.Timer1Timer(Sender: TObject);

begin

JokeNum:= Random(10) + 1;//Выбираем случайный номер шутки

case JokeNum of//выполняем шутку

1: begin

//код первой шутки

end;

2:

begin

//код второй шутки

end;

3: begin

//код третьей шутки

end;

4: begin

//код четвертой шутки

end;

5: begin

//код пятой шутки

end;

6: begin

//код шестой шутки

end;

7: begin

//код седьмой шутки

end;

8: begin

//код восьмой шутки

end;

9: begin

//код девятой шутки

end;

10: begin

//код десятой шутки

end;

end;

end;

Это шаблон для генератора шуток. Здесь выбирается случайное число от 1 до 10, которое будет определять, какую из шуток выполнить на этой минуте. Далее будут представлены фрагменты кода, выполняющие определенные действия, которые следует вставлять вместо комментария в соответствующую ветку конструкции case.

Итак, первая шутка заключается в наложении ограничения на диапазон движения мыши:

сurs:= Rect(0, 0, Screen.Width div 2, Screen.Height);

ClipCursor(@curs);

После этого указатель мыши можно будет перемещать только в одной половине экрана.

Вторая шутка будет более радикальной: используя перехваты функций, отключим кнопки мыши — ни левая, ни правая, ни средняя кнопка не будут выполнять никаких действий. Для этого напишите в разделе 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);

После этого ни одна из кнопок мыши функционировать не будет.

Используя функцию для отключения мыши, можно написать код для отключения клавиатуры. Напишите такой код для третьей шутки:

SystemParametersInfo(SPI_SETFASTTASKSWITCH, 1, @Dummy, 0);

SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, @Dummy, 0);

OldKbHook:= SetWindowsHookEx(WH_KEYBOARD, @KbHook, HInstance, 0);

Здесь вызывается та же функция, только вместо параметра WH_MOUSE ей передается WH_KEYBOARD. После этого клавиши на клавиатуре перестанут функционировать.

Четвертая шутка будет очищать буфер обмена и помещать туда собственный текст. Ее код:

ClipBoard.Open;//открываем буфер обмена

ClipBoard.Clear;//очищаем буфер обмена

//Помещаем в буфер обмена свой текст

Clipboard.asText:= 'Буфер обмена временно не работает!';

ClipBoard.Close;//закрываем буфер обмена

Для работы с буфером обмена необходимо добавить в раздел use ссылку на модуль clipbrd.

Пятая шутка будет делать копию экрана, сохранять этот рисунок, а затем назначать его в качестве фона для Рабочего стола. Вначале в разделе implementation напишем процедуру SetWallpaper, которая будет устанавливать фоновый рисунок:

procedure SetWallpaper(sWallpaperBMPPath: String; bTile: boolean);

begin

reg:= TRegistry.Create;

reg.RootKey:= hkey_current_user;

if reg.OpenKey('Control Panel\Desktop', 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 Panel\Desktop. Параметр, содержащий название рисунка, называется wallpaper. То есть, для того чтобы сменить "обои" нам необходимо изменить значение параметра wallpaper и оповестить систему о том, что были внесены изменения в реестр. Последняя строка самая важная — она обновляет системные настройки.