"Прикольная" форма в Delphi

Наверное, вы слышали (и только!) о таком розыгрыше советских времён. К металлическому рублю припаивают гвоздь, а затем всю эту конструкцию вбивают в пол и скрытно ждут наивного искателя сокровищ. Рано или поздно он появляется. Ничего не подозревающий «счастливчик» пытается поднять ценную находку, да не тут то было - рубль невозможно ни сдви­нуть, ни сковырнуть. Остаётся только с досадой смотреть на него... (Ещё более мерзкий вариант этого розыгрыша: прибить гвоздями к полу ботинки товарища. Заодно вы сможете проверить, насколько у него развито чувство юмора, - и вообще, товарищ ли он вам.)

 

А почему бы нам не сыграть эту шутку средствами Delphi? Суть подвоха: при запуске программы на экране появляется совершенно обычная форма, но она так привязана к своему месту рождения, что и не сдвинешь (как судно на приколе). Изменить размеры формы тоже не удастся - сколько ни тяни её за углы и стороны! Более того, на каждую попытку покуситься на её суверенитет форма откликается отборными русскими выражениями (их отбор зависит от вас).

Главную роль в нашей программе исполнит процедура WMPosChange. Она обрабатывает сообщение WindowsWM_WINDOWPOSCHANGING, которое окно получает при изменении его размеров и положения. В ролях второго плана - процедуры WMSizeи WMSizeChange, также связанные с сообще­ниями операционной системы.


unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls; type TForm1 = class(TForm) Label1: TLabel; Timer1: TTimer; procedure Timer1Timer(Sender: TObject); private { Private declarations } procedure WMPosChange (var Message: TWMWINDOWPOSCHANGING); message WM_WINDOWPOSCHANGING; procedure WMSize (var Message: TWMSIZE); message WM_SIZE; procedure WMSizeChange (var Message: TWMGETMINMAXINFO); message WM_GETMINMAXINFO; public { Public declarations } end; var Form1: TForm1; implementation

Не трогая свойства новой формы, установите на ней метку
Label1: Font.Color = clRed Font.Height = -32 Font.Style = [fsBold] и таймер Timer1 (Рис. С7.12): Enabled = False Interval = 500
Чтобы запретить изменение положения и размеров формы, перехватыва­ем сообщение WindowsWM_WINDOWPOSCHANGINGи добавляем флаги SWP_NOMOVEи SWP_NOSIZE:
//ЗАПРЕТИТЬ ПЕРЕМЕЩЕНИЕ ФОРМЫ И ИЗМЕНЕНИЕ ЕЁ РАЗМЕРОВ procedure TForm1.WMPosChange (var Message: TWMWINDOWPOSCHANGING); begin PWindowPos(TMessage(Message).lParam).Flags:= PWindowPos(TMessage(Message).lParam).Flags or SWP_NOMOVE or SWP_NOSIZE; end; Теперь форма будет стоять на экране, как корабль - на якоре. Стираем надпись на метке, которая появляется при старте программы: procedure TForm1.WMSize(var Message: TWMSIZE); begin if Message.SizeType <> 0 then Label1.Caption:= '' end;

Следующая процедура будет отзываться (или обзываться) на попытку сдвинуть форму или изменить её размеры:

 //ОТВЕТ НА ПОПЫТКУ ИЗМЕНИТЬ СТАТУС ФОРМЫ procedure TForm1.WMSizeChange (var Message: TWMGETMINMAXINFO); begin if Message.Msg <> 0 then Label1.Caption:= Что вы меня дёргаете?’; Timer1.Enabled:= True; end; Таймер необходим для того, чтобы через некоторое время стирать надпись: //СТЕРЕТЬ НАДПИСЬ procedure TForm1.Timer1Timer(Sender: TObject); begin Label1.Caption:= ’’; Timer1.Enabled:= False; end; 

После старта программы форма будет выглядеть совершенно обычно, но как только пользователь зацепит её мышкой, она отзовётся раздражён­ным сообщением 

delphi

dle

Помоги проекту! Расскажи друзьям об этом сайте: