Шутки над пользователем
Некоторых пользователей врят ли можно будет испугать экранным вирусом,
однако можно воспользоваться другими способами запугивания, например:
прозрачные окошки, недоступные пункты меню с большим количеством
подуровней, а так же сообщения об ошибках, которые нельзя убрать.
В приведённом ниже примере при помощи обычного диалогового окна
пользователю показывается сообщение об ошибке, причём кнопка "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;
|