diff --git a/Source/VirtualTrees.AncestorFMX.pas b/Source/VirtualTrees.AncestorFMX.pas index 3e9b8d1c..ca82b78e 100644 --- a/Source/VirtualTrees.AncestorFMX.pas +++ b/Source/VirtualTrees.AncestorFMX.pas @@ -1,4 +1,4 @@ -unit VirtualTrees.BaseAncestorFMX; +unit VirtualTrees.AncestorFMX; {$SCOPEDENUMS ON} @@ -13,7 +13,9 @@ interface uses - VirtualTrees.BaseTree; + System.Classes, System.UITypes, + FMX.Graphics, + VirtualTrees.FMX, VirtualTrees.BaseTree; const EVENT_OBJECT_STATECHANGE = $800A; @@ -32,15 +34,29 @@ TVTAncestorFMX = class abstract(TBaseVirtualTree) function GetClientRect: TRect; override; procedure NotifyAccessibleEvent(pEvent: Uint32 = EVENT_OBJECT_STATECHANGE); virtual; + procedure HScrollChangeProc(Sender: TObject); override; + procedure VScrollChangeProc(Sender: TObject); override; + + procedure Resize; override; //TODO: CopyCutPaste - need to be implemented { function PasteFromClipboard(): Boolean; override; procedure CopyToClipboard(); override; procedure CutToClipboard(); override; } + public + constructor Create(AOwner: TComponent); override; end; implementation +uses + System.SysUtils, + FMX.Forms, + VirtualTrees.Header, + VirtualTrees.Types; + +type + TVTHeaderCracker = class(TVTHeader); //---------------------------------------------------------------------------------------------------------------------- @@ -61,7 +77,7 @@ procedure TVTAncestorFMX.MouseDown(Button: TMouseButton; Shift: TShiftState; X: P:= ClientToScreen(P); end; FillTWMMouse(MM, Button, Shift, P.X, P.Y, isNC, false); - if FHeader.HandleMessage(TMessage(MM)) then + if TVTHeaderCracker(Header).HandleMessage(TMessage(MM)) then exit;//!!! FillTWMMouse(MM, Button, Shift, X, Y, isNC, false); @@ -90,7 +106,7 @@ procedure TVTAncestorFMX.MouseUp(Button: TMouseButton; Shift: TShiftState; X: Si P:= ClientToScreen(P); end; FillTWMMouse(MM, Button, Shift, P.X, P.Y, isNC, true); - if FHeader.HandleMessage(TMessage(MM)) then + if TVTHeaderCracker(Header).HandleMessage(TMessage(MM)) then exit;//!!! FillTWMMouse(MM, Button, Shift, X, Y, isNC, true); @@ -152,7 +168,7 @@ function TVTAncestorFMX.PrepareDottedBrush(CurrentDottedBrush: TBrush; Bits: Poi DestPitch := PixelFormatBytes[PatternBitmap.PixelFormat]; System.Move(PAlphaColorArray(BitmapData.Data)[0], PAlphaColorArray(Bits)[0], 8 * 4); } - for line:= 0 to LineLen-1 do + for line:= 0 to BitsLinesCount-1 do begin for bit:= 0 to 7 do begin @@ -186,6 +202,72 @@ function TVTAncestorFMX.PrepareDottedBrush(CurrentDottedBrush: TBrush; Bits: Poi //---------------------------------------------------------------------------------------------------------------------- +procedure TVTAncestorFMX.Resize; +Var M: TWMSize; +begin + inherited; + + if FInCreate then + exit; //!! + + M.Msg:= WM_SIZE; + M.SizeType:= SIZE_RESTORED; + M.Width:= Width; + M.Height:= Height; + M.Result:= 0; + WMSize(M); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTAncestorFMX.VScrollChangeProc(Sender: TObject); +Var M: TWMHScroll; +begin + M.Msg:= WM_VSCROLL; + M.ScrollCode:= SB_THUMBPOSITION; + M.Pos:= GetScrollPos(SB_VERT); + M.ScrollBar:= SB_VERT; + M.Result:= 0; + + WMVScroll(M); + Repaint; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTAncestorFMX.HScrollChangeProc(Sender: TObject); +Var M: TWMHScroll; +begin + M.Msg:= WM_HSCROLL; + M.ScrollCode:= SB_THUMBPOSITION; + M.Pos:= GetScrollPos(SB_HORZ); + M.ScrollBar:= SB_HORZ; + M.Result:= 0; + + WMHScroll(M); + Repaint; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +constructor TVTAncestorFMX.Create(AOwner: TComponent); +begin + FInCreate:= true; + + inherited; + + BackgroundOffsetX:= 0; + BackgroundOffsetY:= 0; + Margin:= 4; + TextMargin:= 4; + DefaultNodeHeight:= 18; //??? + Indent:= 18; //??? + + FInCreate:= false; +end; + +//---------------------------------------------------------------------------------------------------------------------- + function TVTAncestorFMX.GetClientHeight: Single; begin Result:= ClientRect.Height; diff --git a/Source/VirtualTrees.BaseAncestorFMX.pas b/Source/VirtualTrees.BaseAncestorFMX.pas index e080368b..9d7ba60c 100644 --- a/Source/VirtualTrees.BaseAncestorFMX.pas +++ b/Source/VirtualTrees.BaseAncestorFMX.pas @@ -12,9 +12,12 @@ interface uses - System.Classes, System.UITypes - , FMX.Objects, FMX.Graphics, FMX.StdCtrls - , VirtualTrees.Types, VirtualTrees.FMX; + {$IFDEF MSWINDOWS} + WinApi.Windows, + {$ENDIF} + System.Classes, System.UITypes, + FMX.Objects, FMX.Graphics, FMX.Controls, FMX.StdCtrls, FMX.Forms, FMX.ImgList, + VirtualTrees.Types, VirtualTrees.FMX; type @@ -25,7 +28,7 @@ TVTBaseAncestorFMX = class abstract(TRectangle) private FDottedBrushTreeLines: TStrokeBrush; // used to paint dotted lines without special pens FDottedBrushGridLines: TStrokeBrush; // used to paint dotted lines without special pens - FInCreate: Boolean; + FInCreate: Boolean; function GetFillColor: TAlphaColor; procedure SetFillColor(const Value: TAlphaColor); @@ -60,8 +63,8 @@ TVTBaseAncestorFMX = class abstract(TRectangle) procedure DragCanceled; virtual; abstract; procedure Resize; override; - function CreateSystemImageSet(): TImageList; - procedure SetWindowTheme(const Theme: string); virtual; + function CreateSystemImageSet(): TImageList; + procedure SetWindowTheme(const Theme: string); virtual; procedure ChangeScale(M, D: Integer{$if CompilerVersion >= 31}; isDpiChange: Boolean{$ifend}); virtual; abstract; function GetControlsAlignment: TAlignment; virtual; abstract; @@ -71,6 +74,8 @@ TVTBaseAncestorFMX = class abstract(TRectangle) function GetSortedCutCopySet(Resolve: Boolean): TNodeArray; virtual; abstract; function GetSortedSelection(Resolve: Boolean): TNodeArray; virtual; abstract; procedure WriteNode(Stream: TStream; Node: PVirtualNode); virtual; abstract; + procedure DoMouseEnter(); reintroduce; overload; virtual; abstract; + procedure DoMouseLeave(); reintroduce; overload; virtual; abstract; protected //properties property DottedBrushTreeLines: TStrokeBrush read FDottedBrushTreeLines write FDottedBrushTreeLines; property DottedBrushGridLines: TStrokeBrush read FDottedBrushGridLines write FDottedBrushGridLines; @@ -86,8 +91,8 @@ TVTBaseAncestorFMX = class abstract(TRectangle) function GetScrollInfo(Bar: Integer; var ScrollInfo: TScrollInfo): Boolean; function GetScrollPos(Bar: Integer): TDimension; function GetScrollBarForBar(Bar: Integer): TScrollBar; - procedure HScrollChangeProc(Sender: TObject); - procedure VScrollChangeProc(Sender: TObject); + procedure HScrollChangeProc(Sender: TObject); virtual; abstract; + procedure VScrollChangeProc(Sender: TObject); virtual; abstract; procedure CopyToClipboard; virtual; abstract; procedure CutToClipboard; virtual; abstract; @@ -136,6 +141,7 @@ TVTBaseAncestorFMX = class abstract(TRectangle) /// Simulate Windows GetSystemMetrics /// function GetSystemMetrics(nIndex: Integer): Integer; + procedure Sort(Node: PVirtualNode; Column: TColumnIndex; Direction: TSortDirection; DoInit: Boolean = True); reintroduce; overload; virtual; abstract; public //properties property Font: TFont read FFont write SetFont; property ClientRect: TRect read GetClientRect; @@ -182,20 +188,6 @@ class function TVTBaseAncestorFMX.KeysToShiftState(Keys: LongInt): TShiftState; //---------------------------------------------------------------------------------------------------------------------- -function TVTBaseAncestorFMX.GetClientHeight: Single; -begin - Result:= ClientRect.Height; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTBaseAncestorFMX.GetClientWidth: Single; -begin - Result:= ClientRect.Width; -end; - -//---------------------------------------------------------------------------------------------------------------------- - function TVTBaseAncestorFMX.GetFillColor: TAlphaColor; begin Result:= Fill.Color; @@ -203,50 +195,6 @@ function TVTBaseAncestorFMX.GetFillColor: TAlphaColor; //---------------------------------------------------------------------------------------------------------------------- -function TVTBaseAncestorFMX.GetClientRect: TRect; -begin - Result:= ClipRect; - if Assigned(FHeader) then - begin - if hoVisible in FHeader.FOptions then - Inc(Result.Top, FHeader.Height); - end; - if FVScrollBar.Visible then - Dec(Result.Right, FVScrollBar.Width); - if FHScrollBar.Visible then - Dec(Result.Bottom, FHScrollBar.Height); - - if Result.Left>Result.Right then - Result.Left:= Result.Right; - - if Result.Top>Result.Bottom then - Result.Top:= Result.Bottom; - - //OffsetRect(Result, OffsetX, OffsetY); - //Dec(Result.Left, -OffsetX); //increase width - //Dec(Result.Top, -OffsetY); //increase height -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTBaseAncestorFMX.Resize; -Var M: TWMSize; -begin - inherited; - - if FInCreate then - exit; //!! - - M.Msg:= WM_SIZE; - M.SizeType:= SIZE_RESTORED; - M.Width:= Width; - M.Height:= Height; - M.Result:= 0; - WMSize(M); -end; - -//---------------------------------------------------------------------------------------------------------------------- - constructor TVTBaseAncestorFMX.Create(AOwner: TComponent); begin FInCreate:= true; @@ -254,12 +202,6 @@ constructor TVTBaseAncestorFMX.Create(AOwner: TComponent); FHandleAllocated:= true; FUseRightToLeftAlignment:= false; - FBackgroundOffsetX:= 0; - FBackgroundOffsetY:= 0; - FMargin:= 4; - FTextMargin:= 4; - FDefaultNodeHeight:= 18; //??? - FIndent:= 18; //??? FBevelEdges:= [TBevelEdge.beLeft, TBevelEdge.beTop, TBevelEdge.beRight, TBevelEdge.beBottom]; FBevelInner:= TBevelCut.bvRaised; FBevelOuter:= TBevelCut.bvLowered; @@ -288,6 +230,7 @@ constructor TVTBaseAncestorFMX.Create(AOwner: TComponent); //FVScrollBar.Margins.Bottom:= FVScrollBar.Width; SetAcceptsControls(false); + FInCreate:= false; end; @@ -506,36 +449,6 @@ function TVTBaseAncestorFMX.GetScrollBarForBar(Bar: Integer): TScrollBar; //---------------------------------------------------------------------------------------------------------------------- -procedure TVTBaseAncestorFMX.HScrollChangeProc(Sender: TObject); -Var M: TWMHScroll; -begin - M.Msg:= WM_HSCROLL; - M.ScrollCode:= SB_THUMBPOSITION; - M.Pos:= GetScrollPos(SB_HORZ); - M.ScrollBar:= SB_HORZ; - M.Result:= 0; - - WMHScroll(M); - Repaint; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTBaseAncestorFMX.VScrollChangeProc(Sender: TObject); -Var M: TWMHScroll; -begin - M.Msg:= WM_VSCROLL; - M.ScrollCode:= SB_THUMBPOSITION; - M.Pos:= GetScrollPos(SB_VERT); - M.ScrollBar:= SB_VERT; - M.Result:= 0; - - WMVScroll(M); - Repaint; -end; - -//---------------------------------------------------------------------------------------------------------------------- - procedure TVTBaseAncestorFMX.SetBiDiMode(Value: TBiDiMode); begin if FBiDiMode <> Value then @@ -618,6 +531,20 @@ function TVTBaseAncestorFMX.CreateSystemImageSet(): TImageList; //---------------------------------------------------------------------------------------------------------------------- +procedure TVTBaseAncestorFMX.SetWindowTheme(const Theme: string); +begin + //nothing +end; +//---------------------------------------------------------------------------------------------------------------------- + +function TVTBaseAncestorFMX.CreateSystemImageSet(): TImageList; +begin + Result:= TImageList.Create(Self); + FillSystemCheckImages(Self, Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + procedure TVTBaseAncestorFMX.SetWindowTheme(const Theme: string); begin //nothing diff --git a/Source/VirtualTrees.BaseAncestorVcl.pas b/Source/VirtualTrees.BaseAncestorVcl.pas index 6e5ad0d8..ce624b59 100644 --- a/Source/VirtualTrees.BaseAncestorVcl.pas +++ b/Source/VirtualTrees.BaseAncestorVcl.pas @@ -46,6 +46,9 @@ TVTBaseAncestorVcl = class abstract(TCustomControl) function GetSortedCutCopySet(Resolve: Boolean): TNodeArray; virtual; abstract; function GetSortedSelection(Resolve: Boolean): TNodeArray; virtual; abstract; procedure WriteNode(Stream: TStream; Node: PVirtualNode); virtual; abstract; + procedure Sort(Node: PVirtualNode; Column: TColumnIndex; Direction: TSortDirection; DoInit: Boolean = True); virtual; abstract; + procedure DoMouseEnter(); virtual; abstract; + procedure DoMouseLeave(); virtual; abstract; protected //properties property DottedBrushTreeLines: TBrush read FDottedBrushTreeLines write FDottedBrushTreeLines; public // methods @@ -292,6 +295,8 @@ procedure TVTBaseAncestorVcl.CopyToClipboard; end; end; +//---------------------------------------------------------------------------------------------------------------------- + function TVTBaseAncestorVcl.CreateSystemImageSet: TImageList; // Creates a system check image set. diff --git a/Source/VirtualTrees.BaseTree.pas b/Source/VirtualTrees.BaseTree.pas index 65ab8cdd..bfb2f286 100644 --- a/Source/VirtualTrees.BaseTree.pas +++ b/Source/VirtualTrees.BaseTree.pas @@ -1025,8 +1025,8 @@ TBaseVirtualTree = class abstract(TVTBaseAncestor) function DoKeyAction(var CharCode: Word; var Shift: TShiftState): Boolean; virtual; procedure DoLoadUserData(Node: PVirtualNode; Stream: TStream); virtual; procedure DoMeasureItem(TargetCanvas: TCanvas; Node: PVirtualNode; var NodeHeight: TDimension); virtual; - procedure DoMouseEnter(); virtual; - procedure DoMouseLeave(); virtual; + procedure DoMouseEnter(); override; + procedure DoMouseLeave(); override; procedure DoNodeCopied(Node: PVirtualNode); virtual; function DoNodeCopying(Node, NewParent: PVirtualNode): Boolean; virtual; procedure DoNodeClick(const HitInfo: THitInfo); virtual; @@ -1545,7 +1545,7 @@ TBaseVirtualTree = class abstract(TVTBaseAncestor) procedure SetNodeData(pNode: PVirtualNode; pUserData: Pointer); overload; inline; procedure SetNodeData(pNode: PVirtualNode; const pUserData: IInterface); overload; inline; procedure SetNodeData(pNode: PVirtualNode; pUserData: T); overload; - procedure Sort(Node: PVirtualNode; Column: TColumnIndex; Direction: TSortDirection; DoInit: Boolean = True); virtual; + procedure Sort(Node: PVirtualNode; Column: TColumnIndex; Direction: TSortDirection; DoInit: Boolean = True); override; procedure SortTree(Column: TColumnIndex; Direction: TSortDirection; DoInit: Boolean = True); virtual; procedure ToggleNode(Node: PVirtualNode); procedure UpdateHorizontalRange; virtual;