Прикалываемся с помощью Delphi

(Продолжение, начало в №36)

Вот уже в двух выпусках я рассказываю вам, как прикалываться программным путём. Сегодня рассмотрим ещё несколько примеров забавных приколов - в основном, графических.


Просто, но докучливо

Все мы знаем, что Windows - это графическая система, и все кнопки, окна и панели - это всё графика. Получается всё, что делает Windows с экраном, это графика или, проще говоря, многоразовая бумага, на которой Windows рисует и рисует. Вот мы сейчас ей и поможем. Для начала берём наш старый шаблон, сделанный ещё в первой части (на сайте kv.by есть архивы всех номеров, и оттуда даже можно операцией Ctr+C и Ctr+V вставить код в Delphi), в событие таймера записываем код:

procedure TForm1.Timer1Timer(Sender: TObject);
var scr:HDC;
begin
 scr:=GetDC(0);
 rectangle(scr, 0, 0, 1300, 1300);
end;

Всё, объясняю - сначала объявляю переменную "scr" типа "HDC", это тип рисования Windows (помните начало статьи - она графическая), потом этой же переменной присваиваем контекст самого экрана и с помощью функции "rectangle" рисуем квадрат с заданными координатами. И каждую секунду будет рисоваться квадрат поверх всего. Но стоит вам только что-нибудь сделать, для чего нужна графика, например, вызвать "Диспетчер задач", как он появится и через секунду снова закрасится. Если всё оставить как есть, то зарисовываться экран будет каждую секунду, но измените свойство "Interval" на, например, 100 и вы вряд ли сможете закрыть программу.


Вывод текста

Сейчас я продемонстрирую вывод текста (по вашему желанию) на экран монитора и сделаю это двумя способами.

Первый способ

Берём шаблон, у компонента "Timer1" свойство "Interval" ставим равным 1 и в обработчике события таймера печатаем код:

procedure TForm1.Timer1Timer(Sender: TObject);
var scr:HDC;
begin
 scr:=GetDC(0);
 rectangle(scr, 64, 175,96, 350);
 rectangle(scr, 96, 175,128,210);
 rectangle(scr, 128,175,160,245);
 rectangle(scr, 96,245,128,280);
 rectangle(scr, 128,280,160,350);
 rectangle(scr, 96,315,128,350);

 rectangle(scr, 192,175,224,350);
 rectangle(scr, 224,280,256,315);
 rectangle(scr, 256,245,288,280);
 rectangle(scr, 288,175,320,350);

 rectangle(scr, 352,175,384,350);
 rectangle(scr, 384,175,416,210);
 rectangle(scr, 384,245,416,280);
 rectangle(scr, 416,175,448,280);

 rectangle(scr, 480,175,512,245);
 rectangle(scr, 544,175,576,245);
 rectangle(scr, 448,315,480,350);
 rectangle(scr, 480,280,512,315);
 rectangle(scr, 512,245,544,280);

 rectangle(scr, 608,175,640,350);
 rectangle(scr, 640,175,672,210);
 rectangle(scr, 640,315,672,350);

 rectangle(scr, 192,455,224,630);
 rectangle(scr, 224,455,256,490);
 rectangle(scr, 224,595,256,630);

 rectangle(scr, 384,455,544,490);
 rectangle(scr, 448,490,480,630);

 rectangle(scr, 576,455,608,630);
 rectangle(scr, 640,455,672,630);
 rectangle(scr, 608,455,640,490);
 rectangle(scr, 608,595,640,630);

 rectangle(scr, 704,455,736,630);
 rectangle(scr, 736,455,800,490);
 rectangle(scr, 736,525,768,560);
 rectangle(scr, 736,595,768,630);
 rectangle(scr, 768,525,800,630);

 rectangle(scr, 832,455,864,630);
 rectangle(scr, 896,455,928,630);
 rectangle(scr, 864,455,896,490);
 rectangle(scr, 864,595,896,630);

 rectangle(scr, 960,455,992,630);
 rectangle(scr, 992,560,1024,595);
 rectangle(scr, 1024,525,1056,560);
 rectangle(scr, 992,385,1036,420);
 rectangle(scr, 1056,455,1088,630);

 rectangle(scr, 1100,455,1132,560);
 rectangle(scr, 1100,595,1132,630);
end;

