mirror of
https://github.com/HeidiSQL/HeidiSQL.git
synced 2025-08-06 18:24:26 +08:00
554 lines
19 KiB
ObjectPascal
554 lines
19 KiB
ObjectPascal
unit VirtualTrees.BaseAncestorFMX;
|
|
|
|
{$SCOPEDENUMS ON}
|
|
|
|
{****************************************************************************************************************}
|
|
{ Project : VirtualTrees }
|
|
{ }
|
|
{ author : Karol Bieniaszewski }
|
|
{ year : 2022 }
|
|
{ contibutors : }
|
|
{****************************************************************************************************************}
|
|
|
|
interface
|
|
uses
|
|
{$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
|
|
TVTBaseAncestorFMX = class abstract(TRectangle)
|
|
strict private
|
|
FFont: TFont;
|
|
procedure SetFont(const Value: TFont);
|
|
private
|
|
FDottedBrushTreeLines: TStrokeBrush; // used to paint dotted lines without special pens
|
|
FDottedBrushGridLines: TStrokeBrush; // used to paint dotted lines without special pens
|
|
FInCreate: Boolean;
|
|
|
|
function GetFillColor: TAlphaColor;
|
|
procedure SetFillColor(const Value: TAlphaColor);
|
|
protected
|
|
FBevelEdges: TBevelEdges;
|
|
FBevelInner: TBevelCut;
|
|
FBevelOuter: TBevelCut;
|
|
FBevelKind: TBevelKind;
|
|
FBevelWidth: TBevelWidth;
|
|
FBorderWidth: TBorderWidth;
|
|
FHandleAllocated: Boolean;
|
|
FBiDiMode: TBiDiMode;
|
|
FHScrollBar: TScrollBar;
|
|
FVScrollBar: TScrollBar;
|
|
|
|
FUseRightToLeftAlignment: Boolean;
|
|
|
|
procedure SetBevelCut(Index: Integer; const Value: TBevelCut);
|
|
procedure SetBevelEdges(const Value: TBevelEdges);
|
|
procedure SetBevelKind(const Value: TBevelKind);
|
|
procedure SetBevelWidth(const Value: TBevelWidth);
|
|
procedure SetBorderWidth(Value: TBorderWidth);
|
|
procedure SetBiDiMode(Value: TBiDiMode);
|
|
|
|
function GetClientHeight: Single; virtual; abstract;
|
|
function GetClientWidth: Single; virtual; abstract;
|
|
function GetClientRect: TRect; virtual; abstract;
|
|
procedure UpdateStyleElements; virtual; abstract;
|
|
|
|
procedure DoStartDrag(var DragObject: TVTDragDataObject); virtual; abstract;
|
|
procedure DoEndDrag(Target: TObject; X, Y: TDimension); virtual; abstract;
|
|
procedure DragCanceled; virtual; abstract;
|
|
|
|
procedure Resize; override;
|
|
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;
|
|
function PrepareDottedBrush(CurrentDottedBrush: TBrush; Bits: Pointer; const BitsLinesCount: Word): TBrush; virtual; abstract;
|
|
function GetSelectedCount(): Integer; virtual; abstract;
|
|
procedure MarkCutCopyNodes; virtual; abstract;
|
|
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;
|
|
public //methods
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
function ClientToScreen(P: TPoint): TPoint;
|
|
function ScreenToClient(P: TPoint): TPoint;
|
|
procedure RecreateWnd;
|
|
procedure ShowScrollBar(Bar: Integer; AShow: Boolean);
|
|
function SetScrollInfo(Bar: Integer; const ScrollInfo: TScrollInfo; Redraw: Boolean): TDimension;
|
|
function GetScrollInfo(Bar: Integer; var ScrollInfo: TScrollInfo): Boolean;
|
|
function GetScrollPos(Bar: Integer): TDimension;
|
|
function GetScrollBarForBar(Bar: Integer): TScrollBar;
|
|
procedure HScrollChangeProc(Sender: TObject); virtual; abstract;
|
|
procedure VScrollChangeProc(Sender: TObject); virtual; abstract;
|
|
|
|
procedure CopyToClipboard; virtual; abstract;
|
|
procedure CutToClipboard; virtual; abstract;
|
|
function PasteFromClipboard: Boolean; virtual; abstract;
|
|
|
|
/// <summary>
|
|
/// Alias for IsFocused to make same as Vcl Focused
|
|
/// </summary>
|
|
function Focused(): Boolean; inline;
|
|
|
|
/// <summary>
|
|
/// Convert mouse message to TMouseButton
|
|
/// Created as method, to be available in whole hierarchy without specifing Unit file name (prevent circular unit ref).
|
|
/// </summary>
|
|
class function KeysToShiftState(Keys: LongInt): TShiftState; static;
|
|
|
|
function GetParentForm(Control: TControl; TopForm: Boolean = True): TCustomForm;
|
|
|
|
/// <summary>
|
|
/// Alias for Repaint on FMX to be compatible with VCL
|
|
/// </summary>
|
|
procedure Invalidate(); inline;
|
|
/// <summary>
|
|
/// Alias for Repaint on FMX to be compatible with VCL
|
|
/// </summary>
|
|
function InvalidateRect(lpRect: PRect; bErase: Boolean): Boolean; inline;
|
|
/// <summary>
|
|
/// Alias for Repaint on FMX to be compatible with VCL
|
|
/// </summary>
|
|
function UpdateWindow(): Boolean; inline;
|
|
/// <summary>
|
|
/// Alias for Repaint on FMX to be compatible with VCL
|
|
/// </summary>
|
|
function RedrawWindow(lprcUpdate: PRect; hrgnUpdate: NativeUInt; flags: UINT): Boolean; overload; inline;
|
|
/// <summary>
|
|
/// Alias for Repaint on FMX to be compatible with VCL
|
|
/// </summary>
|
|
function RedrawWindow(const lprcUpdate: TRect; hrgnUpdate: NativeUInt; flags: UINT): Boolean; overload; inline;
|
|
|
|
/// <summary>
|
|
/// Alias for Repaint on FMX to be compatible with VCL
|
|
/// </summary>
|
|
function SendWM_SETREDRAW(Updating: Boolean): NativeUInt; inline;
|
|
|
|
/// <summary>
|
|
/// 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;
|
|
property ClientWidth: Single read GetClientWidth;
|
|
property ClientHeight: Single read GetClientHeight;
|
|
property UseRightToLeftAlignment: Boolean read FUseRightToLeftAlignment write FUseRightToLeftAlignment default false;
|
|
property BevelEdges: TBevelEdges read FBevelEdges write SetBevelEdges default [TBevelEdge.beLeft, TBevelEdge.beTop, TBevelEdge.beRight, TBevelEdge.beBottom];
|
|
property BevelInner: TBevelCut index 0 read FBevelInner write SetBevelCut default TBevelCut.bvRaised;
|
|
property BevelOuter: TBevelCut index 1 read FBevelOuter write SetBevelCut default TBevelCut.bvLowered;
|
|
property BevelKind: TBevelKind read FBevelKind write SetBevelKind default TBevelKind.bkNone;
|
|
property BevelWidth: TBevelWidth read FBevelWidth write SetBevelWidth default 1;
|
|
property BorderWidth: TBorderWidth read FBorderWidth write SetBorderWidth;
|
|
property BiDiMode: TBiDiMode read FBiDiMode write SetBiDiMode;
|
|
property HScrollBar: TScrollBar read FHScrollBar;
|
|
property VScrollBar: TScrollBar read FVScrollBar;
|
|
property HandleAllocated: Boolean read FHandleAllocated;
|
|
|
|
/// <summary>
|
|
/// Alias for Fill.Color to make same use as Vcl Color property
|
|
/// </summary>
|
|
property Color: TAlphaColor read GetFillColor write SetFillColor;
|
|
end;
|
|
|
|
{$IFNDEF MSWINDOWS}
|
|
const
|
|
{ GetSystemMetrics() codes }
|
|
SM_CXVSCROLL = 2;
|
|
SM_CYHSCROLL = 3;
|
|
{$ENDIF}
|
|
|
|
implementation
|
|
uses FMX.TextLayout, FMX.Utils
|
|
{$IFNDEF MSWINDOWS}
|
|
, WinApi.Windows
|
|
{$ENDIF}
|
|
;
|
|
|
|
//-------- TVTBaseAncestorFMX ------------------------------------------------------------------------------------------
|
|
|
|
class function TVTBaseAncestorFMX.KeysToShiftState(Keys: LongInt): TShiftState;
|
|
begin
|
|
Result := TShiftState(Word(Keys));
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TVTBaseAncestorFMX.GetFillColor: TAlphaColor;
|
|
begin
|
|
Result:= Fill.Color;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
constructor TVTBaseAncestorFMX.Create(AOwner: TComponent);
|
|
begin
|
|
FInCreate:= true;
|
|
inherited;
|
|
|
|
FHandleAllocated:= true;
|
|
FUseRightToLeftAlignment:= false;
|
|
FBevelEdges:= [TBevelEdge.beLeft, TBevelEdge.beTop, TBevelEdge.beRight, TBevelEdge.beBottom];
|
|
FBevelInner:= TBevelCut.bvRaised;
|
|
FBevelOuter:= TBevelCut.bvLowered;
|
|
FBevelKind:= TBevelKind.bkNone;
|
|
FBevelWidth:= 1;
|
|
FBorderWidth:= 0;
|
|
FFont:= TFont.Create;
|
|
DisableFocusEffect := True;
|
|
CanFocus := True;
|
|
AutoCapture := True;
|
|
|
|
FHScrollBar:= TScrollBar.Create(Self);
|
|
FHScrollBar.Parent:= Self;
|
|
FHScrollBar.Orientation:= TOrientation.Horizontal;
|
|
FHScrollBar.Align:= TAlignLayout.MostBottom;
|
|
FHScrollBar.Visible:= true;
|
|
FHScrollBar.OnChange:= HScrollChangeProc;
|
|
FHScrollBar.Margins.Right:= FHScrollBar.Height;
|
|
|
|
FVScrollBar:= TScrollBar.Create(Self);
|
|
FVScrollBar.Parent:= Self;
|
|
FVScrollBar.Orientation:= TOrientation.Vertical;
|
|
FVScrollBar.Align:= TAlignLayout.MostRight;
|
|
FVScrollBar.Visible:= true;
|
|
FVScrollBar.OnChange:= VScrollChangeProc;
|
|
//FVScrollBar.Margins.Bottom:= FVScrollBar.Width;
|
|
|
|
SetAcceptsControls(false);
|
|
|
|
FInCreate:= false;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
destructor TVTBaseAncestorFMX.Destroy();
|
|
begin
|
|
inherited;
|
|
|
|
if FDottedBrushTreeLines <> nil then
|
|
FreeAndNil(FDottedBrushTreeLines);
|
|
if FDottedBrushGridLines <> nil then
|
|
FreeAndNil(FDottedBrushGridLines);
|
|
FreeAndNil(FFont);
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TVTBaseAncestorFMX.SetBevelCut(Index: Integer; const Value: TBevelCut);
|
|
begin
|
|
case Index of
|
|
0: { BevelInner }
|
|
if Value <> FBevelInner then
|
|
begin
|
|
FBevelInner := Value;
|
|
Repaint;
|
|
end;
|
|
1: { BevelOuter }
|
|
if Value <> FBevelOuter then
|
|
begin
|
|
FBevelOuter := Value;
|
|
Repaint;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TVTBaseAncestorFMX.SetBevelEdges(const Value: TBevelEdges);
|
|
begin
|
|
if Value <> FBevelEdges then
|
|
begin
|
|
FBevelEdges := Value;
|
|
Repaint;
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TVTBaseAncestorFMX.SetBevelKind(const Value: TBevelKind);
|
|
begin
|
|
if Value <> FBevelKind then
|
|
begin
|
|
FBevelKind := Value;
|
|
Repaint;
|
|
end;
|
|
end;
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TVTBaseAncestorFMX.SetBevelWidth(const Value: TBevelWidth);
|
|
begin
|
|
if Value <> FBevelWidth then
|
|
begin
|
|
FBevelWidth := Value;
|
|
Repaint;
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TVTBaseAncestorFMX.ScreenToClient(P: TPoint): TPoint;
|
|
|
|
begin
|
|
Result:= AbsoluteToLocal(P);
|
|
end;
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TVTBaseAncestorFMX.ClientToScreen(P: TPoint): TPoint;
|
|
begin
|
|
Result:= LocalToAbsolute(P);
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TVTBaseAncestorFMX.Invalidate();
|
|
begin
|
|
Repaint;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TVTBaseAncestorFMX.InvalidateRect(lpRect: PRect; bErase: Boolean): Boolean;
|
|
begin
|
|
Repaint;
|
|
Result:= true;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TVTBaseAncestorFMX.UpdateWindow(): Boolean;
|
|
begin
|
|
Repaint;
|
|
Result:= true;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TVTBaseAncestorFMX.RedrawWindow(lprcUpdate: PRect; hrgnUpdate: NativeUInt; flags: UINT): Boolean;
|
|
begin
|
|
Repaint;
|
|
Result:= true;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TVTBaseAncestorFMX.RedrawWindow(const lprcUpdate: TRect; hrgnUpdate: NativeUInt; flags: UINT): Boolean;
|
|
begin
|
|
Repaint;
|
|
Result:= true;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TVTBaseAncestorFMX.RecreateWnd();
|
|
begin
|
|
Repaint;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TVTBaseAncestorFMX.ShowScrollBar(Bar: Integer; AShow: Boolean);
|
|
begin
|
|
if (Bar=SB_HORZ) or (Bar=SB_BOTH) then
|
|
FHScrollBar.Visible:= AShow;
|
|
|
|
if (Bar=SB_VERT) or (Bar=SB_BOTH) then
|
|
FVScrollBar.Visible:= AShow;
|
|
|
|
if FHScrollBar.Visible and FVScrollBar.Visible then
|
|
FHScrollBar.Margins.Right:= FHScrollBar.Height else
|
|
FHScrollBar.Margins.Right:= 0;
|
|
|
|
Repaint;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TVTBaseAncestorFMX.SetScrollInfo(Bar: Integer; const ScrollInfo: TScrollInfo; Redraw: Boolean): TDimension;
|
|
Var ScrollBar: TScrollBar;
|
|
begin
|
|
ScrollBar:= GetScrollBarForBar(Bar);
|
|
if ScrollBar=nil then
|
|
Exit(0); //!!!
|
|
|
|
if ScrollInfo.fMask and SIF_PAGE<>0 then
|
|
begin
|
|
ScrollBar.SmallChange:= ScrollInfo.nPage;
|
|
end;
|
|
|
|
if ScrollInfo.fMask and SIF_RANGE<>0 then
|
|
begin
|
|
ScrollBar.Min:= ScrollInfo.nMin;
|
|
ScrollBar.Max:= ScrollInfo.nMax;
|
|
end;
|
|
|
|
if ScrollInfo.fMask and SIF_POS<>0 then
|
|
begin
|
|
ScrollBar.Value:= ScrollInfo.nPos;
|
|
end;
|
|
|
|
Result:= ScrollBar.Value;
|
|
|
|
Repaint;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TVTBaseAncestorFMX.GetScrollInfo(Bar: Integer; var ScrollInfo: TScrollInfo): Boolean;
|
|
Var ScrollBar: TScrollBar;
|
|
begin
|
|
ScrollBar:= GetScrollBarForBar(Bar);
|
|
if ScrollBar=nil then
|
|
Exit(False); //!!!
|
|
|
|
Result:= true;
|
|
|
|
ScrollInfo.cbSize:= SizeOf(TScrollInfo);
|
|
ScrollInfo.fMask:= SIF_ALL;
|
|
|
|
ScrollInfo.nMin:= ScrollBar.Min;
|
|
ScrollInfo.nMax:= ScrollBar.Max;
|
|
ScrollInfo.nPage:= ScrollBar.SmallChange;
|
|
ScrollInfo.nPos:= ScrollBar.Value;
|
|
ScrollInfo.nTrackPos:= ScrollBar.Value;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TVTBaseAncestorFMX.GetScrollPos(Bar: Integer): TDimension;
|
|
Var ScrollInfo: TScrollInfo;
|
|
begin
|
|
GetScrollInfo(Bar, ScrollInfo); //ignore result
|
|
Result:= ScrollInfo.nPos;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TVTBaseAncestorFMX.GetScrollBarForBar(Bar: Integer): TScrollBar;
|
|
begin
|
|
if (Bar=SB_HORZ) then
|
|
Result:= FHScrollBar else
|
|
if (Bar=SB_VERT) then
|
|
Result:= FVScrollBar else
|
|
Result:= nil;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TVTBaseAncestorFMX.SetBiDiMode(Value: TBiDiMode);
|
|
begin
|
|
if FBiDiMode <> Value then
|
|
begin
|
|
FBiDiMode := Value;
|
|
Repaint;
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TVTBaseAncestorFMX.SetBorderWidth(Value: TBorderWidth);
|
|
begin
|
|
if FBorderWidth <> Value then
|
|
begin
|
|
FBorderWidth := Value;
|
|
Repaint;
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TVTBaseAncestorFMX.SetFillColor(const Value: TAlphaColor);
|
|
begin
|
|
Fill.Color:= Value;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TVTBaseAncestorFMX.SetFont(const Value: TFont);
|
|
begin
|
|
FFont.Assign(Value);
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TVTBaseAncestorFMX.Focused(): Boolean;
|
|
begin
|
|
Result:= IsFocused;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TVTBaseAncestorFMX.GetParentForm(Control: TControl; TopForm: Boolean = True): TCustomForm;
|
|
begin
|
|
Result:= Control.Root.GetObject as TCustomForm;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TVTBaseAncestorFMX.SendWM_SETREDRAW(Updating: Boolean): NativeUInt;
|
|
begin
|
|
Repaint;
|
|
Result:= 0;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TVTBaseAncestorFMX.GetSystemMetrics(nIndex: Integer): Integer;
|
|
begin
|
|
{$IFDEF MSWINDOWS}
|
|
Result:= GetSystemMetrics(nIndex);
|
|
{$ELSE}
|
|
case nIndex of
|
|
SM_CXVSCROLL: Result:= 16;
|
|
SM_CYHSCROLL: Result:= 3;
|
|
else
|
|
raise Exception.Create('Unknown code for GetSystemMetrics: ' + IntToStr(nIndex));
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TVTBaseAncestorFMX.CreateSystemImageSet(): TImageList;
|
|
begin
|
|
Result:= TImageList.Create(Self);
|
|
FillSystemCheckImages(Self, Result);
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
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
|
|
end;
|
|
|
|
end.
|