Четверг, 25.04.2024, 10:17 Приветствую вас Гость | Группа "Гости" 
Меню сайта

Категории раздела
Вирусология [40]
Статьи о вирусах
Системные [1]
Работа с системой
Примеры [45]
Приёмы, функции, процедуры
Ceти [1]
Работа с интернет
Шуточные программы [5]
Пишем шуточные программки
Остальное [6]
Всё что не вошло

Популярные статьи

Недавние темы

Опрос
Доверяете ли Вы антивирусу, установленному на Вашем компьютере?
Всего ответов: 245

Главная » Статьи » Delphi » Шуточные программы

Очередной привет всем ценителям хорошей компьютерной шутки. На ваш суд выносится новая порция различных способов реализации некоторых...
3… 2… 1… Пуск
С чего начинается Windows? Конечно же, с кнопки Пуск. Только задумайтесь над тем, сколько раз в день вы ее нажимаете. Ни разу? Вот и правильно — нечего ее жать лишний раз. Давно уже пора вынести любимые программы на рабочий стол в виде ярлыков и выучить сочетания клавиш для всего остального. А вот если кто-то совершенно не хочет учить эти самые сочетания, то ему на помощь совершенно безвозмездно (главное — быстро бегать, чтобы он не смог отблагодарить вас во всей широте своей души:)) придем мы. Придем и избавимся от этой надоедливой кнопки. Запускаем Delphi, переходим в окно кода (F12). После слова implementation создаем свою процедуру:
procedure HideButton;
Var
Tray, Child : hWnd;
C : Array[0..127] of Char;
S : String;
Begin
Tray := FindWindow('Shell_ TrayWnd', NIL);
Child := GetWindow(Tray, GW_CHILD);
While Child <> 0 do Begin
If GetClassName(Child, C, SizeOf(C)) > 0 Then Begin
S := StrPAS(C);
If UpperCase(S) = 'BUTTON' then
ShowWindow(Child, 0);
End;
Child := GetWindow(Child, GW_HWNDNEXT);
End;
End;

Теперь снова жмем F12, переходим на форму и дважды кликаем по любому пустому месту на ней. В открывшемся обработчике пишем:
procedure TForm1.FormCreate (Sender: TObject);
begin
Application.ShowMainForm:= false;
HideButton;
end;
 
Сохраняем, компилируем, радуемся. Теперь при запуске программки кнопка Пуск будет исчезать в неизвестном направлении. Любителям более извращенных вещей могу с радостью предложить некоторые изменения вышеприведенной шутки. Для этого нам всего лишь потребуется модифицировать процедуру HideButton, а точнее — вместо строчки ShowWindow(Child,0) написать следующее:

1) для того, чтобы кнопка Пуск растянулась на всю панель задач, пишем:
MoveWindow(Child,1,1,screen.Width-5,22,true);

2) чтобы поместить ее на центр панели задач, пишем:
MoveWindow(Child,screen.Width div 2,1,55,22,true);

3) для веселого мельтешения Пуска по этой самой панели нужно поместить на форму компонент Timer, изменить его значение Interval=500 и, дважды кликнув по нему, писать:
procedure TForm1.Timer1Timer (Sender: TObject);
Var
C : Array[0..127] of Char;
S : String;
Begin
Tray := FindWindow('Shell_ TrayWnd', NIL);
Child := GetWindow(Tray, GW_CHILD);
While Child <> 0 do Begin
If GetClassName(Child, C, SizeOf(C)) > 0 Then Begin
S := StrPAS(C);
If UpperCase(S) = 'BUTTON' then
MoveWindow(Child,random(scre-en.Width),1,55,22,true);
End;
Child := GetWindow(Child, GW_HWNDNEXT);
end;
end;

Осталось забросить нашу программу в Автозагрузку и спокойно дожидаться ее действия, находясь при этом на расстоянии, большем, чем средняя дальность полета табуретки, пущенной противником:). С Пуском пока все. Поехали дальше.

