www.marco
cantu.com

Copyright 1997
Marco Cantù

The Fun Side of Delphi

This text is a work in progress: suggestions me corrections and changes are welome. You can follow this link to get to an extended area, the ActiveVirus page, also called "Web Measles". This paper is copyright Marco Cantù 1997 and cannot be distributed without permission.

Delphi programming is fun. The environment is easy to use and is quite powerful, and programmers enjoy using it. The more you use Delphi, the more you find out that there are ways to configure it, and perform a number of strange actions. Beside writing programs you can use Delphi to extend its own environment with components and experts.

The real fun (if we can say so) is when you spend time to do useless things, otherwise writing programs can be considered as a work. Although there is some effort involved, you can really have a lot of fun in Delphi.

This paper describes a number of ways to loose time and have fun in Delphi, writing components, stretching Delphi and Windows to the limit, and configuring the environment with Experts and other tools. Being a "fun" presentation, some multimedia will be involved, of course.

Useless Components

If you program in Delphi you probably know about Smiley. It is one of the first Delphi components ever developed, and it shows a smiling face. Actually it is a great tool to show how to build components (some of the components discussed in this paper can actually provide similar hints, as well).

We want to built a component, but how do we build one? Please refer to a specific session, article, or book, to discover everything about writing components. For this presentation you only need to know that a component is a subclass of class TComponent (or one of its subclasses), that there are three kinds of components (non-visual components, window-based components, and graphical components), and that components have methods, properties, and events.

Instead of discussing components in general, I prefer showing you how to build some useless ones (in this section) and some very strange ones (in the next section). For the moment, let me focus on how you can make a lot of work to obtain very little, but still have some fun in the process (and in the result).

The Nothing Component

The first component is probably the less useful component you can build: it does nothing. Luckily it takes very little coding to implement it. The nothing component (of class TNothing) is a graphical component, having no output, and only inherited properties and events. I can see no use for it, which is why it is the first of the list.

Still, we have to write some code. In fact if we want our component to have standard properties and events we have to list them:

type
  TNothing = class(TGraphicControl)
  public
    constructor Create (Owner: TComponent); override;
  published
    property Width default 50;
    property Height default 50;
    property Align;
    property ShowHint;
    property Visible;
    ...
  end;

We also need to write the code of the Create constructor of the component (which sets the default values) and the Register procedure:

constructor TNothing.Create (Owner: TComponent);
begin
  // call parent class constructor first
  inherited Create (Owner);
  // set the size
  Width := 50;
  Height := 50;
end;

procedure Register;
begin
  RegisterComponents('DDHB', [TNothing]);
end;

The Auto-Pressing Button

This component falls is a slightly different category. It is a component for the lazy users, a button you don't have to click to have an OnClick event. You only need to drag the mouse over it. In the best tradition of wasting time, this components requires a lot of work, because we need to handle the mouse, capture it, and perform other complex tasks. It is really a lot of work, but the result is well worth it!

I've actually written two versions of theis component. The simplest version redefines a Windows message, with the following code, in which the mouse move message handler looks for and eventually calls the OnClick event handler:

type
  TAutoButton1 = class(TButton)
  private
    procedure WmMouseMove (var Msg: TMessage);
      message wm_MouseMove;
  end;

procedure TAutoButton1.WmMouseMove (var Msg: TMessage);
begin
  inherited;
  if Assigned (OnClick) then
    OnClick (self);
end;

The second version has much more code, since I try to repeat the mouse OnClick event when the user moves the mouse over the button or after a given amount of time. Here is the declaration of the class:

type
  TAutoKind = (akTime, akMovement, akBoth);

  TAutoButton2 = class(TButton)
  private
    FAutoKind: TAutoKind;
    FMovements: Integer;
    FSeconds: Integer;
    // really private
    CurrMov: Integer;
    Capture: Boolean;
    MyTimer: TTimer;
    procedure EndCapture;
    // message handlers
    procedure WmMouseMove (var Msg: TWMMouse);
      message wm_MouseMove;
    procedure TimerProc (Sender: TObject);
    procedure WmLBUttonDown (var Msg: TMessage);
      message wm_LBUttonDown;
    procedure WmLButtonUp (var Msg: TMessage);
      message wm_LButtonUp;
  public
    constructor Create (AOwner: TComponent); override;
  published
    property AutoKind: TAutoKind
      read FAutoKind write FAutoKind default akTime;
    property Movements: Integer
      read FMovements write FMovements default 5;
    property Seconds: Integer
      read FSeconds write FSeconds default 10;
  end;

