Componentes.Terceros.DevExp.../internal/x.44/1/ExpressOrgChart/Sources/dxorgchr.pas
2009-06-29 12:09:02 +00:00

3627 lines
98 KiB
ObjectPascal

{*******************************************************************}
{ }
{ Developer Express Visual Component Library }
{ Express OrgChart }
{ }
{ Copyright (c) 1998-2009 Developer Express Inc. }
{ ALL RIGHTS RESERVED }
{ }
{ The entire contents of this file is protected by U.S. and }
{ International Copyright Laws. Unauthorized reproduction, }
{ reverse-engineering, and distribution of all or any portion of }
{ the code contained in this file is strictly prohibited and may }
{ result in severe civil and criminal penalties and will be }
{ prosecuted to the maximum extent possible under the law. }
{ }
{ RESTRICTIONS }
{ }
{ THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES }
{ (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE }
{ SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS }
{ LICENSED TO DISTRIBUTE THE EXPRESSORGCHART AND ALL ACCOMPANYING }
{ VCL CONTROLS AS PART OF AN EXECUTABLE PROGRAM ONLY. }
{ }
{ THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED }
{ FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE }
{ COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE }
{ AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT }
{ AND PERMISSION FROM DEVELOPER EXPRESS INC. }
{ }
{ CONSULT THE end USER LICENSE AGREEMENT FOR INFORMATION ON }
{ ADDITIONAL RESTRICTIONS. }
{ }
{*******************************************************************}
unit dxorgchr;
{$I cxVer.inc}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls, ImgList;
const
OtScrollUnit = 16;
type
TdxOcNodeAlign = (caLeft, caCenter, caRight);
TdxOcImageAlign = (iaNone, iaLT, iaLC, iaLB, iaRT, iaRC, iaRB, iaTL, iaTC, iaTR, iaBL, iaBC, iaBR);
TdxOcIvFlags = (ivWidth, ivHeight, ivBoth);
TdxOcShape = (shRectangle, shRoundRect, shEllipse, shDiamond);
TdxOcNodeAttachMode = (naAdd, naAddFirst, naAddChild, naAddChildFirst, naInsert);
TdxCustomOrgChart = class;
TdxOcNodeInfo = packed record
Width: Word;
Height: Word;
Color: TColor;
Align: TdxOcNodeAlign;
Shape: TdxOcShape;
Index: Smallint;
IAlign: TdxOcImageAlign;
end;
TdxOcInplaceEdit = class(TCustomEdit)
private
FMinW: Integer;
FMaxW: Integer;
FMinH: Integer;
FMaxH: Integer;
procedure AdjustBounds;
procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE;
procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS;
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyUp(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: Char); override;
public
constructor Create(AOwner: TComponent); override;
function Tree: TdxCustomOrgChart;
property MaxLength;
property OEMConvert;
end;
TdxOcNodeData = Pointer;
TdxOcNode = class(TObject)
private
FOwner: TdxCustomOrgChart;
FParent: TdxOcNode;
FList: TList;
FIndex: Integer;
FData: TdxOcNodeData;
FWidth: Word;
FHeight: Word;
FChildrenWidth: Integer;
FChildrenHeight: Integer;
FExpanded: Boolean;
FDeleting: Boolean;
FChildAlign: TdxOcNodeAlign;
FShape: TdxOcShape;
FColor: TColor;
FText: string;
FAnimX: Integer;
FAnimY: Integer;
FAnimX0: Integer;
FAnimY0: Integer;
FImageIndex: Smallint;
FImageAlign: TdxOcImageAlign;
FDraw: Boolean;
procedure InvalidateSize(Flags: TdxOcIvFlags);
procedure Enumerate(Value: Integer);
procedure AdjustSizes(const S: string);
function FullRect: TRect;
function Radius: Integer;
function Is3D: Boolean;
procedure FullToDisplay(var Rect: TRect);
procedure DisplayToClient(var Rect: TRect);
function ClientToText(var Rect: TRect): TPoint;
function GetAbsoluteCount: Integer;
function GetAbsoluteItem(Index: Integer): TdxOcNode;
function GetCount: Integer;
function GetChildren: Boolean;
function GetVisible: Boolean;
function GetItem(Index: Integer): TdxOcNode;
function GetLevel: Integer;
function GetParent: TdxOcNode;
function GetSelected: Boolean;
function GetWidth: Word;
function GetHeight: Word;
function GetColor: TColor;
procedure SetExpanded(Value: Boolean);
procedure SetChildren(Value: Boolean);
procedure SetAlign(Value: TdxOcNodeAlign);
procedure SetWidth(Value: Word);
procedure SetHeight(Value: Word);
procedure SetSelected(Value: Boolean);
procedure SetColor(Value: TColor);
procedure SetShape(Value: TdxOcShape);
procedure SetImageIndex(Value: Smallint);
procedure SetImageAlign(Value: TdxOcImageAlign);
procedure InternalSetText(const Value: string);
procedure SetAnimXY(LeftX, TopY: Integer; const Clip: TRect; First: Boolean);
function ExtWidth: Word;
function ExtHeight: Word;
function ChildOffset: Integer;
procedure ReadChildren(Stream: TStream);
procedure WriteChildren(Stream: TStream);
protected
procedure SetData(Value: TdxOcNodeData); virtual;
procedure SetFont(Font: TFont); virtual;
procedure ReadData(Stream: TStream); virtual;
procedure WriteData(Stream: TStream); virtual;
function GetText: string; virtual;
procedure SetText(const Value: string); virtual;
public
constructor Create(AOwner: TdxCustomOrgChart);
destructor Destroy; override;
procedure DeleteChildren;
procedure Collapse(Recurse: Boolean);
procedure Expand(Recurse: Boolean);
function GetFirstChild: TdxOcNode;
function GetLastChild: TdxOcNode;
function GetNextChild(Value: TdxOcNode): TdxOcNode;
function GetPrevChild(Value: TdxOcNode): TdxOcNode;
function GetNext: TdxOcNode;
function GetPrev: TdxOcNode;
function GetNextSibling: TdxOcNode;
function GetPrevSibling: TdxOcNode;
function GetNextVisible: TdxOcNode;
function GetPrevVisible: TdxOcNode;
function HasAsParent(Value: TdxOcNode): Boolean;
function IndexOf(Value: TdxOcNode): Integer;
function Focused: Boolean;
function FullWidth: Integer;
function FullHeight: Integer;
function ChildrenWidth: Integer;
function ChildrenHeight: Integer;
procedure MakeVisible;
procedure MoveTo(Dest: TdxOcNode; Mode: TdxOcNodeAttachMode);
function DisplayRect: TRect;
function ClientRect: TRect;
function IsParentRoot: Boolean;
procedure GetNodeInfo(var AInfo: TdxOcNodeInfo);
property AbsoluteCount: Integer read GetAbsoluteCount;
property AbsoluteItems[Index: Integer]: TdxOcNode read GetAbsoluteItem;
property Count: Integer read GetCount;
property Data: TdxOcNodeData read FData write SetData;
property Expanded: Boolean read FExpanded write SetExpanded;
property HasChildren: Boolean read GetChildren write SetChildren;
property Index: Integer read FIndex;
property IsVisible: Boolean read GetVisible;
property Items[Index: Integer]: TdxOcNode read GetItem; default;
property Level: Integer read GetLevel;
property Owner: TdxCustomOrgChart read FOwner;
property Parent: TdxOcNode read GetParent;
property Selected: Boolean read GetSelected write SetSelected;
property ChildAlign: TdxOcNodeAlign read FChildAlign write SetAlign;
property Width: Word read GetWidth write SetWidth;
property Height: Word read GetHeight write SetHeight;
property Deleting: Boolean read FDeleting;
property Color: TColor read GetColor write SetColor;
property Shape: TdxOcShape read FShape write SetShape;
property Text: string read GetText write InternalSetText;
property ImageIndex: Smallint read FImageIndex write SetImageIndex;
property ImageAlign: TdxOcImageAlign read FImageAlign write SetImageAlign;
end;
TdxOcEvent = procedure(Sender: TObject; Node: TdxOcNode) of object;
TdxOcAllowEvent = procedure(Sender: TObject; Node: TdxOcNode; var Allow: Boolean) of object;
TdxOcFontEvent = procedure(Sender: TObject; Node: TdxOcNode; Font: TFont) of object;
TdxOcDrawEvent = procedure(Sender: TObject; Node: TdxOcNode; ACanvas: TCanvas; Rect: TRect) of object;
TdxOcGetTextEvent = procedure(Sender: TObject; Node: TdxOcNode; var Text: string) of object;
TdxOcSetTextEvent = procedure(Sender: TObject; Node: TdxOcNode; const Text: string) of object;
TdxOcNodeFunc = function(Value: TdxOcNode): TdxOcNode;
TdxOcEditMode = set of (emLeft, emCenter, emRight, emVCenter,
emWrap, emUpper, emLower, emGrow);
TdxOcOptions = set of (ocSelect, ocFocus, ocButtons, ocDblClick, ocEdit,
ocCanDrag, ocShowDrag, ocInsDel, ocRect3D, ocAnimate);
TdxOcHitTest = (htNowhere, htOnLeftIndentX, htOnRightIndentX, htOnIndentY,
htUnder, htOnRect, htOnShape, htOnButton);
TdxOcHitTests = set of TdxOcHitTest;
TdxOcNavigate = (ocnLineLeft, ocnLineUp, ocnLineRight, ocnLineDown,
ocnPageLeft, ocnPageUp, ocnPageRight, ocnPageDown,
ocnLeft, ocnTop, ocnRight, ocnBottom,
ocnLeftPosition, ocnTopPosition,
ocnSelectNextLeft, ocnSelectNextUp, ocnSelectNextRight, ocnSelectNextDown);
TdxCustomOrgChart = class(TCustomControl)
private
FRoot: TdxOcNode;
FCount: Integer;
FUpdate: Integer;
FLeftEdge: Integer;
FTopEdge: Integer;
FDefaultNodeWidth: Word;
FDefaultNodeHeight: Word;
FIndentX: Word;
FIndentY: Word;
FIsUnicode: Boolean;
FSelected: TdxOcNode;
FNodeAt: TdxOcNode;
FCollapsed: TdxOcNode;
FHitX: Integer;
FHitY: Integer;
FZoom: Integer;
FZoomLo: Integer;
FZoomHi: Integer;
FEditor: TdxOcInplaceEdit;
FEditMode: TdxOcEditMode;
FHitTests: TdxOcHitTests;
FLineWidth: Word;
FLineColor: TColor;
FSelectedNodeColor: TColor;
FSelectedNodeTextColor: TColor;
FDragParent: TdxOcNode;
FDragX0: Integer;
FDragY0: Integer;
FDragX1: Integer;
FDragY1: Integer;
FScrollX: Smallint;
FScrollY: Smallint;
FTimer: TTimer;
FImages: TCustomImageList;
FBitmap: TBitmap;
FDefaultImageAlign: TdxOcImageAlign;
FSizeChanged: Boolean;
FUpdated: Boolean;
FOptions: TdxOcOptions;
FOnCreateNode: TdxOcEvent;
FOnChange: TdxOcEvent;
FOnChanging: TdxOcAllowEvent;
FOnCollapsed: TdxOcEvent;
FOnCollapsing: TdxOcAllowEvent;
FOnDeletion: TdxOcEvent;
FOnExpanded: TdxOcEvent;
FOnExpansion: TdxOcAllowEvent;
FOnEditing: TdxOcAllowEvent;
FOnEdited: TdxOcGetTextEvent;
FOnSetFont: TdxOcFontEvent;
FOnDrawNode: TdxOcDrawEvent;
FOnGetText: TdxOcGetTextEvent;
FOnSetText: TdxOcSetTextEvent;
FBorderStyle: TBorderStyle;
FRotated: Boolean;
FNoScroll: Boolean;
FDrag: Boolean;
FNoAnim: Boolean;
FImagesChangeLink: TChangeLink;
procedure ImageListChange(Sender: TObject);
function GetAbsoluteItem(Index: Integer): TdxOcNode;
function GetItem(Index: Integer): TdxOcNode;
function GetRootCount: Integer;
function GetLineWidth: Word;
function GetIndentX: Word;
function GetIndentY: Word;
function GetLeftEdge: Integer;
function GetTopEdge: Integer;
function GetZoom: Boolean;
function GetEditing: Boolean;
procedure InvalidateSizes(Flags: TdxOcIvFlags);
function InvalidateNode(Value: TdxOcNode): Boolean;
function InvalidateSel: Boolean;
function IsUpdated: Boolean;
function IsMyNode(Value: TdxOcNode): Boolean;
function HasButton(Node: TdxOcNode): Boolean;
function CanSelect(Node: TdxOcNode): Boolean;
function NextSel(Get: TdxOcNodeFunc): TdxOcNode;
function MinSizes: TPoint;
procedure DoAdd(AParent, ANode: TdxOcNode; AIndex: Integer);
procedure HitTestsAt(X, Y: Integer);
procedure ChangeSize;
procedure RecalcSizes;
procedure UpdateScrollRange;
procedure SetTimeScroll;
procedure KillTimeScroll;
procedure TimeScroll;
procedure DoTimerScrolling(Sender: TObject);
function InitAnimate(Node: TdxOcNode): Boolean;
function DragScroll(X, Y: Integer; St: TDragState): Boolean;
procedure DragDraw(Source: TdxCustomOrgChart);
procedure DoDrawText(Handle: HDC; Text: string; var Rect: TRect; Flags: Integer);
procedure DoDrawImage(ACanvas: TCanvas; FullRect, R: TRect; ABitmap: TBitmap);
procedure SetLeftEdge(Value: Integer);
procedure SetTopEdge(Value: Integer);
procedure SetLineColor(Value: TColor);
procedure SetLineWidth(Value: Word);
procedure SetSelectedNodeColor(Value: TColor);
procedure SetSelectedNodeTextColor(Value: TColor);
procedure SetNodeWidth(Value: Word);
procedure SetNodeHeight(Value: Word);
procedure SetIndentX(Value: Word);
procedure SetIndentY(Value: Word);
procedure SetSelected(Value: TdxOcNode);
procedure SetZoom(Value: Boolean);
procedure SetZoomRatio;
procedure SetEditing(Value: Boolean);
procedure SetEditMode(Value: TdxOcEditMode);
procedure SetImages(Value: TCustomImageList);
procedure SetRotated(Value: Boolean);
procedure SetBorderStyle(Value: TBorderStyle);
procedure SetOptions(Value: TdxOcOptions);
function RotateRect(const Rect: TRect): TRect;
procedure RotatePoint(var X, Y: Integer);
procedure ReadData(Stream: TStream);
procedure WriteData(Stream: TStream);
procedure WMHScroll(var Msg: TWMHScroll); message WM_HSCROLL;
procedure WMVScroll(var Msg: TWMVScroll); message WM_VSCROLL;
procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS;
procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS;
procedure WMSize(var Msg: TWMSize); message WM_SIZE;
procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE;
procedure WMDblClk(var Msg: TWMMouse); message WM_LBUTTONDBLCLK;
procedure WMErase(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
procedure CMCtl3DChanged(var Msg: TMessage); message CM_CTL3DCHANGED;
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateHandle; override;
procedure Paint; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
procedure DragCanceled; override;
procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState;
var Accept: Boolean); override;
procedure KeyPress(var Key: Char); override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure DblClick; override;
procedure Loaded; override;
procedure DefineProperties(Filer: TFiler); override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
function CreateNode: TdxOcNode; virtual;
function CreateEditor: TdxOcInplaceEdit; virtual;
procedure DrawNode(Node: TdxOcNode; ACanvas: TCanvas; Rect: TRect); virtual;
procedure DoChange(Node: TdxOcNode); virtual;
procedure DoChanging(Node: TdxOcNode; var Allow: Boolean); virtual;
procedure DoNavigate(ANavigateCode: TdxOcNavigate; AValue: Integer = 0);
function InternalAdd(ParentNode: TdxOcNode; Data: TdxOcNodeData; Idx: Integer): TdxOcNode; virtual;
procedure InternalMoveTo(ParentNode, Node: TdxOcNode; Idx: Integer); virtual;
procedure NodeChanged(Node: TdxOcNode); virtual;
procedure SelectNode(ANode: TdxOcNode);
property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
property DefaultImageAlign: TdxOcImageAlign read FDefaultImageAlign write FDefaultImageAlign default iaNone;
property DefaultNodeHeight: Word read FDefaultNodeHeight write SetNodeHeight default 40;
property DefaultNodeWidth: Word read FDefaultNodeWidth write SetNodeWidth default 64;
property EditMode: TdxOcEditMode read FEditMode write SetEditMode default [emWrap];
property Images: TCustomImageList read FImages write SetImages;
property IndentX: Word read GetIndentX write SetIndentX default 16;
property IndentY: Word read GetIndentY write SetIndentY default 16;
property IsUnicode: Boolean read FIsUnicode write FIsUnicode;
property LineColor: TColor read FLineColor write SetLineColor default clBlack;
property LineWidth: Word read GetLineWidth write SetLineWidth default 1;
property Options: TdxOcOptions read FOptions write SetOptions;
property Rotated: Boolean read FRotated write SetRotated default False;
property SelectedNodeColor: TColor read FSelectedNodeColor write SetSelectedNodeColor default clHighlight;
property SelectedNodeTextColor: TColor read FSelectedNodeTextColor write SetSelectedNodeTextColor default clHighlightText;
property OnCreateNode: TdxOcEvent read FOnCreateNode write FOnCreateNode;
property OnChange: TdxOcEvent read FOnChange write FOnChange;
property OnChanging: TdxOcAllowEvent read FOnChanging write FOnChanging;
property OnCollapsed: TdxOcEvent read FOnCollapsed write FOnCollapsed;
property OnCollapsing: TdxOcAllowEvent read FOnCollapsing write FOnCollapsing;
property OnDeletion: TdxOcEvent read FOnDeletion write FOnDeletion;
property OnExpanded: TdxOcEvent read FOnExpanded write FOnExpanded;
property OnExpansion: TdxOcAllowEvent read FOnExpansion write FOnExpansion;
property OnEditing: TdxOcAllowEvent read FOnEditing write FOnEditing;
property OnEdited: TdxOcGetTextEvent read FOnEdited write FOnEdited;
property OnSetFont: TdxOcFontEvent read FOnSetFont write FOnSetFont;
property OnDrawNode: TdxOcDrawEvent read FOnDrawNode write FOnDrawNode;
property OnGetText: TdxOcGetTextEvent read FOnGetText write FOnGetText;
property OnSetText: TdxOcSetTextEvent read FOnSetText write FOnSetText;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Invalidate; override;
function Add(Node: TdxOcNode; Data: TdxOcNodeData): TdxOcNode;
function AddChild(Node: TdxOcNode; Data: TdxOcNodeData): TdxOcNode;
function AddFirst(Node: TdxOcNode; Data: TdxOcNodeData): TdxOcNode;
function AddChildFirst(Node: TdxOcNode; Data: TdxOcNodeData): TdxOcNode;
procedure BeginUpdate;
procedure EndUpdate;
procedure Clear;
procedure Delete(Node: TdxOcNode); virtual;
function GetFirstNode: TdxOcNode;
function Insert(Node: TdxOcNode; Data: TdxOcNodeData): TdxOcNode;
procedure FullExpand;
procedure FullCollapse;
function FullWidth: Integer;
function FullHeight: Integer;
function IsZoomed: Boolean;
function GetNodeAt(X, Y: Integer): TdxOcNode;
function GetHitTestsAt(X, Y: Integer): TdxOcHitTests;
function DoZoom(Value: Integer): Integer;
procedure SetLeftTop(ALeft, ATop: Integer);
procedure DragDrop(Source: TObject; X, Y: Integer); override;
procedure DefaultDrawNode(Node: TdxOcNode; ACanvas: TCanvas; Rect: TRect);
procedure AssignData(Source: TdxCustomOrgChart);
procedure ShowEditor; virtual;
procedure HideEditor(Save: Boolean);
procedure SaveToFile(const AFileName: string);
procedure SaveToStream(AStream: TStream);
property AbsoluteItems[Index: Integer]: TdxOcNode read GetAbsoluteItem;
property Count: Integer read FCount;
property DragParent: TdxOcNode read FDragParent;
property RootCount: Integer read GetRootCount;
property Items[Index: Integer]: TdxOcNode read GetItem; default;
property LeftEdge: Integer read GetLeftEdge write SetLeftEdge;
property TopEdge: Integer read GetTopEdge write SetTopEdge;
property Selected: TdxOcNode read FSelected write SetSelected;
property Zoom: Boolean read GetZoom write SetZoom default False;
property Editing: Boolean read GetEditing write SetEditing;
property RootNode: TdxocNode read FRoot;
end;
TdxOrgChart = class(TdxCustomOrgChart)
protected
procedure DefineProperties(Filer: TFiler); override;
public
procedure LoadFromFile(const AFileName: string);
procedure LoadFromStream(AStream: TStream);
published
property LineColor;
property LineWidth;
property SelectedNodeColor;
property SelectedNodeTextColor;
property DefaultNodeWidth;
property DefaultNodeHeight;
property IndentX;
property IndentY;
property EditMode;
property Images;
property DefaultImageAlign;
property BorderStyle;
property Rotated;
property Zoom;
property Options;
property OnCreateNode;
property OnChange;
property OnChanging;
property OnCollapsed;
property OnCollapsing;
property OnDeletion;
property OnExpanded;
property OnExpansion;
property OnEditing;
property OnEdited;
property OnSetFont;
property OnDrawNode;
property OnGetText;
property OnSetText;
property Align;
property Ctl3D;
property Color;
property Enabled;
property Font;
property ParentColor default False;
property ParentCtl3D;
property TabStop default True;
property Visible;
property OnClick;
property OnDblClick;
property OnEnter;
property OnExit;
property OnDragDrop;
property OnDragOver;
property OnStartDrag;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property PopupMenu;
property ParentFont default False;
property ParentShowHint;
property ShowHint;
end;
implementation
uses
Math;
const
StreamDescriptionANSI: AnsiString = 'VER1.0A';
StreamDescriptionUNICODE: AnsiString = 'VER1.0U';
function ReadStr(Stream: TStream; AIsUnicode: Boolean): string;
var
L: Word;
SA: AnsiString;
SW: WideString;
begin
Stream.ReadBuffer(L, SizeOf(Word));
if AIsUnicode then
begin
SetLength(SW, L);
if L > 0 then Stream.ReadBuffer(SW[1], L * 2);
Result := SW;
end
else
begin
SetLength(SA, L);
if L > 0 then Stream.ReadBuffer(SA[1], L);
{$IFDEF DELPHI12}
Result := UTF8ToWideString(SA);
{$ELSE}
Result := SA;
{$ENDIF}
end;
end;
procedure WriteStr(Stream: TStream; const S: string);
var
L: Integer;
{$IFDEF STREAMANSIFORMAT}
SA: AnsiString;
{$ENDIF}
begin
L := Length(S);
if L > $FFFF then L := $FFFF;
Stream.WriteBuffer(L, SizeOf(Word));
if L > 0 then
begin
{$IFDEF STREAMANSIFORMAT}
{$IFDEF DELPHI12}
SA := UTF8Encode(S);
{$ELSE}
SA := S;
{$ENDIF}
Stream.WriteBuffer(SA[1], L);
{$ELSE}
Stream.WriteBuffer(S[1], L * SizeOf(Char));
{$ENDIF}
end;
end;
function GetNV(Value: TdxOcNode): TdxOcNode;
begin
Result := Value.GetNextVisible;
end;
function GetPV(Value: TdxOcNode): TdxOcNode;
begin
Result := Value.GetPrevVisible;
end;
function GetNS(Value: TdxOcNode): TdxOcNode;
begin
Result := Value.GetNextSibling;
end;
function GetPS(Value: TdxOcNode): TdxOcNode;
begin
Result := Value.GetPrevSibling;
end;
{ TdxOcInplaceEdit }
constructor TdxOcInplaceEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Hide;
TabStop := False;
AutoSize := False;
ParentCtl3D := False;
Ctl3D := False;
Parent := TWinControl(AOwner);
end;
procedure TdxOcInplaceEdit.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
begin
Style := Style or ES_MULTILINE;
if emLeft in Tree.EditMode then Style := Style or ES_LEFT;
if emCenter in Tree.EditMode then Style := Style or ES_CENTER;
if emRight in Tree.EditMode then Style := Style or ES_RIGHT;
if emWrap in Tree.EditMode then Style := Style and not ES_AUTOHSCROLL;
if emUpper in Tree.EditMode then Style := Style or ES_UPPERCASE;
if emLower in Tree.EditMode then Style := Style or ES_LOWERCASE;
end;
end;
function TdxOcInplaceEdit.Tree: TdxCustomOrgChart;
begin
Result := TdxCustomOrgChart(Parent);
end;
procedure TdxOcInplaceEdit.WMGetDlgCode(var Msg: TWMGetDlgCode);
begin
inherited;
Msg.Result := Msg.Result or DLGC_WANTTAB or DLGC_WANTALLKEYS;
end;
procedure TdxOcInplaceEdit.WMKillFocus(var Msg: TWMKillFocus);
begin
inherited;
Tree.HideEditor(True);
end;
procedure TdxOcInplaceEdit.KeyUp(var Key: Word; Shift: TShiftState);
begin
Tree.KeyUp(Key, Shift);
end;
procedure TdxOcInplaceEdit.KeyPress(var Key: Char);
begin
Tree.KeyPress(Key);
if Key <> #0 then
begin
inherited KeyPress(Key);
AdjustBounds;
end;
end;
procedure TdxOcInplaceEdit.KeyDown(var Key: Word; Shift: TShiftState);
procedure EndEdit;
begin
if Key = VK_ESCAPE then Modified := False;
Key := 0;
Tree.HideEditor(True);
end;
begin
if Shift = [ssAlt] then
case Key of
VK_RETURN: EndEdit;
VK_UP, VK_DOWN, VK_RIGHT, VK_LEFT:
begin
Tree.KeyDown(Key, []);
Key := 0;
end;
end;
if Shift = [] then
case Key of
VK_F2, VK_ESCAPE: EndEdit;
end;
if Key <> 0 then inherited KeyDown(Key, Shift);
end;
procedure TdxOcInplaceEdit.AdjustBounds;
var
R: TRect;
W, H: Integer;
begin
R := ClientRect;
Tree.DoDrawText(Tree.Canvas.Handle, Text + 'WW' + #13 + #10 + #13 + #10 + 'WW', R, DT_CALCRECT);
W := R.Right - R.Left; H := R.Bottom - R.Top;
if W < FMinW then W := FMinW;
if W > FMaxW then W := FMaxW;
if H < FMinH then H := FMinH;
if H > FMaxH then H := FMaxH;
W := W - ClientWidth; H := H - ClientHeight;
if emWrap in Tree.EditMode then W := 0;
if (W or H) <> 0 then
begin
R := BoundsRect;
Inc(R.Right, W); Inc(R.Bottom, H);
W := W div 2; H := H div 2;
Dec(R.Left, W); Dec(R.Top, H);
Dec(R.Right, W); Dec(R.Bottom, H);
BoundsRect := R;
end;
end;
{ TdxOrgChart }
procedure TdxOrgChart.DefineProperties(Filer: TFiler);
begin
inherited DefineProperties(Filer);
Filer.DefineBinaryProperty('Items', ReadData, WriteData, Count > 0);
end;
procedure TdxOrgChart.LoadFromFile(const AFileName: string);
var
AStream : TMemoryStream;
begin
AStream := TMemoryStream.Create;
try
AStream.LoadFromFile(AFileName);
LoadFromStream(AStream);
finally
AStream.Free;
end;
end;
procedure TdxOrgChart.LoadFromStream(AStream: TStream);
begin
ReadData(AStream);
end;
{ TdxCustomOrgChart }
constructor TdxCustomOrgChart.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FTimer := TTimer.Create(self);
FTimer.Enabled := False;
FTimer.Interval := 220;
FTimer.OnTimer := DoTimerScrolling;
FRoot := TdxOcNode.Create(Self);
FRoot.FExpanded := True;
Width := 320;
Height := 200;
ParentColor := False;
ParentFont := False;
TabStop := True;
FDefaultNodeWidth := 64;
FDefaultNodeHeight := 40;
FIndentX := 16;
FIndentY := 16;
FLineWidth := 1;
FLineColor := clBlack;
FBorderStyle := bsSingle;
FSelectedNodeColor := clHighlight;
FSelectedNodeTextColor := clHighlightText;
FSizeChanged := True;
FOptions := [ocSelect, ocFocus, ocButtons, ocDblClick, ocEdit, ocCanDrag, ocShowDrag];
FEditMode := [emWrap];
FZoom := 1;
FImagesChangeLink := TChangeLink.Create;
FImagesChangeLink.OnChange := ImageListChange;
end;
destructor TdxCustomOrgChart.Destroy;
begin
FTimer.Free;
FTimer := nil;
HideEditor(False);
FreeAndNil(FEditor);
FBitmap.Free;
Selected := nil;
Images := nil;
FImagesChangeLink.Free;
FRoot.HasChildren := False;
FRoot.FDeleting := True;
FRoot.Free;
inherited Destroy;
end;
procedure TdxCustomOrgChart.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.WindowClass.Style := Params.WindowClass.Style and not (CS_HREDRAW or CS_VREDRAW);
Params.Style := Params.Style or WS_TABSTOP or WS_HSCROLL or WS_VSCROLL;
if BorderStyle = bsSingle then
if Ctl3D then
Params.ExStyle := Params.ExStyle or WS_EX_CLIENTEDGE
else
Params.Style := Params.Style or WS_BORDER;
end;
procedure TdxCustomOrgChart.CreateHandle;
begin
inherited CreateHandle;
if FZoom = 0 then UpdateScrollRange;
end;
procedure TdxCustomOrgChart.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = Images) then
Images := nil;
end;
procedure TdxCustomOrgChart.SetBorderStyle(Value: TBorderStyle);
begin
if Value <> BorderStyle then
begin
FBorderStyle := Value;
RecreateWnd;
end;
end;
function TdxCustomOrgChart.IsMyNode(Value: TdxOcNode): Boolean;
begin
if (Value = nil) or (Value = FRoot) then
Result := True
else
Result := Value.HasAsParent(FRoot);
end;
procedure TdxCustomOrgChart.DoAdd(AParent, ANode: TdxOcNode; AIndex: Integer);
begin
if AParent = nil then AParent := FRoot;
if AIndex < 0 then AIndex := AParent.Count;
ANode.FParent := AParent;
with AParent do
begin
HasChildren := True;
FList.Insert(AIndex, ANode);
Enumerate(AIndex);
InvalidateSize(ivBoth);
end;
end;
function TdxCustomOrgChart.InternalAdd(ParentNode: TdxOcNode; Data: TdxOcNodeData;
Idx: Integer): TdxOcNode;
begin
Result := nil;
if not IsMyNode(ParentNode) then Exit;
Result := CreateNode;
if Result = nil then Exit;
Result.FData := Data;
if Assigned(OnCreateNode) then OnCreateNode(Self, Result);
DoAdd(ParentNode, Result, Idx);
Inc(FCount);
if Count = 1 then Selected := Result;
end;
procedure TdxCustomOrgChart.InternalMoveTo(ParentNode, Node: TdxOcNode; Idx: Integer);
begin
with Node.FParent do
begin
FList.Delete(Node.Index);
Enumerate(Node.Index);
if Node.Parent <> ParentNode then
InvalidateSize(ivBoth);
if FList.Count = 0 then
begin
HasChildren := False;
if (FParent <> nil) then
FExpanded := False;
end;
end;
DoAdd(ParentNode, Node, Idx);
end;
function TdxCustomOrgChart.Insert(Node: TdxOcNode; Data: TdxOcNodeData): TdxOcNode;
begin
if Node = nil then
Result := nil
else
Result := InternalAdd(Node.Parent, Data, Node.Index);
end;
function TdxCustomOrgChart.Add(Node: TdxOcNode; Data: TdxOcNodeData): TdxOcNode;
begin
if Node = nil then
Result := AddChild(nil, Data)
else
Result := InternalAdd(Node.Parent, Data, -1);
end;
function TdxCustomOrgChart.AddFirst(Node: TdxOcNode; Data: TdxOcNodeData): TdxOcNode;
begin
if Node = nil then
Result := AddChildFirst(nil, Data)
else
Result := InternalAdd(Node.Parent, Data, 0);
end;
function TdxCustomOrgChart.AddChild(Node: TdxOcNode; Data: TdxOcNodeData): TdxOcNode;
begin
Result := InternalAdd(Node, Data, -1);
end;
function TdxCustomOrgChart.AddChildFirst(Node: TdxOcNode; Data: TdxOcNodeData): TdxOcNode;
begin
Result := InternalAdd(Node, Data, 0);
end;
function TdxCustomOrgChart.GetAbsoluteItem(Index: Integer): TdxOcNode;
begin
Result := RootNode.AbsoluteItems[Index];
end;
function TdxCustomOrgChart.GetItem(Index: Integer): TdxOcNode;
begin
Result := FRoot.GetItem(Index);
end;
function TdxCustomOrgChart.GetRootCount: Integer;
begin
Result := RootNode.Count;
end;
function TdxCustomOrgChart.HasButton(Node: TdxOcNode): Boolean;
begin
Result := (ocButtons in Options) and (Node.Count > 0) and not (IsZoomed and Node.Expanded);
end;
procedure TdxCustomOrgChart.RotatePoint(var X, Y: LongInt);
var
Tmp: Integer;
begin
if Rotated then
begin
Tmp := X; X := Y; Y := Tmp;
end;
end;
function TdxCustomOrgChart.RotateRect(const Rect: TRect): TRect;
var
Tmp: Integer;
begin
Result := Rect;
if Rotated then
with Result do
begin
Tmp := Left; Left := Top; Top := Tmp;
Tmp := Right; Right := Bottom; Bottom := Tmp;
end;
end;
procedure TdxCustomOrgChart.Paint;
var
Upd: TRect;
Cnv: TCanvas;
TmpFont: TFont;
Time:{$IFDEF DELPHI9}DWORD{$ELSE}Integer{$ENDIF};
Anim: Integer;
function InRect(const R: TRect): Boolean;
begin
Result := not
((R.Left > Upd.Right) or (R.Right < Upd.Left) or (R.Top > Upd.Bottom) or (R.Bottom < Upd.Top));
end;
procedure SetCanvas;
begin
with Cnv do
begin
Pen.Mode := pmCopy;
Pen.Style := psSolid;
Pen.Color := LineColor;
Pen.Width := LineWidth;
Brush.Style := bsSolid;
end;
end;
procedure ExtMoveTo(X, Y: Integer);
begin
RotatePoint(X, Y);
Cnv.MoveTo(X, Y);
end;
procedure ExtLineTo(X, Y: Integer);
begin
RotatePoint(X, Y);
Cnv.LineTo(X, Y);
end;
procedure Erase;
begin
Cnv.Brush.Style := bsSolid;
Cnv.Brush.Color := Color;
Cnv.FillRect(RotateRect(Upd));
end;
procedure PaintFrame(Node: TdxOcNode; const R: TRect);
var
Rad: Integer;
Pts: array[0..3] of TPoint;
begin
case Node.Shape of
shRectangle:
begin
Cnv.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
if ocRect3D in Options then
with Cnv do
begin
Rad := LineWidth shr 1;
MoveTo(R.Left + LineWidth, R.Bottom + Rad);
LineTo(R.Right + Rad, R.Bottom + Rad);
LineTo(R.Right + Rad, R.Top + LineWidth);
end;
end;
shEllipse: Cnv.Ellipse(R.Left, R.Top, R.Right, R.Bottom);
shRoundRect:
begin
Rad := Node.Radius;
Cnv.RoundRect(R.Left, R.Top, R.Right, R.Bottom, Rad, Rad);
end;
shDiamond:
begin
Pts[0].X := R.Left; Pts[0].Y := R.Top + (R.Bottom - R.Top) shr 1;
Pts[1].X := R.Left + (R.Right - R.Left) shr 1; Pts[1].Y := R.Top;
Pts[2].X := R.Right - 1; Pts[2].Y := Pts[0].Y;
Pts[3].X := Pts[1].X; Pts[3].Y := R.Bottom - 1;
Cnv.Polygon(Pts);
end;
end;
Cnv.TextWidth('');
end;
procedure PaintButton(X, Y: Integer; Value: Boolean);
begin
if Rotated then
begin
RotatePoint(X, Y);
Inc(Y); Dec(X);
end;
with Cnv do
begin
Pen.Width := 1; Brush.Color := Color;
Rectangle(X - 5, Y - 6, X + 6, Y + 5);
MoveTo(X - 2, Y - 1); LineTo(X + 3, Y - 1);
if not Value then
begin
MoveTo(X, Y - 3);
LineTo(X, Y + 2);
end;
end;
end;
function GetAnimRect(Node: TdxOcNode; Coef: Integer): TRect;
begin
with Result do
begin
Left := Node.FAnimX + (Node.FAnimX0 - Node.FAnimX) * Coef div 16;
Top := Node.FAnimY + (Node.FAnimY0 - Node.FAnimY) * Coef div 16;
Right := Left + Node.ExtWidth + LineWidth;
Bottom := Top + Node.ExtHeight + IndentY + LineWidth;
end;
end;
function PaintNode(Node: TdxOcNode): TPoint;
var
Where: TRect;
Line: TPoint;
I, LinLeft, LinRight: Integer;
begin
Where := GetAnimRect(Node, Anim);
if Node = FRoot then Where.Bottom := Where.Top;
with Where do
begin
Result.X := Left + (Right - Left) shr 1;
Result.Y := Top + IndentY shr 1;
end;
if not Node.FDraw then Exit;
if (Where.Bottom < Upd.Bottom) and (Node.Expanded or (FCollapsed = Node)) then
begin
LinLeft := 0; LinRight := -1;
for I := 0 to Node.Count - 1 do
begin
Line := PaintNode(Node[I]);
if (I = 0) or (Line.X < Upd.Left) then LinLeft := Line.X;
LinRight := Line.X;
if Line.X >= Upd.Right then Break;
end;
SetCanvas;
if not ((Node = FRoot) and (Node.Count <= 1)) then
begin
if (Node = FRoot) and (Node.Count > 1) then Result.X := LinRight;
if Result.X < LinLeft then LinLeft := Result.X;
if Result.X > LinRight then LinRight := Result.X;
ExtMoveTo(LinLeft, Line.Y);
ExtLineTo(LinRight, Line.Y);
end;
if (Node <> FRoot) and (Line.Y > Where.Bottom) then
begin
ExtMoveTo(Result.X, Where.Bottom - LineWidth);
ExtLineTo(Result.X, Line.Y);
end;
end;
I := 0;
if HasButton(Node) then I := 6 - LineWidth shr 1;
if I < 0 then I := 0;
Inc(Where.Bottom, I);
if (Node <> FRoot) and InRect(Where) then
begin
Dec(Where.Bottom, I); I := LineWidth;
with Where do
begin
if Node.Is3D then
begin
Dec(Right, I); Dec(Bottom, I);
end;
I := I shr 1;
Inc(Left, I); Inc(Top, I);
Dec(Right, I); Dec(Bottom, I);
end;
SetCanvas;
with Cnv do
begin
Font := TmpFont;
Brush.Color := Node.Color;
if (ocSelect in Options) and Node.Focused then
begin
Brush.Color := SelectedNodeColor;
Font.Color := SelectedNodeTextColor;
end;
ExtMoveTo(Result.X, Result.Y);
Inc(Where.Top, IndentY);
if (Node.Parent <> nil) or (FRoot.Count > 1) then ExtLineTo(Result.X, Where.Top);
PaintFrame(Node, RotateRect(Where));
Dec(Where.Top, IndentY);
end;
I := Where.Bottom;
Where := RotateRect(Where);
Node.DisplayToClient(Where);
if InRect(RotateRect(Where)) then
begin
Node.SetFont(Cnv.Font);
DrawNode(Node, Cnv, Where);
SetCanvas;
if (ocFocus in Options) and Node.Selected then Cnv.DrawFocusRect(Where);
end;
if HasButton(Node) then PaintButton(Result.X, I, Node.Expanded);
end;
end;
procedure PaintAnim;
begin
Erase;
PaintNode(FRoot);
Canvas.Draw(0, 0, FBitmap);
end;
var
ARect: TRect;
begin
Anim := 0;
SetRect(ARect, 0, 0, FullWidth, FullHeight);
if csPaintCopy in ControlState then
Upd := RotateRect(ARect)
else
Upd := RotateRect(Canvas.ClipRect);
with Upd do
if (Left >= Right) and (Top > Bottom) then Exit;
if (FCollapsed = nil) and (FBitmap <> nil) then
begin
FBitmap.Free;
FBitmap := nil;
end;
if FBitmap <> nil then
begin
if FBitmap.Width <> Self.Width then // Fix: by Kirill (Hole)
FBitmap.Width := Self.Width; // Fix: by Kirill (Hole)
if FBitmap.Height <> Self.Height then // Fix: by Kirill (Hole)
FBitmap.Height := Self.Height; // Fix: by Kirill (Hole)
end;
FRoot.SetAnimXY(0, 0, Upd, FBitmap = nil);
TmpFont := TFont.Create; TmpFont.Assign(Font);
TmpFont.Height := DoZoom(Font.Height);
try
if FBitmap = nil then
begin
Cnv := Canvas;
Erase;
PaintNode(FRoot);
end
else
begin
Cnv := FBitmap.Canvas;
Time := GetCurrentTime;
for Anim := 15 downto 1 do
begin
Inc(Time, 10);
PaintAnim;
while Time > GetCurrentTime do
;
end;
FCollapsed := nil;
PaintAnim;
end;
finally
TmpFont.Free;
FUpdated := False;
end;
end;
procedure TdxCustomOrgChart.DoDrawText(Handle: HDC; Text: string; var Rect: TRect; Flags: Integer);
var
ARect: TRect;
HText: Integer;
begin
ARect := Rect;
Flags := Flags or DT_EXPANDTABS;
if emLeft in EditMode then Flags := Flags or DT_LEFT;
if emCenter in EditMode then Flags := Flags or DT_CENTER;
if emRight in EditMode then Flags := Flags or DT_RIGHT;
if emWrap in EditMode then Flags := Flags or DT_WORDBREAK;
if emVCenter in EditMode then
begin
HText := DrawText(Handle, PChar(Text), -1, ARect, Flags or DT_CALCRECT);
if (Rect.Bottom - Rect.Top) > HText then
begin
inc(Rect.Top, (Rect.Bottom - Rect.Top - HText) div 2);
Rect.Bottom := Rect.Top + HText;
end;
end;
DrawText(Handle, PChar(Text), -1, Rect, Flags or DT_EDITCONTROL);
end;
procedure TdxCustomOrgChart.DoDrawImage(ACanvas: TCanvas; FullRect, R: TRect; ABitmap: TBitmap);
const
ROP_DSPDxax = $00E20746;
var
W, H, BW, BH: Integer;
DC, MaskDC: HDC;
B, MaskHandle: HBITMAP;
crText, crBack: COLORREF;
ARect: TRect;
begin
with ACanvas, R do
begin
W := Right - Left;
H := Bottom - Top;
BW := ABitmap.Width;
BH := ABitmap.Height;
OffsetRect(R, -FullRect.Left, -FullRect.Top);
DC := CreateCompatibleDC(Handle);
with FullRect do
B := CreateCompatibleBitmap(Handle, Right - Left, Bottom - Top);
B := SelectObject(DC, B);
try
MaskDC := CreateCompatibleDC(0);
MaskHandle := ABitmap.MaskHandle;
MaskHandle := SelectObject(MaskDC, MaskHandle);
try
SetRect(ARect, 0, 0, FullRect.Right - FullRect.Left, FullRect.Bottom - FullRect.Top);
Windows.FillRect(DC, ARect, Brush.Handle);
StretchBlt(DC, Left, Top, W, H, ABitmap.Canvas.Handle, 0, 0, BW, BH, SRCCOPY);
crText := SetTextColor(DC, 0);
crBack := SetBkColor(DC, $FFFFFF);
SelectObject(DC, Brush.Handle);
StretchBlt(DC, Left, Top, W, H, MaskDC, 0, 0, BW, BH, ROP_DSPDxax);
SetTextColor(DC, crText);
SetBkColor(DC, crBack);
finally
SelectObject(MaskDC, MaskHandle);
DeleteDC(MaskDC);
end;
with FullRect do
BitBlt(Handle, Left, Top, Right - Left, Bottom - Top, DC, 0, 0, SRCCOPY);
finally
DeleteObject(SelectObject(DC, B));
DeleteDC(DC);
end;
end;
end;
procedure TdxCustomOrgChart.DrawNode(Node: TdxOcNode; ACanvas: TCanvas; Rect: TRect);
begin
if Assigned(OnDrawNode) then
OnDrawNode(Self, Node, ACanvas, Rect)
else
DefaultDrawNode(Node, ACanvas, Rect);
end;
procedure TdxCustomOrgChart.DefaultDrawNode(Node: TdxOcNode; ACanvas: TCanvas; Rect: TRect);
var
P: TPoint;
Bmp: TBitmap;
ARect: TRect;
begin
P := Node.ClientToText(Rect);
if (P.X + P.Y >= -999999) and (Node.ImageIndex <> -1) then
begin
Bmp := TBitmap.Create;
Images.GetBitmap(Node.ImageIndex, Bmp);
ARect.Left := P.X;
ARect.Top := P.Y;
ARect.Right := ARect.Left + DoZoom(Bmp.Width);
ARect.Bottom := ARect.Top + DoZoom(Bmp.Height);
DoDrawImage(ACanvas, ARect, ARect, Bmp);
Bmp.Free;
end;
DoDrawText(ACanvas.Handle, Node.Text, Rect, 0);
end;
function TdxCustomOrgChart.InitAnimate(Node: TdxOcNode): Boolean;
var
ARect: TRect;
begin
Result := not FNoAnim and (ocAnimate in Options) and HandleAllocated and Node.IsVisible;
if Result then
begin
FCollapsed := Node;
SetRect(ARect, 0, 0, ClientWidth, ClientHeight);
FRoot.SetAnimXY(0, 0, ARect, True);
if FBitmap = nil then
begin
FBitmap := TBitmap.Create;
with FBitmap do
begin
Width := Self.Width;
Height := Self.Height;
{$IFDEF DELPHI3}TransparentColor := clNone; {$ENDIF}
end;
end;
end;
end;
function TdxCustomOrgChart.MinSizes: TPoint;
begin
if Images = nil then
begin
Result.X := 16;
Result.Y := 16;
end else
begin
Result.X := Images.Width shl 1;
Result.Y := Images.Height shl 1;
end;
if Result.X < 16 then Result.X := 16;
if Result.Y < 16 then Result.Y := 16;
end;
procedure TdxCustomOrgChart.SetNodeWidth(Value: Word);
var
P: TPoint;
begin
P := MinSizes;
if Value < P.X then Value := P.X;
if Value = DefaultNodeWidth then Exit;
FDefaultNodeWidth := Value;
if Rotated then
InvalidateSizes(ivHeight)
else
InvalidateSizes(ivWidth);
end;
procedure TdxCustomOrgChart.SetNodeHeight(Value: Word);
var
P: TPoint;
begin
P := MinSizes;
if Value < P.Y then Value := P.Y;
if Value = DefaultNodeHeight then Exit;
FDefaultNodeHeight := Value;
if Rotated then
InvalidateSizes(ivWidth)
else
InvalidateSizes(ivHeight);
end;
procedure TdxCustomOrgChart.SetIndentX(Value: Word);
begin
if Value = FIndentX then Exit;
FIndentX := Value;
if Rotated then
InvalidateSizes(ivHeight)
else
InvalidateSizes(ivWidth);
end;
procedure TdxCustomOrgChart.SetIndentY(Value: Word);
begin
if Value = FIndentY then Exit;
FIndentY := Value;
if Rotated then
InvalidateSizes(ivWidth)
else
InvalidateSizes(ivHeight);
end;
function TdxCustomOrgChart.IsUpdated: Boolean;
begin
//// Result := FUpdated or (FUpdate <> 0); // Fix: by Kirill (IsUpdate)
Result := FUpdated and (FUpdate <> 0); // Fix: by Kirill (IsUpdate)
if Result = False then FUpdated := False; // Fix: by Kirill (IsUpdate)
end;
procedure TdxCustomOrgChart.Invalidate;
begin
if not IsUpdated then inherited Invalidate;
FUpdated := True;
end;
procedure TdxCustomOrgChart.InvalidateSizes(Flags: TdxOcIvFlags);
procedure IvSz(Node: TdxOcNode; Flags: TdxOcIvFlags);
var
I: Integer;
begin
if Flags in [ivWidth, ivBoth] then Node.FChildrenWidth := 0;
if Flags in [ivHeight, ivBoth] then Node.FChildrenHeight := 0;
for I := 0 to Node.Count - 1 do
IvSz(Node[I], Flags);
end;
begin
IvSz(FRoot, Flags);
ChangeSize;
end;
procedure TdxCustomOrgChart.SetLineColor(Value: TColor);
begin
if (Value = clNone) or (Value = clDefault) then Value := clBlack;
if Value = LineColor then Exit;
FLineColor := Value;
if HandleAllocated then
Invalidate;
end;
procedure TdxCustomOrgChart.SetLineWidth(Value: Word);
begin
if Value = 0 then Value := 1;
if Value = FLineWidth then Exit;
FLineWidth := Value;
InvalidateSizes(ivBoth);
end;
procedure TdxCustomOrgChart.SetSelectedNodeColor(Value: TColor);
begin
if (Value = clNone) or (Value = clDefault) then Value := clHighlight;
if Value = SelectedNodeColor then Exit;
FSelectedNodeColor := Value;
if HandleAllocated then
Invalidate;
end;
procedure TdxCustomOrgChart.SetSelectedNodeTextColor(Value: TColor);
begin
if (Value = clNone) or (Value = clDefault) then Value := clHighlightText;
if Value = SelectedNodeTextColor then Exit;
FSelectedNodeTextColor := Value;
if HandleAllocated then
Invalidate;
end;
procedure TdxCustomOrgChart.FullExpand;
begin
FRoot.Expand(True);
end;
procedure TdxCustomOrgChart.FullCollapse;
begin
FRoot.Collapse(True);
end;
procedure TdxCustomOrgChart.Delete(Node: TdxOcNode);
begin
if (Node = nil) or not IsMyNode(Node) then Exit;
if Node.Selected or ((Selected <> nil) and Selected.HasAsParent(Node)) then
begin
Selected := Node.GetNextSibling;
if Selected = nil then Selected := Node.GetPrevSibling;
if Selected = nil then Selected := Node.Parent;
end;
if Assigned(OnDeletion) then OnDeletion(Self, Node);
with Node do
begin
HasChildren := False;
FDeleting := True;
Data := nil;
end;
with Node.FParent do
if not Deleting then
begin
FList.Delete(Node.Index);
Enumerate(Node.Index);
InvalidateSize(ivBoth);
if (FList.Count = 0) and (FParent <> nil) then
FExpanded := False;
if FList.Count = 0 then
HasChildren := False;
end;
Dec(FCount);
Node.Free;
end;
function TdxCustomOrgChart.CreateNode: TdxOcNode;
begin
Result := TdxOcNode.Create(Self);
end;
procedure TdxCustomOrgChart.BeginUpdate;
begin
if (FUpdate = 0) and HandleAllocated then SendMessage(Handle, WM_SETREDRAW, 0, 0);
Inc(FUpdate);
end;
procedure TdxCustomOrgChart.EndUpdate;
begin
if FUpdate = 0 then Exit;
Dec(FUpdate);
if (FUpdate = 0) and HandleAllocated then
begin
SendMessage(Handle, WM_SETREDRAW, 1, 0);
FUpdated := False;
Invalidate;
end;
end;
procedure TdxCustomOrgChart.ChangeSize;
begin
if FSizeChanged then Exit;
HideEditor(True);
Invalidate;
FSizeChanged := True;
FHitTests := [];
end;
procedure TdxCustomOrgChart.RecalcSizes;
begin
if FSizeChanged then
begin
FSizeChanged := False;
if FZoom = 0 then
SetZoomRatio
else
UpdateScrollRange;
end;
end;
function TdxCustomOrgChart.FullWidth: Integer;
begin
if Rotated then
Result := FRoot.ChildrenHeight + 6
else
Result := FRoot.ChildrenWidth;
end;
function TdxCustomOrgChart.FullHeight: Integer;
begin
if Rotated then
Result := FRoot.ChildrenWidth
else
Result := FRoot.ChildrenHeight + 6;
end;
procedure TdxCustomOrgChart.UpdateScrollRange;
var
NewX, NewY: Integer;
Info: TScrollInfo;
function SetScr(Code, Page, Max: Integer): Integer;
begin
with Info do
begin
cbSize := SizeOf(Info);
fMask := SIF_ALL;
GetScrollInfo(Handle, Code, Info);
Result := nPos;
fMask := SIF_PAGE or SIF_RANGE;
nMin := 0;
nMax := Max;
nPage := Page;
end;
SetScrollInfo(Handle, Code, Info, True);
end;
begin
if not HandleAllocated then Exit;
NewX := SetScr(SB_HORZ, ClientWidth, FullWidth);
NewY := SetScr(SB_VERT, ClientHeight, FullHeight);
SetLeftTop(NewX, NewY);
end;
procedure TdxCustomOrgChart.SetLeftTop(ALeft, ATop: Integer);
procedure Adjust(AMax: Integer; var Value: Integer);
begin
Value := Max(Min(Value, AMax), 0);
end;
var
DX, DY: Integer;
begin
Adjust(FullWidth - ClientWidth, ALeft);
Adjust(FullHeight - ClientHeight, ATop);
if (ALeft = LeftEdge) and (ATop = TopEdge) then Exit;
DX := LeftEdge - ALeft;
DY := TopEdge - ATop;
FLeftEdge := ALeft;
FTopEdge := ATop;
if not HandleAllocated then Exit;
ScrollWindow(Handle, DX, DY, nil, nil);
if DX <> 0 then
SetScrollPos(Handle, SB_HORZ, ALeft, True);
if DY <> 0 then
SetScrollPos(Handle, SB_VERT, ATop, True);
end;
function TdxCustomOrgChart.GetLeftEdge: Integer;
begin
if FZoom <> 0 then RecalcSizes;
Result := FLeftEdge;
end;
function TdxCustomOrgChart.GetTopEdge: Integer;
begin
if FZoom <> 0 then RecalcSizes;
Result := FTopEdge;
end;
procedure TdxCustomOrgChart.SetLeftEdge(Value: Integer);
begin
if Value <> LeftEdge then
SetLeftTop(Value, TopEdge);
end;
procedure TdxCustomOrgChart.SetTopEdge(Value: Integer);
begin
if Value <> TopEdge then
SetLeftTop(LeftEdge, Value);
end;
procedure TdxCustomOrgChart.Clear;
begin
Selected := nil;
FRoot.DeleteChildren;
end;
function TdxCustomOrgChart.InvalidateNode(Value: TdxOcNode): Boolean;
var
R: TRect;
DX, DY: Word;
begin
Result := False;
if HandleAllocated and not IsUpdated then
begin
R := Value.DisplayRect;
if R.Left = R.Right then Exit;
if Rotated then
Dec(R.Left, 6)
else
Dec(R.Top, 6);
Result := True;
DX := 0; DY := 0;
if HasButton(Value) then
if Rotated then
DX := 6
else
DY := 6;
if Value.Is3D then
begin
if DX < LineWidth then DX := LineWidth;
if DY < LineWidth then DY := LineWidth;
end;
Inc(R.Right, DX); Inc(R.Bottom, DY);
InflateRect(R, LineWidth, LineWidth);
InvalidateRect(Handle, @R, True);
end;
end;
function TdxCustomOrgChart.InvalidateSel: Boolean;
begin
Result := (Selected <> nil) and InvalidateNode(Selected);
end;
procedure TdxCustomOrgChart.SetSelected(Value: TdxOcNode);
var
Edit: Boolean;
begin
if (Value = Selected) or not IsMyNode(Value) then Exit;
Edit := Editing; HideEditor(True);
if InvalidateSel then
begin
FSelected := nil;
if (Value <> nil) and Value.IsVisible then Update;
end;
FSelected := Value;
InvalidateSel;
Editing := Edit;
DoChange(Value);
end;
function TdxCustomOrgChart.GetFirstNode: TdxOcNode;
begin
if Count = 0 then
Result := nil
else
Result := FRoot[0];
end;
procedure TdxCustomOrgChart.HitTestsAt(X, Y: Integer);
procedure InRect(Node: TdxOcNode; LeftX, TopY: Integer);
var
R, RN: TRect;
I: Integer;
function InFrame(Sh: TdxOcShape): Boolean;
label
Ell;
var
X0, Y0, X1, Y1, A, B: Integer;
begin
Result := False;
if Sh = shRectangle then
begin
Result := True;
Exit;
end;
case Node.ChildAlign of
caLeft:
begin
X0 := 0;
X1 := -IndentX;
end;
caCenter:
begin
X0 := IndentX shr 1;
X1 := -(IndentX shr 1);
end;
else
X0 := IndentX;
X1 := 0;
end;
if Sh = shRoundRect then
begin
A := Node.Radius shr 1;
Inc(X0, (R.Left + A)); Inc(X1, (R.Right - A));
Y0 := R.Top + A + IndentY; Y1 := R.Bottom - A;
if ((X >= X0) and (X <= X1)) or ((Y >= Y0) and (Y <= Y1)) then
begin
Result := True;
Exit;
end;
if X > X0 then X0 := X1;
if Y > Y0 then Y0 := Y1;
X1 := X - X0; Y1 := Y - Y0; goto Ell;
end;
A := (R.Right - R.Left - IndentX) shr 1; B := (R.Bottom - R.Top - IndentY) shr 1;
Inc(X0, (R.Left + A)); Y0 := R.Top + B + IndentY;
X1 := Abs(X - X0); Y1 := Abs(Y - Y0);
if Sh = shDiamond then
begin
if X1 * B + Y1 * A <= A * B then Result := True;
Exit;
end;
if A >= B then
Y1 := Y1 * A div B
else
begin
X1 := X1 * B div A;
A := B;
end;
Ell:
if X1 * X1 + Y1 * Y1 <= A * A then Result := True;
end;
begin
R.Left := LeftX; R.Top := TopY;
R.Right := R.Left + Node.FullWidth;
if Node = FRoot then
R.Bottom := R.Top - 7
else
R.Bottom := R.Top + Node.ExtHeight + IndentY + LineWidth;
if (X < R.Left) or (X >= R.Right) then Exit;
if (Y >= R.Top) and (Y < R.Bottom + 6) then
begin
FHitTests := []; FNodeAt := Node;
RN := R; Node.FullToDisplay(RN);
RN.Top := RN.Top + IndentY;
if Y < RN.Top then Include(FHitTests, htOnIndentY);
if X < RN.Left then Include(FHitTests, htOnLeftIndentX);
if X > RN.Right then Include(FHitTests, htOnRightIndentX);
if FHitTests = [] then
begin
if Y < RN.Bottom then
begin
FHitTests := [htOnRect];
if Node.Is3D then Dec(RN.Bottom, LineWidth);
if InFrame(Node.Shape) then Include(FHitTests, htOnShape);
end;
if HasButton(Node) then
begin
I := Node.ExtWidth shr 1 - 5;
if (X >= RN.Left + I) and (X < RN.Left + I + 11) and (Y >= RN.Bottom - 6)
then Include(FHitTests, htOnButton);
end;
end;
if (Y >= R.Bottom) and not (htOnButton in FHitTests) then FNodeAt := nil;
end;
if FNodeAt = nil then
begin
if not Node.Expanded then
begin
if (Y >= R.Bottom) and (Y <= R.Bottom + Node.ExtHeight) then
begin
FNodeAt := Node;
FHitTests := [htUnder];
end;
Exit;
end;
R.Left := R.Left + Node.ChildOffset;
if R.Bottom < R.Top then R.Bottom := R.Top;
for I := 0 to Node.Count - 1 do
begin
InRect(Node[I], R.Left, R.Bottom);
if FNodeAt <> nil then Exit;
R.Left := R.Left + Node[I].FullWidth;
end;
end;
end;
begin
FNodeAt := nil;
FHitX := X; FHitY := Y;
RotatePoint(X, Y);
if Rotated then
InRect(FRoot, -TopEdge, -LeftEdge)
else
InRect(FRoot, -LeftEdge, -TopEdge);
if FNodeAt = nil then FHitTests := [htNowhere];
end;
function TdxCustomOrgChart.GetNodeAt(X, Y: Integer): TdxOcNode;
begin
if (FHitTests = []) or (X <> FHitX) or (Y <> FHitY) then HitTestsAt(X, Y);
Result := FNodeAt;
end;
function TdxCustomOrgChart.GetHitTestsAt(X, Y: Integer): TdxOcHitTests;
begin
if (FHitTests = []) or (X <> FHitX) or (Y <> FHitY) then HitTestsAt(X, Y);
Result := FHitTests;
end;
procedure TdxCustomOrgChart.DoChange(Node: TdxOcNode);
begin
if Assigned(OnChange) then OnChange(Self, Node);
end;
procedure TdxCustomOrgChart.DoChanging(Node: TdxOcNode; var Allow: Boolean);
begin
Allow := True;
if Assigned(OnChanging) then OnChanging(Self, Node, Allow);
end;
procedure TdxCustomOrgChart.DoNavigate(ANavigateCode: TdxOcNavigate; AValue: Integer);
var
ANextNode: TdxOcNode;
begin
case ANavigateCode of
ocnLineLeft: LeftEdge := LeftEdge - OtScrollUnit;
ocnLineUp: TopEdge := TopEdge - OtScrollUnit;
ocnLineRight: LeftEdge := LeftEdge + OtScrollUnit;
ocnLineDown: TopEdge := TopEdge + OtScrollUnit;
ocnPageLeft: LeftEdge := LeftEdge - ClientWidth + OtScrollUnit;
ocnPageUp: TopEdge := TopEdge - ClientHeight + OtScrollUnit;
ocnPageRight: LeftEdge := LeftEdge + ClientWidth - OtScrollUnit;
ocnPageDown: TopEdge := TopEdge + ClientHeight - OtScrollUnit;
ocnLeft: LeftEdge := 0;
ocnTop: TopEdge := 0;
ocnRight: LeftEdge := FullWidth - ClientWidth;
ocnBottom: TopEdge := FullHeight - ClientHeight;
ocnLeftPosition: LeftEdge := AValue;
ocnTopPosition: TopEdge := AValue;
ocnSelectNextLeft:
begin
ANextNode := NextSel(GetPS);
if ANextNode = nil then
ANextNode := NextSel(GetPV);
SelectNode(ANextNode);
end;
ocnSelectNextUp: SelectNode(NextSel(GetPV));
ocnSelectNextRight:
begin
ANextNode := NextSel(GetNS);
if ANextNode = nil then
ANextNode := NextSel(GetNV);
SelectNode(ANextNode);
end;
ocnSelectNextDown: SelectNode(NextSel(GetNV));
end;
end;
function TdxCustomOrgChart.CanSelect(Node: TdxOcNode): Boolean;
begin
DoChanging(Node, Result);
end;
function TdxCustomOrgChart.NextSel(Get: TdxOcNodeFunc): TdxOcNode;
begin
if Selected = nil then
Result := nil
else
Result := Get(Selected);
while (Result <> nil) and not CanSelect(Result) do
Result := Get(Result);
end;
procedure TdxCustomOrgChart.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
procedure DoSelect;
begin
if CanSelect(FNodeAt) then Selected := FNodeAt;
end;
begin
if (Button = mbLeft) and not (ssDouble in Shift) then
begin
SetFocus;
FDrag := True;
GetNodeAt(X, Y);
if FHitTests * [htOnShape, htOnButton] = [htOnShape] then DoSelect;
if htOnButton in FHitTests then
begin
if (Selected <> nil) and FNodeAt.Expanded and Selected.HasAsParent(FNodeAt)
then DoSelect;
with FNodeAt do
Expanded := not Expanded;
end;
end;
inherited MouseDown(Button, Shift, X, Y);
end;
procedure TdxCustomOrgChart.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
if FDrag and (ocCanDrag in Options) and not Dragging and ((Shift = [ssLeft]) or (Shift = [ssLeft, ssCtrl]))
and (htOnShape in GetHitTestsAt(X, Y)) and (FNodeAt = Selected)
then BeginDrag(False);
if not Dragging then inherited MouseMove(Shift, X, Y);
end;
function TdxCustomOrgChart.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean;
begin
Result := inherited DoMouseWheelDown(Shift, MousePos);
if not Result then
begin
if Shift = [] then
begin
DoNavigate(ocnLineDown);
DoNavigate(ocnLineDown);
DoNavigate(ocnLineDown);
end
else
if Shift = [ssCtrl] then
DoNavigate(ocnPageDown)
else
if Shift = [ssShift] then
DoNavigate(ocnSelectNextDown);
Result := True;
end;
end;
function TdxCustomOrgChart.DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean;
begin
Result := inherited DoMouseWheelUp(Shift, MousePos);
if not Result then
begin
if Shift = [] then
begin
DoNavigate(ocnLineUp);
DoNavigate(ocnLineUp);
DoNavigate(ocnLineUp);
end
else
if Shift = [ssCtrl] then
DoNavigate(ocnPageUp)
else
if Shift = [ssShift] then
DoNavigate(ocnSelectNextUp);
Result := True;
end;
end;
procedure TdxCustomOrgChart.SetTimeScroll;
begin
if not FTimer.Enabled then FTimer.Enabled := True;
end;
procedure TdxCustomOrgChart.KillTimeScroll;
begin
FTimer.Enabled := False;
end;
procedure TdxCustomOrgChart.TimeScroll;
var
OldX, OldY: Integer;
begin
OldX := LeftEdge; OldY := TopEdge;
SetLeftTop(OldX + FScrollX, OldY + FScrollY);
FNoScroll := (LeftEdge = OldX) and (TopEdge = OldY);
if FNoScroll then
KillTimeScroll
else
Update;
end;
procedure TdxCustomOrgChart.DoTimerScrolling(Sender: TObject);
begin
if FTimer <> nil then
TimeScroll;
end;
procedure TdxCustomOrgChart.DragDraw(Source: TdxCustomOrgChart);
label
Sc;
var
W, H, X, Y: Integer;
begin
if FDragParent = nil then Exit;
W := Source.Selected.Width;
H := Source.Selected.Height;
if not Rotated then
begin
X := FDragX0 + W shr 1;
Y := FDragY1 + (FDragY0 - FDragY1) shr 1;
end
else
begin
X := FDragX1 + (FDragX0 - FDragX1) shr 1;
Y := FDragY0 + H shr 1;
end;
with Canvas do
begin
Pen.Mode := pmNotXor;
Pen.Width := 1;
Pen.Style := psDot;
Pen.Color := LineColor;
Brush.Style := bsClear;
ShowCursor(False);
Rectangle(FDragX0, FDragY0, FDragX0 + W, FDragY0 + H);
if FDragParent = FRoot then goto Sc;
if not Rotated then
begin
MoveTo(X, FDragY0);
LineTo(X, Y);
LineTo(FDragX1, Y);
end
else
begin
MoveTo(FDragX0, Y);
LineTo(X, Y);
LineTo(X, FDragY1);
end;
LineTo(FDragX1, FDragY1);
Sc: ShowCursor(True);
end;
end;
function TdxCustomOrgChart.DragScroll(X, Y: Integer; St: TDragState): Boolean;
var
NewX, NewY: Smallint;
begin
Result := St = dsDragMove;
if Result then
begin
NewX := 0; NewY := 0;
if X <= OtScrollUnit then NewX := -OtScrollUnit;
if X >= ClientWidth - OtScrollUnit then NewX := OtScrollUnit;
if Y <= OtScrollUnit then NewY := -OtScrollUnit;
if Y >= ClientHeight - OtScrollUnit then NewY := OtScrollUnit;
if FNoScroll and (NewX = FScrollX) and (NewY = FScrollY) then
Result := False
else
begin
FScrollX := NewX; FScrollY := NewY;
FNoScroll := False;
Result := (NewX or NewY) <> 0;
end;
end;
if Result then
SetTimeScroll
else
KillTimeScroll;
end;
procedure TdxCustomOrgChart.DragOver(Source: TObject; X, Y: Integer; State: TDragState;
var Accept: Boolean);
var
R: TRect;
N: TdxOcNode;
Scrolled: Boolean;
begin
N := nil;
if Assigned(OnDragDrop) then
Accept := Source is TdxCustomOrgChart
else
Accept := Source = Self;
DragDraw(TdxCustomOrgChart(Source));
Scrolled := DragScroll(X, Y, State);
if Accept then
begin
N := GetNodeAt(X, Y);
Accept := (N <> nil) and not N.HasAsParent(TdxCustomOrgChart(Source).Selected);
end;
if not Accept or Scrolled or not (ocShowDrag in Options) or (State <> dsDragMove)
then
FDragParent := nil
else
begin
FDragX0 := X; FDragY0 := Y;
if not (htUnder in FHitTests) or (N = Selected) then N := N.FParent;
if N <> FDragParent then
begin
FDragParent := N;
if N <> FRoot then
begin
R := N.DisplayRect;
if not Rotated then
begin
FDragX1 := R.Left + (R.Right - R.Left) shr 1;
FDragY1 := R.Bottom;
end
else
begin
FDragX1 := R.Right;
FDragY1 := R.Top + (R.Bottom - R.Top) shr 1;
end;
end;
end;
end;
DragDraw(TdxCustomOrgChart(Source));
if Assigned(OnDragOver) then OnDragOver(Self, Source, X, Y, State, Accept);
end;
procedure TdxCustomOrgChart.DragDrop(Source: TObject; X, Y: Integer);
var
Node: TdxOcNode;
Mode: TdxOcNodeAttachMode;
begin
KillTimeScroll;
if Assigned(OnDragDrop) then
OnDragDrop(Self, Source, X, Y)
else
if (Source = Self) and (Selected <> nil) then
begin
Node := GetNodeAt(X, Y);
if Node = nil then Exit;
Mode := naInsert;
if htUnder in FHitTests then Mode := naAddChild;
if (htOnRightIndentX in FHitTests) or (htOnRect in FHitTests)
then Node := Node.GetNextSibling;
if Node = nil then
begin
Node := FNodeAt.Parent;
Mode := naAddChild;
end;
Selected.MoveTo(Node, Mode);
Selected.MakeVisible;
end;
end;
procedure TdxCustomOrgChart.DragCanceled;
begin
KillTimeScroll;
FDrag := False;
end;
procedure TdxCustomOrgChart.KeyPress(var Key: Char);
begin
inherited KeyPress(Key);
if not Editing and (Selected <> nil) then
case Key of
'+': Selected.Expand(False);
'-': Selected.Collapse(False);
end;
end;
procedure TdxCustomOrgChart.KeyDown(var Key: Word; Shift: TShiftState);
function InsertNode(AsChild: Boolean): TdxOcNode;
begin
Result := nil;
if not (ocInsDel in Options) or (Selected = nil) and (Count > 0) then Exit;
if AsChild or (Selected = nil) then
Result := AddChild(Selected, nil)
else
begin
Result := Selected.GetNextSibling;
if Result = nil then
Result := AddChild(Selected.Parent, nil)
else
Result := Insert(Result, nil);
end;
end;
begin
inherited KeyDown(Key, Shift);
if Shift = [ssCtrl] then
case Key of
VK_RIGHT: DoNavigate(ocnPageRight);
VK_LEFT: DoNavigate(ocnPageLeft);
VK_PRIOR: DoNavigate(ocnTop);
VK_NEXT: DoNavigate(ocnBottom);
VK_HOME: SetLeftTop(0, 0);
VK_END: SetLeftTop(FullWidth, FullHeight);
VK_INSERT: SelectNode(InsertNode(True));
end;
if Shift = [] then
case Key of
VK_NEXT: DoNavigate(ocnPageDown);
VK_PRIOR: DoNavigate(ocnPageUp);
VK_HOME: DoNavigate(ocnLeft);
VK_END: DoNavigate(ocnRight);
VK_DOWN: DoNavigate(ocnSelectNextDown);
VK_UP: DoNavigate(ocnSelectNextUp);
VK_ESCAPE: EndDrag(False);
VK_INSERT: SelectNode(InsertNode(False));
VK_DELETE:
if ocInsDel in Options then
Delete(Selected);
VK_RETURN, VK_F2: ShowEditor;
VK_RIGHT: DoNavigate(ocnSelectNextRight);
VK_LEFT: DoNavigate(ocnSelectNextLeft);
end;
end;
procedure TdxCustomOrgChart.SetOptions(Value: TdxOcOptions);
var
Chgd: TdxOcOptions;
begin
if Value <> Options then
begin
Chgd := (Options + Value) - (Options * Value);
FOptions := Value;
if ocRect3D in Chgd then InvalidateSizes(ivBoth);
if ocButtons in Chgd then Invalidate;
if ocSelect in Chgd then InvalidateSel;
if (ocFocus in Chgd) and Focused then InvalidateSel;
end;
end;
procedure TdxCustomOrgChart.SetRotated(Value: Boolean);
begin
if Value <> Rotated then
begin
FRotated := Value;
InvalidateSizes(ivBoth);
SetLeftTop(0, 0);
end;
end;
procedure TdxCustomOrgChart.DblClick;
begin
if (ocDblClick in Options) and (FHitTests * [htOnShape, htOnButton] = [htOnShape])
then
with FNodeAt do
Expanded := not Expanded;
inherited DblClick;
end;
function TdxCustomOrgChart.GetZoom: Boolean;
begin
Result := FZoom = 0;
end;
function TdxCustomOrgChart.IsZoomed: Boolean;
begin
if FZoom = 0 then RecalcSizes;
Result := (FZoom = 0) and (FZoomLo < FZoomHi);
end;
function TdxCustomOrgChart.GetLineWidth: Word;
begin
//// if IsZoomed then Result := 1 // Fix: by Kirill (LineWidth)
if IsZoomed then
Result := DoZoom(FLineWidth) // Fix: by Kirill (LineWidth)
else
Result := FLineWidth;
end;
function TdxCustomOrgChart.GetIndentX: Word;
begin
if Rotated then
Result := DoZoom(FIndentY)
else
Result := DoZoom(FIndentX);
end;
function TdxCustomOrgChart.GetIndentY: Word;
begin
if Rotated then
Result := DoZoom(FIndentX)
else
Result := DoZoom(FIndentY);
end;
function TdxCustomOrgChart.DoZoom(Value: Integer): Integer;
begin
if not IsZoomed then
Result := Value
else
Result := Value * FZoomLo div FZoomHi;
end;
procedure TdxCustomOrgChart.SetZoom(Value: Boolean);
begin
if Value <> Zoom then
begin
FZoom := Ord(not Value);
ChangeSize;
if Value then UpdateScrollRange;
end;
end;
procedure TdxCustomOrgChart.SetZoomRatio;
begin
Inc(FZoom);
if ClientWidth * FullHeight <= ClientHeight * FullWidth then
begin
FZoomLo := ClientWidth;
FZoomHi := FullWidth + 1;
end
else
begin
FZoomLo := ClientHeight;
FZoomHi := FullHeight + 1;
end;
Dec(FZoom);
end;
procedure TdxCustomOrgChart.ImageListChange(Sender: TObject);
begin
if HandleAllocated then
begin
BeginUpdate;
EndUpdate;
end;
end;
procedure TdxCustomOrgChart.SetImages(Value: TCustomImageList);
var
P: TPoint;
Node: TdxOcNode;
begin
if (Value = FImages) or (csDestroying in ComponentState) then exit;
BeginUpdate;
if FImages <> nil then
FImages.UnRegisterChanges(FImagesChangeLink);
FImages := Value;
if Value <> nil then
begin
FImages.RegisterChanges(FImagesChangeLink);
if DefaultImageAlign = iaNone then DefaultImageAlign := iaLT;
P := MinSizes;
if DefaultNodeWidth < P.X then DefaultNodeWidth := P.X;
if DefaultNodeHeight < P.Y then DefaultNodeHeight := P.Y;
Node := GetFirstNode;
while Node <> nil do
begin
if (Node.FWidth <> 0) and (Node.FWidth < P.X) then Node.Width := P.X;
if (Node.FHeight <> 0) and (Node.FHeight < P.Y) then Node.Height := P.Y;
Node := Node.GetNext;
end;
end;
EndUpdate;
end;
procedure TdxCustomOrgChart.ReadData(Stream: TStream);
var
B: array[0..6] of AnsiChar;
begin
Clear;
FIsUnicode := False;
if (Stream.Size - Stream.Position) > SizeOf(B) then
begin
Stream.ReadBuffer(B, SizeOf(B));
FIsUnicode := B = StreamDescriptionUNICODE;
if not FIsUnicode and (B <> StreamDescriptionANSI) then
Stream.Position := Stream.Position - SizeOf(B);
end;
FRoot.ReadChildren(Stream);
end;
procedure TdxCustomOrgChart.WriteData(Stream: TStream);
begin
{$IFNDEF STREAMANSIFORMAT}
{$IFDEF DELPHI12}
Stream.WriteBuffer(StreamDescriptionUNICODE[1], StrLen(PAnsiChar(StreamDescriptionUNICODE)));
{$ELSE}
Stream.WriteBuffer(StreamDescriptionANSI[1], Length(StreamDescriptionANSI));
{$ENDIF}
{$ENDIF}
FRoot.WriteChildren(Stream);
end;
procedure TdxCustomOrgChart.AssignData(Source: TdxCustomOrgChart);
var
Stream: TMemoryStream;
begin
Stream := TMemoryStream.Create;
try
Source.WriteData(Stream);
Stream.Position := 0;
Clear;
ReadData(Stream);
if Count > 0 then Selected := Items[0];
finally
Stream.Free;
end;
end;
procedure TdxCustomOrgChart.Loaded;
begin
inherited Loaded;
if csDesigning in ComponentState then FullExpand;
end;
function TdxCustomOrgChart.CreateEditor: TdxOcInplaceEdit;
begin
Result := TdxOcInplaceEdit.Create(Self);
end;
function TdxCustomOrgChart.GetEditing: Boolean;
begin
Result := (FEditor <> nil) and FEditor.Visible;
end;
procedure TdxCustomOrgChart.SetEditing(Value: Boolean);
begin
if Value then
ShowEditor
else
HideEditor(True);
end;
procedure TdxCustomOrgChart.HideEditor(Save: Boolean);
var
Focus: Boolean;
TheText: string;
begin
if not Editing then Exit;
Focus := FEditor.Focused;
if Save and FEditor.Modified then
begin
TheText := FEditor.Text;
if Assigned(OnEdited) then OnEdited(Self, Selected, TheText);
Selected.Text := TheText;
end;
FEditor.Hide;
if Focus then SetFocus;
end;
procedure TdxCustomOrgChart.ShowEditor;
var
R: TRect;
Allow: Boolean;
begin
if not (ocEdit in Options) or Editing or IsZoomed or (Selected = nil) then Exit;
Allow := True;
if Assigned(OnEditing) then OnEditing(Self, Selected, Allow);
if not Allow then Exit;
Selected.MakeVisible;
if FEditor = nil then FEditor := CreateEditor;
R := Selected.ClientRect;
Selected.ClientToText(R);
with FEditor do
begin
BoundsRect := R;
ClientWidth := R.Right - R.Left;
ClientHeight := R.Bottom - R.Top;
FMinW := Canvas.TextWidth('W'); FMinH := Canvas.TextHeight('W');
FMaxW := Screen.Width shr 1; FMaxH := Screen.Height shr 1;
if FMaxW < FMinW then FMaxW := FMinW;
if FMaxH < FMinH then FMaxH := FMinH;
Color := Selected.Color;
Font := Self.Font;
Selected.SetFont(Font);
Text := Selected.GetText;
SelStart := 0; SelLength := 0;
Modified := False;
AdjustBounds;
Show;
SetFocus;
end;
end;
procedure TdxCustomOrgChart.SetEditMode(Value: TdxOcEditMode);
begin
if Value <> EditMode then
begin
FEditMode := Value;
if FEditor <> nil then FEditor.RecreateWnd;
if Count > 0 then Invalidate;
end;
end;
procedure TdxCustomOrgChart.NodeChanged(Node: TdxOcNode);
begin
end;
procedure TdxCustomOrgChart.SelectNode(ANode: TdxOcNode);
begin
if ANode <> nil then
begin
Selected := ANode;
Selected.MakeVisible;
end;
end;
procedure TdxCustomOrgChart.DefineProperties(Filer: TFiler);
begin
Inc(FZoom);
inherited DefineProperties(Filer);
Dec(FZoom);
end;
procedure TdxCustomOrgChart.WMHScroll(var Msg: TWMHScroll);
const
ACodeMap: array[0..7] of TdxOcNavigate = (ocnLineLeft, ocnLineRight, ocnPageLeft, ocnPageRight, ocnLeftPosition, ocnLeftPosition, ocnLeft, ocnRight);
var
AScrollInfo: TScrollInfo;
begin
if Msg.ScrollCode < 8 then
begin
AScrollInfo.cbSize := SizeOf(AScrollInfo);
AScrollInfo.fMask := SIF_TRACKPOS;
GetScrollInfo(Handle, SB_HORZ, AScrollInfo);
DoNavigate(ACodeMap[Msg.ScrollCode], AScrollInfo.nTrackPos);
end;
end;
procedure TdxCustomOrgChart.WMVScroll(var Msg: TWMVScroll);
const
ACodeMap: array[0..7] of TdxOcNavigate = (ocnLineUp, ocnLineDown, ocnPageUp, ocnPageDown, ocnTopPosition, ocnTopPosition, ocnTop, ocnBottom);
var
AScrollInfo: TScrollInfo;
begin
if Msg.ScrollCode < 8 then
begin
AScrollInfo.cbSize := SizeOf(AScrollInfo);
AScrollInfo.fMask := SIF_TRACKPOS;
GetScrollInfo(Handle, SB_VERT, AScrollInfo);
DoNavigate(ACodeMap[Msg.ScrollCode], AScrollInfo.nTrackPos);
end;
end;
procedure TdxCustomOrgChart.WMSetFocus(var Msg: TWMSetFocus);
begin
inherited;
InvalidateSel;
end;
procedure TdxCustomOrgChart.WMKillFocus(var Msg: TWMKillFocus);
begin
inherited;
InvalidateSel;
end;
procedure TdxCustomOrgChart.WMSize(var Msg: TWMSize);
var
PrevZoom: Boolean;
begin
if GetEditing then HideEditor(False); // Fix: by Kirill (ModalWindow)
inherited;
if (Msg.SizeType = SIZE_MAXIMIZED) or (Msg.SizeType = SIZE_RESTORED) then
begin
PrevZoom := IsZoomed;
FSizeChanged := True;
RecalcSizes;
if PrevZoom or IsZoomed then Invalidate;
end;
end;
procedure TdxCustomOrgChart.WMGetDlgCode(var Msg: TWMGetDlgCode);
begin
inherited;
Msg.Result := Msg.Result or DLGC_WANTARROWS;
end;
procedure TdxCustomOrgChart.WMDblClk(var Msg: TWMMouse);
begin
if ocDblClick in Options then GetNodeAt(Msg.XPos, Msg.YPos);
inherited;
end;
procedure TdxCustomOrgChart.WMErase(var Msg: TWMEraseBkgnd);
begin
RecalcSizes;
Msg.Result := 1;
end;
procedure TdxCustomOrgChart.CMCtl3DChanged(var Msg: TMessage);
begin
inherited;
if BorderStyle = bsSingle then RecreateWnd;
end;
procedure TdxCustomOrgChart.SaveToFile(const AFileName: string);
var
AStream : TMemoryStream;
begin
AStream := TMemoryStream.Create;
SaveToStream(AStream);
try
AStream.SaveToFile(AFileName);
finally
AStream.Free;
end;
end;
procedure TdxCustomOrgChart.SaveToStream(AStream: TStream);
begin
WriteData(AStream);
end;
{ TdxOcNode }
constructor TdxOcNode.Create(AOwner: TdxCustomOrgChart);
begin
inherited Create;
FOwner := AOwner;
FChildAlign := caCenter;
FColor := clNone;
FImageIndex := -1;
FImageAlign := AOwner.DefaultImageAlign;
end;
destructor TdxOcNode.Destroy;
begin
if Deleting then
inherited Destroy
else
Owner.Delete(Self);
end;
function TdxOcNode.GetCount: Integer;
begin
if FList = nil then
Result := 0
else
Result := FList.Count;
end;
function TdxOcNode.GetAbsoluteCount: Integer;
var
I: Integer;
begin
Result := Count;
if Result > 0 then
for I := 0 to Count - 1 do
Inc(Result, Items[I].AbsoluteCount);
end;
function TdxOcNode.GetAbsoluteItem(Index: Integer): TdxOcNode;
var
I, APassedCount, AChildCount: Integer;
begin
Result := nil;
if Count = 0 then exit;
APassedCount := 0;
for I := 0 to Count - 1 do
begin
if Index - APassedCount = 0 then
begin
Result := Items[I];
break;
end else Inc(APassedCount);
AChildCount := Items[I].AbsoluteCount;
if Index - APassedCount < AChildCount then
begin
Result := Items[I].AbsoluteItems[Index - APassedCount];
break;
end else Inc(APassedCount, AChildCount);
end;
end;
procedure TdxOcNode.SetExpanded(Value: Boolean);
begin
if Value then
Expand(False)
else
Collapse(False);
end;
function TdxOcNode.GetChildren: Boolean;
begin
Result := FList <> nil;
end;
procedure TdxOcNode.SetChildren(Value: Boolean);
begin
if Value = HasChildren then Exit;
if Value then
FList := TList.Create
else
begin
DeleteChildren;
FList.Free;
FList := nil;
end;
end;
function TdxOcNode.GetParent: TdxOcNode;
begin
if IsParentRoot then
Result := nil
else
Result := FParent;
end;
function TdxOcNode.GetSelected: Boolean;
begin
Result := Owner.Selected = Self;
end;
procedure TdxOcNode.SetSelected(Value: Boolean);
begin
if Value then
Owner.Selected := Self
else
if Selected then Owner.Selected := nil;
end;
function TdxOcNode.Is3D: Boolean;
begin
Result := (Shape = shRectangle) and (ocRect3D in Owner.Options);
end;
function TdxOcNode.GetWidth: Word;
begin
Result := FWidth;
if Result = 0 then Result := Owner.DefaultNodeWidth;
Result := Owner.DoZoom(Result);
end;
function TdxOcNode.GetHeight: Word;
begin
Result := FHeight;
if Result = 0 then Result := Owner.DefaultNodeHeight;
Result := Owner.DoZoom(Result);
end;
function TdxOcNode.ExtWidth: Word;
begin
if Owner.Rotated then
Result := GetHeight
else
Result := GetWidth;
if Is3D then
Inc(Result, Owner.LineWidth);
end;
function TdxOcNode.ExtHeight: Word;
begin
if Owner.Rotated then
Result := GetWidth
else
Result := GetHeight;
if Is3D then
Inc(Result, Owner.LineWidth);
end;
function TdxOcNode.GetLevel: Integer;
begin
if Parent = nil then
Result := 0
else
Result := FParent.Level + 1;
end;
function TdxOcNode.GetVisible: Boolean;
begin
if Parent = nil then
Result := (FParent <> nil) or (Self = Owner.FRoot)
else
Result := FParent.IsVisible and FParent.Expanded;
end;
procedure TdxOcNode.SetAlign(Value: TdxOcNodeAlign);
var
R: TRect;
begin
if Value <> FChildAlign then
begin
FChildAlign := Value;
if FParent <> nil then
begin
Owner.NodeChanged(Self);
with FParent do
begin
R := FullRect;
R.Bottom := R.Bottom + Owner.IndentY - 1;
if FullWidth > ChildrenWidth then R.Bottom := R.Top + FullHeight + Owner.IndentY;
R := Owner.RotateRect(R);
InvalidateRect(Owner.Handle, @R, True);
end;
end;
if not IsVisible then Exit;
with Owner do
begin
HideEditor(True);
if FNodeAt = Self then FHitTests := [];
if IsUpdated or not HandleAllocated then Exit;
R := FullRect;
R.Bottom := R.Bottom + IndentY - 1;
if Self.FullWidth > ChildrenWidth then R.Bottom := R.Top + Self.FullHeight + IndentY;
R := RotateRect(R);
InvalidateRect(Handle, @R, True);
end;
end;
end;
procedure TdxOcNode.SetWidth(Value: Word);
var
P: TPoint;
begin
P := Owner.MinSizes;
if (Value <> 0) and (Value < P.X) then Value := P.X;
if Value <> FWidth then
begin
FWidth := Value;
if FParent = nil then Exit;
if Owner.Rotated then
FParent.InvalidateSize(ivHeight)
else
FParent.InvalidateSize(ivWidth);
Owner.NodeChanged(Self);
end;
end;
procedure TdxOcNode.SetHeight(Value: Word);
var
P: TPoint;
begin
P := Owner.MinSizes;
if (Value <> 0) and (Value < P.Y) then Value := P.Y;
if Value <> FHeight then
begin
FHeight := Value;
if FParent = nil then Exit;
if Owner.Rotated then
FParent.InvalidateSize(ivWidth)
else
FParent.InvalidateSize(ivHeight);
Owner.NodeChanged(Self);
end;
end;
function TdxOcNode.GetFirstChild: TdxOcNode;
begin
if Count = 0 then
Result := nil
else
Result := TdxOcNode(FList[0]);
end;
function TdxOcNode.GetLastChild: TdxOcNode;
begin
if Count = 0 then
Result := nil
else
Result := TdxOcNode(FList[FList.Count - 1]);
end;
function TdxOcNode.GetNextSibling: TdxOcNode;
begin
if Index >= FParent.Count - 1 then
Result := nil
else
Result := FParent[Index + 1];
end;
function TdxOcNode.GetPrevSibling: TdxOcNode;
begin
if Index = 0 then
Result := nil
else
Result := FParent[Index - 1];
end;
function TdxOcNode.GetNext: TdxOcNode;
function NxtSbl(Node: TdxOcNode): TdxOcNode;
begin
Result := Node.GetNextSibling;
if Result <> nil then Exit;
if Node.Parent <> nil then Result := NxtSbl(Node.FParent);
end;
begin
Result := GetFirstChild;
if Result = nil then Result := NxtSbl(Self);
end;
function TdxOcNode.GetPrev: TdxOcNode;
begin
Result := GetPrevSibling;
if Result = nil then
Result := Parent
else
while Result.Count <> 0 do
Result := Result.GetLastChild;
end;
function TdxOcNode.GetNextChild(Value: TdxOcNode): TdxOcNode;
begin
if Value.FParent <> Self then
Result := nil
else
Result := Value.GetNextSibling;
end;
function TdxOcNode.GetPrevChild(Value: TdxOcNode): TdxOcNode;
begin
if Value.FParent <> Self then
Result := nil
else
Result := Value.GetPrevSibling;
end;
function TdxOcNode.GetNextVisible: TdxOcNode;
var
Node: TdxOcNode;
Tmp: TList;
begin
Node := Self;
while not Node.IsVisible do
Node := Node.FParent;
Tmp := Node.FList;
if not Node.Expanded then Node.FList := nil;
Result := Node.GetNext;
Node.FList := Tmp;
end;
function TdxOcNode.GetPrevVisible: TdxOcNode;
begin
Result := GetPrev;
if Result = nil then Exit;
while not Result.IsVisible do
Result := Result.FParent;
end;
function TdxOcNode.GetItem(Index: Integer): TdxOcNode;
begin
Result := TdxOcNode(FList[Index])
end;
function TdxOcNode.HasAsParent(Value: TdxOcNode): Boolean;
var
Node: TdxOcNode;
begin
Result := True;
if Value = nil then Exit;
Node := FParent;
while Node <> nil do
begin
if Node = Value then Exit;
Node := Node.FParent;
end;
Result := False;
end;
function TdxOcNode.IndexOf(Value: TdxOcNode): Integer;
begin
if Value.FParent <> Self then
Result := -1
else
Result := Value.Index;
end;
procedure TdxOcNode.Enumerate(Value: Integer);
var
I: Integer;
begin
for I := Value to Count - 1 do
TdxOcNode(FList[I]).FIndex := I;
end;
function TdxOcNode.Focused: Boolean;
begin
Result := Selected and Owner.Focused;
end;
function TdxOcNode.ChildrenWidth: Integer;
var
I: Integer;
begin
if not Expanded then
Result := 0
else
begin
Result := FChildrenWidth;
if Result = 0 then
begin
Inc(Owner.FZoom);
for I := 0 to Count - 1 do
Result := Result + Items[I].FullWidth;
FChildrenWidth := Result;
Dec(Owner.FZoom);
end;
Result := Owner.DoZoom(Result);
end;
end;
function TdxOcNode.ChildrenHeight: Integer;
var
I, H: Integer;
begin
if not Expanded then
Result := 0
else
begin
Result := FChildrenHeight;
if Result = 0 then
begin
Inc(Owner.FZoom);
for I := 0 to Count - 1 do
begin
H := Items[I].FullHeight;
if Result < H then Result := H;
end;
FChildrenHeight := Result;
Dec(Owner.FZoom);
end;
Result := Owner.DoZoom(Result);
end;
end;
function TdxOcNode.FullWidth: Integer;
begin
Inc(Owner.FZoom);
Result := ExtWidth + Owner.LineWidth + Owner.IndentX;
if Result < ChildrenWidth then Result := ChildrenWidth;
Dec(Owner.FZoom);
Result := Owner.DoZoom(Result);
end;
function TdxOcNode.FullHeight: Integer;
begin
Inc(Owner.FZoom);
Result := ExtHeight + Owner.LineWidth + Owner.IndentY + ChildrenHeight;
Dec(Owner.FZoom);
Result := Owner.DoZoom(Result);
end;
procedure TdxOcNode.InvalidateSize(Flags: TdxOcIvFlags);
procedure IvSz(Node: TdxOcNode; Flags: TdxOcIvFlags);
begin
if Flags in [ivWidth, ivBoth] then Node.FChildrenWidth := 0;
if Flags in [ivHeight, ivBoth] then Node.FChildrenHeight := 0;
if Node.FParent <> nil then IvSz(Node.FParent, Flags);
end;
begin
IvSz(Self, Flags);
if not IsVisible then Exit;
if Expanded then
Owner.ChangeSize
else
if Count < 2 then Owner.InvalidateNode(Self);
end;
procedure TdxOcNode.Expand(Recurse: Boolean);
var
I: Integer;
Allow: Boolean;
begin
if Count = 0 then Exit;
if Recurse then
begin
for I := 0 to Count - 1 do
Items[I].Expand(True);
Expand(False);
end
else
begin
if Expanded then Exit;
Allow := True;
if Assigned(Owner.OnExpansion) then Owner.OnExpansion(Owner, Self, Allow);
if not Allow then Exit;
Allow := Owner.InitAnimate(Self);
FExpanded := True;
FParent.InvalidateSize(ivBoth);
if Allow then Owner.Update;
if Assigned(Owner.OnExpanded) then Owner.OnExpanded(Owner, Self);
end;
end;
procedure TdxOcNode.Collapse(Recurse: Boolean);
var
I: Integer;
Allow: Boolean;
begin
if Count = 0 then Exit;
if Recurse then
begin
Collapse(False);
for I := 0 to Count - 1 do
Items[I].Collapse(True);
end
else
begin
if (not Expanded) or (FParent = nil) then Exit;
Allow := True;
if Assigned(Owner.OnCollapsing) then Owner.OnCollapsing(Owner, Self, Allow);
if not Allow then Exit;
Allow := Owner.InitAnimate(Self);
FExpanded := False;
FParent.InvalidateSize(ivBoth);
if Allow then Owner.Update;
if Assigned(Owner.OnCollapsed) then Owner.OnCollapsed(Owner, Self);
end;
end;
procedure TdxOcNode.SetData(Value: TdxOcNodeData);
begin
FData := Value;
end;
procedure TdxOcNode.DeleteChildren;
var
I: Integer;
begin
if Count = 0 then Exit;
if (Owner.Selected <> nil) and Owner.Selected.HasAsParent(Self) then Selected := True;
FDeleting := True;
for I := 0 to Count - 1 do
Owner.Delete(Items[I]);
FDeleting := False;
FList.Clear;
if (FParent = nil) or (not FParent.Deleting) then InvalidateSize(ivBoth);
if FParent <> nil then FExpanded := False;
end;
function TdxOcNode.FullRect: TRect;
var
I: Integer;
ALeft, ABottom: Integer;
begin
SetRect(Result, 0, 0, 0, 0);
if not IsVisible then Exit;
if Parent <> nil then
begin
Result := FParent.FullRect;
Result.Left := Result.Left + FParent.ChildOffset;
end
else
begin
ALeft := -Owner.LeftEdge;
ABottom := -Owner.TopEdge;
Owner.RotatePoint(ALeft, ABottom);
Result.Left := ALeft;
Result.Bottom := ABottom;
end;
Result.Top := Result.Bottom;
Result.Bottom := Result.Top + ExtHeight + Owner.IndentY + Owner.LineWidth;
for I := 0 to Index - 1 do
Result.Left := Result.Left + FParent[I].FullWidth;
Result.Right := Result.Left + FullWidth;
end;
procedure TdxOcNode.FullToDisplay(var Rect: TRect);
var
W: Integer;
begin
W := ExtWidth + Owner.LineWidth;
with Rect do
begin
if ChildAlign = caRight then Left := Right - W;
if ChildAlign = caCenter then Left := Left + (Right - Left - W) shr 1;
Right := Left + W;
end;
end;
procedure TdxOcNode.DisplayToClient(var Rect: TRect);
var
DX, DY: Integer;
begin
DX := 0;
DY := 0;
case Shape of
shRectangle:
begin DX := 0; DY := 0; end;
shDiamond:
begin
DX := Width shr 2;
DY := Height shr 2;
end;
shRoundRect:
begin
DX := Radius * 3 div 20;
DY := DX;
end;
shEllipse:
begin
DX := Width * 3 div 20;
DY := Height * 3 div 20;
end;
end;
DX := DX + Owner.LineWidth shr 1 + 1;
DY := DY + Owner.LineWidth shr 1 + 1;
with Rect do
begin
Left := Left + DX;
Top := Top + DY;
Right := Right - DX;
Bottom := Bottom - DY;
if Owner.Rotated then
Left := Left + Owner.IndentY
else
Top := Top + Owner.IndentY;
end;
end;
function TdxOcNode.ClientToText(var Rect: TRect): TPoint;
var
W, H: Integer;
begin
Result.X := -999999;
Result.Y := -999999;
if (Owner.Images = nil) or (ImageAlign = iaNone) or (ImageIndex = -1) then Exit;
W := Owner.DoZoom(Owner.Images.Width);
H := Owner.DoZoom(Owner.Images.Height);
case ImageAlign of
iaLT, iaLC, iaLB:
begin
Result.X := Rect.Left;
Rect.Left := Rect.Left + W;
end;
iaRT, iaRC, iaRB:
begin
Rect.Right := Rect.Right - W;
Result.X := Rect.Right;
end;
iaTL, iaTC, iaTR:
begin
Result.Y := Rect.Top;
Rect.Top := Rect.Top + H;
end;
iaBL, iaBC, iaBR:
begin
Rect.Bottom := Rect.Bottom - H;
Result.Y := Rect.Bottom;
end;
end;
case ImageAlign of
iaLT, iaRT: Result.Y := Rect.Top;
iaLB, iaRB: Result.Y := Rect.Bottom - H;
iaLC, iaRC: Result.Y := Rect.Top + (Rect.Bottom - Rect.Top - H) shr 1;
iaTL, iaBL: Result.X := Rect.Left;
iaTR, iaBR: Result.X := Rect.Right - W;
iaTC, iaBC: Result.X := Rect.Left + (Rect.Right - Rect.Left - W) shr 1;
end;
end;
function TdxOcNode.DisplayRect: TRect;
begin
Result := FullRect;
if Result.Left = Result.Right then Exit;
FullToDisplay(Result);
Result := Owner.RotateRect(Result);
end;
function TdxOcNode.ClientRect: TRect;
begin
Result := DisplayRect;
if Result.Left = Result.Right then Exit;
DisplayToClient(Result);
end;
function TdxOcNode.IsParentRoot: Boolean;
begin
Result := FParent = Owner.RootNode;
end;
procedure TdxOcNode.MakeVisible;
var
R: TRect;
Node: TdxOcNode;
LeftX, TopY: Integer;
begin
Owner.FNoAnim := True;
Node := Parent;
while Node <> nil do
begin
Node.Expand(False);
Node := Node.Parent;
end;
Owner.FNoAnim := False;
R := DisplayRect;
if (R.Right - R.Left > Owner.ClientWidth) or (R.Bottom - R.Top > Owner.ClientHeight)
then DisplayToClient(R);
LeftX := R.Left; TopY := R.Top;
if R.Right > Owner.ClientWidth then LeftX := LeftX + Owner.ClientWidth - R.Right;
if LeftX < 0 then LeftX := 0;
if R.Bottom > Owner.ClientHeight then TopY := TopY + Owner.ClientHeight - R.Bottom;
if TopY < 0 then TopY := 0;
if (LeftX = R.Left) and (TopY = R.Top) then Exit;
Owner.SetLeftTop(Owner.LeftEdge + R.Left - LeftX, Owner.TopEdge + R.Top - TopY);
end;
procedure TdxOcNode.MoveTo(Dest: TdxOcNode; Mode: TdxOcNodeAttachMode);
var
ParNode: TdxOcNode;
ParIdx: Integer;
procedure SetPar(PN: TdxOcNode; PI: Integer);
begin
ParNode := PN;
ParIdx := PI;
end;
begin
if Dest = nil then
case Mode of
naInsert: Exit;
naAdd: Mode := naAddChild;
naAddFirst: Mode := naAddChildFirst;
end
else
if (Dest = Self) or Dest.HasAsParent(Self) or not Owner.IsMyNode(Dest)
then Exit;
case Mode of
naInsert: SetPar(Dest.Parent, Dest.Index);
naAdd: SetPar(Dest.Parent, -1);
naAddFirst: SetPar(Dest.Parent, 0);
naAddChild: SetPar(Dest, -1);
naAddChildFirst: SetPar(Dest, 0);
end;
if ParNode = Parent then
begin
if ParIdx > Index then Dec(ParIdx);
if (ParIdx = Index) or (ParIdx < 0) and (GetNextSibling = nil) then Exit;
end;
Owner.InternalMoveTo(ParNode, Self, ParIdx);
end;
function TdxOcNode.GetColor: TColor;
begin
if FColor <> clNone then
Result := FColor
else
Result := Owner.Color;
end;
procedure TdxOcNode.SetColor(Value: TColor);
begin
if Value <> FColor then
begin
FColor := Value;
if FParent = nil then Exit;
Owner.InvalidateNode(Self);
Owner.NodeChanged(Self);
end;
end;
procedure TdxOcNode.SetShape(Value: TdxOcShape);
begin
if Value <> FShape then
begin
FShape := Value;
if FParent = nil then Exit;
with Owner do
begin
HideEditor(True);
InvalidateNode(Self);
if (FNodeAt = Self) and (htOnRect in FHitTests) then FHitTests := [];
NodeChanged(Self);
end;
end;
end;
function TdxOcNode.ChildOffset: Integer;
begin
if ChildAlign = caLeft then
Result := 0
else
begin
Result := FullWidth - ChildrenWidth;
if ChildAlign = caCenter then Result := Result shr 1;
end;
end;
function TdxOcNode.Radius: Integer;
begin
Result := Height;
if Result > Width then Result := Width;
Result := Result shr 1;
end;
procedure TdxOcNode.SetFont(Font: TFont);
begin
if Assigned(Owner.OnSetFont) then Owner.OnSetFont(Owner, Self, Font);
end;
procedure TdxOcNode.GetNodeInfo(var AInfo: TdxOcNodeInfo);
begin
with AInfo do
begin
Width := FWidth;
Height := FHeight;
Color := FColor;
Align := FChildAlign;
Shape := FShape;
Index := FImageIndex;
IAlign := FImageAlign;
end;
end;
procedure TdxOcNode.SetImageIndex(Value: Smallint);
begin
if Value <> FImageIndex then
begin
FImageIndex := Value;
if FParent = nil then Exit;
if Owner.Images <> nil then Owner.InvalidateNode(Self);
Owner.NodeChanged(Self);
end;
end;
procedure TdxOcNode.SetImageAlign(Value: TdxOcImageAlign);
begin
if Value <> FImageAlign then
begin
FImageAlign := Value;
if FParent = nil then Exit;
if Owner.Images <> nil then Owner.InvalidateNode(Self);
Owner.NodeChanged(Self);
end;
end;
procedure TdxOcNode.AdjustSizes(const S: string);
var
R: TRect;
W, H, Handle: Integer;
begin
Handle := GetDC(0);
Inc(Owner.FZoom);
try
SetRect(R, 0, 0, Width + Owner.LineWidth, Height + Owner.LineWidth);
if Owner.Rotated then
Inc(R.Right, Owner.IndentY)
else
Inc(R.Bottom, Owner.IndentY);
DisplayToClient(R);
ClientToText(R);
W := R.Right - R.Left;
H := R.Bottom - R.Top;
Owner.Canvas.Font := Owner.Font;
SetFont(Owner.Canvas.Font);
SelectObject(Handle, Owner.Canvas.Font.Handle);
Owner.DoDrawText(Handle, S, R, DT_CALCRECT);
W := (R.Right - R.Left - W) * Width div W;
if Assigned(Owner.Images) and (ImageIndex > -1)
and (ImageIndex < Owner.Images.Count) then
begin
W := W + Owner.Images.Width;
if emCenter in Owner.EditMode then
W := W + FOwner.Images.Width;
end;
H := (R.Bottom - R.Top - H) * Height div H;
if (W > 0) and not (emWrap in Owner.EditMode) then Width := Width + W;
if (H > 0) and (emGrow in Owner.EditMode) then Height := Height + H;
finally
Dec(Owner.FZoom);
ReleaseDC(0, Handle);
end;
end;
procedure TdxOcNode.SetAnimXY(LeftX, TopY: Integer; const Clip: TRect; First: Boolean);
var
R: TRect;
I: Integer;
begin
if First then FDraw := False;
if FParent = nil then
begin
LeftX := -Owner.LeftEdge;
TopY := -Owner.TopEdge;
Owner.RotatePoint(LeftX, TopY);
FDraw := True;
end;
if IsVisible then
begin
R.Left := LeftX; R.Top := TopY;
R.Right := LeftX + FullWidth;
if Self = Owner.FRoot then
R.Bottom := TopY
else
R.Bottom := TopY + ExtHeight + Owner.IndentY + Owner.LineWidth;
I := 0;
if Expanded then
I := 999999
else
if Owner.HasButton(Self) then I := 6 - Owner.LineWidth shr 1;
if I < 0 then I := 0;
Inc(R.Bottom, I);
if not ((R.Left > Clip.Right) or (R.Right < Clip.Left) or (R.Top > Clip.Bottom) or (R.Bottom < Clip.Top))
then FDraw := True;
Dec(R.Bottom, I);
LeftX := LeftX + ChildOffset; TopY := R.Bottom;
FullToDisplay(R);
FAnimX := R.Left; FAnimY := R.Top;
end
else
begin
FDraw := FParent.FDraw;
FAnimX := FParent.FAnimX;
FAnimY := FParent.FAnimY + Owner.IndentY shr 2;
if FParent.ChildAlign <> caLeft then
begin
I := FParent.ExtWidth - ExtWidth;
if FParent.ChildAlign = caCenter then I := I div 2;
Inc(FAnimX, I);
end;
end;
if First then
begin
FAnimX0 := FAnimX;
FAnimY0 := FAnimY;
end;
if not (FDraw or First and (Owner.FCollapsed <> nil)) then Exit;
if Expanded or (Owner.FCollapsed = Self) then
for I := 0 to Count - 1 do
begin
Items[I].SetAnimXY(LeftX, TopY, Clip, First);
if Expanded then Inc(LeftX, Items[I].FullWidth);
end;
end;
procedure TdxOcNode.ReadData(Stream: TStream);
var
Info: TdxOcNodeInfo;
begin
Stream.ReadBuffer(Info, SizeOf(Info));
Width := Info.Width;
Height := Info.Height;
Color := Info.Color;
ChildAlign := Info.Align;
Shape := Info.Shape;
ImageIndex := Info.Index;
ImageAlign := Info.IAlign;
end;
procedure TdxOcNode.WriteData(Stream: TStream);
var
Info: TdxOcNodeInfo;
begin
GetNodeInfo(Info);
Stream.WriteBuffer(Info, SizeOf(Info));
end;
procedure TdxOcNode.ReadChildren(Stream: TStream);
var
Cnt: Word;
Child, Par: TdxOcNode;
begin
Text := ReadStr(Stream, Owner.IsUnicode);
if FParent = nil then
Par := nil
else
Par := Self;
Stream.ReadBuffer(Cnt, SizeOf(Cnt));
while Cnt > 0 do
begin
Child := Owner.AddChild(Par, nil);
if Child = nil then Exit;
Child.ReadData(Stream);
Child.ReadChildren(Stream);
Dec(Cnt);
end;
end;
procedure TdxOcNode.WriteChildren(Stream: TStream);
var
I: Integer;
begin
WriteStr(Stream, Text);
I := Count;
Stream.WriteBuffer(I, SizeOf(Word));
for I := 0 to Count - 1 do
begin
Items[I].WriteData(Stream);
Items[I].WriteChildren(Stream);
end;
end;
function TdxOcNode.GetText: string;
begin
Result := FText;
if Assigned(Owner.OnGetText) then
Owner.OnGetText(Owner, self, FText);
end;
procedure TdxOcNode.SetText(const Value: string);
begin
FText := Value;
if Assigned(Owner.OnSetText) then
Owner.OnSetText(Owner, self, Value);
end;
procedure TdxOcNode.InternalSetText(const Value: string);
begin
if Text = Value then Exit;
SetText(Value);
if Owner.EditMode * [emWrap, emGrow] <> [emWrap] then AdjustSizes(Text);
if FParent = nil then Exit;
Owner.InvalidateNode(Self);
Owner.NodeChanged(Self);
end;
end.