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

end;

FindClose(fn);//завершаем поиск

Здесь мы перебираем все рисунки в каталоге Windows и случайным образом выбираем один из них в качестве фонового. Затем мы устанавливаем фон с помощью ранее созданной процедуры SetWallpaper.

Седьмая шутка будет выключать монитор. Для этого достаточно написать одну строку кода:

SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 1);

Восьмая шутка будет выводить сообщение об ошибке, но не простое, а содержащее огромное количество случайных чисел. Код этой шутки:

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. Сообщение об "ошибке"

В девятой шутке мы будем открывать несколько (от 5 до 15) окон браузера Internet Explorer с попыткой зайти на сайт www.heel.nm.ru.

Код этой шутки:

for i:=1 to Random(10)+ 5 do//случайное число от 5 до 15.

ShellExecute(0, 'open', 'C:\Program Files\lnternet Explorer\' +

'IEXPLORE.EXE', 'www.heel.nm.ru', 0, SW_MAXIMIZE);

Чтобы использовать функцию ShellExecute, необходимо добавить в раздел uses ссылку на модуль ShellApi.

Последняя, десятая шутка будет устанавливать текущую дату 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.

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, Registry, clipbrd, ShellApi;

type

TForm1 = class(TForm)

Timer1: TTimer;

procedure Timer1Timer(Sender: TObject);

procedure FormPaint(Sender: TObject);

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

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; //координаты прямоугольника

implementation

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 ;

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;

{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject);

var

JokeNum: shortint;

curs: TRect;

begin

JokeNum:= Random(10) + 1;

case JokeNum of

1: begin //Уменьшить диапазон движения мыши