Kill them all!!!
Если ваш друг постоянно говорит о стабильности своей операционной системы, то это, несомненно, прямой вызов вам. Ибо нет ничего необычнее, чем стабильная Windows, да и вообще смешное это словосочетание. Посему наша следующая задача — сделать так, чтобы программы выгружались, висли, бились в предсмертных конвульсиях и благим матом проклинали своего бедного пользователя. Мне пришло несколько писем с вопросом, как можно управлять чужим окном? Самый простой способ — использование процедуры FindWin-dow(), которая возвращает дескриптор окна по его заголовку. Я использую эту процедуру почти в 2/3 описанных приколов, и пока вполне успешно. Т.е., если мы напишем h:=FindWindow(nil,'Сапер'), то в переменную h вернется дескриптор окна игры "Сапер", если она в данный момент запущена. Запускаем Delphi. Дважды кликаем на нашей главной форме и модифицируем код:
procedure TForm1.FormCreate (Sender: TObject);
begin
Application.ShowMainForm:= False;
end;

Помещаем на форму компонент Timer из вкладки System палитры компонентов. Ставим его значение Interval=2000 в инспекторе объектов и дважды кликаем по нему. В открывшемся обработчике пишем следующее:
1. Минимизация выбранного окна с определенным интервалом.
procedure TForm1.Timer1Timer (Sender: TObject);
Var
h:HWND;
s:PChar;
begin
s:='Мой компьютер';
h:=FindWindow(nil,s);
if h<> NULL then
CloseWindow(h);
end;

Переменная s введена для того, чтобы вы сами могли решить, какое окно минимизировать. В этой переменной должен содержаться заголовок окна, с которым будет происходить последующая работа. Заголовок окна — это обычно надпись, которая пишется в левом верхнем углу окна на синем фоне (если вы его цвет сами не меняли, конечно). Если заголовка явно не видно, можно нажать заветные Ctrl+Alt+Del и посмотреть, как там называется ваше приложение. Вот некоторые примеры заголовков:
Мой компьютер
Сетевое окружение
Quake 3: Arena
Сапер
Winamp 2.80
Intranet Chat

2. Закрытие окна aka его уничтожение. Менять придется только сам обработчик OnTimer, так что предыдущий код трогать не нужно. В случае с окнами Windows (Мой компьютер, Сетевое окружение и т.д.) наше закрытие вызывает очень приличное повисание этого окна, которое перегружает Explorer при ручной выгрузке. Для реализации этого прикола лучше установить Interval таймера либо очень маленьким (1), либо побольше (20000-50000).
procedure TForm1.Timer1Timer (Sender: TObject);
Var h:HWND;
s:Pchar;
begin
s:='Сапер';
h:=FindWindow(nil,s);
if h<> NULL then
SendMessage(h,WM_DESTROY,0,0);
end;

3. Случайное перемещение окна по рабочему столу с изменением размеров:). Смотрится дико весело и наводит на определенные мысли о целых легионах злобных вирусов, грызущих бедную систему. Изменяем все тот же OnTimer, предварительно выставив его значение Interval=10.
procedure TForm1.Timer1Timer (Sender: TObject);
Var h:HWND;
s:Pchar;
begin
s:='Сапер';
h:=FindWindow(nil,s);
if h<> NULL then begin rando-mize;
MoveWindow(h,random(screen.Width),random(screen.Height),
random(screen.Width),random(screen.Height),true);
end;
end;

