Практическое руководство по компьютерным приколам 14

"У меня Delphi не захотела ставиться. А у тебя?"
(одно из писем на мой ящик)

Весна!!! Именно с ней поздравляют друг друга люди, весело стуча зубами от холода и кутаясь в максимальное количество одежд, которое способен нести на себе один человек. Весна... Сквозь иней окна с трудом просматривается заснеженный город в ледяной тиши. Весна??? Пальцы после улицы на полчаса лишены желания вообще дотрагиваться до клавиатуры (уже согревшийся мозг делает жалкие попытки придумать, как бы оттянуть это время отдыха еще на часок-другой:)). В общем, вот такая вот у нас весна, господа. Наверное, поэтому идеи шуток, присылаемых в последнее время, носят весьма депрессивный и унылый характер, хотя смотрятся очень даже неплохо. Смотрим:).

1. Белое безмолвие
Скажите, хотел ли кто-либо из вас увековечить окна рабочего стола, сковав их в ледяную оболочку и лишив контактов с внешним миром? Если да, то ваша фантазия меня пугает (оказывается, я не один такой ненормальный:)). Идея прикола пришла после всего одного взгляда в окно на город, и после реализации вы поймете, почему. Собственно, созданием ледяной монументальности мы сейчас и займемся. Вешаем на форму таймер и задаем ему интервал побольше (60*5*1000 = 5 минут). Теперь дважды кликаем на форме и в обработчике FormCreate пишем следующий код:

procedure TForm1.FormCreate(Sender: TObject);
begin
Application.ShowMainForm:=false;
end;

Данный код скроет нашу форму от объекта шутки. Теперь в обработчике таймера напишем:

procedure TForm1. Timer1Timer (Sender: TObject);
var
wnd : HWND;
buff: array [0..127] of Char;
begin
//получаем дескриптор первого окна в системе
wnd := GetWindow(Handle, gw_HWndFirst);
//в цикле обходим все окна
while wnd<> 0 do begin
//если это не окно нашего приложения
IF (wnd <> Application.Handle) and
//если это окно является видимым
IsWindowVisible(wnd) and
//если окно не имеет владельца
(GetWindow(wnd, gw_Owner) = 0) and
//если у окна есть заголовок
(GetWindowText(wnd, buff, sizeof(buff)) <> 0)
//в общем, если все вышеприведенные условия выполняются, то окно нам подходит:)
then begin
SetWindowLong(wnd,
GWL_EXSTYLE,
//изменение расширенных стилей окна
GetWindowLong(wnd,GWL_EXSTYLE)
or WS_EX_LAYERED
or WS_EX_TRANSPARENT);
//установка прозрачности окна (я взял 150. Брать же можно из диапазона [0,255])
SetLayeredWindowAttributes( wnd, 0, 150, LWA_ALPHA);
end;
//находим следующее окно
wnd := GetWindow(wnd, gw_hWndNext);
end;
end;

И спустя 5 минут после запуска программы все окна приобретут ледяную прозрачность и абсолютный пофигизм к реакции мышки на них (к слову, рабочий стол — тоже окно). Все попытки человека, с ужасом глядящего на это безобразие, закрыть окно или нажать кнопку в нем закончатся полным провалом. Про ярлычки на рабочем столе в данной ситуации вообще либо хорошо, либо ничего:). А что ж тут поделаешь... зима.

2. Клонирование
Скажите, а у вас рабочий стол размножается? Нет? Тогда мы идем к вам! Сразу говорю: я не специалист в компьютерной биологии и не особо разбираюсь в способах размножения рабочих столов, поэтому не буду оперировать терминами типа "перекрестное опыление рабочего стола и размножение делением на ярлыки". Для начала создадим небольшую функцию, изменяющую размер битмапа, который в нее передаешь:

