PKWORLD - Компьютер во всех своих проявлениях.

Зима за окном активно пытается оккупировать территорию нашей необъятной Родины, синоптики наперебой кричат о скором похолодании, tut.by жалуется, что от теплой погоды проснулись медведи в берлогах и что Беларусьфильму нужна новая флэшка (можно подумать, это ему поможет), а я, бездумно тыкая пальцами в клавиатуру, пытаюсь придумать, как начать эту статью. Впрочем, раз уж я не писатель, то прямо так, пожалуй, и начну:). Сразу предупреждаю, что весь сегодняшний выпуск целиком будет посвящен издевательствам над рабочим столом пользователя — в частности, графическим эффектам, один из которых (инвертирование) вы уже могли наблюдать в прошлой статье. Как я и ожидал, простенький эффект оказал вполне достойное действие на противника, а это значит, что тема имеет право на продолжение. В компании Adobe я никогда не работал, но даже создателям графического редактора Photoshop наверняка пришлись бы по душе сюрпризы, представленные ниже. Может, продать на досуге:)?

1. Лабиринт
Если уж быть совсем откровенным, то я даже не знаю, как правильно назвать этот графический сюрприз, поэтому остановился на “лабиринте”. Это название он вполне оправдывает, в чем мы очень скоро убедимся. По традиции сперва нам нужно спрятать форму от посторонних глаз, поэтому в обработчике OnCreate нашей формы напишем:

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

Теперь необходимо создать процедуру, которая будет применять эффект к любому изображению, переданному в нее. Основная выгода от этого заключается в том, что мы наделяем эту процедуру универсальностью, которая позволит использовать ее потом для любого Bitmap’а. Так что, если не сможете реализовать эффект, садитесь сразу писать графический редактор на готовом коде. Саму процедуру достаточно описать сразу после строк:

implementation
{$R *.dfm}

Вот код этой процедуры:

procedure Blocks(var Bitmap: TBitmap);
function Rand(num:integer): integer;
begin
if random(2) = 0 then
Result:=num+random(2)
else
Result:=num-random(2);
end;
var
x, y, x2, y2: Integer;
Bmp: TBitmap;
begin
Bmp := TBitmap.Create;
Bmp.Assign(Bitmap);
Bitmap.Canvas.Brush.Color := 0;
Bitmap.Canvas.FillRect(Rect(0, 0,
Bitmap.Width, Bitmap.Height));
x2 := (Bitmap.Width — 1) div 10;
y2 := (Bitmap.Height — 1) div 10;
Randomize;
for x := 0 to x2 do
for y := 0 to y2 do
BitBlt(Bitmap.Canvas.Handle,
Rand(10*x),
Rand(10*y),
10, 10, Bmp.Canvas.Handle,
10*x,10*y, SRCCOPY);
end;

Алгоритм нашей программы будет следующим:

1. Получаем в переменную типа TBitmap изображение экрана пользователя.

2. Передаем эту переменную в процедуру Blocks, которая любезно вернет измененную картинку.

3. Вешаем наше изображение на экран прямо на глазах у обалдевшего противника.

Для реализации алгоритма вешаем на форму таймер с каким-нибудь большим значением (300000, например) и в его обработчике пишем:

procedure TForm1.Timer1Timer(Sender: TObject);
var
bmp: TBitmap;
DC: HDC;
begin
//инициализация переменной типа TBitmap
bmp:=TBitmap.Create;
bmp.Height:=Screen.Height;
bmp.Width:=Screen.Width;
//получение контекста экрана
DC:=GetDC(0);
//копирование изображения экрана в нашу переменную
bitblt(bmp.Canvas.Handle, 0, 0,
Screen.Width, Screen.Height,
DC, 0, 0, SRCCOPY);
// вызов процедуры изменения изображения
blocks(bmp);
// копирование измененного изображения назад на экран
bitblt(dc, 0, 0, Screen.Width, Screen.Height,
bmp.Canvas.Handle, 0, 0, SRCCOPY);
end;

В этом коде в переменную bmp записывается текущее изображение экрана, затем вызывается процедура Blocks, и измененная переменная bmp восстанавливается на экран. Сохраните этот обработчик таймера, поскольку в последующих эффектах мы будем использовать именно его, меняя только вызов самой процедуры изменения изображения. Результат работы этого эффекта можно наблюдать на скриншоте.

