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

Функция 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, назначаем в качестве фона Рабочего стола.

Раз уж мы написали процедуру, которая устанавливает фоновый рисунок, почему бы не использовать ее в нашей следующей шутке?

Шестая шутка будет заключаться в том, чтобы выбрать случайным образом рисунок из каталога 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.

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

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 //Уменьшить диапазон движения мыши