Skip to content

Commit

Permalink
Merge pull request #1226 from livius2/scroll_fixes__few_virtual_abstract
Browse files Browse the repository at this point in the history 
FMX scroll fixes + some virtal abstract
  • Loading branch information
@joachimmarder
joachimmarder authored Nov 11, 2023
2 parents 2bc0624 + a3a333c commit 1258e88
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 1258e88

Please sign in to comment.