![]() |
![]() ![]() ![]() ![]() |
|
Шутки над пользователемDelphi , Программа и Интерфейс , Приложения чужиеШутки над пользователемНекоторых пользователей врят ли можно будет испугать экранным вирусом, однако можно воспользоваться другими способами запугивания, например: прозрачные окошки, недоступные пункты меню с большим количеством подуровней, а так же сообщения об ошибках, которые нельзя убрать. В приведённом ниже примере при помощи обычного диалогового окна пользователю показывается сообщение об ошибке, причём кнопка "close" накак не хочет нажиматься. У этого диалога есть зависимое окно, которое показывается, при нажатии кнопки "details". Поддельная форма с сообщением об ошибке имеет кнопку "details", которая открывает вторую часть формы. Это достигается путём добавления компонента за пределы самой формы:
object Form2: TForm2
AutoScroll = False
Caption = 'Error'
ClientHeight = 93
ClientWidth = 320
OnShow = FormShow
object Label1: TLabel
Left = 56
Top = 16
Width = 172
Height = 65
AutoSize = False
Caption =
'Программа выполнила недопустимую ' +
'операцию. Если проблема повторится, ' +
'то обратитесь к разработчику программного обеспечения.'
WordWrap = True
end
object Image1: TImage
Left = 8
Top = 16
Width = 41
Height = 41
Picture.Data = {...}
end
object Button1: TButton
Left = 240
Top = 16
Width = 75
Height = 25
Caption = 'Close'
TabOrder = 0
OnClick = Button1Click
end
object Button2: TButton
Left = 240
Top = 56
Width = 75
Height = 25
Caption = 'Details >>'
TabOrder = 1
OnClick = Button2Click
end
object Memo1: TMemo // за пределами формы!
Left = 24
Top = 104
Width = 265
Height = 89
Color = clBtnFace
Lines.Strings = (
'AX:BX 73A5:495B'
'SX:PK 676F:FFFF'
'OH:OH 7645:2347'
'Crash 3485:9874'
''
'What''s going on here?' )
TabOrder = 2
end
end
Когда пользователь нажимает кнопку "details", то программа просто изменяет размер формы: procedure TForm2.Button2Click(Sender: TObject); begin Height := 231; end; Вторая форма, которая наследуется от первой имеет перемещающуюся кнопку "close": procedure TForm3.Button1Click(Sender: TObject); begin Button1.Left := Random(ClientWidth - Button1.Width); Button1.Top := Random(ClientHeight - Button1.Height); end; В заключении, можно сделать дырку в окне, используя API функцию SetWindowRgn:
procedure TForm1.Button4Click(Sender: TObject);
var
HRegion1, Hreg2, Hreg3: THandle;
Col: TColor;
begin
ShowMessage('Ready for a real crash?');
Col := Color;
Color := clRed;
PlaySound('boom.wav', 0, snd_sync);
HRegion1 := CreatePolygonRgn(Pts,
sizeof(Pts) div 8,
alternate);
SetWindowRgn(
Handle, HRegion1, True);
ShowMessage('Now, what have you done?');
Color := Col;
ShowMessage('Вам лучше купить новый монитор');
end;
Шутки над пользователем: создание различных ошибок и неожиданных ситуаций для запугивания пользователя. Комментарии и вопросыПолучайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш :: Главная :: Приложения чужие ::
|
||||
©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007 | ||||