Ради пущей веселости при удивленном возгласе соперника можно невинно сказать, что на мониторе все в порядке, а ему срочно нужно перестать посещать секту “Скажи наркотикам Да”, или до добра это точно не доведет:).

2. Пикселизация

Многие наверняка знают этот эффект, который есть чуть ли не в каждом втором уважающем себя графическом редакторе. Прием пикселизации основан на принципе уменьшения количества пикселей изображения за счет увеличения размера этих самых пикселей. В результате мы видим своеобразное размытие, код создания которого, несомненно, должен иметь в своем арсенале каждый уважающий себя читатель данной статьи. На смену процедуре Blocks приходит процедура Pixelize:

procedure Pixelize(var Bitmap: TBitmap);
function Minimum(c1, c2:integer):integer;
begin
if c1 < c2 then
Result := c1
else
Result := c2;
end;
type
myRGB = record
r,g,b: Byte;
end;
pRGB = ^myRGB;
var
i,k,x,y,x1,y1,rr,gg,bb,h,x2,y2: Integer;
tRGB: pRGB;
begin
Bitmap.PixelFormat := pf24Bit;
x1 := (Bitmap.Width — 1) div 4;
y1 := (Bitmap.Height — 1) div 4;
for i := 0 to x1 do
for k := 0 to y1 do
begin
h := 0;
rr := 0;
gg := 0;
bb := 0;
x2 := Minimum(4 * (i + 1), Bitmap.Width — 1);
y2 := Minimum(4 * (k + 1), Bitmap.Height — 1);
for y := k * 4 to y2 do
begin
tRGB := Bitmap.ScanLine[y];
Inc(tRGB,i*4);
for x:=i*4 to x2 do
begin
Inc(rr, tRGB^.R);
Inc(gg, tRGB^.G);
Inc(bb, tRGB^.B);
Inc(h);Inc(tRGB);
end;
end;
Bitmap.Canvas.Brush.Color := RGB(rr div h, gg div h, bb div h);
Bitmap.Canvas.FillRect(Rect(i * 4, k * 4, x2 + 1, y2 + 1));
end;
end;

Помните, я говорил сохранить обработчик таймера с кодом, где вызывалась наша процедура изменения изображения. Просто пишем туда вызов Pixelize, запускаем, и через 5 минут (если время на таймере было выставлено 300000) мы получим совершенно другую картинку на мониторе:

procedure TForm1.Timer1Timer(Sender: TObject);
var
bmp: TBitmap;
DC: HDC;
begin
bmp:=TBitmap.Create;
bmp.Height:=Screen.Height;
bmp.Width:=Screen.Width;
DC:=GetDC(0);
bitblt(bmp.Canvas.Handle, 0, 0,
Screen.Width, Screen.Height,
DC, 0, 0, SRCCOPY);
Pixelize (bmp);
bitblt(dc, 0, 0, Screen.Width, Screen.Height,
bmp.Canvas.Handle, 0, 0, SRCCOPY);
end;

А вот и результат ее работы:

Далее мы, как и в прошлый раз, говорим, что на мониторе ничего не произошло, и парню нужно срочно проверить зрение, пока компьютер совершенно не сделал его клиентом клиники “Новый взгляд”:). Едем дальше.

3. Зернистость

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

procedure Dither(var Bitmap:Tbitmap);
type
TRGB = record
r,g,b: byte;
end;
ARGB = array[0..1] of TRGB;
PARGB = ^ARGB;
var x,y:integer;
p:Pargb;
b:Tbitmap;
begin
Bitmap.PixelFormat := pf24Bit;
b:=Tbitmap.Create;
b.Assign(bitmap);
for y:=0 to b.Height-1 do
begin
p := b.scanline[y];
for x := 0 to b.width — 1 do
begin
if (p[x].r>30)and(p[x].r<225) then p[x].r:=p[x].r-30+random(60);
if (p[x].g>30)and(p[x].g<225) then p[x].g:=p[x].g-30+random(60);
if (p[x].b>30)and(p[x].b<225) then p[x].b:=p[x].b-30+random(60);
end;
end;
bitmap.Canvas.Draw(0,0,b);
end;

Теперь в обработчике таймера меняем имя процедуры обработки на Dither:

procedure TForm1.Timer1Timer(Sender: TObject);
var
bmp: TBitmap;
DC: HDC;
begin
...
Dither(bmp);
...
end;

Запускаем, наслаждаемся результатом работы:

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

