Delphi Clinic C++Builder Gate Training & Consultancy Delphi Notes Weblog Dr.Bob's Webshop
Dr.Bob's Delphi Notes Dr.Bob's Delphi Clinics
 A Resource Monitor for Delphi 1.x
See Also: Delphi Papers and Columns

Programming in Delphi is fun. It can also be dangerous, especially when it comes to freeing memory and resources. Although Delphi has a powerful mechanism of safeguarding the allocation and deallocation of memory and resources using a try-finally block, it's still up to the programming to do so. And in case you forget to deallocate a component, you'll lose memory and especially resources fast. How can we be sure our applications don't leak? We need a resource monitor, to watch things behind our back, and report the percentage of free resources to us. In this article, we'll design and implement a simple resource monitor that will be able to assist us in watching resource and memory leaks.

Free Resources
Windows itself can tell us how much resources are available (in percentages). The Windows 3.1 API function GetFreeSystemResources returns the percentage of free space for system resources. The declaration of the function is as follows:

  function GetFreeSystemResources(SysResource: Word): Word;
Where the SysResource parameter specifies the type of resource to be checked: GFSR_SYSTEMRESOURCES for the percentage of free space for system resources; GFSR_GDIRESOURCES for the percentage of free space for GDI resources (device-context handles, brushes, pens, regions, fonts, and bitmaps) or GFSR_USERRESOURCES for the percentage of free space for USER resources (window and menu handles).

Free Memory
In contrast to Windows Resources, we can ask Delphi how much memory is has available for our application. Like Turbo and Borland Pascal, this can be done using the MemAvail function from the system unit. Note that MemAvail does return the total amount of available memory, which is not necessary in one continuous block. If you need to know the biggest block of available memory, you should call MaxAvail instead.
Finally, it is important to know the amount of free memory below the 1Mbytes. This amount of free memory is needed for every executed Windows application, which explains why you can get the message "Insufficient memory to run application" on a 16Mb Pentium that says you have over 12Mb of memory and 60% of resources left.

Resource Monitor: Design
Now that we know what resource and memory information we'd like to display, let's talk about the form in which we would like to display this information. I've separated the information in two groups, as can be seen below. The first group, Memory, contains two labels, while the second group, Resources, contains three labels. The five labels will have captions that contain the actual values of MemAvail, BaseMem, Free System, User and GDI resources.

The source code for the form declaration is as follows:

 unit Monform;
 interface
 uses
   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
   Forms, Dialogs, ExtCtrls, StdCtrls;

 Type
   TFormResourceMonitor = class(TForm)
     GroupBoxMemory: TGroupBox;
     GroupBoxResources: TGroupBox;
     LabelMemAvail: TLabel;
     LabelBaseMem: TLabel;
     LabelFreeSystemResources: TLabel;
     LabelFreeUserResources: TLabel;
     LabelFreeGDIResources: TLabel;
     Timer1: TTimer;
     X: TLabel;
     procedure Timer1Timer(Sender: TObject);
   private
     { Private declarations }
   public
     { Public declarations }
   end;

 var
   FormResourceMonitor: TFormResourceMonitor;