The code is quite complex, and we don't have time to cover the details. Basically when a user moves the mouse over the area of the button (WmMouseMove) the component starts a timer or counts the move messages. After a given amount of time, or when the proper number of move messages has been reached, the component simulates the mouse click event. The plain OnClick events do not work properly, but I decided I don't care...

procedure TAutoButton2.WmMouseMove (var Msg: TWMMouse);
begin
  inherited;
  if not Capture then
  begin
    SetCapture (Handle);
    Capture := True;
    CurrMov := 0;
    if FAutoKind <> akMovement then
    begin
      MyTimer := TTimer.Create (Parent);
      if FSeconds <> 0 then
        MyTimer.Interval := 3000
      else
        MyTimer.Interval := FSeconds * 1000;
      MyTimer.OnTimer := TimerProc;
      MyTimer.Enabled := True;
    end;
  end
  else // capture
  begin
    if (Msg.XPos > 0) and (Msg.XPos < Width)
      and (Msg.YPos > 0) and (Msg.YPos < Height) then
    begin
      // if we have to consider movement...
      if FAutoKind <> akTime then
      begin
        Inc (CurrMov);
        if CurrMov >= FMovements then
        begin
          if Assigned (OnClick) then
            OnClick (self);
          EndCapture;
        end;
      end;
    end
    else // out of the area... stop!
      EndCapture;
  end;
end;

procedure TAutoButton2.EndCapture;
begin
  Capture := False;
  ReleaseCapture;
  if Assigned (MyTimer) then
  begin
    MyTimer.Enabled := False;
    MyTimer.Free;
    MyTimer := nil;
  end;
end;

procedure TAutoButton2.TimerProc (Sender: TObject);
begin
  if Assigned (OnClick) then
    OnClick (self);
  EndCapture;
end;

procedure TAutoButton2.WmLBUttonDown (var Msg: TMessage);
begin
  if not Capture then
    inherited;
end;

procedure TAutoButton2.WmLButtonUp (var Msg: TMessage);
begin
  if not Capture then
    inherited;
end;

The Input Label component

This component falls in a different category, reinventing the wheel (or reinventing hot water, as we say in Italy). Many Delphi programmers ask me how user can input text in a label, and the obvious reply is, "use an edit box instead."

If you really want to get rid of edit boxes, here comes the solution: a label input components, a label component that can get the user input. This is an overly complex component, because labels have no way to get the input from the keyboard. They are graphical components, not based on a window, so they cannot receive the input focus, and they cannot get text. For this reason I've developed this example in two steps.

First step is an input-button component (quite simple) to show you the input code:

type
  TInputButton = class(TButton)
  private
    procedure WmChar (var Msg: TWMChar);
      message wm_Char;
  end;

procedure TInputButton.WmChar (var Msg: TWMChar);
var
  Temp: String;
begin
  if Char (Msg.CharCode) = #8 then
  begin
    Temp := Caption;
    Delete (Temp, Length (Temp), 1);
    Caption := Temp;
  end
  else
    Caption := Caption + Char (Msg.CharCode);
end;

The input label, instead, has to do a number of tricks to bypass the problems related to its internal structure. Basically the problem can be solved by creating other hidden components (why not an edit box?) at runtime. Here is the declaration of the class:

type
  TInputLabel = class (TLabel)
  private
    MyEdit: TEdit;
    procedure WMLButtonDown (var Msg: TMessage);
      message wm_LButtonDown;
  protected
    procedure EditChange (Sender: TObject);
    procedure EditExit (Sender: TObject);
  public
    constructor Create (AOwner: TComponent); override;
  end;

When the label is created it generates the edit box, and set some event handler for it. In fact as the user clicks on the label the focus is moved to the (invisible) edit box, and we use its events to update the label. Notice in particular the code used to mimic the focus for the label, which is based on the DrawFocusRect API call:

