Getting the MaxLen parameter to use with MinimizeName - delphi

I am trying to put a very long filename on a TLabel using the MinimizeName function from Vcl.FileCtrl unit but I can't figure out how to get the MaxLen parameter used by the function
If I hardcode a value I can see a valid result. But since the form can be resized I would like it to be dynamic = changing on resize event.
Some of the things I have tried is
lblLicenseFile.Width // string is too long
lblLicenseFile.Width - 10 //string is too long
Trunc(lblLicenseFile.Width / lblLicenseFile.Font.Size) // string is very short
There must be some method of calculating this number of pixels
MinimizeName(const Filename: TFileName; Canvas: TCanvas; MaxLen: Integer): TFileName;
MaxLen is the lenght, in pixels, available for drawing the file name on the canvas.

To let the label control automatically shorten path, you can set the AutoSize property to False and the EllipsisPosition property to epPathEllipsis if you're using a recent version of Delphi.

To get rid of dependencies of form resizing, resize could also happen if you using e.g. splitters, you can override the CanResize Event to adapt your caption.
as example:
unit Unit3;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TLabel = Class(StdCtrls.TLabel)
private
FFullCaption: String;
procedure SetFullname(const Value: String);
published
function CanResize(var NewWidth, NewHeight: Integer): Boolean; override;
property FullCaption: String read FFullCaption Write SetFullname;
End;
TForm3 = class(TForm)
FileNameLabel: TLabel;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form3: TForm3;
implementation
uses FileCtrl;
{$R *.dfm}
procedure TForm3.Button1Click(Sender: TObject);
begin
FileNameLabel.FullCaption := 'C:\ADirectory\ASubDirectory\ASubSubDirectory\AFileN.ame'
end;
{ TLabel }
function TLabel.CanResize(var NewWidth, NewHeight: Integer): Boolean;
begin
inherited;
if Assigned(Parent) then
Caption := MinimizeName(FFullCaption, Canvas, NewWidth)
end;
procedure TLabel.SetFullname(const Value: String);
begin
FFullCaption := Value;
Caption := MinimizeName(FFullCaption, Canvas, Width)
end;
end.

Related

Why is no output displayed?