Мы все знаем, что изображение - это пикселы или очень маленькие квадратики, сложенные воедино. В этом коде я вывожу надпись "вирус с тобой!" с помощью прямоугольников. У этих прямоугольников есть свои координаты, например - 64, 175,96, 350, значит, отступ левой границы квадрата равен 64, правой - 96, верхней - 175, нижней - 350. И это только мы нарисовали одну палочку у буквы "в". Из таких палочек и получаются буквы. Каждая пустая строка - это начало рисования новой буквы. Результат выполнения этой программы вы можете увидеть на рис.:

Второй способ

Прошлым способом пользоваться трудно, зато эффективно. Трудно, т.к. много данных надо вводить и просчитывать (кто будет им пользоваться, могу посоветовать использовать систему координат для удобства), а эффективно, потому что изображение всегда будет поверх остального (см. скриншот). Сейчас мы сделаем вывод текста немного другим способом. Внимание! Этот пример не будет работать в Delphi 5 и младше. Создаём новое приложение и ставим у формы следующие свойства:

  • "Height" и "Width" на значения выше разрешения вашего экрана (обязательно выше разрешения, например, если у вас разрешение 1024х1280, то свойства задайте, как минимум, 1300 и 1300, соответственно)
  • "FormStyle" измените на "fsStayOnTop" (окно всегда будет располагаться поверх других)
  • "Border style" на "bsNone"
  • "Left"=0
  • "Top"=0
  • "WindowState" на "wsMaximized"
  • "AlphaBlendValue" = 50
  • "AlphaBlend"=true

Последние два свойства используются для прозрачности программы. Далее на форму поставьте компонент "TLabel" и в свойстве "Caption" впишите ваш текст, например, "Вирус с тобой!" (ну нравится мне эта фраза). Затем в свойстве "Font" измените шрифт на "Arial Black" и размер шрифта на "72", сделайте шрифт жирным. Поставьте эту надпись посередине экрана и создайте обработчик события "OnActivate" и внесите код:

procedure TForm1.FormActivate(Sender: TObject);
begin
 ShowWindow (Application.Handle, SW_HIDE);
end;

Этим кодом мы убрали приложение с панели задач. Компилируйте и подкалывайте! Только хочу сказать, что в некоторых Windows прозрачность не действует и окно с нашей надписью располагается поверх остальных, поэтому будьте осторожны, не то прикол проколется. То, что получилось у меня, вы можете увидеть на рис.:


Нешуточная печать

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

Для начала возьмём шаблон и поместим на его форму компонент "TMemo" и, при выделенном Memo1, отыщем в объектном инспекторе свойство "Lines" и кликнем два раза справа от него. В открывшемся окне напишем то, что мы хотели бы распечатать. Я, например, написал следующее: "Принтер глючит. Вирус испортил драйвера. Печать в отключке. У вас есть немного времени попрощаться с принтером!!! Торопитесь!". И ещё немного пустого места, чтобы текст не смешивался. После этого изменим свойство "Visible" на "False" и "Enabled" на "False". У компонента "Timer" изменим свойство "Interval" на значение времени, за которое принтер сможет распечатать наши строки, например, 300000 (это равно пяти минутам). Далее два раза кликнем по "часикам" и вносим код:

procedure TForm1.Timer1Timer(Sender: TObject);
var p:textfile; {Объявляю две переменные, одна для работы с принтером}
i:integer; {другая для печати строк}
begin
 AssignPrn(p); {назначаю переменной принтер}
 Rewrite (p); {открываю принтер}
 for i:=0 to Memo1.Lines.Count-1 do
 writeln (p, memo1.lines. strings[i]); {печатаю текст}
 closefile(p); {корректно завершаю работу принтер}
end;

Все объяснения в комментариях. Если вы теперь попробуете скомпилировать программу, то получите ошибку. Для её устранения в начале программы в раздел "Uses" впишите "Printers", в этом Модуле находятся все функции, связанные с принтером. Вот и всё - смерть жмота от бесконечной печати принтера обеспечена!


Не прячьте валидол

Какой пользователь не боится потери всех своих игрушек, картинок и коллекции фильмов с жёсткого диска? Да, такие, может, и есть, но они занесены в красную книгу как вымирающий вид. Вот мы сейчас и обеспечим остальным, которые вне красной книги, форматирование винчестера. Правда, настоящее форматирование это уже не шутка, т.к. пользователь месяц будет оплакивать то, что нажил непосильным трудом, поэтому мы сделаем лже-форматирование. Для начала откройте Delphi и задайте форме следующие параметры у формы:

  • "Caption" - "Формат Локальный диск (С:)"
  • "BorderStyle" - "bsDialog"
  • "Width" - 265
  • "Height" - 400