constructor TInputLabel.Create (AOwner: TComponent);
begin
  inherited Create (AOwner);

  MyEdit := TEdit.Create (AOwner);
  MyEdit.Parent := AOwner as TForm;
  MyEdit.Width := 0;
  MyEdit.Height := 0;
  MyEdit.TabStop := False;
  MyEdit.OnChange := EditChange;
  MyEdit.OnExit := EditExit;
end;

procedure TInputLabel.WMLButtonDown (var Msg: TMessage);
begin
  MyEdit.SetFocus;
  MyEdit.Text := Caption;
  (Owner as TForm).Canvas.DrawFocusRect (BoundsRect);
end;

procedure TInputLabel.EditChange (Sender: TObject);
begin
  Caption := MyEdit.Text;
  Invalidate;
  Update;
  (Owner as TForm).Canvas.DrawFocusRect (BoundsRect);
end;

procedure TInputLabel.EditExit (Sender: TObject);
begin
  (Owner as TForm).Invalidate;
end;

The Sound Button

When you press a button you see the 3 dimensional effect of the button being pressed. What about adding a fourth dimension, sound? Of course we need a press sound and a release sound for the button. We might eventually extend the example adding a spoken hint, with a voice reading to the user the hint of the button, but this might even be useful, so I don't want to cover it.

The sound button component has two brand new properties:

type
  TDdhSoundButton = class(TButton)
  private
    FSoundUp, FSoundDown: string;
  protected
    procedure MouseDown(Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer); override;
  published
    property SoundUp: string
      read FSoundUp write FSoundUp;
    property SoundDown: string
      read FSoundDown write FSoundDown;
  end;

These sounds are played when a button is pressed or realeased:

procedure TDdhSoundButton.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  PlaySound (PChar (FSoundDown), 0, snd_Async);
end;