I started learning classes and objects programming today. There is code in the handbook that I must copy to run and save. I need to create a class(TLine) and use that class for instantiating an object.
Problem : No output is displayed in my RichEdit component. I copied the code exactly from the book to delphi, but no output is displayed.
How the output should look: "**********"
My class:
unit Lines_U;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
Type
TLine = Class
Public
fSize : integer;
fPattern : char;
public
Constructor Create;
Procedure Draw(Var line: string);
end;
implementation
{ TLine }
Constructor TLine.Create;
begin
fSize := 10;
fPattern := '*';
end;
Procedure TLine.Draw(Var line: string);
Var
loop : integer;
begin
for loop := 1 to fSize do
begin
line := line + fPattern;
end;
end;
end.
Code for instantiating the Object of the TLine Class:
unit UseLine_U;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Lines_U, StdCtrls, ComCtrls;
type
TForm1 = class(TForm)
redOut: TRichEdit;
Procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
line : TLine;
implementation
{$R *.dfm}
Procedure TForm1.FormCreate(Sender: TObject);
Var tempLine : string;
begin
line := TLine.Create;
line.Draw(tempLine);
redOut.Lines.Add(tempLine);
end;
end.
The reason your code is not running is that your event handler Form1.FormCreate is not linked to the OnCreate event. Restore the link in the object inspector.
About event handlers
Never write event handlers (all those procedures starting with On...) manually. Always use the Object inspector to create them.
If you double click on an event, Delphi will create a code template for you that you can fill with data.
Make sure your event handlers are filled in the object inspector. If not they will not work (as you've seen).
If you want to remove an event handler do not remove it in the object inspector, but reduce the code inside the event handling procedure back to the empty template.
Delphi will see that it is empty and remove it on the next compile.
About your code
Other than the missing link there is nothing wrong with your code. It runs just fine.
There are a few style issues though, these have no bearing on the operation, but are important none the less.
Here's how I would rewrite your code.
unit Lines_U;
interface
//only import units that you actually use.
type //please type reserved words in all lowercase, this is Pascal not VB.
TLine = class
private //make data members private.
fSize : integer;
fPattern : char;
public
constructor Create;
procedure Draw(var line: string);
property Size: integer read fSize write fSize; //Use properties to expose data members.
property Pattern: char read fPattern write fPattern;
end;
implementation
{ TLine }
constructor TLine.Create;
begin
inherited; //make the inherited call in your constructor explicit.
fSize := 10;
fPattern := '*';
end;
procedure TLine.Draw(var line: string);
//var
//loop : integer; //use consistent indentation
begin
//Changing a string ten times in a row is inefficient.
//try to do your changes all at once.
//for loop := 1 to fSize do begin
// line := line + fPattern;
//end;
Line:= Line + StringOfChar(fPattern, fSize);
end;
end.
Your form:
unit UseLine_U;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, Lines_U;
//put your own unit last, to prevent name clashes with built in classes and functions.
type
TForm1 = class(TForm)
//note that the {nothing} line is really **published**.
//And data members should be private
//Line : TLine; //Line should be private.
RedOut: TRichEdit;
procedure FormCreate(Sender: TObject);
private
//Prefix all private data with `F` for Field.
FLine: TLine; //Line should be a item in the form, not a global var.
public
property Line: TLine read FLine; //read only access to line.
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var
tempLine : string;
i: integer;
begin
//tempLine:= ''; //local variables should be initialized.
//However strings are always initialized to '', because they are managed types.
//everything else will contain random data unless you fill it!
FLine := TLine.Create;
Line.Draw(tempLine);
i:= 0; //init i, otherwise it will be random!
while i < 5 do begin //always use `begin-end` in loops, never a naked `do`
RedOut.Lines.Add(tempLine);
i:= i + 1;
end; {while} //I like to annotate my loop `end`s, but that's just me.
FreeAndNil(FLine); //Dispose of TLine when you're done with it.
end;
end.
I can think of other things, but I don't want to overload you.

Some Delphi errors

I try to make class Ball which should be in Unit and then I need to draw Ball on form with using Canvas. Actually I never trying OOP in Delphi before (all I rember is simple exercises in school in Pascal) so I got many problems. Oh.
So, here the code
unit with Ball class
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
MyPoint = record
x, y: integer;
end;
Ball = class
Pos:MyPoint;
Vel:MyPoint;
Rad:integer;
Can:TCanvas;
procedure BallCreate(crd, spd:MyPoint; Sender: TObject);
procedure BallDraw(Sender: TObject);
procedure BallMove();
private
{ Private declarations }
public
{ Public declarations }
end;
var
posX, posY, speedX, speedY, radius:Integer;
implementation
procedure Ball.BallMove;
begin
if((posX + radius > 700) or (posX - radius < 0)) then speedX:= (-speedX);
if((posY + radius > 500) or (posY - radius < 0)) then speedY:= (-speedY);
posX:=posX+speedX;
posY:=posY+speedY;
end;
procedure Ball.BallCreate(crd, spd:MyPoint; Sender: TObject);
begin
Vel.x:=3;
Vel.y:=3;
pos.X:=crd.x;
pos.Y:=crd.y;
radius:=30;
end;
procedure Ball.BallDraw(Sender: TObject);
begin
with Can do
begin
brush.Style:=bsSolid;
brush.Color:=clRed;
ellipse((pos.X-radius),(pos.Y-radius),(pos.X+radius),(pos.Y+radius));
end;
end;
end.
unit with Form
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Unit2;
type
TForm1 = class(TForm)
Timer1: TTimer;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
x1,y1,x2,y2,x,y:integer;
posX, posY, speedX, speedY, radius:Integer;
f:boolean;
obj:Ball;
p:MyPoint;
s:MyPoint;
implementation
{$R *.dfm}
{procedure TForm1.BallMove;
begin
if((posX + radius > ClientWidth) or (posX - radius < 0)) then speedX:= (-speedX);
if((posY + radius > ClientHeight) or (posY - radius < 0)) then speedY:= (-speedY);
posX:=posX+speedX;
posY:=posY+speedY;
end; }
procedure TForm1.FormCreate(Sender: TObject);
begin
Timer1.Enabled:=false;
Timer1.Interval:=5;
p.x:= Round(ClientWidth/2);
p.y:= Round(ClientHeight/2);
s.y:=3;
s.x:=s.y;
obj.BallCreate(p,s,Sender);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if not f then
begin
Timer1.Enabled:=true;
Button1.Caption:='Ñòîï';
f:=not f;
end
else
begin
Timer1.Enabled:=false;
Button1.Caption:='Ïóñê';
f:=not f;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
obj.BallDraw(Sender);
obj.BallMove;
end;
end.
When I try to Run it it says that
raised exception class EAccessViolation with message 'Access violation at address 0044DE7B in module Project1.exe. Write of address 000000C'
and in the code those strokes are highlighted red
Vel.x:=3;
and
with Can do
I don't understand whats wrong and how i sholud declare and use Canvas here properly. Maybe you've got some examples with OOP stuff in units with Canvas in Delphi?
You declared a Can:TCanvas; variable but it's not created anywhere.
You can use the Main form canvas, for that you should pass it to Ball for exmaple in the Ball constructor like:
TBall = class
...
public
constructor Create(crd, spd:MyPoint; ACanvas:TCanvas);
....
implementation
...
constructor TBall.Create(crd, spd:MyPoint; ACanvas:TCanvas);
begin
Can := ACavas;
...
Then, you are not properly creating and instance of Ball:
obj.BallCreate(p,s,Sender);
to create an instance you have to call the class constructor like
obj := TBall.Create(crd, spd, Self.Canvas);
By the way the "T" before Ball is just a convention to name a class in Delphi

Delphi throbber

What is the best solution to show that the application is doing something?
I tried showing a progress indicator, but it did not work.
UPDATE: -------------
A progress bar works fine, but isn't what I want.
I want to show a throbber, like what Web browsers use, so as long as something is being updated it keeps turning.
Cursor can also be in crHourGlass mode.
Try this:
AnimateUnit
unit AnimateUnit;
interface
uses
Windows, Classes;
type
TFrameProc = procedure(const theFrame: ShortInt) of object;
TFrameThread = class(TThread)
private
{ Private declarations }
FFrameProc: TFrameProc;
FFrameValue: ShortInt;
procedure SynchedFrame();
protected
{ Protected declarations }
procedure Frame(const theFrame: ShortInt); virtual;
public
{ Public declarations }
constructor Create(theFrameProc: TFrameProc; CreateSuspended: Boolean = False); reintroduce; virtual;
end;
TAnimateThread = class(TFrameThread)
private
{ Private declarations }
protected
{ Protected declarations }
procedure Execute(); override;
public
{ Public declarations }
end;
var
AnimateThread: TAnimateThread;
implementation
{ TFrameThread }
constructor TFrameThread.Create(theFrameProc: TFrameProc; CreateSuspended: Boolean = False);
begin
inherited Create(CreateSuspended);
FreeOnTerminate := True;
FFrameProc := theFrameProc;
end;
procedure TFrameThread.SynchedFrame();
begin
if Assigned(FFrameProc) then FFrameProc(FFrameValue);
end;
procedure TFrameThread.Frame(const theFrame: ShortInt);
begin
FFrameValue := theFrame;
try
Sleep(0);
finally
Synchronize(SynchedFrame);
end;
end;
{ TAnimateThread }
procedure TAnimateThread.Execute();
var
I: ShortInt;
begin
while (not Self.Terminated) do
begin
Frame(0);
for I := 1 to 8 do
begin
if (not Self.Terminated) then
begin
Sleep(120);
Frame(I);
end;
end;
Frame(0);
end;
end;
end.
Unit1
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ImgList;
type
TForm1 = class(TForm)
ImageList1: TImageList;
Image1: TImage;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure UpdateFrame(const theFrame: ShortInt);
end;
var
Form1: TForm1;
implementation
uses
AnimateUnit;
{$R *.DFM}
procedure TForm1.UpdateFrame(const theFrame: ShortInt);
begin
Image1.Picture.Bitmap.Handle := 0;
try
ImageList1.GetBitmap(theFrame, Image1.Picture.Bitmap);
finally
Image1.Update();
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
AnimateThread := TAnimateThread.Create(UpdateFrame);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
AnimateThread.Terminate();
end;
end.
The Images
You are probably running your time consuming task in the main thread.
One option is to move it to a background thread which will allow your message queue to be serviced. You need it to be serviced in order for your progress bar, and indeed any UI, to work.
Answer to the updated question:
generate an animated gif e.g. here
add a GIF library to your environment (JEDI JVCL+JCL)
insert a TImage and load the generated gif
make it visible if you need it
A indicator is OK. You have to call Application.ProcessMessages after changing it.
"What is the best solution to show that that application is doing something?" - set mouse cursor to crHourGlass? or to create another form/frame/etc which attentions the user that the application is 'doing' something, and he needs to wait.
From your lengthy task, you can occasionally update a visual indicator, like a progress bar or anything else. However, you need to redraw the changes immediately by calling Update on the control that provides the feedback.
Don't use Application.ProcessMessages as this will introduce possible reentrancy issues.

How to inspect the content of non-generic TObjectList when debugging?

Summarization:
1. Manual typecast when debugging, as LachlanG and Ken pointed out.
2. Make use of the concept of Debugger Visualizers introduced since Delphi 2010.
3. Switch to generics counterparts.
=========================================
Take the following code for example:
If breakpoints are set at the end of TestRegular, and at the end of TestGenerics, respectively, one can see the items of the generic list(and even the content of the items) through the debug inspector, but nothing meaningful (not even the count) for the regular tobjectlist, when one hovers the mouse on the tmp variable. I am wondering if there is some way to achieve similar debug-time functionality for regular tobjectlist?
unit Unit2;
interface
uses
Contnrs, Generics.Collections,
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
type
TMyItem = class;
TMyItemList = class;
TForm2 = class;
TMyItem = class
private
fname: string;
public
property name: string read fname;
constructor Create(aName: string);
end;
TMyItemList = class(TObjectList)
protected
procedure SetObject (Index: Integer; Item: TMyItem);
function GetObject (Index: Integer): TMyItem;
public
function Add (Obj: TMyItem): Integer;
procedure Insert (Index: Integer; Obj: TMyItem);
property Objects [Index: Integer]: TMyItem
read GetObject write SetObject; default;
end;
TForm2 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
procedure TestRegular;
procedure TestGenerics;
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
{ TMyItem }
constructor TMyItem.Create(aName: string);
begin
fname := aName;
end;
{ TMyItemList }
function TMyItemList.Add(Obj: TMyItem): Integer;
begin
Result := inherited Add (Obj);
end;
procedure TMyItemList.SetObject(Index: Integer; Item: TMyItem);
begin
inherited SetItem (Index, Item);
end;
function TMyItemList.GetObject(Index: Integer): TMyItem;
begin
Result := inherited GetItem (Index) as TMyItem;
end;
procedure TMyItemList.Insert(Index: Integer; Obj: TMyItem);
begin
inherited Insert(Index, Obj);
end;
{TForm2}
procedure TForm2.FormCreate(Sender: TObject);
begin
TestGenerics;
TestRegular;
end;
procedure TForm2.TestRegular;
var
tmp: TMyItemList;
begin
tmp := TMyItemList.Create;
tmp.Add(TMyItem.Create('1'));
tmp.Add(TMyItem.Create('2'));
tmp.Free;
end;
procedure TForm2.TestGenerics;
var
tmp: TObjectList<TMyItem>;
begin
tmp := TObjectList<TMyItem>.Create;
tmp.Add(TMyItem.Create('1'));
tmp.Add(TMyItem.Create('2'));
tmp.Free;
end;
end.
I don't think you'll be able to improve what appear in the mouse cursor hover hint.
You can however use typecasts inside Debug windows just as you can within source code.
For example you could typecast the tmp variable to TObjectList(tmp) from within the Evaluation Window (Ctrl F7) or create a Watch (Ctrl F5) on the typecasted variable.
There are Debugger Visualizers that allow you to customise the debugger's visualization capabilities. I've never used them, but it is my understanding that you could combine them with some RTTI and give richer information about a TObject instance.
However, using generics is what you want here. It gives compile time typing which has manifest advantages. I'd simply do it that way.

How can I sort a TList in Delphi on an arbitrary property of the objects it contains?

I have a TList. It contains a collection of objects of the same type. These objects are descended from a TPersistent, and have about 50 different published properties.
In my application, the user can issue a search of these objects, and the results of the search are displayed in a TDrawGrid, with the specific columns displayed being based on the properties being searched. For example, if the user searches on 'invoice', an 'invoice' column is displayed in the results' grid. I would like to be able to let the user sort this grid. The kicker, of course, is that I wont know up front what columns are in the grid.
Normally to sort a TList, I'd just make a function, such as SortOnName( p1, p2), and call the TList's sort() method. I'd like to go one step further and find a way to pass a property name to the sort method and use RTTI to make the comparison.
I could, of course, make 50 different sort methods and just use that. Or, set a variable globally or as part of the class doing all this work to indicate to the sorting method what to sort on. But I was curious if any of the Delphi pro's out there had other ideas on how to implement this.
Delphi 7 version
Here's an example of how to achieve that. I used Delphi2010 to implement it but it should work in Delphi7 at least as I used TypInfo unit directly.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
ListBox1: TListBox;
Edit1: TEdit;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
FList: TList;
procedure DoSort(PropName: String);
procedure DoDisplay(PropName: String);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
TypInfo;
var
PropertyName: String;
type
TPerson = class
private
FName: String;
FAge: Integer;
published
public
constructor Create(Name: String; Age: Integer);
published
property Name: String read FName;
property Age: Integer read FAge;
end;
{ TPerson }
constructor TPerson.Create(Name: String; Age: Integer);
begin
FName := Name;
FAge := Age;
end;
function ComparePersonByPropertyName(P1, P2: Pointer): Integer;
var
propValueP1, propValueP2: Variant;
begin
propValueP1 := GetPropValue(P1, PropertyName, False);
propValueP2 := GetPropValue(P2, PropertyName, False);
if VarCompareValue(propValueP1, propValueP2) = vrEqual then begin
Result := 0;
end else if VarCompareValue(propValueP1, propValueP2) = vrGreaterThan then begin
Result := 1;
end else begin
Result := -1;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FList := TList.Create;
FList.Add(TPerson.Create('Zed', 10));
FList.Add(TPerson.Create('John', 20));
FList.Add(TPerson.Create('Mike', 30));
FList.Add(TPerson.Create('Paul', 40));
FList.Add(TPerson.Create('Albert', 50));
FList.Add(TPerson.Create('Barbara', 60));
FList.Add(TPerson.Create('Christian', 70));
Edit1.Text := 'Age';
DoSort('Age'); // Sort by age
DoDisplay('Age');
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
DoSort(Edit1.Text);
DoDisplay(Edit1.Text);
end;
procedure TForm1.DoSort(PropName: String);
begin
PropertyName := PropName;
FList.Sort(ComparePersonByPropertyName);
end;
procedure TForm1.DoDisplay(PropName: String);
var
i: Integer;
strPropValue: String;
begin
ListBox1.Items.Clear;
for i := 0 to FList.Count - 1 do begin
strPropValue := GetPropValue(FList[i], PropName, False);
ListBox1.Items.Add(strPropValue);
end;
end;
end.
BTW, I used a simple form with a listbox, an edit and a button. The listbox shows the contents of the list (FList) sorted. The button is used to sort the list according to what the user has typed in the editbox.
Delphi 2010 version (uses references to methods)
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm2 = class(TForm)
ListBox1: TListBox;
Edit1: TEdit;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
FList: TList;
FPropertyName: String; { << }
procedure DoSort(PropName: String);
procedure DoDisplay(PropName: String);
function CompareObjectByPropertyName(P1, P2: Pointer): Integer; { << }
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
uses
TypInfo;
type
TPerson = class
private
FName: String;
FAge: Integer;
published
public
constructor Create(Name: String; Age: Integer);
published
property Name: String read FName;
property Age: Integer read FAge;
end;
{ TPerson }
constructor TPerson.Create(Name: String; Age: Integer);
begin
FName := Name;
FAge := Age;
end;
/// This version uses a method to do the sorting and therefore can use a field of the form,
/// no more ugly global variable.
/// See below (DoSort) if you want to get rid of the field also ;)
function TForm2.CompareObjectByPropertyName(P1, P2: Pointer): Integer; { << }
var
propValueP1, propValueP2: Variant;
begin
propValueP1 := GetPropValue(P1, FPropertyName, False);
propValueP2 := GetPropValue(P2, FPropertyName, False);
if VarCompareValue(propValueP1, propValueP2) = vrEqual then begin
Result := 0;
end else if VarCompareValue(propValueP1, propValueP2) = vrGreaterThan then begin
Result := 1;
end else begin
Result := -1;
end;
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
FList := TList.Create;
FList.Add(TPerson.Create('Zed', 10));
FList.Add(TPerson.Create('John', 20));
FList.Add(TPerson.Create('Mike', 30));
FList.Add(TPerson.Create('Paul', 40));
FList.Add(TPerson.Create('Albert', 50));
FList.Add(TPerson.Create('Barbara', 60));
FList.Add(TPerson.Create('Christian', 70));
Edit1.Text := 'Age';
DoSort('Age'); // Sort by age
DoDisplay('Age');
end;
procedure TForm2.Button1Click(Sender: TObject);
begin
DoSort(Edit1.Text);
DoDisplay(Edit1.Text);
end;
procedure TForm2.DoSort(PropName: String);
begin
FPropertyName := PropName; { << }
FList.SortList(CompareObjectByPropertyName); { << }
/// The code above could be written with a lambda, and without CompareObjectByPropertyName
/// using FPropertyName, and by using a closure thus referring to PropName directly.
/// Below is the equivalent code that doesn't make use of FPropertyName. The code below
/// could be commented out completely and just is there to show an alternative approach.
FList.SortList(
function (P1, P2: Pointer): Integer
var
propValueP1, propValueP2: Variant;
begin
propValueP1 := GetPropValue(P1, PropName, False);
propValueP2 := GetPropValue(P2, PropName, False);
if VarCompareValue(propValueP1, propValueP2) = vrEqual then begin
Result := 0;
end else if VarCompareValue(propValueP1, propValueP2) = vrGreaterThan then begin
Result := 1;
end else begin
Result := -1; /// This is a catch anything else, even if the values cannot be compared
end;
end);
/// Inline anonymous functions (lambdas) make the code less readable but
/// have the advantage of "capturing" local variables (creating a closure)
end;
procedure TForm2.DoDisplay(PropName: String);
var
i: Integer;
strPropValue: String;
begin
ListBox1.Items.Clear;
for i := 0 to FList.Count - 1 do begin
strPropValue := GetPropValue(FList[i], PropName, False);
ListBox1.Items.Add(strPropValue);
end;
end;
end.
I marked with { << } the main changes.
Upgrade to Delphi >= 2009, and then you can use anonymous methods to pass a function declaration directly into TList.Sort.
An example can be found at
http://delphi.about.com/od/delphitips2009/qt/sort-generic.htm
I don't know of any other way, other than the methods you describe in your question.

Resources