Затем поместите на форму компоненты:

  • "Label" (4 штуки)
  • "ComboBox" (3 штуки)
  • "Edit" (1 штука)
  • "GroupBox" (1 штука)
  • "CheckBox" (3 штуки) поместите внутри "GroupBox"
  • "ProgressBar" с вкладки "Win32" (1 штука)
  • "Button" (2 штуки)

Разместите компоненты, как показано на рис.:

А теперь будем исправлять свойства компонентов:

  • "Label1" : "Caption" - "Емкость:"
  • "ComboBox1" : "Text" - подставьте емкость винта, на котором будет производиться форматирование; "Enabled" - "False"
  • "Label2" : "Caption" - "Файловая система:"
  • "ComboBox2" : "Text" - "NTFS" ; "Enabled" - "False"
  • "Label3" : "Caption" - "Размер кластера:"
  • "ComboBox3" : "Text" - "4096 байт" ; "Enabled" - "False"
  • "Label4" : "Caption" - "Метка тома:"
  • "Edit1" : "Caption" - "" (оставьте пустое место)
  • "GroupBox1" : "Caption" - "Способы форматирования"
  • "CheckBox1" : "Caption" - "Быстрое (очистка оглавления)"
  • "CheckBox2" : "Caption" - "Использовать сжатие"
  • "CheckBox3" : "Caption" - "Создание загрузочного диска MS-DOS";"Enabled" - "False"
  • "Button1" : "Caption" - "Начать"
  • "Button2" : "Caption" - "Закрыть"

Самое нудное мы сделали, а теперь будет самое интересное. Нажмите два раза на кнопку "Закрыть" и впишите код:

procedure TForm1.Button2Click(Sender: TObject);
begin
 MessageBox (0,'Вы не можете закрыть форматирование,
 если оно на начато. Нажмите кнопку начать, а потом
 закрыть','Внимание',0);
 Button2.Enabled:=false;
end;	

В процедуре мы выводим сообщение с текстом, а потом делаем кнопку недоступной. Кстати, код "MessageBox" надо писать в одну строку.

Далее один раз нажимаем на форму и в объектном инспекторе, на вкладке "Events", находим "OnCloseQuery" и кликаем два раза рядом, чтобы создать обработчик этого события, и в него пишем код:

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
 canclose:=false; // запрещаю программе быть закрытой обычным способом
end;

Как вы уже, наверное, догадались, с помощью данного кода нажатием на крестик нашу программу не закрыть. Надо вызывать диспетчер задач и через него закрывать.

И самое главное - кликаем два раза по кнопке "Начать" и вносим самый главный код:

procedure TForm1.Button1Click(Sender: TObject);
var a:byte;
begin
 for a:=1 to 100 do begin
 ProgressBar1.Position:=ProgressBar1.Position+1;
 sleep (2000);
 end;
 Button2.Enabled:=true;
end;

В этом коде я сначала объявляю переменную "а", которую буду использовать как счётчик в цикле, потом создаю цикл, в котором добавляю +1 позицию нашему "прогресс бару", останавливаю выполнение программы на 2 секунды и заново повторяю цикл, и так всего 100 раз. Получается, что форматирование будет проходить 200 секунд (жертва без "100 грамм" не разберётся, что к чему). И в самом конце делаю кнопку "Закрыть" опять доступной. Правда, получается замкнутая цепочка форматирований, но вы сможете подбежать к жертве и "спасти" компьютер от форматирования (будете героем в глазах чайника). Мы эту программу делали хоть и долго, но, я уверен, что временные затраты себя оправдают. Как я себе форматировал винт, можете увидеть на рис. (слева моя программа, справа - форматирование от Windows):


И напоследок...

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

(Окончание следует)

Резидент Николай,
rezidentnik@gmail.ru

Версия для печатиВерсия для печати

Номер: 

44 за 2008 год

Рубрика: 

Азбука программирования
Заметили ошибку? Выделите ее мышкой и нажмите Ctrl+Enter!

Комментарии

Страницы

Аватар пользователя Rezident
>Похоже, что да.

Извини, редко бываю в сети...

Если ты про манипуляции с реестром, то проски в автозагрузку с тебя хватит:)

Так что за Рolicies в реестре?

Аватар пользователя mike
>Что за Рolicies в реестре?

HKCU\Soft\MS\Win\CurVer\Policies\System, параметры "DisableRegistryTools" и "DisableTaskMgr"

>проски в автозагрузку с тебя хватит:)

Не надо хамить. Учите реестр, сударь, автор всё же.

>редко бываю в сети...

Заметно.

Страницы