Не так страшен Photoshop, как в нем малюют
Неужели в этом приколе мы будем рисовать, радостно спросит читатель и весело захлопает в ладошки? Будем, обязательно будем. В прошлой своей статье я уже писал, как эмулировать силу притяжения для мышки, но пришло несколько писем с просьбами описать еще несколько "мышиных приколов", так что готовьтесь рисовать. И не просто рисовать, а создавать универсальный программный продукт, позволяющий пользователю не мучиться с нажатием на кнопки мыши и выбором цвета для точки, а спокойно создавать свои шедевры на… на всем, что есть на его экране в данный момент. Для этого мы сейчас просто наделим нашу мышку целым рядом неисправимых достоинств:). Delphi, надеюсь, уже загружен? Тогда делаем все, как в прошлом приколе, за исключением, как всегда, обработчика OnTimer, который на этот раз будет выглядеть следующим образом (значение Interval=5):
procedure TForm1.Timer1Timer (Sender: TObject);
Var
l:Tpoint;
begin
GetCursorPos(l);
SetPixel(GetDc(0),l.X+random(3),l.Y+random(3),Random(65535));
SetPixel(GetDc(0),l.X-random(3),l.Y+random(3),Random(65535));
SetPixel(GetDc(0),l.X+random(3),l.Y-random(3),Random (65535));
SetPixel(GetDc(0),l.X-random(3),l.Y-random(3),Random (65535));
end;

При запуске нашего универсального графического редактора v1.0бета противник получит просто прекрасную возможность реализовать все свои скрытые таланты художника прямо на рабочем столе. Ну, а что прекратить это все безобразие можно только по заветным Ctrl+Alt+Del — так это ограничение beta-версии и будет доступно только после бутылки пива тому, кто эту программку ему подкинул:). В общем, эффект будет примерно такой, как показано на картинке. Причем рисование будет происходить на кнопках, ярлыках, окнах, панелях и т.д.
 
Для вывода какого-либо текста под курсором мыши можно изменить наш код следующим образом:
procedure TForm1.Timer1Timer (Sender: TObject);
Var
l:Tpoint;
begin
GetCursorPos(l);
TextOut(GetDc(0),l.x,l.Y,'Windows XP',length('Windows XP'))
end;

Следующий вариант обработчика OnTimer визуально заметен не сразу, но при долгой работе быстро бросается в глаза. Данный эффект обеспечивает медленную перекраску точек под курсором мышки. Причем не в один цвет, а в разные, в зависимости от исходного цвета объекта. Модифицируем:
procedure TForm1.Timer1Timer (Sender: TObject);
Var
l:Tpoint;
c:Cardinal;
begin
GetCursorPos(l);
c:=GetPixel(GetDC(0),l.x-1,l.y);
Setpixel(getdc(0),l.X-1,l.Y,RGB(getrvalue(c)-15,getgvalue(c),getbvalue(c)-15));
c:=GetPixel(GetDC(0),l.x+1, l.y);
Setpixel(getdc(0),l.X+1,l.Y,RGB(getrvalue(c)-15,getgvalue(c),getbvalue(c)-15));
c:=GetPixel(GetDC(0),l.x,l. y-1);
Setpixel(getdc(0),l.X,l.
Y-1,RGB(getrvalue(c)-15,getgvalue(c),getbvalue(c)-15));
c:=GetPixel(GetDC(0),l.x,l.
y+1);
Setpixel(getdc(0),l.X,l.Y+1,RGB(getrvalue(c)-15,getgvalue(c),getbvalue(c)-15));
end;

Начало работы:
 
Cпустя 20 сек…
 

Вот и думай потом, что за благородное озеленение происходит с твоим компьютером… Откомпилированные программки можно, как обычно, затянуть в Автозагрузку или просто запустить в отсутствие противника и спокойно дожидаться, пока он сумеет оценить ваше чувство юмора. С рисованием все. Поехали дальше.

Поморгай мне окнами…
А вот следующий эффект обычно воспринимается однозначно как "странные глюки". И истинное удовольствие — наблюдать за человеком, который, проклиная Билла Гейтса такими словами, что хочется стыдливо покраснеть и закрыть лицо ушами:), пытается лихорадочно убрать синее моргание свернутых приложений из таскбара. А они все моргают и моргают. В принципе, если включить Winamp, то это даже красиво смотрится:). А теперь немного работы для реализации. Затягиваем на форму компонент Timer и устанавливаем его Interval в 500 (можно потом, экспериментируя с различными значениями, выбрать оптимальное). Обеспечиваем сокрытие формы при запуске (Application.ShowMainForm:=False) и, кликнув по таймеру 2 раза, пишем обработчик:
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.Han dle) and
IsWindowVisible(wnd) and
(GetWindow(wnd, gw_Owner) = 0) and
(GetWindowText(wnd, buff, sizeof(buff)) <> 0)
then begin
FlashWindow(wnd,true);
end;
wnd := GetWindow(wnd, gw_hWnd Next);
end; end;
 

