Permalink
Switch branches/tags
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
625 lines (571 sloc) 20.7 KB
{
Copyright (C) 2013-2018 Tim Sinaeve tim.sinaeve@gmail.com
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
}
{$I Concepts.inc}
unit Concepts.Factories;
{ Factories for some commonly used components and objects. }
interface
uses
System.Classes,
Vcl.Controls, Vcl.StdCtrls, Vcl.DBGrids,
Data.DB, Data.Bind.Components,
VirtualTrees,
Spring, Spring.Collections,
DSharp.Windows.TreeViewPresenter, DSharp.Bindings.Collections,
DSharp.Core.DataTemplates, DSharp.Windows.CustomPresenter,
DSharp.Windows.ColumnDefinitions,
{$IFDEF DEVEXPRESS}
DSharp.DevExpress.GridViewPresenter, DSharp.DevExpress.PresenterDataSource,
DSharp.DevExpress.TreeListPresenter,
{$ENDIF}
{$IFDEF DEVEXPRESS}
cxGridCustomView, cxTL, cxTLData,
{$ENDIF}
{$IFDEF BCEDITOR}
BCEditor.Editor.Base, BCEditor.Editor,
{$ENDIF}
Concepts.Types.Contact;
type
TConceptFactories = record
strict private
class procedure InitializePresenter(
APresenter : TCustomPresenter;
ASource : IObjectList = nil;
ATemplate : IDataTemplate = nil;
AFilter : TFilterEvent = nil;
ACustomDraw : TCustomDrawEvent = nil
); static;
public
class function CreateContactList(
const ACount: Integer = 0
): IList<TContact>; static;
class procedure FillListWithContacts(
AList : IObjectList;
ACount : Integer
); static;
class function CreateVirtualStringTree(
AOwner : TComponent;
AParent : TWinControl;
const AName : string = ''
): TVirtualStringTree; static;
class function CreateTreeViewPresenter(
AOwner : TComponent;
AVST : TVirtualStringTree = nil;
ASource : IObjectList = nil;
ATemplate : IDataTemplate = nil;
AFilter : TFilterEvent = nil;
ACustomDraw : TCustomDrawEvent = nil;
const AName : string = ''
): TTreeViewPresenter; static;
{$IFDEF DEVEXPRESS}
class function CreateGridViewPresenter(
AOwner : TComponent;
AGridView : TcxCustomGridView = nil;
ASource : IObjectList = nil;
ATemplate : IDataTemplate = nil;
AFilter : TFilterEvent = nil;
const AName : string = ''
): TGridViewPresenter; static;
class function CreateTreeListPresenter(
AOwner : TComponent;
ATreeList : TcxVirtualTreeList = nil;
ASource : IObjectList = nil;
ATemplate : IDataTemplate = nil;
AFilter : TFilterEvent = nil;
const AName : string = ''
): TTreeListPresenter; static;
{$ENDIF}
class function CreateDBGrid(
AOwner : TComponent;
AParent : TWinControl;
ADataSource : TDataSource = nil;
const AName : string = ''
): TDBGrid; static;
class function CreateRandomContact(
ASpecial: Boolean = False
): TContact; static;
{$IFDEF BCEDITOR}
class function CreateBCEditor(
AOwner : TComponent;
AParent : TWinControl;
const AFileName : string = '';
const AHighlighter : string = '';
const AColorMap : string = ''
): TBCEditor; static;
{$ENDIF}
end;
type
TBindingsFactory = record
class function CreateBindScope(
ASource : TObject;
AOwner : TComponent;
AAutoActivate : Boolean = True
): TBindScope; static;
class function CreateBindExpression(
ASourceComponent : TComponent; // bindscope
const ASourceExpression : string;
AControlComponent : TComponent;
const AControlExpression : string;
ADirection : TExpressionDirection = dirBidirectional;
AOwner : TComponent = nil // take sourcecomponent as owner
): TBindExpression; static;
class function CreateEditBinding(
ASourceComponent : TComponent;
const ASourceExpression : string;
AEdit : TCustomEdit;
ADirection : TExpressionDirection = dirBidirectional;
AOwner : TComponent = nil
): TBindExpression; static;
end;
implementation
uses
System.Rtti, System.TypInfo,
Vcl.Forms, Vcl.Graphics,
BCEditor.Types,
DDuce.RandomData,
DSharp.Windows.ColumnDefinitions.ControlTemplate;
{$REGION 'TVirtualStringTree settings'}
const
DEFAULT_VST_SELECTIONOPTIONS = [
{ Prevent user from selecting with the selection rectangle in multiselect
mode. }
// toDisableDrawSelection,
{ Entries other than in the main column can be selected, edited etc. }
toExtendedFocus,
{ Hit test as well as selection highlight are not constrained to the text
of a node. }
toFullRowSelect,
{ Constrain selection to the same level as the selection anchor. }
// toLevelSelectConstraint,
{ Allow selection, dragging etc. with the middle mouse button. This and
toWheelPanning are mutual exclusive. }
// toMiddleClickSelect,
{ Allow more than one node to be selected. }
toMultiSelect
{ Allow selection, dragging etc. with the right mouse button. }
// toRightClickSelect,
{ Constrain selection to nodes with same parent. }
// toSiblingSelectConstraint,
{ Center nodes vertically in the client area when scrolling into view. }
// toCenterScrollIntoView
{ Simplifies draw selection, so a node's caption does not need to intersect
with the selection rectangle. }
// toSimpleDrawSelection
];
DEFAULT_VST_MISCOPTIONS = [
{ Register tree as OLE accepting drop target }
// toAcceptOLEDrop,
{ Show checkboxes/radio buttons. }
// toCheckSupport,
{ Node captions can be edited. }
// toEditable,
{ Fully invalidate the tree when its window is resized
(CS_HREDRAW/CS_VREDRAW). }
// toFullRepaintOnResize,
{ Use some special enhancements to simulate and support grid behavior. }
// toGridExtensions,
{ Initialize nodes when saving a tree to a stream. }
toInitOnSave,
{ Tree behaves like TListView in report mode. }
// toReportMode,
{ Toggle node expansion state when it is double clicked. }
toToggleOnDblClick,
{ Support for mouse panning (wheel mice only). This option and
toMiddleClickSelect are mutal exclusive, where panning has precedence. }
toWheelPanning,
{ The tree does not allow to be modified in any way. No action is executed
and node editing is not possible. }
// toReadOnly,
{ When set then GetNodeHeight will trigger OnMeasureItem to allow variable
node heights. }
toVariableNodeHeight
{ Start node dragging by clicking anywhere in it instead only on the
caption or image. Must be used together with toDisableDrawSelection. }
// toFullRowDrag,
{ Allows changing a node's height via mouse. }
// toNodeHeightResize,
{ Allows to reset a node's height to FDefaultNodeHeight via a double click. }
// toNodeHeightDblClickResize
{ Editing mode can be entered with a single click }
// toEditOnClick,
{ Editing mode can be entered with a double click }
// toEditOnDblClick
];
DEFAULT_VST_PAINTOPTIONS = [
{ Avoid drawing the dotted rectangle around the currently focused node. }
toHideFocusRect,
{ Selected nodes are drawn as unselected nodes if the tree is unfocused. }
// toHideSelection,
{ Track which node is under the mouse cursor. }
// toHotTrack,
{ Paint tree as would it always have the focus }
toPopupMode,
{ Use the background image if there's one. }
toShowBackground,
{ Display collapse/expand buttons left to a node. }
toShowButtons,
{ Show the dropmark during drag'n drop operations. }
toShowDropmark,
{ Display horizontal lines to simulate a grid. }
// toShowHorzGridLines,
{ Show static background instead of a tiled one. }
toStaticBackground,
{ Show lines also at top level (does not show the hidden/internal root
node). }
toShowRoot,
{ Display tree lines to show hierarchy of nodes. }
toShowTreeLines,
{ Display vertical lines (depending on columns) to simulate a grid. }
toShowVertGridLines,
{ Draw UI elements (header, tree buttons etc.) according to the current
theme if enabled (Windows XP+ only, application must be themed). }
toThemeAware,
{ Enable alpha blending for ghosted nodes or those which are being
cut/copied. }
toUseBlendedImages,
{ Ghosted images are still shown as ghosted if unfocused (otherwise they
become non-ghosted images). }
// toGhostedIfUnfocused,
{ Display vertical lines over the full client area, not only the space
occupied by nodes. This option only has an effect if toShowVertGridLines
is enabled too. }
// toFullVertGridLines,
{ Do not draw node selection, regardless of focused state. }
// toAlwaysHideSelection,
{ Enable alpha blending for node selections. }
toUseBlendedSelection,
{ Show simple static background instead of a tiled one. }
toStaticBackground,
{ Display child nodes above their parent. }
// toChildrenAbove,
{ Draw the tree with a fixed indent. }
// toFixedIndent,
{ Use the explorer theme if run under Windows Vista (or above). }
toUseExplorerTheme
{ Do not show tree lines if theming is used. }
// toHideTreeLinesIfThemed,
{ Draw nodes even if they are filtered out. }
// toShowFilteredNodes
];
DEFAULT_VST_HEADEROPTIONS = [
{ Adjust a column so that the header never exceeds the client width of the
owner control. }
hoAutoResize,
{ Resizing columns with the mouse is allowed. }
hoColumnResize,
{ Allows a column to resize itself to its largest entry. }
hoDblClickResize,
{ Dragging columns is allowed. }
hoDrag,
{ Header captions are highlighted when mouse is over a particular column. }
// hoHotTrack,
{ Header items with the owner draw style can be drawn by the application
via event. }
// hoOwnerDraw,
{ Header can only be dragged horizontally. }
hoRestrictDrag,
{ Show application defined header hint. }
hoShowHint,
{ Show header images. }
hoShowImages,
{ Allow visible sort glyphs. }
hoShowSortGlyphs,
{ Distribute size changes of the header to all columns, which are sizable
and have the coAutoSpring option enabled. hoAutoResize must be enabled
too. }
hoAutoSpring,
{ Fully invalidate the header (instead of subsequent columns only) when a
column is resized. }
// hoFullRepaintOnResize,
{ Disable animated resize for all columns. }
hoDisableAnimatedResize,
{ Allow resizing header height via mouse. }
// hoHeightResize,
{ Allow the header to resize itself to its default height. }
// hoHeightDblClickResize
{ Header is visible. }
hoVisible
];
DEFAULT_VST_STRINGOPTIONS = [
{ If set then the caption is automatically saved with the tree node,
regardless of what is saved in the user data. }
// toSaveCaptions,
{ Show static text in a caption which can be differently formatted than the
caption but cannot be edited. }
// toShowStaticText,
{ Automatically accept changes during edit if the user finishes editing
other then VK_RETURN or ESC. If not set then changes are cancelled. }
toAutoAcceptEditChange
];
DEFAULT_VST_ANIMATIONOPTIONS = [
{ Expanding and collapsing a node is animated (quick window scroll). }
// toAnimatedToggle,
{ Do some advanced animation effects when toggling a node. }
// toAdvancedAnimatedToggle
];
DEFAULT_VST_AUTOOPTIONS = [
{ Expand node if it is the drop target for more than a certain time. }
toAutoDropExpand,
{ Nodes are expanded (collapsed) when getting (losing) the focus. }
toAutoExpand,
{ Scroll if mouse is near the border while dragging or selecting. }
toAutoScroll,
{ Scroll as many child nodes in view as possible after expanding a node. }
toAutoScrollOnExpand,
{ Sort tree when Header.SortColumn or Header.SortDirection change or sort
node if child nodes are added. }
toAutoSort,
{ Large entries continue into next column(s) if there's no text in them
(no clipping). }
// toAutoSpanColumns,
{ Checkstates are automatically propagated for tri state check boxes. }
toAutoTristateTracking,
{ Node buttons are hidden when there are child nodes, but all are invisible.}
// toAutoHideButtons,
{ Delete nodes which where moved in a drag operation (if not directed
otherwise). }
toAutoDeleteMovedNodes,
{ Disable scrolling a node or column into view if it gets focused. }
// toDisableAutoscrollOnFocus,
{ Change default node height automatically if the system's font scale is
set to big fonts. }
toAutoChangeScale,
{ Frees any child node after a node has been collapsed (HasChildren flag
stays there). }
// toAutoFreeOnCollapse,
{ Do not center a node horizontally when it is edited. }
toDisableAutoscrollOnEdit,
{ When set then columns (if any exist) will be reordered from lowest index
to highest index and vice versa when the tree's bidi mode is changed. }
toAutoBidiColumnOrdering
];
{$ENDREGION}
{$REGION 'TConceptFactories'}
class function TConceptFactories.CreateDBGrid(AOwner: TComponent;
AParent: TWinControl; ADataSource: TDataSource; const AName: string): TDBGrid;
var
DBG: TDBGrid;
begin
Guard.CheckNotNull(AParent, 'AParent');
DBG := TDBGrid.Create(AOwner);
DBG.AlignWithMargins := True;
DBG.Parent := AParent;
DBG.Align := alClient;
DBG.DataSource := ADataSource;
Result := DBG;
end;
{$IFDEF DEVEXPRESS}
class function TConceptFactories.CreateGridViewPresenter(AOwner: TComponent;
AGridView: TcxCustomGridView; ASource: IObjectList; ATemplate: IDataTemplate;
AFilter: TFilterEvent; const AName: string): TGridViewPresenter;
var
GVP: TGridViewPresenter;
begin
GVP := TGridViewPresenter.Create(AOwner);
GVP.GridView := AGridView;
InitializePresenter(GVP, ASource, ATemplate, AFilter);
Result := GVP;
end;
class function TConceptFactories.CreateTreeListPresenter(AOwner: TComponent;
ATreeList: TcxVirtualTreeList; ASource: IObjectList; ATemplate: IDataTemplate;
AFilter: TFilterEvent; const AName: string): TTreeListPresenter;
var
TLP: TTreeListPresenter;
begin
TLP := TTreeListPresenter.Create(AOwner);
TLP.TreeList := ATreeList;
InitializePresenter(TLP, ASource, ATemplate, AFilter);
Result := TLP;
end;
{$ENDIF}
class function TConceptFactories.CreateTreeViewPresenter(
AOwner: TComponent; AVST: TVirtualStringTree; ASource: IObjectList;
ATemplate: IDataTemplate; AFilter: TFilterEvent; ACustomDraw: TCustomDrawEvent;
const AName : string): TTreeViewPresenter;
var
TVP: TTreeViewPresenter;
begin
TVP := TTreeViewPresenter.Create(AOwner);
TVP.TreeView := AVST;
TVP.SyncMode := True;
TVP.ListMode := False;
InitializePresenter(TVP, ASource, ATemplate, AFilter, ACustomDraw);
Result := TVP;
end;
class function TConceptFactories.CreateVirtualStringTree(AOwner: TComponent;
AParent: TWinControl; const AName: string): TVirtualStringTree;
var
VST : TVirtualStringTree;
begin
Guard.CheckNotNull(AParent, 'AParent');
VST := TVirtualStringTree.Create(AOwner);
VST.AlignWithMargins := True;
VST.Parent := AParent;
VST.HintMode := hmTooltip;
VST.Align := alClient;
VST.DrawSelectionMode := smBlendedRectangle;
VST.Indent := 2;
VST.Header.Height := 18;
VST.Header.Options := DEFAULT_VST_HEADEROPTIONS;
VST.TreeOptions.SelectionOptions := DEFAULT_VST_SELECTIONOPTIONS;
VST.TreeOptions.MiscOptions := DEFAULT_VST_MISCOPTIONS;
VST.TreeOptions.PaintOptions := DEFAULT_VST_PAINTOPTIONS;
VST.TreeOptions.StringOptions := DEFAULT_VST_STRINGOPTIONS;
VST.TreeOptions.AnimationOptions := DEFAULT_VST_ANIMATIONOPTIONS;
VST.TreeOptions.AutoOptions := DEFAULT_VST_AUTOOPTIONS;
Result := VST;
end;
{$IFDEF BCEDITOR}
class function TConceptFactories.CreateBCEditor(AOwner: TComponent;
AParent: TWinControl; const AFileName : string; const AHighlighter: string;
const AColorMap: string): TBCEditor;
var
BCE : TBCEditor;
begin
BCE := TBCEditor.Create(AOwner);
BCE.Parent := AParent;
BCE.Align := alClient;
BCE.AlignWithMargins := True;
if AFileName <> '' then
BCE.LoadFromFile(AFileName);
if AHighlighter <> '' then
BCE.Highlighter.LoadFromFile(AHighlighter + '.json');
if AColorMap <> '' then
BCE.Highlighter.Colors.LoadFromFile(AColorMap + '.json');
BCE.CodeFolding.Options := BCE.CodeFolding.Options + [cfoFoldMultilineComments];
BCE.Tabs.Options := BCE.Tabs.Options + [toPreviousLineIndent];
BCE.Selection.Options := BCE.Selection.Options + [soALTSetsColumnMode];
BCE.Font.Name := 'Consolas';
BCE.CodeFolding.Visible := True;
BCE.URIOpener := True;
Result := BCE;
end;
{$ENDIF}
class function TConceptFactories.CreateContactList(
const ACount: Integer): IList<TContact>;
begin
Result := TCollections.CreateObjectList<TContact>;
if ACount > 0 then
FillListWithContacts(Result as IObjectList, ACount);
end;
class procedure TConceptFactories.FillListWithContacts(AList: IObjectList;
ACount: Integer);
var
I : Integer;
B : Boolean;
begin
Guard.CheckNotNull(AList, 'AList');
AList.Clear;
B := ACount < 40000;
for I := 0 to ACount - 1 do
begin
AList.Add(CreateRandomContact(B));
end;
end;
class function TConceptFactories.CreateRandomContact(ASpecial: Boolean)
: TContact;
var
C: TContact;
begin
C := TContact.Create;
with C do
begin
FirstName := RandomData.FirstName;
LastName := RandomData.LastName;
if ASpecial then
CompanyName := RandomData.AlliteratedCompanyName
else
CompanyName := RandomData.CompanyName;
Email := RandomData.Email(FirstName, LastName);
Address := RandomData.Address;
Number := RandomData.Number(100);
BirthDate := RandomData.BirthDate(1928, 1987);
Active := RandomData.Bool;
end;
Result := C;
end;
class procedure TConceptFactories.InitializePresenter(
APresenter: TCustomPresenter; ASource: IObjectList; ATemplate: IDataTemplate;
AFilter: TFilterEvent; ACustomDraw: TCustomDrawEvent);
var
P : TRttiProperty;
C : TRttiContext;
begin
Guard.CheckNotNull(APresenter, 'APresenter');
if Assigned(ASource) then // auto create column definitions
begin
for P in C.GetType(ASource.ElementType).GetProperties do
begin
with APresenter.ColumnDefinitions.Add(P.Name) do
begin
ValuePropertyName := P.Name;
HintPropertyName := P.Name;
OnCustomDraw := ACustomDraw;
end;
end;
end;
APresenter.UseColumnDefinitions := True;
APresenter.View.ItemsSource := ASource;
if not Assigned(ATemplate) then
APresenter.View.ItemTemplate :=
TColumnDefinitionsControlTemplate.Create(APresenter.ColumnDefinitions)
else
APresenter.View.ItemTemplate := ATemplate;
if Assigned(AFilter) then
APresenter.View.Filter.Add(AFilter);
end;
{$ENDREGION}
{$REGION 'TBindingsFactory'}
{ Wraps an object in a TBindScope component. }
class function TBindingsFactory.CreateBindScope(ASource: TObject; AOwner: TComponent;
AAutoActivate: Boolean): TBindScope;
var
BS : TBindScope;
begin
BS := TBindScope.Create(AOwner);
BS.AutoActivate := AAutoActivate;
BS.DataObject := ASource;
Result := BS;
end;
class function TBindingsFactory.CreateBindExpression(
ASourceComponent: TComponent; const ASourceExpression: string;
AControlComponent: TComponent; const AControlExpression: string;
ADirection: TExpressionDirection; AOwner: TComponent): TBindExpression;
var
BE : TBindExpression;
begin
if not Assigned(AOwner) then
AOwner := ASourceComponent;
BE := TBindExpression.Create(AOwner);
BE.NotifyOutputs := True;
BE.SourceComponent := ASourceComponent;
BE.SourceExpression := ASourceExpression;
BE.ControlComponent := AControlComponent;
BE.ControlExpression := AControlExpression;
BE.Direction := ADirection;
Result := BE;
end;
class function TBindingsFactory.CreateEditBinding(ASourceComponent: TComponent;
const ASourceExpression: string; AEdit: TCustomEdit; ADirection:
TExpressionDirection; AOwner: TComponent): TBindExpression;
begin
Result := TBindingsFactory.CreateBindExpression(
ASourceComponent,
ASourceExpression,
AEdit,
'Text',
ADirection,
AOwner
);
end;
{$ENDREGION}
end.