Шутки над пользователем

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

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

В приведённом ниже примере при помощи обычного диалогового окна пользователю показывается сообщение об ошибке, причём кнопка «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;

{/codecitation}

Добавить комментарий