256 lines
9.2 KiB
Plaintext
256 lines
9.2 KiB
Plaintext
unit myevents;
|
|
|
|
{
|
|
IEventPresenter:
|
|
The presenter object that connects to the Virtual Tree View passed
|
|
in Setup method called in Create.
|
|
-- Sets up the columns
|
|
-- Sets up the events and callbacks, including those needed for
|
|
sorting.
|
|
-- Implements the display methods.
|
|
|
|
Use of Interfaces:
|
|
-- See OnInitNode for an example of how it sets the interface data
|
|
object IMyEventData as the data for the node.
|
|
-- Interfaced objects are reference-counted, you don't need to free them.
|
|
-- Even this object, IEventPresenter, is designed as an interface for reuse
|
|
by forms that need to display a similar Tree View. This is an
|
|
example of a reuse without making a derived component of the
|
|
Virtual Tree View.
|
|
|
|
Written by Joachim Marder, Sanjay Kanade
|
|
}
|
|
|
|
interface
|
|
|
|
uses Vcl.ImgList, VirtualTrees, System.Classes, Vcl.Controls;
|
|
|
|
type
|
|
IEventPresenter = interface
|
|
['{1984E951-24C5-4484-B470-BBADBDA70EEA}']
|
|
procedure displayOnlyStarEvents(aOnlyStarEvents: Boolean); stdcall;
|
|
end;
|
|
|
|
//With virtual methods that can be overridden by a derived
|
|
//class.
|
|
TEventPresenter = class(TInterfacedObject, IEventPresenter)
|
|
private
|
|
fVST: TVirtualStringTree;
|
|
fImageList: TImageList; //Just in case we need it
|
|
|
|
fOnlyStarEvents: boolean;
|
|
|
|
protected
|
|
//events to be hooked up
|
|
procedure doOnInitNode(Sender: TBaseVirtualTree; ParentNode,
|
|
Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); virtual;
|
|
procedure doOnGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
|
|
Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); virtual;
|
|
procedure doOnGetImageIndex(Sender: TBaseVirtualTree;
|
|
Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
|
|
var Ghosted: Boolean; var ImageIndex: TImageIndex); virtual;
|
|
procedure doOnCompareNodes(Sender: TBaseVirtualTree; Node1, Node2: PVirtualNode; Column: TColumnIndex;
|
|
var Result: Integer); virtual;
|
|
|
|
procedure processForStarDisplay(Sender: TBaseVirtualTree; Node: PVirtualNode; Data: Pointer; var Abort: Boolean);
|
|
|
|
//column display functions
|
|
function getDisplayDate(aDate: TDateTime): string;
|
|
function getDisplayName(aName: string): string;
|
|
function getDisplayAmount(anAmount: currency): string;
|
|
procedure setup(aVST: TVirtualStringTree; anImageList: TImageList); virtual; stdcall;
|
|
|
|
public
|
|
constructor Create(aVST: TVirtualStringTree; anImageList: TImageList);
|
|
destructor Destroy; override;
|
|
procedure displayOnlyStarEvents(aOnlyStarEvents: Boolean); virtual; stdcall;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses myeventdata, System.DateUtils, System.SysUtils, Winapi.Windows, System.Math;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
constructor TEventPresenter.Create(aVST: TVirtualStringTree; anImageList: TImageList);
|
|
begin
|
|
inherited Create();
|
|
//initialize
|
|
fOnlyStarEvents := false;
|
|
setup(aVST, anImageList);
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
destructor TEventPresenter.Destroy;
|
|
begin
|
|
//do cleanup
|
|
inherited;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
procedure TEventPresenter.setup(aVST: TVirtualStringTree; anImageList: TImageList); stdcall;
|
|
var
|
|
col: TVirtualTreeColumn;
|
|
begin
|
|
fVST := aVST;
|
|
fImageList := anImageList;
|
|
|
|
//hook up events
|
|
fVST.OnInitNode := doOnInitNode;
|
|
fVST.OnGetText := doOnGetText;
|
|
fVST.OnGetImageIndex := doOnGetImageIndex;
|
|
fVST.OnCompareNodes := doOnCompareNodes;
|
|
|
|
//set up columns
|
|
col := fVST.header.Columns.Add;
|
|
col.Text := 'Star Event';
|
|
col.Hint := 'Number of Stars';
|
|
col.Width := 120;
|
|
col := fVST.header.Columns.Add;
|
|
col.Text := 'Date';
|
|
col.Hint := 'The date of the event';
|
|
col.Width := 100;
|
|
col := fVST.header.Columns.Add;
|
|
col.Text := 'Charity Event Name';
|
|
col.Width := 180;
|
|
col := fVST.header.Columns.Add;
|
|
col.Text := 'Amount Collected';
|
|
col.Width := 180;
|
|
col.Alignment := taRightJustify;
|
|
|
|
//settings that we want
|
|
fVST.Header.AutoSizeIndex := -1;
|
|
//If the form uses a larger font, the header should use the same
|
|
fVST.Header.Font.Assign(fVST.font);
|
|
fVST.Header.Options := fVST.Header.Options + [TVTHeaderOption.hoVisible, TVTHeaderOption.hoHeaderClickAutoSort];
|
|
fVST.TreeOptions.PaintOptions := fVST.TreeOptions.PaintOptions
|
|
- [TVTPaintOption.toShowRoot, TVTPaintOption.toShowTreeLines];
|
|
fVST.TreeOptions.SelectionOptions := fVST.TreeOptions.SelectionOptions
|
|
+ [TVTSelectionOption.toFullRowSelect];
|
|
fVST.TreeOptions.AutoOptions := fVST.TreeOptions.AutoOptions + [TVTAutoOption.toAutoSort];
|
|
|
|
//generate 20 events as part of setup
|
|
fVST.RootNodeCount := 20;
|
|
|
|
//By default sort descrending on date
|
|
fVST.Header.SortDirection := sdDescending;
|
|
fVST.Header.SortColumn := 1;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
procedure TEventPresenter.doOnInitNode(Sender: TBaseVirtualTree; ParentNode,
|
|
Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
|
|
var
|
|
myEvent: IMyEventData;
|
|
begin
|
|
//generate a fictitious event for our testing
|
|
myEvent := TMyEventData.Create;
|
|
myEvent.initializeRandom;
|
|
//This is how an interface is set as data for the node
|
|
Node.SetData(myEvent);
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
procedure TEventPresenter.doOnGetImageIndex(Sender: TBaseVirtualTree;
|
|
Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
|
|
var Ghosted: Boolean; var ImageIndex: TImageIndex);
|
|
var
|
|
myEvent: IMyEventData;
|
|
begin
|
|
if (Kind <> ikNormal) and (Kind <> ikSelected) then
|
|
exit;
|
|
|
|
myEvent := Sender.GetInterfaceFromNodeData<IMyEventData>(Node);
|
|
if Assigned(myEvent) and (column = 0)
|
|
and myEvent.isStarEvent
|
|
then
|
|
//provide the index of the star image if it is a star event
|
|
ImageIndex := 15;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
procedure TEventPresenter.doOnCompareNodes(Sender: TBaseVirtualTree; Node1, Node2: PVirtualNode; Column: TColumnIndex;
|
|
var Result: Integer);
|
|
var
|
|
myEvent1, myEvent2: IMyEventData;
|
|
begin
|
|
myEvent1 := Sender.GetInterfaceFromNodeData<IMyEventData>(Node1);
|
|
myEvent2 := Sender.GetInterfaceFromNodeData<IMyEventData>(Node2);
|
|
case column of
|
|
0:
|
|
result := Floor(myEvent2.amount - myEvent1.amount); //reverse sort on amount
|
|
1:
|
|
if myEvent1.date = myEvent2.date then
|
|
result := 0
|
|
else
|
|
if myEvent1.date > myEvent2.date then
|
|
result := 1
|
|
else
|
|
result := -1;
|
|
2:
|
|
result := comparetext(myEvent1.name, myEvent2.name);
|
|
3:
|
|
result := Floor(myEvent1.amount - myEvent2.amount);
|
|
end;
|
|
end;
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
//called for each node by next function displayOnlyStarEvents
|
|
procedure TEventPresenter.processForStarDisplay(Sender: TBaseVirtualTree; Node: PVirtualNode; Data: Pointer; var Abort: Boolean);
|
|
var
|
|
myEvent: IMyEventData;
|
|
begin
|
|
myEvent := Sender.GetInterfaceFromNodeData<IMyEventData>(Node);
|
|
//the node is visible based on the flag and whether it is a star event
|
|
Sender.IsVisible[Node] := (not fOnlyStarEvents) or myEvent.isStarEvent;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
procedure TEventPresenter.displayOnlyStarEvents(aOnlyStarEvents: Boolean); stdcall;
|
|
begin
|
|
fOnlyStarEvents := aOnlyStarEvents;
|
|
fVST.BeginUpdate;
|
|
try
|
|
//iterate the tree setting the visiblity of the nodes based on the above flag
|
|
fVST.IterateSubtree(nil, processForStarDisplay, nil, [], True);
|
|
finally
|
|
fVST.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
function TEventPresenter.getDisplayDate(aDate: TDateTime): string;
|
|
begin
|
|
result := FormatDateTime('c', aDate);
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
function TEventPresenter.getDisplayName(aName: string): string;
|
|
begin
|
|
result := aName;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
function TEventPresenter.getDisplayAmount(anAmount: currency): string;
|
|
begin
|
|
result := CurrToStrF(anAmount, ffCurrency, 2, formatSettings);
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
procedure TEventPresenter.doOnGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
|
|
Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
|
|
var
|
|
myEvent: IMyEventData;
|
|
begin
|
|
//the format of the display is handled in display methods
|
|
myEvent := Sender.GetInterfaceFromNodeData<IMyEventData>(Node);
|
|
if Assigned(myEvent) then
|
|
case column of
|
|
1: CellText := getDisplayDate(myEvent.date);
|
|
2: CellText := getDisplayName(myEvent.name);
|
|
3: CellText := getDisplayAmount(myEvent.amount);
|
|
end;
|
|
end;
|
|
|
|
end.
|