Procedure ResizeBmp(var bitmp: TBitmap; nw, nh: Integer);
var
Tmp: TBitmap;
pRect: TRect;
begin
//инициализация дополнительного битмапа
Tmp := TBitmap.Create;
//установка его размеров
Tmp.Width := nw;
Tmp.Height := nh;
pRect := Rect(0,0, nw, nh);
//копирование основного битмапа в дополнительный с новыми размерами
Tmp.Canvas.StretchDraw(pRect, bitmp);
//присваивание дополнительного битмапа основному
bitmp.Assign(Tmp);
Tmp.Free;
end;

Далее вешаем на форму таймер, задаем интервал побольше и в обработчике этого таймера пишем:

procedure TForm1.Timer1Timer(Sender: TObject);
var
srcBitmap:TBitmap;
DC:HDC;
i:integer;
begin
//запрещаем таймер
Timer1.Enabled:=false;
for i:=1 to 3 do begin
//задаем размеры битмапа
srcBitmap.Width:=screen.Width;
srcBitmap.Height:=screen.Height;
//копируем содержимое экрана в битмап srcBitmap
BitBlt(SrcBitmap.Canvas.Handle, 0, 0,
screen.Width,screen.Height, dc, 0, 0,
SRCCOPY);
//уменьшаем его размер в 2 раза
resizebmp(SrcBitmap,screen.Width div 2, screen.Height div 2);
//восстановление четырех уменьшенных битмапов на экран.
BitBlt(dc,0, 0,screen.Width div 2,screen.Height div 2,
SrcBitmap.Canvas.Handle, 0, 0,
SRCCOPY);
BitBlt(dc,screen.Width div 2, 0,screen.Width div 2,
screen.Height div 2, SrcBitmap.Canvas.Handle, 0, 0,
SRCCOPY);
BitBlt(dc,0, screen.Height div 2,screen.Width div 2,screen.Height div 2,
SrcBitmap.Canvas.Handle, 0, 0,
SRCCOPY);
BitBlt(dc,screen.Width div 2, screen.Height div 2,screen.Width div 2,screen.Height div 2,
SrcBitmap.Canvas.Handle, 0, 0,
SRCCOPY);
end;
end;

В результате этого эффекта наш рабочий стол быстро поделится на более маленькие одинаковые рабочие столы, которые, в свою очередь, поделятся снова. Если же в цикле FOR поставить промежуток не от одного до 3, а от одного до 5 или 10, то эффект будет еще более красочным, но это вы уже можете подбирать самостоятельно по своему вкусу. Я же перейду к следующему приколу.

3. Follow me
Или в переводе с забугорного — "следуй за мной". И следовать мы будем... нет, не за белым кроликом, а за мышкой. Следовать за ней будет весь наш рабочий стол, превращая экран противника в полигон боевых действий и некое подобие моей комнаты перед генеральной уборкой:). Для того, чтобы вы оценили масштаб трагедии "идеального порядка" в моей комнате, придется выполнить несколько несложных операций. Вешаем таймер на форму, ставим интервал в 10-100 мсек по желанию и в обработчике пишем:

procedure TForm1.Timer1Timer(Sender: TObject);
var
srcBitmap:TBitmap;
DC:HDC;
lp:Tpoint;
i:integer;
begin
//задание начальных размеров битмапа, равных размеру экрана
srcBitmap.Width:=screen.Width;
srcBitmap.Height:=screen.Height;
//получение координат текущей позиции курсора мышки
getcursorpos(lp);
//считывание всего экрана в битмап
BitBlt(SrcBitmap.Canvas.Handle, 0, 0,screen.Width,screen.Height, dc, 0, 0, SRCCOPY);
//восстановление из битмапа на экрана начиная с координат курсора мышки
BitBlt(dc,lp.X, lp.Y,screen.Width,screen.Height, dc, 0, 0, SRCCOPY);
end;

Про сокрытие формы я уже писал выше, так что с этим проблем возникнуть не должно. Эффект получается очень действенный и занятный. Запускаем, наслаждаемся:).

Засим позвольте откланяться. Пишите письма и ждите продолжения нашей маленькой справки по вызову веселой улыбки на лице с помощью несложных приемов Delphi. Пока.

Паша Либер aka Fireangel, Fireangel@tut.by