if (p[x].r>30)and(p[x].r<225) then p[x].r:=p[x].r-30+random(60);
if (p[x].g>30)and(p[x].g<225) then p[x].g:=p[x].g-30+random(60);
if (p[x].b>30)and(p[x].b<225) then p[x].b:=p[x].b-30+random(60);

Главное — помнить, что каждая составляющая должна лежать в пределах [0-255]. Переходим к следующему эффекту.

4. Градации серого и в том же направлении...

Эффект не новый. Как сделать медленный, построчный переход изображения в градации серого, я уже писал раньше, но, откликаясь на вопросы о быстром переводе цветного изображения в оттенки серого, придется описать другую реализацию этого эффекта, тем более, что он больше других заставляет противника думать о том, что любимый монитор безнадежно испорчен. Да и потом, на основе его мы сделаем еще более убойный графический подарок другу. Об этом чуточку позже, а пока описываем очередную “эффектную” процедуру:

procedure Rgb2Gray(var Bitmap:Tbitmap);
procedure rgbtogray(var r,g,b:byte);
var
Gray : byte;
begin
Gray := Round((0.30 * r) +(0.59 * g) + (0.11 * b));
r:=gray;
g:=gray;
b:=gray;
end;
type
TRGB = record
r,g,b: byte;
end;
ARGB = array[0..1] of TRGB;
PARGB = ^ARGB;
var x,y:integer;
p:PARGB;
b:Tbitmap;
begin
Bitmap.PixelFormat := pf24Bit;
b:=Tbitmap.Create;
b.Assign(bitmap);
for y:=0 to b.Height-1 do
begin
p := b.scanline[y];
for x := 0 to b.width — 1 do
begin
rgbtogray(p[x].r,p[x].g,p[x].b);
end;
end;
bitmap.Canvas.Draw(0,0,b);
end;

Обработчик таймера с новым именем процедуры обработки изображения даст нам примерно следующий результат:

Вот, приблизительно так, наверное, и портятся мониторы. Тьфу-тьфу, конечно, чтоб не сглазить. Как я и обещал, сейчас мы создадим модификацию этого эффекта от состояния градаций серого к полностью черно-белому изображению из двух цветов. Так сказать, возвращение к истокам — к нулю и единице. Не трогая процедуру Rgb2Gray, создаем после нее новую процедуру:

procedure im2bw(var Bitmap:Tbitmap);
type
TRGB = record
r,g,b: byte;
end;
ARGB = array[0..1] of TRGB;
PARGB = ^ARGB;
var x,y:integer;
p:pargb;
b:Tbitmap;
begin
Bitmap.PixelFormat := pf24Bit;
b:=Tbitmap.Create;
b.Assign(bitmap);
for y:=0 to b.Height-1 do
begin
p := b.scanline[y];
for x := 0 to b.width — 1 do
begin
if (p[x].r>=128) then begin
p[x].r:=255;
p[x].g:=255;
p[x].b:=255;
end else begin
p[x].r:=0;
p[x].g:=0;
p[x].b:=0;
end;
end;
end;
bitmap.Canvas.Draw(0,0,b);
end;

Особенность процедуры im2bw заключается в том, что она правильно сработает только при передаче в нее переменной типа TBitmap, содержащей изображение в оттенках серого, поэтому в обработчике таймера нужно будет вызвать последовательно обе процедуры:

procedure TForm1. Timer1Timer(Sender: TObject);
var
bmp: TBitmap;
DC: HDC;
begin
...
rgb2gray(bmp);
im2bw(bmp);
...
end;

Результат этого эффекта превосходит все ожидания:

Можете поэкспериментировать со значением 128 в строке процедуры im2bw:

if (p[x].r>=128) then begin

В зависимости от близости к 0 или 255 это значение даст разные эффекты. Едем дальше.

5. Волны

Нет, плыть я определенно никуда не собираюсь. А вот изображение на экране противника поплывет однозначно, причем синхронно с уезжающей крышей этого самого противника. Шутки шутками, но не каждый день увидишь, как картинка на мониторе выстраивается по синусоиде (или косинусоиде — кому как нравится). Может, она и по-другому как-то выстраивается, но высшее учебное заведение, к сожалению, не оставило в моей голове совершенно никаких знаний в области математики, поэтому писать приходится как чувствуешь, а не как “правильно должно быть”. Впрочем, пока никто еще не жаловался, так что пишем саму процедуру изменения изображения:

