Skip to content

Commit

Permalink
FMX scroll fixes + some virtal abstract
Browse files Browse the repository at this point in the history 
Sort, DoMouseEnter, DoMouseLeave as virtal abstract. In FMX their exists in parent class so must be reintroduced.
Some moves for FMX scroll.
  • Loading branch information
@livius2
livius2 committed Nov 8, 2023
1 parent 2bc0624 commit a3a333c
Show file tree
Hide file tree
Showing 4 changed files with 124 additions and 110 deletions.
92 changes: 87 additions & 5 deletions Source/VirtualTrees.AncestorFMX.pas
View file
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
unit VirtualTrees.BaseAncestorFMX;
unit VirtualTrees.AncestorFMX;

{$SCOPEDENUMS ON}

Expand All @@ -13,7 +13,9 @@
interface

uses
VirtualTrees.BaseTree;
System.Classes, System.UITypes,
FMX.Graphics,
VirtualTrees.FMX, VirtualTrees.BaseTree;

const
EVENT_OBJECT_STATECHANGE = $800A;
Expand All @@ -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);

//----------------------------------------------------------------------------------------------------------------------

Expand All @@ -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);
Expand Down Expand Up @@ -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);
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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;
Expand Down
131 changes: 29 additions & 102 deletions Source/VirtualTrees.BaseAncestorFMX.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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);
Expand Down Expand Up @@ -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;
Expand All @@ -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;
Expand All @@ -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;
Expand Down Expand Up @@ -136,6 +141,7 @@ TVTBaseAncestorFMX = class abstract(TRectangle)
/// Simulate Windows GetSystemMetrics
/// </summary>
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;
Expand Down Expand Up @@ -182,84 +188,20 @@ 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;
end;

//----------------------------------------------------------------------------------------------------------------------

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;
inherited;

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;
Expand Down Expand Up @@ -288,6 +230,7 @@ constructor TVTBaseAncestorFMX.Create(AOwner: TComponent);
//FVScrollBar.Margins.Bottom:= FVScrollBar.Width;

SetAcceptsControls(false);

FInCreate:= false;
end;

Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
5 changes: 5 additions & 0 deletions Source/VirtualTrees.BaseAncestorVcl.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -292,6 +295,8 @@ procedure TVTBaseAncestorVcl.CopyToClipboard;
end;
end;

//----------------------------------------------------------------------------------------------------------------------

function TVTBaseAncestorVcl.CreateSystemImageSet: TImageList;

// Creates a system check image set.
Expand Down
Loading

0 comments on commit a3a333c

Please sign in to comment.