Delphi3000 Articles

delphi3000.
com - Printing Articles Page 1
delphi3000.com Article
Custom statusbar to show hints without any coding

Undertitle: Slick method to show tooltips
URL: http://www.delphi3000.com/article.asp?ID=2946
Category: GUI
Uploader: Kevin Gallagher
Question: How do I show tooltips/hints for menu items and any visual control
Answer: There are several methods to show hints in a statusbar (or similar control), each of these methods
requires more then one line of code!
There are more important things to be spending your time on, drop the following code into a file and save
it as TheStatusbar.pas, now install it in the Delphi IDE menu
File->Components->Install Component
Once installed drop the statusbar onto a form, set the hint property of one or more controls (do some
menu items too for the test). Compile/run the project and while running place the mouse cursor over any
of the items which you set the hint property. You should see the hint in the statusbar.
Note: I have not tested this in D6 but be forewarned that "DsgnIntf" in the USES clause will most likely be
a problem, if so then remove it and all code that does the About dialog.
unit TheStatusBar;
{*****************************************************************}
{ Description }
{ Makes it easy to show hints for components and menu items in the}
{ statusbar. All the programmer needs to do is write the text for }
{ the desired item to show hints. You do not have to set ShowHints}
{ to True on a form unless you want ballon style hints also. }
{ }
{ Tested with D3 to D5 }
{=================================================================}
{ USE TSmartStatusBar AT YOUR OWN RISK. }
{ I AM NOT RESPONSIBLE FOR ANY HARM THIS COMPONENT MIGHT CAUSE!! }
{ }
{ Kevin S. Gallagher }
{ E-Mail : Gallaghe@teleport.com Home }
{ kevin.s.gallagher@state.or.us Work }
http://www.delphi3000.com/printarticle.asp?ArticleID=2946 08/11/2007 17:20:06

delphi3000.com - Printing Articles Page 2
{*****************************************************************}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, DsgnIntf;
type
TAbout = class(TPropertyEditor)
public
procedure Edit; override ;
function GetAttributes: TPropertyAttributes; override ;
function GetValue: string; override ;
end;
TSmartStatusBar = class(TStatusBar)
private
FSizeGrip: Boolean ;
FAbout: TAbout ;
FOldOnHint: TNotifyEvent ;
FSysOnHint: TNotifyEvent ;
FShowAppHint: boolean ;
procedure SetShowAppHint(b : boolean) ;
protected
procedure DispAppHint(Sender : TObject) ;
public
constructor Create(AOwner: TComponent); override ;
published
property About: TAbout read FAbout write FAbout ;
property ShowAppHint : boolean read FShowAppHint write SetShowAppHint default True ;
end;
procedure Register;
implementation
uses Commctrl ;
procedure TAbout.Edit ;
begin
Application.MessageBox('TSmartStatusBar component' + #13 +
'1998-2001 Kevin S. Gallagher - This component is freeware.',
'About TSmartStatusBar Component', MB_OK + MB_ICONINFORMATION) ;
end;
function TAbout.GetAttributes: TPropertyAttributes ;

begin

Result:= [paMultiSelect, paDialog, paReadOnly] ;

end ;
function TAbout.GetValue: string ;

begin
Result:= '(about)' ;
end ;
constructor TSmartStatusBar.Create(AOwner: TComponent) ;

begin
if not(AOwner is TForm) then
raise EInvalidOperation.Create('Can only drop me on a form') ;
inherited Create(AOwner) ;
SimplePanel := True ;
FSizeGrip := True ;
FShowAppHint := True ;
ShowAppHint := True ;
FSysOnHint := Application.OnHint ;
{ Allow controls to be placed onto this component }

ControlStyle := ControlStyle + [csAcceptsControls] ;
end ;
procedure TSmartStatusBar.SetShowAppHint(b : boolean) ;

begin
FShowAppHint := b ;
if not(csDesigning in ComponentState) then
begin
if b then
begin
FOldOnHint := Application.OnHint ;
Application.OnHint := DispAppHint ;
end else
Application.OnHint := FOldOnHint ;
end;
end;
procedure TSmartStatusBar.DispAppHint(Sender : TObject) ;

begin
if not(csDesigning in ComponentState) then
if FShowAppHint then
SimpleText := Application.Hint ;
if Assigned(FOldOnHint) then
FOldOnHint(Sender) ;
end;
procedure Register;

begin
RegisterComponents('Win32', [TSmartStatusBar]);
RegisterPropertyEditor(TypeInfo(TAbout), TSmartStatusBar, 'ABOUT', TAbout);
end;
end.
Make sure to read the comments below on "AutoHint"
Example code for working with a main form and a child form:
{ Here we stop the hints from being displayed in this the main form
and show them in the child form. }
procedure TForm1.cmdTestOneClick(Sender: TObject);
var
f:TfrmChild;
begin
SmartStatusBar1.ShowAppHint := False ;
f:= TfrmChild.Create(Self) ;
try
f.ShowModal ;
SmartStatusBar1.ShowAppHint := True ;
finally
f.release ;
end ;
end;
{ Here we stop the hints from being displayed in the child form and
show them in the main form. Please note that if the child form is
not disabled then both forms will show the same hint which would
be confusing to some users. }
procedure TForm1.cmdTestTwoClick(Sender: TObject);
var
f:TfrmChild;
begin
f:= TfrmChild.Create(Self) ;
try
f.SmartStatusBar1.ShowAppHint := False ;
f.ShowModal ;
finally
f.release ;
end ;
end;
Copyright 2000 delphi3000.com

Contact: delphi3000@bluestep.com'
Comments to this article

Write a new comment
statusbar's autohint
Antoine (Dec 27 2001 3:48PM)
with borland's standard statusbar, if you set the "autohint" property to true, it will display automatically
all the text following a "|" in the hint property of any component. Is it what you tried to implement ?
Respond
RE: statusbar's autohint

Kevin Gallagher (Dec 27 2001 6:41PM)
Yep, but older versions of Delphi didn't have this property. By creating this component w/o using
the underlying method used in more recent versions of Delphi a programmer can use D3 to D6 w/o
any problems. I tend to work with D3 and D5 thus no conflicts when moving between versions.
Also it is easier to alter the logic for showing hints in my component if you want to tweak the code.
For instance in my personal copy the hint is shown in Panel[1].
Cheers
Kevin
Respond
<%If Session("sSecurityLevel") >= 2 Then%> Delete this Comment!<%End If%>