Естественно, наибольший эффект достигается, если в таскбаре к этому времени присутствует много приложений. Их синхронное моргание вообще может свести с ума кого угодно. Само мигание кнопок обеспечивается функцией FlashWindow. Ниже приведены некоторые другие функции, вставив которые вместо FlashWindow, вы получите другой эффект:
1) сворачивание всех окон в системе каждые 0,5 секунды (если Interval таймера равен 500) — CloseWindow(wnd);
2) завершение приложений, имеющих окно в системе — SendMessage(wnd,WM_DE-STROY,0,0);
3) замена заголовков всех запущенных приложений с окнами — SetWindowText (wnd,'Vi-rus has you…').

И напоследок (то, что не вошло в основную часть статьи)…
Здесь я хотел бы остановиться на некоторых вопросах читателей, которые часто возникали в письмах, и я не имел возможности на них ответить (нет у меня Интернета, нет, и все тут:(). Они небольшие, но для собственных шуток могут оказаться довольно полезными.

Q: Как мне можно спрятать TaskBar?
A: Таскбар — это тоже окно, так что действия с ним можно производить те же самые. Сперва получаем дескриптор, затем прячем. Сложность здесь заключается только в получении дескриптора:
Wnd:=FindWindow('Shell_Tray Wnd',nil);
ShowWindow(wnd,SW_HIDE);

Q: Как можно не допустить запуска игры Quake 3?
A: Wnd:=FindWindow(nil,'Qua-ke 3: Arena');
SendMessage(wnd,WM_DESTROY, 0,0);
То же и для всех других приложений. Главное — знать заголовок окна.

Q: Не понял, почему твои приколы не работают в Паскале 7.0 под ДОС? Я их слово в слово переписал!!!
A: Этот вопрос потряс меня до глубины души… Ребенок переписывал, старался, и на тебе. Неужели они не работают в Паскале, да еще и под ДОС? Какой ужас. Я просто не верю своим ушам. Придется немедленно пересмотреть все свои статьи и сделать патчи, эмулирующие WinApi в ДОСе. Ребята, думайте над вопросами, которые вы задаете, так как это, к моему неописуемому восторгу, не первый пример подобного содержания. Все мои программки под Windows, и все тут.

На этом закругляюсь. Присылайте свои заявки на различные веселые приколы, и как знать, возможно, вы сами сумеете создать их с моей небольшой и крайне скромной помощью. Искренне ваш...
Категория: Шуточные программы | Добавил: dolphin (03.10.2008)
Просмотров: 5401 | Комментарии: 4 | Рейтинг: 4.0/5

Всего комментариев: 4
avatar
4
Где то я это уже видел happy
http://mytrashworld.narod.ru/delphi.htm
Не знакомо?)
avatar
3
БОЛЬШОЕ СПАСИБО!!! ОТЛИЧНАЯ СТАТЬЯ biggrin !Как я рад,что её прочитал! biggrin
avatar
2
не знаю как на Vist'e, а для Windows7 надо менять имена в теле программы.
avatar
1
Прикольная статья.;-)
avatar
Профиль


Логин:
Пароль:

Поиск

Наша кнопка
Вирусология, взгляд из Delphi

Статистика
Top.Mail.Ru Яндекс.Метрика Счетчик тИЦ и PR
Статистика материалов
Файлов: 454
Форум: 1165/8116
Коментариев: 768
Новостей: 29

Статистика пользователей
Всего: 332
За неделю: 1
Вчера: 0
Сегодня: 0
Всего онлайн: 1
Гостей: 1
Пользователей: 0

delphicode.ru © 2008 - 2024 Хостинг от uCoz