| Delphi Clinic | C++Builder Gate | Training & Consultancy | Delphi Notes Weblog | Dr.Bob's Webshop |
 |
 |
 |
| Delphi Clinic | C++Builder Gate | Training & Consultancy | Delphi Notes Weblog | Dr.Bob's Webshop |
|
|
|
|
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!
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).