Чтение онлайн

ЖАНРЫ

Delphi. Учимся на примерах

Парижский Сергей Михайлович

Шрифт:

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 Files\lnternet 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;

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;

Поделиться с друзьями: