Delphi. Учимся на примерах - [28]

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.

Шутка №1 — ограничение диапазона движения мыши

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

с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 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);