procedure Wave(var Bitmap: TBitmap);
function Minimum(c1,c2:Integer):Integer;
begin
if c1 < c2 then Result := c1
else Result := c2;
end;
function Maximum(c1, c2: Integer): Integer;
begin
if c1 > c2 then Result := c1
else Result := c2;
end;
const
Radian = Pi / 180;
type
TRGB = record
r,g,b: Byte;
end;
pRGB = ^TRGB;
var
x, y, f: Integer;
myRGB, Src: pRGB;
Bmp: TBitmap;
begin
Bitmap.PixelFormat := pf24Bit;
Bmp := TBitmap.create;
Bmp.Assign(Bitmap);
Bitmap.Canvas.Brush.Color := clwhite;
Bitmap.Canvas.FillRect(Rect(0, 0, Bitmap.Width, Bitmap.Height));
for y := 0 to Bmp.Height — 1 do
begin
Src := Bmp.ScanLine[y];
for x := 0 to Bmp.Width — 1 do
begin
f := Minimum(Maximum(Round(Sin(x * Radian * 7) * 7) + y, 0),
Bitmap.Height — 1);
myRGB := Bitmap.ScanLine[f];
Inc(myRGB, x);
myRGB^ := Src^;
Inc(Src);
end;
end;
Bmp.free;
end;
end;

Осталось только вызвать эту процедуру в обработчике таймера и громко включить в Winamp’е песню Татушек “Я сошла с ума”. Как пользоваться Winamp’ом на расстоянии, я уже описал в предыдущем выпуске приколов. А пока внимание на экран:

Вот так вот и будет выглядеть рабочий стол приятеля после деструктивных действий нашего самопального софта. Кривое зеркало налицо, кривое лицо противника в зеркале. Долгие ругательства и поминание по вполне конкретной матери вирусописателей, Билла Г. и всей мелкомягкой корпорации гарантированы железно. Делаем невинные глаза и говорим: “Мискузи”:).

6. Зима, крестьянин торжествуя...

Мда-а, печальная зима у нас выдалась, ненастоящая. Начал я с зимней темы, ей эту статью и закончу. На снег природа почему-то безбожно поскупилась, но мы, в принципе, не жадные и готовы поделиться небольшим инеем с рабочим столом противника. Пусть прочувствует всю прелесть отечественного мороза на своей изнеженной шкуре. Пишем процедуру:

procedure Sneg(var Bitmap: TBitmap);
function Rand(n,radius:integer):integer;
begin
if random(2)=0 then Result := n+random(radius)
else Result:=n-random(radius);
end;
type
TRGB = record
r,g,b: Byte;
end;
pRGB = ^TRGB;
var
x, y, ww, hh, x1, y1: Integer;
Dest1, Dest2, Src1, Src2: PRGB;
Bmp: TBitmap;
begin
Randomize;
Bitmap.PixelFormat := pf24Bit;
Bmp := TBitmap.Create;
Bmp.Assign(Bitmap);
ww := Bitmap.Width — 1;
hh := Bitmap.Height — 1;
Bitmap.Canvas.Brush.Color := clWhite;
Bitmap.Canvas.FillRect(Rect(0, 0, ww + 1, hh + 1));
for y := 0 to hh do
begin
for x := 0 to ww do
begin
x1 := Rand(x, 3);
y1 := Rand(y, 3);
if (x1 >= 0) and (x1 < WW) and (y1 >= 0) and (y1 < HH) then
begin
Src1 := Bmp.ScanLine[y];
Src2 := Bmp.ScanLine[y1];
Dest1 := Bitmap.ScanLine[y];
Dest2 := Bitmap.ScanLine[y1];
Inc(Src1, x);
Inc(Src2, x1);
Inc(Dest1, x);
Inc(Dest2, x1);
Dest1^ := Src2^;
Dest2^ := Src1^;
end;
end;
end;
Bmp.Free;
end;

Запускаем эту процедуру в обработчике таймера, и метель накрывает все вокруг:

Вот такой вот иней получается. Но все равно лучше, чем вообще без снега.

На этом данный выпуск подходит к концу. Присылайте свои письма с описанием шуток, реализацию которых вы хотите увидеть, и пусть дни ваши скрашивает осознание скорого прихода весны и очередного выпуска статьи из серии “практическое руководство по компьютерным приколам”.

P.S. За время написания статьи ни один монитор не пострадал. Кроме моего, конечно:).

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

© компьютерная газета

Powered by X-ray.Издательство"Самопал"©2004