procedure TDdhSoundButton.MouseUp(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  PlaySound (PChar (FSoundUp), 0, snd_Async);
end;

An Animated Button: TAniButton

This is probably a slightly more useful component, but building and using it is a lot of fun, so it really pertains to the presentation. To show graphics inside a button you can might think of using the glyph of a Bitmap Button, but this doesn't work, mainly because changing the image causes the whole button to refresh, with a nasty effect. An alternative is to place a paint area over the button and use TCanvas methods to paint over it, and change the image at runtime.

To provide the images to the animated button, I've decide to rely on the ImageList component, which allows you to place many bitmaps in a single container. Each of the bitmaps will be displayed after the previous one, providing animated effects. The code is quite long, and is available for reference in the companion source code, but it is not in the paper.

Strange Components

After the first group, the useless components, comes a second one, including very awkward ones. Again, there is little reason to use this components in a professional application, but they can be fun.

The Auto-Font-Changer Component

Programmers can be very good at using too many fonts in a form, making it look weird. But nothing can beat a component that automatically changes the font of the components on a form at run-time, without even bothering to ask. The TAutoFont component even provides two different approaches: it can use random fonts, or allow more control to the program. Some of the versions do not work really very well, because of the many font-compatibility problems of Windows, but the effect is nice anyway.

This is the class definition:

type
  TAutoFont = class(TComponent)
  private
    FTimer: TTimer;
    FInterval: Cardinal;
    FFixedSize, FAllAlike: Boolean;
  protected
    procedure OnTimer (Sender: TObject);
    procedure SetInterval (Value: Cardinal);
  public
    constructor Create (AOwner: TComponent); override;
  published
    property Interval: Cardinal
      read FInterval write SetInterval default 10000;
    property FixedSize: Boolean
      read FFixedSize write FFixedSize default True;
    property AllAlike: Boolean
      read FAllAlike write FAllAlike default True;
  end;

The only relevant method of the class is the OnTimer event handler, which includes the font changing code:

procedure TAutoFont.OnTimer (Sender: TObject);
var
  I: Integer;
  Fnt: TFont;
begin
  (Owner as TForm).Font.Name :=
    Screen.Fonts [Random (Screen.Fonts.Count)];
  if not FFixedSize then
    (Owner as TForm).Font.Size := Random (36);
  if not FAllAlike then
  begin
    Fnt := TFont.Create;
    Fnt.Assign ((Owner as TForm).Font);
    for I := 0 to Owner.ComponentCount - 1 do
    begin
      Fnt.Name := Screen.Fonts [Random (Screen.Fonts.Count)];
      if Owner.Components [I] is TWinControl then
        SendMessage (TWinControl (Owner.Components [I]).Handle,
          wm_SetFont, Fnt.Handle, MakeLong (1,0));
    end;
    Fnt.Free;
  end;
end;

The Smart-Closing Component

When you close a form, it simply disappears. Beside hiding forms, there are many other approaches to closing them. I don't intend to discuss the Action property of the OnClose event, but simply show you how to write a button used to close a form slowly by shrinking it to a minimal size. This is not the only possible closing approach, but one of the simplest ones, thanks to the Scale method of forms:

type
  TSmartClose = class(TComponent)
  public
    procedure Close;
  end;

procedure TSmartClose.Close;
begin
  (Owner as TForm).AutoScroll := False;
  repeat
    (Owner as TForm).ScaleBy (93, 100);
    Application.ProcessMessages;
  until (Owner As TForm).Height < 50;
  (Owner as TForm).Close;
end;

The Screen-Virus Component

Never seen a screen virus? It is an illness of the screen of the computer that causes red spots to appear. The same virus can attack forms and windows, and is really fun to write and use it. The only question is how to prevent the virus to spread out of the screen. The code? The key is painting on the screen, after creating a device context with the GetWindowDC API function.

Again the most relevant portion of the code is in the OnTimer event handler:

type
  TScreenVirus = class(TComponent)
  private
    FTimer: TTimer;
    FInterval: Cardinal;
    FColor: TColor;
    FRadius: Integer;
  protected
    procedure OnTimer (Sender: TObject);
    procedure SetInterval (Value: Cardinal);
  public
    constructor Create (AOwner: TComponent); override;
    procedure StartInfection;
  published
    property Interval: Cardinal
      read FInterval write SetInterval;
    property Color: TColor
      read FColor write FColor default clRed;
    property Radius: Integer
      read FRadius write FRadius default 10;
  end;

constructor TScreenVirus.Create (AOwner: TComponent);
begin
  inherited Create (AOwner);
  FTimer := TTimer.Create (Owner);
  FInterval := FTimer.Interval;
  FTimer.Enabled := False;
  FTimer.OnTimer := OnTimer;
  FColor := clRed;
  FRadius := 10;
end;

procedure TScreenVirus.StartInfection;
begin
  if Assigned (FTimer) then
    FTimer.Enabled := True;
end;

procedure TScreenVirus.SetInterval (Value: Cardinal);
begin
  if Value <> FInterval then
  begin
    FInterval := Value;
    FTimer.Interval := Interval;
  end;
end;

procedure TScreenVirus.OnTimer (Sender: TObject);
var
  hdcDesk: THandle;
  Brush: TBrush;
  X, Y: Integer;
begin
  hdcDesk := GetWindowDC (GetDesktopWindow);
  Brush := TBrush.Create;
  Brush.Color := FColor;
  SelectObject (hdcDesk, Brush.Handle);
  X := Random (Screen.Width);
  Y := Random (Screen.Height);
  Ellipse (hdcDesk, X - FRadius, Y - FRadius,
    X + FRadius, Y + FRadius);
  ReleaseDC (hdcDesk, GetDesktopWindow);
  Brush.Free;
end;

Marketing Components

Programmers are often not very good at marketing, and here I've no intention to offer real advice. I've just noticed two trends: one is adding copyright notices everywhere, so everyone realizes who built that nice component, the other is to bother the user so much that he's going to stop using your component altogether (or eventually spend the money to get rid of messages. This is more common in the demo/trial versions, also called "before-you-buy-'cause-you're-going-to-buy-this-component" versions).

Copyright

There are hundreds of ways to add a copyright notice to a component. Here is a limited list of features you can implement sorted by frequence/oddness:

Add an item in the local menu (or Component Editor).
Show a notice is a special screen (see next section).
Add a special useless property (possibly trying to place it at the end or at the beginning of the alphabetically sorted list of properties).
Use the component name or its caption.
Use a special copyright component.
Use the form's caption.
Use Delphi's own title (or other elements of the environment).

Remember you shall buy

When the component is free, but you should register it, the component writer generally tries to remind you he's waiting for the money. The contents of this screen can be more or less friendly, and generally refers to an order form in the help file or a separate file. The real question is, when do you show this screen? A common approach is when the component is created, usually as the program starts. This can be have a drawback if the program has many copies of the component. An alternative is to use a timer to show this screen every x seconds. Also, some programmers like to address more the programmer then the end user, showing the how-to-buy screen only at desing time (when the csDesigning is set in the ComponentState property).

An actual example

Beside presenting ideas about adding copyright notices, I've actually written a component which implements most of these features. The TFunCopyright component implements: dummy properties you cannot change, showing boring messages, changing the caption of the form and changing the title of the application (at design time only), showing copyright information in an external component, a label:

type
  TFunCopyright = class(TComponent)
  private
    FCopyright, FAuthor: string;
    FDummy1, FDummy2: string;
    FLabel: TLabel;
  protected
    procedure SetLabel (Value: TLabel);
  public
    constructor Create (AOwner: TComponent); override;
  published
    property Copyright: string
      read FCopyright write FDummy1;
    property Author: string
      read FAuthor write FDummy2;
    property OutputLabel: TLabel
      read FLabel write SetLabel;
end;

constructor TFunCopyright.Create (AOwner: TComponent);
begin
  inherited Create (AOwner);

  FAuthor := 'Marco Cantù';
  FCopyright := '(c)MC 1997';
  if csDesigning in ComponentState then
  begin
    with Owner as TForm do
      Caption := Caption +
        ' using a component by ' + FAuthor;
    with Application do
      Title := Title +
      ' using a component by ' + FAuthor;
    ShowMessage ('This form is using a component by ' +
      FAuthor);
  end
  else
    ShowMessage ('This program uses a component by ' +
      FAuthor);
end;

procedure TFunCopyright.SetLabel (Value: TLabel);
begin
  if Value <> FLabel then
  begin
    FLabel := Value;
    FLabel.Caption := FCopyright;
  end;
end;

Configuring the Object Inspector

Having written useless or crazy components, we can move to a different topic, writing overly complex and not much useful property editors, to customize the Object Inspector. Again here is a list of awful ideas you can spend a lot of time working on.

An Integer Spin-Editor

Why punch in numbers in the Object Inspector? It will be easier to increase or decrease values using an UpDown component, and we can indeed write a separate property editor using it. At the end, it will take for more time to input numbers, but it will eventually be easier. But how do you create a property editor? Basically derive a class from an existing property editor class, overriding some virtual functions:

type
  TSpecialIntProperty = class (TIntegerProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure Edit; override;
  end;

The important method is Edit, which is often used to show a dialog box (built in Delphi, as usual):

function TSpecialIntProperty.GetAttributes:
  TPropertyAttributes;
begin
  Result := [paDialog, paReadOnly];
end;

procedure TSpecialIntProperty.Edit;
var
  PEForm: TSpinForm;
begin
  PEForm := TSpinForm.Create (Application);
  try
    PEForm.Edit1.Text := GetValue;
    if PEForm.ShowModal = mrOK then
      SetValue (PEForm.Edit1.Text);
  finally
    PEForm.Free;
  end;
end;

In this code GetValue and SetValue are two special methods of the parent property editor, accessing to the data of the given property of the current component. To make this work you have to write also a proper registration procedure:

procedure Register;
begin
  RegisterPropertyEditor (TypeInfo(Integer),
    TButton, '', TSpecialIntProperty);
end;

A Sounds Property Editor

Another really useful property editor, instead, is a sound editor related to the Sound Button component we've discussed before. This lets you associate a sound name with given properties, and test it with a preview option, and look for a suitable file on disk. The code is quite simple but this example is actually useful, so I'm going to skip its complete description. What is interesting, in this case is the registration code (which is repeated for the two sound properties of the component):

RegisterPropertyEditor (TypeInfo(string),
    TSoundButton, 'SoundUp', TSoundProperty);

A Custom Color Property Editor

Colors are so nice to work with, and the standard color dialog box becomes boring after a while: for this reason I've explored many alternatives to replace it. What is nice about this third property editor, is that it automatically changes every time you use it. Here is its complete course code:

type
  TMyColorProperty = class (TColorProperty)
  public
    procedure Edit; override;
  end;

procedure Register;

implementation

var
  nEditor: Integer;

procedure TMyColorProperty.Edit;
begin
  try
    case nEditor of
      0: begin
        FormColor1 := TFormColor1.Create (Application);
        ...
      1: begin
        FormColor2 := TFormColor2.Create (Application);
        ...
      2: inherited Edit;
    end;
  finally
    nEditor := (nEditor + 1) mod 3;
  end;
end;

procedure Register;
begin
  RegisterPropertyEditor (TypeInfo(TColor),
    TComponent, '', TMyColorProperty);
end;

initialization
  nEditor := 0;
end.

Stupid Experts, pardon Wizards

Building components is easy. Building other Delphi tools requires some more work, but can still be fun. I've built two useless wizards (previously known as Experts, and now better know as Expert Wizards). First of all, how to you build an expert wizard? As for any other Delphi add-on tool you have an abstract class with a virtual interface (an interface with many abstract virtual methods) to override in your subclass. Here is my simple Expert Wizard.

The Blank Expert Wizard

First is something I use, although it is really a weird Expert Wizard: the Blank Expert Wizard. When you start a new project it is created with an empty form. The Blank Expert Wizard allows you to do the same, but also to create a project with no form. And it prompts for a directory immediately, instead of asking for one only when the files are saved to disk.

This is actually an excuse to see how an expert is built. First derive a new class, with a bunch of overridden methods (required since they are virtual abstract):

type
  TBlankExpert = class (TIExpert)
  public
    function GetStyle: TExpertStyle; override;
    function GetName: string; override;
    function GetComment: string; override;
    function GetGlyph: HBITMAP; override;
    function GetState: TExpertState; override;
    function GetIDString: string; override;
    function GetMenuText: string; override;
    procedure Execute; override;
  end;

Most of the methods have empty or default code. The only real code is in the Execute method:

  function TBlankExpert.GetStyle: TExpertStyle;
  begin
    Result := esStandard;
  end;

  function TBlankExpert.GetName: String;
  begin
    Result := 'Blank Expert'
  end;

  function TBlankExpert.GetComment: String;
  begin
    Result := '';  // no thanks
  end;

  function TBlankExpert.GetGlyph: HBITMAP;
  begin
    Result := 0;  // no thanks
  end;

  function TBlankExpert.GetState: TExpertState;
  begin
    Result := [esEnabled];
  end;

  function TBlankExpert.GetIDString: String;
  begin
    Result := 'MarcoCantu.BlankExpert'
  end;

  function TBlankExpert.GetMenuText: String;
  begin
    Result := '&Blank Expert...'
  end;

  procedure TBlankExpert.Execute;
  var
    DirName: string;
  begin
    if MessageDlg ('Are you sure you want to exit'#13 +
      'from the current project, saving it?',
      mtConfirmation, [mbYes, mbNo], 0) = mrYes then
    begin
      ToolServices.SaveProject;
      ToolServices.CloseProject;
      SelectDirectory (DirName,
        [sdAllowCreate, sdPerformCreate, sdPrompt], 0);
      ToolServices.OpenProject (DirName + '\Project1.dpr');
    end;
  end;

Windows 95 Fun

Needless to say the best fun in Delphi 2 is Windows 95 programming. There are so many funny and useless things you can do in Windows that it is difficult to find a starting point. Not having much space/time left, I've decided to focus on a couple of topics, which can be generally indicated as "breaking Windows" and "stumping the users".

Breaking Windows

How can you do this? Here is a list: create too many windows, create too many components, use too much memory, waste too many resources (such as pens), access nil pointers, use the new Delphi 2 long strings in wrong ways, produce a stack overflown by calling an endless recursive function. I demonstrate all these techniques in the WINCRASH program, which has a big problem, I might have to reboot the system to show you all of its features. (Attention: save your files before running it, because it can really crash the system!)

The code of this example is fairly simple: Just write several for loops in which you allocate resources forever. Here are two methods:

procedure TForm1.ButtonWindowsClick(Sender: TObject);
var
  NewForm: TForm;
  Hwnd: THandle;
  I: Integer;
begin
  NewForm := TForm.Create (Application);
  NewForm.Show;
  NewForm.Update;

  // create a number of windows...
  try
    for I := 1 to 1000000 do
    begin
      Hwnd := CreateWindow ('button', 'Button',
        ws_child or ws_border or bs_pushbutton,
        I mod (ClientWidth - 40),
        I mod (ClientHeight - 20),
        40, 20,
        Handle, 0, HInstance, nil);
      if Hwnd = 0 then
        raise Exception.Create ('Out of handles');
      if (I mod 20) = 0 then
        NewForm.Caption := 'Created: ' +
          IntToStr (I);
      Application.ProcessMessages;
    end;
  finally
    ButtonWindows.Caption := Format ('Created: %d', [I]);
    NewForm.Free;
  end;
end;

procedure TForm1.ButtonPensClick(Sender: TObject);
var
  H: THandle;
  I: Integer;
begin
  try
    for I := 1 to 1000000 do
    begin
      H := CreatePen (ps_solid, 1, RGB (0, 0, 0));
      if H = 0 then
        raise Exception.Create ('Out of handles');
      if (I mod 20) = 0 then
        ButtonPens.Caption := Format ('Created: %d', [I]);
      Application.ProcessMessages;
    end;
  finally
    ButtonPens.Caption := Format ('Created: %d', [I]);
  end;
end;

Stump the User

The second, and probably even best category of Windows fun programs is the "stump the user" groups. Beside the screen-virus most users won't probably be scared by, there are some nice techniques to stump users: transparent windows (a feature I consider a Windows bug), unreachable menu item, with too many sub-levels for the screen, and fake GPFaults and unrecoverable error messages.

This last trick is explored by the UAE example. You can show a simple UAE message box, build a full fledged dialog box, with the details sub window, and even make a close button which doesn't want to be pressed.

The fake error form has a details button that shows open the second part of the form. This is accomplished by adding components out of the surface of the form itself, as you can see in its textual description:

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 = 
      'The program has performed an illegal operation. If the problem p' +
      'ersist contact the software vendor.'
    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 // out of the form!
    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'#39's going on here?')
    TabOrder = 2
  end
end

When a user presses the details button the program simply update the size of the form:

procedure TForm2.Button2Click(Sender: TObject);
begin
  Height := 231;
end;

A second form, which inherits from the first one, has an extra trick, a moving close button:

procedure TForm3.Button1Click(Sender: TObject);
begin
  Button1.Left := Random (ClientWidth - Button1.Width);
  Button1.Top := Random (ClientHeight - Button1.Height);
end;

Finally, you can create a hole in a window by using the SetWindowRgn Win32 API function. This can really make users scream:

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 ('You should better buy a new monitor');
end;

Conclusion

As I mentioned fun Windows 95 programming is such a wide topic that there is no way to cover it in a presentation devoted to loosing time with Delphi. There are already so many other Delphi components you can write wasting your time, and other Experts we can add to the environment with no real benefit. Then there are do-nothing version control system and many other Delhi extensions available in the Open Tools API. So, do not worry: There are thousands of ways to have fun trying t write useless Delphi programs, components, and other tools. It might even happen that someone finds a use for something you have written. The result is that you might get some money out of it, having more time free to have fun.

Author

Marco Cantù is a freelance writer and consultant. He is the author of Mastering Delphi 3 (SYBEX), Delphi Developer's Guide, and a couple of C++ books. He is a frequent contributor to several programming magazines. He lives in Italy, and is the founder of Wintech Italia, a training and consulting company focused on Windows and Delphi. You can reach him on www.marcocantu.com.

www.marcocantu.com

Copyright 1997 Marco Cantù