Resource Monitor: Implementation
Of course, the resource and memory information needs to be updated frequently on the form. In order to ensure a constant and continues accurate display of this information, we also need a timer component (from the System page on the component palette). It's the timer's OnTimer event that will update the five labels for us (see procedure Timer1Timer in the following listing).

 implementation
 uses ToolHelp;
 {$R *.DFM}

   procedure TFormResourceMonitor.Timer1Timer(Sender: TObject);
   var Tmp: String;
       BaseMem: LongInt;
   begin
     { free memory }
     FmtStr(Tmp,'MemAvail: %d KBytes',[MemAvail div 1024]);
     LabelMemAvail.Caption := Tmp;
     FmtStr(Tmp,'Base Mem: %d KBytes (%d)',[GetBaseMem div 1024,GetBaseMem]);
     LabelBaseMem.Caption := Tmp;
     { free resources }
     FmtStr(Tmp,'Free System Resources: %d%%',
            [GetFreeSystemResources(gfsr_SystemResources)]);
     LabelFreeSystemResources.Caption := Tmp;
     FmtStr(Tmp,'Free User Resources: %d%%',
            [GetFreeSystemResources(gfsr_UserResources)]);
     LabelFreeUserResources.Caption := Tmp;
     FmtStr(Tmp,'Free GDI Resources: %d%%',
            [GetFreeSystemResources(gfsr_GDIResources)]);
     LabelFreeGDIResources.Caption := Tmp;
     { show that we're still alive and running... }
     if (X.Caption = 'x') then X.Caption := '+'
                          else X.Caption := 'x';
   end;
 end.
Note that the GetBaseMem function (not displayed here) is adapted from Matt Pietrek's "Below1mb.C" as it appeared in July 94 Microsoft Developer's Network CD.

Result
If we set the FormStyle property of the form to fsStayOnTop we ensure that this little application will be on top at all times; a nice feature when guarding and watching over resource allocations and deallocations.

If you look carefully to the screenshot of the Resource Monitor in action, you'll see a tiny '+' sign at the bottom right part of the form. If you run the application, this '+' sign will seem to change in a 'x' and back at every update of the form. I've included this to ensure (or proof) that the application is actually updating the resource and memory information. In the listing above you already saw the last two lines of procedure Timer1Timer that are responsible for this behaviour.

A Resource Monitor for Delphi -- more --
Actually, the title of this section should be "less" instead of more, as we'll see how we can modify and customise the ResMon application to something that uses a lot less screen estate...

Last time in DDJ...
The first part of this article was published in the August 1995 issue of Delphi Developer's Journal. As you've just read, we wrote a Resource Monitor for Delphi, a nice litttle application that shows the free system resources and available memory on a form that stays on top at all times. Right after writing the tool and that article, I gave the program to my friends and asked their comments after a while of real usage (my best friends are programmers, so I expected a lot of feedback). Well, I got what I asked for, and more...

Little Brother
Every one came back within a few minutes and asked for a smaller version: it just used up too much of their screen, even at 1024x768. So, the first thing I did was to try to get the form smaller, by removing the groupboxes and adding some static lines together. Compare the two figures below and you'll know what I mean.


Out of my way...
The new ResMon was small enough to be used by everyone without cluttering their screen, and everybody was happy. Almost, that is. One of the guys didn't like the initial position at the lower left bottom of the screen, and wanted ResMon to pop up at the lower tight bottom of the screen. So, I modified the FormCreate method to set the Left and Top properties to his new prefered values, based on the dimensions of the screen itself:

  procedure TFormResourceMonitor.FormCreate(Sender: TObject);
  begin
    Left := GetSystemMetrics(SM_CXFULLSCREEN) - Width;
    Top := GetSystemMetrics(SM_CYFULLSCREEN) + GetSystemMetrics(SM_CYCAPTION) - Height;
  end {FormCreate};
When a third one claimed he prefered the ResMon to start in the upper right corner of the screen, I decided to let them figure it out by themselves, and enable ResMon to save it's position at closedown in a RESMON.INI file, to be able re-read and use this position again at startup. Again, a tiny modification in FormCreate and FormDestroy:
  procedure TFormResourceMonitor.FormCreate(Sender: TObject);
  var INI: TIniFile;
  begin
    INI := TIniFile.Create(ChangeFileExt(ParamStr(0),'.INI'));
    Top := INI.ReadInteger('window','WindowOrg.Y',0);
    Left := INI.ReadInteger('window','WindowOrg.X',0);
    INI.Free
  end {FormCreate};

  procedure TFormResourceMonitor.FormDestroy(Sender: TObject);
  var INI: TIniFile;
  begin
    INI := TIniFile.Create(ChangeFileExt(ParamStr(0),'.INI'));
    INI.WriteInteger('window','WindowOrg.Y',Top);
    INI.WriteInteger('window','WindowOrg.X',Left);
    INI.Free
  end {FormDestroy};
You saw me using ParamStr(0) to get the base name of the application. This is a convinient and documented way to get the filename (there are other ways, but I prefer this one). Changing the extention of this file to .INI and we have an instant ini-filename next to our executable!
The third parameter to the INI.ReadInteger functions specify the default value if the inifile (or the specified section) does not exist yet. This yields a default position for ResMon at the upper left corner, but as soon as the user moves it to another position and closes the application, the inifile is updated, and this last position will be used for the next startup.

Don't lose your head!
While ResMon now was working out of everybody's way, it still seemed a bit in the way at some times. Can't you make it smaller again, like lose the title bar? they asked me. Well, I could try... One way to eliminate the title bar is to remove the SW_CAPTION style from the Style in the CreateParams procedure:

  procedure TFormResourceMonitor.CreateParams(var Params: TCreateParams);
  { if you remove the SW_CAPTION from the Style, you can elimiate the title bar }
  begin
    inherited CreateParams(Params);
    with Params do Style := Style AND NOT WS_CAPTION
  end {CreateParams};
However, this does not have the desired effect unless you have given the BorderStyle property the value bsNone. With a value of bsDialog or any other value, the caption just remains where it is. Furthermore, you will get the effct at run-time only, and not at design time (so at design time you still see the caption). Personally, I feel that if we use a BorderStyle of bsNone, the form looks a little lost, like the figure below, but you get used to it after a while:

I said move out of my way!
There's one little problem with a caption-less window... You can't seem to move it. In order to move a window, you have to click on the title bar or caption and drag it to another place. Optionally, you can click on the system menu entry Move and use the keyboard to move the window. The ResMon application from last figure does have neither title bar nor system menu, so there is no way to move it, or is there?

Actually, we can cheat by adding a message handler for the WM_NCHITEST message and return HTCAPTION instead of HTCLIENT. That way, Windows will think it's on the caption, when in fact it's on the client area. That way, we can move the window by just clicking anywhere in it and dragging it away. The declaration for the WM_NCHITEST message handler (inside the TFormResourceMonitor) is as follows:

  procedure WMNCHitText(var Msg: TWMNCHitTest); message WM_NCHITTEST;
The implementation is just as easy, just return HTCAPTION if Windows thinks it's HTCLIENT:
  procedure TFormResourceMonitor.WMNCHitText(var Msg: TWMNCHitTest);
  begin
    inherited;
    if Msg.Result = HTCLIENT then Msg.Result := HTCAPTION
  end {WMNCHitText};

The final touch
You may have noticed that the color of the ResMon window is yellow (or at least has changed compared to the previous two figures). The last wish I received was to let everyone give the ResMon window it's own personal favorite color. The value could be read and written in the ini-file again, but how to we change the color? The easiest way would be to respond to the OnClick event of a mous and popup a ColorDialog. Well, close but no cigar. This won't work. The OnClick event seems not to work at all anymore. What happened? We played with the WM_NCHITEST message, that's what happened! While we're letting Windows believe it's on the caption instead of the client area at all times, we cannot get an OnClick event (which is generated by a mouse click on, you guessed it, the client area). So, what can we do? The only solution I found was to respond to a Key event (the OnKeyPress event) and pop the ColorDialog up whenever a key was pressed. This actually involved more steps, as you must first activate the ResMon application by clicking somewhere on its client area, ehum, make that caption.

Source Code
The final source code for ResMon (version 2.0) is as follows:

 unit Monform;
 interface
 uses
   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
   Forms, Dialogs, ExtCtrls, StdCtrls, INIFiles;

 Type
   TFormResourceMonitor = class(TForm)
     Timer1: TTimer;
     Bevel1: TBevel;
     LabelMemAvail: TLabel;
     LabelFreeResources: TLabel;
     X: TLabel;
     ColorDialog1: TColorDialog;
     procedure Timer1Timer(Sender: TObject);
     procedure FormCreate(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
     procedure FormKeyPress(Sender: TObject; var Key: Char);
   private
     { Private declarations }
     procedure CreateParams(var Params: TCreateParams); override;
     procedure WMNCHitText(var Msg: TWMNCHitTest); message WM_NCHITTEST;
   public
     { Public declarations }
   end;

 var
   FormResourceMonitor: TFormResourceMonitor;

 implementation
 uses ToolHelp;
 {$R *.DFM}

 function GetBaseMem: LongInt;
 { Code for this routine adapted from Matt Pietrek's "Below1mb.c" Oct 93 Microsoft
   Systems Journal, as it appeared in July 94 Microsoft Developer's Network CD
 }
 var EndOfBlock,EndOfMem,Total: LongInt;
     GE: TGlobalEntry;
     RC: Bool;
 begin
   Result := 0;
   EndOfBlock := $7FFFFFFF;
   GE.dwSize := Sizeof(GE);
   RC := GlobalFirst(@GE, Global_All);
   with GE do
   begin
     while RC do
     begin
       dwAddress := dwAddress AND $7FFFFFFF;
       if dwAddress > $100000 then
       begin
         dwAddress := EndOfMem;
         hBlock := $FFFF;
         wType := GT_Sentinel
       end;
       if (wType <> gt_Free) AND (hBlock <> 0) AND
        (((hBlock AND 1) <> 0) OR (wcLock <> 0) OR (wcPageLock <> 0)) then
       begin
         if EndOfBlock < dwaddress then Inc(Result, dwAddress - EndOfBlock);
         if hBlock = $FFFF then Break;
         EndOfBlock := dwAddress + dwBlockSize
       end;
       EndOfMem := dwAddress + dwBlockSize;
       RC := GlobalNext(@GE, Global_All)
     end
   end
 end {GetBaseMem};

 procedure TFormResourceMonitor.Timer1Timer(Sender: TObject);
 var BaseMem: LongInt;
 begin
   { free memory }
   BaseMem := GetBaseMem;
   LabelMemAvail.Caption := Format('Mem: %d Kb (Base: %d)',[MemAvail div 1024,BaseMem]);
   { free resources }
   LabelFreeResources.Caption := Format('System: %d%%  User: %d%%  GDI: %d%%',
     [GetFreeSystemResources(gfsr_SystemResources),
      GetFreeSystemResources(gfsr_UserResources),
      GetFreeSystemResources(gfsr_GDIResources)]);
   { show that we're still alive and running... }
   if X.Caption = 'x' then X.Caption := '+'
                      else X.Caption := 'x'
 end;

 procedure TFormResourceMonitor.FormCreate(Sender: TObject);
 var INI: TIniFile;
 begin
   INI := TIniFile.Create(ChangeFileExt(ParamStr(0),'.INI'));
   Top := INI.ReadInteger('window','WindowOrg.Y',0);
   Left := INI.ReadInteger('window','WindowOrg.X',0);
   Color := INI.ReadInteger('window','Colour',clTeal);
   INI.Free
 end;

 procedure TFormResourceMonitor.FormDestroy(Sender: TObject);
 var INI: TIniFile;
 begin
   INI := TIniFile.Create(ChangeFileExt(ParamStr(0),'.INI'));
   INI.WriteInteger('window','WindowOrg.Y',Top);
   INI.WriteInteger('window','WindowOrg.X',Left);
   INI.WriteInteger('window','Colour',Color);
   INI.Free
 end;

 procedure TFormResourceMonitor.CreateParams(var Params: TCreateParams);
 { if you remove the SW_CAPTION from the Style, you can elimiate the title bar }
 begin
   inherited CreateParams(Params);
   with Params do Style := Style AND NOT WS_CAPTION
 end {CreateParams};

 procedure TFormResourceMonitor.WMNCHitText(var Msg: TWMNCHitTest);
 { Note that you won't be able to *move* the resulting window. However, if you
   add another message handler for the "WM_NCHITEST" message, you can make the
   window movable by "grabbing" anywhere in its client area... }
 begin
   inherited;
   if Msg.Result = HTCLIENT then Msg.Result := HTCAPTION
 end {WMNCHitText};

 procedure TFormResourceMonitor.FormKeyPress(Sender: TObject; var Key: Char);
 begin
   ColorDialog1.Color := Color { start with old color };
   if ColorDialog1.Execute then Color := ColorDialog1.Color
 end;

 end.

Form Layout
The form layout is as follows (note that you'll still see the title bar at design time, although it will disappear at run time):

 object FormResourceMonitor: TFormResourceMonitor
   Left = 221
   Top = 164
   Hint = 'Dr.Bob'#39's Resource Monitor  (Esc = colour)'
   BorderIcons = [biSystemMenu, biMinimize]
   BorderStyle = bsNone
   ClientHeight = 29
   ClientWidth = 206
   Color = clTeal
   Font.Color = clBlack
   Font.Height = -11
   Font.Name = 'MS Sans Serif'
   Font.Style = [fsBold]
   FormStyle = fsStayOnTop
   PixelsPerInch = 96
   ShowHint = True
   OnCreate = FormCreate
   OnDestroy = FormDestroy
   OnKeyPress = FormKeyPress
   TextHeight = 13
   object Bevel1: TBevel
     Left = 0
     Top = 0
     Width = 206
     Height = 29
     Align = alClient
     ParentShowHint = False
     ShowHint = False
     Style = bsRaised
   end
   object LabelMemAvail: TLabel
     Left = 2
     Top = 1
     Width = 86
     Height = 13
     Caption = 'LabelMemAvail'
     ParentShowHint = False
     ShowHint = False
   end
   object LabelFreeResources: TLabel
     Left = 2
     Top = 14
     Width = 117
     Height = 13
     Caption = 'LabelFreeResources'
     ParentShowHint = False
     ShowHint = False
   end
   object X: TLabel
     Left = 192
     Top = 1
     Width = 9
     Height = 13
     Caption = 'X'
     ParentShowHint = False
     ShowHint = False
   end
   object Timer1: TTimer
     OnTimer = Timer1Timer
     Left = 144
   end
   object ColorDialog1: TColorDialog
     Left = 120
   end
 end
If you have any more wishes for ResMon, don't hesitate to ask. As you've seen by now, with Delphi we're only limited by our imagination (and Windows itself).
You can download the executable version of RESMON (82,750 bytes) to see it work for yourself.


This webpage © 2000-2015 by Bob Swart (aka Dr.Bob - www.drbob42.com). All Rights Reserved.