Easy and Simple way Using ADO with any image in MS Access with EDBImage
Undertitle:
Category: Database-VCL
Uploader: mind programmer
Question: I got an error message “bitmap image is not valid”. I try several tips out there, but none of
them works. From several tips I found, this is my simple solution:
Answer: Why this happen? watch this blob file viewed in hex editor :
1 151C2F00020000000D000E0014002100 ../...........!.
2 FFFFFFFF4269746D617020496D616765 ....Bitmap Image
3 005061696E742E506963747572650001 .Paint.Picture..
4 05000002000000070000005042727573 ...........PBrus
5 6800000000000000000020540000424 D h......... T..BM
6 16540000000000007600000028000000 .T......v...(...
7 C0000000DF0000000100040000000000 ................
8 A0530000CE0E0000D80E000000000000 .S..............
MS Access stores some information (for JPEG or other type it also include the path of a linked
OLE) in object as part of the object's definition in the OLE object field. Because the definition
of OLE object storage is not documented (!? this is straight from MS) there is no way to
know what gets written before the actual image data.
Obviously line 2 says the data stream is a "Bitmap Image." I assume in Lines 4-5 that PBrush
("Paintbrush") is the program that should be used to open the file.
The first two bytes of BMP files normally are "BM" or 42 4D in hex, so that it appears that the
BMP file starts in line 5, at byte 14 above -- byte 78 within the file.
Download EDBImage in here (http://delphi.icm.edu.pl/)
EDBImage works like TDBImage except :

- It can manage .ico .bmp .wmf .emf .jpg .jpeg. Without a line of code !!!
- Can copy to clipboard .bmp .wmf .jpg .jpeg
- Event OnLoadCustomImage is fired when the image type is unknown, so you can load
"any" type of images (gif, tiff, png,....).
Because Bitmap is always start in byte 78 within the BLOB, you can use the
OnLoadCustomImage in this way:

procedure TForm1.EDBImage1LoadCustomImage(var B: TGraphic;

Stream: TStream);
begin
B := TBitmap.Create;
Stream.Seek(78, soFromBeginning);
B.LoadFromStream(Stream);
end;
---------------------------------------------------------------------------
JPEG start with FF D8. But not always be at the same position in the file. We’ll need to seek
to the 'FFD8' and read the image from there. You can use this function:
function JpegStartsInBlob (Stream : TStream):integer;

var
buffer : Word;
hx : string;
begin
Result := -1;
while (Result = -1) and (Stream.Position + 1 < Stream.Size) do
begin
Stream.ReadBuffer(buffer, 1);
hx:=IntToHex(buffer, 2);
if hx = 'FF' then
begin
Stream.ReadBuffer(buffer, 1);
hx:=IntToHex(buffer, 2);
if hx = 'D8' then
Result := Stream.Position - 2
else if hx = 'FF' then
Stream.Position := Stream.Position-1;
end; //if
end; //while
end;
procedure TForm1.EDBImage1LoadCustomImage(var B: TGraphic;

Stream: TStream);
begin
B := TJPEGImage.Create;
Stream.Seek(JpegStartsInBlob (Stream), soFromBeginning);
B.LoadFromStream(Stream);
end;
That is ALL.!!! - do not call B.Free. You can use any image, since you have the library that
support the image. For many graphic support you can use GraphicEx library from Mike
Lischke (www.soft-gems.net) . And use hex editor to see the header. e.g. :

42 4D : Bitmap
4D 4D : TIFF
47 49 : GIF
D7 CD : Metafile
FF D8 : JPEG
I try to create function that support JPEG and Bitmap, the JPEG is ok but its only support
Bitmap in 16 bit. So if anyone knows how to fix that or to optimize the code, please post
here.

Write a new comment
missed some references...

BTX (Sep 27 2005 12:50AM)
http://delphi.about.com/od/database/l/aa030601d.htm
Respond
missed some references?

BTX (Sep 27 2005 12:49AM)
http://delphi.about.com/od/database/l/aa030601d.htm
Respond

Iterators
Undertitle:
Category: OO-related
Uploader: Peter Friese
Question: How can I elegantly traverse a list?

Answer: Iterators provide an elegant way to iterate lists and other data structures. For those in
the know, Iterators are a Design Pattern (see [GAM95]). Design Patterns capture good
practices of designing software systems. I strongly recommend reading this book.
In order to demonstrate the iterator pattern, I designed the following classes:
TMyItem = class
private
FValue: boolean;
FName: string;
public
property Name: string read FName write FName;
property Value: boolean read FValue write FValue;
end;
TMyListIterator = class
private
FList: TMyList;
FIndex: integer;
protected
constructor Create(List: TMyList);
public
procedure First;
procedure Next;
function IsDone: boolean;
function CurrentItem: TMyItem;
end;
TMyList = class
private
FList: TList;
function GetItem(Index: integer): TMyItem;
procedure SetItem(Index: integer; const Value: TMyItem);
function GetCount: integer;
public
constructor Create;
destructor Destroy; override;
procedure Add(Item: TMyItem);
procedure Delete(const Index: integer);
procedure Clear;
procedure Iterator(var Iter: TMyListIterator);
property Count: integer read GetCount;
property Items[Index: integer]: TMyItem read GetItem write SetItem; default;
end;
As you can see, the TMyList class is a simple type-safe list wrapper that has the capability of
handing out an iterator to the client (the code which uses the list).
But how do we use the iterator? Letäs take a look at the way we normally would traverse
this list:
procedure OldFashioned;
var
i: integer;
item: TMyItem;
begin
for i := 0 to
item := FMyList[i];
Listbxo1.Items.Add(item.Name);
end;
end;
The problem with the above code is that we cannot see what is really happening. A for loop
can have many meanings, for example adding some numbers. But we cannot judge from the
mere existance of a for loop that the code traverses a list.
Enter iterator!
The same code fragment using an iterator looks like this:
procedure TheRightWay;
var
iter: TMyIterator;
item: TMyItem;
begin
FMyList.Iterator(Iter);
while not Iter.IsDone do begin

item := iter.CurrentItem;
Listbox1.Items.Add(item.Name);
Iter.Next;
end;
end;
We can judge from the presence of the iterator that this must be some code that traverses a
list or some other structure. Those of you who already have used the FindFirst/FindNext
functions will see the resemblance of this code fragment with the one used commonly to list
the contents of a directory.
In my opinion, iterators are much easier to use than for loops once you understand them.
One of their advantages is that you can write for example a reverse iterator that traverses
the list in reverse order. If you do so, you won't have to chaneg the client code, since all the
traversation logic is handled by the iterator.

Sample code:
///////////////////////////////
unit ListIterator;
///////////////////////////////
interface
uses Classes;
type
TMyItem = class;
TMyList = class;
TMyListIterator = class;
TMyItem = class
private
FValue: boolean;
FName: string;
public
property Name: string read FName write FName;
property Value: boolean read FValue write FValue;
end;
TMyListIterator = class
private
FList: TMyList;
FIndex: integer;
protected
constructor Create(List: TMyList);
public
procedure First;
procedure Next;
function IsDone: boolean;
function CurrentItem: TMyItem;
end;
TMyList = class
private
FList: TList;
function GetItem(Index: integer): TMyItem;
procedure SetItem(Index: integer; const Value: TMyItem);
function GetCount: integer;
public
constructor Create;
procedure Add(Item: TMyItem);
procedure Delete(const Index: integer);
procedure Clear;
procedure Iterator(var Iter: TMyListIterator);
property Count: integer read GetCount;
property Items[Index: integer]: TMyItem read GetItem write SetItem; default;
end;
implementation
{ TMyListIterator }
constructor TMyListIterator.Create(List: TMyList);

begin
inherited Create;
FList := List;
FIndex := 0;
end;
procedure TMyListIterator.First;
begin
FIndex := 0;
end;
procedure TMyListIterator.Next;
begin
inc(FIndex);
end;
function TMyListIterator.IsDone: boolean;

begin
Result := FIndex >= FList.Count;
end;
function TMyListIterator.CurrentItem: TMyItem;

begin
Result := nil;
if FIndex < FList.Count then
Result := FList[FIndex];
end;
{ TMyList }
constructor TMyList.Create;
begin
inherited Create;
FList := TList.Create;
end;
destructor TMyList.Destroy;
begin
FList.Free;
inherited;
end;
procedure TMyList.Add(Item: TMyItem);

begin
FList.Add(Item);
end;
procedure TMyList.Clear;
begin
FList.Clear;

end;
procedure TMyList.Delete(const Index: integer);

begin
FList.Delete(Index);
end;
function TMyList.GetCount: integer;

begin
Result := FList.Count;
end;
function TMyList.GetItem(Index: integer): TMyItem;

begin
Result := FList[Index];
end;
procedure TMyList.SetItem(Index: integer; const Value: TMyItem);

begin
if FList[Index] <> nil then
TMyItem(FList[Index]).Free;
FList[Index] := Value;
end;
procedure TMyList.Iterator(var Iter: TMyListIterator);

begin
Iter := TMyListIterator.Create(self);
end;
end.
///////////////////////////////
unit TestMain;
///////////////////////////////
interface
uses
Windows, Messages, SysUtils,
Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls,
ListIterator;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
ListBox1: TListBox;
procedure Button1Click(Sender: TObject);
private
FMyList: TMyList;
public
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);

var
item: TMyItem;
i: integer;
begin
if FMyList = nil then
FMyList := TMyList.Create;
for i := 0 to 10 do begin
item := TMyItem.Create;
item.Name := 'Test' + inttostr(i);
item.Value := true;
FMyList.Add(item);
end;
end;

var
iter: TMyListIterator;
item: TMyItem;
begin

Iter.Next;
end;
end;
end.
References:
[GAM95] Gamma, Erich; Helm, Richard; Johnson, Ralph; Vlissides, John: Design Patterns -
Elements of Reusable Object-Oriented Software. Reading, MA: Addison-Wesley, 1995

Write a new comment

Solve MemLeak with Interface

John Elrick (Jun 28 2000 3:41PM)
I see what he`s trying to do here, with MyList responsible for creation.
To keep this technique, change Iterator to a function returning type IIterator - also allows anything to be
passed through that implements IIterator.
The instance will be freed as soon as the variable goes out of scope.
Respond
Memory leak in example code

Lasse Vågsæther Karlsen (Mar 8 2000 9:39AM)
This code (and other parts of the example code) exhibits a memory leak because the Iter variable is not
destroyed before the variable goes out of scope.

var
iter: TMyListIterator;
item: TMyItem;
begin

Iter.Next;
end;
Respond

How to Build Aggregate/Composite Components in Delphi

Undertitle: from Mark Miller
Uploader: Herbert Poltnik
Question: These kind of great articles are somewhere on the web... and nobody knows where !!
Therefore i found that its good to post it here...
Copyright © 1996, 1997 Mark Miller

Eagle Software
Answer:
SuperComponents
How to Build Aggregate/Composite Components in Delphi™
Copyright © 1996, 1997 Mark Miller

Eagle Software
What are SuperComponents?
SuperComponents, also known as aggregate or compound components, are collections of existing

sub-components and their relationships combined into a single component. The collections are
typically arranged inside a container parent component that manages the visual layout of the sub-
components.
Advantages
SuperComponents take all of the advantages of normal components and build on them. Rapid
application development, object reuse, and user interface consistency are all benefits. Code
shrinkage is another. If you have two or more forms containing similar component relationships
(either inside an application or among several), that component relationship is tied to each form
with - you guessed it - code. That binding Object Pascal code is duplicated with each form the
component group lies on. By fusing the component collections into a single component, the code to
manage the sub-component relationships disappears from the user interface code. The code for each
form more truly represents its functionality; it's easier to read and maintain.
Another benefit achieved through the use of SuperComponents is multiple form inheritance. You
can take parts of different forms (SuperComponents) and group them together into a new form. This
leads to even faster prototyping and user interface design than normally experienced with Delphi.
SuperComponents can simplify the properties needed to control the collection. Instead of dealing
with properties and events for each component in the collection, the SuperComponent only exposes
the properties and events it needs, thereby reducing the design-time complexity of the component.

As mentioned earlier, SuperComponents can embody the rules of the relationship among the
subcomponents. This relationship might represent an algorithm or solution to a problem, or it might
support state changes not present in any of the individual parts. Algorithm parameters and/or hooks
to state changes can be easily exposed through new properties and events.
Finally, SuperComponents can be thought of as mini-apps. They are components themselves, and as
such, lend themselves to a well-defined segregation from the rest of the project they are contained
in. In team development environments, this means that developers most familiar with the problem
and solution (whatever they be) can design the SuperComponents so that less-experienced
developers can piece together the application with these building blocks.

Disadvantages
There are two disadvantages to making SuperComponents. First, visual SuperComponents require
an additional Windows handle. Second, there is a small amount of overhead in the container parent
component that holds all the sub-components.
Before We Start
It is useful to distinguish among the different roles developers and users take when dealing with
components. There are three that we are concerned with:
•Application Users (a k.a. "users") will use applications built with the components we make.
•Application Developers (a k.a. "developers") will build applications using our components.
•Component Writers (that's us!) will create components that will make is easier for developers to
build applications and easier for users to use. It's important to note that as a component writer,
you're designing for two customers.
Visual Containment
The steps to building a SuperComponent are roughly as follows:
1. Design the layout of your components inside a form in Delphi, placing all the components
inside a TPanel (or a descendant thereof).
2. Select and copy the panel and paste it into a text file.
3. Replace all instances of " = " with " := ", and add a semi-colon to the end of each line.
4. Convert all DFM "object" declaration lines to appropriate object constructor code, setting the
parent of all visual controls to the container panel.
5. Clean up any remaining code. Bitmaps will need to be placed in resource files.
6. Place this new pascal code inside a create constructor for your component. Within the
constructor , group object sections under the appropriate sub-component creator.
Let's use an example to illustrate these steps. We'll make an OK/Cancel/Help button combination.
Inside Delphi, the layout looks like this (Note: the TPanel's border is set to none):
Selecting, copying and pasting the above collection into a text file yields the following:
object Panel1: TPanel
Left = 114
Top = 10
Width = 75
Height = 95
BevelOuter = bvNone
TabOrder = 0
object OKButton: TButton
Left = 0
Top = 0
Width = 75
Height = 25
Caption = 'OK'
Default = True
ModalResult = 1
TabOrder = 0
end
object CancelButton: TButton
Left = 0
Top = 35
Width = 75
Height = 25
Cancel = True
Caption = 'Cancel'
ModalResult = 2
TabOrder = 1
end
object HelpButton: TButton
Left = 0
Top = 70
Width = 75
Height = 25
Caption = 'Help'

TabOrder = 2
end
end
This is the text representation of our SuperComponent group. Next, we need to convert this text to
something that looks a little more like Object Pascal:
object Panel1: TPanel
Left := 114;
Top := 10;
Width := 75;
Height := 95;
BevelOuter := bvNone;
TabOrder := 0;
object OKButton: TButton
Left := 0;
Top := 0;
Width := 75;
Height := 25;
Caption := 'OK';
Default := True;
ModalResult := 1;
TabOrder := 0;
end
object CancelButton: TButton
Left := 0;
Top := 35;
Width := 75;
Height := 25;
Cancel := True;

Caption := 'Cancel';
ModalResult := 2;
TabOrder := 1;
end
object HelpButton: TButton
Left := 0;
Top := 70;
Width := 75;
Height := 25;
Caption := 'Help';
TabOrder := 2;
end
end
Now we're getting closer to what we want. The next step is to transfer the panel initialization to the
component's constructor. We'll create the embedded controls here, too:
constructor TOkCancelHelp.Create(AOwner: TComponent);
{ Creates an object of type TOkCancelHelp, and initializes

properties. }
begin
inherited Create(AOwner);
Width := 75;
Height := 95;
BevelOuter := bvNone;
TabOrder := 0;
OKButton := TButton.Create(Self);
OKButton.Parent := Self;

CancelButton := TButton.Create(Self);
CancelButton.Parent := Self;
HelpButton := TButton.Create(Self);
HelpButton.Parent := Self;
end; { Create }
The three buttons, OKButton, CancelButton, and HelpButton need to be declared as fields of our
new component. Our component's declaration looks like this:
type
TOkCancelHelp = class(TPanel)
OKButton: TButton;
CancelButton: TButton;
HelpButton: TButton;
private
{ Private declarations }
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
published
{ Published properties and events }
end; { TOkCancelHelp }
Now let's take that converted DFM text and initialize the three buttons. Although you can do this
inside our component's constructor, some VCL sub-component initialization code depends on a
windows handle existing in its parent. At the time when our new SuperComponent is created (inside
the Create constructor), this handle does not yet exist. So we need to find a method we can override
in the TPanel that is called before the component is displayed and before its loaded method is
called, but after a windows handle is assigned to the TPanel. The CreateWindowHandle method is
the best place to do this. An override of this method, with the DFM initialization code inserted,
looks like this:

procedure TOkCancelHelp.CreateWindowHandle(const Params:

TCreateParams);
{ Calls inherited CreateWindowHandle and initializes

subcomponents. }
begin
inherited CreateWindowHandle(Params);
with OKButton do
begin
Left := 0;
Top := 0;
Width := 75;
Height := 25;
Caption := 'OK';
Default := True;
ModalResult := 1;
TabOrder := 0;
end; { OKButton }
with CancelButton do
begin
Left := 0;
Top := 35;
Width := 75;
Height := 25;
Cancel := True;
Caption := 'Cancel';
ModalResult := 2;
TabOrder := 1;
end; { CancelButton }

with HelpButton do
begin
Left := 0;
Top := 70;
Width := 75;
Height := 25;
Caption := 'Help';
TabOrder := 2;
end; { HelpButton }
end; { CreateWindowHandle }
And the component declaration now looks like this:
type
OKButton: TButton;
CancelButton: TButton;
HelpButton: TButton;
private
protected
{ Protected declarations }
procedure CreateWindowHandle(const Params: TCreateParams);

override;
public
constructor Create(AOwner: TComponent); override;
published

end; { TOkCancelHelp }
Finally, we need to add a register method so we can place our new component onto Delphi's
component palette:
procedure Register;
begin
RegisterComponents('CDK', [TOkCancelHelp]);
end; { Register }
Exposing Sub-Component Properties
Grouping components together to create new SuperComponents is a pretty neat trick. One
advantage is that it allows you to isolate many of the grouped components' properties from
application developers. In fact unless you explicitly state otherwise, all of the grouped components
properties will be hidden from developers!
So how do you expose a sub-component property? You need to create two transfer methods that
transfer the sub-component's properties to the outside world.
For example, in our TOkCancelHelp component, it might be useful to expose the caption property
so application writers can change it (e.g., for application development in a language other than
English). Our transfer methods look a lot like the standard property Get and Set methods we're
already familiar with. Here's the declaration for the OK button's caption property:
type
private
procedure SetCaption_OKButton(newValue: TCaption);

function GetCaption_OKButton: TCaption;
published
property Caption_OKButton: TCaption read GetCaption_OKButton

write SetCaption_OKButton;
end;
These transfer methods pass the property values to and from the subcomponents. Their
implementation looks like this:
function TOkCancelHelp.GetCaption_OKButton: TCaption;
{ Returns the Caption property from the OKButton subcomponent. }
begin
result := OKButton.Caption;
end; { GetCaption_OKButton }
procedure TOkCancelHelp.SetCaption_OKButton(newValue: boolean);
{ Sets the OKButton subcomponent's Caption property to

newValue. }
begin
OKButton.Caption := newValue;
end; { SetCaption_OKButton }
You may notice that there is no field variable for this property. All sub-component properties rely
on the sub-components themselves for storage. Also notice that unlike most Set methods, this one
doesn't check to see if the internal value is different from the passed-in newValue. We let the sub-
component handle this check if necessary.
Exposing Sub-Component Events

type
private
FOnClick_OKButton: TNotifyEvent;
procedure Click_OKButtonTransfer(Sender: TObject); {

TNotifyEvent }
published
property OnClick_OKButton: TNotifyEvent read

FOnClick_OKButton write FOnClick_OKButton;
end;
Here, Click_OKButtonTransfer acts as the event handler. Notice that its type, TNotifyEvent,
matches the expected type for the OnClick event (TNotifyEvent). The implementation for the
transfer method looks like this:
procedure TOkCancelHelp.Click_OKButtonTransfer(Sender: TObject);
{ Transfers the OKButton OnClick event to the outside world. }
begin

if assigned(FOnClick_OKButton) then
FOnClick_OKButton(Self); { Substitute Self for

subcomponent's Sender. }
end; { Click_OKButtonTransfer }
If you've triggered events before, you probably recognize this code. The if-clause checks to see if
the event is assigned (typically performed via the Object Inspector at design-time), and if so calls it,
passing a reference to itself (the SuperComponent) to the component user's event handler. So, the
sub-component's event is handled by our transfer method, which in turn passes the event to a
component user's event handler (that's right -- two event handlers for each event!). To hook up this
chain of events, all we do is dynamically assign the event transfer method to the sub-component's
event. We do this in the overridden CreateWindowHandle method:

TCreateParams);

subcomponents. }
begin
with OKButton do
begin
OnClick := Click_OKButtonTransfer;
end; { OKButton }

Hooking in to Sub-Component Events
Sometimes you want to respond to a sub-component event without exposing it. The steps involved
here are similar to those you'd follow to expose a sub-component event, except you don't declare
the event (and you don't need the corresponding event field variable).
type
private
procedure Click_CancelButtonHandler(Sender: TObject); {

TNotifyEvent }
published
end;
The handler looks like this:
procedure TOkCancelHelp.Click_CancelButtonHandler(Sender:
TObject);
{ Handles the CancelButton OnClick event. }

begin
{ Place your event-handling code here. }
end; { Click_CancelButtonHandler }
We glue it all together by dynamically assigning our handler to the sub-component event, just as we
do when we want to expose a sub-component event:

TCreateParams);

subcomponents. }
begin
with CancelButton do
begin
OnClick := Click_CancelButtonHandler;
end; { CancelButton }
Summary
SuperComponents promote consistency and reuse. They can embody commonly-used

configurations of controls, dramatically cutting development time and slashing code size. And the
techniques involved here are not difficult to master.

Recommended Reading
The following books were current at the time of this writing. Make sure you check for the most
recent edition.
Developing Custom Delphi Components
by Ray Konopka; edited by Jeff Duntemann
Coriolis Group Books
(800) 410-0192 or (602) 483-0192
http://www.coriolis.com
585 pages
ISBN 1-883577-47-0
This book is highly recommended if you need additional information on component building or
building business components. It is filled with useful information and excellent examples. The
explanations are clear and easy to understand. In addition, Ray Konopka’s
TRzBusinessComponent, included with the CDK, is presented and detailed in his book.
Secrets of Delphi 2 -- Exposing Undocumented Features of Delphi

by Ray Lischner
Waite Group Press
831 pages
ISBN 1-57169-026-3
This is an amazing book, packed with valuable information you can’t get anywhere else. Also
contains excellent coverage of property editors, component editors, and other advanced component-
building topics.
The Delphi Magazine

To subscribe in the US:
Phone: (802) 244-7820
Email: 70602.1215@compuserve.com
This magazine consistently contains excellent technical articles on Delphi-related subjects. Also
contains a monthly column by Bob Swart (a k.a. Dr. Bob) on component building in Delphi.
Design Patterns--Elements of Reusable Object-Oriented Software
by Erich Gamma, Richard Helm, Ralph Johnson, and John Vlissides
Foreword by Grady Booch
Addison-Wesley Publishing Company
395 pages
ISBN 0-201-63361-2
This book organizes and presents a catalog of proven object-oriented solutions for architecting
complex systems that you can apply to your own specific applications. These design constructs are
labeled, allowing your development team to share a common vocabulary. The CDK help file
references two of the design patterns in this book: the Proxy pattern and the Template Method
pattern. The examples are in C++, but the patterns apply to all programming languages.
Component Writer’s Guide
by Borland International, Inc.
(408) 431-1000
156 pages
The Component Writers Guide is a lean but important resource for learning about how to create
working components and to ensure that components you write are well-behaved parts of the Delphi
environment. The book guides you to writing components that fit in well with any Delphi
application.

Object Pascal, and Delphi for nearly 16 years.
He can be reached at markm@eagle-software.com, or via CompuServe at 76043,2422.

Write a new comment
Pattern
Max Kleiner (Dec 9 2002 2:24PM)
Next year a book will be published «Delphi Design Patterns», so a Super Component is like a Composite
Pattern ;)
Respond

delphi3000.com - Printing Articles Page 1 sur 9
How To Create A Round Robin Tournament Schedule

Undertitle:
Category: Algorithm
Uploader: Charles Doumar
Question: How do I create a balanced round robin tournament schedule which ensures that every team
plays every other team once with the minimum amount of idle time (a/k/a byes) and ensures
that teams have an equal number of home and away games.
Answer:
The creation of a balanced round robin schedule is more complex than it first appears. There
are several delphi round-robin components that are available on the web ... for example the one
from engerning objects international at http://www.engineeringobjects.com/RndRobin.htm which
costs $495.00. I wrote this algorithm to quickly and cheaply calculate a round robin
schedule. Currently, the program has a hard-coded maximum number of 500 teams; however,
this can easily be increased. If you have no need for such an algorithm then so be it, but I hope
that anyone who needs to create such a schedule will give this algorithm a try. The
CreateRoundRobin procedure will easily create a schedule for you.
For example assume that there are 5 teams, a valid schedule would be.
Round 1
Home : 1 Away: 4
Home : 2 Away: 3
Home : 5 Away: -1
Round 2
Home : 5 Away: 3
Home : 1 Away: 2
Home : 4 Away: -1
Round 3
Home : 4 Away: 2
Home : 5 Away: 1
Home : 3 Away: -1
Round 4
Home : 3 Away: 1
Home : 4 Away: 5
Home : 2 Away: -1
Round 5
Home : 2 Away: 5
Home : 3 Away: 4
Home : 1 Away: -1
Most traditional round robin schedules look like the following, but there is no easy way to
calculate which team is the home team (or has the home field) and which team is away team (or
plays on the away field).
team
\ 1 2 3 4 5 6 7 8 9 10
round \............................................................
1: 10 9 8 7 6 5 4 3 2 1
2: 6 10 9 8 7 1 5 4 3 2
3: 2 1 10 9 8 7 6 5 4 3
4: 7 3 2 10 9 8 1 6 5 4
5: 3 4 1 2 10 9 8 7 6 5
6: 8 5 4 3 2 10 9 1 7 6
7: 4 6 5 1 3 2 10 9 8 7
8: 9 7 6 5 4 3 2 10 1 8
9: 5 8 7 6 1 4 3 2 10 9
Instead of creating a tratitional [N by N] array, I have created an [N by 1/2 N by 2] array to

keep track of the home and away aspects of the round robin tournament.
const
MaxTeams = 500;
MaxRounds = MaxTeams;
http://www.delphi3000.com/printarticle.asp?ArticleID=1790 12/11/2007
MaxGames = (MaxTeams+1) Div 2;

Home = 1;
Away = 2;
Bye : Integer = -1;
type
TGameAry = Array[1..MaxTeams] of Integer;
TRoundRobinAry = Array[1..MaxRounds,1..MaxGames,Home..Away] of Integer;
....
procedure TForm1.CreateRoundRobin(var RoundRobinAry: TRoundRobinAry;

const Teams: Integer);
var
GameAry : TGameAry;
Half,
Rounds,
Bottom,
SwitchBottom,
TempGameValue,
i,
ii,
iii : Integer;
begin
For i := 1 to MaxRounds do
For ii := 1 to MaxGames do
For iii := 1 to 2 do
RoundRobinAry[i][ii][iii] := 0;
IF ((Teams < 2) OR (Teams > MaxTeams)) Then exit;
//Initilize Team Array with Team Numbers
For i := 1 to Teams do
GameAry[i] := i;
if (Teams < MaxTeams)
then For i := (Teams+1) to MaxTeams do
GameAry[i] := 0;
Half := (Teams-1) Div 2;
IF ((Teams Mod 2)=0)
Then Begin
Rounds := Teams - 1;
Bottom := Teams - 2;
SwitchBottom := Bottom + 1;
End
else Begin
Rounds := Teams;
Bottom := Teams - 1;
SwitchBottom := Teams;
end;
for i := 1 to Rounds do
begin
for ii := 1 to Half do
begin
RoundRobinAry[i][ii][Home] := GameAry[ii];
RoundRobinAry[i][ii][Away] := GameAry[Bottom-ii+1];
end;
If ((Teams - Bottom) = 2) // if even number of teams
then begin
if i mod 2 = 0
then begin
RoundRobinAry[i][Half+1][Home] := GameAry[SwitchBottom];
RoundRobinAry[i][Half+1][Away] := GameAry[Bottom+2];
end
else begin
RoundRobinAry[i][Half+1][Away] := GameAry[SwitchBottom];
RoundRobinAry[i][Half+1][Home] := GameAry[Bottom+2];
end
end
else begin // if odd number of teams then idle team gets a bye
RoundRobinAry[i][Half+1][Home] := GameAry[SwitchBottom];
RoundRobinAry[i][Half+1][Away] := Bye;
end;
//rotate value of gameary
TempGameValue := GameAry[SwitchBottom];
for ii := SwitchBottom downto 2 do
GameAry[ii] := GameAry[ii-1];
GameAry[1] := TempGameValue;
end;
end;
You can easily print the result to a richedit with a push of a button.

const NoOfTeams : integer = 7;
var roundrobinary : TRoundRobinAry;
begin
RichEdit1.Clear;
CreateRoundRobin(RoundRobinAry,NoOfTeams);
PrintFullChart(RoundRobinAry); //see below
end;
Procedure Tform1.PrintFullChart(const RoundRobinAry: TRoundRobinAry;);

var i,ii : integer;
begin
richedit1.Lines.BeginUpdate;
i := 1;
ii := 1;
repeat;
Richedit1.Lines.Add(Format('Round : %d', [i]));
while (RoundRobinAry[i][ii][Home] <> 0) do
begin
if RoundRobinAry[i][ii][away] <> - 1 then
Richedit1.Lines.Add(Format('Home : %3.0d Away: %3.0d', [RoundRobinAry[i][ii]
[Home],RoundRobinAry[i][ii][Away]]))
else
Richedit1.Lines.Add(Format('BYE FOR TEAM : %3.0d', [RoundRobinAry[i][ii][Home]]));
inc(ii);
end;
inc(i);
ii := 1;
until (RoundRobinAry[i][ii][Home] = 0);
Richedit1.Lines.endupdate;
end;


Write a new comment
please help me..

byron noel llamas (Jul 3 2007 1:47PM)
can you please give me a double round-robin tournament sched. for the bbasketball with 6
teams..i need it now..ASAP...tnx...
Respond
Delete this Comment!
round robin
Jean Robbins (Jan 22 2007 5:25PM)
Can someone help me? I have 8 teams with only 3 courts. I need to make a schedule where
everyone plays everyone.
Thanks
Respond
RE: round robin

stan shoemaker (Oct 22 2007 11:09PM)
I have the exact same problem. Did you get an answer on a round robin on 3 courts with 8
teams? I hope you can help me.
Thanks,
Stan
Respond
round robin
sam (Jan 8 2005 4:51PM)
i need a 20 team round robin schedule

Respond
RE: round robin

Carlos (Jul 4 2005 7:38PM)
How would i set up a round robin pool tournament.

Respond
RE: RE: round robin

jack moore (Dec 4 2005 7:41PM)
I'm trying to set up a coed singles pool league at my club. I'm not sure of the number
of people yet but we will play 12 weeks. Is there a formula to set this up?
Thanks jack
Respond
RE: RE: round robin

anonymus (Dec 9 2005 4:58AM)
this is fucking gay... i like to make tournaments.. jesus christ get a life
Respond
RE: RE: RE: round robin

ehsan moeeni (Jun 26 2006 6:50AM)
#include "stdinc.h"
#include "list.h"
#include "dlist.h"
#include "partition.h"
#include "llheaps.h"
#include "wgraph.h"
wgraph *gp; partition *pp;
// Return true if the endpoints of e are in same tree.

bool delf(item e) {
return (*pp).find((*gp).left((e+1)/2)) == (*pp).find((*gp).right((e+1)/2));
}
void rrobin(wgraph& G, wgraph& T) {

// Find a minimum spanning tree of G using the round robin algorithm and
// return it in T. Actually finds a spanning forest, if no tree.
edge e; vertex u,v,cu,cv; weight w;
dlist q(G.n); list elist(2*G.m); lhNode *h = new lhNode[G.n+1];
partition P(G.n); llheaps L(2*G.m,delf);
gp = &G; pp = &P;
for (e = 1; e <= G.m; e++) {
L.setkey(2*e,G.w(e)); L.setkey(2*e-1,G.w(e));
}
for (u = 1; u <= G.n; u++) {
elist.clear();
for (e = G.first(u); e != Null; e = G.next(u,e)) {

elist &= 2*e - (u == G.left(e));
}
if (elist(1) != Null) {
h[u] = L.makeheap(elist); q &= u;
}
}
while (q(2) != Null) {
h[q(1)] = L.findmin(h[q(1)]);
if (h[q(1)] == Null) { q -= q(1); continue; }
e = (h[q(1)]+1)/2;
u = G.left(e); v = G.right(e); w = G.w(e);
cu = P.find(u); cv = P.find(v);
T.join(u,v,w); q -= cu; q -= cv;
h[P.link(cu,cv)] = L.lmeld(h[cu],h[cv]);
q &= P.find(u);
}
delete [] h;
}
Respond
RE: round robin

Ashley Schultz (Jul 6 2005 8:55PM)
I would like a schedule of 20 teams playing each other 1 time with no duplicates.
Respond
RE: round robin

tom (Feb 16 2006 4:59AM)
need a 12 team round robin pitch tournament, need example

Respond
tournament
Bill (Nov 9 2001 8:40PM)
i am attempting to divide a 24 team golf league in a schedule that has either tri or quad meets ...
everyone plays each other once in ONE round
help
Respond
RE: tournament
John Denaro (Jan 6 2007 3:43PM)
Excellent layout and easy to follow

Respond
Excellent Code
Dave (Feb 20 2001 2:15PM)
Excellent Code. Sure beats trying to think it up all myself.
I ported it to Visual Basic and it worked great except the home / away logic needed some
tweaking. The code as is, for example, will put team #1 in all homes games for the first half of the
rounds and all away games for the next half. To alternate the home and away games I propose
that you change this:
begin
end;
To this:
======
begin
IF ((i Mod 2)=0)
Then Begin
end
else Begin
RoundRobinAry[i][ii][Away] := GameAry[ii];
RoundRobinAry[i][ii][Home] := GameAry[Bottom-ii+1];
end;
end;
Dave Johnston
Respond
RE: Excellent Code

Charles Doumar (Feb 20 2001 4:42PM)
Dave,
While your modified code does have some merit, it does not "solve" the problem. If you
want to switch home and away aspects for all teams, I would use the following code…
*** Replace ***
for i := 1 to Rounds do
begin
*** With ***
For iv := 1 to Rounds do
Begin
If (iv <= (half+1))
Then i := iv * 2 – 1
Else i := (iv – (half+1)) * 2;
Best regards,
Charles
Respond
RE: Excellent Code

neil thomas (Jun 29 2002 5:05PM)
I have 5 teams playing in a pool tournament , I will like to know how to set up a round robin
tournament.
Respond
RE: RE: Excellent Code

daniel meure (Jul 17 2003 1:52PM)
How about a 'double' round robin. Where everybody plays each other twice(once home
and once away).
Is it possible to keep a maximum of 2 sequencial home or away matches ?
Respond
Great code
Chris Allsop (Jan 24 2001 6:37PM)
This code is superb. Its exactly what I was looking for, and as far as I am concerned, who cares
what category its supposed to be in or what hassles people have with it. I think its a great bit of
coding. Full credits to the author.
Respond
WINNT
Outlook (Feb 3 2005 3:56PM)
Respond
RE: Great code

ehsan moeeni (Jun 26 2006 6:46AM)
#include "stdinc.h"
#include "list.h"
#include "dlist.h"
#include "partition.h"
#include "llheaps.h"
#include "wgraph.h"
wgraph *gp; partition *pp;
// Return true if the endpoints of e are in same tree.

bool delf(item e) {
return (*pp).find((*gp).left((e+1)/2)) == (*pp).find((*gp).right((e+1)/2));
}
void rrobin(wgraph& G, wgraph& T) {

// Find a minimum spanning tree of G using the round robin algorithm and
// return it in T. Actually finds a spanning forest, if no tree.
edge e; vertex u,v,cu,cv; weight w;
dlist q(G.n); list elist(2*G.m); lhNode *h = new lhNode[G.n+1];
partition P(G.n); llheaps L(2*G.m,delf);
gp = &G; pp = &P;
for (e = 1; e <= G.m; e++) {
L.setkey(2*e,G.w(e)); L.setkey(2*e-1,G.w(e));
}
for (u = 1; u <= G.n; u++) {
elist.clear();
for (e = G.first(u); e != Null; e = G.next(u,e)) {
elist &= 2*e - (u == G.left(e));
}
if (elist(1) != Null) {
h[u] = L.makeheap(elist); q &= u;
}
}
while (q(2) != Null) {
h[q(1)] = L.findmin(h[q(1)]);
if (h[q(1)] == Null) { q -= q(1); continue; }
e = (h[q(1)]+1)/2;
u = G.left(e); v = G.right(e); w = G.w(e);
cu = P.find(u); cv = P.find(v);
T.join(u,v,w); q -= cu; q -= cv;
h[P.link(cu,cv)] = L.lmeld(h[cu],h[cv]);
q &= P.find(u);
}
delete [] h;
}
Respond
A Good One!!!
S S B Magesh Puvananthiran (Jan 24 2001 4:46PM)
It's really a good algorithm that can be implemented in any language... Good work!!!
Thanx.
Magesh.
Respond
Permutations
Mike Heydon (Jan 23 2001 1:59AM)
Nice example of resolving permutations and combinations. It is very valid under the Algorythm
section and it can be adapted for various functions.
Respond
There is more to Delphi than Database's and Custom components

Bruce (Jan 19 2001 10:00AM)
I for one loved this article. And to those critics out there delphi isn't just for databases.
Respond
Algorithm's are important!

skinny (Jan 17 2001 10:00AM)
There's an algorithm section under this site, which if you

noticed is what it's filed under. What's your problem?
Respond
RE: Algorithm's are important!

Aqab Bin Talal (Jan 17 2001 12:51PM)
well if Algorithm is going to be about "Round Robin Tournament Schedule" then I VOTE to
get rid of it....
Respond

Charles Doumar (Jan 17 2001 2:27PM)
Several delphi round-robin components are available on the web ... for example the
one from engerning objects international at
http://www.engineeringobjects.com/RndRobin.htm which costs $495.00. I wrote this
algorithm to quickly and cheaply calculate a round robin schedule. Currently, the
program has a hard-coded maximum number of 500 teams; however, this can easily
be increased. If you have no need for such an algorithm then so be it, but I hope that
any one who needs to create such a scheduel will give this algorithm a try.
Respond
RE: RE: Algorithm's are important!

anonymus (Jan 18 2001 7:53AM)
Nobody forces you to read it.

Feel free to ignore what you don't need, but don't annoy us with it.
I'm sure anyone who needs to write a schedule program in Delphi will be GLAD to have
an algorithm already done for them.

Respond
RE: RE: Algorithm's are important!

anonymus (Jan 18 2001 1:47PM)
Who cares about your vote.
Don't read it and shut up.

Respond

anonymus (Jan 18 2001 1:48PM)
In response to Aqab BinTalal (I can't reply to his message):
Who cares about your vote. Don't read it and shut up.
Respond
WHAT ??
Aqab Bin Talal (Jan 17 2001 8:08AM)
shouldn't this artical be on www.algorithms3000.com ?? what does Robin Tournament Schedule
(whatever that is) got to do with Delphi ??
Respond
Lighten up...
B Nice (Jan 17 2001 9:52PM)
Hey, lighten up a bit! We want to encourage people to donate whatever code they can to
make this site the best around. Stop flaming people just because YOU can't find a reason for
every little thing that's posted. Personally, I think this article could be of use in the right
situation. If it helps ONE person out there, it's worth having.
Respond
Don't like it? Don't read it!

Ali Bin Dopey (Jan 18 2001 3:56PM)
Dude... get a life and stop flaming those of us who are just trying to help. If you don't like
the article, DON'T READ IT! There's a lot of people who need all sorts of different things in
life (algorithms included!).
Respond
Implementation of the Memento Design Pattern

Undertitle:
Uploader: Jochen Fromm
Question: How do you implement the MEMENTO Design Pattern in Delphi ?

Answer: A Memento is an object that stores a snapshot of the
internal state of another object - the memento's originator,
according to Gamma, Helm, Johnson and Vlissides
("Design Patterns", Addision-Wesley, 1995)
In the following example the originator class is a class that

does some calculations named "tCalculator". The recall-class
must be a friend class of the originator class in order to
access the private variables that characterize the current state.
In delphi you can realize this if the two classes are defined
in the same unit.
A concrete implementation of the Memento design pattern looks

like this :
tCalculator = class
private
ValueA,ValueB,Interval : extended;
Strings : TStringList;
public
...
end;
tCalculatorRecall = class
private
RefObject : tCalculator;
public
constructor Create(Calculator : tCalculator);
end;
constructor tCalculatorRecall.Create(Calculator: tCalculator);

begin
inherited Create;
RefObject := Calculator;
ValueA := RefObject.ValueA;
ValueB := RefObject.ValueB;
Interval := RefObject.Interval;
Strings := TStringList.Create;
Strings.Assign(RefObject.Strings);
end;
destructor tCalculatorRecall.Destroy;
begin
RefObject.ValueA := ValueA;
RefObject.ValueB := ValueB;
RefObject.Interval := Interval;
RefObject.Strings.Assign(Strings);
Strings.Free;
inherited Destroy;
end;
The following lines demonstrate how to use this class :
// Store state of object

CalculatorRecall:=tCalculatorRecall.Create(Calculator);
// Change the state of object to do some calculations

Calculator.ValueA := ...
Calculator.DoSomething;
// Restore the original state

CalculatorRecall.Destroy;
Examples from the VCL for the Memento Design Pattern

are tFontRecall, tPenRecall and tBrushRecall, three
new available classes in Delphi 6 that are derived from TRecall.
Of course you can also define your own classes in this way.
If you do this, consider two important points :
* Derive the originator class from TPersistent

* Implement the Assign procedure
Then our example looks like this :
TCalculator = class(TPersistent)
private
...
public
...
procedure Assign(Source: TPersistent); override;
...
end;
TCalculatorRecall = class(TRecall)

public
constructor Create(ACalculator : TCalculator);
end;
procedure tCalculator.Assign(Source: TPersistent);

var RefObject : tCalculator;
begin
if Source is tCalculator then
begin
RefObject := Source as tCalculator;
ValueA := RefObject.ValueA;
ValueB := RefObject.ValueB;
Interval := RefObject.Interval;
...
Strings.Assign(RefObject.Strings);
...
end else
inherited Assign(Source);
end;
constructor TCalculatorRecall.Create(ACalculator: TCalculator);

begin
inherited Create(TCalculator.Create, ACalculator);
end;


Write a new comment

Implementation of the State Design Pattern

Undertitle:
Question: How do you implement the State Design Pattern in Delphi ?

Answer: Most programs provide toolbars with different tools. For
example Zoom-Buttons, Paint-Buttons (drawing of circles,
rectangles,.. ). When the Zoom-Button is pressed, the
user can zoom in or out, when the Paint-Button is pressed,
the user can paint s.th : each tool changes the behavior of
the program. You can realize this through different flags :
procedure TForm.FormMouseDown/FormMouseMove/FormMouseUp
begin
..
if fZoomFlag then
begin
...
end else
if fPaintFlag then
begin
...
end;
..
end;
Even if we want to create a simple program like MSPaint,

we will need a lot of flags :
fPenFlag, fDrawRectFlag, fDrawCircleFlag, fEraserFlag,...
This results in 'elephant'-procedures and a general view
becomes difficult.
You can avoid such 'elephant'-procedures through the state

design pattern. Gamma, Helm, Johnson and Vlissides
("Design Patterns", Addision-Wesley, 1995) define the
STATE design pattern in this way : it allows an object
to alter its behavior when its internal state changes.
The object will appear to change its class.
In our example, the behavior for each tool is encapsulated

in a different class :
tTool = class
private
fForm : tForm;
public
constructor Create(Form : TForm);
procedure SetCursor; virtual;

procedure HandleMouseDown(x,y : integer); virtual;
procedure HandleMouseMove(x,y : integer); virtual;
procedure HandleMouseUp(x,y : integer); virtual;
procedure StopAction; virtual;

end;
tZoomTool = class(tTool)
public
procedure SetCursor; override;
procedure HandleMouseDown(x,y : integer); override;
procedure HandleMouseMove(x,y : integer); override;
procedure HandleMouseUp(x,y : integer); override;
end;
tPaintTool = class(tTool)
public
procedure SetCursor; override;
procedure HandleMouseDown(x,y : integer); override;
procedure HandleMouseMove(x,y : integer); override;
procedure HandleMouseUp(x,y : integer); override;
end;
Now we can replace all the flags by a simple parameter

fTool of class tTool. Instead of setting different flags,
an object of a derived class is created :
procedure TForm.SetZoomModus;
begin
fTool.Destroy;
fTool := tZoomTool.Create(Self);
end;
procedure TForm.SetPaintModus;
begin
fTool.Destroy;
fTool := tPaintTool.Create(Self);
end;
So that in the MouseDown/MouseMove/MouseUp events the

appropriate method is called :
procedure TForm.FormMouseDown(... X, Y: Integer);

begin
fTool.HandleMouseDown(x,y);
end;

procedure TForm.FormMouseMove(... X, Y: Integer);

begin
fTool.HandleMouseMove(x,y);
end;
procedure TForm.FormMouseUp(... X, Y: Integer);

begin
fTool.HandleMouseUp(x,y);
end;


Write a new comment
What about the State of the Tool

Jacco Kulman (Apr 12 2002 8:03AM)
By destroying and recreating the tool you might loose important state of the tool. In my honest opinion it
would be better to have a two tool members Paint an Zoom created like this:
procedure TForm.FormCreate(Sender: TObject);

begin
fZoomTool := tZoomTool.Create(Self);
fPaintTool := tPaintTool.Create(Self);
end;
procedure TForm.SetZoomModus;
begin
fActiveTool := fZoomTool;
end;
procedure TForm.SetPaintModus;
begin
fActiveTool := fPaintTool;
end;
So that in the MouseDown/MouseMove/MouseUp events the

appropriate method is called :
procedure TForm.FormMouseDown(... X, Y: Integer);

begin
fActiveTool.HandleMouseDown(x,y);
end;
procedure TForm.FormMouseMove(... X, Y: Integer);

begin
fActiveTool.HandleMouseMove(x,y);
end;
procedure TForm.FormMouseUp(... X, Y: Integer);

begin
fActiveTool.HandleMouseUp(x,y);
end;
Regards Jacco
P.S: I think calling destroy is not the standard way to go. Always call Free (this will prevent exceptions
when freeing nil).
Respond

Incremental search in a DBGrid

Undertitle: Use a TEdit to make incremental search in a DBGrid
Uploader: Jorge Abel Ayala Marentes
Question: When you fill a DBGrid with Data from a Query you can search for each column of the Grid, with a TEdit.
Answer: Here is a sample project:
//
MWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMW/
/ Makes incremental search in a DBGrid with a TEdit
//
MWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMW
unit U_Main;
interface
uses
Db, DBTables, StdCtrls, Grids, DBGrids, ExtCtrls, DBCtrls;
type
TFm_Main = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
qry_Data: TQuery;
Ds_Data: TDataSource;
dbg_Data: TDBGrid;
Label1: TLabel;
Ed_Search: TEdit;
Database1: TDatabase;
qry_DataNUM_FACTURA: TStringField;
qry_DataF_FACTURA: TDateTimeField;
qry_DataM_DEVENGADO: TFloatField;
DBNavigator1: TDBNavigator;
procedure dbg_DataTitleClick(Column: TColumn);
procedure FormCreate(Sender: TObject);
procedure Ed_SearchChange(Sender: TObject);

private
FQueryStatement: string;
//Since for Alphanumeric Field you don´t need to validate nothing

//just keep a method pointer to the default Event Handler
FALphaNumericKeyPress: TKeyPressEvent;
public
property QueryStatement: string read FQueryStatement;
//Since we are going to search in various Fields wich DataType

//can be of diferent types, we must validate the user input on
//the OnkeyPress of the TEdit, but instead of building a super
//generic routine, lets make things simple. Build a separate
//method for each DataType you are interested in validate.
//I will only validate for Fields of type ftFloat, but you easily
//customize the code for your own needs..
//Method Pointer for Fields of DataType ftFloat

procedure FloatOnKeyPress(Sender: TObject; var Key: Char);
end;
var
Fm_Main: TFm_Main;
implementation
{$R *.DFM}
procedure TFm_Main.dbg_DataTitleClick(Column: TColumn);

var
vi_Counter: Integer;
vs_Field: String;
begin
with dbg_Data do
begin
//First, deselect all the Grid´s Columns
for vi_Counter:=0 to Columns.Count-1 do
Columns[vi_Counter].Color := clWindow;
//Next "Select" the column the user has Clicked on

Column.Color := clTeal;
//Get the FieldName of the Selected Column

vs_Field := Column.FieldName;
//Order the Grid´s Data by the Selected column

with qry_Data do
begin

DisableControls;
Close;
SQL.Clear;
SQL.Text := QueryStatement + 'ORDER BY '+ vs_Field;
Open;
EnableControls;
end;
//Get the DataType of the selected Field and change the Edit´s event
//OnKeyPress to the proper method Pointer
case Column.Field.DataType of
ftFloat: Ed_Search.OnKeyPress := FloatOnKeyPress;
else
Ed_Search.OnKeyPress := FALphaNumericKeyPress;
end;
end;
end;//End of TFm_Main.dbg_DataTitleClick
//
procedure TFm_Main.FloatOnKeyPress(Sender: TObject; var Key: Char);

begin
if not(Key in ['0'..'9', #13, #8, #10, #46]) then
Key := #0;
end;//End of TFm_Main.FloatOnKeyPress
//
procedure TFm_Main.FormCreate(Sender: TObject);

begin
//Keep a pointer for the default event Handler
FALphaNumericKeyPress := Ed_Search.OnKeyPress;
//Set the original Query SQL Statement

FQueryStatement := 'SELECT FIELD1, FIELD2, FIELD3 '
'FROM ANYTABLE ';
//Select the first Grid´s Column

dbg_DataTitleClick(dbg_Data.Columns[0]);
end;//End of TFm_Main.FormCreate
//
procedure TFm_Main.Ed_SearchChange(Sender: TObject);

var
vi_counter: Integer;
vs_Field: String;
begin

with dbg_Data do
begin
//First determine wich is the Selected Column
if Columns[vi_Counter].Color = clTeal then
begin
vs_Field := Columns[vi_Counter].FieldName;
Break;
end;
//Locate the Value in the Query

with qry_Data do
case Columns[vi_Counter].Field.DataType of
ftFloat: Locate(vs_Field, StrToFloat(Ed_Search.Text),
[loCaseInsensitive, loPartialKey]);
else
Locate(vs_Field, Ed_Search.Text,[loCaseInsensitive,
loPartialKey]);
end;
end;
end;//End of TFm_Main.Ed_SearchChange
//
end.
So, you can customize the code to manage another DataTypes of TFields.


Write a new comment
Check selected column

Jaromir Jindra (May 24 2002 4:45PM)
It's very danger to check color to find out selected column!!!!!!!!!
//First determine wich is the Selected Column

if Columns[vi_Counter].Color = clTeal then
Respond


Reducing Source Code Complexity in your application

Undertitle: Using a MessageCenter to link your application systems together
Uploader: William Egge
Question: Have you ever written an application where things have to know when things happen, such
as when an object gets freed then you need to update some UI screen or remove some
depency. Or in the case of a paint program where when a mode change requires a cursor
change, buttons to enable or disable or push down... if something gets deleted then you
have to do this and that etc... I have a solution that will keep your code clean of linking
code.
Answer: This uses Delphi's built in Messaging in TObject.
Whats in here:
Explaining on the concept.
Example implementation.
Source code of the MessageCenter is listed at the end.
Download full demo.
There are times when you write an application that turns into a linking nightmare when your
system needs to react to certain conditions. Examples are Mode changing in a paint program
requires cursor changes, an object being updated needs to update some UI element or
disable and enable controls, when an object gets freed you need to remove
dependencies. In other words there are side effects that you need to happen as a result of
something changing in your application. Coding these side effects can produce some nasty
code that is like a big spider web.
The solution to the problem is to use a "Message Center". I have created a easy to use
MessageCenter class that uses the built in messaging capablity already built into
TObject. Source code is at the end of this artical.
1. Concept of the message center

The concept is simple, you have a central "hub" that receives maybe all actions that happen
in your program. Certain parts of your program need to change when these events
happen. Instead of hard coding these "reactions" into your code, you send the message of
the event to the message center in a record structure. Anything that needs to react or
change based on the event is registered with and notified by the MessageCenter.
2. Example Implementation
This app is an image editor where you can have multiple images opened at once.
Each Image is opened in a Form class of TForm_ImageEdit.
A graphical list of buttons are listed at the top of the main form, there is one button per
opened image and a picture of the image is drawn on the surface of the button. Users can
click the button and active the form for that image.
The rule of the system is

A button should be added when a new form is added.
The button should remove when the form is removed.
The button should push down when the editor form becomes active.
First define the MessageID and the record for the message.
const
MID_ImageEdit = 14936;
type
TMID_ImageEdit = packed record
MessageID: Cardinal; // This is required field for Dispatching
Action: (aDestroyed, aActivated);
ImageEdit: TForm_ImageEdit;
end;
Then within the TForm_ImageEdit Broadcast the messages...
procedure TForm_ImageEdit.FormDestroy(Sender: TObject);

var
M: TMID_ImageEdit;
begin
with M do
begin
M.MessageID:= MID_ImageEdit;
M.Action:= aClosed;
M.ImageEdit:= Self;
end;
GetMessageCenter.BroadcastMessage(Self, M);
end;
procedure TForm_ImageEdit.FormActivate(Sender: TObject);

var
M: TMID_ImageEdit;
begin
with M do
begin
M.MessageID:= MID_ImageEdit;
M.Action:= aActivated;
M.ImageEdit:= Self;
end;
GetMessageCenter.BroadcastMessage(Self, M);
end;
Now to edit the main form
At some point in your main form when you create the Image Editor, add this code
after creation:
F:= TForm_ImageEdit.Create(Self);
// Listen to messages
GetMessageCenter.AttachListner(Self, F);
// Next few lines will add the button for the new form at the top of the main window.

.
.
.
This way the Main form will receive messages from the ImageEditor window.
So now Add this MessageHandler to your main form:

Create this method to receive messages of type MID_IMageEdit:
procedure ImageEditorWindowChanged(var Msg: TMID_ImageEdit); message

MID_ImageEdit;
And implement it in this way
procedure TForm_NMLDA.ImageEditorWindowChanged(var Msg: TMID_ImageEdit);

begin
case Msg.Action of
aDestroyed:
begin
ImageEditorClosed(Msg.ImageEdit);
GetMessageCenter.DetachListner(Self, Msg.ImageEdit);
end;
aActivated: EditorFocused(Msg.ImageEdit);
end;
end;
ImageEditorClosed method will remove the button from the main form
EditorFocused will push down the button associated with the ImageEditor.
-------------------------
Thats all, you have low coupling and you may attach as many listners as you like.
This concept has a lot of potential and it will make your complex apps very simple and
maintainable.
Here is the code:
=================================
unit MessageCenter;
{
William Egge public@eggcentric.com
Created Feb - 28, 2002
You can modify this code however you wish and use it in commercial apps. But
it would be cool if you told me if you decided to use this code in an app.
The goal is to provide an easy way to handle notifications between objects

in your system without messy coding. The goal was to keep coding to a minimum
to accomplish this. That is why I chose to use Delphi's built in
Message dispatching.
This unit/class is intended to be a central spot for messages to get dispatched,
every object in the system can use the global GetMessageCenter function.
You may also create your own isolated MessageCenter by creating your own
instance of TMessageCenter.. for example if you had a large subsystem and
you feel it would be more effecient to have its own message center.
The goal is to capture messages from certain "Source" objects.
Doc:
procedure BroadcastMessage(MessageSource: TObject; var Message);
The message "Message" will be sent to all objects who called AttachListner
for the MessageSource.
If no objects have ever called AttachListner then nothing will happen and
the code will not blow up :-). Notice that there is no registration for
a MessageSource, this is because the MessageSource registration happens
automatically when a listner registers itself for a sender.
(keeping external code simpler)
procedure AttachListner(Listner, MessageSource: TObject);

This simply tells the MessageCenter that you want to receive messages from
MessageSource.
procedure DetachListner(Listner, MessageSource: TObject);

This removes the Listner so it does not receive messages from MessageSource.
Technique for usage with interfaces:

If your program is interface based then its not possible to pass a
MessageSource but it IS possible to pass an object listner if it is being
done from within the object wanting to "listen" (using "self").
To solve the problem of not being able to pass a MessageSource, you can
add 2 methods to your Sender interface definition,
AttachListner(Listner: TObject) and DetachListner(Listner: TObject).
Internally within those methods your interfaced object can call the
MessageCenter and pass its object pointer "Self".
Info:
Performance and speed were #1 so...
MessageSources are sorted and are searched using a binary search so that
a higher number of MessageSources should not really effect runtime performance.
The only performance penalty for this is on adding a new MessageSource because
it has to do an insert rather than an add, this causes all memory to be shifted
to make room for the new element. The benifit is fast message dispatching.
There is no check for duplicate MesssageListners per Sender, this would have
slowed things down and this coding is usefull only when you have bugs. And
hoping you prevent bugs, you do not have to pay for this penalty when your
code has no bugs.
}
interface
uses
Classes, SysUtils;
type
TMessageCenter = class
private
FSenders: TList;
FBroadcastBuffers: TList;

function FindSenderList(Sender: TObject; var Index: Integer): TList;

public
constructor Create;
procedure BroadcastMessage(MessageSource: TObject; var Message);
procedure AttachListner(Listner, MessageSource: TObject);
procedure DetachListner(Listner, MessageSource: TObject);
end;
// Shared for the entire application

function GetMessageCenter: TMessageCenter;
implementation
var
GMessageCenter: TMessageCenter;
ShuttingDown: Boolean = False;
function GetMessageCenter: TMessageCenter;

begin
if GMessageCenter = nil then
begin
if ShuttingDown then
raise Exception.Create('Shutting down, do not call GetMessageCenter during
shutdown.');
GMessageCenter:= TMessageCenter.Create;
end;
Result:= GMessageCenter;
end;
{ TMessageCenter }
procedure TMessageCenter.AttachListner(Listner, MessageSource: TObject);

var
L: TList;
Index: Integer;
begin
L:= FindSenderList(MessageSource, Index);
if L = nil then
begin
L:= TList.Create;
L.Add(MessageSource);
L.Add(Listner);
FSenders.Insert(Index, L);
end
else
L.Add(Listner);
end;
procedure TMessageCenter.BroadcastMessage(MessageSource: TObject; var Message);

var
L, Buffer: TList;
I: Integer;
Index: Integer;
Obj: TObject;
begin
if L <> nil then
begin
// Use a buffer because objects may detach or add during the broadcast
// Broadcast can be recursive. Only broadcast to objects that existed
// before the broadcast and not new added ones. But do not broadcast to
// objects that are deleted during a broadcast.
Buffer:= TList.Create;
try
FBroadcastBuffers.Add(Buffer);
try
for I:= 0 to L.Count-1 do
Buffer.Add(L[I]);
// skip 1st element because it is the MessageSender

for I:= 1 to Buffer.Count-1 do
begin
Obj:= Buffer[I];
// Check for nil because items in the buffer are set to nil when they are removed
if Obj <> nil then
Obj.Dispatch(Message);
end;
finally
FBroadcastBuffers.Delete(FBroadcastBuffers.Count-1);
end;
finally
Buffer.Free;
end;
end;
end;
constructor TMessageCenter.Create;
begin
inherited;
FSenders:= TList.Create;
FBroadcastBuffers:= TList.Create;
end;
destructor TMessageCenter.Destroy;
var
I: Integer;
begin
for I:= 0 to FSenders.Count-1 do
TList(FSenders[I]).Free;
FSenders.Free;
FBroadcastBuffers.Free;
inherited;
end;
procedure TMessageCenter.DetachListner(Listner, MessageSource: TObject);

var
L: TList;
I, J: Integer;

Index: Integer;
begin
if L <> nil then
begin
for I:= L.Count-1 downto 1 do
if L[I] = Listner then
L.Delete(I);
if L.Count = 1 then
begin
FSenders.Remove(L);
L.Free;
end;
// Remove from Broadcast buffers

for I:= 0 to FBroadcastBuffers.Count-1 do
begin
L:= FBroadcastBuffers[I];
if L[0] = MessageSource then
for J:= 1 to L.Count-1 do
if L[J] = Listner then
L[J]:= nil;
end;
end;
end;
function TMessageCenter.FindSenderList(Sender: TObject;

var Index: Integer): TList;
function ComparePointers(P1, P2: Pointer): Integer;
begin
if LongWord(P1) < LongWord(P2) then
Result:= -1
else if LongWord(P1) > LongWord(P2) then
Result:= 1
else
Result:= 0;
end;
var
L, H, I, C: Integer;
begin
Result:= nil;
L:= 0;
H:= FSenders.Count - 1;
while L <= H do
begin
I:= (L + H) shr 1;
C:= ComparePointers(TList(FSenders[I])[0], Sender);
if C < 0 then
L:= I + 1
else
begin
H:= I - 1;
if C = 0 then
begin
Result:= FSenders[I];
L:= I;
end;
end;
end;
Index := L;
end;
initialization
finalization
ShuttingDown:= True;
FreeAndNil(GMessageCenter);
end.

Write a new comment
good idea
Jorge Abel Ayala Marentes (Mar 4 2002 9:00PM)
you could also use the Observer pattern
Respond
RE: good idea

William Egge (Mar 7 2002 2:04AM)
Actually this is an implementation of an observer pattern except that it uses Delphi's built in
message dispatching and also maintains the relationships. This means your objects can be free of
maintaining observers and free of looping through them. Also any object can be "observed" without
altering or needing them to decend from some base class.
Respond
Is it possible to get a Demo

Akhila J (Mar 4 2002 4:29PM)
Is it possible to get a demo program to use the above mentioned
code. It will be very easy to follow.
Thanks and Best Regards

Jayan Chandrasekhar
Respond
RE: Is it possible to get a Demo

William Egge (Mar 5 2002 7:02PM)
Yes, I would be happy to make one. What features would you like it to have. Are there any problems
you would want me to approach and solve?
Respond
RE: RE: Is it possible to get a Demo

Jayan Chandrasekhar (Mar 5 2002 8:52PM)
Hi William,
I would like to have the demo on how to use MessageCenter in our applications. A simple
demo ( preferably non-database )
which shows all the features, methods and use of Message center will be be good enough.
Best Regards,
Jayan Chandrasekhar
Respond
RE: RE: RE: Is it possible to get a Demo

William Egge (Mar 7 2002 1:59AM)
I created a demo that shows all features. You can download it from the component link. If
you have further questions, I can change the demo to include more examples of usage.
Respond
why not...
EberSys (Mar 3 2002 7:30PM)
mmm... why not simply use Delphi TActionList, that's a very efficient way of keeping code centralized
and has some other cool features (as enabling/disabling the control that they're associated to, assign the
bitmap image to the associated control(s), etc)
I've noticed that many delphi programmers don't use this component, and is actually one that really helps
to organize all the source code
salu2
EberSys
Respond
RE: why not...

Sean Dockery (Mar 15 2002 7:31PM)
The problem with using TActionList is that you have to take everything underneath TActionList with
it. Sometimes that isn't practical for systems which require a messaging with a small footprint.
For example, if you have business objects which use TActionList instead of the TMessageCenter
component, you suddenly have to worry about linking or deploying half of the VCL with your code.
Respond

Returning Objects from Functions- my thoughts

Undertitle: Is returning an object from a function a bad idea?
Uploader: david bolton
Question: Should you avoid using functions that create and return objects as there is no direct
'ownership' of the object?
Answer: Freeing Result Objects from functions
This was requested in the requested articles section by Jeff.C.
This represents my own opinion as a full time Delphi developer (four years experience) with a
couple of years of C++ experience. My first reaction was that returning an Object (like a
stringlist) from a function was a bad thing because it introduces an object that is potentially
unowned and may not get freed. In managing objects you must always consider who owns
the object and is responsible for freeing it up. How you create them and use them is less
important than ensuring they are freed up.
And considering that all objects are created by calling a Constructor function, you can see
that returning objects from a function that creates them is acceptable, so long as you
maintain a reference to the object to let it be freed up after use.
You might consider developing an object management framework where every objects is
created indirectly through calls to the framework and the framework tracks each object as it
is created, manages explicit deletions (your code tells the framework that it no longer needs
the object) and deletes any undeleted objects when the framework is destroyed. This
approach can be a little inflexible though.
Creating & Freeing a lot of objects repeatedly can cause other problems (see my earlier
article http://www.delphi3000.com/article.asp?ID=1414) so you need to be well equipped to
detect memory leak bugs. If you are lucky they will cause an access violation when the
application terminates. If they don’t show up now then they will show up at some time in the
future, usually at the worst possible time. I recommend Snoop an excellent free utility for
trapping memory errors- you can find it at http://www.rmarsh.com/snoop.html
An Example of Good and Bad use

If you drop a list box and two buttons on a form and connect the two buttons to these event
handlers and add the makelist function you can see a leak in action with snoop.
function makelist:tstringlist;
begin
result := tstringlist.create;
result.add('Address 1');
result.add('Address 2');
end;

var list : tstringlist;
begin
list := makelist;
listbox1.items.Assign(list);
list.free;
end;

begin
listbox1.items.Assign(makelist);
end;
Button1 is the correct way- the list is owned by the list variable, and listbox1 manages its
own copy. Button2 is naughty – the list is unowned by anyone so the stringlist still exists
when the application terminates. Running Snoop on these two confirms that Button1 works
fine and button 2 leaves the list (and its strings) hanging around.
So remember - avoid untracked objects!


Write a new comment
Possible Solution
Stephen Deetz (Mar 22 2003 5:40AM)
There are several different ways to solve this problem.
This is the one our company has adopted and it has worked well.
A function with the potential to create an object uses the keyword Create somewhere in the name of that
function.
Something Like: CreateStringlistAndDoWhatever
Along with that, we allow object of a similar type to be passed in and used. Only if nil is passed as an arg
to the function will an object be created.
CreateStringlistAndDoWhatever( nil, ... ---Creates an Object
Otherwise:
CreateStringlistAndDoWhatever( SomeStringList, ... ----Uses SomeStringlist and Doesn't Create an Object
Respond

Functions returning objects

Paul Lowman (Oct 4 2000 4:13PM)
I have mulled over this one for years and still not sure - Is it better to use the old OO Pascal 'Object'
rather than 'Class' in some cases as the old Object can be statically instantiated and therefore if returned
by a function is no different from any other variable return. This means that when the caller method /
procedure exits the returned object is disposed of when the stack frame is cleared up. The only downside
I can think of using Objects is that they don't seem to be flavour of the month in Delphi.
Respond
RE: Functions returning objects

david bolton (Oct 5 2000 2:47AM)
I'm not sure if the old Pascal objects will be around for ever. Compared to Object classes - they
suffer from at least one major disadvantage- not descending from Tobject but I can see the
attraction.
Respond
VCL way
Peter Morris (Oct 1 2000 4:01AM)
If you look at the VCL Inprise always do the following
procedure TMyClass.GetItems(List: TStrings); //Not TStringList

begin
List.Add('Hello');
end;

var
Words: TStringList;
begin
Words := TStringList.Create;
try
MyObjOfMyClass.GetItems(Words);
finally
Words.Free;
end;
end;
----
DIB components made open-source
http://www.stuckindoors.com/dib
Respond
Coding guidelines
Todd Lang (Sep 29 2000 9:14AM)
At our company, we simply avoided this issue by adopting guidelines for memory management. This
comes from our transition from C, and these have served us well. Here's a brief comment on how we
view memory ownership.
If a routine to be called requires a buffer (or an object in this case) the routine being called should be
supplied with the buffer. The reasoning goes along the lines that the caller knows more about how the
application functions than the callee. If the callee were responsible for the memory management, then
they would also the need the ability to signal an error condition and a reason for that error condition. (i.e.
- Could not allocate the memory due to insufficient memory.)
So, instead of having:

function GetStringList : TStringList
We use
procedure GetStringList( StringList : TStringList );
begin
StringList.Add( ...
StringList.Add( ...
end;
And the caller would look something like:
procedure Foo;
var
SL : TStringList;
begin
SL := TStringList.Create;
GetStringList( SL )
DoSomethingWithSL( SL );
SL.Free;
end;
This way all of the control is in the caller, who quite probably knows how to handle errors in a more
graceful way.
This is our company guideline and we count on this behaviour in all routines.
Respond
RE: Coding guidelines

Henry Mueller (Oct 27 2000 8:01PM)
To make this even more clear, use the keywords 'out', or 'const' on your object parameters. It can
be confusing when looking at a prototype for a method that takes an object parameter. Do you
create the object before passing it in, or will the method create it internally?
For example, in your example you would use 'const' to communicate that you are expecting a
created object to be passed in. A const parameter can not be "created" inside a method as it would
change the address of that pointer (the compiler will not let you even try it). Since most
programmers understand this they would realize that they need to pass in a "created" object to you
method, since you have promised that you will not be creating it yourself.
like this: TMyObject.AddStrings(const AStringList: TStrings);

On the flip side, if you want a caller to just pass in "place" to put an object that will be created
inside the method, use 'out'. Out is a newer reserved word you may see in COM programming that
works great for non-COM programming too. It means that whatever the value of the parameter is
when passed in irrelevant (and inaccessible I believe), the method is merely using the parameter to
pass out some results. A 'var' parameter on the other hand could be used but the value passed in
could be significant and is accessible.
Of course you could also pass out the object as a function result, as the original article
suggests. But when you can't or choose not to, I suggest using 'const' or 'out' to be imminently
clear what you are planning to do with the parameter.
Respond
Reference counted objects

Jérôme Tremblay (Sep 28 2000 8:51AM)
IAddressList = Interface
['{F03D475F-A4AF-4E71-B489-9C1CDA2D56F1}']
function GetAddress(Index: integer): string;
property Address[Index: integer]: string read GetAddress;
end;
TAddressList = class(TInterfacedObject, IAddressList)

public
function GetAddress(Index: integer): string;
property Address[Index: integer]: string read GetAddress;
end;
function AddressList: IAddressList;

begin
Result := TAddressList.Create;
end;
IAddressList is an interface, and it's implementing object will be freed automatically when it's no longer
needed. But be careful with that method, because a new instance of TAddressList is created each time the
function is used, and since you don't have to free it by yourself, it's easy to use it in a loop, which causes
memory fragmentation like Mr. Bolton pointed out in a previous article.
Respond
Comments
Jérôme Tremblay (Sep 28 2000 8:15AM)
Functions that returns an Object are sometimes very useful, but that can be confusing for the users. Such
functions should be clearly defined as returning a new object that must be handled by the caller.
There is a Design Pattern that fits this description, it's a Factory. So by naming it something like
AddressListFactory, it's clear that it's task is to create something, and the caller is less prone to forget
it.
Respond
Safer way
John Cargill (Sep 28 2000 7:45AM)
instead of this:

begin
list := makelist;
list.free;
end;
have this:

begin
list := makelist;
try
finally
list.free;
end;//try
end;
This way if an exception occurs the object is alway freed.
Respond
RE: Safer way

david bolton (Sep 28 2000 8:59AM)
Ah yes I did overlook that. Tch and heres me trying to increase robustness. Thanks.
Respond

Row number in a DBGrid

Undertitle: Get the row number in a DBGrid with master/detail dataset
Category: DB-General
Uploader: G Siliotti
Question: Implementing a different method of getting the line number of a selected row in a DBGrid. Using
dataset.RecNo is not the best practice with a master-detail relationships.
Answer:
This is a different method for getting the line number of a selected row in a DBGrid and the
total number of lines using master-detail relationships. The table.recno doesn't respect the
order of the items in the detail dataset.
So in the AfterScroll event of the master dataset you load a TStringList with the recno property
of all the items. Then you can use the index property of that TStringList to search the exact
rownumber.
The source uses two dataset (master-detail), a dbgrid and two label to put the selected row
number and the total row number.
...
Database: TDatabase;
Details: TTable;
Master: TTable;
...
nRowLbl: TLabel;
totRowsLbl: TLabel;
...
procedure LoadRowList();
function getRowNum: integer;
function getTotRowsNum: integer;
...
var
Form1: TForm1;
rowList: TStringList;
inserting: Boolean;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);

begin
Master.Open;
end;
procedure TForm1.MasterBeforeOpen(DataSet: TDataSet);

begin
rowList:=TStringList.Create;
Details.Open;
end;
procedure TForm1.MasterNewRecord(DataSet: TDataSet);

begin
rowList.Clear;
end;
procedure TForm1.DetailsAfterDelete(DataSet: TDataSet);

begin
//re-load the list
LoadRowList;
end;
procedure TForm1.DetailsAfterPost(DataSet: TDataSet);

begin
if inserting then
rowList.Add(inttostr(Details.RecNo));
inserting:= false;
nRowLbl.Caption:=IntToStr(getRowNum);
end;
function TForm1.getRowNum: integer;

var
nRiga: integer;
begin
if (Details.RecordCount=0) then
getRowNum:=1
else
begin
nRiga:=Details.RecNo;
if nRiga<>-1 then
getRowNum:=rowList.IndexOf(inttostr(nRiga)) + 1
else
getRowNum:=Details.RecordCount + 1;
end;
end;
procedure TForm1.DetailsNewRecord(DataSet: TDataSet);

begin
DetailsRIG_CODICE.Value := MasterDOC_CODICE.Value;
inserting:=true;
end;
procedure TForm1.DetailsBeforeCancel(DataSet: TDataSet);

begin
inserting:=false;
end;
function TForm1.getTotRowsNum: integer;

begin
if (Details.RecordCount=0) then
getTotRowsNum:=1
else
if Details.RecNo<>-1 then
getTotRowsNum:=Details.RecordCount
else
getTotRowsNum:=Details.RecordCount + 1;
end;
procedure TForm1.MasterAfterScroll(DataSet: TDataSet);

begin
LoadRowList;
totRowsLbl.Caption:=IntToStr(getTotRowsNum);
end;
procedure TForm1.DetailsAfterScroll(DataSet: TDataSet);

begin
if not Details.ControlsDisabled then
begin
totRowsLbl.Caption:=IntToStr(getTotRowsNum);
end;
end;
procedure TForm1.LoadRowList;
begin
rowList.Clear;
Details.DisableControls; //for better performance
Details.First;
while not Details.Eof do
begin
rowList.Add(inttostr(Details.RecNo));
Details.Next;
end;
Details.EnableControls;
end;

Write a new comment
Saving and loading binary data to/from an MSSQL Image (Blob) field.
How to get binary data in a workable format into or out of an MSSQL Image (Blob) field using
Undertitle:
ADO components.
Category: ADO/OLE-DB
Uploader: andrew venmore
Question: How to get binary data in a workable format into or out of an MSSQL Image (Blob) field using
ADO components.
Answer:
The main problem I faced when trying to do this was to deal with the fact that TField.Value
returns a varOleStr no matter what was written into it, so the data needed to be converted into a
more usable format.
Note that there is no checking here that the TField is in fact of the correct type, and that the
stream must be created and free-ed elsewhere manually. Also, additional memory equal to the
size of the stream/blob is required, so be cautious if large amounts of data are involved.
For ease of use in my own application, I incorporated this functionality into my descendent of
TADOQuery.
function LoadFromBlob(const AField: TField; const Stream: TStream): boolean;

var
ResultStr: string;
PResultStr: PChar;
begin
Result := false;
if (Assigned(AField)) and (Assigned(Stream)) then begin
try
ResultStr := AField.Value;
PResultStr := PChar(ResultStr);
Stream.Write(PResultStr^, Length(ResultStr));
Stream.Seek(0,0);
Result := true;
except
end;
end;
end;
function SaveToBlob(const Stream: TStream; const AField: TField): boolean;

var
FieldStr: string;
PFieldStr: PChar;
begin
Result := false;
if (Assigned(AField)) and (Assigned(Stream)) then begin
try
Stream.Seek(0,0);
SetLength(FieldStr, Stream.Size);
PFieldStr := PChar(FieldStr);
Stream.Read(PFieldStr^, Stream.Size);
AField.Value := FieldStr;
Result := true;
except
end;
end;
end;
-------------------------------------------------------
Examples:
If you have an ADO query "qryBlobTest" with the following fields: nFileIcon: Image; nFileData:
Image;
// Store an icon in an Image field

function StoreFileIcon: boolean;
var
AFileIcon: TIcon;
MS: TMemoryStream;
begin
Result := false;
AFileIcon := TIcon.Create;
MS := TMemoryStream.Create;
try
AFileIcon.handle := ExtractAssociatedIcon('c:\temp\Test.doc'); // Pseudocode !!
AFileIcon.SaveToStream(MS);
Result := SaveToBlob(MS, qryBlobTest.FieldByName('nFileIcon'));
finally
AFileIcon.Free;
MS.Free;
end;
end;
// Load an icon from an Image field

function LoadFileIcon: boolean;
var
AFileIcon: TIcon;
MS: TMemoryStream;
begin
Result := false;
AFileIcon := TIcon.Create;
MS := TMemoryStream.Create;
try
if (LoadFromBlob(qryBlobTest.FieldByName('nFileIcon'), MS)) then begin
AFileIcon.LoadFromStream(MS);
// Do something with the Icon?
Result := true;
end;
finally
AFileIcon.Free;
MS.Free;
end;
end;
// Save a binary file in an Image field

function StoreFileData: boolean;
var
FS: TFileStream;
begin
FS := TFileStream.Create('c:\temp\Test.doc', fmOpenRead);
Result := SaveToBlob(FS, qryBlobTest.FieldByName('nFileData'));
FS.Free;
end;
// Load a file from an Image field (save it to a file name)

function LoadFileData: boolean;
var
FS: TFileStream;
begin
FS := TFileStream.Create('c:\temp\Test2.doc', fmCreate);
LoadFromBlob(qryBlobTest.FieldByName('nFileData'), FS);
FS.Free;
end;


Write a new comment
strore the blob in Pchar is not a good idea

gros jojo (Mar 20 2006 6:25PM)
at the first #0 the blob is cut....

Respond
RE: strore the blob in Pchar is not a good idea

andrew venmore (Mar 20 2006 7:10PM)
Only if the PChar was going to be passed to something that was expecting a PChar (a Win32
API for example). In this case it is just used as a mechanism to get a pointer to the
beginning of the data.
Respond
RE: RE: strore the blob in Pchar is not a good idea

Marc Skarshinski (Sep 27 2006 4:48AM)
I created an overloaded SaveToBlob which accepts a TParameter instead of TField as I

save using a stored procedure. Saves resulted in widestrings being saved (ie database
contained "FF00D800..." instead of "FFD8..." until I changed the local "string" to an
array of byte. Have no idea why but fwiw, hope it saves someone some time.
Respond
Article makes no sense

Gillis Onyeabor (Jul 12 2005 4:48AM)
I expected to see images. Only .doc files are used in the examples.
I will see what happens after I try loading real images.
Respond
RE: Article makes no sense

andrew venmore (Jul 12 2005 12:40PM)
Huh? Try replacing *.doc with *.,jpg. Or do you need a picture?

Respond
Alliviated...
Oswaldo Ricardo Rocha Jr (May 15 2002 7:28PM)
Vine ha some days tendando to record documents in tables of the Ms-SQL Server, and this article
assisted me very.
Respond
Simple example for the COMPOSITE Design Pattern

Undertitle:
Question: What is the Composite Design Pattern ? How do you copy a directory with all subdirectories
in a simple way ?
Answer:
The COMPOSITE Design Pattern lets clients treat individual
objects and compositions of objects uniformly
(according to Gamma, Helm, Johnson and Vlissides
"Design Patterns", Addision-Wesley, 1995. Allthough
this book now is nearly 8 years old, it is even in
the new DOT NET World still important.)
The idea is to define a Composite Class
aComponentClass = class
..
procedure DoSomething; virtual;
end;
aCompositeClass = class(aComponentClass)
aList: tList; // List of "aComponentClass" Objects
procedure DoSomething; override;
...
end;
Now you can call a single class method
aComponentClass.DoSomething;
in any case, whether the class is a composite class or not.

The method "DoSomething" of the CompositeClass for example
calls "DoSomething" for every item of the list.
This allows you to ignore the difference between compositions

of objects and individual objects.
A simple example for a composition is a directory : a

directory is a composition of files. A simple implementation
of a class that copies a file or a complete directory with
all subdirectories looks like this :
uses Classes,SysUtils,..;
tFile = class
public
fName : string;
public
constructor Create(Name : string);
procedure Copy(DstDir : string); virtual;
property Name : string read fName;

end;
tDirectory = class(tFile)
private
FileList : tList;
public
constructor Create(Name : string);
destructor Destroy;
procedure Copy(DstDir : string); override;
property Name;
end;
{ tFile }
constructor tFile.Create(Name: string);

begin
fName:=Name;
end;
procedure tFile.Copy(DstDir: string);

var SrcFilename,DstFilename : string;
begin
SrcFilename:=fName;
DstFilename:=IncludeTrailingPathDelimiter(DstDir)+
ExtractFilename(fName);
if FileExists(SrcFilename) then
Windows.CopyFile(PChar(SrcFilename),PChar(DstFilename),false);
end;
{ tDirectory }
procedure tDirectory.Copy(DstDir: string);

var i : integer;
RelPath : string;
begin
if not DirectoryExists(DstDir) then
ForceDirectories(DstDir);
for i:=0 to FileList.Count-1 do

if tFile(FileList[i]) is tDirectory then
begin

RelPath:=ExtractRelativePath(IncludeTrailingPathDelimiter(Name),
tDirectory(FileList[i]).Name);
tDirectory(FileList[i]).Copy(DstDir+'\'+RelPath)
end else
tFile(FileList[i]).Copy(DstDir)
end;
constructor tDirectory.Create(Name: string);

var Root,s : string;
sr : tSearchRec;
begin
inherited Create(Name);
FileList := tList.Create;
Root:=IncludeTrailingPathDelimiter(Name);
s:=Root+'*.*';
if FindFirst(s, faAnyFile , sr) = 0 then
begin
repeat
if (sr.Name = '.') or (sr.Name = '..') then continue;
if ((sr.Attr and faDirectory) <> 0)

then FileList.Add(tDirectory.Create(Root+sr.Name))
else FileList.Add(tFile.Create(Root+sr.Name));
until FindNext(sr) <> 0;
FindClose(sr);
end;
end;
destructor tDirectory.Destroy;
var i : integer;
begin
for i:=0 to FileList.Count-1 do
tFile(FileList[i]).Destroy;
FileList.Free;
end;


Write a new comment
Patterns around the World

Max Kleiner (Mar 20 2003 10:20AM)
As such it captures design experience of experienced programmers. A designer who is familiar with such
patterns can apply them immediately to design problems (and code problems too, like code patterns)
without having to rediscover them.
If you agree, I would like to publish your solution in my new book.
Respond
RE: Patterns around the World

Jochen Fromm (Mar 20 2003 10:56AM)
Yes, of course I agree.

Good luck with your new book.
Respond

Simple Observer pattern

Undertitle: A simple implementation of the observer patterns
Uploader: Christer Höstklint
Question: How to make objects aware of changes in the state of another object, without coupling the
changing object with the observing object.
Answer: To make, for example a form, avare of changes in another object we can
add a notify event to that object and implement some method to it. But
in that case only one observer can exist for that class. If more than
one class has to get notified of changes in the class, we have to implement some kind of list
with events. This is best implemented with an Observer-pattern.
And here we have our little version of the pattern :).
The unit Observer_un consists of two classes

TObserverItem wich is the container for one "observation" event
TObserverMgr Maintains a list of TObserverItem and has a method for
running registered observers
For clarity we call the classes thats going to use these for observation
TObserver : The class that want to get notified of changes
TChanger : The class that changes
To use this you start with the class you want others to be able to
observe (TChanger), and implement a private field for TObserverMgr.
Then to avoid need for coupling between observer and TObserverMgr you
implement two methods, AddObserver and RemoveObserver in the changer
which just forwards the methods to TObserverMgr.
procedure TChanger.AddObserver(aNotifyEvent: TNotifyEvent; Observer: TObject);

begin
// Forwarding method call, Observer should not need to know about fObserverMgr
fObserverMgr.AddObserver(aNotifyEvent, Observer);
end;
Now if you want to observe the field FMyString in changer you implement
a property MyString with a set method
Could look like this
procedure TChanger.SetMyStr( value : String )

begin
FMyString := Value ;
// And now we want to call all the observers
FObserverMgr.RunObservers ;
end;
Ok its esier for you to understand the source so look below or in Observer.zip
which has an example also.
/Christer & Fredrik
unit Observers_un;
interface
uses
contnrs, classes;
type
{{
Item for holding an observer and one of its TNotifyEvents.
}
TObserverItem = class
private
FObserved: TObject;
FObserver: TObject;
FOnChange: TNotifyEvent;
protected
constructor Create(theObserved: TObject);
public
procedure Change;
property Observer: TObject read FObserver write FObserver;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
end;
{{
Class for managing ObserverItems.
Holds methods for inserting deleting and running

ObserverItems.
}
TObserverMgr = class (TObject)
private
FObserved: TObject;
FObserverList: TObjectList;
function FindMatch(aNotifyEvent: TNotifyEvent; Observer: TObject): Integer;
public
constructor Create(Owner : TObject);
procedure AddObserver(aNotifyEvent : TNotifyEvent ; Observer : TObject);
procedure RemoveObserver(aNotifyEvent : TNotifyEvent ; Observer : TObject);
procedure RunObservers;
end;
implementation

****************************************** TObserverItem
*******************************************
}
constructor TObserverItem.Create(theObserved: TObject);
begin
inherited Create ;
FObserved := theObserved ;
end;
procedure TObserverItem.Change;
begin
if Assigned(FOnChange) then
FOnChange( FObserved ) ;
end;
{
******************************************* TObserverMgr
*******************************************
}
constructor TObserverMgr.Create(Owner : TObject);
begin
inherited Create ;
FObserved := Owner ;
FObserverList := TObjectList.Create;
FObserverList.OwnsObjects := true;
end;
procedure TObserverMgr.AddObserver(aNotifyEvent : TNotifyEvent ; Observer : TObject);

var
anItem: TObserverItem;
begin
if (0 > FindMatch(aNotifyEvent, Observer)) then
begin
anItem := TObserverItem.Create(FObserved) ;
anItem.OnChange := aNotifyEvent ;
anItem.Observer := Observer ;
FObserverList.Add(anItem) ;
end ;
end;
function TObserverMgr.FindMatch(aNotifyEvent: TNotifyEvent; Observer: TObject): Integer;

var
I: Integer;
anItem: TObserverItem;
// Check if this Observer and notify event exists in FObserverList

// Result is -1 if not present, else it's the index in FObserverList
//
// If aNotifyEvent is Nil then the first item with the same observer will
// return it's index
//
begin
result := -1 ;
For I := 0 to FObserverList.count-1 do
begin
anItem := TObserverItem( FObserverList.Items[i] ) ;
if anItem.Observer = Observer then

begin
if @aNotifyEvent = nil then
begin
result := I ;
exit ;
end
else if (@anItem.OnChange = @aNotifyEvent) then
begin
result := I ;
exit ;
end ;
end ;
end ;
end;
procedure TObserverMgr.RemoveObserver(aNotifyEvent : TNotifyEvent ; Observer :

TObject);
var
I: Integer;
begin
// If aNotifyEvent is Nil then we loop through the list
// and removes all items with this observer
repeat
I := FindMatch(aNotifyEvent, Observer) ;
if (I >= 0) then FObserverList.Delete(I) ;
until (I < 0) ;
end;
procedure TObserverMgr.RunObservers;
var
I: Integer;
anObserver: TObserverItem;
begin
For I := 0 to FObserverList.Count - 1 do
begin
anObserver := TObserverItem( FObserverList.items[i] );
anObserver.Change ;
end ;
end;
end.


Write a new comment
Observers are smart, bad

Johannes Bjerregaard (Jun 4 2001 3:55PM)
Another name for this is event multicasting.
It's dangerous and most often leads to code which can be understood only by stepping through it with a
debugger, because the flow of execution is obscured.
If you've ever had weird bugs pop up in unrelated places with data access components and data aware
controls, they were most likely caused by the fact that the VCL uses a form of multicasting (allowing the
same event to be handled in multiple places.)
An alternative is to use a hierachical event model where one component propagates messages to several
components that it knows. The idea is that one component handles the event, and calls public methods on
other objects which need to know when the event occurs. These components can in turn pass the event
on to other components that they know.
The advantages are:
- Execution flow is not obscured, leading to readable code

- Your application doesn't need Yet Another Component which doesn't help solving the original business
problem
Respond
RE: Observers are smart, bad

Mat Hobbs (Jun 20 2001 7:34PM)
Any use of events (multi or not) obscures the flow of execution practically by the very nature of
'events'.
Just try tracing any user interface process through the vcl once the windows and component
messaging kicks in.
The observer model solves the design problem of separating the observer from the observed.
If anyone is interested in some theory just search for "observer design pattern" on the internet, e.g.
http://compsci.about.com/science/compsci/cs/observerpattern/
(which has a delphi link on it).
-Mat
Respond
Interface
Peter Morris (May 22 2001 10:24AM)
Personally I would use a TInterfaceList (cntnrs.pas)
and have an interface will a method, like so
type
INotifyEvent = Interface
procedure Notify(Sender: TObject);
end;
and then implement like so

TForm1 = class(TForm, INotifyEvent)
private
public
procedure Notify(Sender: TObject);
end;
You can then do

MyObject.AddWatch(Self);
MyObject.AddWatch would do something like
SomeList.Add(Watcher);
then you could do

for I := 0 to List.Count -1 do (List[I] as INotifyEvent).Notify(Self);
This is not compiled code, I just typed it directly into the browser
Respond

Sort DBGrid on column click !

Undertitle: with a ORDER-BY clause from TQuery
Uploader: Helmut Dollinger
Question: How to resort a dataset with a mouse-click...

Answer: It's quite easy to do this.
I have a TQuery, TDatasource and TDbGrid on a form, linked together.
QuerySQL is a global string that holds the SQL-statement.
begin
QuerySQL := 'SELECT * FROM Customer.DB';
Query1.SQL.Add(QuerySQL);
Query1.Open;
end;
In the DBGrid event OnTitleClick, we just add an ORDER-BY clause to the sql and refresh the
query.
procedure TForm1.DBGrid1TitleClick(Column: TColumn);

begin
witzh Query1 do
begin
DisableControls;
Close;
SQL.Clear;
SQL.Add(QuerySQL);
SQL.Add('ORDER BY ' + Column.FieldName);
Open;
// Restore the title settings, otherwise everything
// will be blue after a while
DBGrid1.Columns.RestoreDefaults;
Column.Title.Font.Color := clBlue;
EnableControls;
end;
end;


Write a new comment
[Error] CFFAdmin.pas(187): Undeclared identifier: 'QuerySQL'

Wayne Barron (Sep 25 2004 5:21AM)
The person that wrote this code, should have really made sure that
It worked. Mis-Splelled words, and "Undescared identifier"
Very pour, Will find information else where.

Respond
When work with DBGrid+Query runtime it doesn't work

Oleg Solovey (Feb 17 2003 3:04PM)
So, If your SQL-query changing run-time this code generate exception.

You must add columns before assign to another SQL-query.
Respond
help me with the grid

Marco Villegas (Jun 18 2001 12:56AM)
how could i make some action happens when i make double click in a specifyc cell, for example, if
i make double click in a cell i want to show an information about that cell
excuse me fot my english

thank you all
Respond
Sorting column header

Steve (Nov 15 2000 4:47AM)
Does anyone know how to modify the column heading of a TDBGrid so as to display an arrow
indicating which column is sorted ? (see Microsoft Outlook for an example of this).
Respond
RE: Sorting column header

Bjørge Sæther (Dec 4 2001 11:19AM)
Hi !
I found this code snippet in a project where I modified the TDBGrid to allow for painting
arrows. I see now that one routine paints it with PolyLine, the other with LineTo...:
procedure PaintArrowUp(Canvas: TCanvas; var Rect: TRect);

var
SaveCol : TColor;
begin
with Canvas do begin
SaveCol:=Pen.Color;
Pen.Color:=clGray;
MoveTo(Rect.Right-10, Rect.Top+11);
LineTo(Rect.Right-7, Rect.Top+5);
Pen.Color:=clWhite;
Pen.Color:=SaveCol;
end;
end;
procedure PaintArrowDown(Canvas: TCanvas; var Rect: TRect);

var
APolyLine: Array[0..2] of TPoint;
SaveCol : TColor;
begin
with Canvas do begin
SaveCol:=Pen.Color;
Pen.Color:=clGray;
APolyLine[0]:=Point(Rect.Right-3, Rect.Top+5);
PolyLine(APolyLine);
Pen.Color:=clWhite;
Pen.Color:=SaveCol;
end;
end;
Respond
RE: RE: Sorting column header

Brodhol (Sep 18 2004 7:03AM)
Would you like to tell me how to use those procedures? (PaintArrowUp,
PaintArrowDown). Thanks
Respond
sorting column on query

Francis (Sep 30 2000 8:32PM)
Yes there is a way with ADO component
ADOQuery1.Sort := colname + ' ASC' or ' DESC'
But you can come into some trouble depending on what database your are using
(i.e with access one field name can be in two part)
Respond
RE: sorting column on query

Marco Antonio (Oct 24 2005 5:48PM)
Great !
Thanks, man !
Respond
Sorting on lookup fields

Bas (Jul 31 2000 12:44PM)
How can you sort on a lookup field by clicking on de columtitle?
Respond
Excelent, but slow.

Wouter van Wegen (Jul 22 2000 5:00AM)
This is a excelent way do this, for small Queries. The problem with Quereries with more than 12
joined tables and over 32.000 records in it, is that the whole query has to be de-activated and
activated.
I know this can be worked around with the TADOCommand component. anybody knows how to
use this?
and cant this be done by the filter property?
Or by some of the INDEX properties of the Query?
Respond
I can edit, insert, delete records

Domagoj Barisic (Jun 22 2000 6:06PM)
With SQL I can edit, insert, delete records in table!
Respond
DBGrid
M Lopez (Apr 26 2000 11:37PM)
That's actually very good, but what happens if you want to sort by a lookup field when using a
client dataset?
tia
Respond
Sorting a TListView
Undertitle: Sorting a TListView by the first or any arbitrary column
Category: VCL-General
Uploader: Ernesto De Spirito
Question: How can I sort the items in a TListView?

Answer:
Sorting by the first column
---------------------------
Sorting a TListView by the first column is easy:
ListView1.SortType := stText;
Setting SortType to stText is more or less like setting Sorted to

True in a TListBox object. The list will be sorted and will remain
sorted after additions and modifications, until SortType is set back
to stNone:
ListView1.SortType := stNone;
It's like setting Sorted to False in a TListBox object. It won't undo

the sorting, but future additions and modifications to the items list
won't be sorted.
Sorting with an OnCompare event

-------------------------------
To have a TListView sorted on another column (or arbitrary data stored

or referenced in TListItem objects), we should either write an
OnCompare event or an ordering function to be used with the CustomSort
method. If you want to sort keep a list sorted while adding and
modifying items, then you should use an OnCompare event.
procedure(Sender: TObject; Item1, Item2: TListItem;

Data: Integer; var Compare: Integer) of object;
The parameter Compare which is passed by reference should be set to

1, -1 or 0 depending on whether the first item is greater than (or
should be placed after) the second item, the first item is lower than
(or should be placed before) the second item, or if the two items are
equal, respectively. In the following example we are sorting a
TListView by its fourth column (wich represents integer values) in
descending order:
procedure TForm1.ListView1Compare(Sender: TObject; Item1,

Item2: TListItem; Data: Integer; var Compare: Integer);
var
n1, n2: integer;
begin
n1 := StrToInt(Item1.SubItems[2]);
if n1 > n2 then
Compare := -1
else if n1 < n2 then
Compare := 1
else
Compare := 0;
end;
Now that we have an OnCompare event, to sort the list and having
sorted, we should set SortType to stBoth (instead of stText, that
sorts by the first column without using the OnCompare event):
ListView1.SortType := stBoth;
If you just want to perform a temporal sort, you can do the

following:
ListView1.SortType := stBoth;
ListView1.SortType := stNone;
or else:
ListView1.CustomSort(nil, 0);
Sorting with an ordering function

---------------------------------
If you need a faster sort, then you should write an ordering

function. This function should return 1, -1 or 0 (like the Compare
parameter of the OnCompare event discussed above). For example:
function ByFourth(Item1, Item2: TListItem; Data: integer):

integer; stdcall;
var
n1, n2: cardinal;
begin
if n1 > n2 then
Result := -1
else if n1 < n2 then
Result := 1
else
Result := 0;
end;
Then, every time you want to sort the list, you call CustomSort
passing the address of the ordering function. For example:
ListView1.CustomSort(@ByFourth, 0);
The Data parameter of the OnCompare event is 0 if the event is called

automatically when SortType is stData or stBoth, but if it is
generated because of a call to CustomSort, then its value is the
second parameter to this method. The same happens with the Data
parameter of the ordering function, so the Data parameter is normally
used to specify a column to sort (we didn't use it in our example to
make it simple).

Write a new comment
Extending the functionality

Joep Greuter (Aug 23 2004 3:45PM)
The code below is an extend to the sorting code on this page. It has a trick for the ascending
global (unneeded) variable. And can deal with columns containing numerical data.
procedure TFormMain.lvNetworkColumnClick(Sender: TObject; Column: TListColumn);

begin
// Check out if this is the first time the column is sorted
if Column.Tag = 0 then
// Default = Ascending
Column.Tag := 1
else
Column.Tag := -Column.Tag;
// Perform the sort

// the second parameter has a part for the ascending property, the sign of the parameter and
the
// column index is increased by one, else the first column (index=0) is always sorted Descending
// In the SortByCloumn function this assumption is taken into account

TListView(Sender).CustomSort(@SortByColumn, Column.Tag * (Column.Index + 1));
end;
function SortByColumn(PItem1, PItem2: TListItem; PData: integer):integer; stdcall;

var
Ascending: Boolean;
f1, f2: double;
s1, s2: String;
begin
// Check out the Ascending or Descending property, this is embedded in the sign of PData
Ascending := Sign(PData) = 1;
// Get away the ascending or descending property

PData := abs(PData);
// Get the strings to compare

if PData = 1 then
begin
s1 := PItem1.Caption;
s2 := PItem2.Caption;
end
else
begin
s1 := PItem1.SubItems[PData-2];
s2 := PItem2.SubItems[PData-2];
end;
try
// Check out if the column contains numerical data
f1 := StrToFloat(s1);
f2 := StrToFloat(s2);
// if code execution get's to this point, we have to deal with numerical values, and return -1, 0,
1 according to
if f1 > f2 then
result := 1
else if f1 < f2 then
result := -1
else
result := 0;
except
// Else the result is based upon string comparison
Result := AnsiCompareText(s1, s2)
end;
if not Ascending then Result := -Result;

end;
Respond
VB Equivalent ?
Roni Havas (Aug 5 2001 11:38AM)
The following procedure will sort a TListView while you click the Header Column. How can I do this
with Delphi ?. Doesn't Delphi declare the same Method/Property as VB ?
*************************************************************************
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
If ListView1.SortOrder = lvwAscending Then
ListView1.SortOrder = lvwDescending
Else
ListView1.SortOrder = lvwAscending
End If
ListView1.SortKey = ColumnHeader.Index - 1
ListView1.Sorted = True
End Sub
************************************************************
Greetings,
Roni Havas
Respond
RE: VB Equivalent ?
Ernesto De Spirito (Aug 6 2001 7:26AM)
The controls aren't 100% equivalent. However, what you want to do can be achieved using
some of the elements I presented in the article:
var
Ascending: boolean;
function SortByColumn(Item1, Item2: TListItem; Data: integer):

integer; stdcall;
// Copyright (c) 2001 Ernesto D'Spirito
// edspirito@latiumsoftware.com
// http://www.latiumsoftware.com
begin
if Data = 0 then
Result := AnsiCompareText(Item1.Caption, Item2.Caption)
else
Result := AnsiCompareText(Item1.SubItems[Data-1],
Item2.SubItems[Data-1]);
if Result < 0 then begin
if Ascending then Result := -1 else Result := 1;
end else if Result > 0 then begin
if Ascending then Result := 1 else Result := -1;
end;
end;
procedure TForm1.ListView1ColumnClick(Sender: TObject;

Column: TListColumn);
begin
// Toggle column Tag
Column.Tag := 1 - Column.Tag; // 0 -> 1 ; 1 -> 0
// Determine sort order based on the value of the Tag
Ascending := Column.Tag = 1;
// Perform the sort
TListView(Sender).CustomSort(@SortByColumn, Column.Index);
end;
I hope this helps.
Ernesto
Respond
RE: RE: VB Equivalent ?

Roni Havas (Aug 6 2001 8:40AM)
Thank's a lot.
It works smoothly. Excellent Job
Best Regards,
Roni Havas
Respond
A little improvement
Ernesto De Spirito (Aug 6 2001 9:16AM)
I don't know what I was thinking of... Instead of
if Result < 0 then begin

if Ascending then Result := -1 else Result := 1;
end else if Result > 0 then begin
if Ascending then Result := 1 else Result := -1;
end;
You can simply write:
if not Ascending then Result := -Result;
Ernesto
Respond
Supporting events in your own classes

Undertitle:
Uploader: Peter Friese
Question: How can I add custom events to my classes?

Answer: Steps to be taken:
1) Define an event signature. Events are pointers to functions / procedures. Correctly
speaking, they are pointers to methods - we are dealing with an object oriented language! A
basic event definition might look like this:
type
TChangeEvent = procedure(Sender: TObject) of object;
You may pass any parameters to your event methods, so the following code is perfectly
ok:
type
TDateChanged = procedure(MyBirthDay, YourBirthDay: TDateTime; ABoolean: boolean)
of object;
2) Augment your class with event support code. Classes support events via properties. Yes,
events are properties! You need a private field for storing a reference to the event handler
your user assigns, and a property definition. If you like, you can have a plain property
definition (writing directly to your private field) or introduce a pair of set/get methods:
type
TMyTestObject = class
private
FChange: TChangeEvent;
FChange2: TChangeEvent;
procedure SetChange(Value: TChangeEvent);
public
property OnChanged1: TChangeEvent read FChange write FChange; //plain
property definition
property OnChanged2: TChangeEvent read FChange2 write SetChange2; // property
definition with set method
end;
[...]
procedure TMyTestObject.SetChange(Value: TChangeEvent);
begin
if FChange2 <> Value then
FChange2 := Value;
end;
3) Now, you should call the event procedure everywhere in your class where appropriate.
Let's asume a method "Work" that does some computations:
procedure TMyTestObject.Work;
begin
// (compute something important)
FChange(self);
end;
4) STOP! Don't forget to check for NIL! Since your users are not obliged to use your event,
you will quite probably face the situation of having a nil pointer in your private event field. In
this case, you will produce a wonderful AV with the above code fragment. So, before calling
any event routine, you should check wether the event is assigned or not:
begin
if Assigned(FChange) then
FChange(self);
end;
5) It is a good practice to factor out the code that checks for events pointing to nil:
procedure TMyTestObject.DoChange;
begin
FChange(Self);
end;
begin
DoChange;
end;
6) Now, you can create an object of your class and assign an event procedure. See the
sample code how to do this.
Sample code
Your code should look like this:
unit Unit1;
interface
uses


StdCtrls;
type
(* type of event gets defined here.
you don't need to specify the "Sender: TObject", if you don't need to know who the
sender is. however, supplying this parameter is a good habit.
if you want to provide information about the changed value, put as many additional
parameters "on top". Here, I have only supplied an integer parameter, since I wasn't
sure which params would be interesting to you *)
TChangeEvent = procedure(Sender: TObject) of object;
TMyTestObject = class
private
(* you need a local store for your event in your class. this is normally done within
the private section, so to keep classes that derive from your class away from
tampering with your events *)
FChange: TChangeEvent;
FMyBoolean: boolean;
protected
(* this procedure should be called whenever you want to signal a change to your
"subscribers", as we like to call it. if you are into design patterns: this is a
"template method". *)
procedure DoChange;
procedure SetMyBoolean(AValue: boolean);
public
published
(* this is where you make your event public to the rest of the world. you could also
put it into the "public" section, if you like, but this would hide your event from
mr. object inspector.
with the "read" and "write" keywords, you define how access to your local
store is achieved. you could also write an extra "accessor" function, but this
is rather uncommon for events.*)
property OnChanged: TChangeEvent read FChange write FChange;
property MyBoolean: boolean read FMyBoolean write SetMyBoolean;
end;
Button1: TButton;
Button2: TButton;
private
procedure ItHasChanged(Sender: Tobject);
public
end;
var
Form1: TForm1;
_myTest: TMyTestObject;
implementation
{$R *.DFM}
procedure TMyTestObject.DOChange;
begin
(* if your event isn't assigned in the client, the FChange field will be nil.
it is a prerequisite in events programming to check wether something is
nil before calling on it. *)
FChange(Self);
end;
procedure TMyTestObject.SetMyBoolean(AValue: boolean);

begin
FMyBoolean := AValue;
DoChange;
end;
procedure TForm1.ItHasChanged(Sender: Tobject);

begin
ShowMessage('yo. it has changed!');
end;

begin
_myTest := TMyTestObject.Create;
_myTest.OnChanged := ItHasChanged;
end;

begin
_myTest.MyBoolean := true;
end;
end.


Write a new comment

The Observer pattern

Undertitle: An implementation of the Observer pattern with normal methods.
Uploader: Jérôme Tremblay
Question: How can many objects be notified by an event?

Answer:
Sometimes, there is a need to notify many different objects about a state change. My
favorite solution to this problem is the Observer pattern, described in Design Patterns. (I
highly recommend this book). Roughly, this patterns describe a way for objects that want to
be notified of a change (called the Observers) to register themselves with the subject (called
the Subject :). This subject then has the responsability to notify all it's observers when it's
internal state changes.
And this is where we encounter our first problem. How does the Subject notify it's
Observers? By calling one of the Observer's method. But this means the Subject has to know
the Observer somehow, not very flexible. We could use an abstract Observer class, in that
way our Subject would always be able to call a known method, but this would force us to
always descend observers from the same hiearchy, which is not very practical (and
sometimes completely impossible).
Fortunately, for each problem there is a solution, and in our case there are at least TWO!
The first solution is to use Interfaces. Our Subject would accept an IObserver interface. The
neat thing about interfaces is that any class can implement any interface, and as long as an
object would implement IObserver, it would be able to connect to any subject. (If anyone is
interested in this implementation, let me know and I'll post another article, but there are
gazillions of examples on the net if you search a little). This works perfectly, but after
working with interfaces a little, I decided not to use them. The main reason for this is that
code navigation in the IDE is harder, Ctrl-Click brings you to the interface definition, not the
implementation. No big deal. But I wanted something better.
The second solution, the one I'm describing in this article, is a little different. The Observer is
no longer an object, it's a method. Just like standard VCL events. This means that a single
event handler could be used with a component and a Subject at the same time.
Let say we have a TSubject with an event called OnChange. This event is of type
TMultiNotifyEvent. Here is how a user would connect to this event. ChangeHandler is a
procedure matching a TNotifyEvent.
MySubject.OnChange.Attach(ChangeHandler);
From that point on, every time MySubject changes, it will call ChangeHandler, just like a
normal OnChange event. The difference is that there might be many observers of that event.
When the object no longer wish to receive updates from MySubject, it detaches:
MySubject.OnChange.Detach(ChangeHandler);
In order for TMySubject to use a TMultiNotifyEvent, it must create it like this:
type
TMySubject = class
private
FOnChange: TMultiNotifyEvent;
protected
procedure DoChange; virtual;
public
constructor Create;
property OnChange: TMultiNotifyEvent read FOnChange;
end;
implementation
constructor TMySubject.Create;
begin
inherited;
FOnChange := TMultiNotifyEvent.Create;
end;
destructor TMySubject.Destroy;
begin
FOnChange.Free;
inherited;
end;
procedure TMySubject.DoChange;
begin
{ Signal is the method that notify every observers }
OnChange.Signal(Self);
end;
In order to use a new type of event, one must declare a new class inheriting from
TMultiEvent. Why am I doing this? Because TMultiEvent only stores and knows about
TMethod records, it does not know what type of event is used, what are it's parameters, etc.
By having the SignalObserver method Abstract, each concrete class can typecast it to the
type of events it handles and pass all the required parameters. Also, creating a new class
provices a certain level of type by making sure you register a compatible method with the
subject. See TMultiNotifyEvent at the end of this article to see how to create customized
events, it's pretty straight forward.

That's it for the explication, if you have any questions just leave a comment and I'll try to
update the article accordingly.
unit uMultiEvent;
interface
uses
Classes, SysUtils;
type
TMultiEvent = class
private
FObservers: TList;
protected
function FindObserver(Observer: TMethod): integer;
function GetObserver(Index: integer): TMethod;
procedure SignalObserver(Observer: TMethod); virtual;
public
constructor Create;
procedure Attach(Observer: TMethod);

procedure Detach(Observer: TMethod);
procedure Signal;
end;
TMultiNotifyEvent = class(TMultiEvent)
private
FSender: TObject;
protected
procedure SignalObserver(Observer: TMethod); override;
public
procedure Attach(Observer: TNotifyEvent);
procedure Detach(Observer: TNotifyEvent);
procedure Signal(Sender: TObject);

end;
implementation
{ TEvent }
procedure TMultiEvent.Attach(Observer: TMethod);

var
Index: integer;
begin
Index := FindObserver(Observer);
{ This assertion is facultative, we could just ignore observers }

{ already attached, but it's a good way to detect problems early }
{ and avoid unnecessary processing. }
Assert(Index < 0, 'This observer was already attached to this event');
{ A method contains two pointers: }

{ - The code pointer, that's where the procedure is in memory }
{ - The data pointer, this tells Delphi what instance of the }
{ object calls the procedure }
{ We must store both pointers in order to use that callback. }
if Index < 0 then

begin
FObservers.Add(Observer.Code);
FObservers.Add(Observer.Data);
end;
end;
constructor TMultiEvent.Create;
begin
inherited;
FObservers := TList.Create;
end;
destructor TMultiEvent.Destroy;
begin
{ This assertion is facultative, but I prefer when all my objects }
{ are "clean" when they are destroyed. }
Assert(FObservers.Count = 0, 'Not all observers were detached');
FreeAndNil(FObservers);
inherited;
end;
procedure TMultiEvent.Detach(Observer: TMethod);

var
Index: integer;
begin
Index := FindObserver(Observer) * 2;
{ Again, the assertion is facultative, nothing would be broken }

{ if we just ignored it. }
Assert(Index >= 0, 'The observer was not attached to this event');
if Index >= 0 then

begin
FObservers.Delete(Index); // Delete code pointer
FObservers.Delete(Index); // Delete data pointer
end;
end;
function TMultiEvent.FindObserver(Observer: TMethod): integer;

var

i: integer;
begin
{ Search fails by default, if there is a match, result will be updated. }
Result := -1;
for i := (FObservers.Count div 2)-1 downto 0 do
begin
{ We have a match only if both the Code and Data pointers are the same. }
if (Observer.Code = FObservers[i * 2 ]) and (Observer.Data = FObservers[i
* 2 + 1]) then
begin
Result := i;
break;
end;
end;
end;
function TMultiEvent.GetObserver(Index: integer): TMethod;

begin
{ Fill the TMethod record with the code and data pointers. }
Result.Code := FObservers[Index * 2];
Result.Data := FObservers[Index * 2 + 1];
end;
procedure TMultiEvent.SignalObserver(Observer: TMethod);

begin
{ Descendants must take care to notify the Observer by themselves }
{ because we cannot know the parameters required by the event. }
Assert(Assigned(@Observer));
{ We could make this method Abstract and force descendants, but }
{ I prefer to do a run-time check to validate the passe methods }
end;
procedure TMultiEvent.Signal;
var
i: integer;
begin
{ Call SignalObserver for each stored observers in reverse order. }
{ SignalObserver (which is declared in sub-classes) will typecast }

{ the TMethod record into whatever procedure type it handles. }
{ See the TMultiNotifyEvent below for an example. }
for i := (FObservers.Count div 2)-1 downto 0 do

begin
SignalObserver(GetObserver(i));
end;
end;
{ TMultiNotifyEvent }
procedure TMultiNotifyEvent.Attach(Observer: TNotifyEvent);

begin
inherited Attach(TMethod(Observer));
end;
procedure TMultiNotifyEvent.Detach(Observer: TNotifyEvent);

begin
inherited Detach(TMethod(Observer));
end;
procedure TMultiNotifyEvent.Signal(Sender: TObject);

begin
FSender := Sender;
inherited Signal;
end;
procedure TMultiNotifyEvent.SignalObserver(Observer: TMethod);

begin
inherited;
TNotifyEvent(Observer)(FSender);
end;
end.
Change history
2001.06.21
- Fixed the example usage code (TMySubject.DoChange)
- Added a check to prevent an observer to link with an event twice.
- Minor changes in the text
2001.06.22
- Fixed a bug in Detach (Thanks to Flurin Honegger)
2001.10.01
- Changed the SignalObserver method to be simply virtual instead of Abstract. It allows to
validate the parameter at run-time in the ancestor code instead of duplicate it in all
descendants.
2001.11.29
- Updated the example TMultiNotifyEvent.SignalObserver to call inherited (thus validating
the callback method).



Write a new comment
Design Time
Yoav Abrahami (Oct 7 2001 12:54PM)
The one thing bugging me in you're implementation, is the lack of Design time support.
It would be nice to have the property editor show the list of events.
You can accomplish this with the use of a TCollection and TCollectionItem as base classes for TMultiEvent
and the list.
You need also to add support for streaming the events.
Other then those comment, I like what you wrote.

Respond
Yep, observer type models are the way to go

Mat (Jun 18 2001 7:42PM)
I think observer (or listener) type models like this beat the old delphi-style event models any day for
modularity. The current Java event model uses a listener approach with interfaces. Using interfaces like
this in Delphi could be a pain as you touched on (Java has anonymous inner classes to make such coding
more reasonable).
Perhaps make a descendant of this class with a TNotifyEvent property that you could assign to an existing
vcl notify event (e.g. TButton.OnClick) (hoping it doesn't get reset later at runtime) so you could add
listeners (observers) to that class to listen to the button. Like a souped up action class.
thanks,
-Mat
PS: Maybe, for the example, modify the class to keep a TList to store TNotifyEvent pointers directly to
make it easier to understand at a first read.
Respond
RE: Yep, observer type models are the way to go

Peter Morris (Jun 20 2001 5:30AM)
Interesting.
I used a similar method myself.

I had a list of images, each component that pointed to an image in this list needed notification when
the image altered.
I made an ImageLink class. It passed itself to the ImageList which held a list of them. When I
wanted a new component to point to an image I would expose the "Index" property of my
ImageLink, and set the OnChange event of my ImageLink so my component would be notified. The
ImageList would call each ImageLink which would in turn fire an OnChange event to the owning
component.
http://www.stuckindoors.com/dib (DIBImageList component).
Pete
Respond

THE SECRET LIFE OF TCLIENTDATASET

Undertitle: By Lubomir Rosenstein
Category: MIDAS
Uploader: LUBOMIR ROSENSTEIN
Question: When asked about my favourite dataaccess component, I always answer: TClientDataset. And
this is not only for its well-known features: its being simple to use, but reliable foundation stone
to build multitiered applications. There is also some kind of magic in the local applicability of this
component: you can always discover something new about it. It is a great field for
experimenting, if you enjoy playing rather than using the most obvious ways. It can be an
inspiration while remaining still easy, developer-friendly and reliable. This is a true miracle, ins''t
it?
Answer:
LOOKUPING
To start, I would like to remind you of one function we already know the Clientdataset can carry
out: to be a dataset for lookup fields in another dataset. Receiving its Data from the provider
only the first time when a lookup value is needed, the Clientdataset keeps all the information, so
that there is no need to call the server for these values again in this session. Of course, you can
use an usual Dataset and cached updates for this purpose, but it is well worth doing some simple
preliminary tests. Compare the time results and you will be astonished by the difference.
Moreover, there could be a situation in which the usual Dataset will be truly powerless: what if
you don't need the lookup data in the database at all! There are plenty of examples of data
which is never, or hardly ever, changed. In this case, the standard way to save and economize
transactions and database space is to include this information in something like the good old
inifiles on the client machine (NAME=VALUE) and to develop some tools to read and translate
these values before the data presentation. Using Tclientdataset instead is much more logical and
consistent: your datasources will be clearly indicated on your datamodule and the approach to all
data can be the same no matter where the data is situated. The Clientdataset decodes and
encodes the files by itself and transmitts the data just as if the source was a real table.Moreover,
you can easily add a tool which will change this data automatically on all the client machines -
using that the clientdataset supports the briefcase model, rarely transacting with the server and
applying updates or just replacing the files. It's up to you to choose the concrete approach, but
they all are simple, logical and safe.
------
procedure TfrmTypes.FormClose(Sender: TObject; var Action: TcloseAction);
begin
If DataMod.cdsActions.State in [dsEdit, dsInsert] then
DataMod.cdsActions.Post;
If DataMod.cdsPayments.State in [dsEdit, dsInsert] then
DataMod.cdsPayments.Post;
DataMod.cdsActions.MergeChangeLog;
DataMod.cdsPayments.MergeChangeLog ;
DataMod.cdsActions.SaveToFile (ExtractFilePath(Application.Exename)+'Actions.cds’);
DataMod.cdsPayments.SaveToFile (ExtractFilePath(Application.Exename)+'Payments.cds’);
Listing 1: In this example, two Tclientdatasets are used to give values for lookupfields.The
values can be different for different clients and can be, altough rarely, changed by the user. If
this occurs, Clientdatasets will save the changes in local files.
------
BACKUPING
Yet another advantage: for what else can we use the wonderful 'bisexuality' of the Clientdataset
to respond equally to tables and files? The answer is obvious: for everything previously done by
the ASCII files. It is not that I don't rely on the BDE ASCII driver, but how often have you
received messages as 'Data structure corruption!, etc., even if you have used it after diligent
preparation. There are other market products which do this task efficiently, but our hero beats
them all: it is enough to connect a provider and a clientdataset together to transfer all the
information from a table to a file. And, if necessary you can also easily send it back to a table,
again and again, and there will be no mistakes because of a missed comma or a misscount of a
string. In this contest, the ClientDataset may loose in speed, especially for very big tables, but
not in safety. It is simple to organise a backup utility this way, to save, to

compress, to transport and to migrate the data. And all you need you already have on your
component palette.
----------
unit UnBackup;
interface
----------
implementation
procedure TfrmBackup.FormShow(Sender: Tobject);

begin
Provider.DataSet :=tbEventlogBackup;
cdsBackup.Data:=Provider.Data;
cdsBackup.SaveToFile ('C:\BossHelperBackup’);
Application.ProcessMessages;
Timer1.Enabled:=true;
End;
Listing 2: In this example, a Clientdataset and a provider are used to save a file copy of the most
important for the application Oracle table on the user machine every time when the user is
exiting the application.
--------------
DATEPICKING
The next step in our investigation is: the Clientdataset can produce data for your application.
Sounds strange? Look at the following examples.
A client of mine asked to add additional 'Day of week' field to the database application. He told
me that when filling data for the previous few days (something often done in his organization) it
is much easier to orientate oneself by the days, not by the data and wanted to enter days, not
dates on the screen up to seven days back. This task can be performed in Delphi in many
different ways, but using a Clientdataset is one the most economical ways. There is one more
miracle here: the clientdataset can use a database table or a flat file to work, but in fact it does
not need them- it can be a live, selfsupporting dataset even without any external data carrier.
All you need are persistent fields, a dataset creating (right clicking on the component in design
time) and an idea how this can be useful to you. I don't know if the result is a 'real' dataset or a
brilliant imitation, but it works. I have created dataset with two persistent fields. Every time
when the user starts the application, they fill: the first with the date, and the second with the
name of the corresponding day of week, starting from the present day and going up to seven
days back. So no days repetition will occur in the dataset and you can use it for a lookup field
just the same way you would use a 'regular' database-based dataset. When you are choosing a
day of the week on the grid, the appropriate date is written in the database and this cannot be
done for more than a week back .
-----
procedure TDataMod.DataModuleCreate(Sender: Tobject);
.......
.......
try
cdsweek.Open ;
for iWeek:= 0 to 6 do
begin
cdsweek.Insert;
cdsweekdatenow.AsDateTime := date-iWeek;
cdsweekdayofweek.AsString := FormatDateTime('dddd' ,Date-iWeek);
end;
cdsweek.post;
except
end;
Listing 3:TclientDataset works even without a table or a flatfile and still produces a lookup field.
Notice the use of the same 'Insert' and 'Post' as if a real table were connected to the Dataset.
----------------
You dispose of TdateTimePicker to enter a date in your database. But what to do if your client is
a web one, created by using the Internet Express technology. I haven't come across an
equivalent of the datetimepicker for internet Express yet. You can, of course, write one (send it
to me, I will be hapy to have it) or you can use instead...
Yes, you've guessed correctly: a local use of our beloved Tclientdataset. You will have the start
(‘From’) and the end (‘Until’) date parameter list for your query by just putting them both on the
Web module and filling them on OnCreateWebModule procedure.The process is exactly the same
as described above, the only difference is that you may prefer filling up all the dates for a year,
or all the months, or whatever works for you. And even one date field in your clientdatasets is
enough. Enter the two parameters for the datefield in your XMLBroker; connect them with
TquerySelectOptions, compile the project, don't forget to write a query with these parameters in
your remote datamodule and enjoy the results: you do have operating datepicking, maybe not
as 'pretty' as the Windows one but fully functional on your Web browser! Thanks again to the
amazing clientdataset.
And maybe you are already eager to continue this journey...


Write a new comment
Some bug or what?..

DiK (Jul 2 2004 1:17PM)
Ha, TClientDataSet could be really beautiful component for briefcase applications and stand-alone
databases, but... I try it with D7 to create the "somewhat-like-a-notebook" application, that can
contain images and it just not work... Images insert into the dataset well during the work of
application, but they just won't be saved to the file... I try many methods, than look around the
Internet & finally on the Dilphi page... Looks like it's a bug & some update is needed...
Respond
TClientDataset.UpdateStatus
Diogenis Fardellas (Jan 17 2003 3:25PM)
I would like to ask anyone that knows any solution to the following:
I have a clientdataset and I insert a new record. For a specific reason, I need to change its
updatestatus from usInserted to usModified. How can I do it?
Respond
The Secret Life of TClientDataSet

Rob Penfold (May 4 2001 9:25PM)
The TClientDataSet is advertised as being the optimum solution

for implementing the brief-case model.
During the process of "trying" to implement this component

in a brief case model architecture I was amazed to discover that
it ONLY supports a maximum of 15 nested tables through a
Master-Detail relationship. It would appear that once you open
up the Master table (ClientDataSet) all its children are
automatically opened as well....well that is if you have under 15.
On the 15th attempt you get an "Operation not applicable" error.
If anyone knows a work around PLEASE SHARE!
Thanks
Respond
RE: The Secret Life of TClientDataSet

Raymond Barlow (Jul 10 2001 8:59AM)
Sorry, I don't have an answer for your situation, but I would be REALLY interested to know
what situation would required a nesting of more than 15 datasets. I pity the user who has to
maintain this kind of master/detail/detail/detail/detail/detail/detail/(you get the idea)
relationship.
Cheers,
Raymond Barlow
Respond
packaging speed of Tquery results for TdataSetProvider

anonymus (Apr 16 2001 6:29PM)
I have recently converted a Ttable/paradox client/serv application to a multi-tier
clientDataSet/midas/Interbase app. When oppenning a particulary large table (select * from... ) I
received a huge performace hit, compaired to using a Ttable, which was comparatively, very fast.
The time delay occured due to middle-tier sever cpu processing, between the Tquery.afteropen
event and the corresponding TdataSetProvider.OnGetData event, suggesting to me that this was
caused by the "packaging up" of the query dataSet. I resolved the problem easily enough by
seting the TclientDataSet.packetRecords to 30, but am still concerned as to why packaging should
take so long (20 sec for packaging 6000recds with 50 fields, where running the query on its own
in interbase, takes only one second).
Any thoughts thankyou ??
Respond
RE: packaging speed of Tquery results for TdataSetProvider

Moisés López (Jul 21 2001 6:39AM)
well basically it takes up whole lots of memory (dont know exactly how, but i know it does,
since it has far more features than a normal table), so you probably are better not stuffing
it.
anyways the beauty of it is that you can handle only a certain amount of data, so if gives
you more flexibility.
now, this sounds like a charm in theory but once you get your hands on doing it, but i tried
with 60,000 records and it works fairly fast :)
one quick solution: use two datasets: a query for using in a grid, read only,and a
clientdataset for modifying that info that is shown in edits and combos... maybe sounds
crappy but it worked like a charm for me..
and a client dataset
Respond
ClientDataSet BUG!!!
AlGol (Jan 4 2001 5:11AM)
try following steps:
cdsTable.LoadFromFile('subitem.cds');
cdsTable.AddIndex('IXNAME','parentitemID;Name',[ixUnique]);
then modify your ClientDataSet data so, that IXNAME inique index is unvalid. Try to post it. First
time the exception (Key violation) is raised. Good.
BUT NEXT TIME IT POSTED!!!
Respond
ApplyUpdates and new Entry

Quinton (Nov 16 2000 12:41AM)
I have problems to add a new entry in the detailed DB it gives me an Key Voilation Error. From
the Server Interface i can add new entries but from the client side only one entry and then i must
exit the client to add new entry in the detailed DB and the same on the master DB.
Respond
Trouble in Win NT
Ismir Kamili (Jun 28 2000 4:47AM)
I`ve tried the solution proposed in the article (The backup system). It run successfully in Win95 /
Win98 Environment, but it crashed when run under Windows NT 4.0.
The message was `Cannot load IDAPI Service Library`. It happened when I assigned the Data
property of Provider to client dataset.
Regards,
IK
Respond
RE: Trouble in Win NT

anonymus (Jun 28 2000 8:22AM)
Have you install the BDE properly on the machine? Have you import the Midas.dll also?
Respond
RE: RE: Trouble in Win NT

Ismir (Jul 4 2000 3:22AM)
Yes, I have installed it properly.

Even in a computer where Delphi is installed on it, it didn`t work.
Respond
Related article
anonymus (Jun 5 2000 6:12PM)
Good article from the Borland Community website:

http://community.borland.com/article/0,1410,20587,00.html
Respond
RE: Related article

Dear anonymous,
these are two absolutely different articles.Even the topics are different.Only the field is
common, but this field is wide enough and there is even some place for you. I think, before
writing comments it could be helpful for you to write these articles!
Respond
RE: RE: Related article

anonymus (Jun 7 2000 9:24PM)
Hence the topic "Related article". duh.

Respond
RE: RE: RE: Related article

yeah duh
Respond
RE: RE: RE: RE: Related article

Richard (Aug 30 2000 2:40AM)
We all contribute to this site to gain knowledge, so grow up

Respond
tListBox Tricks
Undertitle:
Category: VCL-General
Question: How can you add a horizontal Scrollbar to a Listbox ?

How can you move items in a ListBox with Drag and Drop
(which scrolls if you reach the top or the bottom) ?
Answer:
* How can you add a horizontal Scrollbar to a Listbox ?
SendMessage(ListBox.Handle, LB_SETHORIZONTALEXTENT, MaxWidth, 0);
or simply
ListBox.ScrollWidth := MaxWidth;
* How can you determine the Listbox index of the topmost entry or item,
which is displayed at the top of the Listbox ?
TopIndex := SendMessage(ListBox.Handle, LB_GETTOPINDEX, 0, 0);
or simply
ListBox.TopIndex;
* How can you move items in a ListBox with Drag and Drop ?
1. set DragMode on dmAutomatic

2. implement OnDragOver and OnDragDrop Events
procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;

State: TDragState; var Accept: Boolean);
begin
Accept := Sender is TListBox;
end;
procedure TForm1.ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);

var Box : tListBox;
s : string;
TargetIndex : integer;
begin
// delete selected item
// and insert at new position
// determined by ItemAtPos(..)
Box:=TListBox(Source);
s:=Box.Items[Box.ItemIndex];
Box.Items.Delete(Box.ItemIndex);
TargetIndex:=Box.ItemAtPos(Point(x,y),true);
Box.Items.Insert(TargetIndex,s);
Box.ItemIndex:=TargetIndex;
end;
* How can you move items in a ListBox with Drag and Drop,
which scrolls if you reach the top or the bottom ?
procedure TForm1.ListBox1Click(Sender: TObject);

begin
// save source ItemIndex
SourceIndex:=(Sender as TListBox).ItemIndex;
end;
procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;

State: TDragState; var Accept: Boolean);
var
TargetPos : integer;
Box : tListBox;
r : tRect;
begin
Box := Sender as TListBox;
TargetPos := Box.ItemAtPos(Point(x,y),True);
Box.ItemIndex := TargetPos;
r:=Box.ItemRect(TargetPos);
if r.top < Box.ItemHeight then
begin
if TargetPos > 0 then
Box.ItemIndex:=TargetPos-1;
end else
if r.bottom > (Box.Height-Box.ItemHeight) then
begin
if TargetPos < (Box.Items.Count-1) then
Box.ItemIndex:=Box.ItemIndex+1;
end;
if (TargetPos = -1)
then Accept := False
else Accept := True;
end;
procedure TForm1.ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);

var Box : tListBox;
s : string;
TargetIndex : integer;
begin
// delete selected item

// and insert at new position

// determined by ItemAtPos(..)
Box:=TListBox(Source);
s:=Box.Items[SourceIndex];
Box.Items.Delete(SourceIndex);
TargetIndex:=Box.ItemAtPos(Point(x,y),true);
Box.Items.Insert(TargetIndex,s);
Box.ItemIndex:=TargetIndex;
end;

Write a new comment

Using TList's and Pointers in delphi (Part II)

Undertitle:
Uploader: Stewart Moss
Question: This is a nice demonstration of how to create records on a TList object.
It creates and manages a list of Pointers to TMammal record instances.

Answer:
{-----------------------------------------------------------------------------
Unit Name: Unit1
Creation Date: 10-September-2003 22:12:59

Documentation Date: 10-September-2003 22:12:59
Version: 1.0
Keywords: Generic, Tlist, Pointers
Description:
This is a demonstration of how to create records on a TList object.
It creates a list of Pointers to TMammal record instances.
TMammal = record
TType: string;
Hair: string;
speak: string;
end;
Note the Speak element in this record.

In a later demo I will show how to do this with objects stored on a TList.
The TType is either "Human" or "Dog"
Integers but they could be a list of pointers

to any record or class type.
At the end of this is the source for the DFM file used to run this application.
(It just needs to be bound into a project)
Notes:
If there are any terms or concepts in this demo you don't understand please
ask me.
Dependancies:
Compiler version:
History:
Copyright 2003 by Stewart Moss

All rights reserved.
-----------------------------------------------------------------------------}
unit Unit1;
interface
uses
Windows, Messages, sysutils, Variants, classes, Graphics, Controls, forms,
Dialogs, StdCtrls;
type
PMammal = ^TMammal;
TMammal = record
TType: string;
Hair: string;
speak: string;
end;
btnAdd: TButton;
btnDelete: TButton;
ListBox1: TListBox;
Button1: TButton;
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
lblType: TLabel;
Label4: TLabel;
lblSpeak: TLabel;
lblHair: TLabel;
Label7: TLabel;
Button2: TButton;
Label3: TLabel;
lblIndex: TLabel;
Button3: TButton;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure btnAddClick(Sender: TObject);
procedure btnDeleteClick(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
private

MammalList: TList;
function FindMammalByIndex(Index: integer): PMammal;

procedure FreeList;
procedure showlist;
procedure DeleteMammalAtIndex(Index: integer);
procedure ClearGroupBox;
public
function GetRandomHair: string;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}

begin
MammalList := TList.create;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin
FreeList;
MammalList.Free;
end;
procedure TForm1.FreeList;
{-----------------------------------------------------------------------------
Procedure: TForm1.FreeList
Author: Stewart Moss
Date: 20-Jan-2003
This disposes of all the existing items in the list.
** Very important you can't just free the TList object and expect **
** everything else to disappear **
This is optimized to always delete the last item on the list.

It gives the memory manager less work to do!
* tx delphi300.com :)
-----------------------------------------------------------------------------}
var
loop: integer;
tmpcount: integer;
begin
tmpcount := MammalList.Count - 1;
for loop := tmpcount downto 0 do

begin
dispose(MammalList.Items[loop]);
MammalList.Delete(loop);
end;
end;
procedure TForm1.btnAddClick(Sender: TObject);

{-----------------------------------------------------------------------------
Procedure: TForm1.btnAddClick
Arguments: Sender: TObject
Result: None
Date: 10-September-2003 22:19:22
Description:
Creates a new record and stores it in the Pointer Reference "APMammal".
One of the benifits of using objects is you don't have to know how
big the object is to create it.

-----------------------------------------------------------------------------}
var
APMammal: PMammal;
begin
randomize; // hehehe
// Create and assign memory to a new TMammal record and store it's pointer
new(APMammal);
// Now we choose a random dog or human and set the values
with APMammal^ do
begin
case random(2) of
0: // Human
begin
// if it wasn't for "with APMammal^ do" then these
// lines would read.
// APMammal^.TType := 'Human';
// APMammal^.Hair := 'Blonde';
// APMammal^.speak := 'Hello!';
//
// "APMammal^." is called "dereferencing the pointer"
//
// You are basically saying:
// set (or get) the value of the item (eg Hair) at the pointer
// address held in APMammal.
TType := 'Human';
Hair := GetRandomHair;
speak := 'Hello!';
end;
1: // Dog

begin
TType := 'Dog';
Hair := GetRandomHair;
speak := 'Woof Woof!';
end;
end; // case
end; // with
// Now add this pointer to the TList

// This returns the index position of the item (ie where it is added to the list)
// We don't need it.
//
// More correct is
// Indexpos := MammalList.add(APMammal);
MammalList.add(APMammal);
showlist;
end;
procedure TForm1.showlist;
{-----------------------------------------------------------------------------
Procedure: TForm1.showlist
Date: 20-Jan-2003
PInteger(MammalList.Items[loop])^ returns the integer value stored at the

Integer Pointer in the List (de-reference).
Note:
This time I have "type-casted" the generic pointer. I have
prefered not to use a temporary variable called "APMammal" again.
This saves on memory management when accessing more than one property.
An in-efficient (but clearer) method is
var
loop: integer;
APMammal:PMammal;
begin
ListBox1.Items.Clear;
for loop := 0 to MammalList.Count - 1 do
begin
APMammal := PMammal(MammalList.Items[loop])^;
ListBox1.Items.add(IntTostr(loop) + ' -> ' + PMammal(APMamal.TType);
end;
end;
-----------------------------------------------------------------------------}
var
loop: integer;
begin
try // cheap trick to swallow un-wanted exceptions
for loop := 0 to MammalList.Count - 1 do
begin
ListBox1.Items.add(IntTostr(loop) + ' -> ' +
PMammal(MammalList.Items[loop])^.TType);
end; // for
// Select the last item in the TList

ListBox1.ItemIndex := ListBox1.Items.Count - 1;
// Call the Listbox1 click event, to update the groupbox by retreiving the record
// from the list
ListBox1Click(Self);
except // See I don't trap anything here:

// clear the group box
ClearGroupBox;
end; // I have been a bad boy!
end;
procedure TForm1.btnDeleteClick(Sender: TObject);

var
tmpstr: string;
tmpint: integer;
begin
// User has to enter the index of the item to delete (ie remove from the list)
tmpstr := Inputbox('Delete an item out of the list',
'Which item do you want to delete (0=first) ?', '');
if tmpstr = '' then

Exit;
try
tmpint := StrToInt(Trim(tmpstr));
except
raise exception.create(tmpstr + ' is not an integer!');
end;
// Now delete it
DeleteMammalAtIndex(tmpint);
showlist;
// showmessage('Deleted Item Index ' + IntTostr(Index));

end;

begin
showlist;
end;
function TForm1.FindMammalByIndex(Index: integer): PMammal;

(*-----------------------------------------------------------------------------

Procedure: TForm1.FindMammalByIndex
Arguments: Index: integer
Date: 10-September-2003 22:41:35
Description:
This returns the TMammal record stored at position Index
in the TList.
It traps any exceptions caused by selecting records out of range.

-----------------------------------------------------------------------------*)
begin
// Turn on the range exception
{R+}
try
result := PMammal(MammalList.Items[Index]);
except
on e: ERangeError do
begin
raise exception.create('Cannot retrieve record at position ' + IntTostr(Index));
end;
end;
{$R-}
end;
procedure TForm1.ListBox1Click(Sender: TObject);

var
APMammal: PMammal;
begin
// Find the currently selected Index in the Listbox.

// And use this to point to the TList
APMammal := FindMammalByIndex(ListBox1.ItemIndex);
with APMammal^ do
begin
lblType.caption := TType;
lblHair.caption := Hair;
lblSpeak.caption := speak;
lblIndex.caption := IntTostr(ListBox1.ItemIndex);
end; // with
end;
function TForm1.GetRandomHair: string;
begin
case random(5) of
0: result := 'Blonde';
1: result := 'Brown';
2: result := 'Blue';
3: result := 'Black';
4: result := 'Red';
end; // case
end;

begin
Close;
end;
procedure TForm1.DeleteMammalAtIndex(Index: integer);

begin
if Index > MammalList.Count - 1 then
raise exception.create('Number too high!');
dispose(MammalList.Items[Index]); // Free it's memory

MammalList.Delete(Index); // and remove from list
end;

begin
try
DeleteMammalAtIndex(ListBox1.ItemIndex);
showlist;
except
// clear the group box
ClearGroupBox;
end;
end;
procedure TForm1.ClearGroupBox;
begin
lblType.caption := '<none>';
lblHair.caption := '<none>';
lblSpeak.caption := '<none>';
lblIndex.caption := '<none>';
end;
end.
{
{
Unit1.DFM
----------
object Form1: TForm1

Left = 168
Top = 106
Width = 284
Height = 412
Caption = 'Stewart Moss TList Example II'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText

Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 24
Top = 12
Width = 193
Height = 13
Caption = 'Nice and dirty record TList demonstration'
end
object btnAdd: TButton
Left = 24
Top = 61
Width = 75
Height = 25
Caption = 'Add'
TabOrder = 0
OnClick = btnAddClick
end
object btnDelete: TButton
Left = 104
Top = 31
Width = 75
Height = 25
Caption = 'Delete Prompt'
TabOrder = 1
OnClick = btnDeleteClick
end
object ListBox1: TListBox
Left = 28
Top = 92
Width = 217
Height = 109
ItemHeight = 13
TabOrder = 2
OnClick = ListBox1Click
end
object Button1: TButton
Left = 184
Top = 61
Width = 75
Height = 25
Caption = 'Refresh'
TabOrder = 3
OnClick = Button1Click
end
object GroupBox1: TGroupBox
Left = 24
Top = 208
Width = 221
Height = 137
Caption = ' Object Properties '
TabOrder = 4
Left = 53
Top = 50
Width = 24
Height = 13
Caption = 'Type'
end
object lblType: TLabel
Left = 105
Top = 50
Width = 36
Height = 13
Caption = '<none>'
end
Left = 50
Top = 74
Width = 31
Height = 13
Caption = 'Speak'
end
object lblSpeak: TLabel
Left = 105
Top = 74
Width = 36
Height = 13
Caption = '<none>'
end
object lblHair: TLabel
Left = 105
Top = 98
Width = 36
Height = 13
Caption = '<none>'
end
Left = 39
Top = 98
Width = 52
Height = 13
Caption = 'Hair Colour'
end
Left = 52
Top = 26
Width = 26
Height = 13
Caption = 'Index'
end
object lblIndex: TLabel
Left = 105

Top = 26
Width = 36
Height = 13
Caption = '<none>'
end
end
Left = 196
Top = 352
Width = 75
Height = 25
Caption = 'E&xit'
TabOrder = 5
end
Left = 105
Top = 61
Width = 75
Height = 25
Caption = 'Delete'
TabOrder = 6
end
end


Write a new comment

Using TList's and Pointers in delphi

Undertitle:
Uploader: Stewart Moss
Question: This was a small demonstration to teach a friend how to use the TList helper object.
Also gives you an idea on how to use pointers.
It creates a list of Pointers to Integers but they could be a list of pointers to any record or class type.
Answer:
{-----------------------------------------------------------------------------
Unit Name: Unit1
Author: StewartM (Stewart Moss)
Creation Date: 20, 01, 2003 (13:02,)

Documentation Date: 20, 01, 2003 (13:02,)
Version 1.0
-----------------------------------------------------------------------------
Compiler Directives:
Purpose:
Dependancies:
Description:
This was written by Stewart Moss

This was a small demonstration to teach a friend how to use the TList helper
object.
Also gives you an idea on how to use pointers.
It creates a list of Pointers to Integers but they could be a list of pointers

to any record or class type.
At the end of this is the source for the DFM file used to run this application.
(It just needs to be bound into a project)
Notes:
History:
Copyright 2003 by Stewart Moss. All rights reserved.

-----------------------------------------------------------------------------}
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
PInteger = ^Integer;
btnAdd: TButton;
btnDelete: TButton;
ListBox1: TListBox;
Button1: TButton;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure btnAddClick(Sender: TObject);
procedure btnDeleteClick(Sender: TObject);
procedure CustomizeDlg1Close(Sender: TObject);
procedure acnTestExecute(Sender: TObject);
private
TempList: TList;
procedure FreeList;
procedure showlist;
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}

begin
TempList := TList.Create;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

FreeList;
TempList.Free;
end;
{-----------------------------------------------------------------------------
Procedure: TForm1.FreeList
Date: 20-Jan-2003
This disposes of all the existing items in the list.
Remember by Deleting the first element in the list, you are shifting the
list up and you are also reducing the TempList.count..
** Very important you can't just free the TList object and expect **
** everything else to disappear **
-----------------------------------------------------------------------------}
var
loop: Integer;
tmpcount : Integer;
begin
tmpcount := templist.Count -1;
for loop := 0 to tmpcount do

begin
dispose(TempList.Items[0]);
TempList.Delete(0);
end;
end;
procedure TForm1.btnAddClick(Sender: TObject);

var
tmpint: Integer;
AInteger: PInteger;
begin
Randomize;
tmpint := Random(1000);
// Create and assign memory to a new Integer and store it's pointer
// in AInteger
new(AInteger);
// Now take tmpint and store it at the memory address referenced by the pointer
// AInteger
AInteger^ := tmpint;
// Now add this pointer to the TList

// This returns the index position of the item (ie where it is added to the list)
TempList.Add(AInteger);
showlist;
end;
procedure TForm1.showlist;
{-----------------------------------------------------------------------------
Procedure: TForm1.showlist
Date: 20-Jan-2003
PInteger(templist.Items[loop])^ returns the integer value stored at the

Integer Pointer in the List (de-reference)
-----------------------------------------------------------------------------}
var
loop: Integer;
begin
for loop := 0 to TempList.Count - 1 do
begin
ListBox1.Items.Add(IntToStr(loop) + ' -> ' + IntToStr(PInteger(TempList.Items[loop])^));
end; // for
end;
procedure TForm1.btnDeleteClick(Sender: TObject);

var
tmpstr: string;
tmpint, tmpint2: Integer;
begin
// User has to enter the index of the item to delete (ie remove from the list)
tmpstr := Inputbox('Delete an item out of the list', 'Which item do you want to delete (0=first) ?', '');
if tmpstr = '' then

Exit;
try
tmpint := StrToInt(trim(tmpstr));
except
raise Exception.Create(tmpstr + ' is not an integer!');
end;
if tmpint > TempList.Count - 1 then

raise Exception.Create('Number too high!');
tmpint2 := Integer(TempList.Items[tmpint]^);
dispose(TempList.Items[tmpint]);
TempList.Delete(tmpint);
ShowMessage('Deleted Item Index ' + IntToStr(tmpint) + ' Value ' + IntToStr(tmpint2));
showlist;
end;

begin
showlist;
end;

end.
end.
end.
(*
UNIT11.DFM
----------
object Form1: TForm1

Left = 250
Top = 221
Width = 277
Height = 401
Caption = 'Stewart Moss TList Example'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object btnAdd: TButton
Left = 24
Top = 48
Width = 75
Height = 25
Caption = 'Add'
TabOrder = 0
OnClick = btnAddClick
end
object btnDelete: TButton
Left = 104
Top = 48
Width = 75
Height = 25
Caption = 'Delete'
TabOrder = 1
OnClick = btnDeleteClick
end
object ListBox1: TListBox
Left = 28
Top = 92
Width = 185
Height = 233
ItemHeight = 13
TabOrder = 2
end
Left = 184
Top = 48
Width = 75
Height = 25
Caption = 'Refresh'
TabOrder = 3
end
end
*)


Write a new comment
better FreeList procedure

Richard Winston (Jun 27 2003 3:54PM)
A better version of TForm1.FreeList is given below. It is better than the original one because it does not
require all the items in the list to be moved up one position in the list when that item is removed. For
large lists, the time required to move all the items can be significant.
var
loop: Integer;
begin
for loop := templist.Count -1 downto 0 do
begin
dispose(TempList.Items[0]);
end;
TempList.Clear
end;
Respond
RE: better FreeList procedure

Stewart Moss (Jun 29 2003 5:48PM)
Thank you very much for your tip!
I guess I have some classes to change now!!!
hehehe

Respond
PInteger
Martin Strand (Jun 22 2003 8:02PM)
You doesn't need to declare PInteger, since it already is declared within some Delphi unit. The declaration
is the same, though.
Respond
RE: PInteger
Stewart Moss (Jun 23 2003 6:30PM)
The declaration of PInteger was to show that you can use a pointer to anything. I will be sumitting a
more complicated example shortly to demonstrate how to use pointers of other types (ie Records)
Respond

Using XML as a data storage format

Undertitle: Convert Pascal objects to XML text and vice versa
Category: XML
Uploader: Sergey Kucherov
Question: Does it make sense to use XML in local applications?

Answer: Introduction
Evolution of the web industry leads developers through sophisticated technologies waving
and balancing between client-oriented and server-oriented approaches. New standards for
browsers, protocols, and scripting languages replace each other. The next step is XML -
extended markup language, which suppose to replace HTML and dominate in web
applications as main communication format. XML has been designed to transfer data to
clients separately from data's format. Web server or Internet client should combine XML data
with a style sheet and generate well-known HTML code to display the data.
On the other hand you may use XML language to extend functionality of your programs.
Consider XML as a universal data storage format, which as a matter of fact much more
flexible than DBF or any other relational database format.
Why should you use XML as the only advanced way to create web pages? XML is more
universal and more flexible than just only markup language. You may even create your own
data format or network protocol by inventing your own tags and interface.
Below you will find one example of such non-standard XML usage, designed for use in
Borland Delphi applications.
Analysis
Your program needs to store some data in a file or transfer the data to another computer.
You can save your data in text or any proprietary format. You will need to write code to
support such format. Should you change data structure, you will face necessity to modify the
code. In any case you should not consider this format as a standard one, and other
developers probably will not support the format.
Use XML as base for your data storage and transfer and you will gain the following
advantages:
* Established and supported syntax standards;

* Common program interface for reading and writing XML text;
* Flexible data structure;
* Web enabled technology;
Using XML as a data format has some disadvantages too:
* Unlike usual database, XML text does not have fixed structure.
In most cases whole XML text stored in memory, so it should
be relatively small files;
* There are no built-in security in XML, so you have to encrypt

and decrypt XML files;
* XML is text format so you have to convert all fields to text

type before storing in text;
The most optimal and convenient way to implement this protocol in Delphi is to design an
interface between Pascal objects and XML code. The goal is to store instances of Pascal
classes in XML format with ability to restore the instances from the XML text.
It is a good idea to split "Pascal Object - XML" interface into two interfaces: "Pascal Object -
Data object" and "Data object - XML" (see figure 1).
I do not see a dainty solution to extend any Pascal class with XML interface. Instead, let's
create a new class to store and manage properties and data fields of an object. A developer
will need to write additional code to move data between Pascal object and data object.
Figure 1. XML data interfaces
Design
Our task is to implement two independent interfaces: "Pascal Object - Data Object" and "Data
Object - XML".
First interface will enable a developer to replicate data structure of an instance of any class
and instance of the SPO class. "SPO" stands for Standard Pascal Object. SPO class will
provide data container and set of methods to store and retrieve data.
Second interface will be implemented as a set of routines to convert SPO object to XML text
and visa versa.
Design of SPO interface
The main purpose of the SPO class is to store and provide access to a data fields and
properties. Because of that, it is much more important to create a convenient data access
interface, than to optimize data storage method. After all, we will be able to change data
storage method later without affecting the interface.
First of all let's define the data types, supported by our interface. We will consider only five
data types in our model:
* String
* Numeric
* Date
* Boolean
* Object
The data type "object" allows us to build complex data structure by nesting one object to
another. On figure 2 you may see an example of data object structure:
Figure 2 Data object model

To access data in our object we can use traditional method - to get property of main project,
retrieve object from the property, then get the property of the retrieved object, etc:
var
O: TspoObject;
P: TspoProperty;
S: string;
begin
P := AnObject.PropByName['Career position'];
O := P.TheObject;
S := P.PropByName['Title'].Value;
end;
The same long sequence will be necessary to add new property to an object. To simplify
access to nested objects and properties we will use path-style resource locator string. For
example to get value of the "Start date" field you will use the following syntax:
AnObject['Career position/Start date'] := Now;
To create the object on figure 2 we can use only six lines of code:
with AnObject do begin

AddItem('First name','John');
AddItem('Last name','Smith');
AddItem('Date of birth',EncodeDate(1964,7,23));
AddItem('Career position',NULL,xtObject);
AddItem('Career position/Start date',EncodeDate(1998,9,1));
AddItem('Career position/Title','Director');
end;
Using collections
Sometimes you need to store several objects inside one property. You may index this
collection of objects by a number or by keyword. To create a collection in object property
you have to create an object and then add as many properties as you wish:
with AnObject do begin

AddItem('List',NULL,xtObject);
for i:=1 to 10 do begin
AddItem('List/'+intToStr(i),'Item'+IntToStr(i));
end;
end;
Design of XML interface

Now we are ready to design an interface to store our SPO in XML text (string). Because XML
code is just a sequence of tags, we will design separate routine to format XML string as a
XML text with indents. The XML dictionary will be quite simple. To store an object in XML text
let's use keyword "object":
<object></object>
Object will contain only properties and methods:
<object> 
<property></property> 
<property></property> 
<method></method> 
</object>
Each property must contain a name, type and value. It can also include default value, and
scope:
<property> 
<type>string</type> 
<name>First name</name> 
<value>Smith</value><br<
</property>
The full list of used tags will looks like:
* Object
* Property
* Scope
* Type
* Name
* DefaultValue
* Value
* Param
* Method
Construction
There are two units. First unit - CPOM.PAS contains classes to create in-memory data
objects: TspoObject, TspoProperty, and TspoMethod. Second unit - CxmlInterface.pas
contains routines to convert TspoObject to XML text and vice versa.
You may download these units here.
The development is still in process and I will be happy to hear any comments.

Write a new comment
Website gone?
Peter Snoek (Oct 25 2001 11:49PM)
Hi there...
thanks for the article, it's very good. I only can't go to the website of the author anymore... Is it gone
forever?
Peter
Respond
RE: delphi bible?

zlst zlst (Mar 30 2004 10:35AM)
Delphi Bible includes a serials of application sources code that from general to advance
applications,also contains some developers develop experiences and tips.
http://www.qwerks.com/product.asp?ProductID=6874
Respond
missing file
Johannes Grabsch (Dec 20 2000 7:04AM)
In Article
http://www.delphi3000.com/articles/article_515.asp
a file xmllib10.zip is mentioned, but the offered link is dead
Where can I find this file?
thanks
Johannes
Respond
RE: missing file

Sergey Kucherov (Feb 13 2001 6:08PM)
Please, find latest updates at my web site:

skch.net
Sincerely
Respond
Superb article
Thierry Coq (Nov 16 2000 5:16AM)
I've tried many ways to store objects painlessly.
One very good way is to use the persistent mechanism of Delphi
.However, there is a drawback : it isn't a recognised standard.
When will Inprise use XML to store objects and forms ?
Respond
RE: Superb article

Kristofer Skaug (Feb 12 2001 5:45PM)
Borland already has started using XML in support of their IDE... for example in C++ Builder 5, the
project options (e.g. compiler settings etc) file is now stored in XML format. (I believe the equivalent
Delphi file is the .DOF file).
Respond
Your Article
Subbu Balakrishnan (Sep 22 2000 7:05PM)
We are using a similar approach with the VB-ASP-IIS-MTS/COM+ reengineering of our product. Since VB
does not provide multithreading, we had to develop our 'ObjectAsXML' helper DLL in C++. Would have
liked to use Delphi but then we are a MS shop :(
Very good article and I hope to use the concept in my own private Delphi projects when appropriate.
Keep 'em coming :)
Respond

Using XML as a data storage format
Selva Saravana Bala Magesh (Jul 28 2000 10:45AM)
It`s really interesting. Thanx for the article. Do write more on this.
Respond
There are more on my site

Sergey Kucherov (Jul 1 2000 2:38AM)
You can find the updated version of the article on my web site:
http://www.skch.net
Respond
RE: There are more on my site

Misson (Jul 27 2000 4:10AM)
Sorry but wrong URL New in Delphi, can you give some short example how to use your 2 units, try
but something is going wrong Thanks a lot
Respond
a couple of improvements...
saj (Jun 30 2000 6:55PM)
[1] In XML empty tags need special syntax (e.g. should be ).
[2] the <object> element could use a sub-element like <class> to indicate object type
Respond
It is looks good
Vlad (Jun 2 2000 4:15PM)
I hope you will continue the posting following article in this topic
Thanks
Respond
Very interesting...
anonymus (May 14 2000 12:07AM)
This would be very interesting to look deeper into. Any more who can shed more light on this subject?
Respond
Excellent Article
(Mar 4 2000 5:18PM)
This is really an excellent article, hope that there will be posted further articles about XML on delphi3000
soon!
Respond

Delegation, Events and Methods

Undertitle:
Question: How do you delegate actions and operations in Delphi ?

How do you use a stand-alone procedure as an event handler ?
Answer: The basic types of reuse mechanisms are
(see Gamma, Helm, Johnson and Vlissides,
"Design Patterns",
Addision-Wesley, 1995)
Inheritance :
reuse by subclassing, lets you define the
implementation of one class in terms of another's
Aggregation (or Composition):
reuse by assembling or composing objects to get
more complex functionality
Delegation :
reuse by connecting methods : a object that
receives a request, delegates operations to
another object
(special kind of composition, two or more objects
are involved to produce a behavior)
The difference between inheritance and delegation

is the same as between to "be" and to "have",
for instance a rectangular windows-class "is" a
subclass of a general window, or a window can
"have" access to a class that knows how to
draw a rectangular window.
Delegation is used for example in the "State"

and "Strategy" design patterns, which change
the behavior of an object by changing the
objects to which it delegates requests.
In delphi, inheritance is a feature of the

language, and its obvious how to compose
objects. How does delegation work in delphi ?
Delegation within a class is done by defining
objects for a state or a strategy (see "State"
and "Stategy" design pattern).
Delegation between different classes is done by
method pointers, variables that point to methods.
I want to show this by an example :

Let us suppose that you want to display the
progress of a calculation in a progress-form.
To do this, you can use messages or method pointers.
Using messages, you can send messages with
SendMessage(ProgressForm.Handle,WM_ProgressMsg,Progress,0);
The progress-form can receive this message and

respond to it with WndProc or own procedures like
procedure WMProgress(var msg : TMessage); message WM_Progress;
This is the "windows-way". The "delphi-way"

is to use method pointers : Delphi uses them to
manage and to hide the processing of messages :
if a window-message like WM_Activate is received,
the corresponding event OnActivate is triggered.
An event encapsulates the response for a certain message,
and is implemented by a method pointer.
Instead of using SendMessage, we can define a

"ProgressMessage" event with a method pointer :
TProgressMsg = procedure(Msg : string;Progress : integer) of object;
constructor TProgressForm.Create(LCID : integer;CompressClass : TCompressClass);

begin
inherited create(nil);
fCompressClass:=CompressClass;
fCompressClass.ProgressMsg:=ProgressMsg;
...
end;
Now we can delegate the process of displaying

the progress to the progress-form :
procedure TCompressClass.SendProgressMsg(Msg: string;Progress: integer);

begin
if Assigned(fProgressMsg) then
fProgressMsg(Msg,Progress);
end;
The calling class knows, *when* the action is

triggered, the class that rents the method knows
exactly *what* to do in this case.
procedure TProgressForm.ProgressMsg(Msg : string;Progress : integer);

var s : string;
k : integer;
begin
StepLabel.Caption:=Format(sProgress+' %s',[IntToStr(Progress)])+'%';
StepLabel.Refresh;
end;

...
Delegating or Event handling is done with

Method Pointers. They allow you to change and
to extend an object's >> behavior << simply by
assigning new methods to the pointers.
With method pointers, actions can be delegated
to other classes.
(-> Events page of the Object-Inspector)
Properties allow to change an object's

>> state << by assigning new values to
the properties.
(-> Properties page of the Object-Inspector)
Normal properties encapsulate elementary

blocks of states (access to object-data),
"event properties" encapsulate elementary
blocks of behavior (access to message-handling).
All method variables, including the event

properties, are defined in the unit System
(former in SysUtils) as follows :
TMethod = record
Code, Data: Pointer;
end;
If you know that, you can do tricks like

accessing methods by the method-name with
(see Artikel 2644)
Method.Code := Class.MethodAddress(MethodName);
or using a Stand-alone procedure as an event handler

Normally an event handler for the OnClick event would
look like this :
procedure TForm1.ClassProc(Sender: TObject);

begin
...
end;
Because a Stand-alone procedure has no relation

to a certain class, we have to add an additional
Data parameter of type pointer (for methods, the
first parameter is always Self (passed in EAX),
and the first parameter explicitly declared is
in fact the second parameter (passed in EDX)):
procedure StandAloneProc(Data: Pointer; Sender: TObject);

begin
...
end;

var
Event: TNotifyEvent;
begin
TMethod(Event).Code := @StandAloneProc;
TMethod(Event).Data := nil; // or Button1
Button1.OnClick := Event;
end;


Write a new comment

Delphi3000 Articles

Uploaded by

Copyright:

Available Formats

Delphi3000 Articles

Uploaded by

Document Information

Copyright

Available Formats

Share this document

Share or Embed Document

Sharing Options

Did you find this document useful?

Is this content inappropriate?

Copyright:

Available Formats

Delphi3000 Articles

Uploaded by

Copyright:

Available Formats

delphi3000.

com - Printing Articles Page 1

Custom statusbar to show hints without any coding

http://www.delphi3000.com/printarticle.asp?ArticleID=2946 08/11/2007 17:20:06

function TAbout.GetAttributes: TPropertyAttributes ;

http://www.delphi3000.com/printarticle.asp?ArticleID=2946 08/11/2007 17:20:06

Result:= [paMultiSelect, paDialog, paReadOnly] ;

function TAbout.GetValue: string ;

constructor TSmartStatusBar.Create(AOwner: TComponent) ;

{ Allow controls to be placed onto this component }

procedure TSmartStatusBar.SetShowAppHint(b : boolean) ;

procedure TSmartStatusBar.DispAppHint(Sender : TObject) ;

http://www.delphi3000.com/printarticle.asp?ArticleID=2946 08/11/2007 17:20:06

Make sure to read the comments below on "AutoHint"

Copyright 2000 delphi3000.com

Comments to this article

http://www.delphi3000.com/printarticle.asp?ArticleID=2946 08/11/2007 17:20:06

Write a new comment

RE: statusbar's autohint

<%If Session("sSecurityLevel") >= 2 Then%> Delete this Comment!<%End If%>

http://www.delphi3000.com/printarticle.asp?ArticleID=2946 08/11/2007 17:20:06

Download EDBImage in here (http://delphi.icm.edu.pl/)

EDBImage works like TDBImage except :

http://www.delphi3000.com/printarticle.asp?ArticleID=4426 08/11/2007 17:39:30

procedure TForm1.EDBImage1LoadCustomImage(var B: TGraphic;

function JpegStartsInBlob (Stream : TStream):integer;

procedure TForm1.EDBImage1LoadCustomImage(var B: TGraphic;

http://www.delphi3000.com/printarticle.asp?ArticleID=4426 08/11/2007 17:39:30

Comments to this article

missed some references...

<%If Session("sSecurityLevel") >= 2 Then%> Delete this Comment!<%End If%>

missed some references?

<%If Session("sSecurityLevel") >= 2 Then%> Delete this Comment!<%End If%>

http://www.delphi3000.com/printarticle.asp?ArticleID=4426 08/11/2007 17:39:30

Question: How can I elegantly traverse a list?

In order to demonstrate the iterator pattern, I designed the following classes:

while not Iter.IsDone do begin

http://www.delphi3000.com/printarticle.asp?ArticleID=592 04/12/2007 23:14:05

constructor TMyListIterator.Create(List: TMyList);

function TMyListIterator.IsDone: boolean;

function TMyListIterator.CurrentItem: TMyItem;

procedure TMyList.Add(Item: TMyItem);

http://www.delphi3000.com/printarticle.asp?ArticleID=592 04/12/2007 23:14:05

procedure TMyList.Delete(const Index: integer);

function TMyList.GetCount: integer;

function TMyList.GetItem(Index: integer): TMyItem;

procedure TMyList.SetItem(Index: integer; const Value: TMyItem);

procedure TMyList.Iterator(var Iter: TMyListIterator);

procedure TForm1.Button1Click(Sender: TObject);

procedure TForm1.Button2Click(Sender: TObject);

while not Iter.IsDone do begin

Comments to this article

http://www.delphi3000.com/printarticle.asp?ArticleID=592 04/12/2007 23:14:05

Solve MemLeak with Interface

<%If Session("sSecurityLevel") >= 2 Then%> Delete this Comment!<%End If%>

Memory leak in example code

procedure TForm1.Button2Click(Sender: TObject);

while not Iter.IsDone do begin

<%If Session("sSecurityLevel") >= 2 Then%> Delete this Comment!<%End If%>

http://www.delphi3000.com/printarticle.asp?ArticleID=592 04/12/2007 23:14:05