From df38930dde9705c19ec22942d7f0ab8833fe894b Mon Sep 17 00:00:00 2001 From: Karol Bieniaszewski Date: Sun, 4 Nov 2018 23:21:20 +0100 Subject: [PATCH 01/61] Initial Port to Firemonkey --- Source/VirtualTrees.Accessibility.pas | 5 + Source/VirtualTrees.AccessibilityFactory.pas | 5 + Source/VirtualTrees.Actions.pas | 5 + Source/VirtualTrees.Classes.pas | 5 + Source/VirtualTrees.ClipBoard.pas | 6 + Source/VirtualTrees.Export.pas | 152 +- Source/VirtualTrees.HeaderPopup.pas | 76 +- Source/VirtualTrees.StyleHooks.pas | 6 + Source/VirtualTrees.Utils.pas | 111 +- Source/VirtualTrees.WorkerThread.pas | 4 + Source/VirtualTrees.pas | 3601 +++++++++++++----- 11 files changed, 2924 insertions(+), 1052 deletions(-) diff --git a/Source/VirtualTrees.Accessibility.pas b/Source/VirtualTrees.Accessibility.pas index 568815a5c..56caa00a6 100644 --- a/Source/VirtualTrees.Accessibility.pas +++ b/Source/VirtualTrees.Accessibility.pas @@ -7,6 +7,11 @@ interface +//{$DEFINE VT_FMX} +{$IFNDEF VT_FMX} + {$DEFINE VT_VCL} +{$ENDIF} + uses Winapi.Windows, System.Classes, Winapi.ActiveX, System.Types, Winapi.oleacc, VirtualTrees, VirtualTrees.AccessibilityFactory, Vcl.Controls; diff --git a/Source/VirtualTrees.AccessibilityFactory.pas b/Source/VirtualTrees.AccessibilityFactory.pas index 5c772d81a..0bc8960b2 100644 --- a/Source/VirtualTrees.AccessibilityFactory.pas +++ b/Source/VirtualTrees.AccessibilityFactory.pas @@ -36,6 +36,11 @@ interface +//{$DEFINE VT_FMX} +{$IFNDEF VT_FMX} + {$DEFINE VT_VCL} +{$ENDIF} + uses System.Classes, Winapi.oleacc, VirtualTrees; diff --git a/Source/VirtualTrees.Actions.pas b/Source/VirtualTrees.Actions.pas index 0a74ac618..a901de4c0 100644 --- a/Source/VirtualTrees.Actions.pas +++ b/Source/VirtualTrees.Actions.pas @@ -2,6 +2,11 @@ interface +//{$DEFINE VT_FMX} +{$IFNDEF VT_FMX} + {$DEFINE VT_VCL} +{$ENDIF} + uses System.Classes, System.Actions, diff --git a/Source/VirtualTrees.Classes.pas b/Source/VirtualTrees.Classes.pas index c8284e980..bce291001 100644 --- a/Source/VirtualTrees.Classes.pas +++ b/Source/VirtualTrees.Classes.pas @@ -28,6 +28,11 @@ interface {$WARN UNSAFE_CAST OFF} {$WARN UNSAFE_CODE OFF} +//{$DEFINE VT_FMX} +{$IFNDEF VT_FMX} + {$DEFINE VT_VCL} +{$ENDIF} + uses Winapi.Windows; diff --git a/Source/VirtualTrees.ClipBoard.pas b/Source/VirtualTrees.ClipBoard.pas index 197eed237..072bf8b20 100644 --- a/Source/VirtualTrees.ClipBoard.pas +++ b/Source/VirtualTrees.ClipBoard.pas @@ -28,6 +28,12 @@ interface {$WARN UNSAFE_TYPE OFF} {$WARN UNSAFE_CAST OFF} +//{$DEFINE VT_FMX} +{$IFNDEF VT_FMX} + {$DEFINE VT_VCL} +{$ENDIF} + + uses Winapi.Windows, Winapi.ActiveX, diff --git a/Source/VirtualTrees.Export.pas b/Source/VirtualTrees.Export.pas index 8ae32cd0f..cc0ddfeae 100644 --- a/Source/VirtualTrees.Export.pas +++ b/Source/VirtualTrees.Export.pas @@ -6,27 +6,34 @@ interface -uses Winapi.Windows, - VirtualTrees, - VirtualTrees.Classes; +//{$DEFINE VT_FMX} +{$IFNDEF VT_FMX} + {$DEFINE VT_VCL} +{$ENDIF} + +{$IFDEF VT_FMX} +uses System.SysUtils, FMX.Graphics, System.Classes, FMX.Forms, + FMX.Controls, System.StrUtils, System.Generics.Collections, + VirtualTrees, VirtualTrees.Classes, FMX.Types; +{$ELSE} +uses Winapi.Windows, System.SysUtils, Vcl.Graphics, System.Classes, Vcl.Forms, + Vcl.Controls, System.StrUtils, System.Generics.Collections, + VirtualTrees, VirtualTrees.Classes; +{$ENDIF} + function ContentToHTML(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceType; const Caption: string = ''): String; function ContentToRTF(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceType): RawByteString; function ContentToUnicodeString(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceType; const Separator: string): string; +{$IFDEF VT_VCL} function ContentToClipboard(Tree: TCustomVirtualStringTree; Format: Word; Source: TVSTTextSourceType): HGLOBAL; +{$ENDIF} procedure ContentToCustom(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceType); implementation uses - Vcl.Graphics, - Vcl.Controls, - Vcl.Forms, - System.Classes, - System.SysUtils, - System.StrUtils, - System.Generics.Collections, - System.UITypes; + UITypes; type TCustomVirtualStringTreeCracker = class(TCustomVirtualStringTree) @@ -48,9 +55,17 @@ function ContentToHTML(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceTyp Buffer: TBufferedString; //--------------- local functions ------------------------------------------- - +{$IFDEF VT_FMX} + procedure WriteColorAsHex(Color: TColor); + var + Result: String; + begin + Result := IntToHex(Color, 6); + Result := '#' + Copy(Result, 5, 2) + Copy(Result, 3, 2) + Copy(Result, 1, 2); + Buffer.Add('#' + Result); + end; +{$ELSE} procedure WriteColorAsHex(Color: TColor); - var WinColor: COLORREF; I: Integer; @@ -67,19 +82,21 @@ function ContentToHTML(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceTyp Value := 48 + (Component shr 4); if Value > $39 then - Inc(Value, 7); + System.Inc(Value, 7); Buffer.Add(AnsiChar(Value)); - Inc(I); + System.Inc(I); Value := 48 + (Component and $F); if Value > $39 then - Inc(Value, 7); + System.Inc(Value, 7); Buffer.Add(AnsiChar(Value)); - Inc(I); + System.Inc(I); WinColor := WinColor shr 8; end; end; +{$ENDIF} + //--------------------------------------------------------------------------- @@ -98,18 +115,23 @@ function ContentToHTML(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceTyp Buffer.Add('{'); end; - Buffer.Add(Format('font-family: ''%s''; ', [Font.Name])); + Buffer.Add(Format('font-family: ''%s''; ', [Font.{$IFDEF VT_FMX}Family{$ELSE}Name{$ENDIF}])); +{$IFDEF VT_FMX} + Buffer.Add(Format('font-size: %dpt; ', [Round(Font.Size)])); //TODO: Round +{$ELSE} if Font.Size < 0 then Buffer.Add(Format('font-size: %dpx; ', [Font.Height])) else Buffer.Add(Format('font-size: %dpt; ', [Font.Size])); +{$ENDIF} + - Buffer.Add(Format('font-style: %s; ', [IfThen(fsItalic in Font.Style, 'italic', 'normal')])); - Buffer.Add(Format('font-weight: %s; ', [IfThen(fsBold in Font.Style, 'bold', 'normal')])); - Buffer.Add(Format('text-decoration: %s; ', [IfThen(fsUnderline in Font.Style, 'underline', 'none')])); + Buffer.Add(Format('font-style: %s; ', [IfThen(TFontStyle.fsItalic in Font.Style, 'italic', 'normal')])); + Buffer.Add(Format('font-weight: %s; ', [IfThen(TFontStyle.fsBold in Font.Style, 'bold', 'normal')])); + Buffer.Add(Format('text-decoration: %s; ', [IfThen(TFontStyle.fsUnderline in Font.Style, 'underline', 'none')])); Buffer.Add('color: '); - WriteColorAsHex(Font.Color); + WriteColorAsHex({$IFDEF VT_FMX}TColors.Black{$ELSE}Font.Color{$ENDIF}); //TODO: Font.Color Buffer.Add(';'); if Length(Name) = 0 then Buffer.Add('"') @@ -149,14 +171,17 @@ function ContentToHTML(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceTyp CrackTree.RedirectFontChangeEvent(CrackTree.Canvas); CellPadding := Format('padding-left: %dpx; padding-right: %0:dpx;', [CrackTree.Margin]); - +{$IFDEF VT_FMX} + IndentWidth := IntToStr(Round(CrackTree.Indent)); +{$ELSE} IndentWidth := IntToStr(CrackTree.Indent); +{$ENDIF} AddHeader := ' '; // Add title if adviced so by giving a caption. if Length(Caption) > 0 then AddHeader := AddHeader + 'caption="' + Caption + '"'; if CrackTree.Borderstyle <> bsNone then - AddHeader := AddHeader + Format(' border="%d" frame=box', [CrackTree.BorderWidth + 1]); + AddHeader := AddHeader + Format(' border="%d" frame=box', [{$IFDEF VT_FMX}Round{$ENDIF}(CrackTree.BorderWidth) + 1]); //TODO: Round Buffer.Add(''); @@ -209,7 +234,11 @@ function ContentToHTML(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceTyp // General table properties. Buffer.Add(''); Buffer.AddNewLine; @@ -254,13 +283,19 @@ function ContentToHTML(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceTyp if Assigned(CrackTree.OnBeforeColumnExport) then CrackTree.OnBeforeColumnExport(CrackTree, etHTML, Columns[I]); Buffer.Add(''); end else @@ -373,13 +424,21 @@ function ContentToHTML(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceTyp Buffer.Add('
bdLeftToRight then begin +{$IFDEF VT_VCL} ChangeBidiModeAlignment(Alignment); +{$ENDIF} Buffer.Add(' dir="rtl"'); end; @@ -289,7 +324,11 @@ function ContentToHTML(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceTyp // Set column width in pixels. Buffer.Add(' width="'); +{$IFDEF VT_FMX} + Buffer.Add(IntToStr(Round(Columns[I].Width))); //TODO: Round +{$ELSE} Buffer.Add(IntToStr(Columns[I].Width)); +{$ENDIF} Buffer.Add('px">'); if Length(Columns[I].Text) > 0 then @@ -330,7 +369,11 @@ function ContentToHTML(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceTyp if not RenderColumns or (coVisible in Columns[I].Options) then begin // Call back the application to know about font customization. +{$IFDEF VT_FMX} + CrackTree.Canvas.Font.Assign(CrackTree.Font); +{$ELSE} CrackTree.Canvas.Font := CrackTree.Font; +{$ENDIF} CrackTree.FFontChanged := False; CrackTree.DoPaintText(Run, CrackTree.Canvas, Index, ttNormal); @@ -344,7 +387,11 @@ function ContentToHTML(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceTyp Buffer.Add('  bdLeftToRight then begin +{$IFDEF VT_VCL} ChangeBidiModeAlignment(Alignment); +{$ENDIF} Buffer.Add(' dir="rtl"'); end; @@ -434,7 +495,7 @@ function ContentToHTML(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceTyp if not RenderColumns then Break; - Inc(I); + System.Inc(I); end; if Assigned(CrackTree.OnAfterNodeExport) then CrackTree.OnAfterNodeExport(CrackTree, etHTML, Run); @@ -462,7 +523,7 @@ function ContentToRTF(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceType Fonts: TStringList; Colors: TList; CurrentFontIndex, - CurrentFontColor, + CurrentFontColor: Integer; CurrentFontSize: Integer; Buffer: TBufferedRawByteString; @@ -535,23 +596,23 @@ function ContentToRTF(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceType begin if Length(Text) > 0 then begin - UseUnderline := fsUnderline in Font.Style; + UseUnderline := TFontStyle.fsUnderline in Font.Style; if UseUnderline then Buffer.Add('\ul'); - UseItalic := fsItalic in Font.Style; + UseItalic := TFontStyle.fsItalic in Font.Style; if UseItalic then Buffer.Add('\i'); - UseBold := fsBold in Font.Style; + UseBold := TFontStyle.fsBold in Font.Style; if UseBold then Buffer.Add('\b'); - SelectFont(Font.Name); - SelectColor(Font.Color); + SelectFont(Font.{$IFDEF VT_FMX}Family{$ELSE}Name{$ENDIF}); + SelectColor({$IFDEF VT_FMX}TColors.Black{$ELSE}Font.Color{$ENDIF}); //TODO: color if Font.Size <> CurrentFontSize then begin // Font size must be given in half points. Buffer.Add('\fs'); - Buffer.Add(IntToStr(2 * Font.Size)); - CurrentFontSize := Font.Size; + Buffer.Add(IntToStr(2 * {$IFDEF VT_FMX}Round{$ENDIF}(Font.Size))); //TODO: Round + CurrentFontSize := {$IFDEF VT_FMX}Round{$ENDIF}(Font.Size); end; // Use escape sequences to note Unicode text. Buffer.Add(' '); @@ -630,16 +691,16 @@ function ContentToRTF(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceType begin for I := 0 to High(Columns) do begin - Inc(J, Columns[I].Width); + System.Inc(J, {$IFDEF VT_FMX}Round{$ENDIF}(Columns[I].Width)); // This value must be expressed in twips (1 inch = 1440 twips). - Twips := Round(1440 * J / Screen.PixelsPerInch); + Twips := Round(1440 * J / {$IFDEF VT_FMX}96{$ELSE}Screen.PixelsPerInch{$ENDIF}); //TODO: PixelsPerInch Buffer.Add('\cellx'); Buffer.Add(IntToStr(Twips)); end; end else begin - Twips := Round(1440 * CrackTree.ClientWidth / Screen.PixelsPerInch); + Twips := Round(1440 * CrackTree.ClientWidth / {$IFDEF VT_FMX}96{$ELSE}Screen.PixelsPerInch{$ENDIF});//TODO: PixelsPerInch Buffer.Add('\cellx'); Buffer.Add(IntToStr(Twips)); end; @@ -658,8 +719,10 @@ function ContentToRTF(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceType BidiMode := Columns[I].BidiMode; // Alignment is not supported with older RTF formats, however it will be ignored. +{$IFDEF VT_VCL} if BidiMode <> bdLeftToRight then ChangeBidiModeAlignment(Alignment); +{$ENDIF} case Alignment of taLeftJustify: Buffer.Add('\ql'); @@ -715,8 +778,10 @@ function ContentToRTF(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceType Buffer.Add('\pard\intbl'); // Alignment is not supported with older RTF formats, however it will be ignored. +{$IFDEF VT_VCL} if BidiMode <> bdLeftToRight then ChangeBidiModeAlignment(Alignment); +{$ENDIF} case Alignment of taRightJustify: Buffer.Add('\qr'); @@ -725,7 +790,11 @@ function ContentToRTF(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceType end; // Call back the application to know about font customization. +{$IFDEF VT_FMX} + CrackTree.Canvas.Font.Assign(CrackTree.Font); +{$ELSE} CrackTree.Canvas.Font := CrackTree.Font; +{$ENDIF} CrackTree.FFontChanged := False; CrackTree.DoPaintText(Run, CrackTree.Canvas, Index, ttNormal); @@ -764,7 +833,7 @@ function ContentToRTF(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceType if not RenderColumns then Break; - Inc(I); + System.Inc(I); end; Buffer.Add('\row'); Buffer.AddNewLine; @@ -784,14 +853,19 @@ function ContentToRTF(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceType S := S + '{\colortbl;'; for I := 0 to Colors.Count - 1 do begin - J := ColorToRGB(TColor(Colors[I])); + J := {$IFDEF VT_VCL}ColorToRGB{$ENDIF}(TColor(Colors[I])); S := S + Format('\red%d\green%d\blue%d;', [J and $FF, (J shr 8) and $FF, (J shr 16) and $FF]); end; S := S + '}'; +{$IFDEF VT_FMX} + S := S + '\paperw16840\paperh11907';// This sets A4 landscape format +{$ELSE} if (GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_IMEASURE, @LocaleBuffer[0], Length(LocaleBuffer)) <> 0) and (LocaleBuffer[0] = '0'{metric}) then S := S + '\paperw16840\paperh11907'// This sets A4 landscape format else S := S + '\paperw15840\paperh12240';//[JAM:marder] This sets US Letter landscape format +{$ENDIF} + // Make sure a small margin is used so that a lot of the table fits on a paper. This defines a margin of 0.5" S := S + '\margl720\margr720\margt720\margb720'; Result := S + Buffer.AsString + '}'; @@ -939,6 +1013,7 @@ function ContentToUnicodeString(Tree: TCustomVirtualStringTree; Source: TVSTText end; end; +{$IFDEF VT_VCL} function ContentToClipboard(Tree: TCustomVirtualStringTree; Format: Word; Source: TVSTTextSourceType): HGLOBAL; // This method constructs a shareable memory object filled with string data in the required format. Supported are: @@ -1061,6 +1136,7 @@ function ContentToClipboard(Tree: TCustomVirtualStringTree; Format: Word; Source GlobalUnlock(Result); end; end; +{$ENDIF} procedure ContentToCustom(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceType); diff --git a/Source/VirtualTrees.HeaderPopup.pas b/Source/VirtualTrees.HeaderPopup.pas index 2499b4e82..61a9efc95 100644 --- a/Source/VirtualTrees.HeaderPopup.pas +++ b/Source/VirtualTrees.HeaderPopup.pas @@ -65,10 +65,22 @@ interface +//{$DEFINE VT_FMX} +{$IFNDEF VT_FMX} + {$DEFINE VT_VCL} +{$ENDIF} + uses +{$IFDEF VT_FMX} + System.Classes, + FMX.Menus, + VirtualTrees; +{$ELSE} System.Classes, Vcl.Menus, VirtualTrees; +{$ENDIF} + type TVTHeaderPopupOption = ( @@ -94,7 +106,7 @@ TVTHeaderPopupMenu = class(TPopupMenu) procedure OnMenuItemClick(Sender: TObject); public constructor Create(AOwner: TComponent); override; - procedure Popup(x, y: Integer); override; + procedure Popup(x, y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); override; published property Options: TVTHeaderPopupOptions read FOptions write FOptions default [poResizeToFitItem]; @@ -107,7 +119,14 @@ TVTHeaderPopupMenu = class(TPopupMenu) implementation uses +{$IFDEF VT_FMX} + FMX.Types; +{$ELSE} Winapi.Windows, System.Types; +{$ENDIF} +const + cResizeToFitMenuItemName = 'VT_ResizeToFitMenuItem'; + resourcestring sResizeColumnToFit = 'Size &Column to Fit'; @@ -152,7 +171,7 @@ procedure TVTHeaderPopupMenu.OnMenuItemClick(Sender: TObject); if Assigned(PopupComponent) and (PopupComponent is TBaseVirtualTree) then begin with TBaseVirtualTree(PopupComponent).Header.Columns.Items[TVTMenuItem(Sender).Tag] do begin - if TVTMenuItem(Sender).Checked then + if TVTMenuItem(Sender).{$IFDEF VT_FMX}IsChecked{$ELSE}Checked{$ENDIF} then Options := Options - [coVisible] else Options := Options + [coVisible]; @@ -162,7 +181,31 @@ procedure TVTHeaderPopupMenu.OnMenuItemClick(Sender: TObject); //---------------------------------------------------------------------------------------------------------------------- -procedure TVTHeaderPopupMenu.Popup(x, y: Integer); +{$IFDEF VT_FMX} +function NewItem(const ACaption: string; AShortCut: TShortCut; + AChecked, AEnabled: Boolean; AOnClick: TNotifyEvent; hCtx: THelpContext; + const AName: string): TVTMenuItem; +begin + Result := TVTMenuItem.Create(nil, ACaption, AOnClick); + with Result do + begin + Text := ACaption; + ShortCut := AShortCut; + OnClick := AOnClick; + HelpContext := hCtx; + IsChecked := AChecked; + Enabled := AEnabled; + Name := AName; + end; +end; + +function NewLine: TMenuItem; +begin + Result := TMenuItem.Create(nil); + Result.Text := '-'; +end; +{$ENDIF} +procedure TVTHeaderPopupMenu.Popup(x, y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); var ColPos: TColumnPosition; ColIdx: TColumnIndex; @@ -174,11 +217,22 @@ procedure TVTHeaderPopupMenu.Popup(x, y: Integer); VisibleItem: TVTMenuItem; i: Integer; - begin if Assigned(PopupComponent) and (PopupComponent is TBaseVirtualTree) then begin // Delete existing menu items. +{$IFDEF VT_FMX} + while ItemsCount > 0 do + Items[0].Free; + + if poResizeToFitItem in Self.Options then begin + NewMenuItem := NewItem(sResizeToFit, 0, False, True, OnMenuItemClick, 0, cResizeToFitMenuItemName); + InsertObject(ItemsCount-1{???}, NewMenuItem); + InsertObject(ItemsCount-1{???}, NewLine()); + {if IsHandleValid(Handle) then + Platform.UpdateMenuItem(mnuFile); } + end;//poResizeToFitItem +{$ELSE} for i := Items.Count -1 downto 0 do begin if Items[i] is TVTMenuItem then Items[i].Free; @@ -190,6 +244,8 @@ procedure TVTHeaderPopupMenu.Popup(x, y: Integer); Items.Add(TVTMenuItem.Create(Self, sResizeToFit, ResizeToFit)); Items.Add(TVTMenuItem.Create(Self, cLineCaption)); end;//poResizeToFitItem +{$ENDIF} + // Add column menu items. with (PopupComponent as TBaseVirtualTree).Header do @@ -211,22 +267,26 @@ procedure TVTHeaderPopupMenu.Popup(x, y: Integer); with Columns[ColIdx] do begin if coVisible in Options then - Inc(VisibleCounter); + System.Inc(VisibleCounter); DoAddHeaderPopupItem(ColIdx, Cmd); if Cmd <> apHidden then begin NewMenuItem := TVTMenuItem.Create(Self, Text, OnMenuItemClick); NewMenuItem.Tag := ColIdx; - NewMenuItem.Caption := Text; + NewMenuItem.{$IFDEF VT_FMX}Text{$ELSE}Caption{$ENDIF} := Text; NewMenuItem.Hint := Hint; NewMenuItem.ImageIndex := ImageIndex; - NewMenuItem.Checked := coVisible in Options; + NewMenuItem.{$IFDEF VT_FMX}IsChecked{$ELSE}Checked{$ENDIF} := coVisible in Options; if Cmd = apDisabled then NewMenuItem.Enabled := False else if coVisible in Options then VisibleItem := NewMenuItem; +{$IFDEF VT_FMX} + InsertObject(Self.ItemsCount-1{???}, NewMenuItem); +{$ELSE} Items.Add(NewMenuItem); +{$ENDIF} end; end; end; @@ -264,7 +324,7 @@ procedure TVTHeaderPopupMenu.ResizeToFit(Sender: TObject); constructor TVTMenuItem.Create(AOwner: TComponent; const ACaption: string; AClickHandler: TNotifyEvent); begin Inherited Create(AOwner); - Caption := ACaption; + {$IFDEF VT_FMX}Text{$ELSE}Caption{$ENDIF} := ACaption; OnClick := AClickHandler; end; diff --git a/Source/VirtualTrees.StyleHooks.pas b/Source/VirtualTrees.StyleHooks.pas index bc771b3a6..1b626ed57 100644 --- a/Source/VirtualTrees.StyleHooks.pas +++ b/Source/VirtualTrees.StyleHooks.pas @@ -29,6 +29,12 @@ interface {$WARN UNSAFE_CAST OFF} {$WARN UNSAFE_CODE OFF} +//{$DEFINE VT_FMX} +{$IFNDEF VT_FMX} + {$DEFINE VT_VCL} +{$ENDIF} + + uses Winapi.Windows, Winapi.Messages, diff --git a/Source/VirtualTrees.Utils.pas b/Source/VirtualTrees.Utils.pas index 4f8833f27..a0b640997 100644 --- a/Source/VirtualTrees.Utils.pas +++ b/Source/VirtualTrees.Utils.pas @@ -28,13 +28,28 @@ interface {$WARN UNSAFE_CAST OFF} {$WARN UNSAFE_CODE OFF} +//{$DEFINE VT_FMX} +{$IFNDEF VT_FMX} + {$DEFINE VT_VCL} +{$ENDIF} + uses +{$IFDEF VT_FMX} + System.Types, + System.Sysutils, + FMX.Graphics, + FMX.ImgList, + System.ImageList, + FMX.Types, + VirtualTrees; +{$ELSE} Winapi.Windows, Winapi.ActiveX, System.Types, Vcl.Graphics, Vcl.ImgList, Vcl.Controls; +{$ENDIF} type @@ -46,6 +61,7 @@ interface bmConstantAlphaAndColor // blend the destination color with the given constant color und the constant alpha value ); +{$IFDEF VT_VCL} procedure AlphaBlend(Source, Destination: HDC; R: TRect; Target: TPoint; Mode: TBlendMode; ConstantAlpha, Bias: Integer); function GetRGBColor(Value: TColor): DWORD; procedure PrtStretchDrawDIB(Canvas: TCanvas; DestRect: TRect; ABitmap: TBitmap); @@ -59,23 +75,29 @@ procedure SetCanvasOrigin(Canvas: TCanvas; X, Y: Integer); inline; procedure ClipCanvas(Canvas: TCanvas; ClipRect: TRect; VisibleRegion: HRGN = 0); procedure DrawImage(ImageList: TCustomImageList; Index: Integer; Canvas: TCanvas; X, Y: Integer; Style: Cardinal; Enabled: Boolean); +{$ENDIF} // Adjusts the given string S so that it fits into the given width. EllipsisWidth gives the width of // the three points to be added to the shorted string. If this value is 0 then it will be determined implicitely. // For higher speed (and multiple entries to be shorted) specify this value explicitely. -function ShortenString(DC: HDC; const S: string; Width: Integer; EllipsisWidth: Integer = 0): string; +function ShortenString({$IFDEF VT_FMX}ACanvas: TCanvas{$ELSE}DC: HDC{$ENDIF}; const S: string; Width: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; EllipsisWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} = 0): string; // Wrap the given string S so that it fits into a space of given width. // RTL determines if right-to-left reading is active. -function WrapString(DC: HDC; const S: string; const Bounds: TRect; RTL: Boolean; DrawFormat: Cardinal): string; +function WrapString({$IFDEF VT_FMX}ACanvas: TCanvas{$ELSE}DC: HDC{$ENDIF}; const S: string; const Bounds: TRect; RTL: Boolean; DrawFormat: Cardinal): string; // Calculates bounds of a drawing rectangle for the given string -procedure GetStringDrawRect(DC: HDC; const S: string; var Bounds: TRect; DrawFormat: Cardinal); - +procedure GetStringDrawRect({$IFDEF VT_FMX}ACanvas: TCanvas{$ELSE}DC: HDC{$ENDIF}; const S: string; var Bounds: TRect; DrawFormat: Cardinal); +{$IFDEF VT_FMX} +procedure DrawTextW(ACanvas: TCanvas; CaptionText: String; Len: Integer; Bounds: TRectF; DrawFormat: Cardinal{this is windows format - must be converted to FMX}); +procedure GetTextExtentPoint32W(ACanvas: TCanvas; CaptionText: String; Len: Integer; Var Size: TSizeF); +{--}procedure DrawEdge(TargetCanvas: TCanvas; PaintRectangle: TRectF; PressedButtonStyle, PressedButtonFlags: Cardinal); +{$ENDIF} // Converts the incoming rectangle so that left and top are always less than or equal to right and bottom. function OrderRect(const R: TRect): TRect; +{$IFDEF VT_VCL} // Fills the given rectangles with values which can be used while dragging around an image // (used in DragMove of the drag manager and DragTo of the header columns). procedure FillDragRectangles(DragWidth, DragHeight, DeltaX, DeltaY: Integer; var RClip, RScroll, RSamp1, RSamp2, RDraw1, RDraw2: TRect); @@ -90,20 +112,25 @@ procedure ApplyDragImage(const pDataObject: IDataObject; pBitmap: TBitmap); function IsMouseCursorVisible(): Boolean; procedure ScaleImageList(const ImgList: TImageList; M, D: Integer); - +{$ENDIF} implementation - uses +{$IFDEF VT_FMX} + System.Math; +{$ELSE} Winapi.CommCtrl, Winapi.ShlObj, System.SysUtils, System.StrUtils, System.Math; +{$ENDIF} + const WideLF = Char(#10); +{$IFDEF VT_VCL} procedure ApplyDragImage(const pDataObject: IDataObject; pBitmap: TBitmap); var DragSourceHelper: IDragSourceHelper; @@ -133,7 +160,7 @@ procedure ApplyDragImage(const pDataObject: IDataObject; pBitmap: TBitmap); end;//if not InitializeFromWindow end; end; - +{$ENDIF} function OrderRect(const R: TRect): TRect; @@ -161,8 +188,14 @@ function OrderRect(const R: TRect): TRect; end; //---------------------------------------------------------------------------------------------------------------------- - - +{$IFDEF VT_FMX} +procedure DrawTextW(ACanvas: TCanvas; CaptionText: String; Len: Integer; Bounds: TRectF; DrawFormat: Cardinal{this is windows format - must be converted to FMX}); +begin + //TTextLayout. render + //DrawFormat: Cardinal{this is windows format - must be converted to FMX} + ACanvas.FillText(Bounds, CaptionText, false, 1.0, [], TTextAlign.Leading, TTextAlign.Center); +end; +{$ELSE} procedure SetBrushOrigin(Canvas: TCanvas; X, Y: Integer); // Set the brush origin of a given canvas. @@ -214,29 +247,44 @@ procedure ClipCanvas(Canvas: TCanvas; ClipRect: TRect; VisibleRegion: HRGN = 0); SelectClipRgn(Canvas.Handle, ClipRegion); DeleteObject(ClipRegion); end; +{$ENDIF} -//---------------------------------------------------------------------------------------------------------------------- +//---------------------------------------------------------------------------------------------------------------------- -procedure GetStringDrawRect(DC: HDC; const S: string; var Bounds: TRect; DrawFormat: Cardinal); +procedure GetStringDrawRect({$IFDEF VT_FMX}ACanvas: TCanvas{$ELSE}DC: HDC{$ENDIF}; const S: string; var Bounds: TRect; DrawFormat: Cardinal); begin - Bounds.Right := Bounds.Left + 1; +{$IFDEF VT_FMX} + Bounds:= Rect(0, 0, ACanvas.TextWidth(S), ACanvas.TextHeight(S)); +{$ELSE} + Bounds.Right := Bounds.Left + 1; Bounds.Bottom := Bounds.Top + 1; - Winapi.Windows.DrawTextW(DC, PWideChar(S), Length(S), Bounds, DrawFormat or DT_CALCRECT); + Winapi.Windows.DrawTextW(DC, PWideChar(S), Length(S), Bounds, DrawFormat or DT_CALCRECT); +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- +procedure DrawEdge(TargetCanvas: TCanvas; PaintRectangle: TRectF; PressedButtonStyle, PressedButtonFlags: Cardinal); +begin + //TODO: DrawEdge + //NormalButtonStyle + //RaisedButtonStyle + //RaisedButtonFlags or RightBorderFlag + //NormalButtonFlags or RightBorderFlag +end; + +//---------------------------------------------------------------------------------------------------------------------- -function ShortenString(DC: HDC; const S: string; Width: Integer; EllipsisWidth: Integer = 0): string; +function ShortenString({$IFDEF VT_FMX}ACanvas: TCanvas{$ELSE}DC: HDC{$ENDIF}; const S: string; Width: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; EllipsisWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} = 0): string; var Size: TSize; Len: Integer; - L, H, N, W: Integer; - + L, H, N: Integer; + W: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; begin Len := Length(S); if (Len = 0) or (Width <= 0) then @@ -246,7 +294,7 @@ function ShortenString(DC: HDC; const S: string; Width: Integer; EllipsisWidth: // Determine width of triple point using the current DC settings (if not already done). if EllipsisWidth = 0 then begin - GetTextExtentPoint32W(DC, '...', 3, Size); + GetTextExtentPoint32W({$IFDEF VT_FMX}ACanvas{$ELSE}DC{$ENDIF}, '...', 3, Size); EllipsisWidth := Size.cx; end; @@ -259,7 +307,7 @@ function ShortenString(DC: HDC; const S: string; Width: Integer; EllipsisWidth: while L < H do begin N := (L + H + 1) shr 1; - GetTextExtentPoint32W(DC, PWideChar(S), N, Size); + GetTextExtentPoint32W({$IFDEF VT_FMX}ACanvas{$ELSE}DC{$ENDIF}, {$IFDEF VT_VCL}PWideChar{$ENDIF}(S), N, Size); W := Size.cx + EllipsisWidth; if W <= Width then L := N @@ -278,9 +326,20 @@ function ShortenString(DC: HDC; const S: string; Width: Integer; EllipsisWidth: end; end; +{$IFDEF VT_FMX} + +//---------------------------------------------------------------------------------------------------------------------- + +procedure GetTextExtentPoint32W(ACanvas: TCanvas; CaptionText: String; Len: Integer; Var Size: TSizeF); +begin + Size.cx:= ACanvas.TextWidth(Copy(CaptionText, 1, Len)); + Size.cy:= ACanvas.TextHeight(Copy(CaptionText, 1, Len)); +end; + +{$ENDIF} //---------------------------------------------------------------------------------------------------------------------- -function WrapString(DC: HDC; const S: string; const Bounds: TRect; RTL: Boolean; DrawFormat: Cardinal): string; +function WrapString({$IFDEF VT_FMX}ACanvas: TCanvas{$ELSE}DC: HDC{$ENDIF}; const S: string; const Bounds: TRect; RTL: Boolean; DrawFormat: Cardinal): string; var Width, @@ -292,8 +351,10 @@ function WrapString(DC: HDC; const S: string; const Bounds: TRect; RTL: Boolean; Line: string; Words: array of string; R: TRect; - begin +{$IFDEF VT_FMX} + Result:= S; +{$ELSE} Result := ''; // Leading and trailing are ignored. Buffer := Trim(S); @@ -426,7 +487,10 @@ function WrapString(DC: HDC; const S: string; const Bounds: TRect; RTL: Boolean; Len := Length(Result); if Result[Len] = WideLF then - SetLength(Result, Len - 1); + SetLength(Result, Len - 1); +{$ENDIF} + + end; //---------------------------------------------------------------------------------------------------------------------- @@ -446,8 +510,8 @@ function CalculateScanline(Bits: Pointer; Width, Height, Row: Integer): Pointer; //---------------------------------------------------------------------------------------------------------------------- - -function GetBitmapBitsFromDeviceContext(DC: HDC; var Width, Height: Integer): Pointer; +{$IFDEF VT_VCL} +function GetBitmapBitsFromDeviceContext({$IFDEF VT_FMX}ACanvas: TCanvas{$ELSE}DC: HDC{$ENDIF}; var Width, Height: Integer): Pointer; // Helper function used to retrieve the bitmap selected into the given device context. If there is a bitmap then // the function will return a pointer to its bits otherwise nil is returned. @@ -1363,5 +1427,6 @@ procedure ScaleImageList(const ImgList: TImageList; M, D: Integer); TmpImgList.Free; end; end; +{$ENDIF} end. diff --git a/Source/VirtualTrees.WorkerThread.pas b/Source/VirtualTrees.WorkerThread.pas index c6d5e00ee..16fd7680a 100644 --- a/Source/VirtualTrees.WorkerThread.pas +++ b/Source/VirtualTrees.WorkerThread.pas @@ -1,6 +1,10 @@ unit VirtualTrees.WorkerThread; interface +//{$DEFINE VT_FMX} +{$IFNDEF VT_FMX} + {$DEFINE VT_VCL} +{$ENDIF} uses System.Classes, diff --git a/Source/VirtualTrees.pas b/Source/VirtualTrees.pas index 91710a93a..f955a8e5f 100644 --- a/Source/VirtualTrees.pas +++ b/Source/VirtualTrees.pas @@ -48,6 +48,11 @@ //---------------------------------------------------------------------------------------------------------------------- interface +//{$DEFINE VT_FMX} +{$IFNDEF VT_FMX} + {$DEFINE VT_VCL} +{$ENDIF} + {$if CompilerVersion < 24}{$MESSAGE FATAL 'This version supports only RAD Studio XE3 and higher. Please use V5 from http://www.jam-software.com/virtual-treeview/VirtualTreeViewV5.5.3.zip or https://github.com/Virtual-TreeView/Virtual-TreeView/archive/V5_stable.zip'}{$ifend} @@ -61,6 +66,7 @@ interface {$LEGACYIFEND ON} {$WARN UNSUPPORTED_CONSTRUCT OFF} +{$IFDEF VT_VCL} {$HPPEMIT '#include '} {$HPPEMIT '#include '} {$HPPEMIT '#include '} @@ -70,17 +76,46 @@ interface {$HPPEMIT '#pragma comment(lib, "VirtualTreesR")'} {$endif} {$HPPEMIT '#pragma comment(lib, "Shell32")'} +{$ENDIF} uses +{$IFDEF VT_FMX} + System.SysUtils, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.ImgList, System.ImageList, FMX.StdCtrls, System.Classes, + FMX.Menus, System.Types, System.UITypes, System.Generics.Collections, System.Threading, + System.Variants, FMX.Types, FMX.Dialogs, FMX.Controls.Presentation, FMX.Objects, FMX.Printer, FMX.Edit, FMX.Platform, + System.Devices; +{$ELSE} Winapi.Windows, Winapi.oleacc, Winapi.Messages, System.SysUtils, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.ImgList, Winapi.ActiveX, Vcl.StdCtrls, System.Classes, Vcl.Menus, Vcl.Printers, System.Types, Winapi.CommCtrl, Vcl.Themes, Winapi.UxTheme, Winapi.ShlObj, System.UITypes, System.Generics.Collections; - +{$ENDIF} const VTVersion = '7.0.0'; const +{$IFDEF VT_FMX} + //i resign from overriding types as this caused many problems and i start from scratch once again + //this can be done in the next steep if really needed because step back will be not so simple + //TColor = TAlphaColor; + //TRect = TRectF; + //TPoint = TPointF; + clBtnFace = TAlphaColorRec.Gray; + clBtnText = TAlphaColorRec.Black; + clBtnHighlight = TAlphaColorRec.DkGray; + clBtnShadow = TAlphaColorRec.Darkgray; + clHighlight = TAlphaColorRec.Lightblue; + clWindow = TAlphaColorRec.White; + clWindowText = TAlphaColorRec.Black; + clHighlightText = TAlphaColorRec.White; + clWhite = TAlphaColorRec.White; + clSilver = TAlphaColorRec.Silver; + clGray = TAlphaColorRec.Gray; + clBlack = TAlphaColorRec.Black; + clGreen = TAlphaColorRec.Green; + clBlue = TAlphaColorRec.Blue; + clGrayText = TAlphaColorRec.DkGray; +{$ENDIF} VTTreeStreamVersion = 3; VTHeaderStreamVersion = 6; // The header needs an own stream version to indicate changes only relevant to the header. @@ -138,15 +173,16 @@ interface ThemeChangedTimerDelay = 500; // Need to use this message to release the edit link interface asynchronously. + {$IFDEF VT_VCL} WM_CHANGESTATE = WM_APP + 32; - + // Virtual Treeview does not need to be subclassed by an eventual Theme Manager instance as it handles // Windows XP theme painting itself. Hence the special message is used to prevent subclassing. CM_DENYSUBCLASSING = CM_BASE + 2000; // Decoupling message for auto-adjusting the internal edit window. CM_AUTOADJUST = CM_BASE + 2005; - + {$ENDIF} // VT's own clipboard formats, @@ -196,6 +232,186 @@ interface {$MinEnumSize 1, make enumerations as small as possible} +{$IFDEF VT_FMX} +type + TRect = System.Types.TRectF; + PRect = System.Types.PRectF; + TPoint = System.Types.TPointF; + PPoint = System.Types.PPointF; + PSize = System.Types.PSizeF; + TSize = System.Types.TSizeF; + TColor = System.UITypes.TAlphaColor; + + TBorderWidth = Single; + TBevelCut = (bvNone, bvLowered, bvRaised, bvSpace); + TBevelEdge = (beLeft, beTop, beRight, beBottom); + TBevelEdges = set of TBevelEdge; + TBevelKind = (bkNone, bkTile, bkSoft, bkFlat); + TBevelWidth = 1..MaxInt; + + TFormBorderStyle = (bsNone, bsSingle, bsSizeable, bsDialog, bsToolWindow, bsSizeToolWin); + TBorderStyle = bsNone..bsSingle; + + TTextMetric = record + tmHeight: Single; //The height (ascent + descent) of characters. + tmAscent: Single; //The ascent (units above the base line) of characters. + tmDescent: Single; //The descent (units below the base line) of characters. + tmInternalLeading: Single; //The amount of leading (space) inside the bounds set by the tmHeight member. Accent marks and other diacritical characters may occur in this area. The designer may set this member to zero + tmExternalLeading: Single; //The amount of extra leading (space) that the application adds between rows. Since this area is outside the font, it contains no marks and is not altered by text output calls in either OPAQUE or TRANSPARENT mode. The designer may set this member to zero. + tmAveCharWidth: Single; //The average width of characters in the font (generally defined as the width of the letter x ). This value does not include the overhang required for bold or italic characters. + tmMaxCharWidth: Single; //The width of the widest character in the font. + tmWeight: Single; //The weight of the font. + tmOverhang: Single; + tmDigitizedAspectX: Single; //The horizontal aspect of the device for which the font was designed. + tmDigitizedAspectY: Single; //The vertical aspect of the device for which the font was designed. The ratio of the tmDigitizedAspectX and tmDigitizedAspectY members is the aspect ratio of the device for which the font was designed. + tmFirstChar: WideChar; //The value of the first character defined in the font. + tmLastChar: WideChar; //The value of the last character defined in the font. + tmDefaultChar: WideChar; //The value of the character to be substituted for characters not in the font. + tmBreakChar: WideChar; //The value of the character that will be used to define word breaks for text justification. + tmItalic: Byte; //Specifies an italic font if it is nonzero. + tmUnderlined: Byte; //Specifies an underlined font if it is nonzero. + tmStruckOut: Byte; //A strikeout font if it is nonzero. + tmPitchAndFamily: Byte; //Specifies information about the pitch, the technology, and the family of a physical font. TMPF_FIXED_PITCH, TMPF_VECTOR, TMPF_TRUETYPE, TMPF_DEVICE + tmCharSet: Byte; //The character set of the font. The character set can be one of the following values. ANSI_CHARSET, GREEK_CHARSET.... + end; + procedure GetTextMetrics(ACanvas: TCanvas; var TM: TTextMetric); + function Rect(ALeft, ATop, ARight, ABottom: Single): TRect; overload; inline; + function Rect(const ATopLeft, ABottomRight: TPoint): TRect; overload; inline; + function Point(AX, AY: Single): TPoint; overload; inline; + + procedure Inc(Var V: Single; OIle: Single=1.0); overload; + procedure Dec(Var V: Single; OIle: Single=1.0); overload; + function MulDiv(const A, B, C: Single): Single; overload; + procedure FillMemory(Destination: Pointer; Length: NativeUInt; Fill: Byte); + procedure ZeroMemory(Destination: Pointer; Length: NativeUInt); + procedure MoveMemory(Destination: Pointer; Source: Pointer; Length: NativeUInt); + procedure CopyMemory(Destination: Pointer; Source: Pointer; Length: NativeUInt); + + +const + { 3D border styles } + {$EXTERNALSYM BDR_RAISEDOUTER} + BDR_RAISEDOUTER = 1; + {$EXTERNALSYM BDR_SUNKENOUTER} + BDR_SUNKENOUTER = 2; + {$EXTERNALSYM BDR_RAISEDINNER} + BDR_RAISEDINNER = 4; + {$EXTERNALSYM BDR_SUNKENINNER} + BDR_SUNKENINNER = 8; + + {$EXTERNALSYM BDR_OUTER} + BDR_OUTER = 3; + {$EXTERNALSYM BDR_INNER} + BDR_INNER = 12; + {$EXTERNALSYM BDR_RAISED} + BDR_RAISED = 5; + {$EXTERNALSYM BDR_SUNKEN} + BDR_SUNKEN = 10; + + {$EXTERNALSYM EDGE_RAISED} + EDGE_RAISED = (BDR_RAISEDOUTER or BDR_RAISEDINNER); + {$EXTERNALSYM EDGE_SUNKEN} + EDGE_SUNKEN = (BDR_SUNKENOUTER or BDR_SUNKENINNER); + {$EXTERNALSYM EDGE_ETCHED} + EDGE_ETCHED = (BDR_SUNKENOUTER or BDR_RAISEDINNER); + {$EXTERNALSYM EDGE_BUMP} + EDGE_BUMP = (BDR_RAISEDOUTER or BDR_SUNKENINNER); + + {$EXTERNALSYM ETO_OPAQUE} + ETO_OPAQUE = 2; + {$EXTERNALSYM ETO_CLIPPED} + ETO_CLIPPED = 4; + {$EXTERNALSYM ETO_RTLREADING} + ETO_RTLREADING = $80; + + RTLFlag: array[Boolean] of Integer = (0, ETO_RTLREADING); + + { Border flags } + {$EXTERNALSYM BF_LEFT} + BF_LEFT = 1; + {$EXTERNALSYM BF_TOP} + BF_TOP = 2; + {$EXTERNALSYM BF_RIGHT} + BF_RIGHT = 4; + {$EXTERNALSYM BF_BOTTOM} + BF_BOTTOM = 8; + + {$EXTERNALSYM BF_TOPLEFT} + BF_TOPLEFT = (BF_TOP or BF_LEFT); + {$EXTERNALSYM BF_TOPRIGHT} + BF_TOPRIGHT = (BF_TOP or BF_RIGHT); + {$EXTERNALSYM BF_BOTTOMLEFT} + BF_BOTTOMLEFT = (BF_BOTTOM or BF_LEFT); + {$EXTERNALSYM BF_BOTTOMRIGHT} + BF_BOTTOMRIGHT = (BF_BOTTOM or BF_RIGHT); + {$EXTERNALSYM BF_RECT} + BF_RECT = (BF_LEFT or BF_TOP or BF_RIGHT or BF_BOTTOM); + + {$EXTERNALSYM BF_MIDDLE} + BF_MIDDLE = $800; { Fill in the middle } + {$EXTERNALSYM BF_SOFT} + BF_SOFT = $1000; { For softer buttons } + {$EXTERNALSYM BF_ADJUST} + BF_ADJUST = $2000; { Calculate the space left over } + {$EXTERNALSYM BF_FLAT} + BF_FLAT = $4000; { For flat rather than 3D borders } + {$EXTERNALSYM BF_MONO} + BF_MONO = $8000; { For monochrome borders } + + { DrawText() Format Flags } + DT_TOP = 0; + {$EXTERNALSYM DT_TOP} + DT_LEFT = 0; + {$EXTERNALSYM DT_LEFT} + DT_CENTER = 1; + {$EXTERNALSYM DT_CENTER} + DT_RIGHT = 2; + {$EXTERNALSYM DT_RIGHT} + DT_VCENTER = 4; + {$EXTERNALSYM DT_VCENTER} + DT_BOTTOM = 8; + {$EXTERNALSYM DT_BOTTOM} + DT_WORDBREAK = $10; + {$EXTERNALSYM DT_WORDBREAK} + DT_SINGLELINE = $20; + {$EXTERNALSYM DT_SINGLELINE} + DT_EXPANDTABS = $40; + {$EXTERNALSYM DT_EXPANDTABS} + DT_TABSTOP = $80; + {$EXTERNALSYM DT_TABSTOP} + DT_NOCLIP = $100; + {$EXTERNALSYM DT_NOCLIP} + DT_EXTERNALLEADING = $200; + {$EXTERNALSYM DT_EXTERNALLEADING} + DT_CALCRECT = $400; + {$EXTERNALSYM DT_CALCRECT} + DT_NOPREFIX = $800; + {$EXTERNALSYM DT_NOPREFIX} + DT_INTERNAL = $1000; + {$EXTERNALSYM DT_INTERNAL} + + + DT_EDITCONTROL = $2000; + {$EXTERNALSYM DT_EDITCONTROL} + DT_PATH_ELLIPSIS = $4000; + {$EXTERNALSYM DT_PATH_ELLIPSIS} + DT_END_ELLIPSIS = $8000; + {$EXTERNALSYM DT_END_ELLIPSIS} + DT_MODIFYSTRING = $10000; + {$EXTERNALSYM DT_MODIFYSTRING} + DT_RTLREADING = $20000; + {$EXTERNALSYM DT_RTLREADING} + DT_WORD_ELLIPSIS = $40000; + {$EXTERNALSYM DT_WORD_ELLIPSIS} + DT_NOFULLWIDTHCHARBREAK = $0080000; + {$EXTERNALSYM DT_NOFULLWIDTHCHARBREAK} + DT_HIDEPREFIX = $00100000; + {$EXTERNALSYM DT_HIDEPREFIX} + DT_PREFIXONLY = $00200000; + {$EXTERNALSYM DT_PREFIXONLY} + +{$ENDIF} + type // Alias defintions for convenience TImageIndex = System.UITypes.TImageIndex; @@ -395,7 +611,7 @@ TCheckStateHelper = record helper for TCheckState -- hmToolTip shows a hint only when node text is not fully shown. It's meant to fully show node text when not visible. It will show multi-line hint only if the node itself is multi-line. If you provide a custom multi-line hint then - you msut force linebreak style to hlbForceMultiLine in the OnGetHint event + you must force linebreak style to hlbForceMultiLine in the OnGetHint event in order to show the complete hint. } TVTHintMode = ( @@ -462,7 +678,7 @@ TCheckStateHelper = record helper for TCheckState The animation does not look good as the image splits and moves with it. } TVTAnimationOption = ( - toAnimatedToggle, // Expanding and collapsing a node is animated (quick window scroll). + toAnimatedToggle, // Expanding and collapsing a node is animated (quick window scroll). // **See note above. toAdvancedAnimatedToggle // Do some advanced animation effects when toggling a node. ); @@ -521,7 +737,9 @@ TCheckStateHelper = record helper for TCheckState // Options which do not fit into any of the other groups: TVTMiscOption = ( +{$IFDEF VT_VCL} toAcceptOLEDrop, // Register tree as OLE accepting drop target +{$ENDIF} toCheckSupport, // Show checkboxes/radio buttons. toEditable, // Node captions can be edited. toFullRepaintOnResize, // Fully invalidate the tree when its window is resized (CS_HREDRAW/CS_VREDRAW). @@ -578,7 +796,7 @@ TCheckStateHelper = record helper for TCheckState ); /// An array that can be used to calculate the offsets ofthe elements in the tree. - TVTOffsets = array [TVTElement] of integer; + TVTOffsets = array [TVTElement] of {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; TAddPopupItemType = ( apNormal, @@ -591,7 +809,7 @@ TCheckStateHelper = record helper for TCheckState DefaultAnimationOptions = []; DefaultAutoOptions = [toAutoDropExpand, toAutoTristateTracking, toAutoScrollOnExpand, toAutoDeleteMovedNodes, toAutoChangeScale, toAutoSort]; DefaultSelectionOptions = []; - DefaultMiscOptions = [toAcceptOLEDrop, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning, + DefaultMiscOptions = [{$IFDEF VT_VCL}toAcceptOLEDrop, {$ENDIF}toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning, toEditOnClick]; DefaultColumnOptions = [coAllowClick, coDraggable, coEnabled, coParentColor, coParentBidiMode, coResizable, coShowDropmark, coVisible, coAllowFocus, coEditable, coStyleColor]; @@ -609,7 +827,7 @@ TVirtualTreeClass = class of TBaseVirtualTree; // to compile (conversion done by BCB is wrong). TCacheEntry = record Node: PVirtualNode; - AbsoluteTop: Cardinal; + AbsoluteTop: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; end; TCache = array of TCacheEntry; @@ -667,14 +885,14 @@ TVTReference = record TVirtualNode = packed record Index, // index of node with regard to its parent ChildCount: Cardinal; // number of child nodes - NodeHeight: Word; // height in pixels + NodeHeight: {$IFDEF VT_FMX}Single{$ELSE}Word{$ENDIF}; // height in pixels States: TVirtualNodeStates; // states describing various properties of the node (expanded, initialized etc.) Align: Byte; // line/button alignment CheckState: TCheckState; // indicates the current check state (e.g. checked, pressed etc.) CheckType: TCheckType; // indicates which check type shall be used for this node Dummy: Byte; // dummy value to fill DWORD boundary - TotalCount, // sum of this node, all of its child nodes and their child nodes etc. - TotalHeight: Cardinal; // height in pixels this node covers on screen including the height of all of its + TotalCount: Cardinal; // sum of this node, all of its child nodes and their child nodes etc. + TotalHeight: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; // height in pixels this node covers on screen including the height of all of its // children // Note: Some copy routines require that all pointers (as well as the data area) in a node are // located at the end of the node! Hence if you want to add new member fields (except pointers to internal @@ -699,7 +917,7 @@ TVTReference = record // Structure used when info about a certain position in the header is needed. TVTHeaderHitInfo = record X, - Y: Integer; + Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; Button: TMouseButton; Shift: TShiftState; Column: TColumnIndex; @@ -722,10 +940,12 @@ THitInfo = record sdDown ); +{$IFDEF VT_VCL} // OLE drag'n drop support TFormatEtcArray = array of TFormatEtc; +{$ENDIF} TFormatArray = array of Word; - +{$IFDEF VT_VCL} // IDataObject.SetData support TInternalStgMedium = packed record Format: TClipFormat; @@ -830,6 +1050,7 @@ TVTDragManager = class(TInterfacedObject, IVTDragManager, IDropSource, IDropTa function GiveFeedback(Effect: Integer): HResult; stdcall; function QueryContinueDrag(EscapePressed: BOOL; KeyState: Integer): HResult; stdcall; end; +{$ENDIF} PVTHintData = ^TVTHintData; TVTHintData = record @@ -844,6 +1065,7 @@ TVTHintData = record end; // The trees need an own hint window class because of Unicode output and adjusted font. +{$IFDEF VT_VCL} TVirtualTreeHintWindow = class(THintWindow) strict private FHintData: TVTHintData; @@ -856,7 +1078,7 @@ TVirtualTreeHintWindow = class(THintWindow) function CalcHintRect(MaxWidth: Integer; const AHint: string; AData: Pointer): TRect; override; function IsHintMsg(var Msg: TMsg): Boolean; override; end; - +{$ENDIF} // Drag image support for the tree. TVTTransparency = 0..255; TVTBias = -128..127; @@ -876,6 +1098,7 @@ TVirtualTreeHintWindow = class(THintWindow) ); // Class to manage header and tree drag image during a drag'n drop operation. +{$IFDEF VT_VCL} TVTDragImage = class private FOwner: TBaseVirtualTree; @@ -917,7 +1140,7 @@ TVTDragImage = class property Transparency: TVTTransparency read FTransparency write FTransparency default 128; property Visible: Boolean read GetVisible; end; - +{$ENDIF} // tree columns implementation TVirtualTreeColumns = class; TVTHeader = class; @@ -951,23 +1174,23 @@ TVirtualTreeColumn = class(TCollectionItem) private FText, FHint: string; - FWidth: Integer; + FWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; FPosition: TColumnPosition; - FMinWidth: Integer; - FMaxWidth: Integer; + FMinWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + FMaxWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; FStyle: TVirtualTreeColumnStyle; FImageIndex: TImageIndex; FBiDiMode: TBiDiMode; FLayout: TVTHeaderColumnLayout; FMargin, - FSpacing: Integer; + FSpacing: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; FOptions: TVTColumnOptions; FEditOptions: TVTEditOptions; FEditNextColumn: Integer; FTag: NativeInt; FAlignment: TAlignment; FCaptionAlignment: TAlignment; // Alignment of the caption. - FLastWidth: Integer; + FLastWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; FColor: TColor; FBonusPixel: Boolean; FSpringRest: Single; // Accumulator for width adjustment when auto spring option is enabled. @@ -979,7 +1202,7 @@ TVirtualTreeColumn = class(TCollectionItem) FHasImage: Boolean; FDefaultSortDirection: TSortDirection; function GetCaptionAlignment: TAlignment; - function GetLeft: Integer; + function GetLeft: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; function IsBiDiModeStored: Boolean; function IsCaptionAlignmentStored: Boolean; function IsColorStored: Boolean; @@ -992,21 +1215,21 @@ TVirtualTreeColumn = class(TCollectionItem) procedure SetColor(const Value: TColor); procedure SetImageIndex(Value: TImageIndex); procedure SetLayout(Value: TVTHeaderColumnLayout); - procedure SetMargin(Value: Integer); - procedure SetMaxWidth(Value: Integer); - procedure SetMinWidth(Value: Integer); + procedure SetMargin(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); + procedure SetMaxWidth(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); + procedure SetMinWidth(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); procedure SetOptions(Value: TVTColumnOptions); procedure SetPosition(Value: TColumnPosition); - procedure SetSpacing(Value: Integer); + procedure SetSpacing(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); procedure SetStyle(Value: TVirtualTreeColumnStyle); - procedure SetWidth(Value: Integer); + procedure SetWidth(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); protected - FLeft: Integer; - procedure ComputeHeaderLayout(DC: HDC; Client: TRect; UseHeaderGlyph, UseSortGlyph: Boolean; + FLeft: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + procedure ComputeHeaderLayout({$IFDEF VT_FMX}ACanvas: TCanvas{$ELSE}DC: HDC{$ENDIF}; Client: TRect; UseHeaderGlyph, UseSortGlyph: Boolean; var HeaderGlyphPos, SortGlyphPos: TPoint; var SortGlyphSize: TSize; var TextBounds: TRect; DrawFormat: Cardinal; CalculateTextRect: Boolean = False); procedure DefineProperties(Filer: TFiler); override; - procedure GetAbsoluteBounds(var Left, Right: Integer); + procedure GetAbsoluteBounds(var Left, Right: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); function GetDisplayName: string; override; function GetText: string; virtual; // [IPK] procedure SetText(const Value: string); virtual; // [IPK] private to protected & virtual @@ -1031,7 +1254,7 @@ TVirtualTreeColumn = class(TCollectionItem) function UseRightToLeftReading: Boolean; property CaptionText: string read FCaptionText; - property Left: Integer read GetLeft; + property Left: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} read GetLeft; property Owner: TVirtualTreeColumns read GetOwner; published property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify; @@ -1046,18 +1269,18 @@ TVirtualTreeColumn = class(TCollectionItem) property Hint: string read FHint write FHint; property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1; property Layout: TVTHeaderColumnLayout read FLayout write SetLayout default blGlyphLeft; - property Margin: Integer read FMargin write SetMargin default 4; - property MaxWidth: Integer read FMaxWidth write SetMaxWidth default 10000; - property MinWidth: Integer read FMinWidth write SetMinWidth default 10; + property Margin: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} read FMargin write SetMargin{$IFDEF VT_VCL} default 4{$ENDIF}; + property MaxWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} read FMaxWidth write SetMaxWidth{$IFDEF VT_VCL} default 10000{$ENDIF}; + property MinWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} read FMinWidth write SetMinWidth{$IFDEF VT_VCL} default 10{$ENDIF}; property Options: TVTColumnOptions read FOptions write SetOptions default DefaultColumnOptions; property EditOptions: TVTEditOptions read FEditOptions write FEditOptions default toDefaultEdit; property EditNextColumn: Integer read FEditNextColumn write FEditNextColumn default -1; property Position: TColumnPosition read FPosition write SetPosition; - property Spacing: Integer read FSpacing write SetSpacing default 3; + property Spacing: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} read FSpacing write SetSpacing{$IFDEF VT_VCL} default 3{$ENDIF}; property Style: TVirtualTreeColumnStyle read FStyle write SetStyle default vsText; property Tag: NativeInt read FTag write FTag default 0; property Text: string read GetText write SetText; - property Width: Integer read FWidth write SetWidth default 50; + property Width: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} read FWidth write SetWidth{$IFDEF VT_VCL} default 50{$ENDIF}; end; TVirtualTreeColumnClass = class of TVirtualTreeColumn; @@ -1099,12 +1322,12 @@ TVirtualTreeColumns = class(TCollection) procedure AdjustPosition(Column: TVirtualTreeColumn; Position: Cardinal); function CanSplitterResize(P: TPoint; Column: TColumnIndex): Boolean; procedure DoCanSplitterResize(P: TPoint; Column: TColumnIndex; var Allowed: Boolean); virtual; - procedure DrawButtonText(DC: HDC; Caption: string; Bounds: TRect; Enabled, Hot: Boolean; DrawFormat: Cardinal; + procedure DrawButtonText({$IFDEF VT_FMX}ACanvas: TCanvas{$ELSE}DC: HDC{$ENDIF}; Caption: string; Bounds: TRect; Enabled, Hot: Boolean; DrawFormat: Cardinal; WrapCaption: Boolean); procedure FixPositions; - function GetColumnAndBounds(P: TPoint; var ColumnLeft, ColumnRight: Integer; Relative: Boolean = True): Integer; + function GetColumnAndBounds(P: TPoint; var ColumnLeft, ColumnRight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; Relative: Boolean = True): Integer; function GetOwner: TPersistent; override; - function HandleClick(P: TPoint; Button: TMouseButton; Force, DblClick: Boolean): Boolean; virtual; + function HandleClick(P: TPoint; Button: TMouseButton;{$IFDEF VT_FMX}Shift: TShiftState;{$ENDIF} Force, DblClick: Boolean): Boolean; virtual; procedure HeaderPopupMenuAddHeaderPopupItem(const Sender: TBaseVirtualTree; const Column: TColumnIndex; var Cmd: TAddPopupItemType); procedure HeaderPopupMenuColumnChange(const Sender: TBaseVirtualTree; const Column: TColumnIndex; Visible: Boolean); @@ -1125,13 +1348,13 @@ TVirtualTreeColumns = class(TCollection) destructor Destroy; override; function Add: TVirtualTreeColumn; virtual; - procedure AnimatedResize(Column: TColumnIndex; NewWidth: Integer); + procedure AnimatedResize(Column: TColumnIndex; NewWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); procedure Assign(Source: TPersistent); override; procedure Clear; virtual; function ColumnFromPosition(P: TPoint; Relative: Boolean = True): TColumnIndex; overload; virtual; function ColumnFromPosition(PositionIndex: TColumnPosition): TColumnIndex; overload; virtual; function Equals(OtherColumnsObj: TObject): Boolean; override; - procedure GetColumnBounds(Column: TColumnIndex; var Left, Right: Integer); + procedure GetColumnBounds(Column: TColumnIndex; var Left, Right: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); function GetFirstVisibleColumn(ConsiderAllowFocus: Boolean = False): TColumnIndex; function GetLastVisibleColumn(ConsiderAllowFocus: Boolean = False): TColumnIndex; function GetFirstColumn: TColumnIndex; @@ -1139,17 +1362,16 @@ TVirtualTreeColumns = class(TCollection) function GetNextVisibleColumn(Column: TColumnIndex; ConsiderAllowFocus: Boolean = False): TColumnIndex; function GetPreviousColumn(Column: TColumnIndex): TColumnIndex; function GetPreviousVisibleColumn(Column: TColumnIndex; ConsiderAllowFocus: Boolean = False): TColumnIndex; - function GetScrollWidth: Integer; + function GetScrollWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; function GetVisibleColumns: TColumnsArray; - function GetVisibleFixedWidth: Integer; + function GetVisibleFixedWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; function IsValidColumn(Column: TColumnIndex): Boolean; procedure LoadFromStream(const Stream: TStream; Version: Integer); - procedure PaintHeader(DC: HDC; R: TRect; HOffset: Integer); overload; virtual; - procedure PaintHeader(TargetCanvas: TCanvas; R: TRect; const Target: TPoint; - RTLOffset: Integer = 0); overload; virtual; + procedure PaintHeader({$IFDEF VT_FMX}ACanvas: TCanvas{$ELSE}DC: HDC{$ENDIF}; R: TRect; HOffset: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); overload; virtual; + procedure PaintHeader(TargetCanvas: TCanvas; R: TRect; const Target: TPoint; RTLOffset: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} = 0); overload; virtual; procedure SaveToStream(const Stream: TStream); procedure EndUpdate(); override; - function TotalWidth: Integer; + function TotalWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; property Count: Integer read GetCount; property ClickIndex: TColumnIndex read FClickIndex; @@ -1248,12 +1470,22 @@ TVTFixedAreaConstraints = class(TPersistent) crNodeCopied, // a node has been duplicated crNodeMoved // a node has been moved to a new place ); // desribes what made a structure change event happen +{$IFDEF VT_FMX} + TChangeLink = class(TImageLink) + private + function GetSender: TCustomImageList; inline; + procedure SetSender(const Value: TCustomImageList); inline; + public + constructor Create; override; + property Sender: TCustomImageList read GetSender write SetSender; + end; +{$ENDIF} TVTHeader = class(TPersistent) private FOwner: TBaseVirtualTree; FColumns: TVirtualTreeColumns; - FHeight: Integer; + FHeight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; FFont: TFont; FParentFont: Boolean; FOptions: TVTHeaderOptions; @@ -1262,17 +1494,19 @@ TVTHeader = class(TPersistent) FAutoSizeIndex: TColumnIndex; FPopupMenu: TPopupMenu; FMainColumn: TColumnIndex; // the column which holds the tree - FMaxHeight: Integer; - FMinHeight: Integer; - FDefaultHeight: Integer; + FMaxHeight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + FMinHeight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + FDefaultHeight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; FFixedAreaConstraints: TVTFixedAreaConstraints; // Percentages for the fixed area (header, fixed columns). FImages: TCustomImageList; FImageChangeLink: TChangeLink; // connections to the image list to get notified about changes fSplitterHitTolerance: Integer; // For property SplitterHitTolerance FSortColumn: TColumnIndex; FSortDirection: TSortDirection; + {$IFDEF VT_VCL} FDragImage: TVTDragImage; // drag image management during header drag - FLastWidth: Integer; // Used to adjust spring columns. This is the width of all visible columns, + {$ENDIF} + FLastWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; // Used to adjust spring columns. This is the width of all visible columns, // not the header rectangle. procedure FontChanged(Sender: TObject); function GetMainColumn: TColumnIndex; @@ -1281,13 +1515,13 @@ TVTHeader = class(TPersistent) procedure SetAutoSizeIndex(Value: TColumnIndex); procedure SetBackground(Value: TColor); procedure SetColumns(Value: TVirtualTreeColumns); - procedure SetDefaultHeight(Value: Integer); + procedure SetDefaultHeight(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); procedure SetFont(const Value: TFont); - procedure SetHeight(Value: Integer); + procedure SetHeight(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); procedure SetImages(const Value: TCustomImageList); procedure SetMainColumn(Value: TColumnIndex); - procedure SetMaxHeight(Value: Integer); - procedure SetMinHeight(Value: Integer); + procedure SetMaxHeight(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); + procedure SetMinHeight(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); procedure SetOptions(Value: TVTHeaderOptions); procedure SetParentFont(Value: Boolean); procedure SetSortColumn(Value: TColumnIndex); @@ -1302,7 +1536,7 @@ TVTHeader = class(TPersistent) function CanSplitterResize(P: TPoint): Boolean; function CanWriteColumns: Boolean; virtual; - procedure ChangeScale(M, D: Integer); virtual; + procedure ChangeScale(M, D: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); virtual; function DetermineSplitterIndex(P: TPoint): Boolean; virtual; procedure DoAfterAutoFitColumn(Column: TColumnIndex); virtual; procedure DoAfterColumnWidthTracking(Column: TColumnIndex); virtual; @@ -1321,9 +1555,11 @@ TVTHeader = class(TPersistent) procedure FixedAreaConstraintsChanged(Sender: TObject); function GetColumnsClass: TVirtualTreeColumnsClass; virtual; function GetOwner: TPersistent; override; +{$IFDEF VT_VCL} function GetShiftState: TShiftState; function HandleHeaderMouseMove(var Message: TWMMouseMove): Boolean; function HandleMessage(var Message: TMessage): Boolean; virtual; +{$ENDIF} procedure ImageListChange(Sender: TObject); procedure PrepareDrag(P, Start: TPoint); procedure ReadColumns(Reader: TReader); @@ -1333,7 +1569,7 @@ TVTHeader = class(TPersistent) procedure UpdateSpringColumns; procedure WriteColumns(Writer: TWriter); public - constructor Create(AOwner: TBaseVirtualTree); virtual; + constructor Create(AOwner: TBaseVirtualTree); virtual; //header destructor Destroy; override; function AllowFocus(ColumnIndex: TColumnIndex): Boolean; @@ -1344,12 +1580,13 @@ TVTHeader = class(TPersistent) function InHeaderSplitterArea(P: TPoint): Boolean; virtual; procedure Invalidate(Column: TVirtualTreeColumn; ExpandToBorder: Boolean = False; UpdateNowFlag : Boolean = False); procedure LoadFromStream(const Stream: TStream); virtual; - function ResizeColumns(ChangeBy: Integer; RangeStartCol: TColumnIndex; RangeEndCol: TColumnIndex; - Options: TVTColumnOptions = [coVisible]): Integer; + function ResizeColumns(ChangeBy: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; RangeStartCol: TColumnIndex; RangeEndCol: TColumnIndex; + Options: TVTColumnOptions = [coVisible]): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; procedure RestoreColumns; procedure SaveToStream(const Stream: TStream); virtual; - +{$IFDEF VT_VCL} property DragImage: TVTDragImage read FDragImage; +{$ENDIF} property States: THeaderStates read FStates; property Treeview: TBaseVirtualTree read FOwner; property UseColumns: Boolean read GetUseColumns; @@ -1358,14 +1595,14 @@ TVTHeader = class(TPersistent) property AutoSizeIndex: TColumnIndex read FAutoSizeIndex write SetAutoSizeIndex; property Background: TColor read FBackgroundColor write SetBackground default clBtnFace; property Columns: TVirtualTreeColumns read FColumns write SetColumns stored False; // Stored by the owner tree to support VFI. - property DefaultHeight: Integer read FDefaultHeight write SetDefaultHeight default 19; + property DefaultHeight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} read FDefaultHeight write SetDefaultHeight{$IFDEF VT_VCL} default 19{$ENDIF}; property Font: TFont read FFont write SetFont stored IsFontStored; property FixedAreaConstraints: TVTFixedAreaConstraints read FFixedAreaConstraints write FFixedAreaConstraints; - property Height: Integer read FHeight write SetHeight default 19; + property Height: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} read FHeight write SetHeight{$IFDEF VT_VCL} default 19{$ENDIF}; property Images: TCustomImageList read FImages write SetImages; property MainColumn: TColumnIndex read GetMainColumn write SetMainColumn default 0; - property MaxHeight: Integer read FMaxHeight write SetMaxHeight default 10000; - property MinHeight: Integer read FMinHeight write SetMinHeight default 10; + property MaxHeight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} read FMaxHeight write SetMaxHeight{$IFDEF VT_VCL} default 10000{$ENDIF}; + property MinHeight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} read FMinHeight write SetMinHeight{$IFDEF VT_VCL} default 10{$ENDIF}; property Options: TVTHeaderOptions read FOptions write SetOptions default [hoColumnResize, hoDrag, hoShowSortGlyphs]; property ParentFont: Boolean read FParentFont write SetParentFont default True; property PopupMenu: TPopupMenu read FPopupMenu write FPopupMenu; @@ -1387,7 +1624,9 @@ TVTHeaderClass = class of TVTHeader; function EndEdit: Boolean; stdcall; // Called when editing has been finished by the tree. Returns True if successful, False if edit mode is still active. function PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean; stdcall; // Called after creation to allow a setup. +{$IFDEF VT_VCL} procedure ProcessMessage(var Message: TMessage); stdcall; +{$ENDIF} // Used to forward messages to the edit window(s)- procedure SetBounds(R: TRect); stdcall; // Called to place the editor. end; @@ -1471,8 +1710,10 @@ THeaderPaintInfo = record tsMiddleButtonDown, // Set when the middle mouse button is down. tsMiddleDblClick, // Set when the middle mouse button was doubly clicked. tsNeedRootCountUpdate, // Set if while loading a root node count is set. +{$IFDEF VT_VCL} tsOLEDragging, // OLE dragging in progress. tsOLEDragPending, // User has requested to start delayed dragging. +{$ENDIF} tsPainting, // The tree is currently painting itself. tsRightButtonDown, // Set when the right mouse button is down. tsRightDblClick, // Set when the right mouse button was doubly clicked. @@ -1499,8 +1740,8 @@ THeaderPaintInfo = record tsVCLDragFinished, // Flag to avoid triggering the OnColumnClick event twice tsWheelPanning, // Wheel mouse panning is active or soon will be. tsWheelScrolling, // Wheel mouse scrolling is active or soon will be. - tsWindowCreating, // Set during window handle creation to avoid frequent unnecessary updates. - tsUseExplorerTheme // The tree runs under WinVista+ and is using the explorer theme + tsWindowCreating{$IFDEF VT_VCL}, // Set during window handle creation to avoid frequent unnecessary updates. + tsUseExplorerTheme{$ENDIF} // The tree runs under WinVista+ and is using the explorer theme ); TChangeStates = set of ( @@ -1607,7 +1848,7 @@ TScrollBarOptions = class(TPersistent) published property AlwaysVisible: Boolean read FAlwaysVisible write SetAlwaysVisible default False; property HorizontalIncrement: TVTScrollIncrement read FIncrementX write FIncrementX default 20; - property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars default ssBoth; + property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars default TScrollStyle.ssBoth; property ScrollBarStyle: TScrollBarStyle read FScrollBarStyle write SetScrollBarStyle default sbmRegular; property VerticalIncrement: TVTScrollIncrement read FIncrementY write FIncrementY default 20; end; @@ -1658,7 +1899,7 @@ TVTColors = class(TPersistent) TVTImageInfo = record Index: TImageIndex; // Index in the associated image list. XPos, // Horizontal position in the current target canvas. - YPos: Integer; // Vertical position in the current target canvas. + YPos: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; // Vertical position in the current target canvas. Ghosted: Boolean; // Flag to indicate that the image must be drawn slightly lighter. Images: TCustomImageList; // The image list to be used for painting. function Equals(const pImageInfo2: TVTImageInfo): Boolean; @@ -1701,14 +1942,14 @@ TVTPaintInfo = record Position: TColumnPosition; // the column position of the node CellRect: TRect; // the node cell ContentRect: TRect; // the area of the cell used for the node's content - NodeWidth: Integer; // the actual node width + NodeWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; // the actual node width Alignment: TAlignment; // how to align within the node rectangle CaptionAlignment: TAlignment; // how to align text within the caption rectangle BidiMode: TBidiMode; // directionality to be used for painting BrushOrigin: TPoint; // the alignment for the brush used to draw dotted lines ImageInfo: array[TVTImageInfoIndex] of TVTImageInfo; // info about each possible node image Offsets: TVTOffsets; - procedure AdjustImageCoordinates(VAlign: Integer); + procedure AdjustImageCoordinates(VAlign: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); end; // Method called by the Animate routine for each animation step. @@ -1815,8 +2056,8 @@ TClipboardFormats = class(TStringList) TVTHeaderAddPopupItemEvent = procedure(const Sender: TBaseVirtualTree; const Column: TColumnIndex; var Cmd: TAddPopupItemType) of object; TVTHeaderClickEvent = procedure(Sender: TVTHeader; HitInfo: TVTHeaderHitInfo) of object; - TVTHeaderMouseEvent = procedure(Sender: TVTHeader; Button: TMouseButton; Shift: TShiftState; X, Y: Integer) of object; - TVTHeaderMouseMoveEvent = procedure(Sender: TVTHeader; Shift: TShiftState; X, Y: Integer) of object; + TVTHeaderMouseEvent = procedure(Sender: TVTHeader; Button: TMouseButton; Shift: TShiftState; X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}) of object; + TVTHeaderMouseMoveEvent = procedure(Sender: TVTHeader; Shift: TShiftState; X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}) of object; TVTBeforeHeaderHeightTrackingEvent = procedure(Sender: TVTHeader; Shift: TShiftState) of object; TVTAfterHeaderHeightTrackingEvent = procedure(Sender: TVTHeader) of object; TVTHeaderHeightTrackingEvent = procedure(Sender: TVTHeader; var P: TPoint; Shift: TShiftState; var Allowed: Boolean) of object; @@ -1845,9 +2086,9 @@ TClipboardFormats = class(TStringList) TVTAfterColumnWidthTrackingEvent = procedure(Sender: TVTHeader; Column: TColumnIndex) of object; TVTColumnWidthTrackingEvent = procedure(Sender: TVTHeader; Column: TColumnIndex; Shift: TShiftState; var TrackPoint: TPoint; P: TPoint; var Allowed: Boolean) of object; - TVTGetHeaderCursorEvent = procedure(Sender: TVTHeader; var Cursor: HCURSOR) of object; + TVTGetHeaderCursorEvent = procedure(Sender: TVTHeader; var Cursor: {$IFDEF VT_FMX}TCursor{$ELSE}HCURSOR{$ENDIF}) of object; TVTBeforeGetMaxColumnWidthEvent = procedure(Sender: TVTHeader; Column: TColumnIndex; var UseSmartColumnWidth: Boolean) of object; - TVTAfterGetMaxColumnWidthEvent = procedure(Sender: TVTHeader; Column: TColumnIndex; var MaxWidth: Integer) of object; + TVTAfterGetMaxColumnWidthEvent = procedure(Sender: TVTHeader; Column: TColumnIndex; var MaxWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}) of object; TVTCanSplitterResizeColumnEvent = procedure(Sender: TVTHeader; P: TPoint; Column: TColumnIndex; var Allowed: Boolean) of object; TVTCanSplitterResizeHeaderEvent = procedure(Sender: TVTHeader; P: TPoint; var Allowed: Boolean) of object; @@ -1867,17 +2108,21 @@ TClipboardFormats = class(TStringList) Column: TColumnIndex; var Allowed: Boolean) of object; // drag'n drop/OLE events +{$IFDEF VT_VCL} TVTCreateDragManagerEvent = procedure(Sender: TBaseVirtualTree; out DragManager: IVTDragManager) of object; - TVTCreateDataObjectEvent = procedure(Sender: TBaseVirtualTree; out IDataObject: IDataObject) of object; +{$ENDIF} + TVTCreateDataObjectEvent = procedure(Sender: TBaseVirtualTree; out IDataObject: {$IFDEF VT_FMX}TDragObject{$ELSE}IDataObject{$ENDIF}) of object; TVTDragAllowedEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean) of object; TVTDragOverEvent = procedure(Sender: TBaseVirtualTree; Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode; var Effect: Integer; var Accept: Boolean) of object; - TVTDragDropEvent = procedure(Sender: TBaseVirtualTree; Source: TObject; DataObject: IDataObject; + TVTDragDropEvent = procedure(Sender: TBaseVirtualTree; Source: TObject; DataObject: {$IFDEF VT_FMX}TDragObject{$ELSE}IDataObject{$ENDIF}; Formats: TFormatArray; Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode) of object; +{$IFDEF VT_VCL} TVTRenderOLEDataEvent = procedure(Sender: TBaseVirtualTree; const FormatEtcIn: TFormatEtc; out Medium: TStgMedium; ForClipboard: Boolean; var Result: HRESULT) of object; TVTGetUserClipboardFormatsEvent = procedure(Sender: TBaseVirtualTree; var Formats: TFormatEtcArray) of object; +{$ENDIF} // paint events TVTBeforeItemEraseEvent = procedure(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; ItemRect: TRect; @@ -1897,7 +2142,7 @@ TClipboardFormats = class(TStringList) var Handled: Boolean) of object; TVTGetLineStyleEvent = procedure(Sender: TBaseVirtualTree; var Bits: Pointer) of object; TVTMeasureItemEvent = procedure(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; - var NodeHeight: Integer) of object; + var NodeHeight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}) of object; TVTPrepareButtonImagesEvent = procedure(Sender: TBaseVirtualTree; const APlusBM : TBitmap; const APlusHotBM :TBitmap; const APlusSelectedHotBM :TBitmap; const AMinusBM : TBitmap; const AMinusHotBM : TBitmap; @@ -1922,7 +2167,7 @@ TClipboardFormats = class(TStringList) TVTGetNodeDataSizeEvent = procedure(Sender: TBaseVirtualTree; var NodeDataSize: Integer) of object; TVTKeyActionEvent = procedure(Sender: TBaseVirtualTree; var CharCode: Word; var Shift: TShiftState; var DoDefault: Boolean) of object; - TVTScrollEvent = procedure(Sender: TBaseVirtualTree; DeltaX, DeltaY: Integer) of object; + TVTScrollEvent = procedure(Sender: TBaseVirtualTree; DeltaX, DeltaY: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}) of object; TVTUpdatingEvent = procedure(Sender: TBaseVirtualTree; State: TVTUpdateState) of object; TVTGetCursorEvent = procedure(Sender: TBaseVirtualTree; var Cursor: TCursor) of object; TVTStateChangeEvent = procedure(Sender: TBaseVirtualTree; Enter, Leave: TVirtualTreeStates) of object; @@ -1981,14 +2226,14 @@ TVTVirtualNodeEnumeration = record // ----- TBaseVirtualTree - TBaseVirtualTree = class(TCustomControl) + TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF}) private FTotalInternalDataSize: Cardinal; // Cache of the sum of the necessary internal data size for all tree FBorderStyle: TBorderStyle; FHeader: TVTHeader; FRoot: PVirtualNode; FDefaultNodeHeight, - FIndent: Cardinal; + FIndent: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; FOptions: TCustomVirtualTreeOptions; FUpdateCount: Cardinal; // update stopper, updates of the tree control are only done if = 0 FSynchUpdateCount: Cardinal; // synchronizer, causes all events which are usually done via timers @@ -2038,14 +2283,14 @@ TBaseVirtualTree = class(TCustomControl) FEditLink: IVTEditLink; // used to comunicate with an application defined editor FTempNodeCache: TNodeArray; // used at various places to hold temporarily a bunch of node refs. FTempNodeCount: Cardinal; // number of nodes in FTempNodeCache - FBackground: TPicture; // A background image loadable at design and runtime. + FBackground: {$IFDEF VT_FMX}TImage{$ELSE}TPicture{$ENDIF}; // A background image loadable at design and runtime. FBackgroundImageTransparent: Boolean; // By default, this is off. When switched on, will try to draw the image // transparent by using the color of the component as transparent color - FMargin: Integer; // horizontal distance to border and columns - FTextMargin: Integer; // space between the node's text and its horizontal bounds + FMargin: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; // horizontal distance to border and columns + FTextMargin: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; // space between the node's text and its horizontal bounds FBackgroundOffsetX, - FBackgroundOffsetY: Integer; // used to fine tune the position of the background image + FBackgroundOffsetY: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; // used to fine tune the position of the background image FAnimationDuration: Cardinal; // specifies how long an animation shall take (expanding, hint) FWantTabs: Boolean; // If True then the tree also consumes the tab key. FNodeAlignment: TVTNodeAlignment; // determines how to interpret the align member of a node @@ -2067,7 +2312,7 @@ TBaseVirtualTree = class(TCustomControl) FCheckImageKind: TCheckImageKind; // light or dark, cross marks or tick marks FCheckImages: TCustomImageList; // Reference to global image list to be used for the check images. //TODO: Use this margin for other images as well - FImagesMargin: Integer; // The margin used left and right of the checkboxes. + FImagesMargin: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; // The margin used left and right of the checkboxes. FImageChangeLink, FStateChangeLink, FCustomCheckChangeLink: TChangeLink; // connections to the image lists @@ -2077,7 +2322,7 @@ TBaseVirtualTree = class(TCustomControl) FButtonFillMode: TVTButtonFillMode; // for rectangular tree buttons only: how to fill them FLineStyle: TVTLineStyle; // style of the tree lines FLineMode: TVTLineMode; // tree lines or bands etc. - FDottedBrush: HBRUSH; // used to paint dotted lines without special pens + FDottedBrush: {$IFDEF VT_FMX}TBrush{$ELSE}HBRUSH{$ENDIF}; // used to paint dotted lines without special pens FSelectionCurveRadius: Cardinal; // radius for rounded selection rectangles FSelectionBlendFactor: Byte; // Determines the factor by which the selection rectangle is to be // faded if enabled. @@ -2090,13 +2335,17 @@ TBaseVirtualTree = class(TCustomControl) FDragImageKind: TVTDragImageKind; // determines whether or not and what to show in the drag image FDragOperations: TDragOperations; // determines which operations are allowed during drag'n drop FDragThreshold: Integer; // used to determine when to actually start a drag'n drop operation +{$IFDEF VT_VCL} FDragManager: IVTDragManager; // drag'n drop, cut'n paste +{$ENDIF} FDropTargetNode: PVirtualNode; // node currently selected as drop target FLastDropMode: TDropMode; // set while dragging and used to track changes FDragSelection: TNodeArray; // temporary copy of FSelection used during drag'n drop FLastDragEffect: Integer; // The last executed drag effect FDragType: TVTDragType; // used to switch between OLE and VCL drag'n drop +{$IFDEF VT_VCL} FDragImage: TVTDragImage; // drag image management +{$ENDIF} FDragWidth, FDragHeight: Integer; // size of the drag image, the larger the more CPU power is needed FClipboardFormats: TClipboardFormats; // a list of clipboard format descriptions enabled for this tree @@ -2109,12 +2358,12 @@ TBaseVirtualTree = class(TCustomControl) FAutoScrollDelay: Cardinal; // amount of milliseconds to wait until autoscrolling becomes active FAutoExpandDelay: Cardinal; // amount of milliseconds to wait until a node is expanded if it is the // drop target - FOffsetX: Integer; - FOffsetY: Integer; // Determines left and top scroll offset. - FEffectiveOffsetX: Integer; // Actual position of the horizontal scroll bar (varies depending on bidi mode). + FOffsetX: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + FOffsetY: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; // Determines left and top scroll offset. + FEffectiveOffsetX: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; // Actual position of the horizontal scroll bar (varies depending on bidi mode). FRangeX, - FRangeY: Cardinal; // current virtual width and height of the tree - FBottomSpace: Cardinal; // Extra space below the last node. + FRangeY: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; // current virtual width and height of the tree + FBottomSpace: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; // Extra space below the last node. FDefaultPasteMode: TVTNodeAttachMode; // Used to determine where to add pasted nodes to. FSingletonNodeArray: TNodeArray; // Contains only one element for quick addition of single nodes @@ -2130,20 +2379,22 @@ TBaseVirtualTree = class(TCustomControl) FSearchStart: TVTSearchStart; // Where to start iteration on each key press. // miscellanous +{$IFDEF VT_VCL} FPanningWindow: HWND; // Helper window for wheel panning - FPanningCursor: HCURSOR; // Current wheel panning cursor. +{$ENDIF} + FPanningCursor: {$IFDEF VT_FMX}TCursor{$ELSE}HCURSOR{$ENDIF}; // Current wheel panning cursor. FPanningImage: TBitmap; // A little 32x32 bitmap to indicate the panning reference point. FLastClickPos: TPoint; // Used for retained drag start and wheel mouse scrolling. FOperationCount: Cardinal; // Counts how many nested long-running operations are in progress. FOperationCanceled: Boolean; // Used to indicate that a long-running operation should be canceled. FChangingTheme: Boolean; // Used to indicate that a theme change is goi ng on FNextNodeToSelect: PVirtualNode; // Next tree node that we would like to select if the current one gets deleted or looses selection for other reasons. - +{$IFDEF VT_VCL} // MSAA support FAccessible: IAccessible; // The IAccessible interface to the window itself. FAccessibleItem: IAccessible; // The IAccessible to the item that currently has focus. FAccessibleName: string; // The name the window is given for screen readers. - +{$ENDIF} // export FOnBeforeNodeExport: TVTNodeExportEvent; // called before exporting a node FOnNodeExport: TVTNodeExportEvent; @@ -2269,7 +2520,9 @@ TBaseVirtualTree = class(TCustomControl) // determined by the application. // drag'n drop events +{$IFDEF VT_VCL} FOnCreateDragManager: TVTCreateDragManagerEvent; // called to allow for app./descendant defined drag managers +{$ENDIF} FOnCreateDataObject: TVTCreateDataObjectEvent; // called to allow for app./descendant defined data objects FOnDragAllowed: TVTDragAllowedEvent; // used to get permission for manual drag in mouse down FOnDragOver: TVTDragOverEvent; // called for every mouse move @@ -2277,9 +2530,11 @@ TBaseVirtualTree = class(TCustomControl) FOnHeaderDragged: TVTHeaderDraggedEvent; // header (column) drag'n drop FOnHeaderDraggedOut: TVTHeaderDraggedOutEvent; // header (column) drag'n drop, which did not result in a valid drop. FOnHeaderDragging: TVTHeaderDraggingEvent; // header (column) drag'n drop +{$IFDEF VT_VCL} FOnRenderOLEData: TVTRenderOLEDataEvent; // application/descendant defined clipboard formats FOnGetUserClipboardFormats: TVTGetUserClipboardFormatsEvent; // gives application/descendants the opportunity to // add own clipboard formats on the fly +{$ENDIF} // miscellanous events FOnGetNodeDataSize: TVTGetNodeDataSizeEvent; // Called if NodeDataSize is -1. @@ -2309,25 +2564,36 @@ TBaseVirtualTree = class(TCustomControl) FOnEndOperation: TVTOperationEvent; // Called when an operation ends FVclStyleEnabled: Boolean; - +{$IFDEF VT_FMX} + FFont: TFont; + FBevelEdges: TBevelEdges; + FBevelInner: TBevelCut; + FBevelOuter: TBevelCut; + FBevelKind: TBevelKind; + FBevelWidth: TBevelWidth; + FBorderWidth: TBorderWidth; + FHandleAllocated: Boolean; + FBiDiMode: TBiDiMode; +{$ENDIF} +{$IFDEF VT_VCL} procedure CMStyleChanged(var Message: TMessage); message CM_STYLECHANGED; procedure CMParentDoubleBufferedChange(var Message: TMessage); message CM_PARENTDOUBLEBUFFEREDCHANGED; - +{$ENDIF} procedure AdjustTotalCount(Node: PVirtualNode; Value: Integer; relative: Boolean = False); - procedure AdjustTotalHeight(Node: PVirtualNode; Value: Integer; relative: Boolean = False); + procedure AdjustTotalHeight(Node: PVirtualNode; Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; relative: Boolean = False); function CalculateCacheEntryCount: Integer; procedure CalculateVerticalAlignments(ShowImages, ShowStateImages: Boolean; Node: PVirtualNode; var VAlign, - VButtonAlign: Integer); + VButtonAlign: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); function ChangeCheckState(Node: PVirtualNode; Value: TCheckState): Boolean; - function CollectSelectedNodesLTR(MainColumn, NodeLeft, NodeRight: Integer; Alignment: TAlignment; OldRect, - NewRect: TRect): Boolean; - function CollectSelectedNodesRTL(MainColumn, NodeLeft, NodeRight: Integer; Alignment: TAlignment; OldRect, + function CollectSelectedNodesLTR(MainColumn: Integer; NodeLeft, NodeRight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; Alignment: TAlignment; OldRect, + NewRect: TRectF): Boolean; + function CollectSelectedNodesRTL(MainColumn: Integer; NodeLeft, NodeRight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; Alignment: TAlignment; OldRect, NewRect: TRect): Boolean; procedure ClearNodeBackground(const PaintInfo: TVTPaintInfo; UseBackground, Floating: Boolean; R: TRect); function CompareNodePositions(Node1, Node2: PVirtualNode; ConsiderChildrenAbove: Boolean = False): Integer; procedure DrawLineImage(const PaintInfo: TVTPaintInfo; X, Y, H, VAlign: Integer; Style: TVTLineType; Reverse: Boolean); - function FindInPositionCache(Node: PVirtualNode; var CurrentPos: Cardinal): PVirtualNode; overload; - function FindInPositionCache(Position: Cardinal; var CurrentPos: Cardinal): PVirtualNode; overload; + function FindInPositionCache(Node: PVirtualNode; var CurrentPos: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}): PVirtualNode; overload; + function FindInPositionCache(Position: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; var CurrentPos: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}): PVirtualNode; overload; procedure FixupTotalCount(Node: PVirtualNode); procedure FixupTotalHeight(Node: PVirtualNode); function GetBottomNode: PVirtualNode; @@ -2337,14 +2603,16 @@ TBaseVirtualTree = class(TCustomControl) function GetChildrenInitialized(Node: PVirtualNode): Boolean; function GetCutCopyCount: Integer; function GetDisabled(Node: PVirtualNode): Boolean; - function GetSyncCheckstateWithSelection(Node: PVirtualNode): Boolean; + function GetSyncCheckstateWithSelection(Node: PVirtualNode): Boolean; +{$IFDEF VT_VCL} function GetDragManager: IVTDragManager; +{$ENDIF} function GetExpanded(Node: PVirtualNode): Boolean; function GetFiltered(Node: PVirtualNode): Boolean; function GetFullyVisible(Node: PVirtualNode): Boolean; function GetHasChildren(Node: PVirtualNode): Boolean; function GetMultiline(Node: PVirtualNode): Boolean; - function GetNodeHeight(Node: PVirtualNode): Cardinal; + function GetNodeHeight(Node: PVirtualNode): {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; function GetNodeParent(Node: PVirtualNode): PVirtualNode; function GetOffsetXY: TPoint; function GetRootNodeCount: Cardinal; @@ -2354,7 +2622,7 @@ TBaseVirtualTree = class(TCustomControl) function GetVerticalAlignment(Node: PVirtualNode): Byte; function GetVisible(Node: PVirtualNode): Boolean; function GetVisiblePath(Node: PVirtualNode): Boolean; - function HandleDrawSelection(X, Y: Integer): Boolean; + function HandleDrawSelection(X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}): Boolean; function HasVisibleNextSibling(Node: PVirtualNode): Boolean; function HasVisiblePreviousSibling(Node: PVirtualNode): Boolean; procedure ImageListChange(Sender: TObject); @@ -2368,12 +2636,12 @@ TBaseVirtualTree = class(TCustomControl) procedure FakeReadIdent(Reader: TReader); procedure SetAlignment(const Value: TAlignment); procedure SetAnimationDuration(const Value: Cardinal); - procedure SetBackground(const Value: TPicture); + procedure SetBackground(const Value: {$IFDEF VT_FMX}TImage{$ELSE}TPicture{$ENDIF}); procedure SetBackGroundImageTransparent(const Value: Boolean); - procedure SetBackgroundOffset(const Index, Value: Integer); + procedure SetBackgroundOffset(const Index: Integer; const Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); procedure SetBorderStyle(Value: TBorderStyle); procedure SetBottomNode(Node: PVirtualNode); - procedure SetBottomSpace(const Value: Cardinal); + procedure SetBottomSpace(const Value: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}); procedure SetButtonFillMode(const Value: TVTButtonFillMode); procedure SetButtonStyle(const Value: TVTButtonStyle); procedure SetCheckImageKind(Value: TCheckImageKind); @@ -2382,7 +2650,7 @@ TBaseVirtualTree = class(TCustomControl) procedure SetClipboardFormats(const Value: TClipboardFormats); procedure SetColors(const Value: TVTColors); procedure SetCustomCheckImages(const Value: TCustomImageList); - procedure SetDefaultNodeHeight(Value: Cardinal); + procedure SetDefaultNodeHeight(Value: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}); procedure SetDisabled(Node: PVirtualNode; Value: Boolean); procedure SetEmptyListMessage(const Value: string); procedure SetExpanded(Node: PVirtualNode; Value: Boolean); @@ -2394,18 +2662,18 @@ TBaseVirtualTree = class(TCustomControl) procedure SetHotNode(Value: PVirtualNode); procedure SetFiltered(Node: PVirtualNode; Value: Boolean); procedure SetImages(const Value: TCustomImageList); - procedure SetIndent(Value: Cardinal); + procedure SetIndent(Value: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}); procedure SetLineMode(const Value: TVTLineMode); procedure SetLineStyle(const Value: TVTLineStyle); - procedure SetMargin(Value: Integer); + procedure SetMargin(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); procedure SetMultiline(Node: PVirtualNode; const Value: Boolean); procedure SetNodeAlignment(const Value: TVTNodeAlignment); procedure SetNodeDataSize(Value: Integer); - procedure SetNodeHeight(Node: PVirtualNode; Value: Cardinal); + procedure SetNodeHeight(Node: PVirtualNode; Value: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}); procedure SetNodeParent(Node: PVirtualNode; const Value: PVirtualNode); - procedure SetOffsetX(const Value: Integer); + procedure SetOffsetX(const Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); procedure SetOffsetXY(const Value: TPoint); - procedure SetOffsetY(const Value: Integer); + procedure SetOffsetY(const Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); procedure SetOptions(const Value: TCustomVirtualTreeOptions); procedure SetRootNodeCount(Value: Cardinal); procedure SetScrollBarOptions(Value: TScrollBarOptions); @@ -2413,17 +2681,19 @@ TBaseVirtualTree = class(TCustomControl) procedure SetSelected(Node: PVirtualNode; Value: Boolean); procedure SetSelectionCurveRadius(const Value: Cardinal); procedure SetStateImages(const Value: TCustomImageList); - procedure SetTextMargin(Value: Integer); + procedure SetTextMargin(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); procedure SetTopNode(Node: PVirtualNode); procedure SetUpdateState(Updating: Boolean); procedure SetVerticalAlignment(Node: PVirtualNode; Value: Byte); procedure SetVisible(Node: PVirtualNode; Value: Boolean); procedure SetVisiblePath(Node: PVirtualNode; Value: Boolean); - procedure PrepareBackGroundPicture(Source: TPicture; DrawBitmap: TBitmap; DrawBitmapWidth: Integer; DrawBitMapHeight: Integer; ABkgcolor: TColor); - procedure StaticBackground(Source: TPicture; Target: TCanvas; OffsetPosition: TPoint; R: TRect; aBkgColor: TColor); + procedure PrepareBackGroundPicture(Source: {$IFDEF VT_FMX}TImage{$ELSE}TPicture{$ENDIF}; DrawBitmap: TBitmap; DrawBitmapWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; DrawBitMapHeight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; ABkgcolor: TColor); + procedure StaticBackground(Source: {$IFDEF VT_FMX}TImage{$ELSE}TPicture{$ENDIF}; Target: TCanvas; OffsetPosition: TPoint; R: TRect; aBkgColor: TColor); procedure StopTimer(ID: Integer); procedure SetWindowTheme(const Theme: string); - procedure TileBackground(Source: TPicture; Target: TCanvas; Offset: TPoint; R: TRect; aBkgColor: TColor); + procedure TileBackground(Source: {$IFDEF VT_FMX}TImage{$ELSE}TPicture{$ENDIF}; Target: TCanvas; Offset: TPoint; R: TRect; aBkgColor: TColor); +{$IFDEF VT_VCL} + function ToggleCallback(Step, StepSize: Integer; Data: Pointer): Boolean; procedure CMColorChange(var Message: TMessage); message CM_COLORCHANGED; @@ -2480,52 +2750,69 @@ TBaseVirtualTree = class(TCustomControl) procedure WMTimer(var Message: TWMTimer); message WM_TIMER; procedure WMThemeChanged(var Message: TMessage); message WM_THEMECHANGED; procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL; - function GetRangeX: Cardinal; +{$ENDIF} + function GetRangeX: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; function GetDoubleBuffered: Boolean; procedure SetDoubleBuffered(const Value: Boolean); +{$IFDEF VT_FMX} + procedure SetFont(const Value: TFont); + function GetClientHeight: Single; + function GetClientWidth: Single; +{$ENDIF} protected FFontChanged: Boolean; // flag for keeping informed about font changes in the off screen buffer // [IPK] - private to protected +{$IFDEF VT_FMX} + 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); +{$ENDIF} procedure AutoScale(isDpiChange: Boolean); virtual; procedure AddToSelection(Node: PVirtualNode); overload; virtual; procedure AddToSelection(const NewItems: TNodeArray; NewLength: Integer; ForceInsert: Boolean = False); overload; virtual; procedure AdjustPaintCellRect(var PaintInfo: TVTPaintInfo; var NextNonEmpty: TColumnIndex); virtual; - procedure AdjustPanningCursor(X, Y: Integer); virtual; + procedure AdjustPanningCursor(X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); virtual; procedure AdviseChangeEvent(StructureChange: Boolean; Node: PVirtualNode; Reason: TChangeReason); virtual; function AllocateInternalDataArea(Size: Cardinal): Cardinal; virtual; procedure Animate(Steps, Duration: Cardinal; Callback: TVTAnimationCallback; Data: Pointer); virtual; - function CalculateSelectionRect(X, Y: Integer): Boolean; virtual; + function CalculateSelectionRect(X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}): Boolean; virtual; function CanAutoScroll: Boolean; virtual; function CanShowDragImage: Boolean; virtual; function CanSplitterResizeNode(P: TPoint; Node: PVirtualNode; Column: TColumnIndex): Boolean; procedure Change(Node: PVirtualNode); virtual; procedure ChangeTreeStatesAsync(EnterStates, LeaveStates: TChangeStates); - procedure ChangeScale(M, D: Integer{$if CompilerVersion >= 31}; isDpiChange: Boolean{$ifend}); override; + procedure ChangeScale(M, D: Integer{$if CompilerVersion >= 31}; isDpiChange: Boolean{$ifend}); {$IFDEF VT_FMX}virtual;{$ELSE}override;{$ENDIF} function CheckParentCheckState(Node: PVirtualNode; NewCheckState: TCheckState): Boolean; virtual; procedure ClearSelection(pFireChangeEvent: Boolean); overload; virtual; procedure ClearTempCache; virtual; function ColumnIsEmpty(Node: PVirtualNode; Column: TColumnIndex): Boolean; virtual; - function ComputeRTLOffset(ExcludeScrollBar: Boolean = False): Integer; virtual; + function ComputeRTLOffset(ExcludeScrollBar: Boolean = False): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; virtual; function CountLevelDifference(Node1, Node2: PVirtualNode): Integer; virtual; function CountVisibleChildren(Node: PVirtualNode): Cardinal; virtual; +{$IFDEF VT_VCL} procedure CreateParams(var Params: TCreateParams); override; procedure CreateWnd; override; +{$ENDIF} procedure DefineProperties(Filer: TFiler); override; procedure DeleteNode(Node: PVirtualNode; Reindex: Boolean; ParentClearing: Boolean); overload; function DetermineDropMode(const P: TPoint; var HitInfo: THitInfo; var NodeRect: TRect): TDropMode; virtual; procedure DetermineHiddenChildrenFlag(Node: PVirtualNode); virtual; procedure DetermineHiddenChildrenFlagAllNodes; virtual; - procedure DetermineHitPositionLTR(var HitInfo: THitInfo; Offset, Right: Integer; Alignment: TAlignment); virtual; - procedure DetermineHitPositionRTL(var HitInfo: THitInfo; Offset, Right: Integer; Alignment: TAlignment); virtual; + procedure DetermineHitPositionLTR(var HitInfo: THitInfo; Offset, Right: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; Alignment: TAlignment); virtual; + procedure DetermineHitPositionRTL(var HitInfo: THitInfo; Offset, Right: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; Alignment: TAlignment); virtual; function DetermineLineImageAndSelectLevel(Node: PVirtualNode; var LineImage: TLineImage): Integer; virtual; function DetermineNextCheckState(CheckType: TCheckType; CheckState: TCheckState): TCheckState; virtual; - function DetermineScrollDirections(X, Y: Integer): TScrollDirections; virtual; + function DetermineScrollDirections(X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}): TScrollDirections; virtual; procedure DoAdvancedHeaderDraw(var PaintInfo: THeaderPaintInfo; const Elements: THeaderPaintElements); virtual; procedure DoAfterCellPaint(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; CellRect: TRect); virtual; procedure DoAfterItemErase(Canvas: TCanvas; Node: PVirtualNode; ItemRect: TRect); virtual; procedure DoAfterItemPaint(Canvas: TCanvas; Node: PVirtualNode; ItemRect: TRect); virtual; procedure DoAfterPaint(Canvas: TCanvas); virtual; - procedure DoAutoScroll(X, Y: Integer); virtual; + procedure DoAutoScroll(X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); virtual; function DoBeforeDrag(Node: PVirtualNode; Column: TColumnIndex): Boolean; virtual; procedure DoBeforeCellPaint(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect); virtual; @@ -2548,20 +2835,22 @@ TBaseVirtualTree = class(TCustomControl) procedure DoColumnResize(Column: TColumnIndex); virtual; procedure DoColumnVisibilityChanged(const Column: TColumnIndex; Visible: Boolean); function DoCompare(Node1, Node2: PVirtualNode; Column: TColumnIndex): Integer; virtual; +{$IFDEF VT_VCL} function DoCreateDataObject: IDataObject; virtual; function DoCreateDragManager: IVTDragManager; virtual; +{$ENDIF} function DoCreateEditor(Node: PVirtualNode; Column: TColumnIndex): IVTEditLink; virtual; procedure DoDragging(P: TPoint); virtual; procedure DoDragExpand; virtual; procedure DoBeforeDrawLineImage(Node: PVirtualNode; Level: Integer; var XPos: Integer); virtual; function DoDragOver(Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode; var Effect: Integer): Boolean; virtual; - procedure DoDragDrop(Source: TObject; const DataObject: IDataObject; const Formats: TFormatArray; Shift: TShiftState; Pt: TPoint; + procedure DoDragDrop(Source: TObject; const DataObject: {$IFDEF VT_FMX}TDragObject{$ELSE}IDataObject{$ENDIF}; const Formats: TFormatArray; Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode); virtual; procedure DoDrawHint(Canvas: TCanvas; Node: PVirtualNode; R: TRect; Column: TColumnIndex); procedure DoEdit; virtual; - procedure DoEndDrag(Target: TObject; X, Y: Integer); override; + procedure DoEndDrag(Target: TObject; X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); {$IFDEF VT_FMX}virtual;{$ELSE}override;{$ENDIF} function DoEndEdit: Boolean; virtual; procedure DoEndOperation(OperationKind: TVTOperationKind); virtual; procedure DoEnter(); override; @@ -2574,7 +2863,7 @@ TBaseVirtualTree = class(TCustomControl) function DoGetCellContentMargin(Node: PVirtualNode; Column: TColumnIndex; CellContentMarginType: TVTCellContentMarginType = ccmtAllSides; Canvas: TCanvas = nil): TPoint; virtual; procedure DoGetCursor(var Cursor: TCursor); virtual; - procedure DoGetHeaderCursor(var Cursor: HCURSOR); virtual; + procedure DoGetHeaderCursor(var Cursor: {$IFDEF VT_FMX}TCursor{$ELSE}HCURSOR{$ENDIF}); virtual; procedure DoGetHintSize(Node: PVirtualNode; Column: TColumnIndex; var R: TRect); virtual; procedure DoGetHintKind(Node: PVirtualNode; Column: TColumnIndex; var Kind: @@ -2585,10 +2874,12 @@ TBaseVirtualTree = class(TCustomControl) procedure DoGetLineStyle(var Bits: Pointer); virtual; function DoGetNodeHint(Node: PVirtualNode; Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle): string; virtual; function DoGetNodeTooltip(Node: PVirtualNode; Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle): string; virtual; - function DoGetNodeExtraWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): Integer; virtual; - function DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): Integer; virtual; + function DoGetNodeExtraWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; virtual; + function DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; virtual; function DoGetPopupMenu(Node: PVirtualNode; Column: TColumnIndex; Position: TPoint): TPopupMenu; virtual; - procedure DoGetUserClipboardFormats(var Formats: TFormatEtcArray); virtual; +{$IFDEF VT_VCL} + procedure DoGetUserClipboardFormats(var Formats: TFormatEtcArray); virtual; +{$ENDIF} procedure DoHeaderAddPopupItem(const Column: TColumnIndex; var Cmd: TAddPopupItemType); procedure DoHeaderClick(const HitInfo: TVTHeaderHitInfo); virtual; procedure DoHeaderDblClick(const HitInfo: TVTHeaderHitInfo); virtual; @@ -2607,7 +2898,7 @@ TBaseVirtualTree = class(TCustomControl) procedure DoInitNode(Parent, Node: PVirtualNode; var InitStates: TVirtualNodeInitStates); virtual; 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: Integer); virtual; + procedure DoMeasureItem(TargetCanvas: TCanvas; Node: PVirtualNode; var NodeHeight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); virtual; procedure DoMouseEnter(); virtual; procedure DoMouseLeave(); virtual; procedure DoNodeCopied(Node: PVirtualNode); virtual; @@ -2625,31 +2916,33 @@ TBaseVirtualTree = class(TCustomControl) procedure DoPaintNode(var PaintInfo: TVTPaintInfo); virtual; procedure DoPopupMenu(Node: PVirtualNode; Column: TColumnIndex; Position: TPoint); virtual; procedure DoRemoveFromSelection(Node: PVirtualNode); virtual; +{$IFDEF VT_VCL} function DoRenderOLEData(const FormatEtcIn: TFormatEtc; out Medium: TStgMedium; ForClipboard: Boolean): HRESULT; virtual; +{$ENDIF} procedure DoReset(Node: PVirtualNode); virtual; procedure DoSaveUserData(Node: PVirtualNode; Stream: TStream); virtual; - procedure DoScroll(DeltaX, DeltaY: Integer); virtual; + procedure DoScroll(DeltaX, DeltaY: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); virtual; function DoSetOffsetXY(Value: TPoint; Options: TScrollUpdateOptions; ClipRect: PRect = nil): Boolean; virtual; procedure DoShowScrollBar(Bar: Integer; Show: Boolean); virtual; - procedure DoStartDrag(var DragObject: TDragObject); override; + procedure DoStartDrag(var DragObject: TDragObject); {$IFDEF VT_FMX}virtual{$ELSE}override{$ENDIF}; procedure DoStartOperation(OperationKind: TVTOperationKind); virtual; procedure DoStateChange(Enter: TVirtualTreeStates; Leave: TVirtualTreeStates = []); virtual; procedure DoStructureChange(Node: PVirtualNode; Reason: TChangeReason); virtual; procedure DoTimerScroll; virtual; procedure DoUpdating(State: TVTUpdateState); virtual; function DoValidateCache: Boolean; virtual; - procedure DragAndDrop(AllowedEffects: DWord; const DataObject: IDataObject; var DragEffect: Integer); virtual; - procedure DragCanceled; override; - function DragDrop(const DataObject: IDataObject; KeyState: Integer; Pt: TPoint; + procedure DragAndDrop(AllowedEffects: DWord; const DataObject: {$IFDEF VT_FMX}TDragObject{$ELSE}IDataObject{$ENDIF}; var DragEffect: Integer); virtual; + procedure DragCanceled; {$IFDEF VT_FMX}virtual{$ELSE}override{$ENDIF}; + function DragDrop(const DataObject: {$IFDEF VT_FMX}TDragObject{$ELSE}IDataObject{$ENDIF}; KeyState: Integer; Pt: TPoint; var Effect: Integer): HResult; reintroduce; virtual; function DragEnter(KeyState: Integer; Pt: TPoint; var Effect: Integer): HResult; virtual; procedure DragFinished; virtual; procedure DragLeave; virtual; function DragOver(Source: TObject; KeyState: Integer; DragState: TDragState; Pt: TPoint; var Effect: Integer): HResult; reintroduce; virtual; - procedure DrawDottedHLine(const PaintInfo: TVTPaintInfo; Left, Right, Top: Integer); virtual; - procedure DrawDottedVLine(const PaintInfo: TVTPaintInfo; Top, Bottom, Left: Integer; UseSelectedBkColor: Boolean = False); virtual; + procedure DrawDottedHLine(const PaintInfo: TVTPaintInfo; Left, Right, Top: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); virtual; + procedure DrawDottedVLine(const PaintInfo: TVTPaintInfo; Top, Bottom, Left: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; UseSelectedBkColor: Boolean = False); virtual; procedure EndOperation(OperationKind: TVTOperationKind); procedure EnsureNodeFocused(); virtual; function FindNodeInSelection(P: PVirtualNode; var Index: Integer; LowBound, HighBound: Integer): Boolean; virtual; @@ -2662,20 +2955,28 @@ TBaseVirtualTree = class(TCustomControl) function GetColumnClass: TVirtualTreeColumnClass; virtual; function GetDefaultHintKind: TVTHintKind; virtual; function GetHeaderClass: TVTHeaderClass; virtual; +{$IFDEF VT_VCL} function GetHintWindowClass: THintWindowClass; virtual; +{$ENDIF} procedure GetImageIndex(var Info: TVTPaintInfo; Kind: TVTImageKind; InfoIndex: TVTImageInfoIndex); virtual; function GetImageSize(Node: PVirtualNode; Kind: TVTImageKind = TVTImageKind.ikNormal; Column: TColumnIndex = 0; IncludePadding: Boolean = True): TSize; virtual; function GetNodeImageSize(Node: PVirtualNode): TSize; virtual; deprecated 'Use GetImageSize instead'; - function GetMaxRightExtend: Cardinal; virtual; + function GetMaxRightExtend: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; virtual; +{$IFDEF VT_VCL} procedure GetNativeClipboardFormats(var Formats: TFormatEtcArray); virtual; +{$ENDIF} function GetOperationCanceled: Boolean; function GetOptionsClass: TTreeOptionsClass; virtual; - function GetTreeFromDataObject(const DataObject: IDataObject): TBaseVirtualTree; virtual; - procedure HandleHotTrack(X, Y: Integer); virtual; + function GetTreeFromDataObject(const DataObject: {$IFDEF VT_FMX}TDragObject{$ELSE}IDataObject{$ENDIF}): TBaseVirtualTree; virtual; + procedure HandleHotTrack(X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); virtual; procedure HandleIncrementalSearch(CharCode: Word); virtual; +{$IFDEF VT_FMX} + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Single; Y: Single); override; +{$ELSE} procedure HandleMouseDblClick(var Message: TWMMouse; const HitInfo: THitInfo); virtual; procedure HandleMouseDown(var Message: TWMMouse; var HitInfo: THitInfo); virtual; procedure HandleMouseUp(var Message: TWMMouse; const HitInfo: THitInfo); virtual; +{$ENDIF} procedure HandleClickSelection(LastFocused, NewNode: PVirtualNode; Shift: TShiftState; DragPending: Boolean); function HasImage(Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex): Boolean; virtual; deprecated 'Use GetImageSize instead'; function HasPopupMenu(Node: PVirtualNode; Column: TColumnIndex; Pos: TPoint): Boolean; virtual; @@ -2696,32 +2997,36 @@ TBaseVirtualTree = class(TCustomControl) procedure Loaded; override; procedure MainColumnChanged; virtual; procedure MarkCutCopyNodes; virtual; - procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; + procedure MouseMove(Shift: TShiftState; X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); override; procedure Notification(AComponent: TComponent; Operation: TOperation); override; - procedure OriginalWMNCPaint(DC: HDC); virtual; + procedure OriginalWMNCPaint({$IFDEF VT_FMX}ACanvas: TCanvas{$ELSE}DC: HDC{$ENDIF}); virtual; procedure Paint; override; procedure PaintCheckImage(Canvas: TCanvas; const ImageInfo: TVTImageInfo; Selected: Boolean); virtual; procedure PaintImage(var PaintInfo: TVTPaintInfo; ImageInfoIndex: TVTImageInfoIndex; DoOverlay: Boolean); virtual; procedure PaintNodeButton(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const R: TRect; ButtonX, - ButtonY: Integer; BidiMode: TBiDiMode); virtual; - procedure PaintTreeLines(const PaintInfo: TVTPaintInfo; VAlignment, IndentSize: Integer; const LineImage: TLineImage); virtual; - procedure PaintSelectionRectangle(Target: TCanvas; WindowOrgX: Integer; const SelectionRect: TRect; + ButtonY: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; BidiMode: TBiDiMode); virtual; + procedure PaintTreeLines(const PaintInfo: TVTPaintInfo; VAlignment, IndentSize: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; const LineImage: TLineImage); virtual; + procedure PaintSelectionRectangle(Target: TCanvas; WindowOrgX: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; const SelectionRect: TRect; TargetRect: TRect); virtual; +{$IFDEF VT_VCL} procedure PanningWindowProc(var Message: TMessage); virtual; - procedure PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX, MaxWidth: Integer); virtual; +{$ENDIF} + procedure PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX, MaxWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); virtual; function ReadChunk(Stream: TStream; Version: Integer; Node: PVirtualNode; ChunkType, ChunkSize: Integer): Boolean; virtual; procedure ReadNode(Stream: TStream; Version: Integer; Node: PVirtualNode); virtual; procedure RedirectFontChangeEvent(Canvas: TCanvas); virtual; procedure RemoveFromSelection(Node: PVirtualNode); virtual; procedure UpdateNextNodeToSelect(Node: PVirtualNode); virtual; +{$IFDEF VT_VCL} function RenderOLEData(const FormatEtcIn: TFormatEtc; out Medium: TStgMedium; ForClipboard: Boolean): HResult; virtual; +{$ENDIF} procedure ResetRangeAnchor; virtual; procedure RestoreFontChangeEvent(Canvas: TCanvas); virtual; procedure SelectNodes(StartNode, EndNode: PVirtualNode; AddOnly: Boolean); virtual; procedure SetChildCount(Node: PVirtualNode; NewChildCount: Cardinal); virtual; procedure SetFocusedNodeAndColumn(Node: PVirtualNode; Column: TColumnIndex); virtual; - procedure SetRangeX(value: Cardinal); + procedure SetRangeX(value: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}); procedure SkipNode(Stream: TStream); virtual; procedure StartOperation(OperationKind: TVTOperationKind); procedure StartWheelPanning(Position: TPoint); virtual; @@ -2734,16 +3039,21 @@ TBaseVirtualTree = class(TCustomControl) procedure UpdateDesigner; virtual; procedure UpdateEditBounds; virtual; procedure UpdateHeaderRect; virtual; - procedure UpdateStyleElements; override; + procedure UpdateStyleElements; {$IFDEF VT_FMX}virtual{$ELSE}override{$ENDIF}; procedure UpdateWindowAndDragImage(const Tree: TBaseVirtualTree; TreeRect: TRect; UpdateNCArea, ReshowDragImage: Boolean); virtual; procedure ValidateCache; virtual; procedure ValidateNodeDataSize(var Size: Integer); virtual; +{$IFDEF VT_VCL} procedure WndProc(var Message: TMessage); override; +{$ENDIF} procedure WriteChunks(Stream: TStream; Node: PVirtualNode); virtual; procedure WriteNode(Stream: TStream; Node: PVirtualNode); virtual; procedure VclStyleChanged; virtual; +{$IFDEF VT_FMX} + property HandleAllocated: Boolean read FHandleAllocated default true; +{$ENDIF} property VclStyleEnabled: Boolean read FVclStyleEnabled; property TotalInternalDataSize: Cardinal read FTotalInternalDataSize; @@ -2752,12 +3062,12 @@ TBaseVirtualTree = class(TCustomControl) property AutoExpandDelay: Cardinal read FAutoExpandDelay write FAutoExpandDelay default 1000; property AutoScrollDelay: Cardinal read FAutoScrollDelay write FAutoScrollDelay default 1000; property AutoScrollInterval: TAutoScrollInterval read FAutoScrollInterval write FAutoScrollInterval default 1; - property Background: TPicture read FBackground write SetBackground; + property Background: {$IFDEF VT_FMX}TImage{$ELSE}TPicture{$ENDIF} read FBackground write SetBackground; property BackGroundImageTransparent: Boolean read FBackGroundImageTransparent write SetBackGroundImageTransparent default False; - property BackgroundOffsetX: Integer index 0 read FBackgroundOffsetX write SetBackgroundOffset default 0; - property BackgroundOffsetY: Integer index 1 read FBackgroundOffsetY write SetBackgroundOffset default 0; + property BackgroundOffsetX: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} index 0 read FBackgroundOffsetX write SetBackgroundOffset{$IFDEF VT_VCL} default 0{$ENDIF}; + property BackgroundOffsetY: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} index 1 read FBackgroundOffsetY write SetBackgroundOffset{$IFDEF VT_VCL} default 0{$ENDIF}; property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle; - property BottomSpace: Cardinal read FBottomSpace write SetBottomSpace default 0; + property BottomSpace: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF} read FBottomSpace write SetBottomSpace{$IFDEF VT_VCL} default 0{$ENDIF}; property ButtonFillMode: TVTButtonFillMode read FButtonFillMode write SetButtonFillMode default fmTreeColor; property ButtonStyle: TVTButtonStyle read FButtonStyle write SetButtonStyle default bsRectangle; property ChangeDelay: Cardinal read FChangeDelay write FChangeDelay default 0; @@ -2766,7 +3076,7 @@ TBaseVirtualTree = class(TCustomControl) property Colors: TVTColors read FColors write SetColors; property CustomCheckImages: TCustomImageList read FCustomCheckImages write SetCustomCheckImages; property DefaultHintKind: TVTHintKind read GetDefaultHintKind; - property DefaultNodeHeight: Cardinal read FDefaultNodeHeight write SetDefaultNodeHeight default 18; + property DefaultNodeHeight: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF} read FDefaultNodeHeight write SetDefaultNodeHeight{$IFDEF VT_VCL} default 18{$ENDIF}; property DefaultPasteMode: TVTNodeAttachMode read FDefaultPasteMode write FDefaultPasteMode default amAddChildLast; property DragHeight: Integer read FDragHeight write FDragHeight default 350; property DragImageKind: TVTDragImageKind read FDragImageKind write FDragImageKind default diComplete; @@ -2779,7 +3089,7 @@ TBaseVirtualTree = class(TCustomControl) default smDottedRectangle; property EditColumn: TColumnIndex read FEditColumn write FEditColumn; property EditDelay: Cardinal read FEditDelay write FEditDelay default 1000; - property EffectiveOffsetX: Integer read FEffectiveOffsetX; + property EffectiveOffsetX: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} read FEffectiveOffsetX; property HeaderRect: TRect read FHeaderRect; property HintMode: TVTHintMode read FHintMode write FHintMode default hmDefault; property HintData: TVTHintData read FHintData write FHintData; @@ -2789,13 +3099,13 @@ TBaseVirtualTree = class(TCustomControl) property IncrementalSearchDirection: TVTSearchDirection read FSearchDirection write FSearchDirection default sdForward; property IncrementalSearchStart: TVTSearchStart read FSearchStart write FSearchStart default ssFocusedNode; property IncrementalSearchTimeout: Cardinal read FSearchTimeout write FSearchTimeout default 1000; - property Indent: Cardinal read FIndent write SetIndent default 18; + property Indent: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF} read FIndent write SetIndent{$IFDEF VT_VCL} default 18{$ENDIF}; property LastClickPos: TPoint read FLastClickPos write FLastClickPos; property LastDropMode: TDropMode read FLastDropMode write FLastDropMode; property LastHintRect: TRect read FLastHintRect write FLastHintRect; property LineMode: TVTLineMode read FLineMode write SetLineMode default lmNormal; property LineStyle: TVTLineStyle read FLineStyle write SetLineStyle default lsDotted; - property Margin: Integer read FMargin write SetMargin default 4; + property Margin: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} read FMargin write SetMargin{$IFDEF VT_VCL} default 4{$ENDIF}; property NextNodeToSelect: PVirtualNode read FNextNodeToSelect; // Next tree node that we would like to select if the current one gets deleted property NodeAlignment: TVTNodeAlignment read FNodeAlignment write SetNodeAlignment default naProportional; property NodeDataSize: Integer read FNodeDataSize write SetNodeDataSize default -1; @@ -2804,14 +3114,14 @@ TBaseVirtualTree = class(TCustomControl) property HotPlusBM: TBitmap read FHotPlusBM; property MinusBM: TBitmap read FMinusBM; property PlusBM: TBitmap read FPlusBM; - property RangeX: Cardinal read GetRangeX;// Returns the width of the virtual tree in pixels, (not ClientWidth). If there are columns it returns the total width of all of them; otherwise it returns the maximum of the all the line's data widths. - property RangeY: Cardinal read FRangeY; + property RangeX: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF} read GetRangeX;// Returns the width of the virtual tree in pixels, (not ClientWidth). If there are columns it returns the total width of all of them; otherwise it returns the maximum of the all the line's data widths. + property RangeY: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF} read FRangeY; property RootNodeCount: Cardinal read GetRootNodeCount write SetRootNodeCount default 0; property ScrollBarOptions: TScrollBarOptions read FScrollBarOptions write SetScrollBarOptions; property SelectionBlendFactor: Byte read FSelectionBlendFactor write FSelectionBlendFactor default 128; property SelectionCurveRadius: Cardinal read FSelectionCurveRadius write SetSelectionCurveRadius default 0; property StateImages: TCustomImageList read FStateImages write SetStateImages; - property TextMargin: Integer read FTextMargin write SetTextMargin default 4; + property TextMargin: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} read FTextMargin write SetTextMargin{$IFDEF VT_VCL} default 4{$ENDIF}; property TreeOptions: TCustomVirtualTreeOptions read FOptions write SetOptions; property WantTabs: Boolean read FWantTabs write FWantTabs default False; property SyncCheckstateWithSelection[Node: PVirtualNode]: Boolean read GetSyncCheckstateWithSelection; @@ -2866,7 +3176,9 @@ TBaseVirtualTree = class(TCustomControl) property OnColumnWidthTracking: TVTColumnWidthTrackingEvent read FOnColumnWidthTracking write FOnColumnWidthTracking; property OnCompareNodes: TVTCompareEvent read FOnCompareNodes write FOnCompareNodes; property OnCreateDataObject: TVTCreateDataObjectEvent read FOnCreateDataObject write FOnCreateDataObject; +{$IFDEF VT_VCL} property OnCreateDragManager: TVTCreateDragManagerEvent read FOnCreateDragManager write FOnCreateDragManager; +{$ENDIF} property OnCreateEditor: TVTCreateEditorEvent read FOnCreateEditor write FOnCreateEditor; property OnDragAllowed: TVTDragAllowedEvent read FOnDragAllowed write FOnDragAllowed; property OnDragOver: TVTDragOverEvent read FOnDragOver write FOnDragOver; @@ -2895,8 +3207,10 @@ TBaseVirtualTree = class(TCustomControl) property OnGetLineStyle: TVTGetLineStyleEvent read FOnGetLineStyle write FOnGetLineStyle; property OnGetNodeDataSize: TVTGetNodeDataSizeEvent read FOnGetNodeDataSize write FOnGetNodeDataSize; property OnGetPopupMenu: TVTPopupEvent read FOnGetPopupMenu write FOnGetPopupMenu; +{$IFDEF VT_VCL} property OnGetUserClipboardFormats: TVTGetUserClipboardFormatsEvent read FOnGetUserClipboardFormats write FOnGetUserClipboardFormats; +{$ENDIF} property OnHeaderAddPopupItem: TVTHeaderAddPopupItemEvent read FOnHeaderAddPopupItem write FOnHeaderAddPopupItem; property OnHeaderClick: TVTHeaderClickEvent read FOnHeaderClick write FOnHeaderClick; property OnHeaderDblClick: TVTHeaderClickEvent read FOnHeaderDblClick write FOnHeaderDblClick; @@ -2936,7 +3250,9 @@ TBaseVirtualTree = class(TCustomControl) property OnPaintBackground: TVTBackgroundPaintEvent read FOnPaintBackground write FOnPaintBackground; property OnPrepareButtonBitmaps : TVTPrepareButtonImagesEvent read FOnPrepareButtonImages write FOnPrepareButtonImages; property OnRemoveFromSelection: TVTRemoveFromSelectionEvent read FOnRemoveFromSelection write FOnRemoveFromSelection; - property OnRenderOLEData: TVTRenderOLEDataEvent read FOnRenderOLEData write FOnRenderOLEData; +{$IFDEF VT_VCL} + property OnRenderOLEData: TVTRenderOLEDataEvent read FOnRenderOLEData write FOnRenderOLEData; +{$ENDIF} property OnResetNode: TVTChangeEvent read FOnResetNode write FOnResetNode; property OnSaveNode: TVTSaveNodeEvent read FOnSaveNode write FOnSaveNode; property OnSaveTree: TVTSaveTreeEvent read FOnSaveTree write FOnSaveTree; @@ -2948,7 +3264,7 @@ TBaseVirtualTree = class(TCustomControl) property OnStructureChange: TVTStructureChangeEvent read FOnStructureChange write FOnStructureChange; property OnUpdating: TVTUpdatingEvent read FOnUpdating write FOnUpdating; public - constructor Create(AOwner: TComponent); override; + constructor Create(AOwner: TComponent); override; //base tree destructor Destroy; override; function AbsoluteIndex(Node: PVirtualNode): Cardinal; function AddChild(Parent: PVirtualNode; UserData: Pointer = nil): PVirtualNode; overload; virtual; @@ -2964,7 +3280,7 @@ TBaseVirtualTree = class(TCustomControl) function CancelEditNode: Boolean; procedure CancelOperation; function CanEdit(Node: PVirtualNode; Column: TColumnIndex): Boolean; virtual; - function CanFocus: Boolean; override; + function CanFocus: Boolean; {$IFDEF VT_FMX}virtual{$ELSE}override{$ENDIF}; procedure Clear; virtual; procedure ClearChecked; procedure ClearSelection(); overload; inline; @@ -2989,7 +3305,7 @@ TBaseVirtualTree = class(TCustomControl) procedure FlushClipboard; procedure FullCollapse(Node: PVirtualNode = nil); virtual; procedure FullExpand(Node: PVirtualNode = nil); virtual; - function GetControlsAlignment: TAlignment; override; + function GetControlsAlignment: TAlignment; {$IFDEF VT_FMX}virtual{$ELSE}override{$ENDIF}; function GetDisplayRect(Node: PVirtualNode; Column: TColumnIndex; TextOnly: Boolean; Unclipped: Boolean = False; ApplyCellContentMargin: Boolean = False): TRect; function GetEffectivelyFiltered(Node: PVirtualNode): Boolean; @@ -3010,7 +3326,7 @@ TBaseVirtualTree = class(TCustomControl) function GetFirstVisibleChildNoInit(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode; function GetFirstVisibleNoInit(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = True; IncludeFiltered: Boolean = False): PVirtualNode; - procedure GetHitTestInfoAt(X, Y: Integer; Relative: Boolean; var HitInfo: THitInfo); virtual; + procedure GetHitTestInfoAt(X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; Relative: Boolean; var HitInfo: THitInfo); virtual; function GetLast(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = False): PVirtualNode; function GetLastInitialized(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = False): PVirtualNode; function GetLastNoInit(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = False): PVirtualNode; @@ -3022,7 +3338,7 @@ TBaseVirtualTree = class(TCustomControl) function GetLastVisibleChildNoInit(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode; function GetLastVisibleNoInit(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = True; IncludeFiltered: Boolean = False): PVirtualNode; - function GetMaxColumnWidth(Column: TColumnIndex; UseSmartColumnWidth: Boolean = False): Integer; virtual; + function GetMaxColumnWidth(Column: TColumnIndex; UseSmartColumnWidth: Boolean = False): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; virtual; function GetNext(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; function GetNextChecked(Node: PVirtualNode; State: TCheckState = csCheckedNormal; ConsiderChildrenAbove: Boolean = False): PVirtualNode; overload; @@ -3040,8 +3356,8 @@ TBaseVirtualTree = class(TCustomControl) function GetNextVisibleSibling(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode; function GetNextVisibleSiblingNoInit(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode; function GetNodeAt(const P: TPoint): PVirtualNode; overload; inline; - function GetNodeAt(X, Y: Integer): PVirtualNode; overload; - function GetNodeAt(X, Y: Integer; Relative: Boolean; var NodeTop: Integer): PVirtualNode; overload; + function GetNodeAt(X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}): PVirtualNode; overload; + function GetNodeAt(X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; Relative: Boolean; var NodeTop: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}): PVirtualNode; overload; function GetNodeData(Node: PVirtualNode): Pointer; overload; function GetNodeData(pNode: PVirtualNode): T; overload; inline; function GetSelectedData(): TArray; overload; @@ -3050,7 +3366,7 @@ TBaseVirtualTree = class(TCustomControl) function GetFirstSelectedNodeData(): T; function GetNodeLevel(Node: PVirtualNode): Cardinal; function GetNodeLevelForSelectConstraint(Node: PVirtualNode): integer; - function GetOffset(pElement: TVTElement; pNode: PVirtualNode): integer; + function GetOffset(pElement: TVTElement; pNode: PVirtualNode): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; procedure GetOffsets(pNode: PVirtualNode; out pOffsets: TVTOffsets; pElement: TVTElement = TVTElement.ofsEndOfClientArea; pColumn: Integer = NoColumn); function GetPrevious(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; function GetPreviousChecked(Node: PVirtualNode; State: TCheckState = csCheckedNormal; @@ -3092,14 +3408,16 @@ TBaseVirtualTree = class(TCustomControl) procedure MoveTo(Node: PVirtualNode; Tree: TBaseVirtualTree; Mode: TVTNodeAttachMode; ChildrenOnly: Boolean); overload; procedure PaintTree(TargetCanvas: TCanvas; Window: TRect; Target: TPoint; PaintOptions: TVTInternalPaintOptions; - PixelFormat: TPixelFormat = pfDevice); virtual; + PixelFormat: TPixelFormat = {$IFDEF VT_FMX}TPixelFormat.RGBA{$ELSE}pfDevice{$ENDIF}); virtual; function PasteFromClipboard: Boolean; virtual; - procedure PrepareDragImage(HotSpot: TPoint; const DataObject: IDataObject); + procedure PrepareDragImage(HotSpot: TPoint; const DataObject: {$IFDEF VT_FMX}TDragObject{$ELSE}IDataObject{$ENDIF}); procedure Print(Printer: TPrinter; PrintHeader: Boolean); - function ProcessDrop(const DataObject: IDataObject; TargetNode: PVirtualNode; var Effect: Integer; Mode: + function ProcessDrop(const DataObject: {$IFDEF VT_FMX}TDragObject{$ELSE}IDataObject{$ENDIF}; TargetNode: PVirtualNode; var Effect: Integer; Mode: TVTNodeAttachMode): Boolean; - function ProcessOLEData(Source: TBaseVirtualTree; const DataObject: IDataObject; TargetNode: PVirtualNode; - Mode: TVTNodeAttachMode; Optimized: Boolean): Boolean; +{$IFDEF VT_VCL} + function ProcessOLEData(Source: TBaseVirtualTree; const DataObject: IDataObject; TargetNode: PVirtualNode; + Mode: TVTNodeAttachMode; Optimized: Boolean): Boolean; +{$ENDIF} procedure RepaintNode(Node: PVirtualNode); procedure ReinitChildren(Node: PVirtualNode; Recursive: Boolean); virtual; procedure InitRecursive(Node: PVirtualNode; Levels: Cardinal = MaxInt; pVisibleOnly: Boolean = True); @@ -3107,7 +3425,7 @@ TBaseVirtualTree = class(TCustomControl) procedure ResetNode(Node: PVirtualNode); virtual; procedure SaveToFile(const FileName: TFileName); procedure SaveToStream(Stream: TStream; Node: PVirtualNode = nil); virtual; - function ScaledPixels(pPixels: Integer): Integer; + function ScaledPixels(pPixels: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; function ScrollIntoView(Node: PVirtualNode; Center: Boolean; Horizontally: Boolean = False): Boolean; overload; function ScrollIntoView(Column: TColumnIndex; Center: Boolean; Node: PVirtualNode = nil): Boolean; overload; procedure SelectAll(VisibleOnly: Boolean); @@ -3144,9 +3462,11 @@ TBaseVirtualTree = class(TCustomControl) function VisibleChildNoInitNodes(Node: PVirtualNode; IncludeFiltered: Boolean = False): TVTVirtualNodeEnumeration; function VisibleNoInitNodes(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = True; IncludeFiltered: Boolean = False): TVTVirtualNodeEnumeration; +{$IFDEF VT_VCL} property Accessible: IAccessible read FAccessible write FAccessible; property AccessibleItem: IAccessible read FAccessibleItem write FAccessibleItem; property AccessibleName: string read FAccessibleName write FAccessibleName; +{$ENDIF} property BottomNode: PVirtualNode read GetBottomNode write SetBottomNode; property CheckedCount: Integer read GetCheckedCount; property CheckImages: TCustomImageList read FCheckImages; @@ -3155,15 +3475,17 @@ TBaseVirtualTree = class(TCustomControl) property ChildCount[Node: PVirtualNode]: Cardinal read GetChildCount write SetChildCount; property ChildrenInitialized[Node: PVirtualNode]: Boolean read GetChildrenInitialized; property CutCopyCount: Integer read GetCutCopyCount; +{$IFDEF VT_VCL} property DragImage: TVTDragImage read FDragImage; property DragManager: IVTDragManager read GetDragManager; +{$ENDIF} property DropTargetNode: PVirtualNode read FDropTargetNode write FDropTargetNode; property EditLink: IVTEditLink read FEditLink; property EmptyListMessage: string read FEmptyListMessage write SetEmptyListMessage; property Expanded[Node: PVirtualNode]: Boolean read GetExpanded write SetExpanded; property FocusedColumn: TColumnIndex read FFocusedColumn write SetFocusedColumn default InvalidColumn; property FocusedNode: PVirtualNode read FFocusedNode write SetFocusedNode; - property Font; + property Font{$IFDEF VT_FMX}: TFont read FFont write SetFont{$ENDIF}; property FullyVisible[Node: PVirtualNode]: Boolean read GetFullyVisible write SetFullyVisible; property HasChildren[Node: PVirtualNode]: Boolean read GetHasChildren write SetHasChildren; property Header: TVTHeader read FHeader write SetHeader; @@ -3174,11 +3496,11 @@ TBaseVirtualTree = class(TCustomControl) property IsFiltered[Node: PVirtualNode]: Boolean read GetFiltered write SetFiltered; property IsVisible[Node: PVirtualNode]: Boolean read GetVisible write SetVisible; property MultiLine[Node: PVirtualNode]: Boolean read GetMultiline write SetMultiline; - property NodeHeight[Node: PVirtualNode]: Cardinal read GetNodeHeight write SetNodeHeight; + property NodeHeight[Node: PVirtualNode]: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF} read GetNodeHeight write SetNodeHeight; property NodeParent[Node: PVirtualNode]: PVirtualNode read GetNodeParent write SetNodeParent; - property OffsetX: Integer read FOffsetX write SetOffsetX; + property OffsetX: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} read FOffsetX write SetOffsetX; property OffsetXY: TPoint read GetOffsetXY write SetOffsetXY; - property OffsetY: Integer read FOffsetY write SetOffsetY; + property OffsetY: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} read FOffsetY write SetOffsetY; property OperationCount: Cardinal read FOperationCount; property RootNode: PVirtualNode read FRoot; property SearchBuffer: string read FSearchBuffer; @@ -3193,6 +3515,24 @@ TBaseVirtualTree = class(TCustomControl) property VisiblePath[Node: PVirtualNode]: Boolean read GetVisiblePath write SetVisiblePath; property UpdateCount: Cardinal read FUpdateCount; property DoubleBuffered: Boolean read GetDoubleBuffered write SetDoubleBuffered default True; +{$IFDEF VT_FMX} + 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 [beLeft, beTop, beRight, beBottom]; + property BevelInner: TBevelCut index 0 read FBevelInner write SetBevelCut default bvRaised; + property BevelOuter: TBevelCut index 1 read FBevelOuter write SetBevelCut default bvLowered; + property BevelKind: TBevelKind read FBevelKind write SetBevelKind default bkNone; + property BevelWidth: TBevelWidth read FBevelWidth write SetBevelWidth default 1; + property BorderWidth: TBorderWidth read FBorderWidth write SetBorderWidth; + property BiDiMode: TBiDiMode read FBiDiMode write SetBiDiMode; + procedure Invalidate(); +{$IFDEF VT_FMX} + function ClientToScreen(P: TPoint): TPoint; + function ScreenToClient(P: TPoint): TPoint; + procedure RecreateWnd; +{$ENDIF} +{$ENDIF} end; @@ -3244,6 +3584,7 @@ TStringEditLink = class; TVTEdit = class(TCustomEdit) private +{$IFDEF VT_VCL} procedure CMAutoAdjust(var Message: TMessage); message CM_AUTOADJUST; procedure CMExit(var Message: TMessage); message CM_EXIT; procedure CMRelease(var Message: TMessage); message CM_RELEASE; @@ -3252,26 +3593,35 @@ TVTEdit = class(TCustomEdit) procedure WMDestroy(var Message: TWMDestroy); message WM_DESTROY; procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE; procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN; +{$ENDIF} protected FRefLink: IVTEditLink; FLink: TStringEditLink; procedure AutoAdjustSize; virtual; +{$IFDEF VT_VCL} function CalcMinHeight: Integer; virtual; procedure CreateParams(var Params: TCreateParams); override; function GetTextSize: TSize; virtual; +{$ENDIF} public constructor Create(Link: TStringEditLink); reintroduce; procedure Release; virtual; - +{$IFDEF VT_VCL} property AutoSelect; property AutoSize; property BorderStyle; +{$ENDIF} property CharCase; +{$IFDEF VT_VCL} property HideSelection; property MaxLength; property OEMConvert; property PasswordChar; +{$ENDIF} +{$IFDEF VT_FMX} + property Password; +{$ENDIF} end; TStringEditLink = class(TInterfacedObject, IVTEditLink) @@ -3289,7 +3639,7 @@ TStringEditLink = class(TInterfacedObject, IVTEditLink) constructor Create; virtual; destructor Destroy; override; property Node : PVirtualNode read FNode; // [IPK] Make FNode accessible - property Column: TColumnIndex read FColumn; // [IPK] Make Column(Index) accessible + property Column: TColumnIndex read FColumn; // [IPK] Make Column(Index) accessible function BeginEdit: Boolean; virtual; stdcall; function CancelEdit: Boolean; virtual; stdcall; @@ -3297,7 +3647,9 @@ TStringEditLink = class(TInterfacedObject, IVTEditLink) function EndEdit: Boolean; virtual; stdcall; function GetBounds: TRect; virtual; stdcall; function PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean; virtual; stdcall; +{$IFDEF VT_VCL} procedure ProcessMessage(var Message: TMessage); virtual; stdcall; +{$ENDIF} procedure SetBounds(R: TRect); virtual; stdcall; end; @@ -3327,10 +3679,10 @@ TStringEditLink = class(TInterfacedObject, IVTEditLink) TVSTNewTextEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; NewText: string) of object; TVSTShortenStringEvent = procedure(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; - Column: TColumnIndex; const S: string; TextSpace: Integer; var Result: string; + Column: TColumnIndex; const S: string; TextSpace: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; var Result: string; var Done: Boolean) of object; TVTMeasureTextEvent = procedure(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; - Column: TColumnIndex; const Text: string; var Extent: Integer) of object; + Column: TColumnIndex; const Text: string; var Extent: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}) of object; TVTDrawTextEvent = procedure(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const Text: string; const CellRect: TRect; var DefaultDraw: Boolean) of object; @@ -3374,7 +3726,9 @@ TCustomVirtualStringTree = class(TBaseVirtualTree) procedure SetDefaultText(const Value: string); procedure SetOptions(const Value: TCustomStringTreeOptions); procedure SetText(Node: PVirtualNode; Column: TColumnIndex; const Value: string); +{$IFDEF VT_VCL} procedure WMSetFont(var Msg: TWMSetFont); message WM_SETFONT; +{$ENDIF} procedure GetDataFromGrid(const AStrings : TStringList; const IncludeHeading : Boolean = True); protected FPreviouslySelected: TStringList; @@ -3383,23 +3737,23 @@ TCustomVirtualStringTree = class(TBaseVirtualTree) procedure PaintStaticText(const PaintInfo: TVTPaintInfo; TextOutFlags: Integer; const Text: string); virtual; // [IPK] - private to protected procedure AdjustPaintCellRect(var PaintInfo: TVTPaintInfo; var NextNonEmpty: TColumnIndex); override; function CanExportNode(Node: PVirtualNode): Boolean; - function CalculateStaticTextWidth(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const Text: string): Integer; virtual; - function CalculateTextWidth(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const Text: string): Integer; virtual; + function CalculateStaticTextWidth(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const Text: string): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; virtual; + function CalculateTextWidth(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const Text: string): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; virtual; function ColumnIsEmpty(Node: PVirtualNode; Column: TColumnIndex): Boolean; override; procedure DefineProperties(Filer: TFiler); override; function DoCreateEditor(Node: PVirtualNode; Column: TColumnIndex): IVTEditLink; override; function DoGetNodeHint(Node: PVirtualNode; Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle): string; override; function DoGetNodeTooltip(Node: PVirtualNode; Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle): string; override; - function DoGetNodeExtraWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): Integer; override; - function DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): Integer; override; + function DoGetNodeExtraWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; override; + function DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; override; procedure DoGetText(var pEventArgs: TVSTGetCellTextEventArgs); virtual; function DoIncrementalSearch(Node: PVirtualNode; const Text: string): Integer; override; procedure DoNewText(Node: PVirtualNode; Column: TColumnIndex; const Text: string); virtual; procedure DoPaintNode(var PaintInfo: TVTPaintInfo); override; procedure DoPaintText(Node: PVirtualNode; const Canvas: TCanvas; Column: TColumnIndex; TextType: TVSTTextType); virtual; - function DoShortenString(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const S: string; Width: Integer; - EllipsisWidth: Integer = 0): string; virtual; + function DoShortenString(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const S: string; Width: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + EllipsisWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} = 0): string; virtual; procedure DoTextDrawing(var PaintInfo: TVTPaintInfo; const Text: string; CellRect: TRect; DrawFormat: Cardinal); virtual; function DoTextMeasuring(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const Text: string): TSize; virtual; function GetOptionsClass: TTreeOptionsClass; override; @@ -3410,7 +3764,9 @@ TCustomVirtualStringTree = class(TBaseVirtualTree) function ReadChunk(Stream: TStream; Version: Integer; Node: PVirtualNode; ChunkType, ChunkSize: Integer): Boolean; override; procedure ReadOldStringOptions(Reader: TReader); +{$IFDEF VT_VCL} function RenderOLEData(const FormatEtcIn: TFormatEtc; out Medium: TStgMedium; ForClipboard: Boolean): HResult; override; +{$ENDIF} procedure SetChildCount(Node: PVirtualNode; NewChildCount: Cardinal); override; procedure WriteChunks(Stream: TStream; Node: PVirtualNode); override; @@ -3431,7 +3787,7 @@ TCustomVirtualStringTree = class(TBaseVirtualTree) constructor Create(AOwner: TComponent); override; destructor Destroy(); override; function AddChild(Parent: PVirtualNode; UserData: Pointer = nil): PVirtualNode; override; - function ComputeNodeHeight(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; S: string = ''): Integer; virtual; + function ComputeNodeHeight(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; S: string = ''): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; virtual; function ContentToClipboard(Format: Word; Source: TVSTTextSourceType): HGLOBAL; procedure ContentToCustom(Source: TVSTTextSourceType); function ContentToHTML(Source: TVSTTextSourceType; const Caption: string = ''): String; @@ -3465,10 +3821,14 @@ TVirtualStringTree = class(TCustomVirtualStringTree) property Canvas; property RangeX; +{$IFDEF VT_VCL} property LastDragEffect; +{$ENDIF} property CheckImageKind; // should no more be published to make #622 fix working published +{$IFDEF VT_VCL} property AccessibleName; +{$ENDIF} property Action; property Align; property Alignment; @@ -3494,17 +3854,25 @@ TVirtualStringTree = class(TCustomVirtualStringTree) property BorderWidth; property ChangeDelay; property ClipboardFormats; +{$IFDEF VT_VCL} property Color; +{$ENDIF} property Colors; +{$IFDEF VT_VCL} property Constraints; property Ctl3D; +{$ENDIF} property CustomCheckImages; property DefaultNodeHeight; property DefaultPasteMode; property DefaultText; +{$IFDEF VT_VCL} property DragCursor; +{$ENDIF} property DragHeight; +{$IFDEF VT_VCL} property DragKind; +{$ENDIF} property DragImageKind; property DragMode; property DragOperations; @@ -3530,10 +3898,12 @@ TVirtualStringTree = class(TCustomVirtualStringTree) property NodeAlignment; property NodeDataSize; property OperationCanceled; +{$IFDEF VT_VCL} property ParentBiDiMode; property ParentColor default False; property ParentCtl3D; property ParentFont; +{$ENDIF} property ParentShowHint; property PopupMenu; property RootNodeCount; @@ -3542,7 +3912,9 @@ TVirtualStringTree = class(TCustomVirtualStringTree) property SelectionCurveRadius; property ShowHint; property StateImages; +{$IFDEF VT_VCL} property StyleElements; +{$ENDIF} property TabOrder; property TabStop default True; property TextMargin; @@ -3596,9 +3968,13 @@ TVirtualStringTree = class(TCustomVirtualStringTree) property OnColumnWidthDblClickResize; property OnColumnWidthTracking; property OnCompareNodes; +{$IFDEF VT_VCL} property OnContextPopup; +{$ENDIF} property OnCreateDataObject; +{$IFDEF VT_VCL} property OnCreateDragManager; +{$ENDIF} property OnCreateEditor; property OnDblClick; property OnDragAllowed; @@ -3609,8 +3985,10 @@ TVirtualStringTree = class(TCustomVirtualStringTree) property OnEditCancelled; property OnEdited; property OnEditing; +{$IFDEF VT_VCL} property OnEndDock; property OnEndDrag; +{$ENDIF} property OnEndOperation; property OnEnter; property OnExit; @@ -3635,7 +4013,9 @@ TVirtualStringTree = class(TCustomVirtualStringTree) property OnGetLineStyle; property OnGetNodeDataSize; property OnGetPopupMenu; - property OnGetUserClipboardFormats; +{$IFDEF VT_VCL} + property OnGetUserClipboardFormats; +{$ENDIF} property OnHeaderAddPopupItem; property OnHeaderClick; property OnHeaderDblClick; @@ -3655,7 +4035,9 @@ TVirtualStringTree = class(TCustomVirtualStringTree) property OnInitNode; property OnKeyAction; property OnKeyDown; +{$IFDEF VT_VCL} property OnKeyPress; +{$ENDIF} property OnKeyUp; property OnLoadNode; property OnLoadTree; @@ -3681,7 +4063,9 @@ TVirtualStringTree = class(TCustomVirtualStringTree) property OnPaintBackground; property OnPrepareButtonBitmaps; property OnRemoveFromSelection; +{$IFDEF VT_VCL} property OnRenderOLEData; +{$ENDIF} property OnResetNode; property OnResize; property OnSaveNode; @@ -3690,13 +4074,17 @@ TVirtualStringTree = class(TCustomVirtualStringTree) property OnShortenString; property OnShowScrollBar; property OnBeforeGetCheckState; +{$IFDEF VT_VCL} property OnStartDock; property OnStartDrag; +{$ENDIF} property OnStartOperation; property OnStateChange; property OnStructureChange; property OnUpdating; +{$IFDEF VT_VCL} property OnCanResize; +{$ENDIF} property OnGesture; property Touch; end; @@ -3705,7 +4093,7 @@ TVirtualStringTree = class(TCustomVirtualStringTree) TVTGetCellContentMarginEvent = procedure(Sender: TBaseVirtualTree; HintCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; CellContentMarginType: TVTCellContentMarginType; var CellContentMargin: TPoint) of object; TVTGetNodeWidthEvent = procedure(Sender: TBaseVirtualTree; HintCanvas: TCanvas; Node: PVirtualNode; - Column: TColumnIndex; var NodeWidth: Integer) of object; + Column: TColumnIndex; var NodeWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}) of object; // Tree descendant to let an application draw its stuff itself. TCustomVirtualDrawTree = class(TBaseVirtualTree) @@ -3716,7 +4104,7 @@ TCustomVirtualDrawTree = class(TBaseVirtualTree) protected function DoGetCellContentMargin(Node: PVirtualNode; Column: TColumnIndex; CellContentMarginType: TVTCellContentMarginType = ccmtAllSides; Canvas: TCanvas = nil): TPoint; override; - function DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): Integer; override; + function DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; override; procedure DoPaintNode(var PaintInfo: TVTPaintInfo); override; function GetDefaultHintKind: TVTHintKind; override; @@ -3734,7 +4122,9 @@ TVirtualDrawTree = class(TCustomVirtualDrawTree) function GetOptionsClass: TTreeOptionsClass; override; public property Canvas; +{$IFDEF VT_VCL} property LastDragEffect; +{$ENDIF} property CheckImageKind; // should no more be published to make #622 fix working published property Action; @@ -3761,16 +4151,24 @@ TVirtualDrawTree = class(TCustomVirtualDrawTree) property BorderWidth; property ChangeDelay; property ClipboardFormats; +{$IFDEF VT_VCL} property Color; +{$ENDIF} property Colors; +{$IFDEF VT_VCL} property Constraints; property Ctl3D; +{$ENDIF} property CustomCheckImages; property DefaultNodeHeight; property DefaultPasteMode; +{$IFDEF VT_VCL} property DragCursor; +{$ENDIF} property DragHeight; +{$IFDEF VT_VCL} property DragKind; +{$ENDIF} property DragImageKind; property DragMode; property DragOperations; @@ -3795,10 +4193,12 @@ TVirtualDrawTree = class(TCustomVirtualDrawTree) property NodeAlignment; property NodeDataSize; property OperationCanceled; +{$IFDEF VT_VCL} property ParentBiDiMode; property ParentColor default False; property ParentCtl3D; property ParentFont; +{$ENDIF} property ParentShowHint; property PopupMenu; property RootNodeCount; @@ -3860,9 +4260,13 @@ TVirtualDrawTree = class(TCustomVirtualDrawTree) property OnColumnWidthDblClickResize; property OnColumnWidthTracking; property OnCompareNodes; +{$IFDEF VT_VCL} property OnContextPopup; +{$ENDIF} property OnCreateDataObject; +{$IFDEF VT_VCL} property OnCreateDragManager; +{$ENDIF} property OnCreateEditor; property OnDblClick; property OnDragAllowed; @@ -3872,8 +4276,10 @@ TVirtualDrawTree = class(TCustomVirtualDrawTree) property OnDrawNode; property OnEdited; property OnEditing; +{$IFDEF VT_VCL} property OnEndDock; property OnEndDrag; +{$ENDIF} property OnEndOperation; property OnEnter; property OnExit; @@ -3894,7 +4300,9 @@ TVirtualDrawTree = class(TCustomVirtualDrawTree) property OnGetNodeDataSize; property OnGetNodeWidth; property OnGetPopupMenu; +{$IFDEF VT_VCL} property OnGetUserClipboardFormats; +{$ENDIF} property OnHeaderAddPopupItem; property OnHeaderClick; property OnHeaderDblClick; @@ -3914,7 +4322,9 @@ TVirtualDrawTree = class(TCustomVirtualDrawTree) property OnInitNode; property OnKeyAction; property OnKeyDown; +{$IFDEF VT_VCL} property OnKeyPress; +{$ENDIF} property OnKeyUp; property OnLoadNode; property OnLoadTree; @@ -3935,23 +4345,31 @@ TVirtualDrawTree = class(TCustomVirtualDrawTree) property OnPaintBackground; property OnPrepareButtonBitmaps; property OnRemoveFromSelection; +{$IFDEF VT_VCL} property OnRenderOLEData; +{$ENDIF} property OnResetNode; property OnResize; property OnSaveNode; property OnSaveTree; property OnScroll; property OnShowScrollBar; +{$IFDEF VT_VCL} property OnStartDock; property OnStartDrag; +{$ENDIF} property OnStartOperation; property OnStateChange; property OnStructureChange; property OnUpdating; +{$IFDEF VT_VCL} property OnCanResize; +{$ENDIF} property OnGesture; property Touch; +{$IFDEF VT_VCL} property StyleElements; +{$ENDIF} end; @@ -3969,24 +4387,40 @@ implementation {$R VirtualTrees.res} uses +{$IFDEF VT_VCL} Vcl.Consts, +{$ENDIF} System.Math, +{$IFDEF VT_VCL} Vcl.AxCtrls, // TOLEStream Winapi.MMSystem, // for animation timer (does not include further resources) +{$ENDIF} System.TypInfo, // for migration stuff System.SyncObjs, +{$IFDEF VT_VCL} Vcl.ActnList, Vcl.StdActns, // for standard action support +{$ENDIF} System.StrUtils, +{$IFDEF VT_VCL} Vcl.GraphUtil, // accessibility helper class - VirtualTrees.AccessibilityFactory, +{$ENDIF} + //VirtualTrees.AccessibilityFactory, +{$IFDEF VT_VCL} VirtualTrees.StyleHooks, +{$ENDIF} VirtualTrees.Classes, +{$IFDEF VT_VCL} VirtualTrees.WorkerThread, VirtualTrees.ClipBoard, +{$ENDIF} VirtualTrees.Utils, VirtualTrees.Export, - VirtualTrees.HeaderPopup; + VirtualTrees.HeaderPopup +{$IFDEF VT_FMX} + ,FMX.TextLayout +{$ENDIF} +; resourcestring // Localizable strings. @@ -4009,7 +4443,7 @@ implementation // Do not modify the copyright in any way! Usage of this unit is prohibited without the copyright notice // in the compiled binary file. Copyright: string = 'Virtual Treeview © 1999, 2010, 2016 Mike Lischke, Joachim Marder'; - +{$IFDEF VT_VCL} var StandardOLEFormat: TFormatEtc = ( // Format must later be set. @@ -4023,12 +4457,146 @@ implementation // Acceptable storage formats are IStream and global memory. The first is preferred. tymed: TYMED_ISTREAM or TYMED_HGLOBAL; ); +{$ENDIF} +{$IFDEF VT_FMX} +procedure GetTextMetrics(ACanvas: TCanvas; var TM: TTextMetric); +Var P: TPathData; + tx: TTextLayout; + R: TRectF; +begin +{ + tmHeight: Single; //The height (ascent + descent) of characters. + tmAscent: Single; //The ascent (units above the base line) of characters. + tmDescent: Single; //The descent (units below the base line) of characters. + tmInternalLeading: Single; //The amount of leading (space) inside the bounds set by the tmHeight member. Accent marks and other diacritical characters may occur in this area. The designer may set this member to zero + tmExternalLeading: Single; //The amount of extra leading (space) that the application adds between rows. Since this area is outside the font, it contains no marks and is not altered by text output calls in either OPAQUE or TRANSPARENT mode. The designer may set this member to zero. + tmAveCharWidth: Single; //The average width of characters in the font (generally defined as the width of the letter x ). This value does not include the overhang required for bold or italic characters. + tmMaxCharWidth: Single; //The width of the widest character in the font. + tmWeight: Single; //The weight of the font. + tmOverhang: Single; + tmDigitizedAspectX: Single; //The horizontal aspect of the device for which the font was designed. + tmDigitizedAspectY: Single; //The vertical aspect of the device for which the font was designed. The ratio of the tmDigitizedAspectX and tmDigitizedAspectY members is the aspect ratio of the device for which the font was designed. + tmFirstChar: WideChar; //The value of the first character defined in the font. + tmLastChar: WideChar; //The value of the last character defined in the font. + tmDefaultChar: WideChar; //The value of the character to be substituted for characters not in the font. + tmBreakChar: WideChar; //The value of the character that will be used to define word breaks for text justification. + tmItalic: Byte; //Specifies an italic font if it is nonzero. + tmUnderlined: Byte; //Specifies an underlined font if it is nonzero. + tmStruckOut: Byte; //A strikeout font if it is nonzero. + tmPitchAndFamily: Byte; //Specifies information about the pitch, the technology, and the family of a physical font. TMPF_FIXED_PITCH, TMPF_VECTOR, TMPF_TRUETYPE, TMPF_DEVICE + tmCharSet: Byte; //The character set of the font. The character set can be one of the following values. ANSI_CHARSET, GREEK_CHARSET.... +} + TM.tmExternalLeading:= 0; + TM.tmWeight:= 0; //boldness??? + TM.tmOverhang:= 0; + TM.tmDigitizedAspectX:= 0; + TM.tmDigitizedAspectY:= 0; + TM.tmFirstChar:= 'a'; //??? + TM.tmLastChar:= 'z'; //??? + TM.tmDefaultChar:= ' '; + TM.tmBreakChar:= ' '; + TM.tmItalic:= 0; + TM.tmUnderlined:= 0; + TM.tmStruckOut:= 0; + TM.tmPitchAndFamily:= 0; + TM.tmCharSet:= 0; + + tx:= TTextLayoutManager.DefaultTextLayout.Create(ACanvas); + P:= TPathData.Create; + try + tx.Text:= 'W'; + tx.ConvertToPath(p); + R:= P.GetBounds(); + + TM.tmHeight:= R.Height; + TM.tmMaxCharWidth:= R.Width; + + //------------------------------------ + tx.Text:= 'Ó'; + p.Clear; + tx.ConvertToPath(p); + R:= P.GetBounds(); + TM.tmInternalLeading:= R.Height - TM.tmHeight; + + //------------------------------------ + tx.Text:= 'x'; + p.Clear; + tx.ConvertToPath(p); + R:= P.GetBounds(); + TM.tmAscent:= R.Height - TM.tmHeight; + TM.tmAveCharWidth:= R.Width; + + //------------------------------------ + tx.Text:= 'y'; + p.Clear; + tx.ConvertToPath(p); + TM.tmDescent:= P.GetBounds().Height - R.Height; + TM.tmHeight:= TM.tmHeight + TM.tmDescent; + finally + FreeAndNil(P); + FreeAndNil(tx); + end; +end; + +function Rect(ALeft, ATop, ARight, ABottom: Single): TRect; +begin + Result:= RectF(ALeft, ATop, ARight, ABottom); +end; + +function Rect(const ATopLeft, ABottomRight: TPoint): TRect; +begin + Result:= RectF(ATopLeft.X, ATopLeft.Y, ABottomRight.X, ABottomRight.Y); +end; + +function Point(AX, AY: Single): TPoint; +begin + Result.X:= AX; + Result.Y:= AY; +end; + +procedure Inc(Var V: Single; OIle: Single=1.0); +begin + V:= V + OIle; +end; + +procedure Dec(Var V: Single; OIle: Single=1.0); +begin + V:= V - OIle; +end; + +function MulDiv(const A, B, C: Single): Single; +begin + Result:= (A * B) / C; +end; + +procedure FillMemory(Destination: Pointer; Length: NativeUInt; Fill: Byte); +begin + FillChar(Destination^, Length, Fill); +end; + +procedure ZeroMemory(Destination: Pointer; Length: NativeUInt); +begin + FillChar(Destination^, Length, 0); +end; + +procedure MoveMemory(Destination: Pointer; Source: Pointer; Length: NativeUInt); +begin + Move(Source^, Destination^, Length); +end; + +procedure CopyMemory(Destination: Pointer; Source: Pointer; Length: NativeUInt); +begin + Move(Source^, Destination^, Length); +end; + +{$ENDIF} + type // protection against TRect record method that cause problems with with-statements TWithSafeRect = record case Integer of - 0: (Left, Top, Right, Bottom: Integer); + 0: (Left, Top, Right, Bottom: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); 1: (TopLeft, BottomRight: TPoint); end; @@ -4042,8 +4610,8 @@ TChunkHeader = record // base information about a node TBaseChunkBody = packed record - ChildCount, - NodeHeight: Cardinal; + ChildCount: Cardinal; + NodeHeight: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; States: TVirtualNodeStates; Align: Byte; CheckState: TCheckState; @@ -4065,9 +4633,13 @@ TChunkHeader = record // Internally used data for animations. TToggleAnimationData = record +{$IFDEF VT_FMX} + Canvas: TCanvas; +{$ELSE} Window: HWND; // copy of the tree's window handle DC: HDC; // the DC of the window to erase uncovered parts - Brush: HBRUSH; // the brush to be used to erase uncovered parts +{$ENDIF} + Brush: {$IFDEF VT_FMX}TBrush{$ELSE}HBRUSH{$ENDIF}; // the brush to be used to erase uncovered parts R1, R2: TRect; // animation rectangles Mode1, @@ -4087,8 +4659,9 @@ TCanvasEx = class(TCanvas); // this chunk is immediately followed by all child nodes CaptionChunk = 3; // used by the string tree to store a node's caption UserChunk = 4; // used for data supplied by the application - +{$IFDEF VT_VCL} RTLFlag: array[Boolean] of Integer = (0, ETO_RTLREADING); +{$ENDIF} AlignmentToDrawFlag: array[TAlignment] of Cardinal = (DT_LEFT, DT_RIGHT, DT_CENTER); WideCR = Char(#13); @@ -4111,7 +4684,7 @@ TCanvasEx = class(TCanvas); function GetUtilityImages: TCustomImageList; // [IPK] begin - Result := UtilityImages; + Result := UtilityImages; end; //---------------------------------------------------------------------------------------------------------------------- @@ -4156,16 +4729,16 @@ procedure QuickSort(const TheArray: TNodeArray; L, R: Integer); P := TheArray[(L + R) shr 1]; repeat while PAnsiChar(TheArray[I]) < PAnsiChar(P) do - Inc(I); + System.Inc(I); while PAnsiChar(TheArray[J]) > PAnsiChar(P) do - Dec(J); + System.Dec(J); if I <= J then begin T := TheArray[I]; TheArray[I] := TheArray[J]; TheArray[J] := T; - Inc(I); - Dec(J); + System.Inc(I); + System.Dec(J); end; until I > J; if L < J then @@ -4184,6 +4757,7 @@ procedure QuickSort(const TheArray: TNodeArray; L, R: Integer); Grays: array[0..3] of TColor = (clWhite, clSilver, clGray, clBlack); SysGrays: array[0..3] of TColor = (clWindow, clBtnFace, clBtnShadow, clBtnText); +{$IFDEF VT_VCL} procedure ConvertImageList(IL: TImageList; const ImageName: string; ColorRemapping: Boolean = True); // Loads a bunch of images given by ImageName into IL. If ColorRemapping = True then a mapping of gray values to @@ -4234,9 +4808,10 @@ procedure ConvertImageList(IL: TImageList; const ImageName: string; ColorRemappi gWatcher.Leave(); end; end; +{$ENDIF} //---------------------------------------------------------------------------------------------------------------------- - +{$IFDEF VT_VCL} procedure CreateSystemImageSet(Handle: HWND; var IL: TImageList; Flags: Cardinal; Flat: Boolean); // Creates a system check image set. @@ -4357,6 +4932,7 @@ procedure CreateSystemImageSet(Handle: HWND; var IL: TImageList; Flags: Cardinal BM.Free; end; end; +{$ENDIF} //---------------------------------------------------------------------------------------------------------------------- @@ -4372,7 +4948,7 @@ procedure InitializeGlobalStructures(); Flags: Cardinal; begin - if (gInitialized > 0) or (InterlockedIncrement(gInitialized) <> 1) then // Ensure threadsafe that this code is executed only once + if (gInitialized > 0) or ({$IFDEF VT_FMX}AtomicIncrement{$ELSE}InterlockedIncrement{$ENDIF}(gInitialized) <> 1) then // Ensure threadsafe that this code is executed only once exit; // This watcher is used whenever a global structure could be modified by more than one thread. @@ -4381,15 +4957,16 @@ procedure InitializeGlobalStructures(); IsWinVistaOrAbove := (Win32MajorVersion >= 6); // Initialize OLE subsystem for drag'n drop and clipboard operations. - NeedToUnitialize := not IsLibrary and Succeeded(OleInitialize(nil)); + NeedToUnitialize := {$IFDEF VT_FMX}false{$ELSE}not IsLibrary and Succeeded(OleInitialize(nil)){$ENDIF}; // Register the tree reference clipboard format. Others will be handled in InternalClipboarFormats. - CF_VTREFERENCE := RegisterClipboardFormat(CFSTR_VTREFERENCE); + CF_VTREFERENCE := {$IFDEF VT_FMX}0{$ELSE}RegisterClipboardFormat(CFSTR_VTREFERENCE){$ENDIF}; // Load all internal image lists and convert their colors to current desktop color scheme. // In order to use high color images we have to create the image list handle ourselves. - Flags := ILC_COLOR32 or ILC_MASK; + Flags := {$IFDEF VT_FMX}0{$ELSE}ILC_COLOR32 or ILC_MASK{$ENDIF}; +{$IFDEF VT_VCL} NodeImages := TImageList.CreateSize(16, 16); with NodeImages do Handle := ImageList_Create(16, 16, Flags, 0, AllocBy); @@ -4401,25 +4978,29 @@ procedure InitializeGlobalStructures(); ConvertImageList(UtilityImages, 'VT_UTILITIES'); CreateSystemImageSet(0, SystemCheckImages, Flags, False); +{$ENDIF} // Delphi (at least version 6 and lower) does not provide a standard split cursor. // Hence we have to load our own. +{$IFDEF VT_VCL} Screen.Cursors[crHeaderSplit] := LoadCursor(HInstance, 'VT_HEADERSPLIT'); Screen.Cursors[crVertSplit] := LoadCursor(HInstance, 'VT_VERTSPLIT'); - +{$ENDIF} // Clipboard format registration. // Native clipboard format. Needs a new identifier and has an average priority to allow other formats to take over. // This format is supposed to use the IStream storage format but unfortunately this does not work when // OLEFlushClipboard is used. Hence it is disabled until somebody finds a solution. - CF_VIRTUALTREE := RegisterVTClipboardFormat(CFSTR_VIRTUALTREE, TBaseVirtualTree, 50, TYMED_HGLOBAL {or TYMED_ISTREAM}); + CF_VIRTUALTREE := {$IFDEF VT_FMX}0{$ELSE}RegisterVTClipboardFormat(CFSTR_VIRTUALTREE, TBaseVirtualTree, 50, TYMED_HGLOBAL {or TYMED_ISTREAM}){$ENDIF}; // Specialized string tree formats. - CF_HTML := RegisterVTClipboardFormat(CFSTR_HTML, TCustomVirtualStringTree, 80); - CF_VRTFNOOBJS := RegisterVTClipboardFormat(CFSTR_RTFNOOBJS, TCustomVirtualStringTree, 84); - CF_VRTF := RegisterVTClipboardFormat(CFSTR_RTF, TCustomVirtualStringTree, 85); - CF_CSV := RegisterVTClipboardFormat(CFSTR_CSV, TCustomVirtualStringTree, 90); + CF_HTML := {$IFDEF VT_FMX}0{$ELSE}RegisterVTClipboardFormat(CFSTR_HTML, TCustomVirtualStringTree, 80){$ENDIF}; + CF_VRTFNOOBJS := {$IFDEF VT_FMX}0{$ELSE}RegisterVTClipboardFormat(CFSTR_RTFNOOBJS, TCustomVirtualStringTree, 84){$ENDIF}; + CF_VRTF := {$IFDEF VT_FMX}0{$ELSE}RegisterVTClipboardFormat(CFSTR_RTF, TCustomVirtualStringTree, 85){$ENDIF}; + CF_CSV := {$IFDEF VT_FMX}0{$ELSE}RegisterVTClipboardFormat(CFSTR_CSV, TCustomVirtualStringTree, 90){$ENDIF}; // Predefined clipboard formats. Just add them to the internal list. +{$IFDEF VT_VCL} RegisterVTClipboardFormat(CF_TEXT, TCustomVirtualStringTree, 100); RegisterVTClipboardFormat(CF_UNICODETEXT, TCustomVirtualStringTree, 95); +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -4437,8 +5018,10 @@ procedure FinalizeGlobalStructures(); FreeAndNil(UtilityImages); FreeAndNil(SystemCheckImages); +{$IFDEF VT_VCL} if NeedToUnitialize then OleUninitialize; +{$ENDIF} // If VT is used in a package and its special hint window was used then the last instance of this // window is not freed correctly (bug in the VCL). We explicitely tell the application to free it @@ -4523,12 +5106,14 @@ procedure TCustomVirtualTreeOptions.SetMiscOptions(const Value: TVTMiscOptions); if not (csDesigning in ComponentState) then begin +{$IFDEF VT_VCL} if toAcceptOLEDrop in ToBeCleared then RevokeDragDrop(Handle); if toFullRepaintOnResize in ToBeSet + ToBeCleared then RecreateWnd; if toAcceptOLEDrop in ToBeSet then RegisterDragDrop(Handle, DragManager as IDropTarget); +{$ENDIF} if toVariableNodeHeight in ToBeSet then begin BeginUpdate(); try @@ -4581,9 +5166,9 @@ procedure TCustomVirtualTreeOptions.SetPaintOptions(const Value: TVTPaintOptions if FullyVisible[Run] then begin if toShowFilteredNodes in ToBeSet then - Inc(FVisibleCount) + System.Inc(FVisibleCount) else - Dec(FVisibleCount); + System.Dec(FVisibleCount); end; if toShowFilteredNodes in ToBeSet then AdjustTotalHeight(Run, Run.NodeHeight, True) @@ -4599,9 +5184,10 @@ procedure TCustomVirtualTreeOptions.SetPaintOptions(const Value: TVTPaintOptions if HandleAllocated then begin if IsWinVistaOrAbove and ((tsUseThemes in FStates) or - ((toThemeAware in ToBeSet) and StyleServices.Enabled)) and + ((toThemeAware in ToBeSet) {$IFDEF VT_VCL}and StyleServices.Enabled{$ENDIF})) and (toUseExplorerTheme in (ToBeSet + ToBeCleared)) and not VclStyleEnabled then begin +{$IFDEF VT_VCL} if (toUseExplorerTheme in ToBeSet) then begin SetWindowTheme('explorer'); @@ -4613,20 +5199,21 @@ procedure TCustomVirtualTreeOptions.SetPaintOptions(const Value: TVTPaintOptions SetWindowTheme(''); DoStateChange([], [tsUseExplorerTheme]); end; +{$ENDIF} end; if not (csLoading in ComponentState) then begin if ((toThemeAware in ToBeSet + ToBeCleared) or (toUseExplorerTheme in ToBeSet + ToBeCleared) or VclStyleEnabled) then begin - if ((toThemeAware in ToBeSet) and StyleServices.Enabled) then + if ((toThemeAware in ToBeSet) {$IFDEF VT_VCL}and StyleServices.Enabled{$ENDIF}) then DoStateChange([tsUseThemes]) else if (toThemeAware in ToBeCleared) then DoStateChange([], [tsUseThemes]); PrepareBitmaps(True, False); - RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_VALIDATE or RDW_FRAME); + {$IFDEF VT_FMX}Repaint{$ELSE}RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_VALIDATE or RDW_FRAME){$ENDIF}; end; if toChildrenAbove in ToBeSet + ToBeCleared then @@ -4706,7 +5293,7 @@ procedure TCustomVirtualTreeOptions.AssignTo(Dest: TPersistent); // of DD'ing various kinds of virtual data and works also between applications. //----------------- TEnumFormatEtc ------------------------------------------------------------------------------------- - +{$IFDEF VT_VCL} constructor TEnumFormatEtc.Create(Tree: TBaseVirtualTree; const AFormatEtcArray: TFormatEtcArray); var @@ -6272,6 +6859,7 @@ function TVTDragImage.WillMove(P: TPoint): Boolean; end; end; end; +{$ENDIF} //----------------- TVTVirtualNodeEnumerator --------------------------------------------------------------------------- @@ -6411,6 +6999,7 @@ function TVTVirtualNodeEnumeration.GetNext(Node: PVirtualNode): PVirtualNode; constructor TVirtualTreeColumn.Create(Collection: TCollection); begin + FWidth:= 50; FMinWidth := 10; FMaxWidth := 10000; FImageIndex := -1; @@ -6457,7 +7046,7 @@ destructor TVirtualTreeColumn.Destroy; ColumnIndex := NoColumn else if Index < ColumnIndex then - Dec(ColumnIndex); + System.Dec(ColumnIndex); end; //--------------- end local function ----------------------------------------- @@ -6513,7 +7102,7 @@ function TVirtualTreeColumn.GetCaptionAlignment: TAlignment; //---------------------------------------------------------------------------------------------------------------------- -function TVirtualTreeColumn.GetLeft: Integer; +function TVirtualTreeColumn.GetLeft: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; begin Result := FLeft; @@ -6676,7 +7265,7 @@ procedure TVirtualTreeColumn.SetLayout(Value: TVTHeaderColumnLayout); //---------------------------------------------------------------------------------------------------------------------- -procedure TVirtualTreeColumn.SetMargin(Value: Integer); +procedure TVirtualTreeColumn.SetMargin(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); begin // Compatibility setting for -1. @@ -6691,7 +7280,7 @@ procedure TVirtualTreeColumn.SetMargin(Value: Integer); //---------------------------------------------------------------------------------------------------------------------- -procedure TVirtualTreeColumn.SetMaxWidth(Value: Integer); +procedure TVirtualTreeColumn.SetMaxWidth(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); begin if Value < FMinWidth then @@ -6702,7 +7291,7 @@ procedure TVirtualTreeColumn.SetMaxWidth(Value: Integer); //---------------------------------------------------------------------------------------------------------------------- -procedure TVirtualTreeColumn.SetMinWidth(Value: Integer); +procedure TVirtualTreeColumn.SetMinWidth(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); begin if Value < 0 then @@ -6748,11 +7337,11 @@ procedure TVirtualTreeColumn.SetOptions(Value: TVTColumnOptions); Changed(False); // Need to repaint and adjust the owner tree too. lTreeView := Owner.Header.Treeview; - if not (csLoading in lTreeview.ComponentState) and (VisibleChanged or ColorChanged) and (Owner.UpdateCount = 0) and - lTreeView.HandleAllocated then + if not (csLoading in lTreeview.ComponentState) and ({$IFDEF VT_VCL}VisibleChanged or{$ENDIF} ColorChanged) and (Owner.UpdateCount = 0) + and lTreeView.HandleAllocated then begin lTreeview.Invalidate(); - if VisibleChanged then begin + if {$IFDEF VT_FMX}true{$ELSE}VisibleChanged {$ENDIF}then begin lTreeview.DoColumnVisibilityChanged(Self.Index, coVisible in ToBeSet); lTreeview.UpdateHorizontalScrollBar(False); end; @@ -6815,7 +7404,7 @@ procedure TVirtualTreeColumn.SetPosition(Value: TColumnPosition); //---------------------------------------------------------------------------------------------------------------------- -procedure TVirtualTreeColumn.SetSpacing(Value: Integer); +procedure TVirtualTreeColumn.SetSpacing(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); begin if FSpacing <> Value then @@ -6852,13 +7441,13 @@ procedure TVirtualTreeColumn.SetText(const Value: string); //---------------------------------------------------------------------------------------------------------------------- -procedure TVirtualTreeColumn.SetWidth(Value: Integer); +procedure TVirtualTreeColumn.SetWidth(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); var EffectiveMaxWidth, EffectiveMinWidth, TotalFixedMaxWidth, - TotalFixedMinWidth: Integer; + TotalFixedMinWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; I: TColumnIndex; begin @@ -6878,18 +7467,18 @@ procedure TVirtualTreeColumn.SetWidth(Value: Integer); // The percentage values have precedence over the pixel values. If FMaxWidthPercent > 0 then - TotalFixedMinWidth:= Min((ClientWidth * FMaxWidthPercent) div 100, TotalFixedMinWidth); + TotalFixedMinWidth:= Min((ClientWidth * FMaxWidthPercent) {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 100, TotalFixedMinWidth); If FMinWidthPercent > 0 then - TotalFixedMaxWidth := Max((ClientWidth * FMinWidthPercent) div 100, TotalFixedMaxWidth); + TotalFixedMaxWidth := Max((ClientWidth * FMinWidthPercent) {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 100, TotalFixedMaxWidth); EffectiveMaxWidth := Min(TotalFixedMaxWidth - (GetVisibleFixedWidth - Self.FWidth), FMaxWidth); EffectiveMinWidth := Max(TotalFixedMinWidth - (GetVisibleFixedWidth - Self.FWidth), FMinWidth); Value := Min(Max(Value, EffectiveMinWidth), EffectiveMaxWidth); if FMinWidthPercent > 0 then - Value := Max((ClientWidth * FMinWidthPercent) div 100 - GetVisibleFixedWidth + Self.FWidth, Value); + Value := Max((ClientWidth * FMinWidthPercent) {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 100 - GetVisibleFixedWidth + Self.FWidth, Value); if FMaxWidthPercent > 0 then - Value := Min((ClientWidth * FMaxWidthPercent) div 100 - GetVisibleFixedWidth + Self.FWidth, Value); + Value := Min((ClientWidth * FMaxWidthPercent) {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 100 - GetVisibleFixedWidth + Self.FWidth, Value); end; end else @@ -6916,8 +7505,8 @@ procedure TVirtualTreeColumn.SetWidth(Value: Integer); //---------------------------------------------------------------------------------------------------------------------- -procedure TVirtualTreeColumn.ComputeHeaderLayout(DC: HDC; Client: TRect; UseHeaderGlyph, UseSortGlyph: Boolean; - var HeaderGlyphPos, SortGlyphPos: TPoint; var SortGlyphSize: TSize; var TextBounds: TRect; DrawFormat: Cardinal; +procedure TVirtualTreeColumn.ComputeHeaderLayout({$IFDEF VT_FMX}ACanvas: TCanvas{$ELSE}DC: HDC{$ENDIF}; Client: TRect; UseHeaderGlyph, UseSortGlyph: Boolean; + var HeaderGlyphPos, SortGlyphPos: TPoint; var SortGlyphSize: TSizeF; var TextBounds: TRect; DrawFormat: Cardinal; CalculateTextRect: Boolean = False); // The layout of a column header is determined by a lot of factors. This method takes them all into account and @@ -6934,11 +7523,12 @@ procedure TVirtualTreeColumn.ComputeHeaderLayout(DC: HDC; Client: TRect; UseHead CurrentAlignment: TAlignment; MinLeft, MaxRight, - TextSpacing: Integer; + TextSpacing: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; UseText: Boolean; R: TRect; +{$IFDEF VT_VCL} Theme: HTHEME; - +{$ENDIF} begin UseText := Length(FText) > 0; // If nothing is to show then don't waste time with useless preparation. @@ -6946,8 +7536,10 @@ procedure TVirtualTreeColumn.ComputeHeaderLayout(DC: HDC; Client: TRect; UseHead Exit; CurrentAlignment := CaptionAlignment; +{$IFDEF VT_VCL} if FBiDiMode <> bdLeftToRight then ChangeBiDiModeAlignment(CurrentAlignment); +{$ENDIF} // Calculate sizes of the involved items. ClientSize := Point(Client.Right - Client.Left, Client.Bottom - Client.Top); @@ -6955,17 +7547,18 @@ procedure TVirtualTreeColumn.ComputeHeaderLayout(DC: HDC; Client: TRect; UseHead begin if UseHeaderGlyph then if not FCheckBox then - HeaderGlyphSize := Point(FImages.Width, FImages.Height) + HeaderGlyphSize := {$IFDEF VT_FMX}PointF(16, 16){$ELSE}Point(FImages.Width, FImages.Height){$ENDIF} //TODO: 16px Image! else with Self.Owner.Header.Treeview do begin if Assigned(FCheckImages) then - HeaderGlyphSize := Point(FCheckImages.Width, FCheckImages.Height); + HeaderGlyphSize := {$IFDEF VT_FMX}PointF(16, 16){$ELSE}Point(FCheckImages.Width, FCheckImages.Height){$ENDIF}; //TODO: 16px Image! end else HeaderGlyphSize := Point(0, 0); if UseSortGlyph then begin +{$IFDEF VT_VCL} if tsUseExplorerTheme in FHeader.Treeview.FStates then begin R := Rect(0, 0, 100, 100); @@ -6974,13 +7567,14 @@ procedure TVirtualTreeColumn.ComputeHeaderLayout(DC: HDC; Client: TRect; UseHead CloseThemeData(Theme); end else +{$ENDIF} begin - SortGlyphSize.cx := UtilityImages.Width; - SortGlyphSize.cy := UtilityImages.Height; + SortGlyphSize.cx := {$IFDEF VT_FMX}16{$ELSE}UtilityImages.Width{$ENDIF};//TODO: 16px Image! + SortGlyphSize.cy := {$IFDEF VT_FMX}16{$ELSE}UtilityImages.Height{$ENDIF};//TODO: 16px Image! end; // In any case, the sort glyph is vertically centered. - SortGlyphPos.Y := (ClientSize.Y - SortGlyphSize.cy) div 2; + SortGlyphPos.Y := (ClientSize.Y - SortGlyphSize.cy) {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2; end else begin @@ -6994,7 +7588,7 @@ procedure TVirtualTreeColumn.ComputeHeaderLayout(DC: HDC; Client: TRect; UseHead if not (coWrapCaption in FOptions) then begin FCaptionText := FText; - GetTextExtentPoint32W(DC, PWideChar(FText), Length(FText), TextSize); + GetTextExtentPoint32W({$IFDEF VT_FMX}ACanvas{$ELSE}DC{$ENDIF}, {$IFDEF VT_VCL}PWideChar{$ENDIF}(FText), Length(FText), TextSize); Inc(TextSize.cx, 2); TextBounds := Rect(0, 0, TextSize.cx, TextSize.cy); end @@ -7002,9 +7596,9 @@ procedure TVirtualTreeColumn.ComputeHeaderLayout(DC: HDC; Client: TRect; UseHead begin R := Client; if FCaptionText = '' then - FCaptionText := WrapString(DC, FText, R, DT_RTLREADING and DrawFormat <> 0, DrawFormat); + FCaptionText := WrapString({$IFDEF VT_FMX}ACanvas{$ELSE}DC{$ENDIF}, FText, R, {$IFDEF VT_FMX}false{$ELSE}DT_RTLREADING and DrawFormat <> 0{$ENDIF}, DrawFormat); - GetStringDrawRect(DC, FCaptionText, R, DrawFormat); + GetStringDrawRect({$IFDEF VT_FMX}ACanvas{$ELSE}DC{$ENDIF}, FCaptionText, R, DrawFormat); TextSize.cx := Client.Right - Client.Left; TextSize.cy := R.Bottom - R.Top; TextBounds := Rect(0, 0, TextSize.cx, TextSize.cy); @@ -7022,29 +7616,29 @@ procedure TVirtualTreeColumn.ComputeHeaderLayout(DC: HDC; Client: TRect; UseHead if UseSortGlyph and not (UseText or UseHeaderGlyph) then begin // Center the sort glyph in the available area if nothing else is there. - SortGlyphPos := Point((ClientSize.X - SortGlyphSize.cx) div 2, (ClientSize.Y - SortGlyphSize.cy) div 2); + SortGlyphPos := Point((ClientSize.X - SortGlyphSize.cx) {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2, (ClientSize.Y - SortGlyphSize.cy) {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2); end else begin // Determine extents of text and glyph and calculate positions which are clear from the layout. if (Layout in [blGlyphLeft, blGlyphRight]) or not UseHeaderGlyph then begin - HeaderGlyphPos.Y := (ClientSize.Y - HeaderGlyphSize.Y) div 2; + HeaderGlyphPos.Y := (ClientSize.Y - HeaderGlyphSize.Y) {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2; // If the text is taller than the given height, perform no vertical centration as this // would make the text even less readable. //Using Max() fixes badly positioned text if Extra Large fonts have been activated in the Windows display options - TextPos.Y := Max(-5, (ClientSize.Y - TextSize.cy) div 2); + TextPos.Y := Max(-5, (ClientSize.Y - TextSize.cy) {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2); end else begin if Layout = blGlyphTop then begin - HeaderGlyphPos.Y := (ClientSize.Y - HeaderGlyphSize.Y - TextSize.cy - TextSpacing) div 2; + HeaderGlyphPos.Y := (ClientSize.Y - HeaderGlyphSize.Y - TextSize.cy - TextSpacing) {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2; TextPos.Y := HeaderGlyphPos.Y + HeaderGlyphSize.Y + TextSpacing; end else begin - TextPos.Y := (ClientSize.Y - HeaderGlyphSize.Y - TextSize.cy - TextSpacing) div 2; + TextPos.Y := (ClientSize.Y - HeaderGlyphSize.Y - TextSize.cy - TextSpacing) {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2; HeaderGlyphPos.Y := TextPos.Y + TextSize.cy + TextSpacing; end; end; @@ -7067,7 +7661,7 @@ procedure TVirtualTreeColumn.ComputeHeaderLayout(DC: HDC; Client: TRect; UseHead TextPos.X := MinLeft; if UseHeaderGlyph then begin - HeaderGlyphPos.X := (ClientSize.X - HeaderGlyphSize.X) div 2; + HeaderGlyphPos.X := (ClientSize.X - HeaderGlyphSize.X) {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2; if HeaderGlyphPos.X < MinLeft then HeaderGlyphPos.X := MinLeft; MinLeft := Max(TextPos.X + TextSize.cx + TextSpacing, HeaderGlyphPos.X + HeaderGlyphSize.X + FSpacing); @@ -7099,14 +7693,14 @@ procedure TVirtualTreeColumn.ComputeHeaderLayout(DC: HDC; Client: TRect; UseHead begin if Layout in [blGlyphTop, blGlyphBottom] then begin - HeaderGlyphPos.X := (ClientSize.X - HeaderGlyphSize.X) div 2; - TextPos.X := (ClientSize.X - TextSize.cx) div 2; + HeaderGlyphPos.X := (ClientSize.X - HeaderGlyphSize.X) {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2; + TextPos.X := (ClientSize.X - TextSize.cx) {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2; if UseSortGlyph then - Dec(TextPos.X, SortGlyphSize.cx div 2); + Dec(TextPos.X, SortGlyphSize.cx {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2); end else begin - MinLeft := (ClientSize.X - HeaderGlyphSize.X - TextSpacing - TextSize.cx) div 2; + MinLeft := (ClientSize.X - HeaderGlyphSize.X - TextSpacing - TextSize.cx) {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2; if UseHeaderGlyph and (Layout = blGlyphLeft) then begin HeaderGlyphPos.X := MinLeft; @@ -7155,7 +7749,7 @@ procedure TVirtualTreeColumn.ComputeHeaderLayout(DC: HDC; Client: TRect; UseHead TextPos.X := MaxRight - TextSize.cx; if UseHeaderGlyph then begin - HeaderGlyphPos.X := (ClientSize.X - HeaderGlyphSize.X) div 2; + HeaderGlyphPos.X := (ClientSize.X - HeaderGlyphSize.X) {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2; if HeaderGlyphPos.X + HeaderGlyphSize.X + FSpacing > MaxRight then HeaderGlyphPos.X := MaxRight - HeaderGlyphSize.X - FSpacing; MaxRight := Min(TextPos.X - TextSpacing, HeaderGlyphPos.X - FSpacing); @@ -7246,8 +7840,8 @@ procedure TVirtualTreeColumn.ComputeHeaderLayout(DC: HDC; Client: TRect; UseHead begin // Wrap the column caption if necessary. R := TextBounds; - FCaptionText := WrapString(DC, FText, R, DT_RTLREADING and DrawFormat <> 0, DrawFormat); - GetStringDrawRect(DC, FCaptionText, R, DrawFormat); + FCaptionText := WrapString({$IFDEF VT_FMX}ACanvas{$ELSE}DC{$ENDIF}, FText, R, {$IFDEF VT_FMX}false{$ELSE}DT_RTLREADING and DrawFormat <> 0{$ENDIF}, DrawFormat); + GetStringDrawRect({$IFDEF VT_FMX}ACanvas{$ELSE}DC{$ENDIF}, FCaptionText, R, DrawFormat); end; end; end; @@ -7266,7 +7860,7 @@ procedure TVirtualTreeColumn.DefineProperties(Filer: TFiler); //---------------------------------------------------------------------------------------------------------------------- -procedure TVirtualTreeColumn.GetAbsoluteBounds(var Left, Right: Integer); +procedure TVirtualTreeColumn.GetAbsoluteBounds(var Left, Right: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); // Returns the column's left and right bounds in header coordinates, that is, independant of the scrolling position. @@ -7292,7 +7886,7 @@ function TVirtualTreeColumn.GetDisplayName: string; begin if Ord(FText[I]) > 255 then Break; - Inc(I); + System.Inc(I); end; if I > Length(FText) then @@ -7510,11 +8104,13 @@ procedure TVirtualTreeColumn.ParentBiDiModeChanged; if coParentBiDiMode in FOptions then begin Columns := GetOwner as TVirtualTreeColumns; +{$IFDEF VT_VCL} if Assigned(Columns) and (FBiDiMode <> Columns.FHeader.Treeview.BiDiMode) then begin FBiDiMode := Columns.FHeader.Treeview.BiDiMode; Changed(False); end; +{$ENDIF} end; end; @@ -7529,9 +8125,9 @@ procedure TVirtualTreeColumn.ParentColorChanged; if coParentColor in FOptions then begin Columns := GetOwner as TVirtualTreeColumns; - if Assigned(Columns) and (FColor <> Columns.FHeader.Treeview.Color) then + if Assigned(Columns) and (FColor <> Columns.FHeader.Treeview.{$IFDEF VT_FMX}Fill.{$ENDIF}Color) then begin - FColor := Columns.FHeader.Treeview.Color; + FColor := Columns.FHeader.Treeview.{$IFDEF VT_FMX}Fill.{$ENDIF}Color; Changed(False); end; end; @@ -7619,8 +8215,9 @@ constructor TVirtualTreeColumns.Create(AOwner: TVTHeader); inherited Create(ColumnClass); FHeaderBitmap := TBitmap.Create; +{$IFDEF VT_VCL} FHeaderBitmap.PixelFormat := pf32Bit; - +{$ENDIF} FHoverIndex := NoColumn; FDownIndex := NoColumn; FClickIndex := NoColumn; @@ -7704,10 +8301,9 @@ procedure TVirtualTreeColumns.AdjustAutoSize(CurrentIndex: TColumnIndex; Force: // CurrentIndex (if not InvalidColumn) describes which column has just been resized. var - NewValue, AutoIndex, - Index, - RestWidth: Integer; + Index: Integer; + NewValue, RestWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; WasUpdating: Boolean; begin if Count > 0 then @@ -7835,46 +8431,75 @@ procedure TVirtualTreeColumns.DoCanSplitterResize(P: TPoint; Column: TColumnInde //---------------------------------------------------------------------------------------------------------------------- -procedure TVirtualTreeColumns.DrawButtonText(DC: HDC; Caption: string; Bounds: TRect; Enabled, Hot: Boolean; +procedure TVirtualTreeColumns.DrawButtonText({$IFDEF VT_FMX}ACanvas: TCanvas{$ELSE}DC: HDC{$ENDIF}; Caption: string; Bounds: TRect; Enabled, Hot: Boolean; DrawFormat: Cardinal; WrapCaption: Boolean); var - TextSpace: Integer; + TextSpace: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; Size: TSize; begin if not WrapCaption then begin // Do we need to shorten the caption due to limited space? - GetTextExtentPoint32W(DC, PWideChar(Caption), Length(Caption), Size); + GetTextExtentPoint32W({$IFDEF VT_FMX}ACanvas{$ELSE}DC{$ENDIF}, {$IFDEF VT_VCL}PWideChar{$ENDIF}(Caption), Length(Caption), Size); TextSpace := Bounds.Right - Bounds.Left; if TextSpace < Size.cx then - Caption := ShortenString(DC, Caption, TextSpace); + Caption := ShortenString({$IFDEF VT_FMX}ACanvas{$ELSE}DC{$ENDIF}, Caption, TextSpace); end; - +{$IFDEF VT_VCL} SetBkMode(DC, TRANSPARENT); +{$ENDIF} if not Enabled then if FHeader.Treeview.VclStyleEnabled then begin +{$IFDEF VT_FMX} + ACanvas.Fill.Color:= FHeader.Treeview.FColors.HeaderFontColor; + DrawTextW(ACanvas, Caption, Length(Caption), Bounds, DrawFormat); +{$ELSE} SetTextColor(DC, ColorToRGB(FHeader.Treeview.FColors.HeaderFontColor)); - Winapi.Windows.DrawTextW(DC, PWideChar(Caption), Length(Caption), Bounds, DrawFormat); + Winapi.Windows.DrawTextW(DC, PWideChar(Caption), Length(Caption), Bounds, DrawFormat); +{$ENDIF} end else begin OffsetRect(Bounds, 1, 1); +{$IFDEF VT_FMX} + ACanvas.Fill.Color:= clBtnHighlight; + DrawTextW(ACanvas, Caption, Length(Caption), Bounds, DrawFormat); +{$ELSE} SetTextColor(DC, ColorToRGB(clBtnHighlight)); Winapi.Windows.DrawTextW(DC, PWideChar(Caption), Length(Caption), Bounds, DrawFormat); +{$ENDIF} OffsetRect(Bounds, -1, -1); +{$IFDEF VT_FMX} + ACanvas.Fill.Color:= clBtnShadow; + DrawTextW(ACanvas, Caption, Length(Caption), Bounds, DrawFormat); +{$ELSE} SetTextColor(DC, ColorToRGB(clBtnShadow)); Winapi.Windows.DrawTextW(DC, PWideChar(Caption), Length(Caption), Bounds, DrawFormat); +{$ENDIF} end else begin if Hot then +{$IFDEF VT_FMX} + ACanvas.Fill.Color:= FHeader.Treeview.FColors.HeaderHotColor +{$ELSE} SetTextColor(DC, ColorToRGB(FHeader.Treeview.FColors.HeaderHotColor)) +{$ENDIF} else +{$IFDEF VT_FMX} + ACanvas.Fill.Color:= FHeader.Treeview.FColors.HeaderFontColor; +{$ELSE} SetTextColor(DC, ColorToRGB(FHeader.Treeview.FColors.HeaderFontColor)); +{$ENDIF} +{$IFDEF VT_FMX} + DrawTextW(ACanvas, Caption, Length(Caption), Bounds, DrawFormat); +{$ELSE} Winapi.Windows.DrawTextW(DC, PWideChar(Caption), Length(Caption), Bounds, DrawFormat); +{$ENDIF} + end; end; @@ -7897,7 +8522,7 @@ procedure TVirtualTreeColumns.FixPositions; //---------------------------------------------------------------------------------------------------------------------- -function TVirtualTreeColumns.GetColumnAndBounds(P: TPoint; var ColumnLeft, ColumnRight: Integer; +function TVirtualTreeColumns.GetColumnAndBounds(P: TPoint; var ColumnLeft, ColumnRight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; Relative: Boolean = True): Integer; // Returns the column where the mouse is currently in as well as the left and right bound of @@ -7927,7 +8552,7 @@ function TVirtualTreeColumns.GetColumnAndBounds(P: TPoint; var ColumnLeft, Colum if (P.X < ColumnLeft) and (I = 0) then begin Result := InvalidColumn; - exit; + Exit; end; if P.X < ColumnRight then begin @@ -7948,7 +8573,7 @@ function TVirtualTreeColumns.GetOwner: TPersistent; //---------------------------------------------------------------------------------------------------------------------- -function TVirtualTreeColumns.HandleClick(P: TPoint; Button: TMouseButton; Force, DblClick: Boolean): Boolean; +function TVirtualTreeColumns.HandleClick(P: TPoint; Button: TMouseButton; {$IFDEF VT_FMX}Shift: TShiftState;{$ENDIF} Force, DblClick: Boolean): Boolean; // Generates a click event if the mouse button has been released over the same column it was pressed first. // Alternatively, Force might be set to True to indicate that the down index does not matter (right, middle and @@ -7970,10 +8595,15 @@ function TVirtualTreeColumns.HandleClick(P: TPoint; Button: TMouseButton; Force, begin X := P.X; Y := P.Y; +{$IFDEF VT_VCL} Shift := FHeader.GetShiftState; +{$ENDIF} if DblClick then Shift := Shift + [ssDouble]; end; +{$IFDEF VT_FMX} + HitInfo.Shift:= Shift; +{$ENDIF} HitInfo.Button := Button; if (NewClickIndex > NoColumn) and (coAllowClick in Items[NewClickIndex].FOptions) and @@ -7988,7 +8618,7 @@ function TVirtualTreeColumns.HandleClick(P: TPoint; Button: TMouseButton; Force, Include(HitInfo.HitPosition, hhiOnIcon); if Items[NewClickIndex].CheckBox then begin - if Button = mbLeft then + if Button = TMouseButton.mbLeft then FHeader.Treeview.UpdateColumnCheckState(Items[NewClickIndex]); Include(HitInfo.HitPosition, hhiOnCheckbox); end; @@ -8004,7 +8634,7 @@ function TVirtualTreeColumns.HandleClick(P: TPoint; Button: TMouseButton; Force, if DblClick then FHeader.Treeview.DoHeaderDblClick(HitInfo) else begin - if (hoHeaderClickAutoSort in Header.Options) and (HitInfo.Button = mbLeft) and not (hhiOnCheckbox in HitInfo.HitPosition) and (HitInfo.Column >= 0) then + if (hoHeaderClickAutoSort in Header.Options) and (HitInfo.Button = TMouseButton.mbLeft) and not (hhiOnCheckbox in HitInfo.HitPosition) and (HitInfo.Column >= 0) then begin // handle automatic setting of SortColumn and toggling of the sort order if HitInfo.Column <> Header.SortColumn then @@ -8023,14 +8653,14 @@ function TVirtualTreeColumns.HandleClick(P: TPoint; Button: TMouseButton; Force, Result := True; end;//if - if (Button = mbRight) then + if (Button = TMouseButton.mbRight) then begin Dec(P.Y, FHeader.FHeight); // popup menus at actual clicked point FreeAndNil(fColumnPopupMenu);// Attention: Do not free the TVTHeaderPopupMenu at the end of this method, otherwise the clikc events of the menu item will not be fired. Self.FDownIndex := NoColumn; Self.FTrackIndex := NoColumn; Self.FCheckBoxHit := False; - Menu := Header.DoGetPopupMenu(Self.ColumnFromPosition(Point(P.X, P.Y + Integer(Header.Treeview.Height))), P); + Menu := Header.DoGetPopupMenu(Self.ColumnFromPosition(Point(P.X, P.Y + {$IFDEF VT_VCL}Integer{$ENDIF}(Header.Treeview.Height))), P); if Assigned(Menu) then begin Header.Treeview.StopTimer(ScrollTimer); @@ -8108,11 +8738,11 @@ procedure TVirtualTreeColumns.IndexChanged(OldIndex, NewIndex: Integer); begin // Index found. Move all higher entries one step down and remove the last entry. if I < Upper then - Move(FPositionToIndex[I + 1], FPositionToIndex[I], (Upper - I) * SizeOf(TColumnIndex)); + System.Move(FPositionToIndex[I + 1], FPositionToIndex[I], (Upper - I) * SizeOf(TColumnIndex)); end; // Decrease all indices, which are greater than the index to be deleted. if FPositionToIndex[I] > OldIndex then - Dec(FPositionToIndex[I]); + System.Dec(FPositionToIndex[I]); end; SetLength(FPositionToIndex, High(FPositionToIndex)); end @@ -8128,7 +8758,7 @@ procedure TVirtualTreeColumns.IndexChanged(OldIndex, NewIndex: Integer); for I := 0 to High(FPositionToIndex) do begin if (FPositionToIndex[I] >= Lower) and (FPositionToIndex[I] < Upper) then - Inc(FPositionToIndex[I], Increment) + System.Inc(FPositionToIndex[I], Increment) else if FPositionToIndex[I] = OldIndex then FPositionToIndex[I] := NewIndex; @@ -8167,7 +8797,7 @@ procedure TVirtualTreeColumns.InitializePositionArray; for I := 0 to Count - 1 do if FPositionToIndex[I] >= Count then begin - Dec(FPositionToIndex[I]); + System.Dec(FPositionToIndex[I]); Changed := True; end; until not Changed; @@ -8267,8 +8897,8 @@ procedure TVirtualTreeColumns.UpdatePositions(Force: Boolean = False); // PostionToIndex array which primarily determines where each column is placed visually. var - I, RunningPos: Integer; - + I: Integer; + RunningPos: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; begin if not (csDestroying in FHeader.Treeview.ComponentState) and not FNeedPositionsFix and (Force or (UpdateCount = 0)) then begin @@ -8290,28 +8920,30 @@ procedure TVirtualTreeColumns.UpdatePositions(Force: Boolean = False); function TVirtualTreeColumns.Add: TVirtualTreeColumn; begin +{$IFDEF VT_VCL} Assert(GetCurrentThreadId = MainThreadId, 'UI controls may only be chnaged in UI thread.'); +{$ENDIF} Result := TVirtualTreeColumn(inherited Add); end; //---------------------------------------------------------------------------------------------------------------------- -procedure TVirtualTreeColumns.AnimatedResize(Column: TColumnIndex; NewWidth: Integer); +procedure TVirtualTreeColumns.AnimatedResize(Column: TColumnIndex; NewWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); // Resizes the given column animated by scrolling the window DC. var - OldWidth: Integer; - DC: HDC; - I, - Steps, - DX: Integer; + OldWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + {$IFDEF VT_FMX}Canvas: TCanvas{$ELSE}DC: HDC{$ENDIF}; + I: Integer; + Steps: Integer; + DX: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; HeaderScrollRect, ScrollRect, R: TRect; NewBrush, - LastBrush: HBRUSH; + LastBrush: {$IFDEF VT_FMX}TBrush{$ELSE}HBRUSH{$ENDIF}; begin if not IsValidColumn(Column) then @@ -8330,11 +8962,15 @@ procedure TVirtualTreeColumns.AnimatedResize(Column: TColumnIndex; NewWidth: Int if not ( (hoDisableAnimatedResize in FHeader.Options) or (coDisableAnimatedResize in Items[Column].Options) ) then begin +{$IFDEF VT_FMX} + Canvas:= FHeader.Treeview.Canvas; +{$ELSE} DC := GetWindowDC(FHeader.Treeview.Handle); +{$ENDIF} with FHeader.Treeview do try Steps := 32; - DX := (NewWidth - OldWidth) div Steps; + DX := (NewWidth - OldWidth) {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} Steps; // Determination of the scroll rectangle is a bit complicated since we neither want // to scroll the scrollbars nor the border of the treeview window. @@ -8354,12 +8990,26 @@ procedure TVirtualTreeColumns.AnimatedResize(Column: TColumnIndex; NewWidth: Int if NewWidth > OldWidth then begin R := ScrollRect; +{$IFDEF VT_FMX} + NewBrush := TBrush.Create(TBrushKind.Solid, Fill.Color); + LastBrush := TBrush.Create(TBrushKind.Solid, Fill.Color); + LastBrush.Assign(Canvas.Fill); +{$ELSE} NewBrush := CreateSolidBrush(ColorToRGB(Color)); LastBrush := SelectObject(DC, NewBrush); +{$ENDIF} + R.Right := R.Left + DX; +{$IFDEF VT_FMX} + Canvas.FillRect(R, 0, 0, [], 1.0, NewBrush); + Canvas.Fill.Assign(LastBrush); + FreeAndNil(NewBrush); + FreeAndNil(LastBrush); +{$ELSE} FillRect(DC, R, NewBrush); SelectObject(DC, LastBrush); DeleteObject(NewBrush); +{$ENDIF} end else begin @@ -8367,6 +9017,7 @@ procedure TVirtualTreeColumns.AnimatedResize(Column: TColumnIndex; NewWidth: Int Inc(ScrollRect.Left, DX); end; +{$IFDEF VT_VCL} for I := 0 to Steps - 1 do begin ScrollDC(DC, DX, 0, HeaderScrollRect, HeaderScrollRect, 0, nil); @@ -8375,8 +9026,11 @@ procedure TVirtualTreeColumns.AnimatedResize(Column: TColumnIndex; NewWidth: Int Inc(ScrollRect.Left, DX); Sleep(1); end; +{$ENDIF} finally +{$IFDEF VT_VCL} ReleaseDC(Handle, DC); +{$ENDIF} end; end; Items[Column].Width := NewWidth; @@ -8443,8 +9097,8 @@ function TVirtualTreeColumns.ColumnFromPosition(P: TPoint; Relative: Boolean = T // Determines the current column based on the position passed in P. var - I, Sum: Integer; - + I: Integer; + Sum: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; begin Result := InvalidColumn; @@ -8527,7 +9181,7 @@ function TVirtualTreeColumns.Equals(OtherColumnsObj: TObject): Boolean; //---------------------------------------------------------------------------------------------------------------------- -procedure TVirtualTreeColumns.GetColumnBounds(Column: TColumnIndex; var Left, Right: Integer); +procedure TVirtualTreeColumns.GetColumnBounds(Column: TColumnIndex; var Left, Right: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); // Returns the left and right bound of the given column. If Column is NoColumn then the entire client width is returned. @@ -8551,7 +9205,7 @@ procedure TVirtualTreeColumns.GetColumnBounds(Column: TColumnIndex; var Left, Ri //---------------------------------------------------------------------------------------------------------------------- -function TVirtualTreeColumns.GetScrollWidth: Integer; +function TVirtualTreeColumns.GetScrollWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; // Returns the average width of all visible, non-fixed columns. If there is no such column the indent is returned. @@ -8569,14 +9223,14 @@ function TVirtualTreeColumns.GetScrollWidth: Integer; if ([coVisible, coFixed] * FHeader.Columns[I].Options = [coVisible]) then begin Inc(Result, FHeader.Columns[I].Width); - Inc(ScrollColumnCount); + System.Inc(ScrollColumnCount); end; end; if ScrollColumnCount > 0 then // use average width Result := Round(Result / ScrollColumnCount) else // use indent - Result := Integer(FHeader.Treeview.FIndent); + Result := {$IFDEF VT_VCL}Integer{$ENDIF}(FHeader.Treeview.FIndent); end; @@ -8744,7 +9398,7 @@ function TVirtualTreeColumns.GetVisibleColumns: TColumnsArray; if coVisible in Items[FPositionToIndex[I]].FOptions then begin Result[Counter] := Items[FPositionToIndex[I]]; - Inc(Counter); + System.Inc(Counter); end; // Set result length to actual visible count. SetLength(Result, Counter); @@ -8752,7 +9406,7 @@ function TVirtualTreeColumns.GetVisibleColumns: TColumnsArray; //---------------------------------------------------------------------------------------------------------------------- -function TVirtualTreeColumns.GetVisibleFixedWidth: Integer; +function TVirtualTreeColumns.GetVisibleFixedWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; // Determines the horizontal space all visible and fixed columns occupy. @@ -8811,16 +9465,15 @@ procedure TVirtualTreeColumns.LoadFromStream(const Stream: TStream; Version: Int //---------------------------------------------------------------------------------------------------------------------- -procedure TVirtualTreeColumns.PaintHeader(DC: HDC; R: TRect; HOffset: Integer); +procedure TVirtualTreeColumns.PaintHeader({$IFDEF VT_FMX}ACanvas: TCanvas{$ELSE}DC: HDC{$ENDIF}; R: TRect; HOffset: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); // Backward compatible header paint method. This method takes care of visually moving floating columns var - VisibleFixedWidth: Integer; - RTLOffset: Integer; + VisibleFixedWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + RTLOffset: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; procedure PaintFixedArea; - begin if VisibleFixedWidth > 0 then PaintHeader(FHeaderBitmap.Canvas, @@ -8832,7 +9485,7 @@ procedure TVirtualTreeColumns.PaintHeader(DC: HDC; R: TRect; HOffset: Integer); // Adjust size of the header bitmap with TWithSafeRect(FHeader.Treeview.FHeaderRect) do begin - FHeaderBitmap.SetSize(Max(Right, R.Right - R.Left), Bottom); + FHeaderBitmap.SetSize({$IFDEF VT_FMX}Round{$ENDIF}(Max(Right, R.Right - R.Left)), {$IFDEF VT_FMX}Round{$ENDIF}(Bottom)); //TODO: round added!!! end; VisibleFixedWidth := GetVisibleFixedWidth; @@ -8842,7 +9495,7 @@ procedure TVirtualTreeColumns.PaintHeader(DC: HDC; R: TRect; HOffset: Integer); RTLOffset := FHeader.Treeview.ComputeRTLOffset else RTLOffset := 0; - + if RTLOffset = 0 then PaintFixedArea; @@ -8854,16 +9507,25 @@ procedure TVirtualTreeColumns.PaintHeader(DC: HDC; R: TRect; HOffset: Integer); // In case of right-to-left directionality we paint the fixed part last. if RTLOffset <> 0 then PaintFixedArea; - + // Blit the result to target. with TWithSafeRect(R) do +{$IFDEF VT_FMX} + ACanvas.DrawBitmap( + FHeaderBitmap + , Rect(Left, Top, Right - Left, Bottom - Top) + , Rect(Left, Top, Left+FHeaderBitmap.Width, Top+FHeaderBitmap.Height) + , 1.0 + , false); +{$ELSE} BitBlt(DC, Left, Top, Right - Left, Bottom - Top, FHeaderBitmap.Canvas.Handle, Left, Top, SRCCOPY); +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- procedure TVirtualTreeColumns.PaintHeader(TargetCanvas: TCanvas; R: TRect; const Target: TPoint; - RTLOffset: Integer = 0); + RTLOffset: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} = 0); // Main paint method to draw the header. // This procedure will paint the a slice (given in R) out of HeaderRect into TargetCanvas starting at position Target. @@ -8890,7 +9552,9 @@ procedure TVirtualTreeColumns.PaintHeader(TargetCanvas: TCanvas; R: TRect; const PaintInfo: THeaderPaintInfo; RequestedElements, ActualElements: THeaderPaintElements; - +{$IFDEF VT_FMX} + SaveS: TCanvasSaveState; +{$ENDIF} //--------------- local functions ------------------------------------------- procedure PrepareButtonStyles; @@ -8936,8 +9600,10 @@ procedure TVirtualTreeColumns.PaintHeader(TargetCanvas: TCanvas; R: TRect; const var BackgroundRect: TRect; +{$IFDEF VT_VCL} Details: TThemedElementDetails; Theme: HTheme; +{$ENDIF} begin BackgroundRect := Rect(Target.X, Target.Y, Target.X + R.Right - R.Left, Target.Y + FHeader.Height); @@ -8947,9 +9613,10 @@ procedure TVirtualTreeColumns.PaintHeader(TargetCanvas: TCanvas; R: TRect; const begin PaintInfo.PaintRectangle := BackgroundRect; FHeader.Treeview.DoAdvancedHeaderDraw(PaintInfo, [hpeBackground]); - end + end else begin +{$IFDEF VT_VCL} if (FHeader.Treeview.VclStyleEnabled and (seClient in FHeader.FOwner.StyleElements)) then begin Details := StyleServices.GetElementDetails(thHeaderItemRightNormal); @@ -8963,9 +9630,10 @@ procedure TVirtualTreeColumns.PaintHeader(TargetCanvas: TCanvas; R: TRect; const CloseThemeData(THeme); end else +{$ENDIF} begin - Brush.Color := FHeader.FBackgroundColor; - FillRect(BackgroundRect); + {$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := FHeader.FBackgroundColor; + FillRect(BackgroundRect{$IFDEF VT_FMX}, 0, 0, [], 1.0{$ENDIF}); end; end; end; @@ -8979,21 +9647,28 @@ procedure TVirtualTreeColumns.PaintHeader(TargetCanvas: TCanvas; R: TRect; const // this procedure is called. var - Y: Integer; + Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; SavedDC: Integer; ColCaptionText: string; ColImageInfo: TVTImageInfo; SortIndex: Integer; SortGlyphSize: TSize; +{$IFDEF VT_VCL} Glyph: TThemedHeader; Details: TThemedElementDetails; +{$ENDIF} WrapCaption: Boolean; DrawFormat: Cardinal; Pos: TRect; DrawHot: Boolean; ImageWidth: Integer; +{$IFDEF VT_VCL} Theme: HTheme; +{$ENDIF} IdState: Integer; +{$IFDEF VT_FMX} + SaveS: TCanvasSaveState; +{$ENDIF} begin ColImageInfo.Ghosted := False; PaintInfo.Column := Items[AColumn]; @@ -9023,7 +9698,7 @@ procedure TVirtualTreeColumns.PaintHeader(TargetCanvas: TCanvas; R: TRect; const //the dragged column will stay where it is if (DropMark = dmmRight) and (Items[FDragIndex].Position = Items[FDropTarget].Position + 1) then - DropMark := dmmNone; + DropMark := dmmNone; IsEnabled := (coEnabled in FOptions) and (FHeader.Treeview.Enabled); ShowHeaderGlyph := (hoShowImages in FHeader.FOptions) and ((Assigned(Images) and (FImageIndex > -1)) or FCheckBox); @@ -9052,6 +9727,7 @@ procedure TVirtualTreeColumns.PaintHeader(TargetCanvas: TCanvas; R: TRect; const FHeader.Treeview.DoAdvancedHeaderDraw(PaintInfo, [hpeBackground]) else begin +{$IFDEF VT_VCL} if FHeader.Treeview.VclStyleEnabled and (seClient in FHeader.FOwner.StyleElements) then begin if IsDownIndex then @@ -9064,7 +9740,9 @@ procedure TVirtualTreeColumns.PaintHeader(TargetCanvas: TCanvas; R: TRect; const StyleServices.DrawElement(TargetCanvas.Handle, Details, PaintRectangle, @PaintRectangle); end else +{$ENDIF} begin +{$IFDEF VT_VCL} if tsUseThemes in FHeader.Treeview.FStates then begin Theme := OpenThemeData(FHeader.Treeview.Handle, 'HEADER'); @@ -9079,16 +9757,17 @@ procedure TVirtualTreeColumns.PaintHeader(TargetCanvas: TCanvas; R: TRect; const CloseThemeData(Theme); end else +{$ENDIF} if IsDownIndex then - DrawEdge(TargetCanvas.Handle, PaintRectangle, PressedButtonStyle, PressedButtonFlags) + DrawEdge(TargetCanvas{$IFDEF VT_VCL}.Handle{$ENDIF}, PaintRectangle, PressedButtonStyle, PressedButtonFlags) else // Plates have the special case of raising on mouse over. if (FHeader.Style = hsPlates) and IsHoverIndex and (coAllowClick in FOptions) and (coEnabled in FOptions) then - DrawEdge(TargetCanvas.Handle, PaintRectangle, RaisedButtonStyle, + DrawEdge(TargetCanvas{$IFDEF VT_VCL}.Handle{$ENDIF}, PaintRectangle, RaisedButtonStyle, RaisedButtonFlags or RightBorderFlag) else - DrawEdge(TargetCanvas.Handle, PaintRectangle, NormalButtonStyle, + DrawEdge(TargetCanvas{$IFDEF VT_VCL}.Handle{$ENDIF}, PaintRectangle, NormalButtonStyle, NormalButtonFlags or RightBorderFlag); end; end; @@ -9105,7 +9784,7 @@ procedure TVirtualTreeColumns.PaintHeader(TargetCanvas: TCanvas; R: TRect; const end; if UseRightToLeftReading then DrawFormat := DrawFormat + DT_RTLREADING; - ComputeHeaderLayout(TargetCanvas.Handle, PaintRectangle, ShowHeaderGlyph, ShowSortGlyph, GlyphPos, + ComputeHeaderLayout(TargetCanvas{$IFDEF VT_VCL}.Handle{$ENDIF}, PaintRectangle, ShowHeaderGlyph, ShowSortGlyph, GlyphPos, SortGlyphPos, SortGlyphSize, TextRectangle, DrawFormat); // Move glyph and text one pixel to the right and down to simulate a pressed button. @@ -9125,7 +9804,7 @@ procedure TVirtualTreeColumns.PaintHeader(TargetCanvas: TCanvas; R: TRect; const // main glyph FHasImage := False; if Assigned(Images) then - ImageWidth := Images.Width + ImageWidth := {$IFDEF VT_FMX}16{$ELSE}Images.Width{$ENDIF} //TODO: 16 px image!!! else ImageWidth := 0; @@ -9135,7 +9814,7 @@ procedure TVirtualTreeColumns.PaintHeader(TargetCanvas: TCanvas; R: TRect; const if not FCheckBox then begin ColImageInfo.Images := Images; - Images.Draw(TargetCanvas, GlyphPos.X, GlyphPos.Y, FImageIndex, IsEnabled); + Images.Draw(TargetCanvas, {$IFDEF VT_FMX}RectF(GlyphPos.X, GlyphPos.Y, GlyphPos.X+16, GlyphPos.Y+16){$ELSE}GlyphPos.X, GlyphPos.Y({$ENDIF}, FImageIndex{$IFDEF VT_VCL}, IsEnabled{$ENDIF}); //TODO: 16px Image!!! end else begin @@ -9157,8 +9836,8 @@ procedure TVirtualTreeColumns.PaintHeader(TargetCanvas: TCanvas; R: TRect; const begin Left := GlyphPos.X; Top := GlyphPos.Y; - Right := Left + ColImageInfo.Images.Width; - Bottom := Top + ColImageInfo.Images.Height; + Right := Left + {$IFDEF VT_FMX}16{$ELSE}ColImageInfo.Images.Width{$ENDIF};//TODO: 16px Image!!! + Bottom := Top + {$IFDEF VT_FMX}16{$ELSE}ColImageInfo.Images.Height{$ENDIF};//TODO: 16px Image!!! end; end; @@ -9172,11 +9851,12 @@ procedure TVirtualTreeColumns.PaintHeader(TargetCanvas: TCanvas; R: TRect; const else DrawHot := (IsHoverIndex and (hoHotTrack in FHeader.FOptions) and not(tsUseThemes in FHeader.Treeview.FStates)); if not(hpeText in ActualElements) and (Length(Text) > 0) then - DrawButtonText(TargetCanvas.Handle, ColCaptionText, TextRectangle, IsEnabled, DrawHot, DrawFormat, WrapCaption); + DrawButtonText(TargetCanvas{$IFDEF VT_VCL}.Handle{$ENDIF}, ColCaptionText, TextRectangle, IsEnabled, DrawHot, DrawFormat, WrapCaption); // sort glyph if not (hpeSortGlyph in ActualElements) and ShowSortGlyph then begin +{$IFDEF VT_VCL} if tsUseExplorerTheme in FHeader.Treeview.FStates then begin Pos.TopLeft := SortGlyphPos; @@ -9190,27 +9870,37 @@ procedure TVirtualTreeColumns.PaintHeader(TargetCanvas: TCanvas; R: TRect; const StyleServices.DrawElement(TargetCanvas.Handle, Details, Pos, @Pos); end else +{$ENDIF} begin SortIndex := SortGlyphs[FHeader.FSortDirection, tsUseThemes in FHeader.Treeview.FStates]; - UtilityImages.Draw(TargetCanvas, SortGlyphPos.X, SortGlyphPos.Y, SortIndex); + UtilityImages.Draw(TargetCanvas, {$IFDEF VT_FMX}RectF(SortGlyphPos.X, SortGlyphPos.Y, SortGlyphPos.X + 16, SortGlyphPos.Y + 16){$ELSE}SortGlyphPos.X, SortGlyphPos.Y{$ENDIF}, SortIndex);//TODO: 16px Image!!! end; end; // Show an indication if this column is the current drop target in a header drag operation. if not (hpeDropMark in ActualElements) and (DropMark <> dmmNone) then begin - Y := (PaintRectangle.Top + PaintRectangle.Bottom - UtilityImages.Height) div 2; + Y := (PaintRectangle.Top + PaintRectangle.Bottom - {$IFDEF VT_FMX}16{$ELSE}UtilityImages.Height{$ENDIF}) {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2;//TODO: 16px Image!!! if DropMark = dmmLeft then - UtilityImages.Draw(TargetCanvas, PaintRectangle.Left, Y, 0) + UtilityImages.Draw(TargetCanvas, {$IFDEF VT_FMX}RectF(PaintRectangle.Left, Y, PaintRectangle.Left+16, Y+16){$ELSE}PaintRectangle.Left, Y{$ENDIF}, 0)//TODO: 16px Image!!! else - UtilityImages.Draw(TargetCanvas, PaintRectangle.Right - 16 , Y, 1); + UtilityImages.Draw(TargetCanvas, {$IFDEF VT_FMX}RectF(PaintRectangle.Right - 16, Y, PaintRectangle.Right, Y + 16){$ELSE}PaintRectangle.Right - 16 , Y{$ENDIF}, 1);//TODO: 16px Image!!! end; if ActualElements <> [] then begin +{$IFDEF VT_FMX} + saveS:= TargetCanvas.SaveState; + try + FHeader.Treeview.DoAdvancedHeaderDraw(PaintInfo, ActualElements); + finally + TargetCanvas.RestoreState(saveS); //must i free it??? + end; +{$ELSE} SavedDC := SaveDC(TargetCanvas.Handle); - FHeader.Treeview.DoAdvancedHeaderDraw(PaintInfo, ActualElements); - RestoreDC(TargetCanvas.Handle, SavedDC); + FHeader.Treeview.DoAdvancedHeaderDraw(PaintInfo, ActualElements); + RestoreDC(TargetCanvas.Handle, SavedDC); +{$ENDIF} end; end else // Let application draw the header. @@ -9223,8 +9913,7 @@ procedure TVirtualTreeColumns.PaintHeader(TargetCanvas: TCanvas; R: TRect; const var TargetRect: TRect; - MaxX: Integer; - + MaxX: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; begin if IsRectEmpty(R) then Exit; @@ -9242,8 +9931,11 @@ procedure TVirtualTreeColumns.PaintHeader(TargetCanvas: TCanvas; R: TRect; const begin // Use shortcuts for the images and the font. Images := FHeader.FImages; +{$IFDEF VT_FMX} + Font.Assign(FHeader.FFont); +{$ELSE} Font := FHeader.FFont; - +{$ENDIF} PrepareButtonStyles; // At first, query the application which parts of the header it wants to draw on its own. @@ -9285,13 +9977,21 @@ procedure TVirtualTreeColumns.PaintHeader(TargetCanvas: TCanvas; R: TRect; const TargetRect.Right := TargetRect.Left + Items[Run].FWidth; // create a clipping rect to limit painting to button area +{$IFDEF VT_FMX} + SaveS:= TargetCanvas.SaveState; + try + TargetCanvas.IntersectClipRect(RectF(Max(TargetRect.Left, Target.X), Target.Y + R.Top, + Min(TargetRect.Right, MaxX), TargetRect.Bottom)); + PaintColumnHeader(Run, TargetRect); + finally + TargetCanvas.RestoreState(SaveS); + end; +{$ELSE} ClipCanvas(TargetCanvas, Rect(Max(TargetRect.Left, Target.X), Target.Y + R.Top, Min(TargetRect.Right, MaxX), TargetRect.Bottom)); - PaintColumnHeader(Run, TargetRect); - SelectClipRgn(Handle, 0); - +{$ENDIF} TargetRect.Left := TargetRect.Right; Run := GetNextVisibleColumn(Run); end; @@ -9322,7 +10022,7 @@ procedure TVirtualTreeColumns.SaveToStream(const Stream: TStream); //---------------------------------------------------------------------------------------------------------------------- -function TVirtualTreeColumns.TotalWidth: Integer; +function TVirtualTreeColumns.TotalWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; var LastColumn: TColumnIndex; @@ -9430,7 +10130,7 @@ constructor TVTHeader.Create(AOwner: TBaseVirtualTree); FMinHeight := 10; FMaxHeight := 10000; FFont := TFont.Create; - FFont.OnChange := FontChanged; + FFont.{$IFDEF VT_FMX}OnChanged{$ELSE}OnChange{$ENDIF} := FontChanged; FParentFont := True; FBackgroundColor := clBtnFace; FOptions := [hoColumnResize, hoDrag, hoShowSortGlyphs]; @@ -9442,6 +10142,7 @@ constructor TVTHeader.Create(AOwner: TBaseVirtualTree); FSortDirection := sdAscending; FMainColumn := NoColumn; +{$IFDEF VT_VCL} FDragImage := TVTDragImage.Create(AOwner); with FDragImage do begin @@ -9450,6 +10151,7 @@ constructor TVTHeader.Create(AOwner: TBaseVirtualTree); PreBlendBias := -50; Transparency := 140; end; +{$ENDIF} fSplitterHitTolerance := 8; FFixedAreaConstraints := TVTFixedAreaConstraints.Create(Self); @@ -9463,7 +10165,9 @@ constructor TVTHeader.Create(AOwner: TBaseVirtualTree); destructor TVTHeader.Destroy; begin +{$IFDEF VT_VCL} FDragImage.Free; +{$ENDIF} FFixedAreaConstraints.Free; FImageChangeLink.Free; FFont.Free; @@ -9477,7 +10181,7 @@ destructor TVTHeader.Destroy; procedure TVTHeader.FontChanged(Sender: TObject); var I: Integer; - lMaxHeight: Integer; + lMaxHeight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; begin if toAutoChangeScale in Treeview.TreeOptions.AutoOptions then begin @@ -9489,7 +10193,7 @@ procedure TVTHeader.FontChanged(Sender: TObject); with TBitmap.Create do try Canvas.Font.Assign(FFont); - lMaxHeight := lMaxHeight {top spacing} + (lMaxHeight div 2) {minimum bottom spacing} + Canvas.TextHeight('Q'); + lMaxHeight := lMaxHeight {top spacing} + (lMaxHeight {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2) {minimum bottom spacing} + Canvas.TextHeight('Q'); finally Free; end; @@ -9563,7 +10267,7 @@ procedure TVTHeader.SetColumns(Value: TVirtualTreeColumns); //---------------------------------------------------------------------------------------------------------------------- -procedure TVTHeader.SetDefaultHeight(Value: Integer); +procedure TVTHeader.SetDefaultHeight(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); begin if Value < FMinHeight then @@ -9587,13 +10291,13 @@ procedure TVTHeader.SetFont(const Value: TFont); //---------------------------------------------------------------------------------------------------------------------- -procedure TVTHeader.SetHeight(Value: Integer); +procedure TVTHeader.SetHeight(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); var RelativeMaxHeight, RelativeMinHeight, EffectiveMaxHeight, - EffectiveMinHeight: Integer; + EffectiveMinHeight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; begin if not TreeView.HandleAllocated then @@ -9605,8 +10309,8 @@ procedure TVTHeader.SetHeight(Value: Integer); begin with FFixedAreaConstraints do begin - RelativeMaxHeight := ((Treeview.ClientHeight + FHeight) * FMaxHeightPercent) div 100; - RelativeMinHeight := ((Treeview.ClientHeight + FHeight) * FMinHeightPercent) div 100; + RelativeMaxHeight := ((Treeview.ClientHeight + FHeight) * FMaxHeightPercent) {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 100; + RelativeMinHeight := ((Treeview.ClientHeight + FHeight) * FMinHeightPercent) {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 100; EffectiveMinHeight := IfThen(FMaxHeightPercent > 0, Min(RelativeMaxHeight, FMinHeight), FMinHeight); EffectiveMaxHeight := IfThen(FMinHeightPercent > 0, Max(RelativeMinHeight, FMaxHeight), FMaxHeight); @@ -9637,13 +10341,21 @@ procedure TVTHeader.SetImages(const Value: TCustomImageList); begin if Assigned(FImages) then begin +{$IFDEF VT_FMX} + FImageChangeLink.Images:= nil; +{$ELSE} FImages.UnRegisterChanges(FImageChangeLink); +{$ENDIF} FImages.RemoveFreeNotification(FOwner); end; FImages := Value; if Assigned(FImages) then begin +{$IFDEF VT_FMX} + FImageChangeLink.Images:= FImages; +{$ELSE} FImages.RegisterChanges(FImageChangeLink); +{$ENDIF} FImages.FreeNotification(FOwner); end; if not (csLoading in Treeview.ComponentState) then @@ -9680,7 +10392,7 @@ procedure TVTHeader.SetMainColumn(Value: TColumnIndex); //---------------------------------------------------------------------------------------------------------------------- -procedure TVTHeader.SetMaxHeight(Value: Integer); +procedure TVTHeader.SetMaxHeight(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); begin if Value < FMinHeight then @@ -9691,7 +10403,7 @@ procedure TVTHeader.SetMaxHeight(Value: Integer); //---------------------------------------------------------------------------------------------------------------------- -procedure TVTHeader.SetMinHeight(Value: Integer); +procedure TVTHeader.SetMinHeight(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); begin if Value < 0 then @@ -9807,14 +10519,14 @@ function TVTHeader.CanWriteColumns: Boolean; //---------------------------------------------------------------------------------------------------------------------- -procedure TVTHeader.ChangeScale(M, D: Integer); +procedure TVTHeader.ChangeScale(M, D: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); var I: Integer; begin // This method is only executed if toAutoChangeScale is set Self.Height := MulDiv(FHeight, M, D); if not ParentFont then - Font.Height := MulDiv(Font.Height, M, D); + FFont.{$IFDEF VT_FMX}Size{$ELSE}Height{$ENDIF} := MulDiv(FFont.{$IFDEF VT_FMX}Size{$ELSE}Height{$ENDIF}, M, D); // Scale the columns widths too for I := 0 to FColumns.Count - 1 do begin @@ -9833,8 +10545,8 @@ function TVTHeader.DetermineSplitterIndex(P: TPoint): Boolean; // columns possible. var - VisibleFixedWidth: Integer; - SplitPoint: Integer; + VisibleFixedWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + SplitPoint: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; //--------------- local function -------------------------------------------- @@ -10080,7 +10792,7 @@ procedure TVTHeader.DragTo(P: TPoint); // optimized drag image move support ClientP: TPoint; Left, - Right: Integer; + Right: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; NeedRepaint: Boolean; // True if the screen needs an update (changed drop target or drop side) begin @@ -10093,7 +10805,7 @@ procedure TVTHeader.DragTo(P: TPoint); if NewTarget >= 0 then begin FColumns.GetColumnBounds(NewTarget, Left, Right); - if (ClientP.X < ((Left + Right) div 2)) <> FColumns.FDropBefore then + if (ClientP.X < ((Left + Right) {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2)) <> FColumns.FDropBefore then begin NeedRepaint := True; FColumns.FDropBefore := not FColumns.FDropBefore; @@ -10119,12 +10831,17 @@ procedure TVTHeader.DragTo(P: TPoint); // Fix for various problems mentioned in issue 248. if NeedRepaint then begin +{$IFDEF VT_FMX} + FOwner.Repaint; +{$ELSE} UpdateWindow(FOwner.Handle); +{$ENDIF} // The new routine recaptures the backup image after the updatewindow // Note: We could have called this unconditionally but when called // over the tree, doesn't capture the background image. Since our // problems are in painting of the header, we call it only when the // drag image is over the header. +{$IFDEF VT_VCL} if // determine the case when the drag image is or was on the header area (InHeader(FOwner.ScreenToClient(FDragImage.FLastPosition)) @@ -10134,12 +10851,14 @@ procedure TVTHeader.DragTo(P: TPoint); GDIFlush; FOwner.UpdateWindowAndDragImage(FOwner, FOwner.HeaderRect, True, true); end; +{$ENDIF} // since we took care of UpdateWindow above, there is no need to do an // update window again by sending NeedRepaint. So switch off the second parameter. NeedRepaint := false; end; - +{$IFDEF VT_VCL} FDragImage.DragTo(P, NeedRepaint); +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -10176,6 +10895,7 @@ function TVTHeader.GetOwner: TPersistent; //---------------------------------------------------------------------------------------------------------------------- +{$IFDEF VT_VCL} function TVTHeader.GetShiftState: TShiftState; begin @@ -10187,9 +10907,11 @@ function TVTHeader.GetShiftState: TShiftState; if GetKeyState(VK_MENU) < 0 then Include(Result, ssAlt); end; +{$ENDIF} //---------------------------------------------------------------------------------------------------------------------- +{$IFDEF VT_VCL} function TVTHeader.HandleHeaderMouseMove(var Message: TWMMouseMove): Boolean; var @@ -10746,7 +11468,7 @@ function TVTHeader.HandleMessage(var Message: TMessage): Boolean; end; end; end; - +{$ENDIF} //---------------------------------------------------------------------------------------------------------------------- procedure TVTHeader.ImageListChange(Sender: TObject); @@ -10766,7 +11488,7 @@ procedure TVTHeader.PrepareDrag(P, Start: TPoint); Image: TBitmap; ImagePos: TPoint; DragColumn: TVirtualTreeColumn; - RTLOffset: Integer; + RTLOffset: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; begin // Determine initial position of drag image (screen coordinates). @@ -10779,13 +11501,15 @@ procedure TVTHeader.PrepareDrag(P, Start: TPoint); Image := TBitmap.Create; with Image do try +{$IFDEF VT_VCL} PixelFormat := pf32Bit; - SetSize(DragColumn.Width, FHeight); +{$ENDIF} + SetSize({$IFDEF VT_FMX}Round{$ENDIF}(DragColumn.Width), {$IFDEF VT_FMX}Round{$ENDIF}(FHeight)); //TODO: round is not good here! // Erase the entire image with the color key value, for the case not everything // in the image is covered by the header image. - Canvas.Brush.Color := clBtnFace; - Canvas.FillRect(Rect(0, 0, Width, Height)); + Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := clBtnFace; + Canvas.FillRect(Rect(0, 0, Width, Height){$IFDEF VT_FMX}, 0, 0, [], 1.0{$ENDIF}); if TreeView.UseRightToLeftAlignment then RTLOffset := Treeview.ComputeRTLOffset @@ -10801,12 +11525,14 @@ procedure TVTHeader.PrepareDrag(P, Start: TPoint); // Column rectangles are given in local window coordinates not client coordinates. Dec(ImagePos.Y, FHeight); +{$IFDEF VT_VCL} if hoRestrictDrag in FOptions then FDragImage.MoveRestriction := dmrHorizontalOnly else FDragImage.MoveRestriction := dmrNone; FDragImage.PrepareDrag(Image, ImagePos, P, nil); FDragImage.ShowDragImage; +{$ENDIF} finally Image.Free; end; @@ -10834,8 +11560,10 @@ procedure TVTHeader.RecalculateHeader; if Treeview.HandleAllocated then begin Treeview.UpdateHeaderRect; +{$IFDEF VT_VCL} SetWindowPos(Treeview.Handle, 0, 0, 0, 0, 0, SWP_FRAMECHANGED or SWP_NOMOVE or SWP_NOACTIVATE or SWP_NOOWNERZORDER or SWP_NOSENDCHANGING or SWP_NOSIZE or SWP_NOZORDER); +{$ENDIF} end; end; @@ -10848,7 +11576,7 @@ procedure TVTHeader.RescaleHeader; var FixedWidth, MaxFixedWidth, - MinFixedWidth: Integer; + MinFixedWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; //--------------- local function -------------------------------------------- @@ -10872,8 +11600,8 @@ procedure TVTHeader.RescaleHeader; with FFixedAreaConstraints do begin - MinFixedWidth := (TreeView.ClientWidth * FMinWidthPercent) div 100; - MaxFixedWidth := (TreeView.ClientWidth * FMaxWidthPercent) div 100; + MinFixedWidth := (TreeView.ClientWidth * FMinWidthPercent) {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 100; + MaxFixedWidth := (TreeView.ClientWidth * FMaxWidthPercent) {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 100; end; end; @@ -10948,7 +11676,7 @@ procedure TVTHeader.UpdateSpringColumns; SpringCount := 0; for I := 0 to FColumns.Count-1 do if [coVisible, coAutoSpring] * FColumns[I].FOptions = [coVisible, coAutoSpring] then - Inc(SpringCount); + System.Inc(SpringCount); if SpringCount > 0 then begin // Calculate the size to add/sub to each columns. @@ -11134,6 +11862,7 @@ procedure TVTHeader.AutoFitColumns(Animated: Boolean = True; SmartAutoFitType: T //---------------------------------------------------------------------------------------------------------------------- +//TODO: to investigate - here client coordinates and non client coordinates have problem in FMX function TVTHeader.InHeader(P: TPoint): Boolean; // Determines whether the given point (client coordinates!) is within the header rectangle (non-client coordinates). @@ -11145,13 +11874,18 @@ function TVTHeader.InHeader(P: TPoint): Boolean; R := Treeview.FHeaderRect; // Current position of the owner in screen coordinates. +{$IFDEF VT_FMX} + RW:= Treeview.ClipRect; +{$ELSE} GetWindowRect(Treeview.Handle, RW); - - // Convert to client coordinates. + // Convert to client coordinates. MapWindowPoints(0, Treeview.Handle, RW, 2); +{$ENDIF} +{$IFDEF VT_VCL} // Consider the header within this rectangle. OffsetRect(R, RW.Left, RW.Top); +{$ENDIF} Result := PtInRect(R, P); end; @@ -11173,13 +11907,18 @@ function TVTHeader.InHeaderSplitterArea(P: TPoint): Boolean; Inc(R.Bottom, 2); // Current position of the owner in screen coordinates. - GetWindowRect(Treeview.Handle, RW); - - // Convert to client coordinates. - MapWindowPoints(0, Treeview.Handle, RW, 2); +{$IFDEF VT_FMX} + RW:= Treeview.ClipRect; +{$ELSE} + GetWindowRect(Treeview.Handle, RW); + // Convert to client coordinates. + MapWindowPoints(0, Treeview.Handle, RW, 2); +{$ENDIF} +{$IFDEF VT_VCL} // Consider the header within this rectangle. OffsetRect(R, RW.Left, RW.Top); +{$ENDIF} Result := PtInRect(R, P); end; end; @@ -11197,11 +11936,13 @@ procedure TVTHeader.Invalidate(Column: TVirtualTreeColumn; ExpandToBorder: Boole var R, RW: TRect; Flags: Cardinal; - begin if (hoVisible in FOptions) and Treeview.HandleAllocated then with Treeview do begin +{$IFDEF VT_FMX} + Repaint; +{$ELSE} if Column = nil then R := FHeaderRect else @@ -11240,6 +11981,7 @@ procedure TVTHeader.Invalidate(Column: TVirtualTreeColumn; ExpandToBorder: Boole if UpdateNowFlag then Flags := Flags or RDW_UPDATENOW; RedrawWindow(Handle, @R, 0, Flags); +{$ENDIF} end; end; @@ -11290,16 +12032,20 @@ procedure TVTHeader.LoadFromStream(const Stream: TStream); // TFont has no own save routine so we do it manually with Font do begin +{$IFDEF VT_VCL} ReadBuffer(Dummy, SizeOf(Dummy)); Color := Dummy; +{$ENDIF} ReadBuffer(Dummy, SizeOf(Dummy)); Height := Dummy; ReadBuffer(Dummy, SizeOf(Dummy)); SetLength(S, Dummy); ReadBuffer(PAnsiChar(S)^, Dummy); - Name := UTF8ToString(S); + {$IFDEF VT_FMX}Family{$ELSE}Name{$ENDIF} := UTF8ToString(S); +{$IFDEF VT_VCL} ReadBuffer(Dummy, SizeOf(Dummy)); Pitch := TFontPitch(Dummy); +{$ENDIF} ReadBuffer(Dummy, SizeOf(Dummy)); Style := TFontStyles(Byte(Dummy)); end; @@ -11347,8 +12093,8 @@ procedure TVTHeader.LoadFromStream(const Stream: TStream); //---------------------------------------------------------------------------------------------------------------------- -function TVTHeader.ResizeColumns(ChangeBy: Integer; RangeStartCol: TColumnIndex; RangeEndCol: TColumnIndex; - Options: TVTColumnOptions = [coVisible]): Integer; +function TVTHeader.ResizeColumns(ChangeBy: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; RangeStartCol: TColumnIndex; RangeEndCol: TColumnIndex; + Options: TVTColumnOptions = [coVisible]): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; // Distribute the given width change to a range of columns. A 'fair' way is used to distribute ChangeBy to the columns, // while ensuring that everything that can be distributed will be distributed. @@ -11357,13 +12103,10 @@ function TVTHeader.ResizeColumns(ChangeBy: Integer; RangeStartCol: TColumnIndex; Start, I: TColumnIndex; ColCount, - ToGo, - Sign, - Rest, - MaxDelta, - Difference: Integer; + Sign: Integer; + ToGo, MaxDelta, Difference, Rest: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; Constraints, - Widths: array of Integer; + Widths: array of {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; BonusPixel: Boolean; //--------------- local functions ------------------------------------------- @@ -11390,7 +12133,7 @@ function TVTHeader.ResizeColumns(ChangeBy: Integer; RangeStartCol: TColumnIndex; //--------------------------------------------------------------------------- - function ChangeWidth(Column: TColumnIndex; Delta: Integer): Integer; + function ChangeWidth(Column: TColumnIndex; Delta: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; begin if Delta > 0 then @@ -11408,7 +12151,7 @@ function TVTHeader.ResizeColumns(ChangeBy: Integer; RangeStartCol: TColumnIndex; function ReduceConstraints: Boolean; var - MaxWidth, + MaxWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; MaxReserveCol, Column: TColumnIndex; @@ -11431,7 +12174,7 @@ function TVTHeader.ResizeColumns(ChangeBy: Integer; RangeStartCol: TColumnIndex; Result := False else Dec(Constraints[MaxReserveCol - RangeStartCol], - Constraints[MaxReserveCol - RangeStartCol] div 10); + Constraints[MaxReserveCol - RangeStartCol] {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 10); end; //----------- end local functions ------------------------------------------- @@ -11460,7 +12203,7 @@ function TVTHeader.ResizeColumns(ChangeBy: Integer; RangeStartCol: TColumnIndex; for I := RangeStartCol to RangeEndCol do if (Options * FColumns[I].FOptions = Options) and IsResizable(I) then begin - Inc(ColCount); + System.Inc(ColCount); IncDelta(I); end; if MaxDelta < Abs(ChangeBy) then @@ -11472,8 +12215,13 @@ function TVTHeader.ResizeColumns(ChangeBy: Integer; RangeStartCol: TColumnIndex; Break; ToGo := Min(ToGo, MaxDelta); +{$IFDEF VT_FMX} + Difference := Trunc(ToGo / ColCount); + Rest := Frac(ToGo / ColCount); +{$ELSE} Difference := ToGo div ColCount; Rest := ToGo mod ColCount; +{$ENDIF} if Difference > 0 then for I := RangeStartCol to RangeEndCol do @@ -11490,7 +12238,7 @@ function TVTHeader.ResizeColumns(ChangeBy: Integer; RangeStartCol: TColumnIndex; Dec(Rest, ChangeWidth(I, Sign)); FColumns[I].FBonusPixel := BonusPixel; end; - Inc(I, Sign); + System.Inc(I, Sign); if (BonusPixel and (I > RangeEndCol)) or (not BonusPixel and (I < RangeStartCol)) then begin for I := RangeStartCol to RangeEndCol do @@ -11537,6 +12285,9 @@ procedure TVTHeader.SaveToStream(const Stream: TStream); var Dummy: Integer; +{$IFDEF VT_FMX} + DummySingle: Single; +{$ENDIF} Tmp: AnsiString; begin @@ -11559,8 +12310,8 @@ procedure TVTHeader.SaveToStream(const Stream: TStream); WriteBuffer(Dummy, SizeOf(Dummy)); Dummy := FBackgroundColor; WriteBuffer(Dummy, SizeOf(Dummy)); - Dummy := FHeight; - WriteBuffer(Dummy, SizeOf(Dummy)); + {$IFDEF VT_FMX}DummySingle{$ELSE}Dummy{$ENDIF}:= FHeight; + WriteBuffer({$IFDEF VT_FMX}DummySingle{$ELSE}Dummy{$ENDIF}, SizeOf({$IFDEF VT_FMX}DummySingle{$ELSE}Dummy{$ENDIF})); Dummy := Integer(FOptions); WriteBuffer(Dummy, SizeOf(Dummy)); // PopupMenu is neither saved nor restored @@ -11569,18 +12320,22 @@ procedure TVTHeader.SaveToStream(const Stream: TStream); // TFont has no own save routine so we do it manually with Font do begin +{$IFDEF VT_VCL} Dummy := Color; WriteBuffer(Dummy, SizeOf(Dummy)); +{$ENDIF} // Need only to write one: size or height, I decided to write height. - Dummy := Height; - WriteBuffer(Dummy, SizeOf(Dummy)); - Tmp := UTF8Encode(Name); + {$IFDEF VT_FMX}DummySingle{$ELSE}Dummy{$ENDIF} := Height; + WriteBuffer({$IFDEF VT_FMX}DummySingle{$ELSE}Dummy{$ENDIF}, SizeOf({$IFDEF VT_FMX}DummySingle{$ELSE}Dummy{$ENDIF})); + Tmp := UTF8Encode({$IFDEF VT_FMX}Family{$ELSE}Name{$ENDIF}); Dummy := Length(Tmp); WriteBuffer(Dummy, SizeOf(Dummy)); WriteBuffer(PAnsiChar(Tmp)^, Dummy); +{$IFDEF VT_VCL} Dummy := Ord(Pitch); WriteBuffer(Dummy, SizeOf(Dummy)); +{$ENDIF} Dummy := Byte(Style); WriteBuffer(Dummy, SizeOf(Dummy)); end; @@ -11596,12 +12351,21 @@ procedure TVTHeader.SaveToStream(const Stream: TStream); // Data introduced by stream version 5. Dummy := Integer(ParentFont); WriteBuffer(Dummy, SizeOf(Dummy)); +{$IFDEF VT_FMX} + DummySingle := FMaxHeight; + WriteBuffer(DummySingle, SizeOf(DummySingle)); + DummySingle := FMinHeight; + WriteBuffer(DummySingle, SizeOf(DummySingle)); + DummySingle := FDefaultHeight; + WriteBuffer(DummySingle, SizeOf(DummySingle)); +{$ELSE} Dummy := Integer(FMaxHeight); WriteBuffer(Dummy, SizeOf(Dummy)); Dummy := Integer(FMinHeight); WriteBuffer(Dummy, SizeOf(Dummy)); - Dummy := Integer(FDefaultHeight); + Dummy := FDefaultHeight; WriteBuffer(Dummy, SizeOf(Dummy)); +{$ENDIF} with FFixedAreaConstraints do begin Dummy := Integer(FMaxHeightPercent); @@ -11626,7 +12390,7 @@ constructor TScrollBarOptions.Create(AOwner: TBaseVirtualTree); FOwner := AOwner; FAlwaysVisible := False; FScrollBarStyle := sbmRegular; - FScrollBars := ssBoth; + FScrollBars := TScrollStyle.ssBoth; FIncrementX := 20; FIncrementY := 20; end; @@ -11723,10 +12487,12 @@ constructor TVTColors.Create(AOwner: TBaseVirtualTree); function TVTColors.GetBackgroundColor: TColor; begin // XE2 VCL Style +{$IFDEF VT_VCL} if FOwner.VclStyleEnabled and (seClient in FOwner.StyleElements) then Result := StyleServices.GetStyleColor(scTreeView) else - Result := FOwner.Color; +{$ENDIF} + Result := FOwner.{$IFDEF VT_FMX}Fill.Color{$ELSE}Color{$ENDIF}; end; //---------------------------------------------------------------------------------------------------------------------- @@ -11734,7 +12500,8 @@ function TVTColors.GetBackgroundColor: TColor; function TVTColors.GetColor(const Index: Integer): TColor; begin Result := FColors[Index]; - if FOwner.VclStyleEnabled and not StyleServices.IsSystemStyle then + {$IFDEF VT_VCL} + if FOwner.VclStyleEnabled and not StyleServices.IsSystemStyle then begin // Only fetch the color via StyleServices if it is the default color // Return user defined color otherwise @@ -11776,6 +12543,7 @@ function TVTColors.GetColor(const Index: Integer): TColor; Result := StyleServices.GetSystemColor(FColors[Index]); end; end; +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -11783,20 +12551,28 @@ function TVTColors.GetColor(const Index: Integer): TColor; function TVTColors.GetHeaderFontColor: TColor; begin // XE2+ VCL Style +{$IFDEF VT_FMX} + Result := clBlack; //TODO: color!!! +{$ELSE} if FOwner.VclStyleEnabled and (seFont in FOwner.StyleElements) then StyleServices.GetElementColor(StyleServices.GetElementDetails(thHeaderItemNormal), ecTextColor, Result) else Result := FOwner.FHeader.Font.Color; +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- function TVTColors.GetNodeFontColor: TColor; begin +{$IFDEF VT_FMX} + Result := clBlack; //TODO: color!!! +{$ELSE} if FOwner.VclStyleEnabled and (seFont in FOwner.StyleElements) then StyleServices.GetElementColor(StyleServices.GetElementDetails(ttItemNormal), ecTextColor, Result) else Result := FOwner.Font.Color; +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -11817,7 +12593,12 @@ procedure TVTColors.SetColor(const Index: Integer; const Value: TColor); FOwner.Invalidate; end; 7: +{$IFDEF VT_FMX} + FOwner.Repaint; +{$ELSE} RedrawWindow(FOwner.Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE or RDW_NOERASE or RDW_NOCHILDREN) +{$ENDIF} + else FOwner.Invalidate; end; @@ -11862,10 +12643,12 @@ function TClipboardFormats.Add(const S: string): Integer; RegisteredClass: TVirtualTreeClass; begin +{$IFDEF VT_VCL} RegisteredClass := TClipboardFormatList.FindFormat(S, Format); if Assigned(RegisteredClass) and FOwner.ClassType.InheritsFrom(RegisteredClass) then Result := inherited Add(S) else +{$ENDIF} Result := -1; end; @@ -11881,7 +12664,7 @@ procedure TClipboardFormats.Insert(Index: Integer; const S: string); RegisteredClass: TVirtualTreeClass; begin - RegisteredClass := TClipboardFormatList.FindFormat(S, Format); + RegisteredClass := {$IFDEF VT_FMX}nil{$ELSE}TClipboardFormatList.FindFormat(S, Format);{$ENDIF}; if Assigned(RegisteredClass) and FOwner.ClassType.InheritsFrom(RegisteredClass) then inherited Insert(Index, S); end; @@ -11894,15 +12677,34 @@ constructor TBaseVirtualTree.Create(AOwner: TComponent); InitializeGlobalStructures(); inherited; - +{$IFDEF VT_FMX} + FHandleAllocated:= true; + FUseRightToLeftAlignment:= false; + FBackgroundOffsetX:= 0; + FBackgroundOffsetY:= 0; + FMargin:= 4; + FTextMargin:= 4; + FDefaultNodeHeight:= 18; //??? + FIndent:= 18; //??? + FBevelEdges:= [beLeft, beTop, beRight, beBottom]; + FBevelInner:= bvRaised; + FBevelOuter:= bvLowered; + FBevelKind:= bkNone; + FBevelWidth:= 1; + FBorderWidth:= 0; +{$ELSE} ControlStyle := ControlStyle - [csSetCaption] + [csCaptureMouse, csOpaque, csReplicatable, csDisplayDragImage, csReflector]; +{$ENDIF} + FTotalInternalDataSize := 0; FNodeDataSize := -1; Width := 200; Height := 100; TabStop := True; +{$IFDEF VT_VCL} ParentColor := False; +{$ENDIF} FDefaultNodeHeight := 18; FDragOperations := [doCopy, doMove]; FHotCursor := crDefault; @@ -11928,8 +12730,9 @@ constructor TBaseVirtualTree.Create(AOwner: TComponent); FHeader := GetHeaderClass.Create(Self); // we have an own double buffer handling +{$IFDEF VT_VCL} inherited DoubleBuffered := False; - +{$ENDIF} FCheckImageKind := ckSystemDefault; FCheckImages := SystemCheckImages; @@ -11944,7 +12747,7 @@ constructor TBaseVirtualTree.Create(AOwner: TComponent); FAutoScrollDelay := 1000; FAutoScrollInterval := 1; - FBackground := TPicture.Create; + FBackground := {$IFDEF VT_FMX}TImage.Create(Self){$ELSE}TPicture.Create{$ENDIF}; // Similar to the Transparent property of TImage, // this flag is Off by default. FBackGroundImageTransparent := False; @@ -11953,14 +12756,16 @@ constructor TBaseVirtualTree.Create(AOwner: TComponent); FMargin := 4; FTextMargin := 4; FImagesMargin := 2; +{$IFDEF VT_VCL} FLastDragEffect := DROPEFFECT_NONE; +{$ENDIF} FDragType := dtOLE; FDragHeight := 350; FDragWidth := 200; FColors := TVTColors.Create(Self); FEditDelay := 1000; - +{$IFDEF VT_VCL} FDragImage := TVTDragImage.Create(Self); with FDragImage do begin @@ -11969,6 +12774,7 @@ constructor TBaseVirtualTree.Create(AOwner: TComponent); PreBlendBias := 0; Transparency := 200; end; +{$ENDIF} SetLength(FSingletonNodeArray, 1); FAnimationDuration := 200; @@ -11979,10 +12785,14 @@ constructor TBaseVirtualTree.Create(AOwner: TComponent); FIncrementalSearch := isNone; FClipboardFormats := TClipboardFormats.Create(Self); FOptions := GetOptionsClass.Create(Self); - +{$IFDEF VT_VCL} if not (csDesigning in ComponentState) then //Don't create worker thread in IDE, there is no use for it TWorkerThread.AddThreadReference(); +{$ENDIF} VclStyleChanged(); +{$IFDEF VT_FMX} + PrepareBitmaps(True, True); +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -11991,6 +12801,7 @@ destructor TBaseVirtualTree.Destroy; begin // Disconnect all remote MSAA connections +{$IFDEF VT_VCL} if Assigned(FAccessibleItem) then begin CoDisconnectObject(FAccessibleItem, 0); FAccessibleItem := nil; @@ -11999,11 +12810,14 @@ destructor TBaseVirtualTree.Destroy; CoDisconnectObject(fAccessible, 0); fAccessible := nil; end; +{$ENDIF} InterruptValidation(); Exclude(FOptions.FMiscOptions, toReadOnly); +{$IFDEF VT_VCL} // Make sure there is no reference remaining to the releasing tree. TWorkerThread.ReleaseThreadReference(); +{$ENDIF} StopWheelPanning; CancelEditNode; @@ -12012,7 +12826,9 @@ destructor TBaseVirtualTree.Destroy; FClipboardFormats.Free; // Clear will also free the drag manager if it is still alive. Clear; +{$IFDEF VT_VCL} FDragImage.Free; +{$ENDIF} FColors.Free; FBackground.Free; FImageChangeLink.Free; @@ -12021,13 +12837,20 @@ destructor TBaseVirtualTree.Destroy; FScrollBarOptions.Free; // The window handle must be destroyed before the header is freed because it is needed in WM_NCDESTROY. +{$IFDEF VT_VCL} if HandleAllocated then DestroyWindowHandle; +{$ENDIF} // Release FDottedBrush in case WM_NCDESTROY hasn't been triggered. +{$IFDEF VT_FMX} + if FDottedBrush <> nil then + FreeAndNil(FDottedBrush); +{$ELSE} if FDottedBrush <> 0 then DeleteObject(FDottedBrush); FDottedBrush := 0; +{$ENDIF} FHeader.Free; FHeader := nil; // Do not use FreeAndNil() before checking issue #497 @@ -12067,7 +12890,7 @@ procedure TBaseVirtualTree.AdjustTotalCount(Node: PVirtualNode; Value: Integer; // Root node has as parent the tree view. while Assigned(Run) and (Run <> Pointer(Self)) do begin - Inc(Integer(Run.TotalCount), Difference); + System.Inc(Integer(Run.TotalCount), Difference); Run := Run.Parent; end; end; @@ -12075,24 +12898,29 @@ procedure TBaseVirtualTree.AdjustTotalCount(Node: PVirtualNode; Value: Integer; //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.AdjustTotalHeight(Node: PVirtualNode; Value: Integer; Relative: Boolean = False); +procedure TBaseVirtualTree.AdjustTotalHeight(Node: PVirtualNode; Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; Relative: Boolean = False); // Sets a node's total height to the given value and recursively adjusts the parent's total height. var - Difference: Integer; + Difference: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; Run: PVirtualNode; begin if Relative then Difference := Value else - Difference := Value - Integer(Node.TotalHeight); + Difference := Value - {$IFDEF VT_VCL}Integer{$ENDIF}(Node.TotalHeight); if Difference <> 0 then begin Run := Node; repeat +{$IFDEF VT_FMX} + Inc(Run.TotalHeight, Difference); +{$ELSE} Inc(Integer(Run.TotalHeight), Difference); +{$ENDIF} + // If the node is not visible or the parent node is not expanded or we are already at the top // then nothing more remains to do. if not (vsVisible in Run.States) or (Run = FRoot) or @@ -12122,7 +12950,7 @@ function TBaseVirtualTree.CalculateCacheEntryCount: Integer; //---------------------------------------------------------------------------------------------------------------------- procedure TBaseVirtualTree.CalculateVerticalAlignments(ShowImages, ShowStateImages: Boolean; Node: PVirtualNode; - var VAlign, VButtonAlign: Integer); + var VAlign, VButtonAlign: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); // Calculates the vertical alignment of the given node and its associated expand/collapse button during // a node paint cycle depending on the required node alignment style. @@ -12133,7 +12961,7 @@ procedure TBaseVirtualTree.CalculateVerticalAlignments(ShowImages, ShowStateImag naFromTop: VAlign := Node.Align; naFromBottom: - VAlign := Integer(NodeHeight[Node]) - Node.Align; + VAlign := {$IFDEF VT_VCL}Integer{$ENDIF}(NodeHeight[Node]) - Node.Align; else // naProportional // Consider button and line alignment, but make sure neither the image nor the button (whichever is taller) // go out of the entire node height (100% means bottom alignment to the node's bounds). @@ -12142,14 +12970,14 @@ procedure TBaseVirtualTree.CalculateVerticalAlignments(ShowImages, ShowStateImag if ShowImages then VAlign := GetImageSize(Node).cy else - VAlign := FStateImages.Height; - VAlign := MulDiv((Integer(NodeHeight[Node]) - VAlign), Node.Align, 100) + VAlign div 2; + VAlign := {$IFDEF VT_FMX}16{$ELSE}FStateImages.Height{$ENDIF}; //TODO: 16px Image! + VAlign := MulDiv(({$IFDEF VT_VCL}Integer{$ENDIF}(NodeHeight[Node]) - VAlign), Node.Align, 100) + VAlign {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2; end else if toShowButtons in FOptions.FPaintOptions then - VAlign := MulDiv((Integer(NodeHeight[Node]) - FPlusBM.Height), Node.Align, 100) + FPlusBM.Height div 2 + VAlign := MulDiv(({$IFDEF VT_VCL}Integer{$ENDIF}(NodeHeight[Node]) - FPlusBM.Height), Node.Align, 100) + FPlusBM.Height {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2 else - VAlign := MulDiv(Integer(Node.NodeHeight), Node.Align, 100); + VAlign := MulDiv({$IFDEF VT_VCL}Integer{$ENDIF}(Node.NodeHeight), Node.Align, 100); end; VButtonAlign := VAlign - FPlusBM.Height div 2 - (FPlusBM.Height and 1); @@ -12191,7 +13019,7 @@ function TBaseVirtualTree.ChangeCheckState(Node: PVirtualNode; Value: TCheckStat DoStateChange([tsCheckPropagation]); BeginUpdate(); end; - Inc(FCheckPropagationCount); + System.Inc(FCheckPropagationCount); try // Do actions which are associated with the given check state. case CheckType of @@ -12218,11 +13046,11 @@ function TBaseVirtualTree.ChangeCheckState(Node: PVirtualNode; Value: TCheckStat // node's new check state accordingly. case Self.GetCheckState(Run) of csCheckedNormal, csCheckedDisabled: - Inc(CheckedCount); + System.Inc(CheckedCount); csMixedNormal: - Inc(MixedCheckCount); + System.Inc(MixedCheckCount); csUncheckedNormal, csUncheckedDisabled: - Inc(UncheckedCount); + System.Inc(UncheckedCount); end; end; Run := Run.NextSibling; @@ -12257,11 +13085,11 @@ function TBaseVirtualTree.ChangeCheckState(Node: PVirtualNode; Value: TCheckStat // node's new check state accordingly. case Self.GetCheckState(Run) of csCheckedNormal: - Inc(CheckedCount); + System.Inc(CheckedCount); csMixedNormal: - Inc(MixedCheckCount); + System.Inc(MixedCheckCount); csUncheckedNormal: - Inc(UncheckedCount); + System.Inc(UncheckedCount); end; end; Run := Run.NextSibling; @@ -12315,7 +13143,7 @@ function TBaseVirtualTree.ChangeCheckState(Node: PVirtualNode; Value: TCheckStat InvalidateNode(Node); finally - Dec(FCheckPropagationCount); // WL, 05.02.2004 + System.Dec(FCheckPropagationCount); // WL, 05.02.2004 if FCheckPropagationCount = 0 then begin // Allow state change event after all check operations finished DoStateChange([], [tsCheckPropagation]); @@ -12330,7 +13158,7 @@ function TBaseVirtualTree.ChangeCheckState(Node: PVirtualNode; Value: TCheckStat //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.CollectSelectedNodesLTR(MainColumn, NodeLeft, NodeRight: Integer; Alignment: TAlignment; +function TBaseVirtualTree.CollectSelectedNodesLTR(MainColumn: Integer; NodeLeft, NodeRight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; Alignment: TAlignment; OldRect, NewRect: TRect): Boolean; // Helper routine used when a draw selection takes place. This version handles left-to-right directionality. @@ -12345,14 +13173,17 @@ function TBaseVirtualTree.CollectSelectedNodesLTR(MainColumn, NodeLeft, NodeRigh TextLeft, CurrentTop, CurrentRight, - NextTop, + NextTop: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; NextColumn, - NodeWidth, Dummy: Integer; - MinY, MaxY: Integer; - LabelOffset: Integer; +{$IFDEF VT_FMX} + DummySingle: Single; +{$ENDIF} + MinY, MaxY: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + LabelOffset: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; IsInOldRect, IsInNewRect: Boolean; + NodeWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; // quick check variables for various parameters DoSwitch, @@ -12384,7 +13215,7 @@ function TBaseVirtualTree.CollectSelectedNodesLTR(MainColumn, NodeLeft, NodeRigh repeat // Collect offsets for check, normal and state images. TextLeft := NodeLeft + LabelOffset; - NextTop := CurrentTop + Integer(NodeHeight[Run]); + NextTop := CurrentTop + {$IFDEF VT_VCL}Integer{$ENDIF}(NodeHeight[Run]); // Simple selection allows to draw the selection rectangle anywhere. No intersection with node captions is // required. Only top and bottom bounds of the rectangle matter. @@ -12413,7 +13244,7 @@ function TBaseVirtualTree.CollectSelectedNodesLTR(MainColumn, NodeLeft, NodeRigh if NextColumn = MainColumn then CurrentRight := NodeRight else - GetColumnBounds(NextColumn, Dummy, CurrentRight); + GetColumnBounds(NextColumn, {$IFDEF VT_FMX}DummySingle{$ELSE}Dummy{$ENDIF}, CurrentRight); end; end else @@ -12431,7 +13262,7 @@ function TBaseVirtualTree.CollectSelectedNodesLTR(MainColumn, NodeLeft, NodeRigh TextRight := TextLeft + NodeWidth; taCenter: begin - TextLeft := (TextLeft + CurrentRight - NodeWidth) div 2; + TextLeft := (TextLeft + CurrentRight - NodeWidth) {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2; TextRight := TextLeft + NodeWidth; end; else @@ -12473,7 +13304,7 @@ function TBaseVirtualTree.CollectSelectedNodesLTR(MainColumn, NodeLeft, NodeRigh NextNode := GetNextVisibleNoInit(Run, True); if NextNode = nil then Break; - Inc(NodeLeft, CountLevelDifference(Run, NextNode) * Integer(FIndent)); + Inc(NodeLeft, CountLevelDifference(Run, NextNode) * {$IFDEF VT_VCL}Integer{$ENDIF}(FIndent)); Run := NextNode; until CurrentTop > MaxY; end; @@ -12481,7 +13312,7 @@ function TBaseVirtualTree.CollectSelectedNodesLTR(MainColumn, NodeLeft, NodeRigh //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.CollectSelectedNodesRTL(MainColumn, NodeLeft, NodeRight: Integer; Alignment: TAlignment; +function TBaseVirtualTree.CollectSelectedNodesRTL(MainColumn: Integer; NodeLeft, NodeRight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; Alignment: TAlignment; OldRect, NewRect: TRect): Boolean; // Helper routine used when a draw selection takes place. This version handles right-to-left directionality. @@ -12490,16 +13321,22 @@ function TBaseVirtualTree.CollectSelectedNodesRTL(MainColumn, NodeLeft, NodeRigh var Run, NextNode: PVirtualNode; + + NextColumn, + Dummy: Integer; + + NextTop, + NodeWidth, TextRight, TextLeft, CheckOffset, CurrentTop, - CurrentLeft, - NextTop, - NextColumn, - NodeWidth, - Dummy: Integer; - MinY, MaxY: Integer; + CurrentLeft, + MinY, MaxY: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + +{$IFDEF VT_FMX} + DummySingle: Single; +{$ENDIF} IsInOldRect, IsInNewRect: Boolean; @@ -12514,7 +13351,9 @@ function TBaseVirtualTree.CollectSelectedNodesRTL(MainColumn, NodeLeft, NodeRigh // A priori nothing changes. Result := False; // Switch the alignment to the opposite value in RTL context. +{$IFDEF VT_VCL} ChangeBiDiModeAlignment(Alignment); +{$ENDIF} // Determine minimum and maximum vertical coordinates to limit iteration to. MinY := Min(OldRect.Top, NewRect.Top); @@ -12526,7 +13365,7 @@ function TBaseVirtualTree.CollectSelectedNodesRTL(MainColumn, NodeLeft, NodeRigh // Don't check the events here as descendant trees might have overriden the DoGetImageIndex method. WithStateImages := Assigned(FStateImages) or Assigned(OnGetImageIndexEx); if WithCheck then - CheckOffset := FCheckImages.Width + FImagesMargin + CheckOffset := {$IFDEF VT_FMX}16{$ELSE}FCheckImages.Width + FImagesMargin{$ENDIF} //TODO: 16px Image! else CheckOffset := 0; AutoSpan := FHeader.UseColumns and (toAutoSpanColumns in FOptions.FAutoOptions); @@ -12538,9 +13377,9 @@ function TBaseVirtualTree.CollectSelectedNodesRTL(MainColumn, NodeLeft, NodeRigh begin // The initial minimal left border is determined by the identation level of the node and is dynamically adjusted. if toShowRoot in FOptions.FPaintOptions then - Dec(NodeRight, Integer((GetNodeLevel(Run) + 1) * FIndent) + FMargin) + Dec(NodeRight, {$IFDEF VT_VCL}Integer{$ENDIF}((GetNodeLevel(Run) + 1) * FIndent) + FMargin) else - Dec(NodeRight, Integer(GetNodeLevel(Run) * FIndent) + FMargin); + Dec(NodeRight, {$IFDEF VT_VCL}Integer{$ENDIF}(GetNodeLevel(Run) * FIndent) + FMargin); // ----- main loop // Change selection depending on the node's rectangle being in the selection rectangle or not, but @@ -12553,7 +13392,7 @@ function TBaseVirtualTree.CollectSelectedNodesRTL(MainColumn, NodeLeft, NodeRigh Dec(TextRight, GetImageSize(Run, ikNormal, MainColumn).cx); if WithStateImages then Dec(TextRight, GetImageSize(Run, ikState, MainColumn).cx); - NextTop := CurrentTop + Integer(NodeHeight[Run]); + NextTop := CurrentTop + {$IFDEF VT_VCL}Integer{$ENDIF}(NodeHeight[Run]); // Simple selection allows to draw the selection rectangle anywhere. No intersection with node captions is // required. Only top and bottom bounds of the rectangle matter. @@ -12577,7 +13416,7 @@ function TBaseVirtualTree.CollectSelectedNodesRTL(MainColumn, NodeLeft, NodeRigh if NextColumn = MainColumn then CurrentLeft := NodeLeft else - FHeader.FColumns.GetColumnBounds(NextColumn, CurrentLeft, Dummy); + FHeader.FColumns.GetColumnBounds(NextColumn, CurrentLeft, {$IFDEF VT_FMX}DummySingle{$ELSE}Dummy{$ENDIF}); end else CurrentLeft := NodeLeft; @@ -12597,7 +13436,7 @@ function TBaseVirtualTree.CollectSelectedNodesRTL(MainColumn, NodeLeft, NodeRigh end; taCenter: begin - TextLeft := (TextRight + CurrentLeft - NodeWidth) div 2; + TextLeft := (TextRight + CurrentLeft - NodeWidth) {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2; TextRight := TextLeft + NodeWidth; end; else @@ -12638,7 +13477,7 @@ function TBaseVirtualTree.CollectSelectedNodesRTL(MainColumn, NodeLeft, NodeRigh NextNode := GetNextVisibleNoInit(Run, True); if NextNode = nil then Break; - Dec(NodeRight, CountLevelDifference(Run, NextNode) * Integer(FIndent)); + Dec(NodeRight, CountLevelDifference(Run, NextNode) * {$IFDEF VT_VCL}Integer{$ENDIF}(FIndent)); Run := NextNode; until CurrentTop > MaxY; end; @@ -12682,8 +13521,13 @@ procedure TBaseVirtualTree.ClearNodeBackground(const PaintInfo: TVTPaintInfo; Us eaColor: begin // User has given a new background color. +{$IFDEF VT_FMX} + Fill.Color := BackColor; + FillRect(R, 0, 0, [], 1.0); +{$ELSE} Brush.Color := BackColor; FillRect(R); +{$ENDIF} end; else // eaDefault if UseBackground then @@ -12696,33 +13540,37 @@ procedure TBaseVirtualTree.ClearNodeBackground(const PaintInfo: TVTPaintInfo; Us else begin if (poDrawSelection in PaintOptions) and (toFullRowSelect in FOptions.FSelectionOptions) and - (vsSelected in Node.States) and not (toUseBlendedSelection in FOptions.PaintOptions) and not - (tsUseExplorerTheme in FStates) then + (vsSelected in Node.States) and not (toUseBlendedSelection in FOptions.PaintOptions) + {$IFDEF VT_VCL}and not (tsUseExplorerTheme in FStates){$ENDIF} then begin if toShowHorzGridLines in FOptions.PaintOptions then begin - Brush.Color := BackColor; - FillRect(Rect(R.Left, R.Bottom - 1, R.Right, R.Bottom)); + {$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := BackColor; + FillRect(Rect(R.Left, R.Bottom - 1, R.Right, R.Bottom){$IFDEF VT_FMX}, 0, 0, [], 1.0{$ENDIF}); Dec(R.Bottom); end; - if Focused or (toPopupMode in FOptions.FPaintOptions) then + if {$IFDEF VT_FMX}IsFocused{$ELSE}Focused{$ENDIF} or (toPopupMode in FOptions.FPaintOptions) then begin - Brush.Color := FColors.FocusedSelectionColor; - Pen.Color := FColors.FocusedSelectionBorderColor; + {$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := FColors.FocusedSelectionColor; + {$IFDEF VT_FMX}Stroke{$ELSE}Pen{$ENDIF}.Color := FColors.FocusedSelectionBorderColor; end else begin - Brush.Color := FColors.UnfocusedSelectionColor; - Pen.Color := FColors.UnfocusedSelectionBorderColor; + {$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := FColors.UnfocusedSelectionColor; + {$IFDEF VT_FMX}Stroke{$ELSE}Pen{$ENDIF}.Color := FColors.UnfocusedSelectionBorderColor; end; with TWithSafeRect(R) do - RoundRect(Left, Top, Right, Bottom, FSelectionCurveRadius, FSelectionCurveRadius); +{$IFDEF VT_FMX} + DrawRect(RectF(Left, Top, Right, Bottom), FSelectionCurveRadius, FSelectionCurveRadius, AllCorners, 1.0); +{$ELSE} + DrawRect(Rect(Left, Top, Right, Bottom), FSelectionCurveRadius, FSelectionCurveRadius); +{$ENDIF} end else begin - Brush.Color := BackColor; - FillRect(R); + {$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := BackColor; + FillRect(R{$IFDEF VT_FMX}, 0, 0, [], 1.0{$ENDIF}); end; end; end; @@ -12771,13 +13619,13 @@ function TBaseVirtualTree.CompareNodePositions(Node1, Node2: PVirtualNode; Consi while Level1 > Level2 do begin Run1 := Run1.Parent; - Dec(Level1); + System.Dec(Level1); end; Run2 := Node2; while Level2 > Level1 do begin Run2 := Run2.Parent; - Dec(Level2); + System.Dec(Level2); end; // now go up until we find a common parent node (loop will safely stop at FRoot if the nodes @@ -12803,14 +13651,14 @@ procedure TBaseVirtualTree.DrawLineImage(const PaintInfo: TVTPaintInfo; X, Y, H, var HalfWidth, - TargetX: Integer; + TargetX: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; begin - HalfWidth := (FIndent div 2); + HalfWidth := FIndent {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2; if Reverse then TargetX := 0 else - TargetX := Integer(FIndent) + ScaledPixels(FImagesMargin); + TargetX := {$IFDEF VT_VCL}Integer{$ENDIF}(FIndent) + ScaledPixels(FImagesMargin); with PaintInfo.Canvas do begin @@ -12836,19 +13684,19 @@ procedure TBaseVirtualTree.DrawLineImage(const PaintInfo: TVTPaintInfo; X, Y, H, end; ltLeft: // left can also mean right for RTL context if Reverse then - DrawDottedVLine(PaintInfo, Y, Y + H, X + Integer(FIndent)) + DrawDottedVLine(PaintInfo, Y, Y + H, X + {$IFDEF VT_VCL}Integer{$ENDIF}(FIndent)) else DrawDottedVLine(PaintInfo, Y, Y + H, X); ltLeftBottom: if Reverse then begin - DrawDottedVLine(PaintInfo, Y, Y + H, X + Integer(FIndent)); - DrawDottedHLine(PaintInfo, X, X + Integer(FIndent), Y + H); + DrawDottedVLine(PaintInfo, Y, Y + H, X + {$IFDEF VT_VCL}Integer{$ENDIF}(FIndent)); + DrawDottedHLine(PaintInfo, X, X + {$IFDEF VT_VCL}Integer{$ENDIF}(FIndent), Y + H); end else begin DrawDottedVLine(PaintInfo, Y, Y + H, X); - DrawDottedHLine(PaintInfo, X, X + Integer(FIndent), Y + H); + DrawDottedHLine(PaintInfo, X, X + {$IFDEF VT_VCL}Integer{$ENDIF}(FIndent), Y + H); end; end; end; @@ -12856,7 +13704,7 @@ procedure TBaseVirtualTree.DrawLineImage(const PaintInfo: TVTPaintInfo; X, Y, H, //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.FindInPositionCache(Node: PVirtualNode; var CurrentPos: Cardinal): PVirtualNode; +function TBaseVirtualTree.FindInPositionCache(Node: PVirtualNode; var CurrentPos: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}): PVirtualNode; // Looks through the position cache and returns the node whose top position is the largest one which is smaller or equal // to the position of the given node. @@ -12889,7 +13737,7 @@ function TBaseVirtualTree.FindInPositionCache(Node: PVirtualNode; var CurrentPos //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.FindInPositionCache(Position: Cardinal; var CurrentPos: Cardinal): PVirtualNode; +function TBaseVirtualTree.FindInPositionCache(Position: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; var CurrentPos: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}): PVirtualNode; // Looks through the position cache and returns the node whose top position is the largest one which is smaller or equal // to the given vertical position. @@ -12939,7 +13787,7 @@ procedure TBaseVirtualTree.FixupTotalCount(Node: PVirtualNode); while Assigned(Child) do begin FixupTotalCount(Child); - Inc(Node.TotalCount, Child.TotalCount); + System.Inc(Node.TotalCount, Child.TotalCount); Child := Child.NextSibling; end; end; @@ -12999,7 +13847,7 @@ function TBaseVirtualTree.GetCheckedCount: Integer; Node := GetFirstChecked; while Assigned(Node) do begin - Inc(Result); + System.Inc(Result); Node := GetNextChecked(Node); end; end; @@ -13042,6 +13890,18 @@ function TBaseVirtualTree.GetChildrenInitialized(Node: PVirtualNode): Boolean; Result := not (vsHasChildren in Node.States) or (Node.ChildCount > 0); end; +{$IFDEF VT_FMX} +function TBaseVirtualTree.GetClientHeight: Single; +begin + Result:= Height; +end; + +function TBaseVirtualTree.GetClientWidth: Single; +begin + Result:= Width; +end; +{$ENDIF} + //---------------------------------------------------------------------------------------------------------------------- function TBaseVirtualTree.GetCutCopyCount: Integer; @@ -13054,7 +13914,7 @@ function TBaseVirtualTree.GetCutCopyCount: Integer; Node := GetFirstCutCopy; while Assigned(Node) do begin - Inc(Result); + System.Inc(Result); Node := GetNextCutCopy(Node); end; end; @@ -13079,7 +13939,7 @@ function TBaseVirtualTree.GetSyncCheckstateWithSelection(Node: PVirtualNode): Bo end; //---------------------------------------------------------------------------------------------------------------------- - +{$IFDEF VT_VCL} function TBaseVirtualTree.GetDragManager: IVTDragManager; // Returns the internal drag manager interface. If this does not yet exist then it is created here. @@ -13094,6 +13954,7 @@ function TBaseVirtualTree.GetDragManager: IVTDragManager; Result := FDragManager; end; +{$ENDIF} //---------------------------------------------------------------------------------------------------------------------- @@ -13148,7 +14009,7 @@ function TBaseVirtualTree.GetMultiline(Node: PVirtualNode): Boolean; //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.GetNodeHeight(Node: PVirtualNode): Cardinal; +function TBaseVirtualTree.GetNodeHeight(Node: PVirtualNode): {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; begin if Assigned(Node) and (Node <> FRoot) then @@ -13180,7 +14041,7 @@ function TBaseVirtualTree.GetNodeParent(Node: PVirtualNode): PVirtualNode; //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.GetOffset(pElement: TVTElement; pNode: PVirtualNode): integer; +function TBaseVirtualTree.GetOffset(pElement: TVTElement; pNode: PVirtualNode): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; // Calculates the offset of the given element var lOffsets: TVTOffsets; @@ -13209,13 +14070,13 @@ procedure TBaseVirtualTree.GetOffsets(pNode: PVirtualNode; out pOffsets: TVTOffs // plus Indent lNodeLevel := GetNodeLevel(pNode); if toShowRoot in FOptions.FPaintOptions then - Inc(lNodeLevel); + System.Inc(lNodeLevel); end else lNodeLevel := 1; - Inc(pOffsets[TVTElement.ofsCheckBox], lNodeLevel * Integer(FIndent)); + Inc(pOffsets[TVTElement.ofsCheckBox], lNodeLevel * {$IFDEF VT_VCL}Integer{$ENDIF}(FIndent)); // toggle buttons - pOffsets[TVTElement.ofsToggleButton] := pOffsets[TVTElement.ofsCheckBox] - fImagesMargin - ((Integer(FIndent) - FPlusBM.Width) div 2) + 1 - FPlusBM.Width; //Compare PaintTree() relative line 107 + pOffsets[TVTElement.ofsToggleButton] := pOffsets[TVTElement.ofsCheckBox] - fImagesMargin - (({$IFDEF VT_VCL}Integer{$ENDIF}(FIndent) - FPlusBM.Width) {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2) + 1 - FPlusBM.Width; //Compare PaintTree() relative line 107 end;//if MainColumn // The area in which the toggle buttons are painted must have exactly the size of one indent level @@ -13224,7 +14085,7 @@ procedure TBaseVirtualTree.GetOffsets(pNode: PVirtualNode; out pOffsets: TVTOffs // right of checkbox, left of state image if (toCheckSupport in FOptions.FMiscOptions) and Assigned(FCheckImages) and (pNode.CheckType <> ctNone) and (pColumn = Header.MainColumn) then - pOffsets[TVTElement.ofsStateImage] := pOffsets[TVTElement.ofsCheckBox] + FCheckImages.Width + fImagesMargin + pOffsets[TVTElement.ofsStateImage] := pOffsets[TVTElement.ofsCheckBox] + {$IFDEF VT_FMX}16{$ELSE}FCheckImages.Width{$ENDIF} + fImagesMargin //TODO: 16px Image! else pOffsets[TVTElement.ofsStateImage] := pOffsets[TVTElement.ofsCheckBox]; if pElement = TVTElement.ofsStateImage then @@ -13255,7 +14116,7 @@ function TBaseVirtualTree.GetOffsetXY: TPoint; //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.GetRangeX: Cardinal; +function TBaseVirtualTree.GetRangeX: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; begin Result := Max(0, FRangeX); end; @@ -13293,7 +14154,7 @@ function TBaseVirtualTree.GetSelectedData: TArray; function TBaseVirtualTree.GetTopNode: PVirtualNode; var - Dummy: Integer; + Dummy: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; begin Result := GetNodeAt(0, 0, True, Dummy); @@ -13304,11 +14165,11 @@ function TBaseVirtualTree.GetTopNode: PVirtualNode; function TBaseVirtualTree.GetTotalCount: Cardinal; begin - Inc(FUpdateCount); + System.Inc(FUpdateCount); try ValidateNode(FRoot, True); finally - Dec(FUpdateCount); + System.Dec(FUpdateCount); end; // The root node itself doesn't count as node. Result := FRoot.TotalCount - 1; @@ -13415,7 +14276,7 @@ procedure TBaseVirtualTree.HandleClickSelection(LastFocused, NewNode: PVirtualNo //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.HandleDrawSelection(X, Y: Integer): Boolean; +function TBaseVirtualTree.HandleDrawSelection(X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}): Boolean; // Handles multi-selection with a focus rectangle. // Result is True if something changed in selection. @@ -13428,7 +14289,7 @@ function TBaseVirtualTree.HandleDrawSelection(X, Y: Integer): Boolean; // limits of a node and its text NodeLeft, - NodeRight: Integer; + NodeRight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; // alignment and directionality CurrentBidiMode: TBidiMode; @@ -13642,7 +14503,9 @@ procedure TBaseVirtualTree.InterruptValidation; // Check the worker thread existance. It might already be gone (usually on destruction of the last tree). WasValidating := (tsValidating in FStates); +{$IFDEF VT_VCL} TWorkerThread.RemoveTree(Self); +{$ENDIF} if WasValidating then InvalidateCache(); end; @@ -13698,10 +14561,10 @@ function TBaseVirtualTree.MakeNewNode: PVirtualNode; ValidateNodeDataSize(FNodeDataSize); // Take record alignment into account. - Inc(Size, FNodeDataSize); + System.Inc(Size, FNodeDataSize); end//not csDesigning else - Inc(Size, SizeOf(Pointer)); // Fixes #702 + System.Inc(Size, SizeOf(Pointer)); // Fixes #702 Result := AllocMem(Size + FTotalInternalDataSize); @@ -13733,7 +14596,7 @@ function TBaseVirtualTree.PackArray({*}const TheArray: TNodeArray; Count: Intege // The returned value is the number of remaining entries in the array, so the caller can reallocate (shorten) // the selection array if needed or -1 if nothing needs to be changed. -{$ifdef CPUX64} +{$IF Defined(CPUX64) or Defined(VT_FMX)} //{$ifdef CPUX64} var Source, Dest: ^PVirtualNode; ConstOne: NativeInt; @@ -13744,9 +14607,9 @@ function TBaseVirtualTree.PackArray({*}const TheArray: TNodeArray; Count: Intege // Do the fastest scan possible to find the first entry while (Count <> 0) and {not Odd(NativeInt(Source^))} (NativeInt(Source^) and ConstOne = 0) do begin - Inc(Result); - Inc(Source); - Dec(Count); + System.Inc(Result); + System.Inc(Source); + System.Dec(Count); end; if Count <> 0 then @@ -13757,11 +14620,11 @@ function TBaseVirtualTree.PackArray({*}const TheArray: TNodeArray; Count: Intege if {not Odd(NativeInt(Source^))} NativeInt(Source^) and ConstOne = 0 then begin Dest^ := Source^; - Inc(Result); - Inc(Dest); + System.Inc(Result); + System.Inc(Dest); end; - Inc(Source); // Point to the next entry - Dec(Count); + System.Inc(Source); // Point to the next entry + System.Dec(Count); until Count = 0; end; end; @@ -13807,7 +14670,7 @@ function TBaseVirtualTree.PackArray({*}const TheArray: TNodeArray; Count: Intege POP EDI POP EBX end; -{$endif CPUX64} +{$IFEND} //{$endif CPUX64} //---------------------------------------------------------------------------------------------------------------------- @@ -13820,16 +14683,27 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean); LineBitsSolid: array [0..7] of Word = (0, 0, 0, 0, 0, 0, 0, 0); var - PatternBitmap: HBITMAP; + PatternBitmap: {$IFDEF VT_FMX}TBitmap{$ELSE}HBITMAP{$ENDIF}; Bits: Pointer; Size: TSize; +{$IFDEF VT_FMX} + Theme: Integer; +{$ELSE} Theme: HTHEME; +{$ENDIF} R: TRect; //--------------- local function -------------------------------------------- procedure FillBitmap (ABitmap: TBitmap); begin + //i hate "with" clause!!! Karol Bieniaszewski +{$IFDEF VT_FMX} + ABitmap.SetSize(9, 9); + + ABitmap.Canvas.Fill.Color := $00FF00FF; // TAlphaColorRec.Fuchsia; + ABitmap.Clear(ABitmap.Canvas.Fill.Color); +{$ELSE} with ABitmap, Canvas do begin SetSize(Size.cx, Size.cy); @@ -13849,11 +14723,13 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean); FillRect(Rect(0, 0, Width, Height)); end; +{$ENDIF} end; //--------------- end local function ---------------------------------------- begin +{$IFDEF VT_VCL} if VclStyleEnabled and (seClient in StyleElements) then begin Size.cx := ScaledPixels(11); @@ -13876,9 +14752,11 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean); FOnPrepareButtonImages(Self, FPlusBM, FHotPlusBM, FSelectedHotPlusBM, FMinusBM, FHotMinusBM, FSelectedHotMinusBM, size); end else +{$ENDIF} begin Size.cx := 9; Size.cy := 9; +{$IFDEF VT_VCL} if tsUseThemes in FStates then begin R := Rect(0, 0, 100, 100); @@ -13886,12 +14764,14 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean); GetThemePartSize(Theme, FPlusBM.Canvas.Handle, TVP_GLYPH, GLPS_OPENED, @R, TS_TRUE, Size); end else +{$ENDIF} Theme := 0; + if NeedButtons then begin //VCL Themes do not really have ability to provide tree plus/minus images when not using the - //windows theme. The bitmap style designer doesn't have any elements for for them, and you + //windows theme. The bitmap style designer doesn't have any elements for them, and you //cannot name any elements you add, which makes it useless. //To mitigate this, Hook up the OnPrepareButtonImages and draw them yourself. if Assigned(FOnPrepareButtonImages) then @@ -13906,7 +14786,7 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean); end else begin - with FMinusBM, Canvas do + with FMinusBM{$IFDEF VT_VCL}, Canvas{$ENDIF} do begin // box is always of odd size FillBitmap(FMinusBM); @@ -13916,13 +14796,15 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean); // Because the self-drawn bitmaps view Vcl Style shit if Theme = 0 then begin +{$IFDEF VT_VCL} if not(tsUseExplorerTheme in FStates) then +{$ENDIF} begin if FButtonStyle = bsTriangle then begin - Brush.Color := clBlack; - Pen.Color := clBlack; - Polygon([Point(0, 2), Point(8, 2), Point(4, 6)]); + FMinusBM.Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := clBlack; + FMinusBM.Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := clBlack; + FMinusBM.Canvas.{$IFDEF VT_FMX}DrawPolygon{$ELSE}Polygon{$ENDIF}([Point(0, 2), Point(8, 2), Point(4, 6)]{$IFDEF VT_FMX}, 1.0{$ENDIF}); end else begin @@ -13931,38 +14813,72 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean); begin case FButtonFillMode of fmTreeColor: - Brush.Color := FColors.BackGroundColor; + FMinusBM.Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := FColors.BackGroundColor; fmWindowColor: - Brush.Color := clWindow; + FMinusBM.Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := clWindow; end; +{$IFDEF VT_FMX} + FMinusBM.Canvas.BeginScene(); + FMinusBM.Canvas.Stroke.Color := FColors.TreeLineColor; + FMinusBM.Canvas.DrawRect(Rect(1, 1, FMinusBM.Width-1, FMinusBM.Height-1), 0, 0, [], 1.0); + FMinusBM.Canvas.Stroke.Color := FColors.NodeFontColor; + FMinusBM.Canvas.DrawLine(Point(2, FMinusBM.Width / 2), Point(FMinusBM.Width - 2, FMinusBM.Width / 2), 1.0); + FMinusBM.Canvas.EndScene(); +{$ELSE} Pen.Color := FColors.TreeLineColor; Rectangle(0, 0, Width, Height); Pen.Color := FColors.NodeFontColor; MoveTo(2, Width div 2); LineTo(Width - 2, Width div 2); + +{$ENDIF} end - else - FMinusBM.Handle := LoadBitmap(HInstance, 'VT_XPBUTTONMINUS'); - end; + else + begin +{$IFDEF VT_FMX} + //load_bitmap_from_resource(FMinusBM, 'VT_XPBUTTONMINUS'); //TODO: is this still releated to Windows??? +{$ELSE} + FMinusBM.Handle := LoadBitmap(HInstance, 'VT_XPBUTTONMINUS'); +{$ENDIF} + end; + end; + +{$IFDEF VT_FMX} + FHotMinusBM.Canvas.DrawBitmap(//###!!! + FMinusBM + , RectF(0, 0, FMinusBM.Width, FMinusBM.Height) + , RectF(0, 0, FMinusBM.Width, FMinusBM.Height) + , 1.0 + ); + FSelectedHotMinusBM.Canvas.DrawBitmap(//###!!! + FMinusBM + , RectF(0, 0, FMinusBM.Width, FMinusBM.Height) + , RectF(0, 0, FMinusBM.Width, FMinusBM.Height) + , 1.0 + ); +{$ELSE} FHotMinusBM.Canvas.Draw(0, 0, FMinusBM); FSelectedHotMinusBM.Canvas.Draw(0, 0, FMinusBM); +{$ENDIF} end; end; end; - with FPlusBM, Canvas do + with FPlusBM{$IFDEF VT_VCL}, Canvas{$ENDIF} do begin FillBitmap(FPlusBM); FillBitmap(FHotPlusBM); FillBitmap(FSelectedHotPlusBM); if Theme = 0 then begin +{$IFDEF VT_VCL} if not(tsUseExplorerTheme in FStates) then +{$ENDIF} begin if FButtonStyle = bsTriangle then begin - Brush.Color := clBlack; - Pen.Color := clBlack; - Polygon([Point(2, 0), Point(6, 4), Point(2, 8)]); + FPlusBM.Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := clBlack; + FPlusBM.Canvas.{$IFDEF VT_FMX}Stroke{$ELSE}Pen{$ENDIF}.Color := clBlack; + FPlusBM.Canvas.{$IFDEF VT_FMX}DrawPolygon{$ELSE}Polygon{$ENDIF}([Point(2, 0), Point(6, 4), Point(2, 8)]{$IFDEF VT_FMX}, 1.0{$ENDIF}); end else begin @@ -13971,10 +14887,19 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean); begin case FButtonFillMode of fmTreeColor: - Brush.Color := FColors.BackGroundColor; + FPlusBM.Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := FColors.BackGroundColor; fmWindowColor: - Brush.Color := clWindow; + FPlusBM.Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := clWindow; end; +{$IFDEF VT_FMX} + FPlusBM.Canvas.BeginScene(); + FPlusBM.Canvas.Stroke.Color := FColors.TreeLineColor; + FPlusBM.Canvas.DrawRect(Rect(1, 1, FPlusBM.Width-1, FPlusBM.Height-1), 0, 0, [], 1.0); //###!!! czy jeszcze fill + FPlusBM.Canvas.Stroke.Color := FColors.NodeFontColor; + FPlusBM.Canvas.DrawLine(Point(2, FPlusBM.Canvas.Width / 2), Point(FPlusBM.Canvas.Width - 2, FPlusBM.Canvas.Width / 2), 1.0); + FPlusBM.Canvas.DrawLine(Point(FPlusBM.Canvas.Width / 2, 2), Point(FPlusBM.Canvas.Width / 2, FPlusBM.Canvas.Width - 2), 1.0); + FPlusBM.Canvas.EndScene(); +{$ELSE} Pen.Color := FColors.TreeLineColor; Rectangle(0, 0, Width, Height); Pen.Color := FColors.NodeFontColor; @@ -13982,18 +14907,42 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean); LineTo(Width - 2, Width div 2); MoveTo(Width div 2, 2); LineTo(Width div 2, Width - 2); +{$ENDIF} end else - FPlusBM.Handle := LoadBitmap(HInstance, 'VT_XPBUTTONPLUS'); - end; + begin +{$IFDEF VT_FMX} + //load_bitmap_from_resource(FPlusBM, 'VT_XPBUTTONPLUS'); //TODO: is this still releated to Windows??? +{$ELSE} + FPlusBM.Handle := LoadBitmap(HInstance, 'VT_XPBUTTONPLUS'); +{$ENDIF} + end; + end; +{$IFDEF VT_FMX} + FHotPlusBM.Canvas.DrawBitmap(//###!!! + FMinusBM + , Rect(0, 0, FMinusBM.Width, FMinusBM.Height) + , Rect(0, 0, FMinusBM.Width, FMinusBM.Height) + , 1.0 + ); + + FSelectedHotPlusBM.Canvas.DrawBitmap(//###!!! + FPlusBM + , Rect(0, 0, FPlusBM.Width, FPlusBM.Height) + , Rect(0, 0, FPlusBM.Width, FPlusBM.Height) + , 1.0 + ); +{$ELSE} FHotPlusBM.Canvas.Draw(0, 0, FPlusBM); FSelectedHotPlusBM.Canvas.Draw(0, 0, FPlusBM); +{$ENDIF} end; end; end; // Overwrite glyph images if theme is active. +{$IFDEF VT_VCL} if (tsUseThemes in FStates) and (Theme <> 0) then begin R := Rect(0, 0, Size.cx, Size.cy); @@ -14005,7 +14954,7 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean); DrawThemeBackground(Theme, FSelectedHotPlusBM.Canvas.Handle, TVP_HOTGLYPH, GLPS_CLOSED, R, nil); DrawThemeBackground(Theme, FHotMinusBM.Canvas.Handle, TVP_HOTGLYPH, GLPS_OPENED, R, nil); DrawThemeBackground(Theme, FSelectedHotMinusBM.Canvas.Handle, TVP_HOTGLYPH, GLPS_OPENED, R, nil); - end + end else begin FHotPlusBM.Canvas.Draw(0, 0, FPlusBM); @@ -14013,17 +14962,24 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean); FHotMinusBM.Canvas.Draw(0, 0, FMinusBM); FSelectedHotMinusBM.Canvas.Draw(0, 0, FMinusBM); end; - end; + end; +{$ENDIF} end; +{$IFDEF VT_VCL} if tsUseThemes in FStates then CloseThemeData(Theme); +{$ENDIF} end; end; if NeedLines then begin +{$IFDEF VT_FMX} + FreeAndNil(FDottedBrush); +{$ELSE} if FDottedBrush <> 0 then DeleteObject(FDottedBrush); +{$ENDIF} case FLineStyle of lsDotted: Bits := @LineBitsDotted; @@ -14033,10 +14989,19 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean); Bits := @LineBitsDotted; DoGetLineStyle(Bits); end; +{$IFDEF VT_FMX} + PatternBitmap := TBitmap.Create(8, 8); //###!!! CreateBitmap(8, 8, 1, 1, Bits); + FDottedBrush := TBrush.Create(TBrushKind.Bitmap, clWhite); //###!!! CreatePatternBrush(PatternBitmap); + FDottedBrush.Bitmap.Bitmap.Assign(PatternBitmap); + FreeAndNil(PatternBitmap); +{$ELSE} PatternBitmap := CreateBitmap(8, 8, 1, 1, Bits); FDottedBrush := CreatePatternBrush(PatternBitmap); DeleteObject(PatternBitmap); +{$ENDIF} end; + FMinusBM.SaveToFile('R:\Minus.png'); + FPlusBM.SaveToFile('R:\Plus.png'); end; //---------------------------------------------------------------------------------------------------------------------- @@ -14073,7 +15038,7 @@ procedure TBaseVirtualTree.SetAnimationDuration(const Value: Cardinal); set the flag BackgroundTransparentExternalType explicitly in order to properly do transparent painting. } -procedure TBaseVirtualTree.SetBackground(const Value: TPicture); +procedure TBaseVirtualTree.SetBackground(const Value: {$IFDEF VT_FMX}TImage{$ELSE}TPicture{$ENDIF}); begin FBackground.Assign(Value); @@ -14094,7 +15059,7 @@ procedure TBaseVirtualTree.SetBackGroundImageTransparent(const Value: Boolean); //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.SetBackgroundOffset(const Index, Value: Integer); +procedure TBaseVirtualTree.SetBackgroundOffset(const Index: Integer; const Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); begin case Index of @@ -14145,14 +15110,14 @@ procedure TBaseVirtualTree.SetBottomNode(Node: PVirtualNode); Run := Run.Parent; end; R := GetDisplayRect(Node, FHeader.MainColumn, True); - DoSetOffsetXY(Point(FOffsetX, FOffsetY + ClientHeight - R.Top - Integer(NodeHeight[Node])), + DoSetOffsetXY(Point(FOffsetX, FOffsetY + ClientHeight - R.Top - {$IFDEF VT_VCL}Integer{$ENDIF}(NodeHeight[Node])), [suoRepaintScrollBars, suoUpdateNCArea]); end; end; //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.SetBottomSpace(const Value: Cardinal); +procedure TBaseVirtualTree.SetBottomSpace(const Value: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}); begin if FBottomSpace <> Value then @@ -14212,7 +15177,7 @@ procedure TBaseVirtualTree.SetCheckImageKind(Value: TCheckImageKind); else FCheckImages := SystemCheckImages; if HandleAllocated and (FUpdateCount = 0) and not (csLoading in ComponentState) then - InvalidateRect(Handle, nil, False); + {$IFDEF VT_FMX}Repaint{$ELSE}InvalidateRect(Handle, nil, False){$ENDIF}; end; end; @@ -14238,7 +15203,9 @@ procedure TBaseVirtualTree.SetCheckStateForAll(aCheckState: TCheckState; pSelect lItem : PVirtualNode; begin With Self do begin +{$IFDEF VT_VCL} Screen.Cursor := crHourGlass; +{$ENDIF} BeginUpdate; try if pSelectedOnly then @@ -14255,7 +15222,9 @@ procedure TBaseVirtualTree.SetCheckStateForAll(aCheckState: TCheckState; pSelect lItem := GetNext(lItem); end;//while finally +{$IFDEF VT_VCL} Screen.Cursor := crDefault; +{$ENDIF} EndUpdate; end;//try..finally end;//With @@ -14301,14 +15270,15 @@ procedure TBaseVirtualTree.SetChildCount(Node: PVirtualNode; NewChildCount: Card Index: Cardinal; Child: PVirtualNode; Count: Integer; - NewHeight: Integer; + NewHeight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; begin if not (toReadOnly in FOptions.FMiscOptions) then begin if Node = nil then Node := FRoot; - +{$IFDEF VT_VCL} Assert(GetCurrentThreadId = MainThreadId, 'UI controls may only be chnaged in UI thread.'); +{$ENDIF} if NewChildCount = 0 then DeleteChildren(Node) else @@ -14334,7 +15304,7 @@ procedure TBaseVirtualTree.SetChildCount(Node: PVirtualNode; NewChildCount: Card end; Node.States := Node.States - [vsAllChildrenHidden, vsHeightMeasured]; if (vsExpanded in Node.States) and FullyVisible[Node] then - Inc(FVisibleCount, Count); // Do this before a possible init of the sub-nodes in DoMeasureItem() + System.Inc(FVisibleCount, Count); // Do this before a possible init of the sub-nodes in DoMeasureItem() // New nodes are by default always visible, so we don't need to check the visibility. while Remaining > 0 do @@ -14348,8 +15318,8 @@ procedure TBaseVirtualTree.SetChildCount(Node: PVirtualNode; NewChildCount: Card Node.LastChild := Child; if Node.FirstChild = nil then Node.FirstChild := Child; - Dec(Remaining); - Inc(Index); + System.Dec(Remaining); + System.Inc(Index); if (toVariableNodeHeight in FOptions.FMiscOptions) then GetNodeHeight(Child); @@ -14373,7 +15343,7 @@ procedure TBaseVirtualTree.SetChildCount(Node: PVirtualNode; NewChildCount: Card while Remaining > 0 do begin DeleteNode(Node.LastChild); - Dec(Remaining); + System.Dec(Remaining); end; end; @@ -14425,7 +15395,11 @@ procedure TBaseVirtualTree.SetCustomCheckImages(const Value: TCustomImageList); begin if Assigned(FCustomCheckImages) then begin +{$IFDEF VT_FMX} + FCustomCheckChangeLink.Images:= nil; +{$ELSE} FCustomCheckImages.UnRegisterChanges(FCustomCheckChangeLink); +{$ENDIF} FCustomCheckImages.RemoveFreeNotification(Self); // Reset the internal check image list reference too, if necessary. if FCheckImages = FCustomCheckImages then @@ -14434,7 +15408,11 @@ procedure TBaseVirtualTree.SetCustomCheckImages(const Value: TCustomImageList); FCustomCheckImages := Value; if Assigned(FCustomCheckImages) then begin +{$IFDEF VT_FMX} + FCustomCheckChangeLink.Images:= FCustomCheckImages; +{$ELSE} FCustomCheckImages.RegisterChanges(FCustomCheckChangeLink); +{$ENDIF} FCustomCheckImages.FreeNotification(Self); // If custom check images are assigned, we switch the property CheckImageKind to ckCustom so that they are actually used FCheckImageKind := ckCustom; @@ -14451,15 +15429,20 @@ procedure TBaseVirtualTree.SetCustomCheckImages(const Value: TCustomImageList); //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.SetDefaultNodeHeight(Value: Cardinal); +procedure TBaseVirtualTree.SetDefaultNodeHeight(Value: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}); begin if Value = 0 then Value := 18; if FDefaultNodeHeight <> Value then begin +{$IFDEF VT_FMX} + Inc(FRoot.TotalHeight, (Value) - (FDefaultNodeHeight)); + Inc(FRoot.NodeHeight, (Value) - (FDefaultNodeHeight)); +{$ELSE} Inc(Integer(FRoot.TotalHeight), Integer(Value) - Integer(FDefaultNodeHeight)); Inc(SmallInt(FRoot.NodeHeight), Integer(Value) - Integer(FDefaultNodeHeight)); +{$ENDIF} FDefaultNodeHeight := Value; InvalidateCache; if (FUpdateCount = 0) and HandleAllocated and not (csLoading in ComponentState) then @@ -14653,10 +15636,10 @@ procedure TBaseVirtualTree.SetFiltered(Node: PVirtualNode; Value: Boolean); if (vsInitializing in Node.States) and not (vsHasChildren in Node.States) then AdjustTotalHeight(Node, 0, False) else - AdjustTotalHeight(Node, -Integer(NodeHeight[Node]), True); + AdjustTotalHeight(Node, -{$IFDEF VT_VCL}Integer{$ENDIF}(NodeHeight[Node]), True); if FullyVisible[Node] then begin - Dec(FVisibleCount); + System.Dec(FVisibleCount); NeedUpdate := True; end; if FocusedNode = Node then @@ -14673,10 +15656,10 @@ procedure TBaseVirtualTree.SetFiltered(Node: PVirtualNode; Value: Boolean); Exclude(Node.States, vsFiltered); if not (toShowFilteredNodes in FOptions.FPaintOptions) then begin - AdjustTotalHeight(Node, Integer(NodeHeight[Node]), True); + AdjustTotalHeight(Node, {$IFDEF VT_VCL}Integer{$ENDIF}(NodeHeight[Node]), True); if FullyVisible[Node] then begin - Inc(FVisibleCount); + System.Inc(FVisibleCount); NeedUpdate := True; end; end; @@ -14705,13 +15688,21 @@ procedure TBaseVirtualTree.SetImages(const Value: TCustomImageList); begin if Assigned(FImages) then begin +{$IFDEF VT_FMX} + FImageChangeLink.Images:= nil; +{$ELSE} FImages.UnRegisterChanges(FImageChangeLink); +{$ENDIF} FImages.RemoveFreeNotification(Self); end; FImages := Value; if Assigned(FImages) then begin +{$IFDEF VT_FMX} + FImageChangeLink.Images:= FImages; +{$ELSE} FImages.RegisterChanges(FImageChangeLink); +{$ENDIF} FImages.FreeNotification(Self); end; if not (csLoading in ComponentState) then @@ -14721,7 +15712,7 @@ procedure TBaseVirtualTree.SetImages(const Value: TCustomImageList); //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.SetIndent(Value: Cardinal); +procedure TBaseVirtualTree.SetIndent(Value: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}); begin if FIndent <> Value then @@ -14767,7 +15758,7 @@ procedure TBaseVirtualTree.SetLineStyle(const Value: TVTLineStyle); //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.SetMargin(Value: Integer); +procedure TBaseVirtualTree.SetMargin(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); begin if FMargin <> Value then @@ -14867,15 +15858,15 @@ procedure TBaseVirtualTree.SetNodeDataSize(Value: Integer); //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.SetNodeHeight(Node: PVirtualNode; Value: Cardinal); +procedure TBaseVirtualTree.SetNodeHeight(Node: PVirtualNode; Value: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}); var - Difference: Integer; + Difference: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; begin if Assigned(Node) and (Node <> FRoot) and (Node.NodeHeight <> Value) and not (toReadOnly in FOptions.FMiscOptions) then begin - Difference := Integer(Value) - Integer(Node.NodeHeight); + Difference := {$IFDEF VT_VCL}Integer{$ENDIF}(Value) - {$IFDEF VT_VCL}Integer{$ENDIF}(Node.NodeHeight); Node.NodeHeight := Value; // If the node is effectively filtered out, nothing else has to be done, as it is not visible anyway. @@ -14912,7 +15903,7 @@ procedure TBaseVirtualTree.SetNodeParent(Node: PVirtualNode; const Value: PVirtu //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.SetOffsetX(const Value: Integer); +procedure TBaseVirtualTree.SetOffsetX(const Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); begin DoSetOffsetXY(Point(Value, FOffsetY), DefaultScrollUpdateFlags); @@ -14928,7 +15919,7 @@ procedure TBaseVirtualTree.SetOffsetXY(const Value: TPoint); //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.SetOffsetY(const Value: Integer); +procedure TBaseVirtualTree.SetOffsetY(const Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); begin DoSetOffsetXY(Point(FOffsetX, Value), DefaultScrollUpdateFlags); @@ -14944,7 +15935,7 @@ procedure TBaseVirtualTree.SetOptions(const Value: TCustomVirtualTreeOptions); //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.SetRangeX(value: Cardinal); +procedure TBaseVirtualTree.SetRangeX(value: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}); begin FRangeX := value; end; @@ -15057,13 +16048,21 @@ procedure TBaseVirtualTree.SetStateImages(const Value: TCustomImageList); begin if Assigned(FStateImages) then begin +{$IFDEF VT_FMX} + FStateChangeLink.Images:= nil; +{$ELSE} FStateImages.UnRegisterChanges(FStateChangeLink); +{$ENDIF} FStateImages.RemoveFreeNotification(Self); end; FStateImages := Value; if Assigned(FStateImages) then begin +{$IFDEF VT_FMX} + FStateChangeLink.Images:= FStateImages; +{$ELSE} FStateImages.RegisterChanges(FStateChangeLink); +{$ENDIF} FStateImages.FreeNotification(Self); end; if HandleAllocated and not (csLoading in ComponentState) then @@ -15073,7 +16072,7 @@ procedure TBaseVirtualTree.SetStateImages(const Value: TCustomImageList); //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.SetTextMargin(Value: Integer); +procedure TBaseVirtualTree.SetTextMargin(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); begin if FTextMargin <> Value then @@ -15117,7 +16116,11 @@ procedure TBaseVirtualTree.SetUpdateState(Updating: Boolean); // updating is allowed. As this happens internally the VCL does not get notified and // still assumes the control is hidden. This results in weird "cannot focus invisible control" errors. if Visible and HandleAllocated and (FUpdateCount = 0) then +{$IFDEF VT_FMX} + Repaint; +{$ELSE} SendMessage(Handle, WM_SETREDRAW, Ord(not Updating), 0); +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -15158,7 +16161,7 @@ procedure TBaseVirtualTree.SetVisible(Node: PVirtualNode; Value: Boolean); AdjustTotalHeight(Node.Parent, Node.TotalHeight, True); if VisiblePath[Node] then begin - Inc(FVisibleCount, CountVisibleChildren(Node) + Cardinal(IfThen(IsEffectivelyVisible[Node], 1))); + System.Inc(FVisibleCount, CountVisibleChildren(Node) + Cardinal(IfThen(IsEffectivelyVisible[Node], 1))); NeedUpdate := True; end; @@ -15170,10 +16173,10 @@ procedure TBaseVirtualTree.SetVisible(Node: PVirtualNode; Value: Boolean); else begin if vsExpanded in Node.Parent.States then - AdjustTotalHeight(Node.Parent, -Integer(Node.TotalHeight), True); + AdjustTotalHeight(Node.Parent, -{$IFDEF VT_VCL}Integer{$ENDIF}(Node.TotalHeight), True); if VisiblePath[Node] then begin - Dec(FVisibleCount, CountVisibleChildren(Node) + Cardinal(IfThen(IsEffectivelyVisible[Node], 1))); + System.Dec(FVisibleCount, CountVisibleChildren(Node) + Cardinal(IfThen(IsEffectivelyVisible[Node], 1))); NeedUpdate := True; end; Exclude(Node.States, vsVisible); @@ -15216,8 +16219,8 @@ procedure TBaseVirtualTree.SetVisiblePath(Node: PVirtualNode; Value: Boolean); end; // ---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.PrepareBackGroundPicture(Source: TPicture; - DrawBitmap: TBitmap; DrawBitmapWidth: Integer; DrawBitMapHeight: Integer; ABkgcolor: TColor); +procedure TBaseVirtualTree.PrepareBackGroundPicture(Source: {$IFDEF VT_FMX}TImage{$ELSE}TPicture{$ENDIF}; + DrawBitmap: TBitmap; DrawBitmapWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; DrawBitMapHeight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; ABkgcolor: TColor); const DST = $00AA0029; // Ternary Raster Operation - Destination unchanged @@ -15225,13 +16228,20 @@ procedure TBaseVirtualTree.PrepareBackGroundPicture(Source: TPicture; // will not disturb non-transparent ones procedure FillDrawBitmapWithBackGroundColor; begin - DrawBitmap.Canvas.Brush.Color := ABkgcolor; - DrawBitmap.Canvas.FillRect(Rect(0, 0, DrawBitmap.Width, DrawBitmap.Height)); + DrawBitmap.Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := ABkgcolor; + DrawBitmap.Canvas.FillRect(Rect(0, 0, DrawBitmap.Width, DrawBitmap.Height){$IFDEF VT_FMX}, 0, 0, [], 1.0{$ENDIF}); end; begin - DrawBitmap.SetSize(DrawBitmapWidth, DrawBitMapHeight); - + DrawBitmap.SetSize({$IFDEF VT_FMX}Round{$ENDIF}(DrawBitmapWidth), {$IFDEF VT_FMX}Round{$ENDIF}(DrawBitMapHeight)); //TODO: round is not good at all!!! +{$IFDEF VT_FMX} + DrawBitmap.Canvas.DrawBitmap(//###!!! + Source.Bitmap + , Rect(0, 0, Source.Width, Source.Height) + , Rect(0, 0, Source.Width, Source.Height) + , 1.0 + ); +{$ELSE} if (Source.Graphic is TBitmap) and (FBackGroundImageTransparent or Source.Bitmap.TRANSPARENT) then @@ -15249,11 +16259,12 @@ procedure TBaseVirtualTree.PrepareBackGroundPicture(Source: TPicture; FillDrawBitmapWithBackGroundColor; DrawBitmap.Canvas.Draw(0, 0, Source.Graphic); end +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.StaticBackground(Source: TPicture; Target: TCanvas; OffsetPosition: TPoint; R: TRect; aBkgColor: TColor); +procedure TBaseVirtualTree.StaticBackground(Source: {$IFDEF VT_FMX}TImage{$ELSE}TPicture{$ENDIF}; Target: TCanvas; OffsetPosition: TPoint; R: TRectF; aBkgColor: TColor); // Draws the given source graphic so that it stays static in the given rectangle which is relative to the target bitmap. // The graphic is aligned so that it always starts at the upper left corner of the target canvas. @@ -15271,8 +16282,8 @@ procedure TBaseVirtualTree.StaticBackground(Source: TPicture; Target: TCanvas; O DrawBitmap := TBitmap.Create; try // clear background - Target.Brush.Color := aBkgColor; - Target.FillRect(R); + Target.{$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := aBkgColor; + Target.FillRect(R{$IFDEF VT_FMX}, 0, 0, [], 1.0{$ENDIF}); // Picture rect in relation to client viewscreen. PicRect := Rect(FBackgroundOffsetX, FBackgroundOffsetY, FBackgroundOffsetX + Source.Width, FBackgroundOffsetY + Source.Height); @@ -15285,9 +16296,17 @@ procedure TBaseVirtualTree.StaticBackground(Source: TPicture; Target: TCanvas; O begin PrepareBackGroundPicture(Source, DrawBitmap, Source.Width, Source.Height, aBkgColor); // copy image to destination +{$IFDEF VT_FMX} + Target.DrawBitmap(DrawBitmap + ,Rect(DrawRect.Left - OffsetPosition.X, DrawRect.Top - OffsetPosition.Y, (DrawRect.Right - OffsetPosition.X) - (DrawRect.Left - OffsetPosition.X), (DrawRect.Bottom - OffsetPosition.Y) - (DrawRect.Top - OffsetPosition.Y) + R.Top) + ,Rect(DrawRect.Left - PicRect.Left, DrawRect.Top - PicRect.Top, DrawRect.Left, DrawRect.Top) + , 1.0 + ); +{$ELSE} BitBlt(Target.Handle, DrawRect.Left - OffsetPosition.X, DrawRect.Top - OffsetPosition.Y, (DrawRect.Right - OffsetPosition.X) - (DrawRect.Left - OffsetPosition.X), (DrawRect.Bottom - OffsetPosition.Y) - (DrawRect.Top - OffsetPosition.Y) + R.Top, DrawBitmap.Canvas.Handle, DrawRect.Left - PicRect.Left, DrawRect.Top - PicRect.Top, SRCCOPY); +{$ENDIF} end; finally DrawBitmap.Free; @@ -15297,24 +16316,126 @@ procedure TBaseVirtualTree.StaticBackground(Source: TPicture; Target: TCanvas; O //---------------------------------------------------------------------------------------------------------------------- procedure TBaseVirtualTree.StopTimer(ID: Integer); - begin +{$IFDEF VT_VCL} if HandleAllocated then KillTimer(Handle, ID); +{$ENDIF} +end; + +//---------------------------------------------------------------------------------------------------------------------- +{$IFDEF VT_FMX} +procedure TBaseVirtualTree.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 TBaseVirtualTree.SetBevelEdges(const Value: TBevelEdges); +begin + if Value <> FBevelEdges then + begin + FBevelEdges := Value; + Repaint; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetBevelKind(const Value: TBevelKind); +begin + if Value <> FBevelKind then + begin + FBevelKind := Value; + Repaint; + end; +end; +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetBevelWidth(const Value: TBevelWidth); +begin + if Value <> FBevelWidth then + begin + FBevelWidth := Value; + Repaint; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.ScreenToClient(P: TPoint): TPoint; +begin + Result:= AbsoluteToLocal(P); end; +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.ClientToScreen(P: TPoint): TPoint; +begin + Result:= LocalToAbsolute(P); +end; + +//---------------------------------------------------------------------------------------------------------------------- +procedure TBaseVirtualTree.Invalidate(); +begin + Repaint; +end; +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.RecreateWnd(); +begin + Repaint; +end; +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetBiDiMode(Value: TBiDiMode); +begin + if FBiDiMode <> Value then + begin + FBiDiMode := Value; + Repaint; + end; +end; +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetBorderWidth(Value: TBorderWidth); +begin + if FBorderWidth <> Value then + begin + FBorderWidth := Value; + Repaint; + end; +end; + +{$ENDIF} //---------------------------------------------------------------------------------------------------------------------- procedure TBaseVirtualTree.SetWindowTheme(const Theme: string); begin FChangingTheme := True; +{$IFDEF VT_VCL} Winapi.UxTheme.SetWindowTheme(Handle, PWideChar(Theme), nil); +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.TileBackground(Source: TPicture; Target: TCanvas; Offset: TPoint; R: TRect; aBkgColor: TColor); +procedure TBaseVirtualTree.TileBackground(Source: {$IFDEF VT_FMX}TImage{$ELSE}TPicture{$ENDIF}; Target: TCanvas; Offset: TPoint; R: TRect; aBkgColor: TColor); // Draws the given source graphic so that it tiles into the given rectangle which is relative to the target bitmap. // The graphic is aligned so that it always starts at the upper left corner of the target canvas. @@ -15327,6 +16448,7 @@ procedure TBaseVirtualTree.TileBackground(Source: TPicture; Target: TCanvas; Off DeltaY: Integer; DrawBitmap: TBitmap; begin +{$IFDEF VT_VCL} DrawBitmap := TBitmap.Create; try PrepareBackGroundPicture(Source, DrawBitmap, Source.Width, Source.Height, aBkgColor); @@ -15364,10 +16486,12 @@ procedure TBaseVirtualTree.TileBackground(Source: TPicture; Target: TCanvas; Off finally DrawBitmap.Free; end; +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- +{$IFDEF VT_VCL} function TBaseVirtualTree.ToggleCallback(Step, StepSize: Integer; Data: Pointer): Boolean; var @@ -15476,9 +16600,9 @@ function TBaseVirtualTree.ToggleCallback(Step, StepSize: Integer; Data: Pointer) end; end; end; - +{$ENDIF} //---------------------------------------------------------------------------------------------------------------------- - +{$IFDEF VT_VCL} procedure TBaseVirtualTree.CMColorChange(var Message: TMessage); begin @@ -16190,9 +17314,9 @@ procedure TBaseVirtualTree.TVMGetItemRect(var Message: TMessage); PRect(Message.LParam)^ := GetDisplayRect(Node, NoColumn, TextOnly); end; end; - +{$ENDIF} //---------------------------------------------------------------------------------------------------------------------- - +{$IFDEF VT_VCL} procedure TBaseVirtualTree.TVMGetNextItem(var Message: TMessage); // Screen read support function. This method returns a node depending on the requested case. @@ -16235,9 +17359,10 @@ procedure TBaseVirtualTree.TVMGetNextItem(var Message: TMessage); Message.Result := LRESULT(GetFirst); end; end; +{$ENDIF} //---------------------------------------------------------------------------------------------------------------------- - +{$IFDEF VT_VCL} procedure TBaseVirtualTree.WMCancelMode(var Message: TWMCancelMode); begin @@ -17467,7 +18592,6 @@ procedure TBaseVirtualTree.WMNCPaint(var Message: TWMNCPaint); TempRgn: HRGN; BorderWidth, BorderHeight: Integer; - begin if tsUseThemes in FStates then begin @@ -17914,7 +19038,7 @@ procedure TBaseVirtualTree.WMVScroll(var Message: TWMVScroll); end; Message.Result := 0; end; - +{$ENDIF} //---------------------------------------------------------------------------------------------------------------------- procedure TBaseVirtualTree.AddToSelection(Node: PVirtualNode); @@ -17984,18 +19108,19 @@ procedure TBaseVirtualTree.AdjustPaintCellRect(var PaintInfo: TVTPaintInfo; var //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.AdjustPanningCursor(X, Y: Integer); +procedure TBaseVirtualTree.AdjustPanningCursor(X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); // Triggered by a mouse move when wheel panning/scrolling is active. // Loads the proper cursor which indicates into which direction scrolling is done. - +{$IFDEF VT_VCL} var Name: string; NewCursor: HCURSOR; ScrollHorizontal, ScrollVertical: Boolean; - +{$ENDIF} begin +{$IFDEF VT_VCL} ScrollHorizontal := Integer(FRangeX) > ClientWidth; ScrollVertical := Integer(FRangeY) > ClientHeight; @@ -18080,6 +19205,7 @@ procedure TBaseVirtualTree.AdjustPanningCursor(X, Y: Integer); end else DeleteObject(NewCursor); +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -18125,7 +19251,7 @@ function TBaseVirtualTree.AllocateInternalDataArea(Size: Cardinal): Cardinal; begin Assert((FRoot = nil) or (FRoot.ChildCount = 0), 'Internal data allocation must be done before any node is created.'); Result := TreeNodeSize + FTotalInternalDataSize; - Inc(FTotalInternalDataSize, (Size + (SizeOf(Pointer) - 1)) and not (SizeOf(Pointer) - 1)); + System.Inc(FTotalInternalDataSize, (Size + (SizeOf(Pointer) - 1)) and not (SizeOf(Pointer) - 1)); InitRootNode(Result); end; @@ -18167,22 +19293,22 @@ procedure TBaseVirtualTree.Animate(Steps, Duration: Cardinal; Callback: TVTAnima while (RemainingSteps > 0) and (RemainingTime > 0) and not Application.Terminated do begin - StartTime := timeGetTime; + StartTime := {$IFDEF VT_FMX}TThread.GetTickCount{$ELSE}timeGetTime{$ENDIF}; NextTimeStep := StartTime + RemainingTime div RemainingSteps; if not Callback(CurrentStep, StepSize, Data) then Break; // Keep duration for this step for rest calculation. - CurrentTime := timeGetTime; + CurrentTime := {$IFDEF VT_FMX}TThread.GetTickCount{$ELSE}timeGetTime{$ENDIF}; // Wait until the calculated time has been reached. while CurrentTime < NextTimeStep do - CurrentTime := timeGetTime; + CurrentTime := {$IFDEF VT_FMX}TThread.GetTickCount{$ELSE}timeGetTime{$ENDIF}; // Subtract the time this step really needed. if RemainingTime >= CurrentTime - StartTime then begin - Dec(RemainingTime, CurrentTime - StartTime); - Dec(RemainingSteps); + System.Dec(RemainingTime, CurrentTime - StartTime); + System.Dec(RemainingSteps); end else begin @@ -18194,11 +19320,11 @@ procedure TBaseVirtualTree.Animate(Steps, Duration: Cardinal; Callback: TVTAnima if (RemainingSteps > 0) and ((RemainingTime div RemainingSteps) < 1) then begin repeat - Inc(StepSize); + System.Inc(StepSize); RemainingSteps := RemainingTime div StepSize; until (RemainingSteps <= 0) or ((RemainingTime div RemainingSteps) >= 1); end; - CurrentStep := Steps - RemainingSteps; + CurrentStep := Cardinal(Steps) - RemainingSteps; end; if not Application.Terminated then @@ -18216,7 +19342,7 @@ procedure TBaseVirtualTree.StartOperation(OperationKind: TVTOperationKind); // Called to indicate that a long-running operation has been started. begin - Inc(FOperationCount); + System.Inc(FOperationCount); if FOperationCount = 1 then FOperationCanceled := False; DoStartOperation(OperationKind); @@ -18224,13 +19350,13 @@ procedure TBaseVirtualTree.StartOperation(OperationKind: TVTOperationKind); //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.CalculateSelectionRect(X, Y: Integer): Boolean; +function TBaseVirtualTree.CalculateSelectionRect(X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}): Boolean; // Recalculates old and new selection rectangle given that X, Y are new mouse coordinates. // Returns True if there was a change since the last call. var - MaxValue: Integer; + MaxValue: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; begin if tsDrawSelecting in FStates then @@ -18241,12 +19367,12 @@ function TBaseVirtualTree.CalculateSelectionRect(X, Y: Integer): Boolean; if FNewSelRect.Bottom < 0 then FNewSelRect.Bottom := 0; MaxValue := ClientWidth; - if FRangeX > Cardinal(MaxValue) then + if FRangeX > {$IFDEF VT_VCL}Cardinal{$ENDIF}(MaxValue) then MaxValue := FRangeX; if FNewSelRect.Right > MaxValue then FNewSelRect.Right := MaxValue; MaxValue := ClientHeight; - if FRangeY > Cardinal(MaxValue) then + if FRangeY > {$IFDEF VT_VCL}Cardinal{$ENDIF}(MaxValue) then MaxValue := FRangeY; if FNewSelRect.Bottom > MaxValue then FNewSelRect.Bottom := MaxValue; @@ -18269,7 +19395,11 @@ function TBaseVirtualTree.CanAutoScroll: Boolean; // Don't scroll the client area if the header is currently doing tracking or dragging. // Do auto scroll only if there is a draw selection in progress or the tree is the current drop target or // wheel panning/scrolling is active. +{$IFDEF VT_FMX} + IsDropTarget := false; //TODO: drop.. +{$ELSE} IsDropTarget := Assigned(FDragManager) and DragManager.IsDropTarget; +{$ENDIF} IsDrawSelecting := [tsDrawSelPending, tsDrawSelecting] * FStates <> []; IsWheelPanning := [tsWheelPanning, tsWheelScrolling] * FStates <> []; Result := ((toAutoScroll in FOptions.FAutoOptions) or IsWheelPanning) and @@ -18306,7 +19436,9 @@ procedure TBaseVirtualTree.Change(Node: PVirtualNode); if FUpdateCount = 0 then begin if (FChangeDelay > 0) and HandleAllocated and not (tsSynchMode in FStates) then +{$IFDEF VT_VCL} SetTimer(Handle, ChangeTimer, FChangeDelay, nil) +{$ENDIF} else DoChange(Node); end; @@ -18319,10 +19451,13 @@ procedure TBaseVirtualTree.ChangeScale(M, D: Integer{$if CompilerVersion >= 31}; const DefaultScalingFlags = [sfLeft, sfTop, sfWidth, sfHeight, sfFont]; // Was introduced with XE6: http://docwiki.embarcadero.com/Libraries/XE6/en/Vcl.Controls.TControl.DefaultScalingFlags {$ifend} +{$IFDEF VT_VCL} var Flags: TScalingFlags; Run: PVirtualNode; +{$ENDIF} begin +{$IFDEF VT_VCL} if (toAutoChangeScale in FOptions.FAutoOptions) then begin if (M <> D) then @@ -18364,6 +19499,7 @@ procedure TBaseVirtualTree.ChangeScale(M, D: Integer{$if CompilerVersion >= 31}; inherited ChangeScale(M, D{$if CompilerVersion >= 31}, isDpiChange{$ifend}); // It is important to do this call after calling inherited, so that the Font has been updated. AutoScale(M <> D); +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -18371,8 +19507,10 @@ procedure TBaseVirtualTree.ChangeScale(M, D: Integer{$if CompilerVersion >= 31}; procedure TBaseVirtualTree.ChangeTreeStatesAsync(EnterStates, LeaveStates: TChangeStates); begin +{$IFDEF VT_VCL} if (Self.HandleAllocated) then SendMessage(Self.Handle, WM_CHANGESTATE, Byte(EnterStates), Byte(LeaveStates)); +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -18401,18 +19539,18 @@ function TBaseVirtualTree.CheckParentCheckState(Node: PVirtualNode; NewCheckStat // will get if this method returns True. if Run.CheckType in [ctCheckBox, ctTriStateCheckBox] then begin - Inc(BoxCount); + System.Inc(BoxCount); if NewCheckState.IsChecked then - Inc(CheckCount); + System.Inc(CheckCount); PartialCheck := PartialCheck or (NewCheckState = csMixedNormal); end; end else if Run.CheckType in [ctCheckBox, ctTriStateCheckBox] then begin - Inc(BoxCount); + System.Inc(BoxCount); if GetCheckState(Run).IsChecked then - Inc(CheckCount); + System.Inc(CheckCount); PartialCheck := PartialCheck or (GetCheckState(Run) = csMixedNormal); end; Run := Run.NextSibling; @@ -18471,29 +19609,29 @@ function TBaseVirtualTree.ColumnIsEmpty(Node: PVirtualNode; Column: TColumnIndex //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.ComputeRTLOffset(ExcludeScrollBar: Boolean): Integer; +function TBaseVirtualTree.ComputeRTLOffset(ExcludeScrollBar: Boolean): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; // Computes the horizontal offset needed when all columns are automatically right aligned (in RTL bidi mode). // ExcludeScrollBar determines if the left-hand vertical scrollbar is to be included (if visible) or not. var - HeaderWidth: Integer; + HeaderWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; ScrollBarVisible: Boolean; begin - ScrollBarVisible := (Integer(FRangeY) > ClientHeight) and (ScrollBarOptions.ScrollBars in [ssVertical, ssBoth]); + ScrollBarVisible := ({$IFDEF VT_VCL}Integer{$ENDIF}(FRangeY) > ClientHeight) and (ScrollBarOptions.ScrollBars in [TScrollStyle.ssVertical, TScrollStyle.ssBoth]); if ScrollBarVisible then - Result := GetSystemMetrics(SM_CXVSCROLL) + Result := {$IFDEF VT_FMX}16{$ELSE}GetSystemMetrics(SM_CXVSCROLL){$ENDIF} else Result := 0; // Make everything right aligned. HeaderWidth := FHeaderRect.Right - FHeaderRect.Left; - if Integer(FRangeX) + Result <= HeaderWidth then - Result := HeaderWidth - Integer(FRangeX); + if {$IFDEF VT_VCL}Integer{$ENDIF}(FRangeX) + Result <= HeaderWidth then + Result := HeaderWidth - {$IFDEF VT_VCL}Integer{$ENDIF}(FRangeX); // Otherwise take only left-hand vertical scrollbar into account. if ScrollBarVisible and ExcludeScrollBar then - Dec(Result, GetSystemMetrics(SM_CXVSCROLL)); + Dec(Result, {$IFDEF VT_FMX}16{$ELSE}GetSystemMetrics(SM_CXVSCROLL){$ENDIF}); end; //---------------------------------------------------------------------------------------------------------------------- @@ -18513,14 +19651,14 @@ function TBaseVirtualTree.CountLevelDifference(Node1, Node2: PVirtualNode): Inte Level1 := 0; while Node1.Parent <> FRoot do begin - Inc(Level1); + System.Inc(Level1); Node1 := Node1.Parent; end; Level2 := 0; while Node2.Parent <> FRoot do begin - Inc(Level2); + System.Inc(Level2); Node2 := Node2.Parent; end; @@ -18544,14 +19682,14 @@ function TBaseVirtualTree.CountVisibleChildren(Node: PVirtualNode): Cardinal; while Assigned(Node) do begin if vsVisible in Node.States then - Inc(Result, CountVisibleChildren(Node) + Cardinal(IfThen(IsEffectivelyVisible[Node], 1))); + System.Inc(Result, CountVisibleChildren(Node) + Cardinal(IfThen(IsEffectivelyVisible[Node], 1))); Node := Node.NextSibling; end; end; end; //---------------------------------------------------------------------------------------------------------------------- - +{$IFDEF VT_VCL} procedure TBaseVirtualTree.CreateParams(var Params: TCreateParams); const @@ -18559,7 +19697,7 @@ procedure TBaseVirtualTree.CreateParams(var Params: TCreateParams); begin inherited CreateParams(Params); - + with Params do begin Style := Style or WS_CLIPCHILDREN or WS_CLIPSIBLINGS or ScrollBar[ScrollBarOptions.FScrollBars]; @@ -18583,9 +19721,9 @@ procedure TBaseVirtualTree.CreateParams(var Params: TCreateParams); AddBiDiModeExStyle(ExStyle); end; end; - +{$ENDIF} //---------------------------------------------------------------------------------------------------------------------- - +{$IFDEF VT_VCL} procedure TBaseVirtualTree.CreateWnd; // Initializes data which depends on a valid window handle. @@ -18626,6 +19764,8 @@ procedure TBaseVirtualTree.CreateWnd; UpdateScrollBars(True); UpdateHeaderRect; end; +{$ENDIF} +//---------------------------------------------------------------------------------------------------------------------- //---------------------------------------------------------------------------------------------------------------------- @@ -18698,7 +19838,7 @@ function TBaseVirtualTree.DetermineDropMode(const P: TPoint; var HitInfo: THitIn if LabelHit or ImageHit or not (toShowDropmark in FOptions.FPaintOptions) then Result := dmOnNode else - if ((NodeRect.Top + NodeRect.Bottom) div 2) > P.Y then + if ((NodeRect.Top + NodeRect.Bottom) {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2) > P.Y then Result := dmAbove else Result := dmBelow; @@ -18755,7 +19895,7 @@ procedure TBaseVirtualTree.DetermineHiddenChildrenFlagAllNodes; //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.DetermineHitPositionLTR(var HitInfo: THitInfo; Offset, Right: Integer; +procedure TBaseVirtualTree.DetermineHitPositionLTR(var HitInfo: THitInfo; Offset, Right: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; Alignment: TAlignment); // This method determines the hit position within a node with left-to-right orientation. @@ -18764,7 +19904,7 @@ procedure TBaseVirtualTree.DetermineHitPositionLTR(var HitInfo: THitInfo; Offset MainColumnHit: Boolean; lIndent, TextWidth, - ImageOffset: Integer; + ImageOffset: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; lOffsets: TVTOffsets; begin MainColumnHit := HitInfo.HitColumn = FHeader.MainColumn; @@ -18779,7 +19919,7 @@ procedure TBaseVirtualTree.DetermineHitPositionLTR(var HitInfo: THitInfo; Offset // Position of button is interpreted very generously to avoid forcing the user // to click exactly into the 9x9 pixels area. The entire node height and one full // indentation level is accepted as button hit. - if Offset >= lOffsets[ofsCheckbox] - Integer(FIndent) then + if Offset >= lOffsets[ofsCheckbox] - {$IFDEF VT_VCL}Integer{$ENDIF}(FIndent) then Include(HitInfo.HitPositions, hiOnItemButton); if Offset > lOffsets[ofsToggleButton] then Include(HitInfo.HitPositions, hiOnItemButtonExact); @@ -18833,7 +19973,7 @@ procedure TBaseVirtualTree.DetermineHitPositionLTR(var HitInfo: THitInfo; Offset case Alignment of taCenter: begin - lIndent := (ImageOffset + Right - TextWidth) div 2; + lIndent := (ImageOffset + Right - TextWidth) {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2; if Offset < lIndent then Include(HitInfo.HitPositions, hiOnItemLeft) else @@ -18866,7 +20006,7 @@ procedure TBaseVirtualTree.DetermineHitPositionLTR(var HitInfo: THitInfo; Offset //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.DetermineHitPositionRTL(var HitInfo: THitInfo; Offset, Right: Integer; Alignment: TAlignment); +procedure TBaseVirtualTree.DetermineHitPositionRTL(var HitInfo: THitInfo; Offset, Right: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; Alignment: TAlignment); // This method determines the hit position within a node with right-to-left orientation. @@ -18875,7 +20015,7 @@ procedure TBaseVirtualTree.DetermineHitPositionRTL(var HitInfo: THitInfo; Offset Run: PVirtualNode; Indent, TextWidth, - ImageOffset: Integer; + ImageOffset: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; begin MainColumnHit := HitInfo.HitColumn = FHeader.MainColumn; @@ -18907,7 +20047,7 @@ procedure TBaseVirtualTree.DetermineHitPositionRTL(var HitInfo: THitInfo; Offset // Position of button is interpreted very generously to avoid forcing the user // to click exactly into the 9x9 pixels area. The entire node height and one full // indentation level is accepted as button hit. - if Offset <= Right + Integer(FIndent) then + if Offset <= Right + {$IFDEF VT_VCL}Integer{$ENDIF}(FIndent) then Include(HitInfo.HitPositions, hiOnItemButton); if Offset <= Right + FPlusBM.Width then Include(HitInfo.HitPositions, hiOnItemButtonExact); @@ -18935,7 +20075,7 @@ procedure TBaseVirtualTree.DetermineHitPositionRTL(var HitInfo: THitInfo; Offset // Check support is only available for the main column. if MainColumnHit and (toCheckSupport in FOptions.FMiscOptions) and Assigned(FCheckImages) and (HitInfo.HitNode.CheckType <> ctNone) then - Dec(ImageOffset, FCheckImages.Width + FImagesMargin); + Dec(ImageOffset, {$IFDEF VT_FMX}16{$ELSE}FCheckImages.Width{$ENDIF} + FImagesMargin); //TODO: 16px Image! if MainColumnHit and (Offset > ImageOffset) then begin @@ -18967,12 +20107,13 @@ procedure TBaseVirtualTree.DetermineHitPositionRTL(var HitInfo: THitInfo; Offset begin // Consider bidi mode here. In RTL context does left alignment actually mean right alignment // and vice versa. +{$IFDEF VT_VCL} ChangeBiDiModeAlignment(Alignment); - +{$ENDIF} case Alignment of taCenter: begin - Indent := (ImageOffset - TextWidth) div 2; + Indent := (ImageOffset - TextWidth) {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2; if Offset < Indent then Include(HitInfo.HitPositions, hiOnItemLeft) else @@ -19026,11 +20167,11 @@ function TBaseVirtualTree.DetermineLineImageAndSelectLevel(Node: PVirtualNode; v // Determine indentation level of top node. while Run.Parent <> FRoot do begin - Inc(X); + System.Inc(X); Run := Run.Parent; // Count selected nodes (FRoot is never selected). if vsSelected in Run.States then - Inc(Result); + System.Inc(Result); end; // Set initial size of line index array, this will automatically initialized all entries to ltNone. @@ -19043,7 +20184,7 @@ function TBaseVirtualTree.DetermineLineImageAndSelectLevel(Node: PVirtualNode; v begin if toChildrenAbove in FOptions.FPaintOptions then begin - Dec(X); + System.Dec(X); if not HasVisiblePreviousSibling(Node) then begin if (Node.Parent <> FRoot) or HasVisibleNextSibling(Node) then @@ -19061,7 +20202,7 @@ function TBaseVirtualTree.DetermineLineImageAndSelectLevel(Node: PVirtualNode; v Run := Node.Parent; while Run <> FRoot do begin - Dec(X); + System.Dec(X); if HasVisiblePreviousSibling(Run) then LineImage[X] := ltTopDown else @@ -19088,7 +20229,7 @@ function TBaseVirtualTree.DetermineLineImageAndSelectLevel(Node: PVirtualNode; v repeat if Run.Parent = FRoot then Break; - Dec(X); + System.Dec(X); if HasVisibleNextSibling(Run) then LineImage[X - 1] := ltTopDown else @@ -19129,10 +20270,11 @@ function TBaseVirtualTree.DetermineLineImageAndSelectLevel(Node: PVirtualNode; v end; end; end; - +{$IFDEF VT_VCL} if (tsUseExplorerTheme in FStates) and HasChildren[Node] and (Indent >= 0) and not ((vsAllChildrenHidden in Node.States) and (toAutoHideButtons in TreeOptions.FAutoOptions)) then LineImage[Indent] := ltNone; +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -19158,7 +20300,7 @@ function TBaseVirtualTree.DetermineNextCheckState(CheckType: TCheckType; CheckSt //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.DetermineScrollDirections(X, Y: Integer): TScrollDirections; +function TBaseVirtualTree.DetermineScrollDirections(X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}): TScrollDirections; // Determines which direction the client area must be scrolled depending on the given position. @@ -19182,18 +20324,19 @@ function TBaseVirtualTree.DetermineScrollDirections(X, Y: Integer): TScrollDirec end else begin - if (X < Integer(FDefaultNodeHeight)) and (FEffectiveOffsetX <> 0) then + if (X < {$IFDEF VT_VCL}Integer{$ENDIF}(FDefaultNodeHeight)) and (FEffectiveOffsetX <> 0) then Include(Result, sdLeft); - if (ClientWidth + FEffectiveOffsetX < Integer(FRangeX)) and (X > ClientWidth - Integer(FDefaultNodeHeight)) then + if (ClientWidth + FEffectiveOffsetX < {$IFDEF VT_VCL}Integer{$ENDIF}(FRangeX)) and (X > ClientWidth - {$IFDEF VT_VCL}Integer{$ENDIF}(FDefaultNodeHeight)) then Include(Result, sdRight); - if (Y < Integer(FDefaultNodeHeight)) and (FOffsetY <> 0) then + if (Y < {$IFDEF VT_VCL}Integer{$ENDIF}(FDefaultNodeHeight)) and (FOffsetY <> 0) then Include(Result, sdUp); - if (ClientHeight - FOffsetY < Integer(FRangeY)) and (Y > ClientHeight - Integer(FDefaultNodeHeight)) then + if (ClientHeight - FOffsetY < {$IFDEF VT_VCL}Integer{$ENDIF}(FRangeY)) and (Y > ClientHeight - {$IFDEF VT_VCL}Integer{$ENDIF}(FDefaultNodeHeight)) then Include(Result, sdDown); // Since scrolling during dragging is not handled via the timer we do a check here whether the auto // scroll timeout already has elapsed or not. +{$IFDEF VT_VCL} if (Result <> []) and ((Assigned(FDragManager) and DragManager.IsDropTarget) or (FindDragTarget(Point(X, Y), False) = Self)) then @@ -19205,6 +20348,7 @@ function TBaseVirtualTree.DetermineScrollDirections(X, Y: Integer): TScrollDirec if ((Int64(timeGetTime) - FDragScrollStart) < FAutoScrollDelay) then Result := []; end; +{$ENDIF} end; end; end; @@ -19256,7 +20400,7 @@ procedure TBaseVirtualTree.DoAfterPaint(Canvas: TCanvas); //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.DoAutoScroll(X, Y: Integer); +procedure TBaseVirtualTree.DoAutoScroll(X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); begin FScrollDirections := DetermineScrollDirections(X, Y); @@ -19277,7 +20421,9 @@ procedure TBaseVirtualTree.DoAutoScroll(X, Y: Integer); if (FStates * [tsScrollPending, tsScrolling]) = [] then begin DoStateChange([tsScrollPending]); +{$IFDEF VT_VCL} SetTimer(Handle, ScrollTimer, FAutoScrollDelay, nil); +{$ENDIF} end; end; end; @@ -19297,27 +20443,36 @@ function TBaseVirtualTree.DoBeforeDrag(Node: PVirtualNode; Column: TColumnIndex) procedure TBaseVirtualTree.DoBeforeCellPaint(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect); - var UpdateRect: TRect; - begin if Assigned(FOnBeforeCellPaint) then begin if CellPaintMode = cpmGetContentMargin then begin // Prevent drawing if we are only about to get the margin. As this also clears the update rect we need to save it. +{$IFDEF VT_FMX} + UpdateRect:= GetUpdateRect; +{$ELSE} GetUpdateRect(Handle, UpdateRect, False); +{$ENDIF} SetUpdateState(True); end; - +{$IFDEF VT_FMX} + Canvas.Font.Assign(Self.Font); // Fixes issue #298 +{$ELSE} Canvas.Font := Self.Font; // Fixes issue #298 +{$ENDIF} FOnBeforeCellPaint(Self, Canvas, Node, Column, CellPaintMode, CellRect, ContentRect); if CellPaintMode = cpmGetContentMargin then begin SetUpdateState(False); +{$IFDEF VT_FMX} + Repaint; +{$ELSE} InvalidateRect(Handle, @UpdateRect, False); +{$ENDIF} end; end; end; @@ -19432,8 +20587,10 @@ procedure TBaseVirtualTree.DoChecked(Node: PVirtualNode); begin if Assigned(FOnChecked) then FOnChecked(Self, Node); +{$IFDEF VT_VCL} if Assigned(FAccessibleItem) then NotifyWinEvent(EVENT_OBJECT_STATECHANGE, Handle, OBJID_CLIENT, CHILDID_SELF); +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -19463,8 +20620,10 @@ procedure TBaseVirtualTree.DoCollapsed(Node: PVirtualNode); if Assigned(FOnCollapsed) then FOnCollapsed(Self, Node); +{$IFDEF VT_VCL} if Assigned(FAccessibleItem) then NotifyWinEvent(EVENT_OBJECT_STATECHANGE, Handle, OBJID_CLIENT, CHILDID_SELF); +{$ENDIF} if (toAlwaysSelectNode in TreeOptions.SelectionOptions) then begin @@ -19536,6 +20695,9 @@ procedure TBaseVirtualTree.DoColumnResize(Column: TColumnIndex); if Column > NoColumn then begin // Invalidate client area from the current column all to the right (or left in RTL mode). +{$IFDEF VT_FMX} + Repaint; +{$ELSE} R := ClientRect; if not (toAutoSpanColumns in FOptions.FAutoOptions) then if UseRightToLeftAlignment then @@ -19544,9 +20706,14 @@ procedure TBaseVirtualTree.DoColumnResize(Column: TColumnIndex); R.Left := FHeader.Columns[Column].Left; InvalidateRect(Handle, @R, False); FHeader.Invalidate(FHeader.Columns[Column], True); +{$ENDIF} end; if [hsColumnWidthTracking, hsResizing] * FHeader.States = [hsColumnWidthTracking] then +{$IFDEF VT_FMX} + Repaint; +{$ELSE} UpdateWindow(Handle); +{$ENDIF} if not (tsUpdating in FStates) then UpdateDesigner; // design time only @@ -19580,7 +20747,7 @@ function TBaseVirtualTree.DoCompare(Node1, Node2: PVirtualNode; Column: TColumnI end; //---------------------------------------------------------------------------------------------------------------------- - +{$IFDEF VT_VCL} function TBaseVirtualTree.DoCreateDataObject: IDataObject; begin @@ -19598,7 +20765,7 @@ function TBaseVirtualTree.DoCreateDragManager: IVTDragManager; if Assigned(FOnCreateDragManager) then FOnCreateDragManager(Self, Result); end; - +{$ENDIF} //---------------------------------------------------------------------------------------------------------------------- function TBaseVirtualTree.DoCreateEditor(Node: PVirtualNode; Column: TColumnIndex): IVTEditLink; @@ -19612,7 +20779,7 @@ function TBaseVirtualTree.DoCreateEditor(Node: PVirtualNode; Column: TColumnInde //---------------------------------------------------------------------------------------------------------------------- procedure TBaseVirtualTree.DoDragging(P: TPoint); - +{$IFDEF VT_VCL} // Initiates finally the drag'n drop operation and returns after DD is finished. //--------------- local function -------------------------------------------- @@ -19641,8 +20808,9 @@ procedure TBaseVirtualTree.DoDragging(P: TPoint); DragObject: TDragObject; DataObject: IDataObject; - +{$ENDIF} begin +{$IFDEF VT_VCL} DataObject := nil; // Dragging is dragging, nothing else. DoCancelEdit; @@ -19702,6 +20870,7 @@ procedure TBaseVirtualTree.DoDragging(P: TPoint); finally FDragSelection := nil; end; +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -19712,6 +20881,7 @@ procedure TBaseVirtualTree.DoDragExpand; SourceTree: TBaseVirtualTree; begin +{$IFDEF VT_VCL} StopTimer(ExpandTimer); if Assigned(FDropTargetNode) and (vsHasChildren in FDropTargetNode.States) and not (vsExpanded in FDropTargetNode.States) then @@ -19728,6 +20898,7 @@ procedure TBaseVirtualTree.DoDragExpand; if not DragManager.DropTargetHelperSupported and Assigned(SourceTree) then SourceTree.FDragImage.ShowDragImage; end; +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -19743,7 +20914,7 @@ function TBaseVirtualTree.DoDragOver(Source: TObject; Shift: TShiftState; State: //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.DoDragDrop(Source: TObject; const DataObject: IDataObject; const Formats: TFormatArray; +procedure TBaseVirtualTree.DoDragDrop(Source: TObject; const DataObject: {$IFDEF VT_FMX}TDragObject{$ELSE}IDragObject{$ENDIF}; const Formats: TFormatArray; Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode); begin @@ -19775,8 +20946,9 @@ procedure TBaseVirtualTree.DoEdit; FEditLink := DoCreateEditor(FFocusedNode, FEditColumn); if Assigned(FEditLink) then begin - DoStateChange([tsEditing], [tsDrawSelecting, tsDrawSelPending, tsToggleFocusedSelection, tsOLEDragPending, - tsOLEDragging, tsClearPending, tsDrawSelPending, tsScrollPending, tsScrolling, tsMouseCheckPending]); + DoStateChange([tsEditing], [tsDrawSelecting, tsDrawSelPending, tsToggleFocusedSelection, + {$IFDEF VT_VCL}tsOLEDragPending, tsOLEDragging,{$ENDIF} + tsClearPending, tsDrawSelPending, tsScrollPending, tsScrolling, tsMouseCheckPending]); ScrollIntoView(FFocusedNode, toCenterScrollIntoView in FOptions.SelectionOptions, not (toDisableAutoscrollOnEdit in FOptions.AutoOptions)); if FEditLink.PrepareEdit(Self, FFocusedNode, FEditColumn) then @@ -19797,7 +20969,7 @@ procedure TBaseVirtualTree.DoEdit; //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.DoEndDrag(Target: TObject; X, Y: Integer); +procedure TBaseVirtualTree.DoEndDrag(Target: TObject; X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); // Does some housekeeping for VCL drag'n drop; @@ -19852,9 +21024,10 @@ procedure TBaseVirtualTree.DoExpanded(Node: PVirtualNode); begin if Assigned(FOnExpanded) then FOnExpanded(Self, Node); - +{$IFDEF VT_VCL} if Assigned(FAccessibleItem) then NotifyWinEvent(EVENT_OBJECT_STATECHANGE, Handle, OBJID_CLIENT, CHILDID_SELF); +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -19875,6 +21048,7 @@ procedure TBaseVirtualTree.DoFocusChange(Node: PVirtualNode; Column: TColumnInde if Assigned(FOnFocusChanged) then FOnFocusChanged(Self, Node, Column); +{$IFDEF VT_VCL} if Assigned(FAccessibleItem) then begin NotifyWinEvent(EVENT_OBJECT_LOCATIONCHANGE, Handle, OBJID_CLIENT, CHILDID_SELF); @@ -19884,6 +21058,7 @@ procedure TBaseVirtualTree.DoFocusChange(Node: PVirtualNode; Column: TColumnInde NotifyWinEvent(EVENT_OBJECT_SELECTION, Handle, OBJID_CLIENT, CHILDID_SELF); NotifyWinEvent(EVENT_OBJECT_FOCUS, Handle, OBJID_CLIENT, CHILDID_SELF); end; +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -20033,7 +21208,7 @@ procedure TBaseVirtualTree.DoGetCursor(var Cursor: TCursor); //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.DoGetHeaderCursor(var Cursor: HCURSOR); +procedure TBaseVirtualTree.DoGetHeaderCursor(var Cursor: {$IFDEF VT_FMX}TCursor{$ELSE}HCURSOR{$ENDIF}); begin if Assigned(FOnGetHeaderCursor) then @@ -20112,7 +21287,7 @@ function TBaseVirtualTree.DoGetNodeTooltip(Node: PVirtualNode; Column: TColumnIn //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.DoGetNodeExtraWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): Integer; +function TBaseVirtualTree.DoGetNodeExtraWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; // Returns the pixel width of extra space occupied by node contents (for example, static text). @@ -20122,7 +21297,7 @@ function TBaseVirtualTree.DoGetNodeExtraWidth(Node: PVirtualNode; Column: TColum //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): Integer; +function TBaseVirtualTree.DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; // Returns the pixel width of a node. @@ -20160,14 +21335,14 @@ function TBaseVirtualTree.DoGetPopupMenu(Node: PVirtualNode; Column: TColumnInde end; //---------------------------------------------------------------------------------------------------------------------- - +{$IFDEF VT_VCL} procedure TBaseVirtualTree.DoGetUserClipboardFormats(var Formats: TFormatEtcArray); begin if Assigned(FOnGetUserClipboardFormats) then FOnGetUserClipboardFormats(Self, Formats); end; - +{$ENDIF} //---------------------------------------------------------------------------------------------------------------------- procedure TBaseVirtualTree.DoHeaderAddPopupItem(const Column: TColumnIndex; var Cmd: TAddPopupItemType); @@ -20336,7 +21511,7 @@ procedure TBaseVirtualTree.DoLoadUserData(Node: PVirtualNode; Stream: TStream); //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.DoMeasureItem(TargetCanvas: TCanvas; Node: PVirtualNode; var NodeHeight: Integer); +procedure TBaseVirtualTree.DoMeasureItem(TargetCanvas: TCanvas; Node: PVirtualNode; var NodeHeight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); begin if not (vsInitialized in Node.States) then @@ -20457,12 +21632,14 @@ procedure TBaseVirtualTree.DoPaintDropMark(Canvas: TCanvas; Node: PVirtualNode; // draws the drop mark into the given rectangle // Note: Changed properties of the given canvas should be reset to their previous values. - +{$IFDEF VT_VCL} var SaveBrushColor: TColor; SavePenStyle: TPenStyle; +{$ENDIF} begin +{$IFDEF VT_VCL} if FLastDropMode in [dmAbove, dmBelow] then with Canvas do begin @@ -20492,6 +21669,7 @@ procedure TBaseVirtualTree.DoPaintDropMark(Canvas: TCanvas; Node: PVirtualNode; Brush.Color := SaveBrushColor; Pen.Style := SavePenStyle; end; +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -20533,7 +21711,7 @@ procedure TBaseVirtualTree.DoRemoveFromSelection(Node: PVirtualNode); end; //---------------------------------------------------------------------------------------------------------------------- - +{$IFDEF VT_VCL} function TBaseVirtualTree.DoRenderOLEData(const FormatEtcIn: TFormatEtc; out Medium: TStgMedium; ForClipboard: Boolean): HRESULT; @@ -20542,6 +21720,7 @@ function TBaseVirtualTree.DoRenderOLEData(const FormatEtcIn: TFormatEtc; out Med if Assigned(FOnRenderOLEData) then FOnRenderOLEData(Self, FormatEtcIn, Medium, ForClipboard, Result); end; +{$ENDIF} //---------------------------------------------------------------------------------------------------------------------- @@ -20566,7 +21745,7 @@ procedure TBaseVirtualTree.DoSaveUserData(Node: PVirtualNode; Stream: TStream); //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.DoScroll(DeltaX, DeltaY: Integer); +procedure TBaseVirtualTree.DoScroll(DeltaX, DeltaY: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); begin if Assigned(FOnScroll) then @@ -20581,24 +21760,26 @@ function TBaseVirtualTree.DoSetOffsetXY(Value: TPoint; Options: TScrollUpdateOpt // Returns True if the offset really changed otherwise False is returned. var - DeltaX: Integer; - DeltaY: Integer; + DeltaX: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + DeltaY: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; +{$IFDEF VT_VCL} DWPStructure: HDWP; +{$ENDIF} I: Integer; P: TPoint; R: TRect; begin // Range check, order is important here. - if Value.X < (ClientWidth - Integer(FRangeX)) then - Value.X := ClientWidth - Integer(FRangeX); + if Value.X < (ClientWidth - {$IFDEF VT_VCL}Integer{$ENDIF}(FRangeX)) then + Value.X := ClientWidth - {$IFDEF VT_VCL}Integer{$ENDIF}(FRangeX); if Value.X > 0 then Value.X := 0; DeltaX := Value.X - FOffsetX; if UseRightToLeftAlignment then DeltaX := -DeltaX; - if Value.Y < (ClientHeight - Integer(FRangeY)) then - Value.Y := ClientHeight - Integer(FRangeY); + if Value.Y < (ClientHeight - {$IFDEF VT_VCL}Integer{$ENDIF}(FRangeY)) then + Value.Y := ClientHeight - {$IFDEF VT_VCL}Integer{$ENDIF}(FRangeY); if Value.Y > 0 then Value.Y := 0; DeltaY := Value.Y - FOffsetY; @@ -20615,9 +21796,11 @@ function TBaseVirtualTree.DoSetOffsetXY(Value: TPoint; Options: TScrollUpdateOpt if FUpdateCount = 0 then begin // The drag image from VCL controls need special consideration. +{$IFDEF VT_VCL} if tsVCLDragging in FStates then ImageList_DragShowNolock(False); - +{$ENDIF} +{$IFDEF VT_VCL} if (suoScrollClientArea in Options) and not (tsToggling in FStates) then begin // Have to invalidate the entire window if there's a background. @@ -20678,15 +21861,27 @@ function TBaseVirtualTree.DoSetOffsetXY(Value: TPoint; Options: TScrollUpdateOpt if tsVCLDragging in FStates then ImageList_DragShowNolock(True); +{$ENDIF} end; // Finally update "hot" node if hot tracking is activated +{$IFDEF VT_FMX} + //FMX.Platform.GetMousePos(P); + P:= Screen.MousePos(); + P := AbsoluteToLocal(P); + if PtInRect(BoundsRect, P) then + HandleHotTrack(P.X, P.Y); + + DoScroll(DeltaX, DeltaY); +{$ELSE} GetCursorPos(P); P := ScreenToClient(P); if PtInRect(ClientRect, P) then HandleHotTrack(P.X, P.Y); DoScroll(DeltaX, DeltaY); +{$ENDIF} + end; end; @@ -20695,7 +21890,9 @@ function TBaseVirtualTree.DoSetOffsetXY(Value: TPoint; Options: TScrollUpdateOpt procedure TBaseVirtualTree.DoShowScrollBar(Bar: Integer; Show: Boolean); begin +{$IFDEF VT_VCL} ShowScrollBar(Handle, Bar, Show); +{$ENDIF} if Assigned(FOnShowScrollBar) then FOnShowScrollBar(Self, Bar, Show); end; @@ -20709,7 +21906,9 @@ procedure TBaseVirtualTree.DoStartDrag(var DragObject: TDragObject); // Check if the application created an own drag object. This is needed to pass the correct source in // OnDragOver and OnDragDrop. +{$IFDEF VT_VCL} if Assigned(DragObject) then +{$ENDIF} DoStateChange([tsUserDragObject]); end; @@ -20772,7 +21971,8 @@ procedure TBaseVirtualTree.DoTimerScroll; DeltaY: Integer; begin - GetCursorPos(P); +{$IFDEF VT_VCL} + GetCursorPos(P); //Platform.GetMousePos(P); R := ClientRect; ClipRect := R; MapWindowPoints(Handle, 0, R, 2); @@ -20881,6 +22081,7 @@ procedure TBaseVirtualTree.DoTimerScroll; DoStateChange([], [tsScrollPending, tsScrolling]); end; end; +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -20905,11 +22106,10 @@ function TBaseVirtualTree.DoValidateCache: Boolean; var EntryCount, - CurrentTop, Index: Cardinal; CurrentNode, Temp: PVirtualNode; - + CurrentTop: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; begin EntryCount := 0; if not (tsStopValidation in FStates) then @@ -20961,7 +22161,7 @@ function TBaseVirtualTree.DoValidateCache: Boolean; Node := CurrentNode; AbsoluteTop := CurrentTop; end; - Inc(Index); + System.Inc(Index); end; Inc(CurrentTop, NodeHeight[CurrentNode]); @@ -20972,7 +22172,7 @@ function TBaseVirtualTree.DoValidateCache: Boolean; Break; // CHANGED: 17.09.2013 - Veit Zimmermann CurrentNode := Temp; - Inc(EntryCount); + System.Inc(EntryCount); end; end; // Finalize the position cache so no nil entry remains there. @@ -20999,18 +22199,22 @@ function TBaseVirtualTree.DoValidateCache: Boolean; //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.DragAndDrop(AllowedEffects: Dword; const DataObject: IDataObject; var DragEffect: Integer); +procedure TBaseVirtualTree.DragAndDrop(AllowedEffects: Dword; const DataObject: {$IFDEF VT_FMX}TDragObject{$ELSE}IDragObject{$ENDIF}; var DragEffect: Integer); var lDragEffect: DWord; // required for type compatibility with SHDoDragDrop begin if IsWinVistaOrAbove then begin lDragEffect := DWord(DragEffect); +{$IFDEF VT_VCL} SHDoDragDrop(Self.Handle, DataObject, nil, AllowedEffects, lDragEffect); // supports drag hints on Windows Vista and later +{$ENDIF} DragEffect := Integer(lDragEffect); end else +{$IFDEF VT_VCL} Winapi.ActiveX.DoDragDrop(DataObject, DragManager as IDropSource, AllowedEffects, DragEffect); +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -21026,18 +22230,18 @@ procedure TBaseVirtualTree.DragCanceled; end; //---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.DragDrop(const DataObject: IDataObject; KeyState: Integer; Pt: TPoint; +function TBaseVirtualTree.DragDrop(const DataObject: {$IFDEF VT_FMX}TDragObject{$ELSE}IDragObject{$ENDIF}; KeyState: Integer; Pt: TPoint; var Effect: Integer): HResult; - +{$IFDEF VT_VCL} var Shift: TShiftState; EnumFormat: IEnumFormatEtc; Fetched: Integer; OLEFormat: TFormatEtc; Formats: TFormatArray; - +{$ENDIF} begin +{$IFDEF VT_VCL} StopTimer(ExpandTimer); StopTimer(ScrollTimer); DoStateChange([], [tsScrollPending, tsScrolling]); @@ -21088,6 +22292,7 @@ function TBaseVirtualTree.DragDrop(const DataObject: IDataObject; KeyState: Inte FDropTargetNode := nil; end; end; +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -21103,6 +22308,7 @@ function TBaseVirtualTree.DragEnter(KeyState: Integer; Pt: TPoint; var Effect: I HitInfo: THitInfo; begin +{$IFDEF VT_VCL} try // Determine acceptance of drag operation and reset scroll start time. FDragScrollStart := 0; @@ -21149,6 +22355,7 @@ function TBaseVirtualTree.DragEnter(KeyState: Integer; Pt: TPoint; var Effect: I except Result := E_UNEXPECTED; end; +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -21162,12 +22369,13 @@ procedure TBaseVirtualTree.DragFinished; P: TPoint; begin - if [tsOLEDragging, tsVCLDragPending, tsVCLDragging, tsVCLDragFinished] * FStates = [] then + if [{$IFDEF VT_VCL}tsOLEDragging, {$ENDIF}tsVCLDragPending, tsVCLDragging, tsVCLDragFinished] * FStates = [] then Exit; DoStateChange([], [tsVCLDragPending, tsVCLDragging, tsUserDragObject, tsVCLDragFinished]); - GetCursorPos(P); +{$IFDEF VT_VCL} + GetCursorPos(P); //Platform.GetMousePos(P); P := ScreenToClient(P); if tsRightButtonDown in FStates then Perform(WM_RBUTTONUP, 0, LPARAM(Integer(PointToSmallPoint(P)))) @@ -21176,6 +22384,7 @@ procedure TBaseVirtualTree.DragFinished; Perform(WM_MBUTTONUP, 0, LPARAM(Integer(PointToSmallPoint(P)))) else Perform(WM_LBUTTONUP, 0, LPARAM(Integer(PointToSmallPoint(P)))); +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -21187,19 +22396,24 @@ procedure TBaseVirtualTree.DragLeave; begin StopTimer(ExpandTimer); - +{$IFDEF VT_VCL} if not DragManager.DropTargetHelperSupported and Assigned(DragManager.DragSource) then DragManager.DragSource.FDragImage.HideDragImage; +{$ENDIF} if Assigned(FDropTargetNode) then begin InvalidateNode(FDropTargetNode); FDropTargetNode := nil; end; +{$IFDEF VT_FMX} + Repaint; +{$ELSE} UpdateWindow(Handle); +{$ENDIF} Effect := 0; - DoDragOver(nil, [], dsDragLeave, Point(0, 0), FLastDropMode, Effect); + DoDragOver(nil, [], TDragState.dsDragLeave, Point(0, 0), FLastDropMode, Effect); end; //---------------------------------------------------------------------------------------------------------------------- @@ -21221,10 +22435,11 @@ function TBaseVirtualTree.DragOver(Source: TObject; KeyState: Integer; DragState Tree: TBaseVirtualTree; LastNode: PVirtualNode; DeltaX, - DeltaY: Integer; + DeltaY: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; ScrollOptions: TScrollUpdateOptions; begin +{$IFDEF VT_VCL} if not DragManager.DropTargetHelperSupported and (Source is TBaseVirtualTree) then begin Tree := Source as TBaseVirtualTree; @@ -21256,7 +22471,7 @@ function TBaseVirtualTree.DragOver(Source: TObject; KeyState: Integer; DragState if sdDown in FScrollDirections then begin DeltaY := -Min(FScrollBarOptions.FIncrementY, ClientHeight); - if (ClientHeight - FOffsetY) = Integer(FRangeY) then + if (ClientHeight - FOffsetY) = {$IFDEF VT_VCL}Integer{$ENDIF}(FRangeY) then Exclude(FScrollDirections, sdDown); end; if sdLeft in FScrollDirections then @@ -21268,7 +22483,7 @@ function TBaseVirtualTree.DragOver(Source: TObject; KeyState: Integer; DragState if sdRight in FScrollDirections then begin DeltaX := -FScrollBarOptions.FIncrementX; - if (ClientWidth + FEffectiveOffsetX) = Integer(FRangeX) then + if (ClientWidth + FEffectiveOffsetX) = {$IFDEF VT_VCL}Integer{$ENDIF}(FRangeX) then Exclude(FScrollDirections, sdRight); end; WindowScrolled := DoSetOffsetXY(Point(FOffsetX + DeltaX, FOffsetY + DeltaY), ScrollOptions, nil); @@ -21398,11 +22613,12 @@ function TBaseVirtualTree.DragOver(Source: TObject; KeyState: Integer; DragState except Result := E_UNEXPECTED; end; +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.DrawDottedHLine(const PaintInfo: TVTPaintInfo; Left, Right, Top: Integer); +procedure TBaseVirtualTree.DrawDottedHLine(const PaintInfo: TVTPaintInfo; Left, Right, Top: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); // Draws a horizontal line with alternating pixels (this style is not supported for pens under Win9x). @@ -21412,16 +22628,21 @@ procedure TBaseVirtualTree.DrawDottedHLine(const PaintInfo: TVTPaintInfo; Left, begin with PaintInfo, Canvas do begin +{$IFDEF VT_FMX} + Fill.Color := FColors.BackGroundColor; + R := RectF(Min(Left, Right), Top, Max(Left, Right) + 1, Top + 1); + FillRect(R, 0, 0, [], 1.0, FDottedBrush); +{$ELSE} Brush.Color := FColors.BackGroundColor; R := Rect(Min(Left, Right), Top, Max(Left, Right) + 1, Top + 1); - Winapi.Windows.FillRect(Handle, R, FDottedBrush - ); + Winapi.Windows.FillRect(Handle, R, FDottedBrush); +{$ENDIF} end; end; //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.DrawDottedVLine(const PaintInfo: TVTPaintInfo; Top, Bottom, Left: Integer; UseSelectedBkColor: Boolean = False); +procedure TBaseVirtualTree.DrawDottedVLine(const PaintInfo: TVTPaintInfo; Top, Bottom, Left: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; UseSelectedBkColor: Boolean = False); // Draws a horizontal line with alternating pixels (this style is not supported for pens under Win9x). @@ -21433,15 +22654,19 @@ procedure TBaseVirtualTree.DrawDottedVLine(const PaintInfo: TVTPaintInfo; Top, B begin if UseSelectedBkColor then begin - if Focused or (toPopupMode in FOptions.FPaintOptions) then - Brush.Color := FColors.FocusedSelectionColor + if {$IFDEF VT_FMX}IsFocused{$ELSE}Focused{$ENDIF} or (toPopupMode in FOptions.FPaintOptions) then + {$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := FColors.FocusedSelectionColor else - Brush.Color := FColors.UnfocusedSelectionColor; + {$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := FColors.UnfocusedSelectionColor; end else - Brush.Color := FColors.BackGroundColor; + {$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := FColors.BackGroundColor; R := Rect(Left, Min(Top, Bottom), Left + 1, Max(Top, Bottom) + 1); +{$IFDEF VT_FMX} + FillRect(R, 0, 0, [], 1.0, FDottedBrush); +{$ELSE} Winapi.Windows.FillRect(Handle, R, FDottedBrush); +{$ENDIF} end; end; @@ -21453,7 +22678,7 @@ procedure TBaseVirtualTree.EndOperation(OperationKind: TVTOperationKind); begin Assert(FOperationCount > 0, 'EndOperation must not be called when no operation in progress.'); - Dec(FOperationCount); + System.Dec(FOperationCount); DoEndOperation(OperationKind); end; @@ -21572,6 +22797,7 @@ function TBaseVirtualTree.GetBorderDimensions: TSize; Result.cx := 0; Result.cy := 0; +{$IFDEF VT_VCL} Styles := GetWindowLong(Handle, GWL_STYLE); if (Styles and WS_BORDER) <> 0 then begin @@ -21589,6 +22815,7 @@ function TBaseVirtualTree.GetBorderDimensions: TSize; Dec(Result.cx, GetSystemMetrics(SM_CXEDGE)); Dec(Result.cy, GetSystemMetrics(SM_CYEDGE)); end; +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -21697,7 +22924,7 @@ function TBaseVirtualTree.GetHeaderClass: TVTHeaderClass; end; //---------------------------------------------------------------------------------------------------------------------- - +{$IFDEF VT_VCL} function TBaseVirtualTree.GetHintWindowClass: THintWindowClass; // Returns the default hint window class used for the tree. Descendants can override it to use their own classes. @@ -21705,6 +22932,7 @@ function TBaseVirtualTree.GetHintWindowClass: THintWindowClass; begin Result := TVirtualTreeHintWindow; end; +{$ENDIF} //---------------------------------------------------------------------------------------------------------------------- @@ -21751,10 +22979,10 @@ function TBaseVirtualTree.GetImageSize(Node: PVirtualNode; Kind: TVTImageKind = lImageList := DoGetImageIndex(Node, Kind, Column, Ghosted, Index); if Index >= 0 then begin if IncludePadding then - Result.cx := lImageList.Width + ScaledPixels(2) + Result.cx := {$IFDEF VT_FMX}16{$ELSE}lImageList.Width{$ENDIF} + ScaledPixels(2) //TODO: 16px Image! else - Result.cx := lImageList.Width; - Result.cy := lImageList.Height; + Result.cx := {$IFDEF VT_FMX}16{$ELSE}lImageList.Width{$ENDIF}; //TODO: 16px Image! + Result.cy := {$IFDEF VT_FMX}16{$ELSE}lImageList.Height{$ENDIF}; //TODO: 16px Image! end else begin Result.cx := 0; @@ -21781,7 +23009,7 @@ function TBaseVirtualTree.GetNodeImageSize(Node: PVirtualNode): TSize; //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.GetMaxRightExtend(): Cardinal; +function TBaseVirtualTree.GetMaxRightExtend(): {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; // Determines the maximum with of the currently visible part of the tree, depending on the length // of the node texts. This method is used for determining the horizontal scroll range if no columns are used. @@ -21789,8 +23017,8 @@ function TBaseVirtualTree.GetMaxRightExtend(): Cardinal; var Node, NextNode: PVirtualNode; - TopPosition: Integer; - CurrentWidth: Integer; + TopPosition: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + CurrentWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; begin Node := GetNodeAt(0, 0, True, TopPosition); @@ -21803,7 +23031,7 @@ function TBaseVirtualTree.GetMaxRightExtend(): Cardinal; if not (vsInitialized in Node.States) then InitNode(Node); CurrentWidth := GetOffset(TVTElement.ofsRightOfText, Node); - if Integer(Result) < (CurrentWidth) then + if {$IFDEF VT_VCL}Integer{$ENDIF}(Result) < (CurrentWidth) then Result := CurrentWidth; Inc(TopPosition, NodeHeight[Node]); if TopPosition > Height then @@ -21818,7 +23046,7 @@ function TBaseVirtualTree.GetMaxRightExtend(): Cardinal; end; //---------------------------------------------------------------------------------------------------------------------- - +{$IFDEF VT_VCL} procedure TBaseVirtualTree.GetNativeClipboardFormats(var Formats: TFormatEtcArray); // Returns the supported clipboard formats of the tree. @@ -21828,6 +23056,7 @@ procedure TBaseVirtualTree.GetNativeClipboardFormats(var Formats: TFormatEtcArra // Ask application/descendants for self defined formats. DoGetUserClipboardFormats(Formats); end; +{$ENDIF} //---------------------------------------------------------------------------------------------------------------------- @@ -21847,17 +23076,20 @@ function TBaseVirtualTree.GetOptionsClass: TTreeOptionsClass; //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.GetTreeFromDataObject(const DataObject: IDataObject): TBaseVirtualTree; +function TBaseVirtualTree.GetTreeFromDataObject(const DataObject: {$IFDEF VT_FMX}TDragObject{$ELSE}IDragObject{$ENDIF}): TBaseVirtualTree; // Returns the owner/sender of the given data object by means of a special clipboard format // or nil if the sender is in another process or no virtual tree at all. - +{$IFDEF VT_VCL} var Medium: TStgMedium; Data: PVTReference; +{$ENDIF} begin Result := nil; + +{$IFDEF VT_VCL} if Assigned(DataObject) then begin StandardOLEFormat.cfFormat := CF_VTREFERENCE; @@ -21873,11 +23105,12 @@ function TBaseVirtualTree.GetTreeFromDataObject(const DataObject: IDataObject): ReleaseStgMedium(Medium); end; end; +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.HandleHotTrack(X, Y: Integer); +procedure TBaseVirtualTree.HandleHotTrack(X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); // Updates the current "hot" node. @@ -21888,6 +23121,7 @@ procedure TBaseVirtualTree.HandleHotTrack(X, Y: Integer); DoInvalidate: Boolean; oldHotNode : PVirtualNode; begin +{$IFDEF VT_VCL} if not IsMouseCursorVisible then begin if Assigned(FCurrentHotNode) then @@ -21897,6 +23131,7 @@ procedure TBaseVirtualTree.HandleHotTrack(X, Y: Integer); end; Exit; end;//if not IsMouseCursorVisible +{$ENDIF} DoInvalidate := False; oldHotNode := FCurrentHotNode; @@ -21907,10 +23142,11 @@ procedure TBaseVirtualTree.HandleHotTrack(X, Y: Integer); CheckPositions := [hiOnItemLabel, hiOnItemCheckbox]; // If running under Windows Vista using the explorer theme hitting the buttons makes the node hot, too. +{$IFDEF VT_VCL} if tsUseExplorerTheme in FStates then Include(CheckPositions, hiOnItemButtonExact); - - if (CheckPositions * HitInfo.HitPositions = []) and +{$ENDIF} + if (CheckPositions * HitInfo.HitPositions = []) and //TODO: check merge TurboPack (not (toFullRowSelect in FOptions.FSelectionOptions) or (hiNowhere in HitInfo.HitPositions)) then FCurrentHotNode := nil else @@ -22068,7 +23304,7 @@ procedure TBaseVirtualTree.HandleIncrementalSearch(CharCode: Word); end; //--------------------------------------------------------------------------- - +{$IFDEF VT_VCL} function CodePageFromLocale(Language: LCID): Integer; // Determines the code page for a given locale. @@ -22081,6 +23317,7 @@ procedure TBaseVirtualTree.HandleIncrementalSearch(CharCode: Word); GetLocaleInfo(Language, LOCALE_IDEFAULTANSICODEPAGE, Buf, 6); Result := StrToIntDef(Buf, GetACP); end; +{$ENDIF} //--------------------------------------------------------------------------- @@ -22108,7 +23345,7 @@ procedure TBaseVirtualTree.HandleIncrementalSearch(CharCode: Word); // Convert the given virtual key code into a Unicode character based on the current locale. NewChar := KeyUnicode(Char(CharCode)); - PreviousSearch := NewChar = WideChar(VK_BACK); + PreviousSearch := NewChar = {$IFDEF VT_FMX}WideChar(vkBack){$ELSE}WideChar(VK_BACK){$ENDIF}; // We cannot do a search with an empty search buffer. if not PreviousSearch or (FSearchBuffer <> '') then begin @@ -22201,12 +23438,22 @@ procedure TBaseVirtualTree.HandleIncrementalSearch(CharCode: Word); end; // Restart search timeout interval. +{$IFDEF VT_VCL} SetTimer(Handle, SearchTimer, FSearchTimeout, nil); +{$ENDIF} end; end; //---------------------------------------------------------------------------------------------------------------------- +{$IFDEF VT_FMX} +procedure TBaseVirtualTree.MouseDown(Button: TMouseButton; Shift: TShiftState; X: Single; Y: Single); +begin + //TODO: MouseDown +end; +{$ENDIF} +//---------------------------------------------------------------------------------------------------------------------- +{$IFDEF VT_VCL} procedure TBaseVirtualTree.HandleMouseDblClick(var Message: TWMMouse; const HitInfo: THitInfo); var @@ -22751,7 +23998,7 @@ procedure TBaseVirtualTree.HandleMouseUp(var Message: TWMMouse; const HitInfo: T end; end; end; - +{$ENDIF} //---------------------------------------------------------------------------------------------------------------------- function TBaseVirtualTree.HasImage(Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex): Boolean; @@ -22868,7 +24115,7 @@ procedure TBaseVirtualTree.InitNode(Node: PVirtualNode); begin AdjustTotalHeight(Node, -NodeHeight, True); if FullyVisible[Node] then - Dec(FVisibleCount); + System.Dec(FVisibleCount); if FUpdateCount = 0 then UpdateScrollBars(True); end; @@ -22901,7 +24148,7 @@ procedure TBaseVirtualTree.InternalAddFromStream(Stream: TStream; Version: Integ var Stop: PVirtualNode; Index: Integer; - LastTotalHeight: Cardinal; + LastTotalHeight: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; WasFullyVisible: Boolean; begin @@ -22920,19 +24167,19 @@ procedure TBaseVirtualTree.InternalAddFromStream(Stream: TStream; Version: Integ FixupTotalCount(Node); AdjustTotalCount(Node.Parent, Node.TotalCount - 1, True); // -1 because Node itself was already set. FixupTotalHeight(Node); - AdjustTotalHeight(Node.Parent, Integer(Node.TotalHeight) - Integer(LastTotalHeight), True); + AdjustTotalHeight(Node.Parent, {$IFDEF VT_VCL}Integer{$ENDIF}(Node.TotalHeight) - {$IFDEF VT_VCL}Integer{$ENDIF}(LastTotalHeight), True); // New nodes are always visible, so the visible node count has been increased already. // If Node is now invisible we have to take back this increment and don't need to add any visible child node. if not FullyVisible[Node] or IsEffectivelyFiltered[Node] then begin if WasFullyVisible then - Dec(FVisibleCount); + System.Dec(FVisibleCount); end else // It can never happen that the node is now fully visible but was not before as this would require // that the visibility state of one of its parents has changed, which cannot happen during loading. - Inc(FVisibleCount, CountVisibleChildren(Node)); + System.Inc(FVisibleCount, CountVisibleChildren(Node)); // Fix selection array. ClearTempCache; @@ -23010,7 +24257,7 @@ function TBaseVirtualTree.InternalAddToSelection(const NewItems: TNodeArray; New for I := 0 to NewLength - 1 do begin AddedNodesIndexes[AddedNodesSize] := I; - Inc(AddedNodesSize); + System.Inc(AddedNodesSize); end; end else @@ -23026,11 +24273,11 @@ function TBaseVirtualTree.InternalAddToSelection(const NewItems: TNodeArray; New if ([vsSelected, vsDisabled] * NewItems[I].States <> []) or (Constrained and (Cardinal(FLastSelectionLevel) <> GetNodeLevel(NewItems[I]))) or (SiblingConstrained and (FRangeAnchor.Parent <> NewItems[I].Parent)) then - Inc(PAnsiChar(NewItems[I])) + System.Inc(PAnsiChar(NewItems[I])) else begin AddedNodesIndexes[AddedNodesSize] := I; - Inc(AddedNodesSize); + System.Inc(AddedNodesSize); end; end; @@ -23062,7 +24309,7 @@ function TBaseVirtualTree.InternalAddToSelection(const NewItems: TNodeArray; New while (J >= 0) and (PAnsiChar(NewItems[J]) > PAnsiChar(FSelection[CurrentEnd])) do begin FSelection[CurrentEnd + J + 1] := NewItems[J]; - Dec(J); + System.Dec(J); end; // early out if nothing more needs to be copied if J < 0 then @@ -23071,7 +24318,7 @@ function TBaseVirtualTree.InternalAddToSelection(const NewItems: TNodeArray; New else begin // insert remaining new entries at position 0 - Move(NewItems[0], FSelection[0], (J + 1) * SizeOf(Pointer)); + System.Move(NewItems[0], FSelection[0], (J + 1) * SizeOf(Pointer)); // nothing more to do so exit main loop Break; end; @@ -23079,15 +24326,15 @@ function TBaseVirtualTree.InternalAddToSelection(const NewItems: TNodeArray; New // find the last entry in the remaining selection list which is smaller then the largest // entry in the remaining new items list FindNodeInSelection(NewItems[J], I, 0, CurrentEnd); - Dec(I); + System.Dec(I); // move all entries which are greater than the greatest entry in the new items list up // so the remaining gap travels down to where new items must be inserted - Move(FSelection[I + 1], FSelection[I + J + 2], (CurrentEnd - I) * SizeOf(Pointer)); + System.Move(FSelection[I + 1], FSelection[I + J + 2], (CurrentEnd - I) * SizeOf(Pointer)); CurrentEnd := I; end; // update selection count - Inc(FSelectionCount, AddedNodesSize); + System.Inc(FSelectionCount, AddedNodesSize); // post process added nodes for I := 0 to AddedNodesSize - 1 do @@ -23126,7 +24373,7 @@ procedure TBaseVirtualTree.InternalCacheNode(Node: PVirtualNode); SetLength(FTempNodeCache, Len); end; FTempNodeCache[FTempNodeCount] := Node; - Inc(FTempNodeCount); + System.Inc(FTempNodeCount); end; //---------------------------------------------------------------------------------------------------------------------- @@ -23152,7 +24399,7 @@ procedure TBaseVirtualTree.InternalClearSelection; while FSelectionCount > 0 do begin - Dec(FSelectionCount); + System.Dec(FSelectionCount); //sync path note: deselect when click on another or on outside area Exclude(FSelection[FSelectionCount].States, vsSelected); if SyncCheckstateWithSelection[FSelection[FSelectionCount]] then @@ -23197,7 +24444,7 @@ procedure TBaseVirtualTree.InternalConnectNode(Node, Destination: PVirtualNode; Run := Destination; while Assigned(Run) do begin - Inc(Run.Index); + System.Inc(Run.Index); Run := Run.NextSibling; end; end; @@ -23217,7 +24464,7 @@ procedure TBaseVirtualTree.InternalConnectNode(Node, Destination: PVirtualNode; Run := Node; while Assigned(Run) do begin - Inc(Run.Index); + System.Inc(Run.Index); Run := Run.NextSibling; end; end; @@ -23244,7 +24491,7 @@ procedure TBaseVirtualTree.InternalConnectNode(Node, Destination: PVirtualNode; Run := Node.NextSibling; while Assigned(Run) do begin - Inc(Run.Index); + System.Inc(Run.Index); Run := Run.NextSibling; end; end; @@ -23278,14 +24525,14 @@ procedure TBaseVirtualTree.InternalConnectNode(Node, Destination: PVirtualNode; Node.States := Node.States - [vsChecking, vsCutOrCopy, vsDeleting]; if (Mode <> amNoWhere) then begin - Inc(Node.Parent.ChildCount); + System.Inc(Node.Parent.ChildCount); Include(Node.Parent.States, vsHasChildren); AdjustTotalCount(Node.Parent, Node.TotalCount, True); // Add the new node's height only if its parent is expanded. if (vsExpanded in Node.Parent.States) and (vsVisible in Node.States) then begin AdjustTotalHeight(Node.Parent, Node.TotalHeight, True); - Inc(FVisibleCount, CountVisibleChildren(Node) + Cardinal(IfThen(IsEffectivelyVisible[Node], 1))); + System.Inc(FVisibleCount, CountVisibleChildren(Node) + Cardinal(IfThen(IsEffectivelyVisible[Node], 1))); end;//if // Update the hidden children flag of the parent. @@ -23354,7 +24601,7 @@ procedure TBaseVirtualTree.InternalDisconnectNode(Node: PVirtualNode; KeepFocus: // Some states are only temporary so take them out. Node.States := Node.States - [vsChecking]; Parent := Node.Parent; - Dec(Parent.ChildCount); + System.Dec(Parent.ChildCount); AdjustHeight := (vsExpanded in Parent.States) and (vsVisible in Node.States); if Parent.ChildCount = 0 then begin @@ -23364,9 +24611,9 @@ procedure TBaseVirtualTree.InternalDisconnectNode(Node: PVirtualNode; KeepFocus: end; AdjustTotalCount(Parent, -Integer(Node.TotalCount), True); if AdjustHeight then - AdjustTotalHeight(Parent, -Integer(Node.TotalHeight), True); + AdjustTotalHeight(Parent, -{$IFDEF VT_VCL}Integer{$ENDIF}(Node.TotalHeight), True); if FullyVisible[Node] then - Dec(FVisibleCount, CountVisibleChildren(Node) + Cardinal(IfThen(IsEffectivelyVisible[Node], 1))); + System.Dec(FVisibleCount, CountVisibleChildren(Node) + Cardinal(IfThen(IsEffectivelyVisible[Node], 1))); if Assigned(Node.PrevSibling) then Node.PrevSibling.NextSibling := Node.NextSibling @@ -23384,7 +24631,7 @@ procedure TBaseVirtualTree.InternalDisconnectNode(Node: PVirtualNode; KeepFocus: while Assigned(Run) do begin Run.Index := Index; - Inc(Index); + System.Inc(Index); Run := Run.NextSibling; end; end; @@ -23414,7 +24661,7 @@ procedure TBaseVirtualTree.InternalRemoveFromSelection(Node: PVirtualNode); Exclude(Node.States, vsSelected); if SyncCheckstateWithSelection[Node] then checkstate[Node] := csUncheckedNormal; - Inc(PAnsiChar(FSelection[Index])); + System.Inc(PAnsiChar(FSelection[Index])); DoRemoveFromSelection(Node); AdviseChangeEvent(False, Node, crIgnore); end; @@ -23468,10 +24715,11 @@ procedure TBaseVirtualTree.Loaded; inherited; // Call RegisterDragDrop after all visual inheritance changes to MiscOptions have been applied. +{$IFDEF VT_VCL} if not (csDesigning in ComponentState) and (toAcceptOLEDrop in FOptions.FMiscOptions) then if HandleAllocated then RegisterDragDrop(Handle, DragManager as IDropTarget); - +{$ENDIF} // If a root node count has been set during load of the tree then update its child structure now // as this hasn't been done yet in this case. if (tsNeedRootCountUpdate in FStates) and (FRoot.ChildCount > 0) then @@ -23494,8 +24742,10 @@ procedure TBaseVirtualTree.Loaded; try FHeader.UpdateMainColumn; FHeader.FColumns.FixPositions; +{$IFDEF VT_VCL} if toAutoBidiColumnOrdering in FOptions.FAutoOptions then FHeader.FColumns.ReorderColumns(UseRightToLeftAlignment); +{$ENDIF} // Because of the special recursion and update stopper when creating the window (or resizing it) // we have to manually trigger the auto size calculation here. if hsNeedScaling in FHeader.FStates then @@ -23515,14 +24765,15 @@ procedure TBaseVirtualTree.MainColumnChanged; begin DoCancelEdit; - +{$IFDEF VT_VCL} if Assigned(FAccessibleItem) then NotifyWinEvent(EVENT_OBJECT_NAMECHANGE, Handle, OBJID_CLIENT, CHILDID_SELF); +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.MouseMove(Shift: TShiftState; X, Y: Integer); +procedure TBaseVirtualTree.MouseMove(Shift: TShiftState; X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); var R: TRect; @@ -23545,7 +24796,7 @@ procedure TBaseVirtualTree.MouseMove(Shift: TShiftState; X, Y: Integer); FSearchBuffer := ''; FLastSearchNode := nil; - DoStateChange([tsNodeHeightTracking], [tsScrollPending, tsScrolling, tsEditPending, tsOLEDragPending, tsVCLDragPending, + DoStateChange([tsNodeHeightTracking], [tsScrollPending, tsScrolling, tsEditPending, {$IFDEF VT_VCL}tsOLEDragPending, {$ENDIF}tsVCLDragPending, tsIncrementalSearching, tsNodeHeightTrackPending]); end; @@ -23555,10 +24806,15 @@ procedure TBaseVirtualTree.MouseMove(Shift: TShiftState; X, Y: Integer); // and moved the mouse. if CalculateSelectionRect(X, Y) then begin +{$IFDEF VT_FMX} + Repaint; +{$ELSE} InvalidateRect(Handle, @FNewSelRect, False); UpdateWindow(Handle); - if (Abs(FNewSelRect.Right - FNewSelRect.Left) > Mouse.DragThreshold) or - (Abs(FNewSelRect.Bottom - FNewSelRect.Top) > Mouse.DragThreshold) then +{$ENDIF} + + if (Abs(FNewSelRect.Right - FNewSelRect.Left) > {$IFDEF VT_FMX}3{$ELSE}Mouse.DragThreshold{$ENDIF}) or + (Abs(FNewSelRect.Bottom - FNewSelRect.Top) > {$IFDEF VT_FMX}3{$ELSE}Mouse.DragThreshold{$ENDIF}) then begin if tsClearPending in FStates then begin @@ -23572,7 +24828,11 @@ procedure TBaseVirtualTree.MouseMove(Shift: TShiftState; X, Y: Integer); // The current rectangle may already include some node captions. Handle this. if HandleDrawSelection(X, Y) then +{$IFDEF VT_FMX} + Repaint; +{$ELSE} InvalidateRect(Handle, nil, False); +{$ENDIF} end; end; end @@ -23581,14 +24841,18 @@ procedure TBaseVirtualTree.MouseMove(Shift: TShiftState; X, Y: Integer); if tsNodeHeightTracking in FStates then begin // Handle height tracking. - if DoNodeHeightTracking(FHeightTrackNode, FHeightTrackColumn, FHeader.GetShiftState, + if DoNodeHeightTracking(FHeightTrackNode, FHeightTrackColumn, {$IFDEF VT_FMX}[]{$ELSE}FHeader.GetShiftState{$ENDIF}, FHeightTrackPoint, Point(X, Y)) then begin // Avoid negative (or zero) node heights. if FHeightTrackPoint.Y >= Y then Y := FHeightTrackPoint.Y + 1; SetNodeHeight(FHeightTrackNode, Y - FHeightTrackPoint.Y); +{$IFDEF VT_FMX} + Repaint; +{$ELSE} UpdateWindow(Handle); +{$ENDIF} Exit; end; end; @@ -23597,15 +24861,17 @@ procedure TBaseVirtualTree.MouseMove(Shift: TShiftState; X, Y: Integer); // middle mouse button. This means panning is being used, hence remove the wheel scroll flag. if [tsWheelPanning, tsWheelScrolling] * FStates = [tsWheelPanning, tsWheelScrolling] then begin - if ((Abs(FLastClickPos.X - X) >= Mouse.DragThreshold) or (Abs(FLastClickPos.Y - Y) >= Mouse.DragThreshold)) then + if ((Abs(FLastClickPos.X - X) >= {$IFDEF VT_FMX}3{$ELSE}Mouse.DragThreshold{$ENDIF}) or (Abs(FLastClickPos.Y - Y) >= {$IFDEF VT_FMX}3{$ELSE}Mouse.DragThreshold{$ENDIF})) then DoStateChange([], [tsWheelScrolling]); end; // Really start dragging if the mouse has been moved more than the threshold. +{$IFDEF VT_VCL} if (tsOLEDragPending in FStates) and ((Abs(FLastClickPos.X - X) >= FDragThreshold) or (Abs(FLastClickPos.Y - Y) >= FDragThreshold)) then DoDragging(FLastClickPos) - else + else +{$ENDIF} begin if CanAutoScroll then DoAutoScroll(X, Y); @@ -23625,14 +24891,26 @@ procedure TBaseVirtualTree.MouseMove(Shift: TShiftState; X, Y: Integer); // If something in the selection changed then invalidate the entire // tree instead trying to figure out the display rects of all changed nodes. if HandleDrawSelection(X, Y) then +{$IFDEF VT_FMX} + Repaint +{$ELSE} InvalidateRect(Handle, nil, False) +{$ENDIF} else begin UnionRect(R, OrderRect(FNewSelRect), OrderRect(FLastSelRect)); OffsetRect(R, -FEffectiveOffsetX, FOffsetY); +{$IFDEF VT_FMX} + Repaint; +{$ELSE} InvalidateRect(Handle, @R, False); +{$ENDIF} end; +{$IFDEF VT_FMX} + Repaint; +{$ELSE} UpdateWindow(Handle); +{$ENDIF} end; end; end; @@ -23687,23 +24965,25 @@ procedure TBaseVirtualTree.Notification(AComponent: TComponent; Operation: TOper //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.OriginalWMNCPaint(DC: HDC); +procedure TBaseVirtualTree.OriginalWMNCPaint({$IFDEF VT_FMX}ACanvas: TCanvas{$ELSE}DC: HDC{$ENDIF}); // Unfortunately, the painting for the non-client area in TControl is not always correct and does also not consider // existing clipping regions, so it has been modified here to take this into account. - +{$IFDEF VT_VCL} const InnerStyles: array[TBevelCut] of Integer = (0, BDR_SUNKENINNER, BDR_RAISEDINNER, 0); OuterStyles: array[TBevelCut] of Integer = (0, BDR_SUNKENOUTER, BDR_RAISEDOUTER, 0); EdgeStyles: array[TBevelKind] of Integer = (0, 0, BF_SOFT, BF_FLAT); Ctl3DStyles: array[Boolean] of Integer = (BF_MONO, 0); +{$ENDIF} var RC, RW: TRect; EdgeSize: Integer; Size: TSize; begin +{$IFDEF VT_VCL} if (BevelKind <> bkNone) or (BorderWidth > 0) then begin RC := Rect(0, 0, Width, Height); @@ -23745,9 +25025,10 @@ procedure TBaseVirtualTree.OriginalWMNCPaint(DC: HDC); ExcludeClipRect(DC, RC.Left, RC.Top, RC.Right, RC.Bottom); // Erase parts not drawn. - Brush.Color := FColors.BorderColor; + {$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := FColors.BorderColor; Winapi.Windows.FillRect(DC, RW, Brush.Handle); end; +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -23759,13 +25040,16 @@ procedure TBaseVirtualTree.Paint; var Window: TRect; Target: TPoint; - Temp: Integer; + Temp: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; Options: TVTInternalPaintOptions; - RTLOffset: Integer; + RTLOffset: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; begin Options := [poBackground, poColumnColor, poDrawFocusRect, poDrawDropMark, poDrawSelection, poGridLines]; +{$IFDEF VT_FMX} + Options:= Options + [poUnbuffered]; //!!!!!!! +{$ENDIF} if UseRightToLeftAlignment and FHeader.UseColumns then RTLOffset := ComputeRTLOffset(True) else @@ -23775,12 +25059,14 @@ procedure TBaseVirtualTree.Paint; // reset when BeginPaint is called (in the ancestor). // The difference to the DC's clipbox is that it is also valid with internal paint operations used // e.g. by the Explorer while dragging, but show window content while dragging is disabled. +{$IFDEF VT_VCL} if not IsRectEmpty(FUpdateRect) then +{$ENDIF} begin Temp := Header.Columns.GetVisibleFixedWidth; if Temp = 0 then begin - Window := FUpdateRect; + Window := {$IFDEF VT_FMX}ClipRect{$ELSE}FUpdateRect{$ENDIF}; Target := Window.TopLeft; // The clipping rectangle is given in client coordinates of the window. We have to convert it into @@ -23791,7 +25077,7 @@ procedure TBaseVirtualTree.Paint; else begin // First part, fixed columns - Window := ClientRect; + Window := {$IFDEF VT_FMX}ClipRect{$ELSE}ClientRect{$ENDIF}; Window.Right := Temp; Target := Window.TopLeft; @@ -23799,7 +25085,7 @@ procedure TBaseVirtualTree.Paint; PaintTree(Canvas, Window, Target, Options); // Second part, other columns - Window := GetClientRect; + Window := {$IFDEF VT_FMX}ClipRect{$ELSE}GetClientRect{$ENDIF}; if Temp > Window.Right then Exit; @@ -23818,14 +25104,18 @@ procedure TBaseVirtualTree.Paint; procedure TBaseVirtualTree.PaintCheckImage(Canvas: TCanvas; const ImageInfo: TVTImageInfo; Selected: Boolean); var - ForegroundColor: COLORREF; - R: TRect; +{$IFDEF VT_VCL} + ForegroundColor: COLORREF; Details: TThemedElementDetails; - lSize: TSize; Theme: HTHEME; +{$ENDIF} + ForegroundColor: TColor; + R: TRect; + lSize: TSize; begin with ImageInfo do begin +{$IFDEF VT_VCL} if (tsUseThemes in FStates) and (FCheckImageKind = ckSystemDefault) then begin Details.Element := teButton; @@ -23885,26 +25175,37 @@ procedure TBaseVirtualTree.PaintCheckImage(Canvas: TCanvas; const ImageInfo: TVT end end else +{$ENDIF} with FCheckImages do begin if Selected and not Ghosted then begin - if Focused or (toPopupMode in FOptions.FPaintOptions) then - ForegroundColor := ColorToRGB(FColors.FocusedSelectionColor) + if {$IFDEF VT_FMX}IsFocused{$ELSE}Focused{$ENDIF} or (TVTPaintOption.toPopupMode in FOptions.FPaintOptions) then + ForegroundColor := {$IFDEF VT_VCL}ColorToRGB{$ENDIF}(FColors.FocusedSelectionColor) else - ForegroundColor := ColorToRGB(FColors.UnfocusedSelectionColor); + ForegroundColor := {$IFDEF VT_VCL}ColorToRGB{$ENDIF}(FColors.UnfocusedSelectionColor); end else +{$IFDEF VT_FMX} + ForegroundColor := clWhite; + Draw(Canvas, Rect(XPos, YPos, 16, 16), Index, 1.0); //TODO: 16px Image! +{$ELSE} ForegroundColor := GetRGBColor(BlendColor); ImageList_DrawEx(Handle, Index, Canvas.Handle, XPos, YPos, 0, 0, GetRGBColor(BkColor), ForegroundColor, ILD_TRANSPARENT); +{$ENDIF} end; end; end; //---------------------------------------------------------------------------------------------------------------------- - +{$IFDEF VT_FMX} +type + TImageType = (itImage, itMask); //###!!! +const + ILD_MASK = $0010; //###!!! +{$ENDIF} procedure TBaseVirtualTree.PaintImage(var PaintInfo: TVTPaintInfo; ImageInfoIndex: TVTImageInfoIndex; DoOverlay: Boolean); const @@ -23916,6 +25217,7 @@ procedure TBaseVirtualTree.PaintImage(var PaintInfo: TVTPaintInfo; ImageInfoInde DrawEnabled: Boolean; CustomOverlayDrawing: Boolean; // False if the built-in overloay drawing of TImageList should be used, True if custom drawing should take place. begin +{$IFDEF VT_VCL} with PaintInfo do begin CutNode := (vsCutOrCopy in Node.States) and (tsCutPending in FStates); @@ -23982,33 +25284,35 @@ procedure TBaseVirtualTree.PaintImage(var PaintInfo: TVTPaintInfo; ImageInfoInde end;//if end; end; +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- procedure TBaseVirtualTree.PaintNodeButton(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const R: TRect; - ButtonX, ButtonY: Integer; BidiMode: TBiDiMode); + ButtonX, ButtonY: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; BidiMode: TBiDiMode); var Bitmap: TBitmap; - XPos: Integer; + XPos: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; IsHot: Boolean; IsSelected : boolean; +{$IFDEF VT_VCL} Theme: HTHEME; +{$ENDIF} Glyph: Integer; State: Integer; Pos: TRect; - begin IsHot := (FCurrentHotNode = Node) and FHotNodeButtonHit; IsSelected := (vsSelected in Node.States); // Draw the node's plus/minus button according to the directionality. - if BidiMode = bdLeftToRight then + if BidiMode = bdLeftToRight then XPos := R.Left + ButtonX else XPos := R.Right - ButtonX - FPlusBM.Width; - +{$IFDEF VT_VCL} if (tsUseExplorerTheme in FStates) and not VclStyleEnabled then begin Glyph := IfThen(IsHot, TVP_HOTGLYPH, TVP_GLYPH); @@ -24019,6 +25323,7 @@ procedure TBaseVirtualTree.PaintNodeButton(Canvas: TCanvas; Node: PVirtualNode; CloseThemeData(Theme); end else +{$ENDIF} begin if vsExpanded in Node.States then begin @@ -24045,23 +25350,31 @@ procedure TBaseVirtualTree.PaintNodeButton(Canvas: TCanvas; Node: PVirtualNode; Bitmap := FPlusBM; end; // Need to draw this masked. +{$IFDEF VT_FMX} + Canvas.DrawBitmap(//###!!! + Bitmap + , Rect(0, 0, FMinusBM.Width, FMinusBM.Height) + , Rect(XPos, R.Top + ButtonY, XPos+FMinusBM.Width, R.Top + ButtonY + FMinusBM.Height) + , 1.0 + ); +{$ELSE} Canvas.Draw(XPos, R.Top + ButtonY, Bitmap); +{$ENDIF} end; end; //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.PaintTreeLines(const PaintInfo: TVTPaintInfo; VAlignment, IndentSize: Integer; const LineImage: TLineImage); +procedure TBaseVirtualTree.PaintTreeLines(const PaintInfo: TVTPaintInfo; VAlignment, IndentSize: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; const LineImage: TLineImage); var I: Integer; XPos, - Offset: Integer; + Offset: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; NewStyles: TLineImage; - begin NewStyles := nil; - +{$IFDEF VT_VCL} with PaintInfo do begin if BidiMode = bdLeftToRight then @@ -24129,21 +25442,23 @@ procedure TBaseVirtualTree.PaintTreeLines(const PaintInfo: TVTPaintInfo; VAlignm end; end; end; +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.PaintSelectionRectangle(Target: TCanvas; WindowOrgX: Integer; const SelectionRect: TRect; +procedure TBaseVirtualTree.PaintSelectionRectangle(Target: TCanvas; WindowOrgX: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; const SelectionRect: TRect; TargetRect: TRect); // Helper routine to draw a selection rectangle in the mode determined by DrawSelectionMode. - +{$IFDEF VT_VCL} var BlendRect: TRect; TextColorBackup, BackColorBackup: COLORREF; // used to restore forground and background colors when drawing a selection rectangle - +{$ENDIF} begin +{$IFDEF VT_VCL} if ((FDrawSelectionMode = smDottedRectangle) and not (tsUseThemes in FStates)) then begin // Classical selection rectangle using dotted borderlines. @@ -24165,14 +25480,15 @@ procedure TBaseVirtualTree.PaintSelectionRectangle(Target: TCanvas; WindowOrgX: AlphaBlend(0, Target.Handle, BlendRect, Point(0, 0), bmConstantAlphaAndColor, FSelectionBlendFactor, ColorToRGB(FColors.SelectionRectangleBlendColor)); - Target.Brush.Color := FColors.SelectionRectangleBorderColor; + Target.{$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := FColors.SelectionRectangleBorderColor; Target.FrameRect(SelectionRect); end; end; +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- - +{$IFDEF VT_VCL} procedure TBaseVirtualTree.PanningWindowProc(var Message: TMessage); var @@ -24198,13 +25514,14 @@ procedure TBaseVirtualTree.PanningWindowProc(var Message: TMessage); with Message do Result := DefWindowProc(FPanningWindow, Msg, wParam, lParam); end; +{$ENDIF} //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX, MaxWidth: Integer); +procedure TBaseVirtualTree.PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX, MaxWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); // This method is called immediately before a cell's content is drawn und is responsible to paint selection colors etc. - +{$IFDEF VT_VCL} var TextColorBackup, BackColorBackup: COLORREF; @@ -24262,8 +25579,9 @@ procedure TBaseVirtualTree.PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX, end; //--------------- end local functions --------------------------------------- - +{$ENDIF} begin +{$IFDEF VT_VCL} if tsUseExplorerTheme in FStates then begin Theme := OpenThemeData(Application.ActiveFormHandle, 'Explorer::TreeView'); @@ -24424,6 +25742,7 @@ procedure TBaseVirtualTree.PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX, if tsUseExplorerTheme in FStates then CloseThemeData(Theme); +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -24437,8 +25756,8 @@ function TBaseVirtualTree.ReadChunk(Stream: TStream; Version: Integer; Node: PVi // Returns True if the chunk could be handled, otherwise False. type TAdvancedVersion2Identifier = packed record - ChildCount, - NodeHeight: Cardinal; + ChildCount: Cardinal; + NodeHeight: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; States: Word; Align: Byte; CheckState: TCheckState; @@ -24491,7 +25810,7 @@ function TBaseVirtualTree.ReadChunk(Stream: TStream; Version: Integer; Node: PVi ChildCount := IdBody.ChildCount; NodeHeight := IdBody.NodeHeight; States := []; - Move(IdBody.States, States, SizeOf(IdBody.States)); + System.Move(IdBody.States, States, SizeOf(IdBody.States)); CheckState := IdBody.CheckState; CheckType := IdBody.CheckType; Reserved := IdBody.Reserved; @@ -24534,7 +25853,7 @@ function TBaseVirtualTree.ReadChunk(Stream: TStream; Version: Integer; Node: PVi Run.Parent := Node; ReadNode(Stream, Version, Run); - Dec(ChunkBody.ChildCount); + System.Dec(ChunkBody.ChildCount); end; end; Result := True; @@ -24600,10 +25919,10 @@ procedure TBaseVirtualTree.ReadNode(Stream: TStream; Version: Integer; Node: PVi procedure TBaseVirtualTree.RedirectFontChangeEvent(Canvas: TCanvas); begin - if @Canvas.Font.OnChange <> @FOldFontChange then + if @Canvas.Font.{$IFDEF VT_FMX}OnChanged{$ELSE}OnChange{$ENDIF} <> @FOldFontChange then begin - FOldFontChange := Canvas.Font.OnChange; - Canvas.Font.OnChange := FontChanged; + FOldFontChange := Canvas.Font.{$IFDEF VT_FMX}OnChanged{$ELSE}OnChange{$ENDIF}; + Canvas.Font.{$IFDEF VT_FMX}OnChanged{$ELSE}OnChange{$ENDIF} := FontChanged; end; end; @@ -24618,7 +25937,9 @@ procedure TBaseVirtualTree.RemoveFromSelection(Node: PVirtualNode); if not FSelectionLocked then begin Assert(Assigned(Node), 'Node must not be nil!'); +{$IFDEF VT_VCL} Assert(GetCurrentThreadId = MainThreadId, Self.Classname + '.RemoveFromSelection() must only be called from UI thread.'); +{$ENDIF} if vsSelected in Node.States then begin Assert(FSelectionCount > 0, 'if one node has set the vsSelected flag, SelectionCount must be >0.'); @@ -24628,9 +25949,9 @@ procedure TBaseVirtualTree.RemoveFromSelection(Node: PVirtualNode); checkstate[Node] := csUncheckedNormal; if FindNodeInSelection(Node, Index, -1, -1) and (Index < FSelectionCount - 1) then - Move(FSelection[Index + 1], FSelection[Index], (FSelectionCount - Index - 1) * SizeOf(Pointer)); + System.Move(FSelection[Index + 1], FSelection[Index], (FSelectionCount - Index - 1) * SizeOf(Pointer)); if FSelectionCount > 0 then - Dec(FSelectionCount); + System.Dec(FSelectionCount); SetLength(FSelection, FSelectionCount); if FSelectionCount = 0 then @@ -24669,7 +25990,7 @@ procedure TBaseVirtualTree.UpdateNextNodeToSelect(Node: PVirtualNode); end;//if Assigned(Node); //---------------------------------------------------------------------------------------------------------------------- - +{$IFDEF VT_VCL} function TBaseVirtualTree.RenderOLEData(const FormatEtcIn: TFormatEtc; out Medium: TStgMedium; ForClipboard: Boolean): HResult; @@ -24764,7 +26085,7 @@ function TBaseVirtualTree.RenderOLEData(const FormatEtcIn: TFormatEtc; out Mediu else // Ask application descendants to render self defined formats. Result := DoRenderOLEData(FormatEtcIn, Medium, ForClipboard); end; - +{$ENDIF} //---------------------------------------------------------------------------------------------------------------------- procedure TBaseVirtualTree.ResetRangeAnchor; @@ -24781,7 +26102,7 @@ procedure TBaseVirtualTree.ResetRangeAnchor; procedure TBaseVirtualTree.RestoreFontChangeEvent(Canvas: TCanvas); begin - Canvas.Font.OnChange := FOldFontChange; + Canvas.Font.{$IFDEF VT_FMX}OnChanged{$ELSE}OnChange{$ENDIF} := FOldFontChange; FOldFontChange := nil; end; @@ -24879,6 +26200,13 @@ procedure TBaseVirtualTree.SetFocusedNodeAndColumn(Node: PVirtualNode; Column: T FFocusedColumn := OldColumn; end; +{$IFDEF VT_FMX} +procedure TBaseVirtualTree.SetFont(const Value: TFont); +begin + FFont.Assign(Value); +end; +{$ENDIF} + //---------------------------------------------------------------------------------------------------------------------- procedure TBaseVirtualTree.SkipNode(Stream: TStream); @@ -24901,7 +26229,7 @@ procedure TBaseVirtualTree.SkipNode(Stream: TStream); end; //---------------------------------------------------------------------------------------------------------------------- - +{$IFDEF VT_VCL} var PanningWindowClass: TWndClass = ( style: 0; @@ -24915,6 +26243,7 @@ procedure TBaseVirtualTree.SkipNode(Stream: TStream); lpszMenuName: nil; lpszClassName: 'VTPanningWindow' ); +{$ENDIF} procedure TBaseVirtualTree.StartWheelPanning(Position: TPoint); @@ -24922,7 +26251,7 @@ procedure TBaseVirtualTree.StartWheelPanning(Position: TPoint); // which determines in which direction and how far wheel panning/scrolling will happen. //--------------- local function -------------------------------------------- - +{$IFDEF VT_VCL} function CreateClipRegion: HRGN; // In order to avoid doing all the transparent drawing ourselves we use a @@ -24978,11 +26307,12 @@ procedure TBaseVirtualTree.StartWheelPanning(Position: TPoint); ClassRegistered: Boolean; ImageName: string; Pt: TPoint; - +{$ENDIF} begin // Set both panning and scrolling flag. One will be removed shortly depending on whether the middle mouse button is // released before the mouse is moved or vice versa. The first case is referred to as wheel scrolling while the // latter is called wheel panning. +{$IFDEF VT_VCL} StopTimer(ScrollTimer); DoStateChange([tsWheelPanning, tsWheelScrolling]); @@ -25024,6 +26354,7 @@ procedure TBaseVirtualTree.StartWheelPanning(Position: TPoint); SetFocus; SetCapture(Handle); SetTimer(Handle, ScrollTimer, 20, nil); +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -25036,6 +26367,7 @@ procedure TBaseVirtualTree.StopWheelPanning; Instance: Pointer; begin +{$IFDEF VT_VCL} if [tsWheelPanning, tsWheelScrolling] * FStates <> [] then begin // Release the mouse capture and stop the panscroll timer. @@ -25059,6 +26391,7 @@ procedure TBaseVirtualTree.StopWheelPanning; FPanningCursor := 0; Winapi.Windows.SetCursor(Screen.Cursors[Cursor]); end; +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -25071,7 +26404,9 @@ procedure TBaseVirtualTree.StructureChange(Node: PVirtualNode; Reason: TChangeRe if FUpdateCount = 0 then begin if (FChangeDelay > 0) and HandleAllocated and not (tsSynchMode in FStates) then +{$IFDEF VT_VCL} SetTimer(Handle, StructureChangeTimer, FChangeDelay, nil) +{$ENDIF} else DoStructureChange(Node, Reason); end; @@ -25087,7 +26422,7 @@ function TBaseVirtualTree.SuggestDropEffect(Source: TObject; Shift: TShiftState; begin Result := AllowedEffects; - +{$IFDEF VT_VCL} // prefer MOVE if source and target are the same control, otherwise whatever is allowed as initial value if Assigned(Source) and (Source = Self) then if (AllowedEffects and DROPEFFECT_MOVE) <> 0 then @@ -25137,6 +26472,7 @@ function TBaseVirtualTree.SuggestDropEffect(Source: TObject; Shift: TShiftState; // else default end; end; +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -25298,7 +26634,11 @@ procedure TBaseVirtualTree.UpdateDesigner; begin if (csDesigning in ComponentState) and not (csUpdating in ComponentState) then begin +{$IFDEF VT_FMX} + ParentForm := Self.Root.GetObject as TCustomForm; +{$ELSE} ParentForm := GetParentForm(Self); +{$ENDIF} if Assigned(ParentForm) and Assigned(ParentForm.Designer) then ParentForm.Designer.Modified; end; @@ -25313,8 +26653,8 @@ procedure TBaseVirtualTree.UpdateHeaderRect; var OffsetX, - OffsetY: Integer; - EdgeSize: Integer; + OffsetY: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + EdgeSize: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; Size: TSize; begin @@ -25345,7 +26685,7 @@ procedure TBaseVirtualTree.UpdateHeaderRect; if hoVisible in FHeader.FOptions then begin if FHeaderRect.Left <= FHeaderRect.Right then - FHeaderRect.Bottom := FHeaderRect.Top + Integer(FHeader.FHeight) + FHeaderRect.Bottom := FHeaderRect.Top + {$IFDEF VT_VCL}Integer{$ENDIF}(FHeader.FHeight) else FHeaderRect := Rect(0, 0, 0, 0); end @@ -25364,17 +26704,19 @@ procedure TBaseVirtualTree.UpdateEditBounds; CurrentAlignment: TAlignment; CurrentBidiMode: TBidiMode; offsets : TVTOffsets; - offset : Integer; + offset : {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; begin if (tsEditing in FStates) and Assigned(FFocusedNode) and (FEditColumn < FHeader.Columns.Count) then // prevent EArgumentOutOfRangeException begin +{$IFDEF VT_VCL} if (GetCurrentThreadId <> MainThreadID) then begin // UpdateEditBounds() will be called at the end of the thread Exit; end; +{$ENDIF} if vsMultiline in FFocusedNode.States then R := GetDisplayRect(FFocusedNode, FEditColumn, True, False) else if not (toGridExtensions in FOptions.FMiscOptions) then @@ -25389,8 +26731,8 @@ procedure TBaseVirtualTree.UpdateEditBounds; // Calculate an offset for the main column. GetOffsets(FFocusedNode, offsets, ofsLabel, FEditColumn); offset := offsets[ofsLabel]; -// if offsets[ofsToggleButton] < 0 then -// Inc(offset, offsets[ofsToggleButton]); + if offsets[ofsToggleButton] < 0 then + Inc(offset, offsets[ofsToggleButton]); end else offset := 0; @@ -25407,8 +26749,10 @@ procedure TBaseVirtualTree.UpdateEditBounds; CurrentBidiMode := FHeader.Columns[FEditColumn].FBiDiMode; end; // Consider bidi mode here. In RTL context does left alignment actually mean right alignment and vice versa. +{$IFDEF VT_VCL} if CurrentBidiMode <> bdLeftToRight then ChangeBiDiModeAlignment(CurrentAlignment); +{$ENDIF} if CurrentAlignment = taLeftJustify then begin if CurrentBiDiMode = bdLeftToRight then @@ -25432,7 +26776,7 @@ procedure TBaseVirtualTree.UpdateEditBounds; end; //---------------------------------------------------------------------------------------------------------------------- - +{$IFDEF VT_VCL} const ScrollMasks: array[Boolean] of Cardinal = (0, SIF_DISABLENOSCROLL); @@ -25443,7 +26787,7 @@ procedure TBaseVirtualTree.UpdateEditBounds; SYSRGN = 4; function GetRandomRgn(DC: HDC; Rgn: HRGN; iNum: Integer): Integer; stdcall; external 'GDI32.DLL'; - +{$ENDIF} procedure TBaseVirtualTree.UpdateWindowAndDragImage(const Tree: TBaseVirtualTree; TreeRect: TRect; UpdateNCArea, ReshowDragImage: Boolean); @@ -25451,7 +26795,7 @@ procedure TBaseVirtualTree.UpdateWindowAndDragImage(const Tree: TBaseVirtualTree // of the drag image. // Note: This method must only be called during a drag operation and the tree passed in is the one managing the current // drag image (so it is the actual drag source). - +{$IFDEF VT_VCL} var DragRegion, // the region representing the drag image UpdateRegion, // the unclipped region within the tree to be updated @@ -25467,7 +26811,11 @@ procedure TBaseVirtualTree.UpdateWindowAndDragImage(const Tree: TBaseVirtualTree //This function was originally designed only for tree's drag image. But we modified //it for reusing it with header's drag image too for solving issue 248. useDragImage: TVTDragImage; +{$ENDIF} begin +{$IFDEF VT_FMX} + Repaint; +{$ELSE} if IntersectRect(TreeRect, TreeRect, ClientRect) then begin // Retrieve the visible region of the window. This is important to avoid overpainting parts of other windows @@ -25526,6 +26874,7 @@ procedure TBaseVirtualTree.UpdateWindowAndDragImage(const Tree: TBaseVirtualTree DeleteObject(DragRegion); DeleteObject(VisibleTreeRegion); end; +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -25540,11 +26889,13 @@ procedure TBaseVirtualTree.ValidateCache(); InterruptValidation; FStartIndex := 0; +{$IFDEF VT_VCL} if (tsValidationNeeded in FStates) and (FVisibleCount > CacheThreshold) then begin // Tell the thread this tree needs actually something to do. TWorkerThread.AddTree(Self); end; +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -25564,12 +26915,17 @@ procedure TBaseVirtualTree.VclStyleChanged; // Updates the member FVclStyleEnabled, should be called initially and when the VCL style changes begin +{$IFDEF VT_FMX} +FVclStyleEnabled := false; +{$ELSE} FVclStyleEnabled := StyleServices.Enabled and not StyleServices.IsSystemStyle; +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- //PROFILE-NO +{$IFDEF VT_VCL} procedure TBaseVirtualTree.WndProc(var Message: TMessage); var @@ -25611,6 +26967,7 @@ procedure TBaseVirtualTree.WndProc(var Message: TMessage); end; end; end; +{$ENDIF} //PROFILE-YES //---------------------------------------------------------------------------------------------------------------------- @@ -25729,13 +27086,13 @@ function TBaseVirtualTree.AbsoluteIndex(Node: PVirtualNode): Cardinal; begin // if there's a previous sibling then add its total count to the result Node := Node.PrevSibling; - Inc(Result, Node.TotalCount); + System.Inc(Result, Node.TotalCount); end else begin Node := Node.Parent; if Node <> FRoot then - Inc(Result); + System.Inc(Result); end; end; end; @@ -25806,7 +27163,7 @@ procedure TBaseVirtualTree.AddFromStream(Stream: TStream; TargetNode: PVirtualNo while (Stream.Position < Stream.Size) and (Count > 0) do begin - Dec(Count); + System.Dec(Count); Node := MakeNewNode; InternalConnectNode(Node, TargetNode, Self, amAddChildLast); InternalAddFromStream(Stream, Version, Node); @@ -25850,27 +27207,37 @@ procedure TBaseVirtualTree.Assign(Source: TPersistent); Self.Anchors := Anchors; Self.AutoScrollDelay := AutoScrollDelay; Self.AutoScrollInterval := AutoScrollInterval; +{$IFDEF VT_VCL} Self.AutoSize := AutoSize; +{$ENDIF} Self.Background := Background; Self.BevelEdges := BevelEdges; Self.BevelInner := BevelInner; Self.BevelKind := BevelKind; Self.BevelOuter := BevelOuter; Self.BevelWidth := BevelWidth; +{$IFDEF VT_VCL} Self.BiDiMode := BiDiMode; +{$ENDIF} Self.BorderStyle := BorderStyle; Self.BorderWidth := BorderWidth; Self.ChangeDelay := ChangeDelay; Self.CheckImageKind := CheckImageKind; - Self.Color := Color; + Self.{$IFDEF VT_FMX}Fill.{$ENDIF}Color := {$IFDEF VT_FMX}Fill.{$ENDIF}Color; Self.Colors.Assign(Colors); +{$IFDEF VT_VCL} Self.Constraints.Assign(Constraints); Self.Ctl3D := Ctl3D; +{$ENDIF} Self.DefaultNodeHeight := DefaultNodeHeight; Self.DefaultPasteMode := DefaultPasteMode; +{$IFDEF VT_VCL} Self.DragCursor := DragCursor; +{$ENDIF} Self.DragImageKind := DragImageKind; +{$IFDEF VT_VCL} Self.DragKind := DragKind; +{$ENDIF} Self.DragMode := DragMode; Self.Enabled := Enabled; Self.Font := Font; @@ -25878,24 +27245,30 @@ procedure TBaseVirtualTree.Assign(Source: TPersistent); Self.HintMode := HintMode; Self.HotCursor := HotCursor; Self.Images := Images; +{$IFDEF VT_VCL} Self.ImeMode := ImeMode; Self.ImeName := ImeName; +{$ENDIF} Self.Indent := Indent; Self.Margin := Margin; Self.NodeAlignment := NodeAlignment; Self.NodeDataSize := NodeDataSize; Self.TreeOptions := TreeOptions; +{$IFDEF VT_VCL} Self.ParentBiDiMode := ParentBiDiMode; Self.ParentColor := ParentColor; Self.ParentCtl3D := ParentCtl3D; Self.ParentFont := ParentFont; +{$ENDIF} Self.ParentShowHint := ParentShowHint; Self.PopupMenu := PopupMenu; Self.RootNodeCount := RootNodeCount; Self.ScrollBarOptions := ScrollBarOptions; Self.ShowHint := ShowHint; Self.StateImages := StateImages; +{$IFDEF VT_VCL} Self.StyleElements := StyleElements; +{$ENDIF} Self.TabOrder := TabOrder; Self.TabStop := TabStop; Self.Visible := Visible; @@ -25915,7 +27288,7 @@ procedure TBaseVirtualTree.AutoScale(isDpiChange: Boolean); // isDPIChnage is True, if the DPI of the form has changed. In this case the font may not yet be adapted to this, so do not adjust DefualtNodeHeight. var - lTextHeight: Cardinal; + lTextHeight: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; begin if HandleAllocated and (toAutoChangeScale in TreeOptions.AutoOptions) and not isDpiChange then begin @@ -25935,6 +27308,7 @@ procedure TBaseVirtualTree.BeginDrag(Immediate: Boolean; Threshold: Integer); // Reintroduced method to allow to start OLE drag'n drop as well as VCL drag'n drop. begin +{$IFDEF VT_VCL} if FDragType = dtVCL then begin DoStateChange([tsVCLDragPending]); @@ -25953,6 +27327,7 @@ procedure TBaseVirtualTree.BeginDrag(Immediate: Boolean; Threshold: Integer); else DoStateChange([tsOLEDragPending]); end; +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -25989,7 +27364,7 @@ procedure TBaseVirtualTree.BeginSynch; else DoUpdating(usSynch); end; - Inc(FSynchUpdateCount); + System.Inc(FSynchUpdateCount); DoStateChange([tsSynchMode]); end; @@ -25998,7 +27373,9 @@ procedure TBaseVirtualTree.BeginSynch; procedure TBaseVirtualTree.BeginUpdate; begin +{$IFDEF VT_VCL} Assert(GetCurrentThreadId = MainThreadId, 'UI controls like ' + Classname + ' should only be manipulated through the main thread.'); +{$ENDIF} if not (csDestroying in ComponentState) then begin if FUpdateCount = 0 then @@ -26009,7 +27386,7 @@ procedure TBaseVirtualTree.BeginUpdate; else DoUpdating(usUpdate); end; - Inc(FUpdateCount); + System.Inc(FUpdateCount); DoStateChange([tsUpdating]); end; @@ -26084,8 +27461,13 @@ function TBaseVirtualTree.CanFocus: Boolean; if Result and not (csDesigning in ComponentState) then begin +{$IFDEF VT_FMX} + Form := Self.Root.GetObject as TCustomForm; + Result := (Form = nil) or ({Form.Enabled and }Form.Visible); +{$ELSE} Form := GetParentForm(Self); Result := (Form = nil) or (Form.Enabled and Form.Visible); +{$ENDIF} end; end; @@ -26104,7 +27486,9 @@ procedure TBaseVirtualTree.Clear; if ClipboardStates * FStates <> [] then begin +{$IFDEF VT_VCL} OleSetClipboard(nil); +{$ENDIF} DoStateChange([], ClipboardStates); end; ClearSelection; @@ -26157,12 +27541,14 @@ procedure TBaseVirtualTree.ClearSelection(pFireChangeEvent: Boolean); var Node: PVirtualNode; - Dummy: Integer; + Dummy: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; R: TRect; Counter: Integer; begin +{$IFDEF VT_VCL} Assert(GetCurrentThreadId = MainThreadId, Self.Classname + '.ClearSelection() must only be called from UI thread.'); +{$ENDIF} if not FSelectionLocked and (FSelectionCount > 0) and not (csDestroying in ComponentState) then begin if (FUpdateCount = 0) and HandleAllocated and (FVisibleCount > 0) then @@ -26175,11 +27561,15 @@ procedure TBaseVirtualTree.ClearSelection(pFireChangeEvent: Boolean); while Assigned(Node) do begin - R.Bottom := R.Top + Integer(NodeHeight[Node]); + R.Bottom := R.Top + {$IFDEF VT_VCL}Integer{$ENDIF}(NodeHeight[Node]); if vsSelected in Node.States then begin +{$IFDEF VT_FMX} + Repaint; +{$ELSE} InvalidateRect(Handle, @R, False); - Dec(Counter); +{$ENDIF} + System.Dec(Counter); // Only try as many nodes as are selected. if Counter = 0 then Break; @@ -26309,11 +27699,12 @@ function TBaseVirtualTree.CopyTo(Source, Target: PVirtualNode; Mode: TVTNodeAtta //---------------------------------------------------------------------------------------------------------------------- procedure TBaseVirtualTree.CopyToClipboard; - +{$IFDEF VT_VCL} var DataObject: IDataObject; - +{$ENDIF} begin +{$IFDEF VT_VCL} if FSelectionCount > 0 then begin DataObject := TVTDataObject.Create(Self, True) as IDataObject; @@ -26324,6 +27715,7 @@ procedure TBaseVirtualTree.CopyToClipboard; Invalidate; end; end; +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -26332,12 +27724,14 @@ procedure TBaseVirtualTree.CutToClipboard; begin if (FSelectionCount > 0) and not (toReadOnly in FOptions.FMiscOptions) then begin +{$IFDEF VT_VCL} if OleSetClipboard(TVTDataObject.Create(Self, True)) = S_OK then begin MarkCutCopyNodes; DoStateChange([tsCutPending], [tsCopyPending]); Invalidate; end; +{$ENDIF} end; end; @@ -26351,7 +27745,7 @@ procedure TBaseVirtualTree.DeleteChildren(Node: PVirtualNode; ResetHasChildren: Run, Mark: PVirtualNode; LastTop, - LastLeft, + LastLeft: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; NewSize: Integer; ParentVisible: Boolean; @@ -26362,7 +27756,7 @@ procedure TBaseVirtualTree.DeleteChildren(Node: PVirtualNode; ResetHasChildren: // The code below uses some flags for speed improvements which may cause invalid pointers if updates of // the tree happen. Hence switch updates off until we have finished the operation. - Inc(FUpdateCount); + System.Inc(FUpdateCount); try InterruptValidation; LastLeft := -FEffectiveOffsetX; @@ -26379,7 +27773,7 @@ procedure TBaseVirtualTree.DeleteChildren(Node: PVirtualNode; ResetHasChildren: while Assigned(Run) do begin if ParentVisible and IsEffectivelyVisible[Run] then - Dec(FVisibleCount); + System.Dec(FVisibleCount); Include(Run.States, vsDeleting); Mark := Run; @@ -26407,7 +27801,7 @@ procedure TBaseVirtualTree.DeleteChildren(Node: PVirtualNode; ResetHasChildren: Node.FirstChild := nil; Node.LastChild := nil; finally - Dec(FUpdateCount); + System.Dec(FUpdateCount); end; InvalidateCache; @@ -26445,7 +27839,7 @@ procedure TBaseVirtualTree.DeleteNode(Node: PVirtualNode; Reindex: Boolean; Pare var LastTop, - LastLeft: Integer; + LastLeft: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; LastParent: PVirtualNode; WasInSynchMode: Boolean; @@ -26573,7 +27967,11 @@ function TBaseVirtualTree.Dragging: Boolean; begin // Check for both OLE drag'n drop as well as VCL drag'n drop. +{$IFDEF VT_FMX} + Result := false; +{$ELSE} Result := ([tsOLEDragPending, tsOLEDragging] * FStates <> []) or inherited Dragging; +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -26627,7 +28025,7 @@ procedure TBaseVirtualTree.EndSynch; begin if FSynchUpdateCount > 0 then - Dec(FSynchUpdateCount); + System.Dec(FSynchUpdateCount); if not (csDestroying in ComponentState) then begin @@ -26650,7 +28048,7 @@ procedure TBaseVirtualTree.EndUpdate; begin if FUpdateCount > 0 then - Dec(FUpdateCount); + System.Dec(FUpdateCount); if not (csDestroying in ComponentState) then begin @@ -26712,28 +28110,28 @@ function TBaseVirtualTree.ExecuteAction(Action: TBasicAction): Boolean; if not Result then begin - Result := Action is TEditSelectAll; + Result := {$IFDEF VT_FMX}false{$ELSE}Action is TEditSelectAll{$ENDIF}; if Result then SelectAll(False) else begin - Result := Action is TEditCopy; + Result := {$IFDEF VT_FMX}false{$ELSE}Action is TEditCopy{$ENDIF}; if Result then CopyToClipboard else if not (toReadOnly in FOptions.FMiscOptions) then begin - Result := Action is TEditCut; + Result := {$IFDEF VT_FMX}false{$ELSE}Action is TEditCut{$ENDIF}; if Result then CutToClipboard else begin - Result := Action is TEditPaste; + Result := {$IFDEF VT_FMX}false{$ELSE}Action is TEditPaste{$ENDIF}; if Result then PasteFromClipboard else begin - Result := Action is TEditDelete; + Result := {$IFDEF VT_FMX}false{$ELSE}Action is TEditDelete{$ENDIF}; if Result then DeleteSelectedNodes; end; @@ -26776,7 +28174,9 @@ procedure TBaseVirtualTree.FlushClipboard; if ClipboardStates * FStates <> [] then begin DoStateChange([tsClipboardFlushing]); +{$IFDEF VT_VCL} OleFlushClipboard; +{$ENDIF} CancelCutOrCopy; DoStateChange([], [tsClipboardFlushing]); end; @@ -26909,15 +28309,15 @@ function TBaseVirtualTree.GetDisplayRect(Node: PVirtualNode; Column: TColumnInde var Temp: PVirtualNode; - LeftOffset: Cardinal; - TopOffset: Cardinal; + LeftOffset: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; + TopOffset: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; CacheIsAvailable: Boolean; - TextWidth: Integer; + TextWidth: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; CurrentBidiMode: TBidiMode; CurrentAlignment: TAlignment; - MaxUnclippedHeight: Integer; + MaxUnclippedHeight: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; TM: TTextMetric; - ExtraVerticalMargin: Integer; + ExtraVerticalMargin: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; lOffsets: TVTOffsets; begin Assert(Assigned(Node), 'Node must not be nil.'); @@ -27001,7 +28401,9 @@ function TBaseVirtualTree.GetDisplayRect(Node: PVirtualNode; Column: TColumnInde Dec(Result.Right, LeftOffset); // Consider bidi mode here. In RTL context does left alignment actually mean right alignment and vice versa. +{$IFDEF VT_VCL} ChangeBiDiModeAlignment(CurrentAlignment); +{$ENDIF} end; TextWidth := DoGetNodeWidth(Node, Column); @@ -27026,15 +28428,15 @@ function TBaseVirtualTree.GetDisplayRect(Node: PVirtualNode; Column: TColumnInde CurrentAlignment := taRightJustify; // Increase cell height (up to MaxUnclippedHeight determined above) if text does not fit. - GetTextMetrics(Self.Canvas.Handle, TM); + GetTextMetrics(Self.Canvas{$IFDEF VT_VCL}.Handle{$ENDIF}, TM); ExtraVerticalMargin := System.Math.Min(TM.tmHeight, MaxUnclippedHeight) - (Result.Bottom - Result.Top); if ExtraVerticalMargin > 0 then - InflateRect(Result, 0, (ExtraVerticalMargin + 1) div 2); + InflateRect(Result, 0, (ExtraVerticalMargin + 1) {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2); case CurrentAlignment of taCenter: begin - Result.Left := (Result.Left + Result.Right - TextWidth) div 2; + Result.Left := (Result.Left + Result.Right - TextWidth) {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2; Result.Right := Result.Left + TextWidth; end; taRightJustify: @@ -27049,7 +28451,7 @@ function TBaseVirtualTree.GetDisplayRect(Node: PVirtualNode; Column: TColumnInde case CurrentAlignment of taCenter: begin - Result.Left := (Result.Left + Result.Right - TextWidth) div 2; + Result.Left := (Result.Left + Result.Right - TextWidth) {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2; Result.Right := Result.Left + TextWidth; end; taRightJustify: @@ -27480,7 +28882,7 @@ function TBaseVirtualTree.GetFirstVisibleNoInit(Node: PVirtualNode = nil; //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.GetHitTestInfoAt(X, Y: Integer; Relative: Boolean; var HitInfo: THitInfo); +procedure TBaseVirtualTree.GetHitTestInfoAt(X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; Relative: Boolean; var HitInfo: THitInfo); // Determines the node that occupies the specified point or nil if there's none. The parameter Relative determines // whether to consider X and Y as being client coordinates (if True) or as being absolute tree coordinates. @@ -27488,14 +28890,13 @@ procedure TBaseVirtualTree.GetHitTestInfoAt(X, Y: Integer; Relative: Boolean; va var ColLeft, - ColRight: Integer; - NodeTop: Integer; + ColRight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + NodeTop: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; InitialColumn, NextColumn: TColumnIndex; CurrentBidiMode: TBidiMode; CurrentAlignment: TAlignment; NodeRect: TRect; - begin HitInfo.HitNode := nil; HitInfo.HitPositions := []; @@ -27809,7 +29210,7 @@ function TBaseVirtualTree.GetLastVisibleNoInit(Node: PVirtualNode = nil; //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.GetMaxColumnWidth(Column: TColumnIndex; UseSmartColumnWidth: Boolean = False): Integer; +function TBaseVirtualTree.GetMaxColumnWidth(Column: TColumnIndex; UseSmartColumnWidth: Boolean = False): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; // This method determines the width of the largest node in the given column. // If UseSmartColumnWidth is True then only the visible nodes which are in view will be considered @@ -27821,7 +29222,7 @@ function TBaseVirtualTree.GetMaxColumnWidth(Column: TColumnIndex; UseSmartColumn LastNode, NextNode: PVirtualNode; TextLeft, - CurrentWidth: Integer; + CurrentWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; lOffsets: TVTOffsets; begin if OperationCanceled then @@ -28476,13 +29877,13 @@ function TBaseVirtualTree.GetNextVisibleSiblingNoInit(Node: PVirtualNode; Includ //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.GetNodeAt(X, Y: Integer): PVirtualNode; +function TBaseVirtualTree.GetNodeAt(X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}): PVirtualNode; // Overloaded variant of GetNodeAt to easy life of application developers which do not need to have the exact // top position returned and always use client coordinates. var - Dummy: Integer; + Dummy: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; begin Result := GetNodeAt(X, Y, True, Dummy); @@ -28495,7 +29896,7 @@ function TBaseVirtualTree.GetNodeAt(const P: TPoint): PVirtualNode; //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.GetNodeAt(X, Y: Integer; Relative: Boolean; var NodeTop: Integer): PVirtualNode; +function TBaseVirtualTree.GetNodeAt(X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; Relative: Boolean; var NodeTop: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}): PVirtualNode; // This method returns the node that occupies the specified point, or nil if there's none. // If Releative is True then X and Y are given in client coordinates otherwise they are considered as being @@ -28505,8 +29906,7 @@ function TBaseVirtualTree.GetNodeAt(X, Y: Integer; Relative: Boolean; var NodeTo var AbsolutePos, - CurrentPos: Cardinal; - + CurrentPos: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; begin if Y < 0 then Y := 0; @@ -28628,7 +30028,7 @@ function TBaseVirtualTree.GetNodeLevel(Node: PVirtualNode): Cardinal; while Run <> FRoot do begin Run := Run.Parent; - Inc(Result); + System.Inc(Result); end; end; end; @@ -29406,7 +30806,7 @@ function TBaseVirtualTree.GetSortedCutCopySet(Resolve: Boolean): TNodeArray; SetLength(Result, Len); end; Result[Counter] := Node; - Inc(Counter); + System.Inc(Counter); end; //--------------- end local function ---------------------------------------- @@ -29489,7 +30889,7 @@ function TBaseVirtualTree.GetSortedSelection(Resolve: Boolean): TNodeArray; if vsSelected in Run.States then begin Result[Counter] := Run; - Inc(Counter); + System.Inc(Counter); if Assigned(Run.NextSibling) then Run := Run.NextSibling else @@ -29516,7 +30916,7 @@ function TBaseVirtualTree.GetSortedSelection(Resolve: Boolean): TNodeArray; if vsSelected in Run.States then begin Result[Counter] := Run; - Inc(Counter); + System.Inc(Counter); end; Run := GetNextNoInit(Run); end; @@ -29705,13 +31105,16 @@ procedure TBaseVirtualTree.InvalidateColumn(Column: TColumnIndex); var R: TRect; - begin if (FUpdateCount = 0) and HandleAllocated and FHeader.FColumns.IsValidColumn(Column) then begin - R := ClientRect; + R := {$IFDEF VT_FMX}ClipRect{$ELSE}ClientRect{$ENDIF}; FHeader.Columns.GetColumnBounds(Column, R.Left, R.Right); +{$IFDEF VT_FMX} + Repaint; +{$ELSE} InvalidateRect(Handle, @R, False); +{$ENDIF} end; end; @@ -29723,13 +31126,19 @@ function TBaseVirtualTree.InvalidateNode(Node: PVirtualNode): TRect; begin Assert(Assigned(Node), 'Node must not be nil.'); +{$IFDEF VT_VCL} Assert(GetCurrentThreadId = MainThreadId, 'UI controls may only be chnaged in UI thread.'); +{$ENDIF} // Reset height measured flag too to cause a re-issue of the OnMeasureItem event. Exclude(Node.States, vsHeightMeasured); if (FUpdateCount = 0) and HandleAllocated then begin Result := GetDisplayRect(Node, NoColumn, False); +{$IFDEF VT_FMX} + Repaint; +{$ELSE} InvalidateRect(Handle, @Result, False); +{$ENDIF} end else result := Rect(-1,-1,-1,-1); @@ -29744,7 +31153,6 @@ procedure TBaseVirtualTree.InvalidateToBottom(Node: PVirtualNode); var R: TRect; - begin if (FUpdateCount = 0) and HandleAllocated then begin @@ -29759,7 +31167,11 @@ procedure TBaseVirtualTree.InvalidateToBottom(Node: PVirtualNode); if (toChildrenAbove in FOptions.FPaintOptions) and (vsExpanded in Node.States) then Dec(R.Top, Node.TotalHeight + NodeHeight[Node]); R.Bottom := ClientHeight; +{$IFDEF VT_FMX} + Repaint; +{$ELSE} InvalidateRect(Handle, @R, False); +{$ENDIF} end; end; end; @@ -29996,7 +31408,7 @@ procedure TBaseVirtualTree.LoadFromStream(Stream: TStream); while (Stream.Position < Stream.Size) and (Count > 0) do begin - Dec(Count); + System.Dec(Count); Node := MakeNewNode; InternalConnectNode(Node, FRoot, Self, amAddChildLast); InternalAddFromStream(Stream, Version, Node); @@ -30023,7 +31435,7 @@ procedure TBaseVirtualTree.MeasureItemHeight(const Canvas: TCanvas; Node: PVirtu // If the height of the given node has not yet been measured then do it now. var - NewNodeHeight: Integer; + NewNodeHeight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; begin if not (vsHeightMeasured in Node.States) then @@ -30033,6 +31445,7 @@ procedure TBaseVirtualTree.MeasureItemHeight(const Canvas: TCanvas; Node: PVirtu begin NewNodeHeight := Node.NodeHeight; // Anonymous methods help to make this thread safe easily. +{$IFDEF VT_VCL} if (MainThreadId <> GetCurrentThreadId) then TThread.Synchronize(nil, procedure @@ -30043,9 +31456,12 @@ procedure TBaseVirtualTree.MeasureItemHeight(const Canvas: TCanvas; Node: PVirtu ) else begin +{$ENDIF} DoMeasureItem(Canvas, Node, NewNodeHeight); SetNodeHeight(Node, NewNodeHeight); +{$IFDEF VT_VCL} end; +{$ENDIF} end; end; end; @@ -30267,7 +31683,7 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe VAlign, IndentSize, - ButtonY: Integer; // Y position of toggle button within the node's rect + ButtonY: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; // Y position of toggle button within the node's rect LineImage: TLineImage; PaintInfo: TVTPaintInfo; // all necessary information about a node to pass to the paint routines @@ -30276,20 +31692,20 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe SelectionRect, // ordered rectangle used for drawing the selection focus rect ClipRect: TRect; // area to which the canvas will be clipped when painting a node's content NextColumn: TColumnIndex; - BaseOffset: Integer; // top position of the top node to draw given in absolute tree coordinates + BaseOffset: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; // top position of the top node to draw given in absolute tree coordinates NodeBitmap: TBitmap; // small buffer to draw flicker free MaximumRight, // maximum horizontal target position - MaximumBottom: Integer; // maximum vertical target position + MaximumBottom: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; // maximum vertical target position SelectLevel: Integer; // > 0 if current node is selected or child/grandchild etc. of a selected node FirstColumn: TColumnIndex; // index of first column which is at least partially visible in the given window MaxRight, ColLeft, - ColRight: Integer; + ColRight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; SavedTargetDC: Integer; - PaintWidth: Integer; - CurrentNodeHeight: Integer; + PaintWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + CurrentNodeHeight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; lUseSelectedBkColor: Boolean; // determines if the dotted grid lines need to be painted in selection color of background color CellIsTouchingClientRight: Boolean; @@ -30297,22 +31713,26 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe ColumnIsFixed: Boolean; begin +{$IFDEF VT_FMX} + PaintOptions:= PaintOptions + [poUnbuffered]; //!!!!!!! +{$ENDIF} + if not (tsPainting in FStates) then begin DoStateChange([tsPainting]); try DoBeforePaint(TargetCanvas); - +{$IFDEF VT_VCL} if poUnbuffered in PaintOptions then SavedTargetDC := SaveDC(TargetCanvas.Handle) else SavedTargetDC := 0; - +{$ENDIF} // Prepare paint info structure. ZeroMemory(@PaintInfo, SizeOf(PaintInfo)); PaintWidth := Window.Right - Window.Left; - +{$IFDEF VT_VCL} if not (poUnbuffered in PaintOptions) then begin // Create small bitmaps and initialize default values. @@ -30334,6 +31754,7 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe PaintInfo.Canvas := NodeBitmap.Canvas; end else +{$ENDIF} begin PaintInfo.Canvas := TargetCanvas; NodeBitmap := nil; @@ -30344,7 +31765,7 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe try // Prepare the current selection rectangle once. The corner points are absolute tree coordinates. SelectionRect := OrderRect(FNewSelRect); - DrawSelectionRect := IsMouseSelecting and not IsRectEmpty(SelectionRect) and (GetKeyState(VK_LBUTTON) < 0); + DrawSelectionRect := IsMouseSelecting and not IsRectEmpty(SelectionRect) {$IFDEF VT_VCL}and (GetKeyState(VK_LBUTTON) < 0){$ENDIF}; //TODO: GetKeyState // R represents an entire node (all columns), but is a bit unprecise when it comes to // trees without any column defined, because FRangeX only represents the maximum width of all @@ -30354,7 +31775,7 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe R := Rect(0, 0, Max(FRangeX, ClientWidth), 0); // For quick checks some intermediate variables are used. - UseBackground := (toShowBackground in FOptions.FPaintOptions) and Assigned(FBackground.Graphic) and + UseBackground := (toShowBackground in FOptions.FPaintOptions) and Assigned(FBackground.{$IFDEF VT_FMX}Bitmap{$ELSE}Graphic{$ENDIF}) and (poBackground in PaintOptions); ShowImages := Assigned(FImages) or Assigned(OnGetImageIndexEx); ShowStateImages := Assigned(FStateImages) or Assigned(OnGetImageIndexEx); @@ -30364,7 +31785,7 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe // Adjust paint options to tree settings. Hide selection if told so or the tree is unfocused. if (toAlwaysHideSelection in FOptions.FPaintOptions) or - (not Focused and (toHideSelection in FOptions.FPaintOptions)) then + (not {$IFDEF VT_FMX}IsFocused{$ELSE}Focused{$ENDIF} and (toHideSelection in FOptions.FPaintOptions)) then Exclude(PaintOptions, poDrawSelection); if toHideFocusRect in FOptions.FPaintOptions then Exclude(PaintOptions, poDrawFocusRect); @@ -30386,7 +31807,11 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe TargetRect := Rect(Target.X, Target.Y - (Window.Top - BaseOffset), MaximumRight, 0); TargetRect.Bottom := TargetRect.Top; +{$IFDEF VT_FMX} + TargetCanvas.Font.Assign(Self.Font); +{$ELSE} TargetCanvas.Font := Self.Font; +{$ENDIF} // This marker gets the index of the first column which is visible in the given window. // This is needed for column based background colors. @@ -30406,14 +31831,14 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe if not (vsInitialized in PaintInfo.Node.States) then InitNode(PaintInfo.Node); if (vsSelected in PaintInfo.Node.States) and not (toChildrenAbove in FOptions.FPaintOptions) then - Inc(SelectLevel); + System.Inc(SelectLevel); // Ensure the node's height is determined. MeasureItemHeight(PaintInfo.Canvas, PaintInfo.Node); // Adjust the brush origin for dotted lines depending on the current source position. // It is applied some lines later, as the canvas might get reallocated, when changing the node bitmap. - PaintInfo.BrushOrigin := Point(Window.Left and 1, BaseOffset and 1); + PaintInfo.BrushOrigin := {$IFDEF VT_FMX}Point(0,0){$ELSE}Point(Window.Left and 1, BaseOffset and 1){$ENDIF}; Inc(BaseOffset, PaintInfo.Node.NodeHeight); TargetRect.Bottom := TargetRect.Top + PaintInfo.Node.NodeHeight; @@ -30422,6 +31847,7 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe // which are children of selected nodes. if (SelectLevel > 0) or not (poSelectedOnly in PaintOptions) then begin +{$IFDEF VT_VCL} if not (poUnbuffered in PaintOptions) then begin // Adjust height of temporary node bitmap. @@ -30446,10 +31872,14 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe // Set the origin of the canvas' brush. This depends on the node heights. with PaintInfo do SetBrushOrigin(Canvas, BrushOrigin.X, BrushOrigin.Y); - +{$ENDIF} CurrentNodeHeight := PaintInfo.Node.NodeHeight; +{$IFDEF VT_FMX} + R := TargetRect; +{$ELSE} R.Bottom := CurrentNodeHeight; - +{$ENDIF} + CalculateVerticalAlignments(ShowImages, ShowStateImages, PaintInfo.Node, VAlign, ButtonY); // Let application decide whether the node should normally be drawn or by the application itself. @@ -30459,7 +31889,7 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe PaintInfo.PaintOptions := PaintOptions; // The node background can contain a single color, a bitmap or can be drawn by the application. - ClearNodeBackground(PaintInfo, UseBackground, True, Rect(Window.Left, TargetRect.Top, Window.Right, + ClearNodeBackground(PaintInfo, UseBackground, {$IFDEF VT_FMX}False{$ELSE}True{$ENDIF}, Rect(Window.Left, TargetRect.Top, Window.Right, TargetRect.Bottom)); // Prepare column, position and node clipping rectangle. @@ -30506,8 +31936,10 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe IsMainColumn := PaintInfo.Column = FHeader.MainColumn; // Consider bidi mode here. In RTL context means left alignment actually right alignment and vice versa. +{$IFDEF VT_VCL} if PaintInfo.BidiMode <> bdLeftToRight then ChangeBiDiModeAlignment(PaintInfo.Alignment); +{$ENDIF} // Paint the current cell if it is marked as being visible or columns aren't used and // if this cell belongs to the main column if only the main column should be drawn. @@ -30553,23 +31985,31 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe ClipRect.Top := Max(ClipRect.Top, Window.Top - (BaseOffset - CurrentNodeHeight)); ClipRect.Bottom := ClipRect.Bottom - Max(TargetRect.Bottom - MaximumBottom, 0); end; +{$IFDEF VT_FMX} + //Canvas.IntersectClipRect(ClipRect); +{$ELSE} ClipCanvas(Canvas, ClipRect); +{$ENDIF} end; // Paint the horizontal grid line. if (poGridLines in PaintOptions) and (toShowHorzGridLines in FOptions.FPaintOptions) then begin +{$IFDEF VT_FMX} + Canvas.Fill.Color := FColors.GridLineColor; +{$ELSE} Canvas.Font.Color := FColors.GridLineColor; +{$ENDIF} if IsMainColumn and (FLineMode = lmBands) then begin if BidiMode = bdLeftToRight then begin - DrawDottedHLine(PaintInfo, CellRect.Left + IfThen(toFixedIndent in FOptions.FPaintOptions, 1, IndentSize) * Integer(FIndent), CellRect.Right - 1, + DrawDottedHLine(PaintInfo, CellRect.Left + IfThen(toFixedIndent in FOptions.FPaintOptions, 1, IndentSize) * {$IFDEF VT_VCL}Integer{$ENDIF}(FIndent), CellRect.Right - 1, CellRect.Bottom - 1); end else begin - DrawDottedHLine(PaintInfo, CellRect.Left, CellRect.Right - IfThen(toFixedIndent in FOptions.FPaintOptions, 1, IndentSize) * Integer(FIndent) - 1, + DrawDottedHLine(PaintInfo, CellRect.Left, CellRect.Right - IfThen(toFixedIndent in FOptions.FPaintOptions, 1, IndentSize) * {$IFDEF VT_VCL}Integer{$ENDIF}(FIndent) - 1, CellRect.Bottom - 1); end; end @@ -30587,7 +32027,7 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe begin // These variables and the nested if conditions shall make the logic // easier to understand. - CellIsTouchingClientRight := PaintInfo.CellRect.Right = ClientRect.Right; + CellIsTouchingClientRight := PaintInfo.CellRect.Right = {$IFDEF VT_FMX}ClipRect{$ELSE}ClientRect{$ENDIF}.Right; CellIsInLastColumn := Position = TColumnPosition(Count - 1); ColumnIsFixed := coFixed in FHeader.FColumns[Column].Options; @@ -30604,10 +32044,14 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe begin if (BidiMode = bdLeftToRight) or not ColumnIsEmpty(Node, Column) then begin +{$IFDEF VT_FMX} + Canvas.Fill.Color := FColors.GridLineColor; +{$ELSE} Canvas.Font.Color := FColors.GridLineColor; +{$ENDIF} lUseSelectedBkColor := (poDrawSelection in PaintOptions) and (toFullRowSelect in FOptions.FSelectionOptions) and - (vsSelected in Node.States) and not (toUseBlendedSelection in FOptions.PaintOptions) and not - (tsUseExplorerTheme in FStates); + (vsSelected in Node.States) and not (toUseBlendedSelection in FOptions.PaintOptions) + {$IFDEF VT_VCL}and not (tsUseExplorerTheme in FStates){$ENDIF}; DrawDottedVLine(PaintInfo, CellRect.Top, CellRect.Bottom, CellRect.Right - 1, lUseSelectedBkColor); end; @@ -30664,7 +32108,12 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe else NextColumn := GetNextVisibleColumn(PaintInfo.Column); +{$IFDEF VT_FMX} + //PaintInfo.Canvas.IntersectClipRect(Rect(0, 0, 0, 0)); +{$ELSE} SelectClipRgn(PaintInfo.Canvas.Handle, 0); +{$ENDIF} + // Stop column loop if there are no further columns in the given window. if (PaintInfo.CellRect.Left >= Window.Right) or (NextColumn = InvalidColumn) then Break; @@ -30705,9 +32154,13 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe end; // Put the constructed node image onto the target canvas. +{$IFDEF VT_FMX} + //TODO: +{$ELSE} if not (poUnbuffered in PaintOptions) then with TWithSafeRect(TargetRect), NodeBitmap do BitBlt(TargetCanvas.Handle, Left, Top, Width, Height, Canvas.Handle, Window.Left, 0, SRCCOPY); +{$ENDIF} end; end; @@ -30731,8 +32184,13 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe BaseOffset := Target.X; Target := TargetRect.TopLeft; R := Rect(TargetRect.Left, 0, TargetRect.Left, MaximumBottom - Target.Y); +{$IFDEF VT_FMX} + TargetRect := Rect(0, TargetRect.Top, MaximumRight - Target.X, MaximumBottom - Target.Y); +{$ELSE} TargetRect := Rect(0, 0, MaximumRight - Target.X, MaximumBottom - Target.Y); +{$ENDIF} +{$IFDEF VT_VCL} if not (poUnbuffered in PaintOptions) then begin // Avoid unnecessary copying of bitmap content. This will destroy the DC handle too. @@ -30740,13 +32198,15 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe NodeBitmap.PixelFormat := pf32Bit; NodeBitmap.SetSize(TargetRect.Right - TargetRect.Left, TargetRect.Bottom - TargetRect.Top); end; - +{$ENDIF} // Call back application/descendants whether they want to erase this area. if not DoPaintBackground(PaintInfo.Canvas, TargetRect) then begin if UseBackground then begin +{$IFDEF VT_VCL} SetCanvasOrigin(PaintInfo.Canvas, 0, 0); +{$ENDIF} if toStaticBackground in TreeOptions.PaintOptions then StaticBackground(FBackground, PaintInfo.Canvas, Target, TargetRect, FColors.BackGroundColor) else @@ -30755,7 +32215,9 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe else begin // Consider here also colors of the columns. +{$IFDEF VT_VCL} SetCanvasOrigin(PaintInfo.Canvas, Target.X, 0); // This line caused issue #313 when it was placed above the if-statement +{$ENDIF} if UseColumns then begin with FHeader.FColumns do @@ -30784,7 +32246,7 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe // Initialize MaxRight. MaxRight := Target.X - 1; - PaintInfo.Canvas.Font.Color := FColors.GridLineColor; + PaintInfo.Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Font{$ENDIF}.Color := FColors.GridLineColor; while (FirstColumn <> InvalidColumn) and (MaxRight < TargetRect.Right + Target.X) do begin // Determine left and right coordinate of the current column @@ -30808,10 +32270,10 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe end; if not (coParentColor in Items[FirstColumn].FOptions) then - PaintInfo.Canvas.Brush.Color := Items[FirstColumn].FColor + PaintInfo.Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := Items[FirstColumn].FColor else - PaintInfo.Canvas.Brush.Color := FColors.BackGroundColor; - PaintInfo.Canvas.FillRect(R); + PaintInfo.Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := FColors.BackGroundColor; + PaintInfo.Canvas.FillRect(R{$IFDEF VT_FMX}, 0, 0, [], 1.0{$ENDIF}); end; FirstColumn := GetNextVisibleColumn(FirstColumn); end; @@ -30826,56 +32288,77 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe (toFullVertGridLines in FOptions.FPaintOptions) and (toShowVertGridLines in FOptions.FPaintOptions) and (not (hoAutoResize in FHeader.FOptions)) then Inc(R.Left); - PaintInfo.Canvas.Brush.Color := FColors.BackGroundColor; - PaintInfo.Canvas.FillRect(R); + PaintInfo.Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := FColors.BackGroundColor; + PaintInfo.Canvas.FillRect(R{$IFDEF VT_FMX}, 0, 0, [], 1.0{$ENDIF}); end; end; +{$IFDEF VT_VCL} SetCanvasOrigin(PaintInfo.Canvas, 0, 0); +{$ENDIF} end else begin // No columns nor bitmap background. Simply erase it with the tree color. +{$IFDEF VT_VCL} SetCanvasOrigin(PaintInfo.Canvas, 0, 0); - PaintInfo.Canvas.Brush.Color := FColors.BackGroundColor; - PaintInfo.Canvas.FillRect(TargetRect); +{$ENDIF} + PaintInfo.Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := FColors.BackGroundColor; + PaintInfo.Canvas.FillRect(TargetRect{$IFDEF VT_FMX}, 0, 0, [], 1.0{$ENDIF}); end; end; end; +{$IFDEF VT_VCL} SetCanvasOrigin(PaintInfo.Canvas, 0, 0); - +{$ENDIF} if DrawSelectionRect then begin R := OrderRect(FNewSelRect); // Remap the selection rectangle to the current window of the tree. // Since Target has been used for other tasks BaseOffset got the left extent of the target position here. OffsetRect(R, -Target.X + BaseOffset - Window.Left, -Target.Y + FOffsetY); +{$IFDEF VT_VCL} SetBrushOrigin(PaintInfo.Canvas, 0, Target.X and 1); +{$ENDIF} PaintSelectionRectangle(PaintInfo.Canvas, 0, R, TargetRect); end; - +{$IFDEF VT_FMX} + //TODO: BitBlt +{$ELSE} if not (poUnBuffered in PaintOptions) then with Target, NodeBitmap do BitBlt(TargetCanvas.Handle, X, Y, Width, Height, Canvas.Handle, 0, 0, SRCCOPY); +{$ENDIF} end; finally PaintInfo.Canvas.Unlock; +{$IFDEF VT_VCL} if poUnbuffered in PaintOptions then RestoreDC(TargetCanvas.Handle, SavedTargetDC) else NodeBitmap.Free; +{$ENDIF} end;//try..finally if (ChildCount[nil] = 0) and (FEmptyListMessage <> '') then begin // output a message if no items are to display +{$IFDEF VT_FMX} + Canvas.Font.Assign(Self.Font); +{$ELSE} Canvas.Font := Self.Font; - SetBkMode(TargetCanvas.Handle, TRANSPARENT); + SetBkMode(TargetCanvas.Handle, TRANSPARENT); +{$ENDIF} R.Left := OffSetX + 2; R.Top := 2; R.Right := R.Left + Width - 2; R.Bottom := Height -2; +{$IFDEF VT_FMX} + TargetCanvas.Fill.Color := clGrayText; + TargetCanvas.FillText(R, FEmptyListMessage, true, 1.0, [], TTextAlign.Leading {[tfNoClip, tfLeft, tfWordBreak]}); +{$ELSE} TargetCanvas.Font.Color := clGrayText; TargetCanvas.TextRect(R, FEmptyListMessage, [tfNoClip, tfLeft, tfWordBreak]); +{$ENDIF} end; DoAfterPaint(TargetCanvas); @@ -30892,13 +32375,15 @@ function TBaseVirtualTree.PasteFromClipboard: Boolean; // Reads what is currently on the clipboard into the tree (if the format is supported). // Note: If the application wants to have text or special formats to be inserted then it must implement // its own code (OLE). Here only the native tree format is accepted. - +{$IFDEF VT_VCL} var Data: IDataObject; Source: TBaseVirtualTree; +{$ENDIF} begin Result := False; +{$IFDEF VT_VCL} if not (toReadOnly in FOptions.FMiscOptions) then begin if OleGetClipboard(Data) <> S_OK then @@ -30918,11 +32403,12 @@ function TBaseVirtualTree.PasteFromClipboard: Boolean; end; end; end; +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.PrepareDragImage(HotSpot: TPoint; const DataObject: IDataObject); +procedure TBaseVirtualTree.PrepareDragImage(HotSpot: TPoint; const DataObject: {$IFDEF VT_FMX}TDragObject{$ELSE}IDragObject{$ENDIF}); // Initiates an image drag operation. HotSpot is the position of the mouse in client coordinates. @@ -30936,6 +32422,8 @@ procedure TBaseVirtualTree.PrepareDragImage(HotSpot: TPoint; const DataObject: I Image: TBitmap; begin +{$IFDEF VT_VCL} + {$IFDEF VT_FMX}PaintOptions:= PaintOptions + [poUnbuffered];{$ENDIF} if CanShowDragImage then begin // Determine the drag rectangle which is a square around the hot spot. Operate in virtual tree space. @@ -30972,7 +32460,7 @@ procedure TBaseVirtualTree.PrepareDragImage(HotSpot: TPoint; const DataObject: I SetSize(TreeRect.Right - TreeRect.Left, TreeRect.Bottom - TreeRect.Top); // Erase the entire image with the color key value, for the case not everything // in the image is covered by the tree image. - Canvas.Brush.Color := FColors.BackGroundColor; + Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := FColors.BackGroundColor; Canvas.FillRect(Rect(0, 0, Width, Height)); PaintOptions := [poDrawSelection, poSelectedOnly]; @@ -30991,6 +32479,7 @@ procedure TBaseVirtualTree.PrepareDragImage(HotSpot: TPoint; const DataObject: I Image.Free; end; end; +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -31016,9 +32505,11 @@ procedure TBaseVirtualTree.Print(Printer: TPrinter; PrintHeader: Boolean); xPageNum, yPageNum, // # of pages (except the occasional last one) xPage, yPage: Integer; // Loop counter Scale: Extended; // Scale factor between Printer Canvas and VTree Canvas +{$IFDEF VT_VCL} LogFont: TLogFont; - +{$ENDIF} begin +{$IFDEF VT_VCL} if Assigned(Printer) then begin BeginUpdate; @@ -31122,7 +32613,7 @@ procedure TBaseVirtualTree.Print(Printer: TPrinter; PrintHeader: Boolean); SrcRect.Bottom := SrcRect.Top + vPageHeight; // Clear the image - PrinterImage.Canvas.Brush.Color := clWhite; + PrinterImage.Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := clWhite; PrinterImage.Canvas.FillRect(Rect(0, 0, PrinterImage.Width, PrinterImage.Height)); PrinterImage.Canvas.CopyRect(DestRect, Image.Canvas, SrcRect); PrtStretchDrawDIB(Printer.Canvas, Rect(0, 0, Printer.PageWidth, Printer.PageHeight - 1), PrinterImage); @@ -31143,11 +32634,12 @@ procedure TBaseVirtualTree.Print(Printer: TPrinter; PrintHeader: Boolean); EndUpdate; end; end; +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.ProcessDrop(const DataObject: IDataObject; TargetNode: PVirtualNode; var Effect: Integer; +function TBaseVirtualTree.ProcessDrop(const DataObject: {$IFDEF VT_FMX}TDragObject{$ELSE}IDragObject{$ENDIF}; TargetNode: PVirtualNode; var Effect: Integer; Mode: TVTNodeAttachMode): Boolean; // Recreates the (sub) tree structure serialized into memory and provided by DataObject. The new nodes are attached to @@ -31160,6 +32652,7 @@ function TBaseVirtualTree.ProcessDrop(const DataObject: IDataObject; TargetNode: begin Result := False; +{$IFDEF VT_VCL} if Mode = amNoWhere then Effect := DROPEFFECT_NONE else @@ -31195,10 +32688,12 @@ function TBaseVirtualTree.ProcessDrop(const DataObject: IDataObject; TargetNode: EndUpdate; end; end; +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- +{$IFDEF VT_VCL} type // needed to handle OLE global memory objects TOLEMemoryStream = class(TCustomMemoryStream) @@ -31213,6 +32708,7 @@ function TOLEMemoryStream.Write(const Buffer; Count: Integer): Integer; begin raise EStreamError.CreateRes(PResStringRec(@SCantWriteResourceStreamError)); end; +{$ENDIF} //----------------- TBaseVirtualTree ----------------------------------------------------------------------------- @@ -31253,7 +32749,7 @@ function TBaseVirtualTree.GetDefaultHintKind: TVTHintKind; end; //---------------------------------------------------------------------------------------------------------------------- - +{$IFDEF VT_VCL} function TBaseVirtualTree.ProcessOLEData(Source: TBaseVirtualTree; const DataObject: IDataObject; TargetNode: PVirtualNode; Mode: TVTNodeAttachMode; Optimized: Boolean): Boolean; @@ -31394,7 +32890,7 @@ function TBaseVirtualTree.ProcessOLEData(Source: TBaseVirtualTree; const DataObj end; end; end; - +{$ENDIF} //---------------------------------------------------------------------------------------------------------------------- procedure TBaseVirtualTree.ReinitChildren(Node: PVirtualNode; Recursive: Boolean); @@ -31457,7 +32953,11 @@ procedure TBaseVirtualTree.RepaintNode(Node: PVirtualNode); if Assigned(Node) and (Node <> FRoot) then begin R := GetDisplayRect(Node, NoColumn, False); +{$IFDEF VT_FMX} + Repaint; +{$ELSE} RedrawWindow(Handle, @R, 0, RDW_INVALIDATE or RDW_UPDATENOW or RDW_NOERASE or RDW_VALIDATE or RDW_NOCHILDREN); +{$ENDIF} end; end; @@ -31585,7 +33085,7 @@ function TBaseVirtualTree.ScrollIntoView(Node: PVirtualNode; Center: Boolean; Ho if R.Top < 0 then begin if Center then - SetOffsetY(FOffsetY - R.Top + ClientHeight div 2) + SetOffsetY(FOffsetY - R.Top + ClientHeight {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2) else SetOffsetY(FOffsetY - R.Top); ScrolledVertically := True; @@ -31594,16 +33094,16 @@ function TBaseVirtualTree.ScrollIntoView(Node: PVirtualNode; Center: Boolean; Ho if (R.Bottom > ClientHeight) or Center then begin HScrollBarVisible := (ScrollBarOptions.ScrollBars in [System.UITypes.TScrollStyle.ssBoth, System.UITypes.TScrollStyle.ssHorizontal]) and - (ScrollBarOptions.AlwaysVisible or (Integer(FRangeX) > ClientWidth)); + (ScrollBarOptions.AlwaysVisible or ({$IFDEF VT_VCL}Integer{$ENDIF}(FRangeX) > ClientWidth)); if Center then - SetOffsetY(FOffsetY - R.Bottom + ClientHeight div 2) + SetOffsetY(FOffsetY - R.Bottom + ClientHeight {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2) else SetOffsetY(FOffsetY - R.Bottom + ClientHeight); // When scrolling up and the horizontal scroll appears because of the operation // then we have to move up the node the horizontal scrollbar's height too // in order to avoid that the scroll bar hides the node which we wanted to have in view. - if not UseColumns and not HScrollBarVisible and (Integer(FRangeX) > ClientWidth) then - SetOffsetY(FOffsetY - GetSystemMetrics(SM_CYHSCROLL)); + if not UseColumns and not HScrollBarVisible and ({$IFDEF VT_VCL}Integer{$ENDIF}(FRangeX) > ClientWidth) then + SetOffsetY(FOffsetY - {$IFDEF VT_FMX}3{$ELSE}GetSystemMetrics(SM_CYHSCROLL){$ENDIF}); ScrolledVertically := True; end; @@ -31618,11 +33118,15 @@ function TBaseVirtualTree.ScrollIntoView(Node: PVirtualNode; Center: Boolean; Ho //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.ScaledPixels(pPixels: Integer): Integer; +function TBaseVirtualTree.ScaledPixels(pPixels: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; /// Returns the given pixels scaled to the current dpi assuming that we designed at 96dpi (100%) begin +{$IFDEF VT_FMX} + Result := MulDiv(pPixels, 96, 96); //TODO: System.Devices.TDeviceInfo.PixelsPerInch +{$ELSE} Result := MulDiv(pPixels, {$if CompilerVersion > 31}Self.FCurrentPPI{$else}Screen.PixelsPerInch{$ifend}, 96); +{$ENDIF} end; function TBaseVirtualTree.ScrollIntoView(Column: TColumnIndex; Center: Boolean; Node: PVirtualNode = nil): Boolean; @@ -31632,8 +33136,8 @@ function TBaseVirtualTree.ScrollIntoView(Column: TColumnIndex; Center: Boolean; var ColumnLeft, - ColumnRight: Integer; - NewOffset: Integer; + ColumnRight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + NewOffset: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; R: TRect; begin @@ -31661,7 +33165,7 @@ function TBaseVirtualTree.ScrollIntoView(Column: TColumnIndex; Center: Boolean; if NewOffset <> FEffectiveOffsetX then begin if UseRightToLeftAlignment then - SetOffsetX(-Integer(FRangeX) + ClientWidth + NewOffset) + SetOffsetX(-{$IFDEF VT_VCL}Integer{$ENDIF}(FRangeX) + ClientWidth + NewOffset) else SetOffsetX(-NewOffset); end; @@ -31669,11 +33173,11 @@ function TBaseVirtualTree.ScrollIntoView(Column: TColumnIndex; Center: Boolean; end else if Center then begin - NewOffset := FEffectiveOffsetX + ColumnLeft - (Header.Columns.GetVisibleFixedWidth div 2) - (ClientWidth div 2) + ((ColumnRight - ColumnLeft) div 2); + NewOffset := FEffectiveOffsetX + ColumnLeft - (Header.Columns.GetVisibleFixedWidth {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2) - (ClientWidth {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2) + ((ColumnRight - ColumnLeft) {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2); if NewOffset <> FEffectiveOffsetX then begin if UseRightToLeftAlignment then - SetOffsetX(-Integer(FRangeX) + ClientWidth + NewOffset) + SetOffsetX(-{$IFDEF VT_VCL}Integer{$ENDIF}(FRangeX) + ClientWidth + NewOffset) else SetOffsetX(-NewOffset); end; @@ -31909,7 +33413,7 @@ procedure TBaseVirtualTree.Sort(Node: PVirtualNode; Column: TColumnIndex; Direct Index := 0; repeat Run.Index := Index; - Inc(Index); + System.Inc(Index); if Run.NextSibling = nil then Break; Run.NextSibling.PrevSibling := Run; @@ -31962,7 +33466,7 @@ procedure TBaseVirtualTree.SortTree(Column: TColumnIndex; Direction: TSortDirect Exit;//Nothing to do if there are one or zero nodes. RootNode.TotalCount is 1 if there are no nodes in the treee as the root node counts too here. // Instead of wrapping the sort using BeginUpdate/EndUpdate simply the update counter // is modified. Otherwise the EndUpdate call will recurse here. - Inc(FUpdateCount); + System.Inc(FUpdateCount); try if Column > InvalidColumn then begin @@ -31971,12 +33475,12 @@ procedure TBaseVirtualTree.SortTree(Column: TColumnIndex; Direction: TSortDirect DoSort(FRoot); finally EndOperation(okSortTree); - end; + end; end; InvalidateCache; finally if FUpdateCount > 0 then - Dec(FUpdateCount); + System.Dec(FUpdateCount); if FUpdateCount = 0 then begin ValidateCache; @@ -31996,7 +33500,7 @@ procedure TBaseVirtualTree.ToggleNode(Node: PVirtualNode); FirstVisible: PVirtualNode; HeightDelta, StepsR1, - StepsR2, + StepsR2: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; Steps: Integer; TogglingTree, ChildrenInView, @@ -32015,17 +33519,22 @@ procedure TBaseVirtualTree.ToggleNode(Node: PVirtualNode); var R: TRect; - S: Integer; + S: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; M: TToggleAnimationMode; begin with ToggleData do begin +{$IFDEF VT_FMX} + Canvas:= Self.Canvas; + Self.Fill.Color := FColors.BackGroundColor; + Brush := Self.Fill; +{$ELSE} Window := Handle; DC := GetDC(Handle); Self.Brush.Color := FColors.BackGroundColor; Brush := Self.Brush.Handle; - +{$ENDIF} if (Mode1 <> tamNoScroll) and (Mode2 <> tamNoScroll) then begin if StepsR1 < StepsR2 then @@ -32047,14 +33556,20 @@ procedure TBaseVirtualTree.ToggleNode(Node: PVirtualNode); ScaleFactor := StepsR2 / StepsR1; MissedSteps := 0; end; - +{$IFDEF VT_FMX} + if Mode1 <> tamNoScroll then + Steps := Round(StepsR1) //TODO: round!! + else + Steps := Round(StepsR2); +{$ELSE} if Mode1 <> tamNoScroll then Steps := StepsR1 else Steps := StepsR2; +{$ENDIF} + end; end; - //--------------- end local function ---------------------------------------- begin @@ -32084,13 +33599,17 @@ procedure TBaseVirtualTree.ToggleNode(Node: PVirtualNode); NeedUpdate := True; // Calculate the height delta right now as we need it for toChildrenAbove anyway. - HeightDelta := -Integer(Node.TotalHeight) + Integer(NodeHeight[Node]); + HeightDelta := -{$IFDEF VT_VCL}Integer{$ENDIF}(Node.TotalHeight) + {$IFDEF VT_VCL}Integer{$ENDIF}(NodeHeight[Node]); if (FUpdateCount = 0) and (toAnimatedToggle in FOptions.FAnimationOptions) and not (tsCollapsing in FStates) then begin if tsHint in Self.FStates then Application.CancelHint; +{$IFDEF VT_FMX} + Repaint; +{$ELSE} UpdateWindow(Handle); +{$ENDIF} // animated collapsing with ToggleData do @@ -32101,7 +33620,7 @@ procedure TBaseVirtualTree.ToggleNode(Node: PVirtualNode); Mode2 := tamNoScroll; if toChildrenAbove in FOptions.FPaintOptions then begin - PosHoldable := (FOffsetY + (Integer(Node.TotalHeight) - Integer(NodeHeight[Node]))) <= 0; + PosHoldable := (FOffsetY + ({$IFDEF VT_VCL}Integer{$ENDIF}(Node.TotalHeight) - {$IFDEF VT_VCL}Integer{$ENDIF}(NodeHeight[Node]))) <= 0; NodeInView := R1.Top < ClientHeight; StepsR1 := 0; @@ -32113,7 +33632,7 @@ procedure TBaseVirtualTree.ToggleNode(Node: PVirtualNode); Mode1 := tamScrollDown; R1.Bottom := R1.Top; R1.Top := 0; - StepsR1 := Min(R1.Bottom - R1.Top + 1, Integer(Node.TotalHeight) - Integer(NodeHeight[Node])); + StepsR1 := Min(R1.Bottom - R1.Top + 1, {$IFDEF VT_VCL}Integer{$ENDIF}(Node.TotalHeight) - {$IFDEF VT_VCL}Integer{$ENDIF}(NodeHeight[Node])); end else begin @@ -32127,8 +33646,8 @@ procedure TBaseVirtualTree.ToggleNode(Node: PVirtualNode); end else begin - if (Integer(FRangeY) + FOffsetY - R1.Bottom + HeightDelta >= ClientHeight - R1.Bottom) or - (Integer(FRangeY) <= ClientHeight) or (FOffsetY = 0) or not + if ({$IFDEF VT_VCL}Integer{$ENDIF}(FRangeY) + FOffsetY - R1.Bottom + HeightDelta >= ClientHeight - R1.Bottom) or + ({$IFDEF VT_VCL}Integer{$ENDIF}(FRangeY) <= ClientHeight) or (FOffsetY = 0) or not (toAdvancedAnimatedToggle in FOptions.FAnimationOptions) then begin // Do a simple scroll up over the child nodes. @@ -32142,7 +33661,7 @@ procedure TBaseVirtualTree.ToggleNode(Node: PVirtualNode); // Scroll the node down to its future position. As FOffsetY will change we need to invalidate the // whole tree. Mode1 := tamScrollDown; - StepsR1 := Min(-FOffsetY, ClientHeight - Integer(FRangeY) -FOffsetY - HeightDelta); + StepsR1 := Min(-FOffsetY, ClientHeight - {$IFDEF VT_VCL}Integer{$ENDIF}(FRangeY) -FOffsetY - HeightDelta); R1.Top := 0; R1.Bottom := Min(ClientHeight, R1.Bottom + Steps); NeedFullInvalidate := True; @@ -32154,9 +33673,11 @@ procedure TBaseVirtualTree.ToggleNode(Node: PVirtualNode); begin PrepareAnimation; try - Animate(Steps, FAnimationDuration, ToggleCallback, @ToggleData); + Animate(Steps, FAnimationDuration, {$IFDEF VT_FMX}nil{$ELSE}ToggleCallback{$ENDIF}, @ToggleData); finally +{$IFDEF VT_VCL} ReleaseDC(Window, DC); +{$ENDIF} end; end; end; @@ -32165,7 +33686,7 @@ procedure TBaseVirtualTree.ToggleNode(Node: PVirtualNode); // collapse the node AdjustTotalHeight(Node, IfThen(IsEffectivelyFiltered[Node], 0, NodeHeight[Node])); if FullyVisible[Node] then - Dec(FVisibleCount, CountVisibleChildren(Node)); + System.Dec(FVisibleCount, CountVisibleChildren(Node)); Exclude(Node.States, vsExpanded); DoCollapsed(Node); @@ -32210,13 +33731,13 @@ procedure TBaseVirtualTree.ToggleNode(Node: PVirtualNode); begin R1 := GetDisplayRect(Node, NoColumn, False); Mode2 := tamNoScroll; - TotalFit := HeightDelta + Integer(NodeHeight[Node]) <= ClientHeight; + TotalFit := HeightDelta + {$IFDEF VT_VCL}Integer{$ENDIF}(NodeHeight[Node]) <= ClientHeight; if toChildrenAbove in FOptions.FPaintOptions then begin // The main goal with toChildrenAbove being set is to keep the nodes visual position so the user does // not get confused. Therefore we need to scroll the view when the expanding is done. - PosHoldable := TotalFit and (Integer(FRangeY) - ClientHeight >= 0) ; + PosHoldable := TotalFit and ({$IFDEF VT_VCL}Integer{$ENDIF}(FRangeY) - ClientHeight >= 0) ; ChildrenInView := (R1.Top - HeightDelta) >= 0; NodeInView := R1.Bottom <= ClientHeight; end @@ -32238,7 +33759,11 @@ procedure TBaseVirtualTree.ToggleNode(Node: PVirtualNode); begin if tsHint in Self.FStates then Application.CancelHint; +{$IFDEF VT_FMX} + Repaint; +{$ELSE} UpdateWindow(Handle); +{$ENDIF} // animated expanding with ToggleData do begin @@ -32263,25 +33788,25 @@ procedure TBaseVirtualTree.ToggleNode(Node: PVirtualNode); begin // If we shall not or cannot scroll to the desired extent we calculate the new position (with // max FOffsetY applied) and animate it that way. - StepsR1 := -FOffsetY - Max(Integer(FRangeY) + HeightDelta - ClientHeight, 0) + HeightDelta; - if (Integer(FRangeY) + HeightDelta - ClientHeight) <= 0 then + StepsR1 := -FOffsetY - Max({$IFDEF VT_VCL}Integer{$ENDIF}(FRangeY) + HeightDelta - ClientHeight, 0) + HeightDelta; + if ({$IFDEF VT_VCL}Integer{$ENDIF}(FRangeY) + HeightDelta - ClientHeight) <= 0 then Mode2 := tamNoScroll else - StepsR2 := Min(Integer(FRangeY) + HeightDelta - ClientHeight, R2.Bottom); + StepsR2 := Min({$IFDEF VT_VCL}Integer{$ENDIF}(FRangeY) + HeightDelta - ClientHeight, R2.Bottom); end else begin - if TotalFit and NodeInView and (Integer(FRangeY) + HeightDelta > ClientHeight) then + if TotalFit and NodeInView and ({$IFDEF VT_VCL}Integer{$ENDIF}(FRangeY) + HeightDelta > ClientHeight) then begin // If the whole subtree will fit into the client area and the node is currently fully visible, // the first child will be made the top node if possible. if HeightDelta >= R1.Top then StepsR1 := Abs(R1.Top - HeightDelta) else - StepsR1 := ClientHeight - Integer(FRangeY); + StepsR1 := ClientHeight - {$IFDEF VT_VCL}Integer{$ENDIF}(FRangeY); end else - if Integer(FRangeY) + HeightDelta <= ClientHeight then + if {$IFDEF VT_VCL}Integer{$ENDIF}(FRangeY) + HeightDelta <= ClientHeight then begin // We cannot make the first child the top node as we cannot scroll to that extent, // so we do a simple scroll down. @@ -32291,7 +33816,7 @@ procedure TBaseVirtualTree.ToggleNode(Node: PVirtualNode); else // If the subtree does not fit into the client area at once, the expanded node will // be made the bottom node. - StepsR1 := ClientHeight - R1.Top - Integer(NodeHeight[Node]); + StepsR1 := ClientHeight - R1.Top - {$IFDEF VT_VCL}Integer{$ENDIF}(NodeHeight[Node]); if Mode2 <> tamNoScroll then begin @@ -32324,11 +33849,11 @@ procedure TBaseVirtualTree.ToggleNode(Node: PVirtualNode); Mode1 := tamScrollUp; Mode2 := tamScrollDown; - R1.Bottom := R1.Top + Integer(NodeHeight[Node]) + 1; + R1.Bottom := R1.Top + {$IFDEF VT_VCL}Integer{$ENDIF}(NodeHeight[Node]) + 1; R1.Top := 0; R2 := Rect(R1.Left, R1.Bottom, R1.Right, ClientHeight); - StepsR1 := Min(HeightDelta - (ClientHeight - R2.Top), R1.Bottom - Integer(NodeHeight[Node])); + StepsR1 := Min(HeightDelta - (ClientHeight - R2.Top), R1.Bottom - {$IFDEF VT_VCL}Integer{$ENDIF}(NodeHeight[Node])); StepsR2 := ClientHeight - R2.Top; end; end; @@ -32337,9 +33862,11 @@ procedure TBaseVirtualTree.ToggleNode(Node: PVirtualNode); begin PrepareAnimation; try - Animate(Steps, FAnimationDuration, ToggleCallback, @ToggleData); + Animate(Steps, FAnimationDuration, {$IFDEF VT_FMX}nil{$ELSE}ToggleCallback{$ENDIF}, @ToggleData); finally +{$IFDEF VT_VCL} ReleaseDC(Window, DC); +{$ENDIF} end; end; end; @@ -32351,7 +33878,7 @@ procedure TBaseVirtualTree.ToggleNode(Node: PVirtualNode); Include(Node.States, vsExpanded); AdjustTotalHeight(Node, HeightDelta, True); if FullyVisible[Node] then - Inc(FVisibleCount, CountVisibleChildren(Node)); + System.Inc(FVisibleCount, CountVisibleChildren(Node)); DoExpanded(Node); end; @@ -32377,7 +33904,7 @@ procedure TBaseVirtualTree.ToggleNode(Node: PVirtualNode); NeedFullInvalidate := True; if (PosHoldable and ChildrenInView and NodeInView) or not (toAutoScrollOnExpand in FOptions.FAutoOptions) then - SetOffsetY(FOffsetY - Integer(HeightDelta)) + SetOffsetY(FOffsetY - {$IFDEF VT_VCL}Integer{$ENDIF}(HeightDelta)) else if TotalFit and NodeInView then begin @@ -32405,7 +33932,7 @@ procedure TBaseVirtualTree.ToggleNode(Node: PVirtualNode); // If we have collapsed the node or toAutoScrollOnExpand is not set, we try to keep the nodes // visual position. if toChildrenAbove in FOptions.FPaintOptions then - SetOffsetY(FOffsetY - Integer(HeightDelta)); + SetOffsetY(FOffsetY - {$IFDEF VT_VCL}Integer{$ENDIF}(HeightDelta)); NeedFullInvalidate := True; end; end; @@ -32450,16 +33977,19 @@ procedure TBaseVirtualTree.UpdateHorizontalRange; //---------------------------------------------------------------------------------------------------------------------- procedure TBaseVirtualTree.UpdateHorizontalScrollBar(DoRepaint: Boolean); - +{$IFDEF VT_VCL} var ScrollInfo: TScrollInfo; - +{$ENDIF} begin UpdateHorizontalRange; if (tsUpdating in FStates) or not HandleAllocated then Exit; + +{$IFDEF VT_VCL} + // Adjust effect scroll offset depending on bidi mode. if UseRightToLeftAlignment then FEffectiveOffsetX := Integer(FRangeX) - ClientWidth + FOffsetX @@ -32512,6 +34042,7 @@ procedure TBaseVirtualTree.UpdateHorizontalScrollBar(DoRepaint: Boolean); // Reset the current horizontal offset to account for window resize etc. SetOffsetX(FOffsetX); end; +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -32534,7 +34065,9 @@ procedure TBaseVirtualTree.UpdateScrollBars(DoRepaint: Boolean); begin UpdateVerticalScrollBar(DoRepaint); UpdateHorizontalScrollBar(DoRepaint); +{$IFDEF VT_VCL} Perform(CM_UPDATE_VCLSTYLE_SCROLLBARS,0,0); +{$ENDIF} end; end; @@ -32551,21 +34084,22 @@ procedure TBaseVirtualTree.UpdateVerticalRange; begin // Total node height includes the height of the invisible root node. - FRangeY := Cardinal(Int64(FRoot.TotalHeight) - FRoot.NodeHeight + FBottomSpace); + FRangeY := {$IFDEF VT_VCL}Cardinal{$ENDIF}({$IFDEF VT_VCL}Int64{$ENDIF}(FRoot.TotalHeight) - FRoot.NodeHeight + FBottomSpace); end; //---------------------------------------------------------------------------------------------------------------------- procedure TBaseVirtualTree.UpdateVerticalScrollBar(DoRepaint: Boolean); - +{$IFDEF VT_VCL} var ScrollInfo: TScrollInfo; - +{$ENDIF} begin UpdateVerticalRange; if tsUpdating in FStates then Exit; +{$IFDEF VT_VCL} Assert(GetCurrentThreadId = MainThreadId, 'UI controls like ' + Classname + ' and its scrollbars should only be manipulated through the main thread.'); if FScrollBarOptions.ScrollBars in [ssVertical, ssBoth] then @@ -32607,6 +34141,7 @@ procedure TBaseVirtualTree.UpdateVerticalScrollBar(DoRepaint: Boolean); // Reset the current vertical offset to account for window resize etc. SetOffsetY(FOffsetY); end; +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -32737,7 +34272,7 @@ constructor TVTEdit.Create(Link: TStringEditLink); end; //---------------------------------------------------------------------------------------------------------------------- - +{$IFDEF VT_VCL} function TVTEdit.CalcMinHeight: Integer; var textHeight : Integer; @@ -32973,17 +34508,19 @@ procedure TVTEdit.WMKeyDown(var Message: TWMKeyDown); inherited; end; end; - +{$ENDIF} //---------------------------------------------------------------------------------------------------------------------- procedure TVTEdit.AutoAdjustSize; // Changes the size of the edit to accomodate as much as possible of its text within its container window. // NewChar describes the next character which will be added to the edit's text. - +{$IFDEF VT_VCL} var Size: TSize; +{$ENDIF} begin +{$IFDEF VT_VCL} if not (vsMultiline in FLink.FNode.States) and not (toGridExtensions in FLink.FTree.FOptions.FMiscOptions{see issue #252}) then begin // avoid flicker @@ -33003,10 +34540,11 @@ procedure TVTEdit.AutoAdjustSize; SendMessage(Handle, WM_SETREDRAW, 1, 0); end; end; +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- - +{$IFDEF VT_VCL} procedure TVTEdit.CreateParams(var Params: TCreateParams); begin @@ -33031,9 +34569,9 @@ procedure TVTEdit.CreateParams(var Params: TCreateParams); end; end; end; - +{$ENDIF} //---------------------------------------------------------------------------------------------------------------------- - +{$IFDEF VT_VCL} function TVTEdit.GetTextSize: TSize; var DC: HDC; @@ -33049,14 +34587,16 @@ function TVTEdit.GetTextSize: TSize; ReleaseDC(Handle, DC); end; end; - +{$ENDIF} //---------------------------------------------------------------------------------------------------------------------- procedure TVTEdit.Release; begin +{$IFDEF VT_VCL} if HandleAllocated then PostMessage(Handle, CM_RELEASE, 0, 0); +{$ENDIF} end; //----------------- TStringEditLink ------------------------------------------------------------------------------------ @@ -33069,8 +34609,10 @@ constructor TStringEditLink.Create; with FEdit do begin Visible := False; +{$IFDEF VT_VCL} BorderStyle := bsSingle; AutoSize := False; +{$ENDIF} end; end; @@ -33137,7 +34679,9 @@ function TStringEditLink.EndEdit: Boolean; if Result then try FStopping := True; +{$IFDEF VT_VCL} if FEdit.Modified then +{$ENDIF} FTree.Text[FNode, FColumn] := FEdit.Text; FEdit.Hide; FEdit.FLink := nil; @@ -33173,43 +34717,56 @@ function TStringEditLink.PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; begin FEdit := TVTEdit.Create(Self); FEdit.Visible := False; +{$IFDEF VT_VCL} FEdit.BorderStyle := bsSingle; +{$ENDIF} end; +{$IFDEF VT_VCL} FEdit.AutoSize := True; +{$ENDIF} FTree := Tree as TCustomVirtualStringTree; FNode := Node; FColumn := Column; FEdit.Parent := Tree; // Initial size, font and text of the node. FTree.GetTextInfo(Node, Column, FEdit.Font, FTextBounds, Text); +{$IFDEF VT_VCL} FEdit.Font.Color := clWindowText; FEdit.RecreateWnd; FEdit.AutoSize := False; +{$ENDIF} FEdit.Text := Text; if Column <= NoColumn then begin +{$IFDEF VT_VCL} FEdit.BidiMode := FTree.BidiMode; +{$ENDIF} FAlignment := FTree.Alignment; end else begin +{$IFDEF VT_VCL} FEdit.BidiMode := FTree.Header.Columns[Column].BidiMode; +{$ENDIF} FAlignment := FTree.Header.Columns[Column].Alignment; end; +{$IFDEF VT_VCL} if FEdit.BidiMode <> bdLeftToRight then ChangeBidiModeAlignment(FAlignment); +{$ENDIF} end; end; //---------------------------------------------------------------------------------------------------------------------- - +{$IFDEF VT_VCL} procedure TStringEditLink.ProcessMessage(var Message: TMessage); begin FEdit.WindowProc(Message); end; +{$ENDIF} //---------------------------------------------------------------------------------------------------------------------- @@ -33218,9 +34775,10 @@ procedure TStringEditLink.SetBounds(R: TRect); // Sets the outer bounds of the edit control and the actual edit area in the control. var - lOffset, tOffset, height: Integer; + lOffset, tOffset, height: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; offsets : TVTOffsets; begin +{$IFDEF VT_VCL} if not FStopping then begin // Check if the provided rect height is smaller than the edit control height. @@ -33251,7 +34809,7 @@ procedure TStringEditLink.SetBounds(R: TRect); // The selected text shall exclude the text margins and be centered vertically. // We have to take out the two pixel border of the edit control as well as a one pixel "edit border" the // control leaves around the (selected) text. - R := FEdit.ClientRect; + R := FEdit.{$IFDEF VT_FMX}BoundsRect{$ELSE}ClientRect{$ENDIF}; // If toGridExtensions are turned on, we can fine tune the left margin (or the right margin if RTL is on) // of the text to exactly match the text in the tree cell. @@ -33290,8 +34848,11 @@ procedure TStringEditLink.SetBounds(R: TRect); end; R.Top := Max(-1, R.Top); // A value smaller than -1 will prevent the edit cursor from being shown by Windows, see issue #159 R.Left := Max(-1, R.Left); +{$IFDEF VT_VCL} SendMessage(FEdit.Handle, EM_SETRECTNP, 0, LPARAM(@R)); +{$ENDIF} end; +{$ENDIF} end; //----------------- TCustomVirtualString ------------------------------------------------------------------------------- @@ -33452,18 +35013,23 @@ procedure TCustomVirtualStringTree.InitializeTextProperties(var PaintInfo: TVTPa with PaintInfo do begin // Set default font values first. +{$IFDEF VT_FMX} + Canvas.Font.Assign(Font); +{$ELSE} Canvas.Font := Font; +{$ENDIF} + if Enabled then // Es werden sonst nur die Farben verwendet von Font die an Canvas.Font übergeben wurden - Canvas.Font.Color := FColors.NodeFontColor + Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Font{$ENDIF}.Color := FColors.NodeFontColor else - Canvas.Font.Color := FColors.DisabledColor; + Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Font{$ENDIF}.Color := FColors.DisabledColor; if (toHotTrack in FOptions.FPaintOptions) and (Node = FCurrentHotNode) then begin - if not (tsUseExplorerTheme in FStates) then + {$IFDEF VT_VCL}if not (tsUseExplorerTheme in FStates) then{$ENDIF} begin - Canvas.Font.Style := Canvas.Font.Style + [fsUnderline]; - Canvas.Font.Color := FColors.HotColor; + Canvas.Font.Style := Canvas.Font.Style + [TFontStyle.fsUnderline]; + Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Font{$ENDIF}.Color := FColors.HotColor; end; end; @@ -33474,15 +35040,15 @@ procedure TCustomVirtualStringTree.InitializeTextProperties(var PaintInfo: TVTPa begin if Node = FDropTargetNode then begin - if ((FLastDropMode = dmOnNode) or (vsSelected in Node.States)) and not - (tsUseExplorerTheme in FStates) then - Canvas.Font.Color := FColors.SelectionTextColor; + if ((FLastDropMode = dmOnNode) or (vsSelected in Node.States)) + {$IFDEF VT_VCL}and not (tsUseExplorerTheme in FStates){$ENDIF} then + Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Font{$ENDIF}.Color := FColors.SelectionTextColor; end else if vsSelected in Node.States then begin - if not (tsUseExplorerTheme in FStates) then - Canvas.Font.Color := FColors.SelectionTextColor; + {$IFDEF VT_VCL}if not (tsUseExplorerTheme in FStates) then{$ENDIF} + Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Font{$ENDIF}.Color := FColors.SelectionTextColor; end; end; end; @@ -33500,18 +35066,20 @@ procedure TCustomVirtualStringTree.PaintNormalText(var PaintInfo: TVTPaintInfo; // the node rectangle. The clipping rectangle comprises the entire node (including tree lines, buttons etc.). var - TripleWidth: Integer; + TripleWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; R: TRect; DrawFormat: Cardinal; Size: TSize; - Height: Integer; + Height: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; begin InitializeTextProperties(PaintInfo); with PaintInfo do begin R := ContentRect; +{$IFDEF VT_VCL} Canvas.TextFlags := 0; +{$ENDIF} InflateRect(R, -FTextMargin, 0); // Multiline nodes don't need special font handling or text manipulation. @@ -33525,7 +35093,7 @@ procedure TCustomVirtualStringTree.PaintNormalText(var PaintInfo: TVTPaintInfo; Height := ComputeNodeHeight(Canvas, Node, Column); // Disabled node color overrides all other variants. if (vsDisabled in Node.States) or not Enabled then - Canvas.Font.Color := FColors.DisabledColor; + Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Font{$ENDIF}.Color := FColors.DisabledColor; // The edit control flag will ensure that no partial line is displayed, that is, only lines // which are (vertically) fully visible are drawn. @@ -33535,7 +35103,7 @@ procedure TCustomVirtualStringTree.PaintNormalText(var PaintInfo: TVTPaintInfo; // Center the text vertically if it fits entirely into the content rect. if R.Bottom - R.Top > Height then - InflateRect(R, 0, (Height - R.Bottom - R.Top) div 2); + InflateRect(R, 0, (Height - R.Bottom - R.Top) {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2); end else begin @@ -33547,13 +35115,13 @@ procedure TCustomVirtualStringTree.PaintNormalText(var PaintInfo: TVTPaintInfo; // If the font has been changed then the ellipsis width must be recalculated. TripleWidth := 0; // Recalculate also the width of the normal text. - GetTextExtentPoint32W(Canvas.Handle, PWideChar(Text), Length(Text), Size); + GetTextExtentPoint32W(Canvas{$IFDEF VT_VCL}.Handle{$ENDIF}, {$IFDEF VT_VCL}PWideChar{$ENDIF}(Text), Length(Text), Size); NodeWidth := Size.cx + 2 * FTextMargin; end; // Disabled node color overrides all other variants. if (vsDisabled in Node.States) or not Enabled then - Canvas.Font.Color := FColors.DisabledColor; + Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Font{$ENDIF}.Color := FColors.DisabledColor; DrawFormat := DT_NOPREFIX or DT_VCENTER or DT_SINGLELINE; if BidiMode <> bdLeftToRight then @@ -33571,11 +35139,12 @@ procedure TCustomVirtualStringTree.PaintNormalText(var PaintInfo: TVTPaintInfo; DrawFormat := DrawFormat or AlignmentToDrawFlag[Alignment]; end; +{$IFDEF VT_VCL} if Canvas.TextFlags and ETO_OPAQUE = 0 then SetBkMode(Canvas.Handle, TRANSPARENT) else SetBkMode(Canvas.Handle, OPAQUE); - +{$ENDIF} DoTextDrawing(PaintInfo, Text, R, DrawFormat); end; end; @@ -33594,45 +35163,54 @@ procedure TCustomVirtualStringTree.PaintStaticText(const PaintInfo: TVTPaintInfo begin with PaintInfo do begin +{$IFDEF VT_FMX} + Canvas.Font.Assign(Font); +{$ELSE} Canvas.Font := Font; +{$ENDIF} if toFullRowSelect in FOptions.FSelectionOptions then begin if Node = FDropTargetNode then begin if (FLastDropMode = dmOnNode) or (vsSelected in Node.States) then - Canvas.Font.Color := FColors.SelectionTextColor + Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Font{$ENDIF}.Color := FColors.SelectionTextColor else - Canvas.Font.Color := FColors.NodeFontColor; + Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Font{$ENDIF}.Color := FColors.NodeFontColor; end else if vsSelected in Node.States then begin - if Focused or (toPopupMode in FOptions.FPaintOptions) then - Canvas.Font.Color := FColors.SelectionTextColor + if {$IFDEF VT_FMX}IsFocused{$ELSE}Focused{$ENDIF} or (toPopupMode in FOptions.FPaintOptions) then + Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Font{$ENDIF}.Color := FColors.SelectionTextColor else - Canvas.Font.Color := FColors.NodeFontColor; + Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Font{$ENDIF}.Color := FColors.NodeFontColor; end; end; DrawFormat := DT_NOPREFIX or DT_VCENTER or DT_SINGLELINE; +{$IFDEF VT_VCL} Canvas.TextFlags := 0; +{$ENDIF} DoPaintText(Node, Canvas, Column, ttStatic); // Disabled node color overrides all other variants. if (vsDisabled in Node.States) or not Enabled then - Canvas.Font.Color := FColors.DisabledColor; + Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Font{$ENDIF}.Color := FColors.DisabledColor; R := ContentRect; if Alignment = taRightJustify then Dec(R.Right, NodeWidth + FTextMargin) else Inc(R.Left, NodeWidth + FTextMargin); - +{$IFDEF VT_FMX} + Canvas.FillText(R, (Text), true, 1.0, [], TTextAlign.Leading); +{$ELSE} if Canvas.TextFlags and ETO_OPAQUE = 0 then SetBkMode(Canvas.Handle, TRANSPARENT) else SetBkMode(Canvas.Handle, OPAQUE); Winapi.Windows.DrawTextW(Canvas.Handle, PWideChar(Text), Length(Text), R, DrawFormat); +{$ENDIF} end; end; @@ -33698,6 +35276,7 @@ procedure TCustomVirtualStringTree.SetText(Node: PVirtualNode; Column: TColumnIn //---------------------------------------------------------------------------------------------------------------------- +{$IFDEF VT_VCL} procedure TCustomVirtualStringTree.WMSetFont(var Msg: TWMSetFont); // Whenever a new font is applied to the tree some default values are determined to avoid frequent @@ -33735,6 +35314,7 @@ procedure TCustomVirtualStringTree.WMSetFont(var Msg: TWMSetFont); Run := GetNextNoInit(Run); end; end; +{$ENDIF} //---------------------------------------------------------------------------------------------------------------------- @@ -33795,7 +35375,7 @@ procedure TCustomVirtualStringTree.AdjustPaintCellRect(var PaintInfo: TVTPaintIn //---------------------------------------------------------------------------------------------------------------------- -function TCustomVirtualStringTree.CalculateStaticTextWidth(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const Text: string): Integer; +function TCustomVirtualStringTree.CalculateStaticTextWidth(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const Text: string): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; begin Result := 0; @@ -33803,7 +35383,7 @@ function TCustomVirtualStringTree.CalculateStaticTextWidth(Canvas: TCanvas; Node begin DoPaintText(Node, Canvas, Column, ttStatic); - Inc(Result, DoTextMeasuring(Canvas, Node, Column, Text).cx); + Inc(Result, DoTextMeasuring(Canvas, Node, Column, Text).{$IFDEF VT_FMX}Width{$ELSE}cx{$ENDIF}); Inc(Result, FTextMargin); end; end; @@ -33811,7 +35391,7 @@ function TCustomVirtualStringTree.CalculateStaticTextWidth(Canvas: TCanvas; Node //---------------------------------------------------------------------------------------------------------------------- function TCustomVirtualStringTree.CalculateTextWidth(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; - const Text: string): Integer; + const Text: string): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; // Determines the width of the given text. @@ -33819,7 +35399,11 @@ function TCustomVirtualStringTree.CalculateTextWidth(Canvas: TCanvas; Node: PVir Result := 2 * FTextMargin; if Length(Text) > 0 then begin +{$IFDEF VT_FMX} + Canvas.Font.Assign(Font); +{$ELSE} Canvas.Font := Font; +{$ENDIF} DoPaintText(Node, Canvas, Column, ttNormal); Inc(Result, DoTextMeasuring(Canvas, Node, Column, Text).cx); @@ -33899,7 +35483,7 @@ function TCustomVirtualStringTree.DoGetNodeTooltip(Node: PVirtualNode; Column: T //---------------------------------------------------------------------------------------------------------------------- function TCustomVirtualStringTree.DoGetNodeExtraWidth(Node: PVirtualNode; Column: TColumnIndex; - Canvas: TCanvas = nil): Integer; + Canvas: TCanvas = nil): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; begin if not (toShowStaticText in TreeOptions.FStringOptions) then @@ -33911,13 +35495,13 @@ function TCustomVirtualStringTree.DoGetNodeExtraWidth(Node: PVirtualNode; Column //---------------------------------------------------------------------------------------------------------------------- -function TCustomVirtualStringTree.DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): Integer; +function TCustomVirtualStringTree.DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; // Returns the text width of the given node in pixels. // This width is stored in the node's data member to increase access speed. var - Data: PInteger; + Data: {$IFDEF VT_FMX}PSingle{$ELSE}PInteger{$ENDIF}; begin if (Column > NoColumn) and (vsMultiline in Node.States) then @@ -34047,7 +35631,7 @@ procedure TCustomVirtualStringTree.DoPaintText(Node: PVirtualNode; const Canvas: //---------------------------------------------------------------------------------------------------------------------- function TCustomVirtualStringTree.DoShortenString(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; - const S: string; Width: Integer; EllipsisWidth: Integer = 0): string; + const S: string; Width: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; EllipsisWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} = 0): string; var Done: Boolean; @@ -34057,7 +35641,7 @@ function TCustomVirtualStringTree.DoShortenString(Canvas: TCanvas; Node: PVirtua if Assigned(FOnShortenString) then FOnShortenString(Self, Canvas, Node, Column, S, Width, Result, Done); if not Done then - Result := ShortenString(Canvas.Handle, S, Width, EllipsisWidth); + Result := ShortenString(Canvas{$IFDEF VT_VCL}.Handle{$ENDIF}, S, Width, EllipsisWidth); end; //---------------------------------------------------------------------------------------------------------------------- @@ -34073,7 +35657,11 @@ procedure TCustomVirtualStringTree.DoTextDrawing(var PaintInfo: TVTPaintInfo; co if Assigned(FOnDrawText) then FOnDrawText(Self, PaintInfo.Canvas, PaintInfo.Node, PaintInfo.Column, Text, CellRect, DefaultDraw); if DefaultDraw then +{$IFDEF VT_FMX} + PaintInfo.Canvas.FillText(CellRect, (Text), true, 1.0, [], TTextAlign.Leading); +{$ELSE} Winapi.Windows.DrawTextW(PaintInfo.Canvas.Handle, PWideChar(Text), Length(Text), CellRect, DrawFormat); +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -34086,15 +35674,22 @@ function TCustomVirtualStringTree.DoTextMeasuring(Canvas: TCanvas; Node: PVirtua DrawFormat: Integer; begin - GetTextExtentPoint32W(Canvas.Handle, PWideChar(Text), Length(Text), Result); + GetTextExtentPoint32W(Canvas{$IFDEF VT_VCL}.Handle{$ENDIF}, {$IFDEF VT_VCL}PWideChar{$ENDIF}(Text), Length(Text), Result); if vsMultiLine in Node.States then begin DrawFormat := DT_CALCRECT or DT_NOPREFIX or DT_WORDBREAK or DT_END_ELLIPSIS or DT_EDITCONTROL or AlignmentToDrawFlag[Alignment]; - if BidiMode <> bdLeftToRight then +{$IFDEF VT_VCL} + if BidiMode <> bdLeftToRight then DrawFormat := DrawFormat or DT_RTLREADING; +{$ENDIF} R := Rect(0, 0, Result.cx, MaxInt); +{$IFDEF VT_FMX} + Canvas.FillText(R, Text, true, 1.0, [], TTextAlign.Leading); +{$ELSE} Winapi.Windows.DrawTextW(Canvas.Handle, PWideChar(Text), Length(Text), R, DrawFormat); +{$ENDIF} + Result.cx := R.Right - R.Left; end; if Assigned(FOnMeasureTextWidth) then @@ -34217,7 +35812,7 @@ procedure TCustomVirtualStringTree.ReadOldStringOptions(Reader: TReader); end; //---------------------------------------------------------------------------------------------------------------------- - +{$IFDEF VT_VCL} function TCustomVirtualStringTree.RenderOLEData(const FormatEtcIn: TFormatEtc; out Medium: TStgMedium; ForClipboard: Boolean): HResult; @@ -34244,6 +35839,7 @@ function TCustomVirtualStringTree.RenderOLEData(const FormatEtcIn: TFormatEtc; o Result := E_FAIL; end; end; +{$ENDIF} //---------------------------------------------------------------------------------------------------------------------- @@ -34282,7 +35878,7 @@ procedure TCustomVirtualStringTree.WriteChunks(Stream: TStream; Node: PVirtualNo //---------------------------------------------------------------------------------------------------------------------- function TCustomVirtualStringTree.ComputeNodeHeight(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; - S: string): Integer; + S: string): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; // Default node height calculation for multi line nodes. This method can be used by the application to delegate the // computation to the string tree. @@ -34311,9 +35907,10 @@ function TCustomVirtualStringTree.ComputeNodeHeight(Canvas: TCanvas; Node: PVirt BidiMode := Header.Columns[Column].BidiMode; Alignment := Header.Columns[Column].Alignment; end; - +{$IFDEF VT_VCL} if BidiMode <> bdLeftToRight then ChangeBidiModeAlignment(Alignment); +{$ENDIF} if vsMultiline in Node.States then DrawFormat := DT_NOPREFIX or DT_TOP or DT_WORDBREAK or DT_EDITCONTROL @@ -34336,7 +35933,7 @@ function TCustomVirtualStringTree.ComputeNodeHeight(Canvas: TCanvas; Node: PVirt SetLength(LineImage, 1) else DetermineLineImageAndSelectLevel(Node, LineImage); - Inc(PaintInfo.CellRect.Left, Length(LineImage) * Integer(Indent)); + Inc(PaintInfo.CellRect.Left, Length(LineImage) * {$IFDEF VT_VCL}Integer{$ENDIF}(Indent)); end; end else @@ -34347,7 +35944,12 @@ function TCustomVirtualStringTree.ComputeNodeHeight(Canvas: TCanvas; Node: PVirt DrawFormat := DrawFormat or DT_RIGHT or DT_RTLREADING else DrawFormat := DrawFormat or DT_LEFT; +{$IFDEF VT_FMX} + Canvas.FillText(PaintInfo.CellRect, S, true, 1.0, [], TTextAlign.Leading); +{$ELSE} Winapi.Windows.DrawTextW(Canvas.Handle, PWideChar(S), Length(S), PaintInfo.CellRect, DrawFormat); +{$ENDIF} + Result := PaintInfo.CellRect.Bottom - PaintInfo.CellRect.Top; end; @@ -34367,7 +35969,11 @@ function TCustomVirtualStringTree.ContentToClipboard(Format: Word; Source: TVSTT // the Result is 0. begin +{$IFDEF VT_FMX} +Result := 0; +{$ELSE} Result := VirtualTrees.Export.ContentToClipboard(Self, Format, Source); +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -34503,22 +36109,24 @@ procedure TCustomVirtualStringTree.GetTextInfo(Node: PVirtualNode; Column: TColu // bounding rectangle around Text. var - NewHeight: Integer; + NewHeight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; TM: TTextMetric; begin // Get default font and initialize the other parameters. inherited GetTextInfo(Node, Column, AFont, R, Text); - +{$IFDEF VT_FMX} + Canvas.Font.Assign(AFont); +{$ELSE} Canvas.Font := AFont; - +{$ENDIF} FFontChanged := False; RedirectFontChangeEvent(Canvas); DoPaintText(Node, Canvas, Column, ttNormal); if FFontChanged then begin AFont.Assign(Canvas.Font); - GetTextMetrics(Canvas.Handle, TM); + GetTextMetrics(Canvas{$IFDEF VT_VCL}.Handle{$ENDIF}, TM); NewHeight := TM.tmHeight; end else // Otherwise the correct font is already there and we only need to set the correct height. @@ -34530,7 +36138,7 @@ procedure TCustomVirtualStringTree.GetTextInfo(Node: PVirtualNode; Column: TColu R := GetDisplayRect(Node, Column, True, not (vsMultiline in Node.States)); if toShowHorzGridLines in TreeOptions.PaintOptions then Dec(R.Bottom); - InflateRect(R, 0, -(R.Bottom - R.Top - NewHeight) div 2); + InflateRect(R, 0, -(R.Bottom - R.Top - NewHeight) {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2); end; //---------------------------------------------------------------------------------------------------------------------- @@ -34661,7 +36269,7 @@ function TCustomVirtualDrawTree.DoGetCellContentMargin(Node: PVirtualNode; Colum //---------------------------------------------------------------------------------------------------------------------- -function TCustomVirtualDrawTree.DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): Integer; +function TCustomVirtualDrawTree.DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; begin Result := 2 * FTextMargin; @@ -34844,10 +36452,28 @@ function TSortDirectionHelper.ToInt(): Integer; Result := cSortDirectionToInt[Self]; end; +{ TChangeLink } +{$IFDEF VT_FMX} +constructor TChangeLink.Create; +begin + inherited; + IgnoreIndex := True; + IgnoreImages := True; +end; + +function TChangeLink.GetSender: TCustomImageList; +begin + Result := TCustomImageList(Images); +end; +procedure TChangeLink.SetSender(const Value: TCustomImageList); +begin + Images := TBaseImageList(Value); +end; +{$ENDIF} { TVTPaintInfo } -procedure TVTPaintInfo.AdjustImageCoordinates(VAlign: Integer); +procedure TVTPaintInfo.AdjustImageCoordinates(VAlign: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); // During painting of the main column some coordinates must be adjusted due to the tree lines. begin ContentRect := CellRect; @@ -34866,12 +36492,21 @@ procedure TVTPaintInfo.AdjustImageCoordinates(VAlign: Integer); ImageInfo[iiCheck].XPos := CellRect.Right - Offsets[TVTElement.ofsCheckBox] - (Offsets[TVTElement.ofsStateImage] - Offsets[TVTElement.ofsCheckBox]); ContentRect.Right := CellRect.Right - Offsets[TVTElement.ofsLabel]; end; +{$IFDEF VT_FMX} + if ImageInfo[iiNormal].Index > -1 then + ImageInfo[iiNormal].YPos := CellRect.Top + VAlign - 16 / 2; //TODO: 16px Image! + if ImageInfo[iiState].Index > -1 then + ImageInfo[iiState].YPos := CellRect.Top + VAlign - 16 / 2; //TODO: 16px Image! + if ImageInfo[iiCheck].Index > -1 then + ImageInfo[iiCheck].YPos := CellRect.Top + VAlign - 16 / 2; //TODO: 16px Image! +{$ELSE} if ImageInfo[iiNormal].Index > -1 then ImageInfo[iiNormal].YPos := CellRect.Top + VAlign - ImageInfo[iiNormal].Images.Height div 2; if ImageInfo[iiState].Index > -1 then ImageInfo[iiState].YPos := CellRect.Top + VAlign - ImageInfo[iiState].Images.Height div 2; if ImageInfo[iiCheck].Index > -1 then ImageInfo[iiCheck].YPos := CellRect.Top + VAlign - ImageInfo[iiCheck].Images.Height div 2; +{$ENDIF} end; initialization From 1eb7a996a7d3c5f695dbf93af2813ea941d5930a Mon Sep 17 00:00:00 2001 From: karol Date: Wed, 7 Nov 2018 11:11:48 +0100 Subject: [PATCH 02/61] Rework on TDimension and TCanvas remove all ifdefs and replace it with TDimension except events. Make changes from HDC to TCanvas sometimes need tu use dummyCanvas --- Source/VirtualTrees.Export.pas | 4 +- Source/VirtualTrees.FMX.pas | 365 +++++++++ Source/VirtualTrees.HeaderPopup.pas | 3 +- Source/VirtualTrees.Utils.pas | 37 +- Source/VirtualTrees.pas | 1105 +++++++++------------------ 5 files changed, 767 insertions(+), 747 deletions(-) create mode 100644 Source/VirtualTrees.FMX.pas diff --git a/Source/VirtualTrees.Export.pas b/Source/VirtualTrees.Export.pas index cc0ddfeae..9f3fb8bdf 100644 --- a/Source/VirtualTrees.Export.pas +++ b/Source/VirtualTrees.Export.pas @@ -14,7 +14,7 @@ interface {$IFDEF VT_FMX} uses System.SysUtils, FMX.Graphics, System.Classes, FMX.Forms, FMX.Controls, System.StrUtils, System.Generics.Collections, - VirtualTrees, VirtualTrees.Classes, FMX.Types; + VirtualTrees, VirtualTrees.Classes, FMX.Types, VirtualTrees.FMX; {$ELSE} uses Winapi.Windows, System.SysUtils, Vcl.Graphics, System.Classes, Vcl.Forms, Vcl.Controls, System.StrUtils, System.Generics.Collections, @@ -180,7 +180,7 @@ function ContentToHTML(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceTyp // Add title if adviced so by giving a caption. if Length(Caption) > 0 then AddHeader := AddHeader + 'caption="' + Caption + '"'; - if CrackTree.Borderstyle <> bsNone then + if CrackTree.Borderstyle <> TFormBorderStyle.bsNone then AddHeader := AddHeader + Format(' border="%d" frame=box', [{$IFDEF VT_FMX}Round{$ENDIF}(CrackTree.BorderWidth) + 1]); //TODO: Round Buffer.Add(''); diff --git a/Source/VirtualTrees.FMX.pas b/Source/VirtualTrees.FMX.pas new file mode 100644 index 000000000..c2fb71c35 --- /dev/null +++ b/Source/VirtualTrees.FMX.pas @@ -0,0 +1,365 @@ +unit VirtualTrees.FMX; + +{$SCOPEDENUMS ON} + +interface +uses System.UITypes, System.Types, System.ImageList, FMX.ImgList, FMX.Graphics; + +const + clBtnFace = TAlphaColorRec.Gray; + clBtnText = TAlphaColorRec.Black; + clBtnHighlight = TAlphaColorRec.DkGray; + clBtnShadow = TAlphaColorRec.Darkgray; + clHighlight = TAlphaColorRec.Lightblue; + clWindow = TAlphaColorRec.White; + clWindowText = TAlphaColorRec.Black; + clHighlightText = TAlphaColorRec.White; + clWhite = TAlphaColorRec.White; + clSilver = TAlphaColorRec.Silver; + clGray = TAlphaColorRec.Gray; + clBlack = TAlphaColorRec.Black; + clGreen = TAlphaColorRec.Green; + clBlue = TAlphaColorRec.Blue; + clGrayText = TAlphaColorRec.DkGray; + +const + { 3D border styles } + {$EXTERNALSYM BDR_RAISEDOUTER} + BDR_RAISEDOUTER = 1; + {$EXTERNALSYM BDR_SUNKENOUTER} + BDR_SUNKENOUTER = 2; + {$EXTERNALSYM BDR_RAISEDINNER} + BDR_RAISEDINNER = 4; + {$EXTERNALSYM BDR_SUNKENINNER} + BDR_SUNKENINNER = 8; + + {$EXTERNALSYM BDR_OUTER} + BDR_OUTER = 3; + {$EXTERNALSYM BDR_INNER} + BDR_INNER = 12; + {$EXTERNALSYM BDR_RAISED} + BDR_RAISED = 5; + {$EXTERNALSYM BDR_SUNKEN} + BDR_SUNKEN = 10; + + {$EXTERNALSYM EDGE_RAISED} + EDGE_RAISED = (BDR_RAISEDOUTER or BDR_RAISEDINNER); + {$EXTERNALSYM EDGE_SUNKEN} + EDGE_SUNKEN = (BDR_SUNKENOUTER or BDR_SUNKENINNER); + {$EXTERNALSYM EDGE_ETCHED} + EDGE_ETCHED = (BDR_SUNKENOUTER or BDR_RAISEDINNER); + {$EXTERNALSYM EDGE_BUMP} + EDGE_BUMP = (BDR_RAISEDOUTER or BDR_SUNKENINNER); + + {$EXTERNALSYM ETO_OPAQUE} + ETO_OPAQUE = 2; + {$EXTERNALSYM ETO_CLIPPED} + ETO_CLIPPED = 4; + {$EXTERNALSYM ETO_RTLREADING} + ETO_RTLREADING = $80; + + RTLFlag: array[Boolean] of Integer = (0, ETO_RTLREADING); + + { Border flags } + {$EXTERNALSYM BF_LEFT} + BF_LEFT = 1; + {$EXTERNALSYM BF_TOP} + BF_TOP = 2; + {$EXTERNALSYM BF_RIGHT} + BF_RIGHT = 4; + {$EXTERNALSYM BF_BOTTOM} + BF_BOTTOM = 8; + + {$EXTERNALSYM BF_TOPLEFT} + BF_TOPLEFT = (BF_TOP or BF_LEFT); + {$EXTERNALSYM BF_TOPRIGHT} + BF_TOPRIGHT = (BF_TOP or BF_RIGHT); + {$EXTERNALSYM BF_BOTTOMLEFT} + BF_BOTTOMLEFT = (BF_BOTTOM or BF_LEFT); + {$EXTERNALSYM BF_BOTTOMRIGHT} + BF_BOTTOMRIGHT = (BF_BOTTOM or BF_RIGHT); + {$EXTERNALSYM BF_RECT} + BF_RECT = (BF_LEFT or BF_TOP or BF_RIGHT or BF_BOTTOM); + + {$EXTERNALSYM BF_MIDDLE} + BF_MIDDLE = $800; { Fill in the middle } + {$EXTERNALSYM BF_SOFT} + BF_SOFT = $1000; { For softer buttons } + {$EXTERNALSYM BF_ADJUST} + BF_ADJUST = $2000; { Calculate the space left over } + {$EXTERNALSYM BF_FLAT} + BF_FLAT = $4000; { For flat rather than 3D borders } + {$EXTERNALSYM BF_MONO} + BF_MONO = $8000; { For monochrome borders } + + { DrawText() Format Flags } + DT_TOP = 0; + {$EXTERNALSYM DT_TOP} + DT_LEFT = 0; + {$EXTERNALSYM DT_LEFT} + DT_CENTER = 1; + {$EXTERNALSYM DT_CENTER} + DT_RIGHT = 2; + {$EXTERNALSYM DT_RIGHT} + DT_VCENTER = 4; + {$EXTERNALSYM DT_VCENTER} + DT_BOTTOM = 8; + {$EXTERNALSYM DT_BOTTOM} + DT_WORDBREAK = $10; + {$EXTERNALSYM DT_WORDBREAK} + DT_SINGLELINE = $20; + {$EXTERNALSYM DT_SINGLELINE} + DT_EXPANDTABS = $40; + {$EXTERNALSYM DT_EXPANDTABS} + DT_TABSTOP = $80; + {$EXTERNALSYM DT_TABSTOP} + DT_NOCLIP = $100; + {$EXTERNALSYM DT_NOCLIP} + DT_EXTERNALLEADING = $200; + {$EXTERNALSYM DT_EXTERNALLEADING} + DT_CALCRECT = $400; + {$EXTERNALSYM DT_CALCRECT} + DT_NOPREFIX = $800; + {$EXTERNALSYM DT_NOPREFIX} + DT_INTERNAL = $1000; + {$EXTERNALSYM DT_INTERNAL} + + + DT_EDITCONTROL = $2000; + {$EXTERNALSYM DT_EDITCONTROL} + DT_PATH_ELLIPSIS = $4000; + {$EXTERNALSYM DT_PATH_ELLIPSIS} + DT_END_ELLIPSIS = $8000; + {$EXTERNALSYM DT_END_ELLIPSIS} + DT_MODIFYSTRING = $10000; + {$EXTERNALSYM DT_MODIFYSTRING} + DT_RTLREADING = $20000; + {$EXTERNALSYM DT_RTLREADING} + DT_WORD_ELLIPSIS = $40000; + {$EXTERNALSYM DT_WORD_ELLIPSIS} + DT_NOFULLWIDTHCHARBREAK = $0080000; + {$EXTERNALSYM DT_NOFULLWIDTHCHARBREAK} + DT_HIDEPREFIX = $00100000; + {$EXTERNALSYM DT_HIDEPREFIX} + DT_PREFIXONLY = $00200000; + {$EXTERNALSYM DT_PREFIXONLY} + +type + TRect = System.Types.TRectF; + PRect = System.Types.PRectF; + TPoint = System.Types.TPointF; + PPoint = System.Types.PPointF; + PSize = System.Types.PSizeF; + TSize = System.Types.TSizeF; + TColor = System.UITypes.TAlphaColor; + + TBorderWidth = Single; + TBevelCut = (bvNone, bvLowered, bvRaised, bvSpace); + TBevelEdge = (beLeft, beTop, beRight, beBottom); + TBevelEdges = set of TBevelEdge; + TBevelKind = (bkNone, bkTile, bkSoft, bkFlat); + TBevelWidth = 1..MaxInt; + + TFormBorderStyle = (bsNone, bsSingle, bsSizeable, bsDialog, bsToolWindow, bsSizeToolWin); + TBorderStyle = TFormBorderStyle.bsNone..TFormBorderStyle.bsSingle; + + TChangeLink = class(TImageLink) + private + function GetSender: TCustomImageList; inline; + procedure SetSender(const Value: TCustomImageList); inline; + public + constructor Create; override; + property Sender: TCustomImageList read GetSender write SetSender; + end; + + TTextMetric = record + tmHeight: Single; //The height (ascent + descent) of characters. + tmAscent: Single; //The ascent (units above the base line) of characters. + tmDescent: Single; //The descent (units below the base line) of characters. + tmInternalLeading: Single; //The amount of leading (space) inside the bounds set by the tmHeight member. Accent marks and other diacritical characters may occur in this area. The designer may set this member to zero + tmExternalLeading: Single; //The amount of extra leading (space) that the application adds between rows. Since this area is outside the font, it contains no marks and is not altered by text output calls in either OPAQUE or TRANSPARENT mode. The designer may set this member to zero. + tmAveCharWidth: Single; //The average width of characters in the font (generally defined as the width of the letter x ). This value does not include the overhang required for bold or italic characters. + tmMaxCharWidth: Single; //The width of the widest character in the font. + tmWeight: Single; //The weight of the font. + tmOverhang: Single; + tmDigitizedAspectX: Single; //The horizontal aspect of the device for which the font was designed. + tmDigitizedAspectY: Single; //The vertical aspect of the device for which the font was designed. The ratio of the tmDigitizedAspectX and tmDigitizedAspectY members is the aspect ratio of the device for which the font was designed. + tmFirstChar: WideChar; //The value of the first character defined in the font. + tmLastChar: WideChar; //The value of the last character defined in the font. + tmDefaultChar: WideChar; //The value of the character to be substituted for characters not in the font. + tmBreakChar: WideChar; //The value of the character that will be used to define word breaks for text justification. + tmItalic: Byte; //Specifies an italic font if it is nonzero. + tmUnderlined: Byte; //Specifies an underlined font if it is nonzero. + tmStruckOut: Byte; //A strikeout font if it is nonzero. + tmPitchAndFamily: Byte; //Specifies information about the pitch, the technology, and the family of a physical font. TMPF_FIXED_PITCH, TMPF_VECTOR, TMPF_TRUETYPE, TMPF_DEVICE + tmCharSet: Byte; //The character set of the font. The character set can be one of the following values. ANSI_CHARSET, GREEK_CHARSET.... + end; + procedure GetTextMetrics(ACanvas: TCanvas; var TM: TTextMetric); + function Rect(ALeft, ATop, ARight, ABottom: Single): TRect; overload; inline; + function Rect(const ATopLeft, ABottomRight: TPoint): TRect; overload; inline; + function Point(AX, AY: Single): TPoint; overload; inline; + + procedure Inc(Var V: Single; OIle: Single=1.0); overload; + procedure Dec(Var V: Single; OIle: Single=1.0); overload; + function MulDiv(const A, B, C: Single): Single; overload; + procedure FillMemory(Destination: Pointer; Length: NativeUInt; Fill: Byte); + procedure ZeroMemory(Destination: Pointer; Length: NativeUInt); + procedure MoveMemory(Destination: Pointer; Source: Pointer; Length: NativeUInt); + procedure CopyMemory(Destination: Pointer; Source: Pointer; Length: NativeUInt); + + +implementation +uses FMX.TextLayout, System.SysUtils; + +procedure GetTextMetrics(ACanvas: TCanvas; var TM: TTextMetric); +Var P: TPathData; + tx: TTextLayout; + R: TRectF; +begin +{ + tmHeight: Single; //The height (ascent + descent) of characters. + tmAscent: Single; //The ascent (units above the base line) of characters. + tmDescent: Single; //The descent (units below the base line) of characters. + tmInternalLeading: Single; //The amount of leading (space) inside the bounds set by the tmHeight member. Accent marks and other diacritical characters may occur in this area. The designer may set this member to zero + tmExternalLeading: Single; //The amount of extra leading (space) that the application adds between rows. Since this area is outside the font, it contains no marks and is not altered by text output calls in either OPAQUE or TRANSPARENT mode. The designer may set this member to zero. + tmAveCharWidth: Single; //The average width of characters in the font (generally defined as the width of the letter x ). This value does not include the overhang required for bold or italic characters. + tmMaxCharWidth: Single; //The width of the widest character in the font. + tmWeight: Single; //The weight of the font. + tmOverhang: Single; + tmDigitizedAspectX: Single; //The horizontal aspect of the device for which the font was designed. + tmDigitizedAspectY: Single; //The vertical aspect of the device for which the font was designed. The ratio of the tmDigitizedAspectX and tmDigitizedAspectY members is the aspect ratio of the device for which the font was designed. + tmFirstChar: WideChar; //The value of the first character defined in the font. + tmLastChar: WideChar; //The value of the last character defined in the font. + tmDefaultChar: WideChar; //The value of the character to be substituted for characters not in the font. + tmBreakChar: WideChar; //The value of the character that will be used to define word breaks for text justification. + tmItalic: Byte; //Specifies an italic font if it is nonzero. + tmUnderlined: Byte; //Specifies an underlined font if it is nonzero. + tmStruckOut: Byte; //A strikeout font if it is nonzero. + tmPitchAndFamily: Byte; //Specifies information about the pitch, the technology, and the family of a physical font. TMPF_FIXED_PITCH, TMPF_VECTOR, TMPF_TRUETYPE, TMPF_DEVICE + tmCharSet: Byte; //The character set of the font. The character set can be one of the following values. ANSI_CHARSET, GREEK_CHARSET.... +} + TM.tmExternalLeading:= 0; + TM.tmWeight:= 0; //boldness??? + TM.tmOverhang:= 0; + TM.tmDigitizedAspectX:= 0; + TM.tmDigitizedAspectY:= 0; + TM.tmFirstChar:= 'a'; //??? + TM.tmLastChar:= 'z'; //??? + TM.tmDefaultChar:= ' '; + TM.tmBreakChar:= ' '; + TM.tmItalic:= 0; + TM.tmUnderlined:= 0; + TM.tmStruckOut:= 0; + TM.tmPitchAndFamily:= 0; + TM.tmCharSet:= 0; + + tx:= TTextLayoutManager.DefaultTextLayout.Create(ACanvas); + P:= TPathData.Create; + try + tx.Text:= 'W'; + tx.ConvertToPath(p); + R:= P.GetBounds(); + + TM.tmHeight:= R.Height; + TM.tmMaxCharWidth:= R.Width; + + //------------------------------------ + tx.Text:= 'Ó'; + p.Clear; + tx.ConvertToPath(p); + R:= P.GetBounds(); + TM.tmInternalLeading:= R.Height - TM.tmHeight; + + //------------------------------------ + tx.Text:= 'x'; + p.Clear; + tx.ConvertToPath(p); + R:= P.GetBounds(); + TM.tmAscent:= R.Height - TM.tmHeight; + TM.tmAveCharWidth:= R.Width; + + //------------------------------------ + tx.Text:= 'y'; + p.Clear; + tx.ConvertToPath(p); + TM.tmDescent:= P.GetBounds().Height - R.Height; + TM.tmHeight:= TM.tmHeight + TM.tmDescent; + finally + FreeAndNil(P); + FreeAndNil(tx); + end; +end; + +function Rect(ALeft, ATop, ARight, ABottom: Single): TRect; +begin + Result:= RectF(ALeft, ATop, ARight, ABottom); +end; + +function Rect(const ATopLeft, ABottomRight: TPoint): TRect; +begin + Result:= RectF(ATopLeft.X, ATopLeft.Y, ABottomRight.X, ABottomRight.Y); +end; + +function Point(AX, AY: Single): TPoint; +begin + Result.X:= AX; + Result.Y:= AY; +end; + +procedure Inc(Var V: Single; OIle: Single=1.0); +begin + V:= V + OIle; +end; + +procedure Dec(Var V: Single; OIle: Single=1.0); +begin + V:= V - OIle; +end; + +function MulDiv(const A, B, C: Single): Single; +begin + Result:= (A * B) / C; +end; + +procedure FillMemory(Destination: Pointer; Length: NativeUInt; Fill: Byte); +begin + FillChar(Destination^, Length, Fill); +end; + +procedure ZeroMemory(Destination: Pointer; Length: NativeUInt); +begin + FillChar(Destination^, Length, 0); +end; + +procedure MoveMemory(Destination: Pointer; Source: Pointer; Length: NativeUInt); +begin + Move(Source^, Destination^, Length); +end; + +procedure CopyMemory(Destination: Pointer; Source: Pointer; Length: NativeUInt); +begin + Move(Source^, Destination^, Length); +end; + +{ TChangeLink } + +constructor TChangeLink.Create; +begin + inherited; + IgnoreIndex := True; + IgnoreImages := True; +end; + +function TChangeLink.GetSender: TCustomImageList; +begin + Result := TCustomImageList(Images); +end; + +procedure TChangeLink.SetSender(const Value: TCustomImageList); +begin + Images := TBaseImageList(Value); +end; + + + +end. diff --git a/Source/VirtualTrees.HeaderPopup.pas b/Source/VirtualTrees.HeaderPopup.pas index 61a9efc95..b6911cbea 100644 --- a/Source/VirtualTrees.HeaderPopup.pas +++ b/Source/VirtualTrees.HeaderPopup.pas @@ -74,7 +74,8 @@ interface {$IFDEF VT_FMX} System.Classes, FMX.Menus, - VirtualTrees; + VirtualTrees, + VirtualTrees.FMX; {$ELSE} System.Classes, Vcl.Menus, diff --git a/Source/VirtualTrees.Utils.pas b/Source/VirtualTrees.Utils.pas index a0b640997..9cfc8a231 100644 --- a/Source/VirtualTrees.Utils.pas +++ b/Source/VirtualTrees.Utils.pas @@ -41,7 +41,8 @@ interface FMX.ImgList, System.ImageList, FMX.Types, - VirtualTrees; + VirtualTrees, + VirtualTrees.FMX; {$ELSE} Winapi.Windows, Winapi.ActiveX, @@ -62,7 +63,7 @@ interface ); {$IFDEF VT_VCL} -procedure AlphaBlend(Source, Destination: HDC; R: TRect; Target: TPoint; Mode: TBlendMode; ConstantAlpha, Bias: Integer); +procedure AlphaBlend(Source, Destination: TCanvas; R: TRect; Target: TPoint; Mode: TBlendMode; ConstantAlpha, Bias: Integer); function GetRGBColor(Value: TColor): DWORD; procedure PrtStretchDrawDIB(Canvas: TCanvas; DestRect: TRect; ABitmap: TBitmap); @@ -81,14 +82,14 @@ procedure DrawImage(ImageList: TCustomImageList; Index: Integer; Canvas: TCanvas // Adjusts the given string S so that it fits into the given width. EllipsisWidth gives the width of // the three points to be added to the shorted string. If this value is 0 then it will be determined implicitely. // For higher speed (and multiple entries to be shorted) specify this value explicitely. -function ShortenString({$IFDEF VT_FMX}ACanvas: TCanvas{$ELSE}DC: HDC{$ENDIF}; const S: string; Width: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; EllipsisWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} = 0): string; +function ShortenString(ACanvas: TCanvas; const S: string; Width: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; EllipsisWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} = 0): string; // Wrap the given string S so that it fits into a space of given width. // RTL determines if right-to-left reading is active. -function WrapString({$IFDEF VT_FMX}ACanvas: TCanvas{$ELSE}DC: HDC{$ENDIF}; const S: string; const Bounds: TRect; RTL: Boolean; DrawFormat: Cardinal): string; +function WrapString(ACanvas: TCanvas; const S: string; const Bounds: TRect; RTL: Boolean; DrawFormat: Cardinal): string; // Calculates bounds of a drawing rectangle for the given string -procedure GetStringDrawRect({$IFDEF VT_FMX}ACanvas: TCanvas{$ELSE}DC: HDC{$ENDIF}; const S: string; var Bounds: TRect; DrawFormat: Cardinal); +procedure GetStringDrawRect(ACanvas: TCanvas; const S: string; var Bounds: TRect; DrawFormat: Cardinal); {$IFDEF VT_FMX} procedure DrawTextW(ACanvas: TCanvas; CaptionText: String; Len: Integer; Bounds: TRectF; DrawFormat: Cardinal{this is windows format - must be converted to FMX}); procedure GetTextExtentPoint32W(ACanvas: TCanvas; CaptionText: String; Len: Integer; Var Size: TSizeF); @@ -253,7 +254,7 @@ procedure ClipCanvas(Canvas: TCanvas; ClipRect: TRect; VisibleRegion: HRGN = 0); //---------------------------------------------------------------------------------------------------------------------- -procedure GetStringDrawRect({$IFDEF VT_FMX}ACanvas: TCanvas{$ELSE}DC: HDC{$ENDIF}; const S: string; var Bounds: TRect; DrawFormat: Cardinal); +procedure GetStringDrawRect(ACanvas: TCanvas; const S: string; var Bounds: TRect; DrawFormat: Cardinal); begin {$IFDEF VT_FMX} Bounds:= Rect(0, 0, ACanvas.TextWidth(S), ACanvas.TextHeight(S)); @@ -261,7 +262,7 @@ procedure GetStringDrawRect({$IFDEF VT_FMX}ACanvas: TCanvas{$ELSE}DC: HDC{$ENDIF Bounds.Right := Bounds.Left + 1; Bounds.Bottom := Bounds.Top + 1; - Winapi.Windows.DrawTextW(DC, PWideChar(S), Length(S), Bounds, DrawFormat or DT_CALCRECT); + Winapi.Windows.DrawTextW(ACanvas.Handle, PWideChar(S), Length(S), Bounds, DrawFormat or DT_CALCRECT); {$ENDIF} end; @@ -278,7 +279,7 @@ procedure DrawEdge(TargetCanvas: TCanvas; PaintRectangle: TRectF; PressedButtonS //---------------------------------------------------------------------------------------------------------------------- -function ShortenString({$IFDEF VT_FMX}ACanvas: TCanvas{$ELSE}DC: HDC{$ENDIF}; const S: string; Width: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; EllipsisWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} = 0): string; +function ShortenString(ACanvas: TCanvas; const S: string; Width: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; EllipsisWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} = 0): string; var Size: TSize; @@ -294,7 +295,7 @@ function ShortenString({$IFDEF VT_FMX}ACanvas: TCanvas{$ELSE}DC: HDC{$ENDIF}; co // Determine width of triple point using the current DC settings (if not already done). if EllipsisWidth = 0 then begin - GetTextExtentPoint32W({$IFDEF VT_FMX}ACanvas{$ELSE}DC{$ENDIF}, '...', 3, Size); + GetTextExtentPoint32W(ACanvas{$IFDEF VT_VCL}.Handle{$ENDIF}, '...', 3, Size); EllipsisWidth := Size.cx; end; @@ -307,7 +308,7 @@ function ShortenString({$IFDEF VT_FMX}ACanvas: TCanvas{$ELSE}DC: HDC{$ENDIF}; co while L < H do begin N := (L + H + 1) shr 1; - GetTextExtentPoint32W({$IFDEF VT_FMX}ACanvas{$ELSE}DC{$ENDIF}, {$IFDEF VT_VCL}PWideChar{$ENDIF}(S), N, Size); + GetTextExtentPoint32W(ACanvas{$IFDEF VT_VCL}.Handle{$ENDIF}, {$IFDEF VT_VCL}PWideChar{$ENDIF}(S), N, Size); W := Size.cx + EllipsisWidth; if W <= Width then L := N @@ -339,7 +340,7 @@ procedure GetTextExtentPoint32W(ACanvas: TCanvas; CaptionText: String; Len: Inte {$ENDIF} //---------------------------------------------------------------------------------------------------------------------- -function WrapString({$IFDEF VT_FMX}ACanvas: TCanvas{$ELSE}DC: HDC{$ENDIF}; const S: string; const Bounds: TRect; RTL: Boolean; DrawFormat: Cardinal): string; +function WrapString(ACanvas: TCanvas; const S: string; const Bounds: TRect; RTL: Boolean; DrawFormat: Cardinal): string; var Width, @@ -391,7 +392,7 @@ function WrapString({$IFDEF VT_FMX}ACanvas: TCanvas{$ELSE}DC: HDC{$ENDIF}; const while WordCounter > 0 do begin - GetStringDrawRect(DC, Line + IfThen(WordsInLine > 0, ' ', '') + Words[WordCounter - 1], R, DrawFormat); + GetStringDrawRect(ACanvas, Line + IfThen(WordsInLine > 0, ' ', '') + Words[WordCounter - 1], R, DrawFormat); if R.Right > Width then begin // If at least one word fits into this line then continue with the next line. @@ -403,7 +404,7 @@ function WrapString({$IFDEF VT_FMX}ACanvas: TCanvas{$ELSE}DC: HDC{$ENDIF}; const begin for Len := Length(Buffer) - 1 downto 2 do begin - GetStringDrawRect(DC, RightStr(Buffer, Len), R, DrawFormat); + GetStringDrawRect(ACanvas, RightStr(Buffer, Len), R, DrawFormat); if R.Right <= Width then Break; end; @@ -447,7 +448,7 @@ function WrapString({$IFDEF VT_FMX}ACanvas: TCanvas{$ELSE}DC: HDC{$ENDIF}; const while WordCounter > 0 do begin - GetStringDrawRect(DC, Line + IfThen(WordsInLine > 0, ' ', '') + Words[WordCounter - 1], R, DrawFormat); + GetStringDrawRect(ACanvas, Line + IfThen(WordsInLine > 0, ' ', '') + Words[WordCounter - 1], R, DrawFormat); if R.Right > Width then begin // If at least one word fits into this line then continue with the next line. @@ -459,7 +460,7 @@ function WrapString({$IFDEF VT_FMX}ACanvas: TCanvas{$ELSE}DC: HDC{$ENDIF}; const begin for Len := Length(Buffer) - 1 downto 2 do begin - GetStringDrawRect(DC, LeftStr(Buffer, Len), R, DrawFormat); + GetStringDrawRect(ACanvas, LeftStr(Buffer, Len), R, DrawFormat); if R.Right <= Width then Break; end; @@ -511,7 +512,7 @@ function CalculateScanline(Bits: Pointer; Width, Height, Row: Integer): Pointer; //---------------------------------------------------------------------------------------------------------------------- {$IFDEF VT_VCL} -function GetBitmapBitsFromDeviceContext({$IFDEF VT_FMX}ACanvas: TCanvas{$ELSE}DC: HDC{$ENDIF}; var Width, Height: Integer): Pointer; +function GetBitmapBitsFromDeviceContext(ACanvas: TCanvas; var Width, Height: Integer): Pointer; // Helper function used to retrieve the bitmap selected into the given device context. If there is a bitmap then // the function will return a pointer to its bits otherwise nil is returned. @@ -526,7 +527,7 @@ function GetBitmapBitsFromDeviceContext({$IFDEF VT_FMX}ACanvas: TCanvas{$ELSE}DC Width := 0; Height := 0; - Bitmap := GetCurrentObject(DC, OBJ_BITMAP); + Bitmap := GetCurrentObject(ACanvas.Handle, OBJ_BITMAP); if Bitmap <> 0 then begin if GetObject(Bitmap, SizeOf(DIB), @DIB) = SizeOf(DIB) then @@ -1082,7 +1083,7 @@ procedure AlphaBlendLineMasterAndColor(Destination: Pointer; Count: Integer; Con //---------------------------------------------------------------------------------------------------------------------- -procedure AlphaBlend(Source, Destination: HDC; R: TRect; Target: TPoint; Mode: TBlendMode; ConstantAlpha, Bias: Integer); +procedure AlphaBlend(Source, Destination: TCanvas; R: TRect; Target: TPoint; Mode: TBlendMode; ConstantAlpha, Bias: Integer); // Optimized alpha blend procedure using MMX instructions to perform as quick as possible. // For this procedure to work properly it is important that both source and target bitmap use the 32 bit color format. diff --git a/Source/VirtualTrees.pas b/Source/VirtualTrees.pas index f955a8e5f..2de06343c 100644 --- a/Source/VirtualTrees.pas +++ b/Source/VirtualTrees.pas @@ -83,39 +83,25 @@ interface System.SysUtils, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.ImgList, System.ImageList, FMX.StdCtrls, System.Classes, FMX.Menus, System.Types, System.UITypes, System.Generics.Collections, System.Threading, System.Variants, FMX.Types, FMX.Dialogs, FMX.Controls.Presentation, FMX.Objects, FMX.Printer, FMX.Edit, FMX.Platform, - System.Devices; + System.Devices, VirtualTrees.FMX; {$ELSE} Winapi.Windows, Winapi.oleacc, Winapi.Messages, System.SysUtils, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.ImgList, Winapi.ActiveX, Vcl.StdCtrls, System.Classes, Vcl.Menus, Vcl.Printers, System.Types, Winapi.CommCtrl, Vcl.Themes, Winapi.UxTheme, Winapi.ShlObj, System.UITypes, System.Generics.Collections; {$ENDIF} + +type +{$IFDEF VT_FMX} + TDimension = Single; +{$ELSE} + TDimension = Integer; +{$ENDIF} + const VTVersion = '7.0.0'; const -{$IFDEF VT_FMX} - //i resign from overriding types as this caused many problems and i start from scratch once again - //this can be done in the next steep if really needed because step back will be not so simple - //TColor = TAlphaColor; - //TRect = TRectF; - //TPoint = TPointF; - clBtnFace = TAlphaColorRec.Gray; - clBtnText = TAlphaColorRec.Black; - clBtnHighlight = TAlphaColorRec.DkGray; - clBtnShadow = TAlphaColorRec.Darkgray; - clHighlight = TAlphaColorRec.Lightblue; - clWindow = TAlphaColorRec.White; - clWindowText = TAlphaColorRec.Black; - clHighlightText = TAlphaColorRec.White; - clWhite = TAlphaColorRec.White; - clSilver = TAlphaColorRec.Silver; - clGray = TAlphaColorRec.Gray; - clBlack = TAlphaColorRec.Black; - clGreen = TAlphaColorRec.Green; - clBlue = TAlphaColorRec.Blue; - clGrayText = TAlphaColorRec.DkGray; -{$ENDIF} VTTreeStreamVersion = 3; VTHeaderStreamVersion = 6; // The header needs an own stream version to indicate changes only relevant to the header. @@ -232,185 +218,7 @@ interface {$MinEnumSize 1, make enumerations as small as possible} -{$IFDEF VT_FMX} -type - TRect = System.Types.TRectF; - PRect = System.Types.PRectF; - TPoint = System.Types.TPointF; - PPoint = System.Types.PPointF; - PSize = System.Types.PSizeF; - TSize = System.Types.TSizeF; - TColor = System.UITypes.TAlphaColor; - - TBorderWidth = Single; - TBevelCut = (bvNone, bvLowered, bvRaised, bvSpace); - TBevelEdge = (beLeft, beTop, beRight, beBottom); - TBevelEdges = set of TBevelEdge; - TBevelKind = (bkNone, bkTile, bkSoft, bkFlat); - TBevelWidth = 1..MaxInt; - - TFormBorderStyle = (bsNone, bsSingle, bsSizeable, bsDialog, bsToolWindow, bsSizeToolWin); - TBorderStyle = bsNone..bsSingle; - - TTextMetric = record - tmHeight: Single; //The height (ascent + descent) of characters. - tmAscent: Single; //The ascent (units above the base line) of characters. - tmDescent: Single; //The descent (units below the base line) of characters. - tmInternalLeading: Single; //The amount of leading (space) inside the bounds set by the tmHeight member. Accent marks and other diacritical characters may occur in this area. The designer may set this member to zero - tmExternalLeading: Single; //The amount of extra leading (space) that the application adds between rows. Since this area is outside the font, it contains no marks and is not altered by text output calls in either OPAQUE or TRANSPARENT mode. The designer may set this member to zero. - tmAveCharWidth: Single; //The average width of characters in the font (generally defined as the width of the letter x ). This value does not include the overhang required for bold or italic characters. - tmMaxCharWidth: Single; //The width of the widest character in the font. - tmWeight: Single; //The weight of the font. - tmOverhang: Single; - tmDigitizedAspectX: Single; //The horizontal aspect of the device for which the font was designed. - tmDigitizedAspectY: Single; //The vertical aspect of the device for which the font was designed. The ratio of the tmDigitizedAspectX and tmDigitizedAspectY members is the aspect ratio of the device for which the font was designed. - tmFirstChar: WideChar; //The value of the first character defined in the font. - tmLastChar: WideChar; //The value of the last character defined in the font. - tmDefaultChar: WideChar; //The value of the character to be substituted for characters not in the font. - tmBreakChar: WideChar; //The value of the character that will be used to define word breaks for text justification. - tmItalic: Byte; //Specifies an italic font if it is nonzero. - tmUnderlined: Byte; //Specifies an underlined font if it is nonzero. - tmStruckOut: Byte; //A strikeout font if it is nonzero. - tmPitchAndFamily: Byte; //Specifies information about the pitch, the technology, and the family of a physical font. TMPF_FIXED_PITCH, TMPF_VECTOR, TMPF_TRUETYPE, TMPF_DEVICE - tmCharSet: Byte; //The character set of the font. The character set can be one of the following values. ANSI_CHARSET, GREEK_CHARSET.... - end; - procedure GetTextMetrics(ACanvas: TCanvas; var TM: TTextMetric); - function Rect(ALeft, ATop, ARight, ABottom: Single): TRect; overload; inline; - function Rect(const ATopLeft, ABottomRight: TPoint): TRect; overload; inline; - function Point(AX, AY: Single): TPoint; overload; inline; - - procedure Inc(Var V: Single; OIle: Single=1.0); overload; - procedure Dec(Var V: Single; OIle: Single=1.0); overload; - function MulDiv(const A, B, C: Single): Single; overload; - procedure FillMemory(Destination: Pointer; Length: NativeUInt; Fill: Byte); - procedure ZeroMemory(Destination: Pointer; Length: NativeUInt); - procedure MoveMemory(Destination: Pointer; Source: Pointer; Length: NativeUInt); - procedure CopyMemory(Destination: Pointer; Source: Pointer; Length: NativeUInt); - -const - { 3D border styles } - {$EXTERNALSYM BDR_RAISEDOUTER} - BDR_RAISEDOUTER = 1; - {$EXTERNALSYM BDR_SUNKENOUTER} - BDR_SUNKENOUTER = 2; - {$EXTERNALSYM BDR_RAISEDINNER} - BDR_RAISEDINNER = 4; - {$EXTERNALSYM BDR_SUNKENINNER} - BDR_SUNKENINNER = 8; - - {$EXTERNALSYM BDR_OUTER} - BDR_OUTER = 3; - {$EXTERNALSYM BDR_INNER} - BDR_INNER = 12; - {$EXTERNALSYM BDR_RAISED} - BDR_RAISED = 5; - {$EXTERNALSYM BDR_SUNKEN} - BDR_SUNKEN = 10; - - {$EXTERNALSYM EDGE_RAISED} - EDGE_RAISED = (BDR_RAISEDOUTER or BDR_RAISEDINNER); - {$EXTERNALSYM EDGE_SUNKEN} - EDGE_SUNKEN = (BDR_SUNKENOUTER or BDR_SUNKENINNER); - {$EXTERNALSYM EDGE_ETCHED} - EDGE_ETCHED = (BDR_SUNKENOUTER or BDR_RAISEDINNER); - {$EXTERNALSYM EDGE_BUMP} - EDGE_BUMP = (BDR_RAISEDOUTER or BDR_SUNKENINNER); - - {$EXTERNALSYM ETO_OPAQUE} - ETO_OPAQUE = 2; - {$EXTERNALSYM ETO_CLIPPED} - ETO_CLIPPED = 4; - {$EXTERNALSYM ETO_RTLREADING} - ETO_RTLREADING = $80; - - RTLFlag: array[Boolean] of Integer = (0, ETO_RTLREADING); - - { Border flags } - {$EXTERNALSYM BF_LEFT} - BF_LEFT = 1; - {$EXTERNALSYM BF_TOP} - BF_TOP = 2; - {$EXTERNALSYM BF_RIGHT} - BF_RIGHT = 4; - {$EXTERNALSYM BF_BOTTOM} - BF_BOTTOM = 8; - - {$EXTERNALSYM BF_TOPLEFT} - BF_TOPLEFT = (BF_TOP or BF_LEFT); - {$EXTERNALSYM BF_TOPRIGHT} - BF_TOPRIGHT = (BF_TOP or BF_RIGHT); - {$EXTERNALSYM BF_BOTTOMLEFT} - BF_BOTTOMLEFT = (BF_BOTTOM or BF_LEFT); - {$EXTERNALSYM BF_BOTTOMRIGHT} - BF_BOTTOMRIGHT = (BF_BOTTOM or BF_RIGHT); - {$EXTERNALSYM BF_RECT} - BF_RECT = (BF_LEFT or BF_TOP or BF_RIGHT or BF_BOTTOM); - - {$EXTERNALSYM BF_MIDDLE} - BF_MIDDLE = $800; { Fill in the middle } - {$EXTERNALSYM BF_SOFT} - BF_SOFT = $1000; { For softer buttons } - {$EXTERNALSYM BF_ADJUST} - BF_ADJUST = $2000; { Calculate the space left over } - {$EXTERNALSYM BF_FLAT} - BF_FLAT = $4000; { For flat rather than 3D borders } - {$EXTERNALSYM BF_MONO} - BF_MONO = $8000; { For monochrome borders } - - { DrawText() Format Flags } - DT_TOP = 0; - {$EXTERNALSYM DT_TOP} - DT_LEFT = 0; - {$EXTERNALSYM DT_LEFT} - DT_CENTER = 1; - {$EXTERNALSYM DT_CENTER} - DT_RIGHT = 2; - {$EXTERNALSYM DT_RIGHT} - DT_VCENTER = 4; - {$EXTERNALSYM DT_VCENTER} - DT_BOTTOM = 8; - {$EXTERNALSYM DT_BOTTOM} - DT_WORDBREAK = $10; - {$EXTERNALSYM DT_WORDBREAK} - DT_SINGLELINE = $20; - {$EXTERNALSYM DT_SINGLELINE} - DT_EXPANDTABS = $40; - {$EXTERNALSYM DT_EXPANDTABS} - DT_TABSTOP = $80; - {$EXTERNALSYM DT_TABSTOP} - DT_NOCLIP = $100; - {$EXTERNALSYM DT_NOCLIP} - DT_EXTERNALLEADING = $200; - {$EXTERNALSYM DT_EXTERNALLEADING} - DT_CALCRECT = $400; - {$EXTERNALSYM DT_CALCRECT} - DT_NOPREFIX = $800; - {$EXTERNALSYM DT_NOPREFIX} - DT_INTERNAL = $1000; - {$EXTERNALSYM DT_INTERNAL} - - - DT_EDITCONTROL = $2000; - {$EXTERNALSYM DT_EDITCONTROL} - DT_PATH_ELLIPSIS = $4000; - {$EXTERNALSYM DT_PATH_ELLIPSIS} - DT_END_ELLIPSIS = $8000; - {$EXTERNALSYM DT_END_ELLIPSIS} - DT_MODIFYSTRING = $10000; - {$EXTERNALSYM DT_MODIFYSTRING} - DT_RTLREADING = $20000; - {$EXTERNALSYM DT_RTLREADING} - DT_WORD_ELLIPSIS = $40000; - {$EXTERNALSYM DT_WORD_ELLIPSIS} - DT_NOFULLWIDTHCHARBREAK = $0080000; - {$EXTERNALSYM DT_NOFULLWIDTHCHARBREAK} - DT_HIDEPREFIX = $00100000; - {$EXTERNALSYM DT_HIDEPREFIX} - DT_PREFIXONLY = $00200000; - {$EXTERNALSYM DT_PREFIXONLY} - -{$ENDIF} type // Alias defintions for convenience @@ -796,7 +604,7 @@ TCheckStateHelper = record helper for TCheckState ); /// An array that can be used to calculate the offsets ofthe elements in the tree. - TVTOffsets = array [TVTElement] of {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + TVTOffsets = array [TVTElement] of TDimension; TAddPopupItemType = ( apNormal, @@ -827,7 +635,7 @@ TVirtualTreeClass = class of TBaseVirtualTree; // to compile (conversion done by BCB is wrong). TCacheEntry = record Node: PVirtualNode; - AbsoluteTop: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; + AbsoluteTop: TDimension; end; TCache = array of TCacheEntry; @@ -885,14 +693,14 @@ TVTReference = record TVirtualNode = packed record Index, // index of node with regard to its parent ChildCount: Cardinal; // number of child nodes - NodeHeight: {$IFDEF VT_FMX}Single{$ELSE}Word{$ENDIF}; // height in pixels + NodeHeight: TDimension; // height in pixels States: TVirtualNodeStates; // states describing various properties of the node (expanded, initialized etc.) Align: Byte; // line/button alignment CheckState: TCheckState; // indicates the current check state (e.g. checked, pressed etc.) CheckType: TCheckType; // indicates which check type shall be used for this node Dummy: Byte; // dummy value to fill DWORD boundary TotalCount: Cardinal; // sum of this node, all of its child nodes and their child nodes etc. - TotalHeight: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; // height in pixels this node covers on screen including the height of all of its + TotalHeight: TDimension; // height in pixels this node covers on screen including the height of all of its // children // Note: Some copy routines require that all pointers (as well as the data area) in a node are // located at the end of the node! Hence if you want to add new member fields (except pointers to internal @@ -917,7 +725,7 @@ TVTReference = record // Structure used when info about a certain position in the header is needed. TVTHeaderHitInfo = record X, - Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + Y: TDimension; Button: TMouseButton; Shift: TShiftState; Column: TColumnIndex; @@ -1174,23 +982,23 @@ TVirtualTreeColumn = class(TCollectionItem) private FText, FHint: string; - FWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + FWidth: TDimension; FPosition: TColumnPosition; - FMinWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; - FMaxWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + FMinWidth: TDimension; + FMaxWidth: TDimension; FStyle: TVirtualTreeColumnStyle; FImageIndex: TImageIndex; FBiDiMode: TBiDiMode; FLayout: TVTHeaderColumnLayout; FMargin, - FSpacing: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + FSpacing: TDimension; FOptions: TVTColumnOptions; FEditOptions: TVTEditOptions; FEditNextColumn: Integer; FTag: NativeInt; FAlignment: TAlignment; FCaptionAlignment: TAlignment; // Alignment of the caption. - FLastWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + FLastWidth: TDimension; FColor: TColor; FBonusPixel: Boolean; FSpringRest: Single; // Accumulator for width adjustment when auto spring option is enabled. @@ -1202,7 +1010,7 @@ TVirtualTreeColumn = class(TCollectionItem) FHasImage: Boolean; FDefaultSortDirection: TSortDirection; function GetCaptionAlignment: TAlignment; - function GetLeft: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + function GetLeft: TDimension; function IsBiDiModeStored: Boolean; function IsCaptionAlignmentStored: Boolean; function IsColorStored: Boolean; @@ -1215,21 +1023,21 @@ TVirtualTreeColumn = class(TCollectionItem) procedure SetColor(const Value: TColor); procedure SetImageIndex(Value: TImageIndex); procedure SetLayout(Value: TVTHeaderColumnLayout); - procedure SetMargin(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); - procedure SetMaxWidth(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); - procedure SetMinWidth(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); + procedure SetMargin(Value: TDimension); + procedure SetMaxWidth(Value: TDimension); + procedure SetMinWidth(Value: TDimension); procedure SetOptions(Value: TVTColumnOptions); procedure SetPosition(Value: TColumnPosition); - procedure SetSpacing(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); + procedure SetSpacing(Value: TDimension); procedure SetStyle(Value: TVirtualTreeColumnStyle); - procedure SetWidth(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); + procedure SetWidth(Value: TDimension); protected - FLeft: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; - procedure ComputeHeaderLayout({$IFDEF VT_FMX}ACanvas: TCanvas{$ELSE}DC: HDC{$ENDIF}; Client: TRect; UseHeaderGlyph, UseSortGlyph: Boolean; + FLeft: TDimension; + procedure ComputeHeaderLayout(ACanvas: TCanvas; Client: TRect; UseHeaderGlyph, UseSortGlyph: Boolean; var HeaderGlyphPos, SortGlyphPos: TPoint; var SortGlyphSize: TSize; var TextBounds: TRect; DrawFormat: Cardinal; CalculateTextRect: Boolean = False); procedure DefineProperties(Filer: TFiler); override; - procedure GetAbsoluteBounds(var Left, Right: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); + procedure GetAbsoluteBounds(var Left, Right: TDimension); function GetDisplayName: string; override; function GetText: string; virtual; // [IPK] procedure SetText(const Value: string); virtual; // [IPK] private to protected & virtual @@ -1254,7 +1062,7 @@ TVirtualTreeColumn = class(TCollectionItem) function UseRightToLeftReading: Boolean; property CaptionText: string read FCaptionText; - property Left: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} read GetLeft; + property Left: TDimension read GetLeft; property Owner: TVirtualTreeColumns read GetOwner; published property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify; @@ -1269,18 +1077,18 @@ TVirtualTreeColumn = class(TCollectionItem) property Hint: string read FHint write FHint; property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1; property Layout: TVTHeaderColumnLayout read FLayout write SetLayout default blGlyphLeft; - property Margin: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} read FMargin write SetMargin{$IFDEF VT_VCL} default 4{$ENDIF}; - property MaxWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} read FMaxWidth write SetMaxWidth{$IFDEF VT_VCL} default 10000{$ENDIF}; - property MinWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} read FMinWidth write SetMinWidth{$IFDEF VT_VCL} default 10{$ENDIF}; + property Margin: TDimension read FMargin write SetMargin{$IFDEF VT_VCL} default 4{$ENDIF}; + property MaxWidth: TDimension read FMaxWidth write SetMaxWidth{$IFDEF VT_VCL} default 10000{$ENDIF}; + property MinWidth: TDimension read FMinWidth write SetMinWidth{$IFDEF VT_VCL} default 10{$ENDIF}; property Options: TVTColumnOptions read FOptions write SetOptions default DefaultColumnOptions; property EditOptions: TVTEditOptions read FEditOptions write FEditOptions default toDefaultEdit; property EditNextColumn: Integer read FEditNextColumn write FEditNextColumn default -1; property Position: TColumnPosition read FPosition write SetPosition; - property Spacing: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} read FSpacing write SetSpacing{$IFDEF VT_VCL} default 3{$ENDIF}; + property Spacing: TDimension read FSpacing write SetSpacing{$IFDEF VT_VCL} default 3{$ENDIF}; property Style: TVirtualTreeColumnStyle read FStyle write SetStyle default vsText; property Tag: NativeInt read FTag write FTag default 0; property Text: string read GetText write SetText; - property Width: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} read FWidth write SetWidth{$IFDEF VT_VCL} default 50{$ENDIF}; + property Width: TDimension read FWidth write SetWidth{$IFDEF VT_VCL} default 50{$ENDIF}; end; TVirtualTreeColumnClass = class of TVirtualTreeColumn; @@ -1322,10 +1130,10 @@ TVirtualTreeColumns = class(TCollection) procedure AdjustPosition(Column: TVirtualTreeColumn; Position: Cardinal); function CanSplitterResize(P: TPoint; Column: TColumnIndex): Boolean; procedure DoCanSplitterResize(P: TPoint; Column: TColumnIndex; var Allowed: Boolean); virtual; - procedure DrawButtonText({$IFDEF VT_FMX}ACanvas: TCanvas{$ELSE}DC: HDC{$ENDIF}; Caption: string; Bounds: TRect; Enabled, Hot: Boolean; DrawFormat: Cardinal; + procedure DrawButtonText(ACanvas: TCanvas; Caption: string; Bounds: TRect; Enabled, Hot: Boolean; DrawFormat: Cardinal; WrapCaption: Boolean); procedure FixPositions; - function GetColumnAndBounds(P: TPoint; var ColumnLeft, ColumnRight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; Relative: Boolean = True): Integer; + function GetColumnAndBounds(P: TPoint; var ColumnLeft, ColumnRight: TDimension; Relative: Boolean = True): Integer; function GetOwner: TPersistent; override; function HandleClick(P: TPoint; Button: TMouseButton;{$IFDEF VT_FMX}Shift: TShiftState;{$ENDIF} Force, DblClick: Boolean): Boolean; virtual; procedure HeaderPopupMenuAddHeaderPopupItem(const Sender: TBaseVirtualTree; const Column: TColumnIndex; @@ -1348,13 +1156,13 @@ TVirtualTreeColumns = class(TCollection) destructor Destroy; override; function Add: TVirtualTreeColumn; virtual; - procedure AnimatedResize(Column: TColumnIndex; NewWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); + procedure AnimatedResize(Column: TColumnIndex; NewWidth: TDimension); procedure Assign(Source: TPersistent); override; procedure Clear; virtual; function ColumnFromPosition(P: TPoint; Relative: Boolean = True): TColumnIndex; overload; virtual; function ColumnFromPosition(PositionIndex: TColumnPosition): TColumnIndex; overload; virtual; function Equals(OtherColumnsObj: TObject): Boolean; override; - procedure GetColumnBounds(Column: TColumnIndex; var Left, Right: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); + procedure GetColumnBounds(Column: TColumnIndex; var Left, Right: TDimension); function GetFirstVisibleColumn(ConsiderAllowFocus: Boolean = False): TColumnIndex; function GetLastVisibleColumn(ConsiderAllowFocus: Boolean = False): TColumnIndex; function GetFirstColumn: TColumnIndex; @@ -1362,16 +1170,16 @@ TVirtualTreeColumns = class(TCollection) function GetNextVisibleColumn(Column: TColumnIndex; ConsiderAllowFocus: Boolean = False): TColumnIndex; function GetPreviousColumn(Column: TColumnIndex): TColumnIndex; function GetPreviousVisibleColumn(Column: TColumnIndex; ConsiderAllowFocus: Boolean = False): TColumnIndex; - function GetScrollWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + function GetScrollWidth: TDimension; function GetVisibleColumns: TColumnsArray; - function GetVisibleFixedWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + function GetVisibleFixedWidth: TDimension; function IsValidColumn(Column: TColumnIndex): Boolean; procedure LoadFromStream(const Stream: TStream; Version: Integer); - procedure PaintHeader({$IFDEF VT_FMX}ACanvas: TCanvas{$ELSE}DC: HDC{$ENDIF}; R: TRect; HOffset: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); overload; virtual; - procedure PaintHeader(TargetCanvas: TCanvas; R: TRect; const Target: TPoint; RTLOffset: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} = 0); overload; virtual; + procedure PaintHeader(ACanvas: TCanvas; R: TRect; HOffset: TDimension); overload; virtual; + procedure PaintHeader(TargetCanvas: TCanvas; R: TRect; const Target: TPoint; RTLOffset: TDimension = 0); overload; virtual; procedure SaveToStream(const Stream: TStream); procedure EndUpdate(); override; - function TotalWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + function TotalWidth: TDimension; property Count: Integer read GetCount; property ClickIndex: TColumnIndex read FClickIndex; @@ -1470,22 +1278,12 @@ TVTFixedAreaConstraints = class(TPersistent) crNodeCopied, // a node has been duplicated crNodeMoved // a node has been moved to a new place ); // desribes what made a structure change event happen -{$IFDEF VT_FMX} - TChangeLink = class(TImageLink) - private - function GetSender: TCustomImageList; inline; - procedure SetSender(const Value: TCustomImageList); inline; - public - constructor Create; override; - property Sender: TCustomImageList read GetSender write SetSender; - end; -{$ENDIF} TVTHeader = class(TPersistent) private FOwner: TBaseVirtualTree; FColumns: TVirtualTreeColumns; - FHeight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + FHeight: TDimension; FFont: TFont; FParentFont: Boolean; FOptions: TVTHeaderOptions; @@ -1494,9 +1292,9 @@ TVTHeader = class(TPersistent) FAutoSizeIndex: TColumnIndex; FPopupMenu: TPopupMenu; FMainColumn: TColumnIndex; // the column which holds the tree - FMaxHeight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; - FMinHeight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; - FDefaultHeight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + FMaxHeight: TDimension; + FMinHeight: TDimension; + FDefaultHeight: TDimension; FFixedAreaConstraints: TVTFixedAreaConstraints; // Percentages for the fixed area (header, fixed columns). FImages: TCustomImageList; FImageChangeLink: TChangeLink; // connections to the image list to get notified about changes @@ -1506,7 +1304,7 @@ TVTHeader = class(TPersistent) {$IFDEF VT_VCL} FDragImage: TVTDragImage; // drag image management during header drag {$ENDIF} - FLastWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; // Used to adjust spring columns. This is the width of all visible columns, + FLastWidth: TDimension; // Used to adjust spring columns. This is the width of all visible columns, // not the header rectangle. procedure FontChanged(Sender: TObject); function GetMainColumn: TColumnIndex; @@ -1515,13 +1313,13 @@ TVTHeader = class(TPersistent) procedure SetAutoSizeIndex(Value: TColumnIndex); procedure SetBackground(Value: TColor); procedure SetColumns(Value: TVirtualTreeColumns); - procedure SetDefaultHeight(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); + procedure SetDefaultHeight(Value: TDimension); procedure SetFont(const Value: TFont); - procedure SetHeight(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); + procedure SetHeight(Value: TDimension); procedure SetImages(const Value: TCustomImageList); procedure SetMainColumn(Value: TColumnIndex); - procedure SetMaxHeight(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); - procedure SetMinHeight(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); + procedure SetMaxHeight(Value: TDimension); + procedure SetMinHeight(Value: TDimension); procedure SetOptions(Value: TVTHeaderOptions); procedure SetParentFont(Value: Boolean); procedure SetSortColumn(Value: TColumnIndex); @@ -1536,7 +1334,7 @@ TVTHeader = class(TPersistent) function CanSplitterResize(P: TPoint): Boolean; function CanWriteColumns: Boolean; virtual; - procedure ChangeScale(M, D: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); virtual; + procedure ChangeScale(M, D: TDimension); virtual; function DetermineSplitterIndex(P: TPoint): Boolean; virtual; procedure DoAfterAutoFitColumn(Column: TColumnIndex); virtual; procedure DoAfterColumnWidthTracking(Column: TColumnIndex); virtual; @@ -1580,8 +1378,8 @@ TVTHeader = class(TPersistent) function InHeaderSplitterArea(P: TPoint): Boolean; virtual; procedure Invalidate(Column: TVirtualTreeColumn; ExpandToBorder: Boolean = False; UpdateNowFlag : Boolean = False); procedure LoadFromStream(const Stream: TStream); virtual; - function ResizeColumns(ChangeBy: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; RangeStartCol: TColumnIndex; RangeEndCol: TColumnIndex; - Options: TVTColumnOptions = [coVisible]): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + function ResizeColumns(ChangeBy: TDimension; RangeStartCol: TColumnIndex; RangeEndCol: TColumnIndex; + Options: TVTColumnOptions = [coVisible]): TDimension; procedure RestoreColumns; procedure SaveToStream(const Stream: TStream); virtual; {$IFDEF VT_VCL} @@ -1595,14 +1393,14 @@ TVTHeader = class(TPersistent) property AutoSizeIndex: TColumnIndex read FAutoSizeIndex write SetAutoSizeIndex; property Background: TColor read FBackgroundColor write SetBackground default clBtnFace; property Columns: TVirtualTreeColumns read FColumns write SetColumns stored False; // Stored by the owner tree to support VFI. - property DefaultHeight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} read FDefaultHeight write SetDefaultHeight{$IFDEF VT_VCL} default 19{$ENDIF}; + property DefaultHeight: TDimension read FDefaultHeight write SetDefaultHeight{$IFDEF VT_VCL} default 19{$ENDIF}; property Font: TFont read FFont write SetFont stored IsFontStored; property FixedAreaConstraints: TVTFixedAreaConstraints read FFixedAreaConstraints write FFixedAreaConstraints; - property Height: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} read FHeight write SetHeight{$IFDEF VT_VCL} default 19{$ENDIF}; + property Height: TDimension read FHeight write SetHeight{$IFDEF VT_VCL} default 19{$ENDIF}; property Images: TCustomImageList read FImages write SetImages; property MainColumn: TColumnIndex read GetMainColumn write SetMainColumn default 0; - property MaxHeight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} read FMaxHeight write SetMaxHeight{$IFDEF VT_VCL} default 10000{$ENDIF}; - property MinHeight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} read FMinHeight write SetMinHeight{$IFDEF VT_VCL} default 10{$ENDIF}; + property MaxHeight: TDimension read FMaxHeight write SetMaxHeight{$IFDEF VT_VCL} default 10000{$ENDIF}; + property MinHeight: TDimension read FMinHeight write SetMinHeight{$IFDEF VT_VCL} default 10{$ENDIF}; property Options: TVTHeaderOptions read FOptions write SetOptions default [hoColumnResize, hoDrag, hoShowSortGlyphs]; property ParentFont: Boolean read FParentFont write SetParentFont default True; property PopupMenu: TPopupMenu read FPopupMenu write FPopupMenu; @@ -1899,7 +1697,7 @@ TVTColors = class(TPersistent) TVTImageInfo = record Index: TImageIndex; // Index in the associated image list. XPos, // Horizontal position in the current target canvas. - YPos: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; // Vertical position in the current target canvas. + YPos: TDimension; // Vertical position in the current target canvas. Ghosted: Boolean; // Flag to indicate that the image must be drawn slightly lighter. Images: TCustomImageList; // The image list to be used for painting. function Equals(const pImageInfo2: TVTImageInfo): Boolean; @@ -1942,14 +1740,14 @@ TVTPaintInfo = record Position: TColumnPosition; // the column position of the node CellRect: TRect; // the node cell ContentRect: TRect; // the area of the cell used for the node's content - NodeWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; // the actual node width + NodeWidth: TDimension; // the actual node width Alignment: TAlignment; // how to align within the node rectangle CaptionAlignment: TAlignment; // how to align text within the caption rectangle BidiMode: TBidiMode; // directionality to be used for painting BrushOrigin: TPoint; // the alignment for the brush used to draw dotted lines ImageInfo: array[TVTImageInfoIndex] of TVTImageInfo; // info about each possible node image Offsets: TVTOffsets; - procedure AdjustImageCoordinates(VAlign: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); + procedure AdjustImageCoordinates(VAlign: TDimension); end; // Method called by the Animate routine for each animation step. @@ -2233,7 +2031,7 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF FHeader: TVTHeader; FRoot: PVirtualNode; FDefaultNodeHeight, - FIndent: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; + FIndent: TDimension; FOptions: TCustomVirtualTreeOptions; FUpdateCount: Cardinal; // update stopper, updates of the tree control are only done if = 0 FSynchUpdateCount: Cardinal; // synchronizer, causes all events which are usually done via timers @@ -2287,10 +2085,10 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF FBackgroundImageTransparent: Boolean; // By default, this is off. When switched on, will try to draw the image // transparent by using the color of the component as transparent color - FMargin: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; // horizontal distance to border and columns - FTextMargin: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; // space between the node's text and its horizontal bounds + FMargin: TDimension; // horizontal distance to border and columns + FTextMargin: TDimension; // space between the node's text and its horizontal bounds FBackgroundOffsetX, - FBackgroundOffsetY: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; // used to fine tune the position of the background image + FBackgroundOffsetY: TDimension; // used to fine tune the position of the background image FAnimationDuration: Cardinal; // specifies how long an animation shall take (expanding, hint) FWantTabs: Boolean; // If True then the tree also consumes the tab key. FNodeAlignment: TVTNodeAlignment; // determines how to interpret the align member of a node @@ -2312,7 +2110,7 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF FCheckImageKind: TCheckImageKind; // light or dark, cross marks or tick marks FCheckImages: TCustomImageList; // Reference to global image list to be used for the check images. //TODO: Use this margin for other images as well - FImagesMargin: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; // The margin used left and right of the checkboxes. + FImagesMargin: TDimension; // The margin used left and right of the checkboxes. FImageChangeLink, FStateChangeLink, FCustomCheckChangeLink: TChangeLink; // connections to the image lists @@ -2358,12 +2156,12 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF FAutoScrollDelay: Cardinal; // amount of milliseconds to wait until autoscrolling becomes active FAutoExpandDelay: Cardinal; // amount of milliseconds to wait until a node is expanded if it is the // drop target - FOffsetX: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; - FOffsetY: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; // Determines left and top scroll offset. - FEffectiveOffsetX: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; // Actual position of the horizontal scroll bar (varies depending on bidi mode). + FOffsetX: TDimension; + FOffsetY: TDimension; // Determines left and top scroll offset. + FEffectiveOffsetX: TDimension; // Actual position of the horizontal scroll bar (varies depending on bidi mode). FRangeX, - FRangeY: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; // current virtual width and height of the tree - FBottomSpace: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; // Extra space below the last node. + FRangeY: TDimension; // current virtual width and height of the tree + FBottomSpace: TDimension; // Extra space below the last node. FDefaultPasteMode: TVTNodeAttachMode; // Used to determine where to add pasted nodes to. FSingletonNodeArray: TNodeArray; // Contains only one element for quick addition of single nodes @@ -2580,20 +2378,20 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF procedure CMParentDoubleBufferedChange(var Message: TMessage); message CM_PARENTDOUBLEBUFFEREDCHANGED; {$ENDIF} procedure AdjustTotalCount(Node: PVirtualNode; Value: Integer; relative: Boolean = False); - procedure AdjustTotalHeight(Node: PVirtualNode; Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; relative: Boolean = False); + procedure AdjustTotalHeight(Node: PVirtualNode; Value: TDimension; relative: Boolean = False); function CalculateCacheEntryCount: Integer; procedure CalculateVerticalAlignments(ShowImages, ShowStateImages: Boolean; Node: PVirtualNode; var VAlign, - VButtonAlign: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); + VButtonAlign: TDimension); function ChangeCheckState(Node: PVirtualNode; Value: TCheckState): Boolean; - function CollectSelectedNodesLTR(MainColumn: Integer; NodeLeft, NodeRight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; Alignment: TAlignment; OldRect, - NewRect: TRectF): Boolean; - function CollectSelectedNodesRTL(MainColumn: Integer; NodeLeft, NodeRight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; Alignment: TAlignment; OldRect, + function CollectSelectedNodesLTR(MainColumn: Integer; NodeLeft, NodeRight: TDimension; Alignment: TAlignment; OldRect, + NewRect: TRect): Boolean; + function CollectSelectedNodesRTL(MainColumn: Integer; NodeLeft, NodeRight: TDimension; Alignment: TAlignment; OldRect, NewRect: TRect): Boolean; procedure ClearNodeBackground(const PaintInfo: TVTPaintInfo; UseBackground, Floating: Boolean; R: TRect); function CompareNodePositions(Node1, Node2: PVirtualNode; ConsiderChildrenAbove: Boolean = False): Integer; procedure DrawLineImage(const PaintInfo: TVTPaintInfo; X, Y, H, VAlign: Integer; Style: TVTLineType; Reverse: Boolean); - function FindInPositionCache(Node: PVirtualNode; var CurrentPos: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}): PVirtualNode; overload; - function FindInPositionCache(Position: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; var CurrentPos: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}): PVirtualNode; overload; + function FindInPositionCache(Node: PVirtualNode; var CurrentPos: TDimension): PVirtualNode; overload; + function FindInPositionCache(Position: TDimension; var CurrentPos: TDimension): PVirtualNode; overload; procedure FixupTotalCount(Node: PVirtualNode); procedure FixupTotalHeight(Node: PVirtualNode); function GetBottomNode: PVirtualNode; @@ -2612,7 +2410,7 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF function GetFullyVisible(Node: PVirtualNode): Boolean; function GetHasChildren(Node: PVirtualNode): Boolean; function GetMultiline(Node: PVirtualNode): Boolean; - function GetNodeHeight(Node: PVirtualNode): {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; + function GetNodeHeight(Node: PVirtualNode): TDimension; function GetNodeParent(Node: PVirtualNode): PVirtualNode; function GetOffsetXY: TPoint; function GetRootNodeCount: Cardinal; @@ -2622,7 +2420,7 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF function GetVerticalAlignment(Node: PVirtualNode): Byte; function GetVisible(Node: PVirtualNode): Boolean; function GetVisiblePath(Node: PVirtualNode): Boolean; - function HandleDrawSelection(X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}): Boolean; + function HandleDrawSelection(X, Y: TDimension): Boolean; function HasVisibleNextSibling(Node: PVirtualNode): Boolean; function HasVisiblePreviousSibling(Node: PVirtualNode): Boolean; procedure ImageListChange(Sender: TObject); @@ -2638,10 +2436,10 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF procedure SetAnimationDuration(const Value: Cardinal); procedure SetBackground(const Value: {$IFDEF VT_FMX}TImage{$ELSE}TPicture{$ENDIF}); procedure SetBackGroundImageTransparent(const Value: Boolean); - procedure SetBackgroundOffset(const Index: Integer; const Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); + procedure SetBackgroundOffset(const Index: Integer; const Value: TDimension); procedure SetBorderStyle(Value: TBorderStyle); procedure SetBottomNode(Node: PVirtualNode); - procedure SetBottomSpace(const Value: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}); + procedure SetBottomSpace(const Value: TDimension); procedure SetButtonFillMode(const Value: TVTButtonFillMode); procedure SetButtonStyle(const Value: TVTButtonStyle); procedure SetCheckImageKind(Value: TCheckImageKind); @@ -2650,7 +2448,7 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF procedure SetClipboardFormats(const Value: TClipboardFormats); procedure SetColors(const Value: TVTColors); procedure SetCustomCheckImages(const Value: TCustomImageList); - procedure SetDefaultNodeHeight(Value: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}); + procedure SetDefaultNodeHeight(Value: TDimension); procedure SetDisabled(Node: PVirtualNode; Value: Boolean); procedure SetEmptyListMessage(const Value: string); procedure SetExpanded(Node: PVirtualNode; Value: Boolean); @@ -2662,18 +2460,18 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF procedure SetHotNode(Value: PVirtualNode); procedure SetFiltered(Node: PVirtualNode; Value: Boolean); procedure SetImages(const Value: TCustomImageList); - procedure SetIndent(Value: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}); + procedure SetIndent(Value: TDimension); procedure SetLineMode(const Value: TVTLineMode); procedure SetLineStyle(const Value: TVTLineStyle); - procedure SetMargin(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); + procedure SetMargin(Value: TDimension); procedure SetMultiline(Node: PVirtualNode; const Value: Boolean); procedure SetNodeAlignment(const Value: TVTNodeAlignment); procedure SetNodeDataSize(Value: Integer); - procedure SetNodeHeight(Node: PVirtualNode; Value: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}); + procedure SetNodeHeight(Node: PVirtualNode; Value: TDimension); procedure SetNodeParent(Node: PVirtualNode; const Value: PVirtualNode); - procedure SetOffsetX(const Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); + procedure SetOffsetX(const Value: TDimension); procedure SetOffsetXY(const Value: TPoint); - procedure SetOffsetY(const Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); + procedure SetOffsetY(const Value: TDimension); procedure SetOptions(const Value: TCustomVirtualTreeOptions); procedure SetRootNodeCount(Value: Cardinal); procedure SetScrollBarOptions(Value: TScrollBarOptions); @@ -2681,13 +2479,13 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF procedure SetSelected(Node: PVirtualNode; Value: Boolean); procedure SetSelectionCurveRadius(const Value: Cardinal); procedure SetStateImages(const Value: TCustomImageList); - procedure SetTextMargin(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); + procedure SetTextMargin(Value: TDimension); procedure SetTopNode(Node: PVirtualNode); procedure SetUpdateState(Updating: Boolean); procedure SetVerticalAlignment(Node: PVirtualNode; Value: Byte); procedure SetVisible(Node: PVirtualNode; Value: Boolean); procedure SetVisiblePath(Node: PVirtualNode; Value: Boolean); - procedure PrepareBackGroundPicture(Source: {$IFDEF VT_FMX}TImage{$ELSE}TPicture{$ENDIF}; DrawBitmap: TBitmap; DrawBitmapWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; DrawBitMapHeight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; ABkgcolor: TColor); + procedure PrepareBackGroundPicture(Source: {$IFDEF VT_FMX}TImage{$ELSE}TPicture{$ENDIF}; DrawBitmap: TBitmap; DrawBitmapWidth: TDimension; DrawBitMapHeight: TDimension; ABkgcolor: TColor); procedure StaticBackground(Source: {$IFDEF VT_FMX}TImage{$ELSE}TPicture{$ENDIF}; Target: TCanvas; OffsetPosition: TPoint; R: TRect; aBkgColor: TColor); procedure StopTimer(ID: Integer); procedure SetWindowTheme(const Theme: string); @@ -2751,7 +2549,7 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF procedure WMThemeChanged(var Message: TMessage); message WM_THEMECHANGED; procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL; {$ENDIF} - function GetRangeX: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; + function GetRangeX: TDimension; function GetDoubleBuffered: Boolean; procedure SetDoubleBuffered(const Value: Boolean); {$IFDEF VT_FMX} @@ -2762,6 +2560,7 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF protected FFontChanged: Boolean; // flag for keeping informed about font changes in the off screen buffer // [IPK] - private to protected + dummyCanvas: TCanvas; // for painting using native handle {$IFDEF VT_FMX} FUseRightToLeftAlignment: Boolean; procedure SetBevelCut(Index: Integer; const Value: TBevelCut); @@ -2775,11 +2574,11 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF procedure AddToSelection(Node: PVirtualNode); overload; virtual; procedure AddToSelection(const NewItems: TNodeArray; NewLength: Integer; ForceInsert: Boolean = False); overload; virtual; procedure AdjustPaintCellRect(var PaintInfo: TVTPaintInfo; var NextNonEmpty: TColumnIndex); virtual; - procedure AdjustPanningCursor(X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); virtual; + procedure AdjustPanningCursor(X, Y: TDimension); virtual; procedure AdviseChangeEvent(StructureChange: Boolean; Node: PVirtualNode; Reason: TChangeReason); virtual; function AllocateInternalDataArea(Size: Cardinal): Cardinal; virtual; procedure Animate(Steps, Duration: Cardinal; Callback: TVTAnimationCallback; Data: Pointer); virtual; - function CalculateSelectionRect(X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}): Boolean; virtual; + function CalculateSelectionRect(X, Y: TDimension): Boolean; virtual; function CanAutoScroll: Boolean; virtual; function CanShowDragImage: Boolean; virtual; function CanSplitterResizeNode(P: TPoint; Node: PVirtualNode; Column: TColumnIndex): Boolean; @@ -2790,7 +2589,7 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF procedure ClearSelection(pFireChangeEvent: Boolean); overload; virtual; procedure ClearTempCache; virtual; function ColumnIsEmpty(Node: PVirtualNode; Column: TColumnIndex): Boolean; virtual; - function ComputeRTLOffset(ExcludeScrollBar: Boolean = False): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; virtual; + function ComputeRTLOffset(ExcludeScrollBar: Boolean = False): TDimension; virtual; function CountLevelDifference(Node1, Node2: PVirtualNode): Integer; virtual; function CountVisibleChildren(Node: PVirtualNode): Cardinal; virtual; {$IFDEF VT_VCL} @@ -2802,17 +2601,17 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF function DetermineDropMode(const P: TPoint; var HitInfo: THitInfo; var NodeRect: TRect): TDropMode; virtual; procedure DetermineHiddenChildrenFlag(Node: PVirtualNode); virtual; procedure DetermineHiddenChildrenFlagAllNodes; virtual; - procedure DetermineHitPositionLTR(var HitInfo: THitInfo; Offset, Right: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; Alignment: TAlignment); virtual; - procedure DetermineHitPositionRTL(var HitInfo: THitInfo; Offset, Right: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; Alignment: TAlignment); virtual; + procedure DetermineHitPositionLTR(var HitInfo: THitInfo; Offset, Right: TDimension; Alignment: TAlignment); virtual; + procedure DetermineHitPositionRTL(var HitInfo: THitInfo; Offset, Right: TDimension; Alignment: TAlignment); virtual; function DetermineLineImageAndSelectLevel(Node: PVirtualNode; var LineImage: TLineImage): Integer; virtual; function DetermineNextCheckState(CheckType: TCheckType; CheckState: TCheckState): TCheckState; virtual; - function DetermineScrollDirections(X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}): TScrollDirections; virtual; + function DetermineScrollDirections(X, Y: TDimension): TScrollDirections; virtual; procedure DoAdvancedHeaderDraw(var PaintInfo: THeaderPaintInfo; const Elements: THeaderPaintElements); virtual; procedure DoAfterCellPaint(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; CellRect: TRect); virtual; procedure DoAfterItemErase(Canvas: TCanvas; Node: PVirtualNode; ItemRect: TRect); virtual; procedure DoAfterItemPaint(Canvas: TCanvas; Node: PVirtualNode; ItemRect: TRect); virtual; procedure DoAfterPaint(Canvas: TCanvas); virtual; - procedure DoAutoScroll(X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); virtual; + procedure DoAutoScroll(X, Y: TDimension); virtual; function DoBeforeDrag(Node: PVirtualNode; Column: TColumnIndex): Boolean; virtual; procedure DoBeforeCellPaint(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect); virtual; @@ -2874,8 +2673,8 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF procedure DoGetLineStyle(var Bits: Pointer); virtual; function DoGetNodeHint(Node: PVirtualNode; Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle): string; virtual; function DoGetNodeTooltip(Node: PVirtualNode; Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle): string; virtual; - function DoGetNodeExtraWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; virtual; - function DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; virtual; + function DoGetNodeExtraWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): TDimension; virtual; + function DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): TDimension; virtual; function DoGetPopupMenu(Node: PVirtualNode; Column: TColumnIndex; Position: TPoint): TPopupMenu; virtual; {$IFDEF VT_VCL} procedure DoGetUserClipboardFormats(var Formats: TFormatEtcArray); virtual; @@ -2898,7 +2697,7 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF procedure DoInitNode(Parent, Node: PVirtualNode; var InitStates: TVirtualNodeInitStates); virtual; 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: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); virtual; + procedure DoMeasureItem(TargetCanvas: TCanvas; Node: PVirtualNode; var NodeHeight: TDimension); virtual; procedure DoMouseEnter(); virtual; procedure DoMouseLeave(); virtual; procedure DoNodeCopied(Node: PVirtualNode); virtual; @@ -2922,7 +2721,7 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF {$ENDIF} procedure DoReset(Node: PVirtualNode); virtual; procedure DoSaveUserData(Node: PVirtualNode; Stream: TStream); virtual; - procedure DoScroll(DeltaX, DeltaY: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); virtual; + procedure DoScroll(DeltaX, DeltaY: TDimension); virtual; function DoSetOffsetXY(Value: TPoint; Options: TScrollUpdateOptions; ClipRect: PRect = nil): Boolean; virtual; procedure DoShowScrollBar(Bar: Integer; Show: Boolean); virtual; procedure DoStartDrag(var DragObject: TDragObject); {$IFDEF VT_FMX}virtual{$ELSE}override{$ENDIF}; @@ -2941,8 +2740,8 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF procedure DragLeave; virtual; function DragOver(Source: TObject; KeyState: Integer; DragState: TDragState; Pt: TPoint; var Effect: Integer): HResult; reintroduce; virtual; - procedure DrawDottedHLine(const PaintInfo: TVTPaintInfo; Left, Right, Top: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); virtual; - procedure DrawDottedVLine(const PaintInfo: TVTPaintInfo; Top, Bottom, Left: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; UseSelectedBkColor: Boolean = False); virtual; + procedure DrawDottedHLine(const PaintInfo: TVTPaintInfo; Left, Right, Top: TDimension); virtual; + procedure DrawDottedVLine(const PaintInfo: TVTPaintInfo; Top, Bottom, Left: TDimension; UseSelectedBkColor: Boolean = False); virtual; procedure EndOperation(OperationKind: TVTOperationKind); procedure EnsureNodeFocused(); virtual; function FindNodeInSelection(P: PVirtualNode; var Index: Integer; LowBound, HighBound: Integer): Boolean; virtual; @@ -2961,14 +2760,14 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF procedure GetImageIndex(var Info: TVTPaintInfo; Kind: TVTImageKind; InfoIndex: TVTImageInfoIndex); virtual; function GetImageSize(Node: PVirtualNode; Kind: TVTImageKind = TVTImageKind.ikNormal; Column: TColumnIndex = 0; IncludePadding: Boolean = True): TSize; virtual; function GetNodeImageSize(Node: PVirtualNode): TSize; virtual; deprecated 'Use GetImageSize instead'; - function GetMaxRightExtend: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; virtual; + function GetMaxRightExtend: TDimension; virtual; {$IFDEF VT_VCL} procedure GetNativeClipboardFormats(var Formats: TFormatEtcArray); virtual; {$ENDIF} function GetOperationCanceled: Boolean; function GetOptionsClass: TTreeOptionsClass; virtual; function GetTreeFromDataObject(const DataObject: {$IFDEF VT_FMX}TDragObject{$ELSE}IDataObject{$ENDIF}): TBaseVirtualTree; virtual; - procedure HandleHotTrack(X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); virtual; + procedure HandleHotTrack(X, Y: TDimension); virtual; procedure HandleIncrementalSearch(CharCode: Word); virtual; {$IFDEF VT_FMX} procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Single; Y: Single); override; @@ -3004,14 +2803,14 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF procedure PaintCheckImage(Canvas: TCanvas; const ImageInfo: TVTImageInfo; Selected: Boolean); virtual; procedure PaintImage(var PaintInfo: TVTPaintInfo; ImageInfoIndex: TVTImageInfoIndex; DoOverlay: Boolean); virtual; procedure PaintNodeButton(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const R: TRect; ButtonX, - ButtonY: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; BidiMode: TBiDiMode); virtual; - procedure PaintTreeLines(const PaintInfo: TVTPaintInfo; VAlignment, IndentSize: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; const LineImage: TLineImage); virtual; - procedure PaintSelectionRectangle(Target: TCanvas; WindowOrgX: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; const SelectionRect: TRect; + ButtonY: TDimension; BidiMode: TBiDiMode); virtual; + procedure PaintTreeLines(const PaintInfo: TVTPaintInfo; VAlignment, IndentSize: TDimension; const LineImage: TLineImage); virtual; + procedure PaintSelectionRectangle(Target: TCanvas; WindowOrgX: TDimension; const SelectionRect: TRect; TargetRect: TRect); virtual; {$IFDEF VT_VCL} procedure PanningWindowProc(var Message: TMessage); virtual; {$ENDIF} - procedure PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX, MaxWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); virtual; + procedure PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX, MaxWidth: TDimension); virtual; function ReadChunk(Stream: TStream; Version: Integer; Node: PVirtualNode; ChunkType, ChunkSize: Integer): Boolean; virtual; procedure ReadNode(Stream: TStream; Version: Integer; Node: PVirtualNode); virtual; @@ -3026,7 +2825,7 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF procedure SelectNodes(StartNode, EndNode: PVirtualNode; AddOnly: Boolean); virtual; procedure SetChildCount(Node: PVirtualNode; NewChildCount: Cardinal); virtual; procedure SetFocusedNodeAndColumn(Node: PVirtualNode; Column: TColumnIndex); virtual; - procedure SetRangeX(value: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}); + procedure SetRangeX(value: TDimension); procedure SkipNode(Stream: TStream); virtual; procedure StartOperation(OperationKind: TVTOperationKind); procedure StartWheelPanning(Position: TPoint); virtual; @@ -3064,10 +2863,10 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF property AutoScrollInterval: TAutoScrollInterval read FAutoScrollInterval write FAutoScrollInterval default 1; property Background: {$IFDEF VT_FMX}TImage{$ELSE}TPicture{$ENDIF} read FBackground write SetBackground; property BackGroundImageTransparent: Boolean read FBackGroundImageTransparent write SetBackGroundImageTransparent default False; - property BackgroundOffsetX: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} index 0 read FBackgroundOffsetX write SetBackgroundOffset{$IFDEF VT_VCL} default 0{$ENDIF}; - property BackgroundOffsetY: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} index 1 read FBackgroundOffsetY write SetBackgroundOffset{$IFDEF VT_VCL} default 0{$ENDIF}; - property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle; - property BottomSpace: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF} read FBottomSpace write SetBottomSpace{$IFDEF VT_VCL} default 0{$ENDIF}; + property BackgroundOffsetX: TDimension index 0 read FBackgroundOffsetX write SetBackgroundOffset{$IFDEF VT_VCL} default 0{$ENDIF}; + property BackgroundOffsetY: TDimension index 1 read FBackgroundOffsetY write SetBackgroundOffset{$IFDEF VT_VCL} default 0{$ENDIF}; + property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default TFormBorderStyle.bsSingle; + property BottomSpace: TDimension read FBottomSpace write SetBottomSpace{$IFDEF VT_VCL} default 0{$ENDIF}; property ButtonFillMode: TVTButtonFillMode read FButtonFillMode write SetButtonFillMode default fmTreeColor; property ButtonStyle: TVTButtonStyle read FButtonStyle write SetButtonStyle default bsRectangle; property ChangeDelay: Cardinal read FChangeDelay write FChangeDelay default 0; @@ -3076,7 +2875,7 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF property Colors: TVTColors read FColors write SetColors; property CustomCheckImages: TCustomImageList read FCustomCheckImages write SetCustomCheckImages; property DefaultHintKind: TVTHintKind read GetDefaultHintKind; - property DefaultNodeHeight: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF} read FDefaultNodeHeight write SetDefaultNodeHeight{$IFDEF VT_VCL} default 18{$ENDIF}; + property DefaultNodeHeight: TDimension read FDefaultNodeHeight write SetDefaultNodeHeight{$IFDEF VT_VCL} default 18{$ENDIF}; property DefaultPasteMode: TVTNodeAttachMode read FDefaultPasteMode write FDefaultPasteMode default amAddChildLast; property DragHeight: Integer read FDragHeight write FDragHeight default 350; property DragImageKind: TVTDragImageKind read FDragImageKind write FDragImageKind default diComplete; @@ -3089,7 +2888,7 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF default smDottedRectangle; property EditColumn: TColumnIndex read FEditColumn write FEditColumn; property EditDelay: Cardinal read FEditDelay write FEditDelay default 1000; - property EffectiveOffsetX: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} read FEffectiveOffsetX; + property EffectiveOffsetX: TDimension read FEffectiveOffsetX; property HeaderRect: TRect read FHeaderRect; property HintMode: TVTHintMode read FHintMode write FHintMode default hmDefault; property HintData: TVTHintData read FHintData write FHintData; @@ -3099,13 +2898,13 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF property IncrementalSearchDirection: TVTSearchDirection read FSearchDirection write FSearchDirection default sdForward; property IncrementalSearchStart: TVTSearchStart read FSearchStart write FSearchStart default ssFocusedNode; property IncrementalSearchTimeout: Cardinal read FSearchTimeout write FSearchTimeout default 1000; - property Indent: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF} read FIndent write SetIndent{$IFDEF VT_VCL} default 18{$ENDIF}; + property Indent: TDimension read FIndent write SetIndent{$IFDEF VT_VCL} default 18{$ENDIF}; property LastClickPos: TPoint read FLastClickPos write FLastClickPos; property LastDropMode: TDropMode read FLastDropMode write FLastDropMode; property LastHintRect: TRect read FLastHintRect write FLastHintRect; property LineMode: TVTLineMode read FLineMode write SetLineMode default lmNormal; property LineStyle: TVTLineStyle read FLineStyle write SetLineStyle default lsDotted; - property Margin: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} read FMargin write SetMargin{$IFDEF VT_VCL} default 4{$ENDIF}; + property Margin: TDimension read FMargin write SetMargin{$IFDEF VT_VCL} default 4{$ENDIF}; property NextNodeToSelect: PVirtualNode read FNextNodeToSelect; // Next tree node that we would like to select if the current one gets deleted property NodeAlignment: TVTNodeAlignment read FNodeAlignment write SetNodeAlignment default naProportional; property NodeDataSize: Integer read FNodeDataSize write SetNodeDataSize default -1; @@ -3114,14 +2913,14 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF property HotPlusBM: TBitmap read FHotPlusBM; property MinusBM: TBitmap read FMinusBM; property PlusBM: TBitmap read FPlusBM; - property RangeX: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF} read GetRangeX;// Returns the width of the virtual tree in pixels, (not ClientWidth). If there are columns it returns the total width of all of them; otherwise it returns the maximum of the all the line's data widths. - property RangeY: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF} read FRangeY; + property RangeX: TDimension read GetRangeX;// Returns the width of the virtual tree in pixels, (not ClientWidth). If there are columns it returns the total width of all of them; otherwise it returns the maximum of the all the line's data widths. + property RangeY: TDimension read FRangeY; property RootNodeCount: Cardinal read GetRootNodeCount write SetRootNodeCount default 0; property ScrollBarOptions: TScrollBarOptions read FScrollBarOptions write SetScrollBarOptions; property SelectionBlendFactor: Byte read FSelectionBlendFactor write FSelectionBlendFactor default 128; property SelectionCurveRadius: Cardinal read FSelectionCurveRadius write SetSelectionCurveRadius default 0; property StateImages: TCustomImageList read FStateImages write SetStateImages; - property TextMargin: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} read FTextMargin write SetTextMargin{$IFDEF VT_VCL} default 4{$ENDIF}; + property TextMargin: TDimension read FTextMargin write SetTextMargin{$IFDEF VT_VCL} default 4{$ENDIF}; property TreeOptions: TCustomVirtualTreeOptions read FOptions write SetOptions; property WantTabs: Boolean read FWantTabs write FWantTabs default False; property SyncCheckstateWithSelection[Node: PVirtualNode]: Boolean read GetSyncCheckstateWithSelection; @@ -3326,7 +3125,7 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF function GetFirstVisibleChildNoInit(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode; function GetFirstVisibleNoInit(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = True; IncludeFiltered: Boolean = False): PVirtualNode; - procedure GetHitTestInfoAt(X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; Relative: Boolean; var HitInfo: THitInfo); virtual; + procedure GetHitTestInfoAt(X, Y: TDimension; Relative: Boolean; var HitInfo: THitInfo); virtual; function GetLast(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = False): PVirtualNode; function GetLastInitialized(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = False): PVirtualNode; function GetLastNoInit(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = False): PVirtualNode; @@ -3338,7 +3137,7 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF function GetLastVisibleChildNoInit(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode; function GetLastVisibleNoInit(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = True; IncludeFiltered: Boolean = False): PVirtualNode; - function GetMaxColumnWidth(Column: TColumnIndex; UseSmartColumnWidth: Boolean = False): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; virtual; + function GetMaxColumnWidth(Column: TColumnIndex; UseSmartColumnWidth: Boolean = False): TDimension; virtual; function GetNext(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; function GetNextChecked(Node: PVirtualNode; State: TCheckState = csCheckedNormal; ConsiderChildrenAbove: Boolean = False): PVirtualNode; overload; @@ -3356,8 +3155,8 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF function GetNextVisibleSibling(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode; function GetNextVisibleSiblingNoInit(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode; function GetNodeAt(const P: TPoint): PVirtualNode; overload; inline; - function GetNodeAt(X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}): PVirtualNode; overload; - function GetNodeAt(X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; Relative: Boolean; var NodeTop: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}): PVirtualNode; overload; + function GetNodeAt(X, Y: TDimension): PVirtualNode; overload; + function GetNodeAt(X, Y: TDimension; Relative: Boolean; var NodeTop: TDimension): PVirtualNode; overload; function GetNodeData(Node: PVirtualNode): Pointer; overload; function GetNodeData(pNode: PVirtualNode): T; overload; inline; function GetSelectedData(): TArray; overload; @@ -3366,7 +3165,7 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF function GetFirstSelectedNodeData(): T; function GetNodeLevel(Node: PVirtualNode): Cardinal; function GetNodeLevelForSelectConstraint(Node: PVirtualNode): integer; - function GetOffset(pElement: TVTElement; pNode: PVirtualNode): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + function GetOffset(pElement: TVTElement; pNode: PVirtualNode): TDimension; procedure GetOffsets(pNode: PVirtualNode; out pOffsets: TVTOffsets; pElement: TVTElement = TVTElement.ofsEndOfClientArea; pColumn: Integer = NoColumn); function GetPrevious(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; function GetPreviousChecked(Node: PVirtualNode; State: TCheckState = csCheckedNormal; @@ -3425,7 +3224,7 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF procedure ResetNode(Node: PVirtualNode); virtual; procedure SaveToFile(const FileName: TFileName); procedure SaveToStream(Stream: TStream; Node: PVirtualNode = nil); virtual; - function ScaledPixels(pPixels: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + function ScaledPixels(pPixels: TDimension): TDimension; function ScrollIntoView(Node: PVirtualNode; Center: Boolean; Horizontally: Boolean = False): Boolean; overload; function ScrollIntoView(Column: TColumnIndex; Center: Boolean; Node: PVirtualNode = nil): Boolean; overload; procedure SelectAll(VisibleOnly: Boolean); @@ -3496,11 +3295,11 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF property IsFiltered[Node: PVirtualNode]: Boolean read GetFiltered write SetFiltered; property IsVisible[Node: PVirtualNode]: Boolean read GetVisible write SetVisible; property MultiLine[Node: PVirtualNode]: Boolean read GetMultiline write SetMultiline; - property NodeHeight[Node: PVirtualNode]: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF} read GetNodeHeight write SetNodeHeight; + property NodeHeight[Node: PVirtualNode]: TDimension read GetNodeHeight write SetNodeHeight; property NodeParent[Node: PVirtualNode]: PVirtualNode read GetNodeParent write SetNodeParent; - property OffsetX: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} read FOffsetX write SetOffsetX; + property OffsetX: TDimension read FOffsetX write SetOffsetX; property OffsetXY: TPoint read GetOffsetXY write SetOffsetXY; - property OffsetY: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} read FOffsetY write SetOffsetY; + property OffsetY: TDimension read FOffsetY write SetOffsetY; property OperationCount: Cardinal read FOperationCount; property RootNode: PVirtualNode read FRoot; property SearchBuffer: string read FSearchBuffer; @@ -3519,19 +3318,17 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF 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 [beLeft, beTop, beRight, beBottom]; - property BevelInner: TBevelCut index 0 read FBevelInner write SetBevelCut default bvRaised; - property BevelOuter: TBevelCut index 1 read FBevelOuter write SetBevelCut default bvLowered; - property BevelKind: TBevelKind read FBevelKind write SetBevelKind default bkNone; + 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; procedure Invalidate(); -{$IFDEF VT_FMX} function ClientToScreen(P: TPoint): TPoint; function ScreenToClient(P: TPoint): TPoint; procedure RecreateWnd; -{$ENDIF} {$ENDIF} end; @@ -3737,23 +3534,23 @@ TCustomVirtualStringTree = class(TBaseVirtualTree) procedure PaintStaticText(const PaintInfo: TVTPaintInfo; TextOutFlags: Integer; const Text: string); virtual; // [IPK] - private to protected procedure AdjustPaintCellRect(var PaintInfo: TVTPaintInfo; var NextNonEmpty: TColumnIndex); override; function CanExportNode(Node: PVirtualNode): Boolean; - function CalculateStaticTextWidth(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const Text: string): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; virtual; - function CalculateTextWidth(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const Text: string): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; virtual; + function CalculateStaticTextWidth(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const Text: string): TDimension; virtual; + function CalculateTextWidth(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const Text: string): TDimension; virtual; function ColumnIsEmpty(Node: PVirtualNode; Column: TColumnIndex): Boolean; override; procedure DefineProperties(Filer: TFiler); override; function DoCreateEditor(Node: PVirtualNode; Column: TColumnIndex): IVTEditLink; override; function DoGetNodeHint(Node: PVirtualNode; Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle): string; override; function DoGetNodeTooltip(Node: PVirtualNode; Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle): string; override; - function DoGetNodeExtraWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; override; - function DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; override; + function DoGetNodeExtraWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): TDimension; override; + function DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): TDimension; override; procedure DoGetText(var pEventArgs: TVSTGetCellTextEventArgs); virtual; function DoIncrementalSearch(Node: PVirtualNode; const Text: string): Integer; override; procedure DoNewText(Node: PVirtualNode; Column: TColumnIndex; const Text: string); virtual; procedure DoPaintNode(var PaintInfo: TVTPaintInfo); override; procedure DoPaintText(Node: PVirtualNode; const Canvas: TCanvas; Column: TColumnIndex; TextType: TVSTTextType); virtual; - function DoShortenString(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const S: string; Width: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; - EllipsisWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} = 0): string; virtual; + function DoShortenString(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const S: string; Width: TDimension; + EllipsisWidth: TDimension = 0): string; virtual; procedure DoTextDrawing(var PaintInfo: TVTPaintInfo; const Text: string; CellRect: TRect; DrawFormat: Cardinal); virtual; function DoTextMeasuring(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const Text: string): TSize; virtual; function GetOptionsClass: TTreeOptionsClass; override; @@ -3787,7 +3584,7 @@ TCustomVirtualStringTree = class(TBaseVirtualTree) constructor Create(AOwner: TComponent); override; destructor Destroy(); override; function AddChild(Parent: PVirtualNode; UserData: Pointer = nil): PVirtualNode; override; - function ComputeNodeHeight(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; S: string = ''): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; virtual; + function ComputeNodeHeight(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; S: string = ''): TDimension; virtual; function ContentToClipboard(Format: Word; Source: TVSTTextSourceType): HGLOBAL; procedure ContentToCustom(Source: TVSTTextSourceType); function ContentToHTML(Source: TVSTTextSourceType; const Caption: string = ''): String; @@ -4104,7 +3901,7 @@ TCustomVirtualDrawTree = class(TBaseVirtualTree) protected function DoGetCellContentMargin(Node: PVirtualNode; Column: TColumnIndex; CellContentMarginType: TVTCellContentMarginType = ccmtAllSides; Canvas: TCanvas = nil): TPoint; override; - function DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; override; + function DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): TDimension; override; procedure DoPaintNode(var PaintInfo: TVTPaintInfo); override; function GetDefaultHintKind: TVTHintKind; override; @@ -4404,9 +4201,7 @@ implementation System.StrUtils, {$IFDEF VT_VCL} Vcl.GraphUtil, // accessibility helper class -{$ENDIF} - //VirtualTrees.AccessibilityFactory, -{$IFDEF VT_VCL} + VirtualTrees.AccessibilityFactory, VirtualTrees.StyleHooks, {$ENDIF} VirtualTrees.Classes, @@ -4458,145 +4253,12 @@ implementation tymed: TYMED_ISTREAM or TYMED_HGLOBAL; ); {$ENDIF} -{$IFDEF VT_FMX} -procedure GetTextMetrics(ACanvas: TCanvas; var TM: TTextMetric); -Var P: TPathData; - tx: TTextLayout; - R: TRectF; -begin -{ - tmHeight: Single; //The height (ascent + descent) of characters. - tmAscent: Single; //The ascent (units above the base line) of characters. - tmDescent: Single; //The descent (units below the base line) of characters. - tmInternalLeading: Single; //The amount of leading (space) inside the bounds set by the tmHeight member. Accent marks and other diacritical characters may occur in this area. The designer may set this member to zero - tmExternalLeading: Single; //The amount of extra leading (space) that the application adds between rows. Since this area is outside the font, it contains no marks and is not altered by text output calls in either OPAQUE or TRANSPARENT mode. The designer may set this member to zero. - tmAveCharWidth: Single; //The average width of characters in the font (generally defined as the width of the letter x ). This value does not include the overhang required for bold or italic characters. - tmMaxCharWidth: Single; //The width of the widest character in the font. - tmWeight: Single; //The weight of the font. - tmOverhang: Single; - tmDigitizedAspectX: Single; //The horizontal aspect of the device for which the font was designed. - tmDigitizedAspectY: Single; //The vertical aspect of the device for which the font was designed. The ratio of the tmDigitizedAspectX and tmDigitizedAspectY members is the aspect ratio of the device for which the font was designed. - tmFirstChar: WideChar; //The value of the first character defined in the font. - tmLastChar: WideChar; //The value of the last character defined in the font. - tmDefaultChar: WideChar; //The value of the character to be substituted for characters not in the font. - tmBreakChar: WideChar; //The value of the character that will be used to define word breaks for text justification. - tmItalic: Byte; //Specifies an italic font if it is nonzero. - tmUnderlined: Byte; //Specifies an underlined font if it is nonzero. - tmStruckOut: Byte; //A strikeout font if it is nonzero. - tmPitchAndFamily: Byte; //Specifies information about the pitch, the technology, and the family of a physical font. TMPF_FIXED_PITCH, TMPF_VECTOR, TMPF_TRUETYPE, TMPF_DEVICE - tmCharSet: Byte; //The character set of the font. The character set can be one of the following values. ANSI_CHARSET, GREEK_CHARSET.... -} - TM.tmExternalLeading:= 0; - TM.tmWeight:= 0; //boldness??? - TM.tmOverhang:= 0; - TM.tmDigitizedAspectX:= 0; - TM.tmDigitizedAspectY:= 0; - TM.tmFirstChar:= 'a'; //??? - TM.tmLastChar:= 'z'; //??? - TM.tmDefaultChar:= ' '; - TM.tmBreakChar:= ' '; - TM.tmItalic:= 0; - TM.tmUnderlined:= 0; - TM.tmStruckOut:= 0; - TM.tmPitchAndFamily:= 0; - TM.tmCharSet:= 0; - - tx:= TTextLayoutManager.DefaultTextLayout.Create(ACanvas); - P:= TPathData.Create; - try - tx.Text:= 'W'; - tx.ConvertToPath(p); - R:= P.GetBounds(); - - TM.tmHeight:= R.Height; - TM.tmMaxCharWidth:= R.Width; - - //------------------------------------ - tx.Text:= 'Ó'; - p.Clear; - tx.ConvertToPath(p); - R:= P.GetBounds(); - TM.tmInternalLeading:= R.Height - TM.tmHeight; - - //------------------------------------ - tx.Text:= 'x'; - p.Clear; - tx.ConvertToPath(p); - R:= P.GetBounds(); - TM.tmAscent:= R.Height - TM.tmHeight; - TM.tmAveCharWidth:= R.Width; - - //------------------------------------ - tx.Text:= 'y'; - p.Clear; - tx.ConvertToPath(p); - TM.tmDescent:= P.GetBounds().Height - R.Height; - TM.tmHeight:= TM.tmHeight + TM.tmDescent; - finally - FreeAndNil(P); - FreeAndNil(tx); - end; -end; - -function Rect(ALeft, ATop, ARight, ABottom: Single): TRect; -begin - Result:= RectF(ALeft, ATop, ARight, ABottom); -end; - -function Rect(const ATopLeft, ABottomRight: TPoint): TRect; -begin - Result:= RectF(ATopLeft.X, ATopLeft.Y, ABottomRight.X, ABottomRight.Y); -end; - -function Point(AX, AY: Single): TPoint; -begin - Result.X:= AX; - Result.Y:= AY; -end; - -procedure Inc(Var V: Single; OIle: Single=1.0); -begin - V:= V + OIle; -end; - -procedure Dec(Var V: Single; OIle: Single=1.0); -begin - V:= V - OIle; -end; - -function MulDiv(const A, B, C: Single): Single; -begin - Result:= (A * B) / C; -end; - -procedure FillMemory(Destination: Pointer; Length: NativeUInt; Fill: Byte); -begin - FillChar(Destination^, Length, Fill); -end; - -procedure ZeroMemory(Destination: Pointer; Length: NativeUInt); -begin - FillChar(Destination^, Length, 0); -end; - -procedure MoveMemory(Destination: Pointer; Source: Pointer; Length: NativeUInt); -begin - Move(Source^, Destination^, Length); -end; - -procedure CopyMemory(Destination: Pointer; Source: Pointer; Length: NativeUInt); -begin - Move(Source^, Destination^, Length); -end; - -{$ENDIF} - type // protection against TRect record method that cause problems with with-statements TWithSafeRect = record case Integer of - 0: (Left, Top, Right, Bottom: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); + 0: (Left, Top, Right, Bottom: TDimension); 1: (TopLeft, BottomRight: TPoint); end; @@ -4611,7 +4273,7 @@ TChunkHeader = record // base information about a node TBaseChunkBody = packed record ChildCount: Cardinal; - NodeHeight: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; + NodeHeight: TDimension; States: TVirtualNodeStates; Align: Byte; CheckState: TCheckState; @@ -6373,7 +6035,7 @@ procedure TVTDragImage.InternalShowDragImage(ScreenDC: HDC); else BlendMode := bmMasterAlpha; with FDragImage do - AlphaBlend(Canvas.Handle, FAlphaImage.Canvas.Handle, Rect(0, 0, Width, Height), Point(0, 0), BlendMode, + AlphaBlend(Canvas, FAlphaImage.Canvas, Rect(0, 0, Width, Height), Point(0, 0), BlendMode, FTransparency, FPostBlendBias); with FAlphaImage do @@ -6714,7 +6376,7 @@ procedure TVTDragImage.PrepareDrag(DragImage: TBitmap; ImagePosition, HotSpot: T with FDragImage do BitBlt(Canvas.Handle, 0, 0, Width, Height, DragImage.Canvas.Handle, 0, 0, SRCCOPY) else - AlphaBlend(DragImage.Canvas.Handle, FDragImage.Canvas.Handle, Rect(0, 0, Width, Height), Point(0, 0), + AlphaBlend(DragImage.Canvas, FDragImage.Canvas, Rect(0, 0, Width, Height), Point(0, 0), bmConstantAlpha, 255, FPreBlendBias); // Create a proper alpha channel also if no fading is required (transparent parts). @@ -7102,7 +6764,7 @@ function TVirtualTreeColumn.GetCaptionAlignment: TAlignment; //---------------------------------------------------------------------------------------------------------------------- -function TVirtualTreeColumn.GetLeft: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; +function TVirtualTreeColumn.GetLeft: TDimension; begin Result := FLeft; @@ -7265,7 +6927,7 @@ procedure TVirtualTreeColumn.SetLayout(Value: TVTHeaderColumnLayout); //---------------------------------------------------------------------------------------------------------------------- -procedure TVirtualTreeColumn.SetMargin(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); +procedure TVirtualTreeColumn.SetMargin(Value: TDimension); begin // Compatibility setting for -1. @@ -7280,7 +6942,7 @@ procedure TVirtualTreeColumn.SetMargin(Value: {$IFDEF VT_FMX}Single{$ELSE}Intege //---------------------------------------------------------------------------------------------------------------------- -procedure TVirtualTreeColumn.SetMaxWidth(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); +procedure TVirtualTreeColumn.SetMaxWidth(Value: TDimension); begin if Value < FMinWidth then @@ -7291,7 +6953,7 @@ procedure TVirtualTreeColumn.SetMaxWidth(Value: {$IFDEF VT_FMX}Single{$ELSE}Inte //---------------------------------------------------------------------------------------------------------------------- -procedure TVirtualTreeColumn.SetMinWidth(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); +procedure TVirtualTreeColumn.SetMinWidth(Value: TDimension); begin if Value < 0 then @@ -7404,7 +7066,7 @@ procedure TVirtualTreeColumn.SetPosition(Value: TColumnPosition); //---------------------------------------------------------------------------------------------------------------------- -procedure TVirtualTreeColumn.SetSpacing(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); +procedure TVirtualTreeColumn.SetSpacing(Value: TDimension); begin if FSpacing <> Value then @@ -7441,13 +7103,13 @@ procedure TVirtualTreeColumn.SetText(const Value: string); //---------------------------------------------------------------------------------------------------------------------- -procedure TVirtualTreeColumn.SetWidth(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); +procedure TVirtualTreeColumn.SetWidth(Value: TDimension); var EffectiveMaxWidth, EffectiveMinWidth, TotalFixedMaxWidth, - TotalFixedMinWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + TotalFixedMinWidth: TDimension; I: TColumnIndex; begin @@ -7505,8 +7167,8 @@ procedure TVirtualTreeColumn.SetWidth(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer //---------------------------------------------------------------------------------------------------------------------- -procedure TVirtualTreeColumn.ComputeHeaderLayout({$IFDEF VT_FMX}ACanvas: TCanvas{$ELSE}DC: HDC{$ENDIF}; Client: TRect; UseHeaderGlyph, UseSortGlyph: Boolean; - var HeaderGlyphPos, SortGlyphPos: TPoint; var SortGlyphSize: TSizeF; var TextBounds: TRect; DrawFormat: Cardinal; +procedure TVirtualTreeColumn.ComputeHeaderLayout(ACanvas: TCanvas; Client: TRect; UseHeaderGlyph, UseSortGlyph: Boolean; + var HeaderGlyphPos, SortGlyphPos: TPoint; var SortGlyphSize: TSize; var TextBounds: TRect; DrawFormat: Cardinal; CalculateTextRect: Boolean = False); // The layout of a column header is determined by a lot of factors. This method takes them all into account and @@ -7523,7 +7185,7 @@ procedure TVirtualTreeColumn.ComputeHeaderLayout({$IFDEF VT_FMX}ACanvas: TCanvas CurrentAlignment: TAlignment; MinLeft, MaxRight, - TextSpacing: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + TextSpacing: TDimension; UseText: Boolean; R: TRect; {$IFDEF VT_VCL} @@ -7563,7 +7225,7 @@ procedure TVirtualTreeColumn.ComputeHeaderLayout({$IFDEF VT_FMX}ACanvas: TCanvas begin R := Rect(0, 0, 100, 100); Theme := OpenThemeData(FHeader.Treeview.Handle, 'HEADER'); - GetThemePartSize(Theme, DC, HP_HEADERSORTARROW, HSAS_SORTEDUP, @R, TS_TRUE, SortGlyphSize); + GetThemePartSize(Theme, ACanvas.Handle, HP_HEADERSORTARROW, HSAS_SORTEDUP, @R, TS_TRUE, SortGlyphSize); CloseThemeData(Theme); end else @@ -7588,7 +7250,7 @@ procedure TVirtualTreeColumn.ComputeHeaderLayout({$IFDEF VT_FMX}ACanvas: TCanvas if not (coWrapCaption in FOptions) then begin FCaptionText := FText; - GetTextExtentPoint32W({$IFDEF VT_FMX}ACanvas{$ELSE}DC{$ENDIF}, {$IFDEF VT_VCL}PWideChar{$ENDIF}(FText), Length(FText), TextSize); + GetTextExtentPoint32W(ACanvas{$IFDEF VT_VCL}.Handle{$ENDIF}, {$IFDEF VT_VCL}PWideChar{$ENDIF}(FText), Length(FText), TextSize); Inc(TextSize.cx, 2); TextBounds := Rect(0, 0, TextSize.cx, TextSize.cy); end @@ -7596,9 +7258,9 @@ procedure TVirtualTreeColumn.ComputeHeaderLayout({$IFDEF VT_FMX}ACanvas: TCanvas begin R := Client; if FCaptionText = '' then - FCaptionText := WrapString({$IFDEF VT_FMX}ACanvas{$ELSE}DC{$ENDIF}, FText, R, {$IFDEF VT_FMX}false{$ELSE}DT_RTLREADING and DrawFormat <> 0{$ENDIF}, DrawFormat); + FCaptionText := WrapString(ACanvas, FText, R, {$IFDEF VT_FMX}false{$ELSE}DT_RTLREADING and DrawFormat <> 0{$ENDIF}, DrawFormat); - GetStringDrawRect({$IFDEF VT_FMX}ACanvas{$ELSE}DC{$ENDIF}, FCaptionText, R, DrawFormat); + GetStringDrawRect(ACanvas, FCaptionText, R, DrawFormat); TextSize.cx := Client.Right - Client.Left; TextSize.cy := R.Bottom - R.Top; TextBounds := Rect(0, 0, TextSize.cx, TextSize.cy); @@ -7840,8 +7502,8 @@ procedure TVirtualTreeColumn.ComputeHeaderLayout({$IFDEF VT_FMX}ACanvas: TCanvas begin // Wrap the column caption if necessary. R := TextBounds; - FCaptionText := WrapString({$IFDEF VT_FMX}ACanvas{$ELSE}DC{$ENDIF}, FText, R, {$IFDEF VT_FMX}false{$ELSE}DT_RTLREADING and DrawFormat <> 0{$ENDIF}, DrawFormat); - GetStringDrawRect({$IFDEF VT_FMX}ACanvas{$ELSE}DC{$ENDIF}, FCaptionText, R, DrawFormat); + FCaptionText := WrapString(ACanvas, FText, R, {$IFDEF VT_FMX}false{$ELSE}DT_RTLREADING and DrawFormat <> 0{$ENDIF}, DrawFormat); + GetStringDrawRect(ACanvas, FCaptionText, R, DrawFormat); end; end; end; @@ -7860,7 +7522,7 @@ procedure TVirtualTreeColumn.DefineProperties(Filer: TFiler); //---------------------------------------------------------------------------------------------------------------------- -procedure TVirtualTreeColumn.GetAbsoluteBounds(var Left, Right: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); +procedure TVirtualTreeColumn.GetAbsoluteBounds(var Left, Right: TDimension); // Returns the column's left and right bounds in header coordinates, that is, independant of the scrolling position. @@ -8303,7 +7965,7 @@ procedure TVirtualTreeColumns.AdjustAutoSize(CurrentIndex: TColumnIndex; Force: var AutoIndex, Index: Integer; - NewValue, RestWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + NewValue, RestWidth: TDimension; WasUpdating: Boolean; begin if Count > 0 then @@ -8431,24 +8093,24 @@ procedure TVirtualTreeColumns.DoCanSplitterResize(P: TPoint; Column: TColumnInde //---------------------------------------------------------------------------------------------------------------------- -procedure TVirtualTreeColumns.DrawButtonText({$IFDEF VT_FMX}ACanvas: TCanvas{$ELSE}DC: HDC{$ENDIF}; Caption: string; Bounds: TRect; Enabled, Hot: Boolean; +procedure TVirtualTreeColumns.DrawButtonText(ACanvas: TCanvas; Caption: string; Bounds: TRect; Enabled, Hot: Boolean; DrawFormat: Cardinal; WrapCaption: Boolean); var - TextSpace: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + TextSpace: TDimension; Size: TSize; begin if not WrapCaption then begin // Do we need to shorten the caption due to limited space? - GetTextExtentPoint32W({$IFDEF VT_FMX}ACanvas{$ELSE}DC{$ENDIF}, {$IFDEF VT_VCL}PWideChar{$ENDIF}(Caption), Length(Caption), Size); + GetTextExtentPoint32W(ACanvas{$IFDEF VT_VCL}.Handle{$ENDIF}, {$IFDEF VT_VCL}PWideChar{$ENDIF}(Caption), Length(Caption), Size); TextSpace := Bounds.Right - Bounds.Left; if TextSpace < Size.cx then - Caption := ShortenString({$IFDEF VT_FMX}ACanvas{$ELSE}DC{$ENDIF}, Caption, TextSpace); + Caption := ShortenString(ACanvas, Caption, TextSpace); end; {$IFDEF VT_VCL} - SetBkMode(DC, TRANSPARENT); + SetBkMode(ACanvas.Handle, TRANSPARENT); {$ENDIF} if not Enabled then if FHeader.Treeview.VclStyleEnabled then @@ -8457,8 +8119,8 @@ procedure TVirtualTreeColumns.DrawButtonText({$IFDEF VT_FMX}ACanvas: TCanvas{$EL ACanvas.Fill.Color:= FHeader.Treeview.FColors.HeaderFontColor; DrawTextW(ACanvas, Caption, Length(Caption), Bounds, DrawFormat); {$ELSE} - SetTextColor(DC, ColorToRGB(FHeader.Treeview.FColors.HeaderFontColor)); - Winapi.Windows.DrawTextW(DC, PWideChar(Caption), Length(Caption), Bounds, DrawFormat); + SetTextColor(ACanvas.Handle, ColorToRGB(FHeader.Treeview.FColors.HeaderFontColor)); + Winapi.Windows.DrawTextW(ACanvas.Handle, PWideChar(Caption), Length(Caption), Bounds, DrawFormat); {$ENDIF} end else @@ -8468,16 +8130,16 @@ procedure TVirtualTreeColumns.DrawButtonText({$IFDEF VT_FMX}ACanvas: TCanvas{$EL ACanvas.Fill.Color:= clBtnHighlight; DrawTextW(ACanvas, Caption, Length(Caption), Bounds, DrawFormat); {$ELSE} - SetTextColor(DC, ColorToRGB(clBtnHighlight)); - Winapi.Windows.DrawTextW(DC, PWideChar(Caption), Length(Caption), Bounds, DrawFormat); + SetTextColor(ACanvas.Handle, ColorToRGB(clBtnHighlight)); + Winapi.Windows.DrawTextW(ACanvas.Handle, PWideChar(Caption), Length(Caption), Bounds, DrawFormat); {$ENDIF} OffsetRect(Bounds, -1, -1); {$IFDEF VT_FMX} ACanvas.Fill.Color:= clBtnShadow; DrawTextW(ACanvas, Caption, Length(Caption), Bounds, DrawFormat); {$ELSE} - SetTextColor(DC, ColorToRGB(clBtnShadow)); - Winapi.Windows.DrawTextW(DC, PWideChar(Caption), Length(Caption), Bounds, DrawFormat); + SetTextColor(ACanvas.Handle, ColorToRGB(clBtnShadow)); + Winapi.Windows.DrawTextW(ACanvas.Handle, PWideChar(Caption), Length(Caption), Bounds, DrawFormat); {$ENDIF} end else @@ -8486,18 +8148,18 @@ procedure TVirtualTreeColumns.DrawButtonText({$IFDEF VT_FMX}ACanvas: TCanvas{$EL {$IFDEF VT_FMX} ACanvas.Fill.Color:= FHeader.Treeview.FColors.HeaderHotColor {$ELSE} - SetTextColor(DC, ColorToRGB(FHeader.Treeview.FColors.HeaderHotColor)) + SetTextColor(ACanvas.Handle, ColorToRGB(FHeader.Treeview.FColors.HeaderHotColor)) {$ENDIF} else {$IFDEF VT_FMX} ACanvas.Fill.Color:= FHeader.Treeview.FColors.HeaderFontColor; {$ELSE} - SetTextColor(DC, ColorToRGB(FHeader.Treeview.FColors.HeaderFontColor)); + SetTextColor(ACanvas.Handle, ColorToRGB(FHeader.Treeview.FColors.HeaderFontColor)); {$ENDIF} {$IFDEF VT_FMX} DrawTextW(ACanvas, Caption, Length(Caption), Bounds, DrawFormat); {$ELSE} - Winapi.Windows.DrawTextW(DC, PWideChar(Caption), Length(Caption), Bounds, DrawFormat); + Winapi.Windows.DrawTextW(ACanvas.Handle, PWideChar(Caption), Length(Caption), Bounds, DrawFormat); {$ENDIF} end; @@ -8522,7 +8184,7 @@ procedure TVirtualTreeColumns.FixPositions; //---------------------------------------------------------------------------------------------------------------------- -function TVirtualTreeColumns.GetColumnAndBounds(P: TPoint; var ColumnLeft, ColumnRight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; +function TVirtualTreeColumns.GetColumnAndBounds(P: TPoint; var ColumnLeft, ColumnRight: TDimension; Relative: Boolean = True): Integer; // Returns the column where the mouse is currently in as well as the left and right bound of @@ -8898,7 +8560,7 @@ procedure TVirtualTreeColumns.UpdatePositions(Force: Boolean = False); var I: Integer; - RunningPos: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + RunningPos: TDimension; begin if not (csDestroying in FHeader.Treeview.ComponentState) and not FNeedPositionsFix and (Force or (UpdateCount = 0)) then begin @@ -8928,16 +8590,16 @@ function TVirtualTreeColumns.Add: TVirtualTreeColumn; //---------------------------------------------------------------------------------------------------------------------- -procedure TVirtualTreeColumns.AnimatedResize(Column: TColumnIndex; NewWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); +procedure TVirtualTreeColumns.AnimatedResize(Column: TColumnIndex; NewWidth: TDimension); // Resizes the given column animated by scrolling the window DC. var - OldWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + OldWidth: TDimension; {$IFDEF VT_FMX}Canvas: TCanvas{$ELSE}DC: HDC{$ENDIF}; I: Integer; Steps: Integer; - DX: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + DX: TDimension; HeaderScrollRect, ScrollRect, R: TRect; @@ -9098,7 +8760,7 @@ function TVirtualTreeColumns.ColumnFromPosition(P: TPoint; Relative: Boolean = T var I: Integer; - Sum: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + Sum: TDimension; begin Result := InvalidColumn; @@ -9181,7 +8843,7 @@ function TVirtualTreeColumns.Equals(OtherColumnsObj: TObject): Boolean; //---------------------------------------------------------------------------------------------------------------------- -procedure TVirtualTreeColumns.GetColumnBounds(Column: TColumnIndex; var Left, Right: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); +procedure TVirtualTreeColumns.GetColumnBounds(Column: TColumnIndex; var Left, Right: TDimension); // Returns the left and right bound of the given column. If Column is NoColumn then the entire client width is returned. @@ -9205,7 +8867,7 @@ procedure TVirtualTreeColumns.GetColumnBounds(Column: TColumnIndex; var Left, Ri //---------------------------------------------------------------------------------------------------------------------- -function TVirtualTreeColumns.GetScrollWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; +function TVirtualTreeColumns.GetScrollWidth: TDimension; // Returns the average width of all visible, non-fixed columns. If there is no such column the indent is returned. @@ -9406,7 +9068,7 @@ function TVirtualTreeColumns.GetVisibleColumns: TColumnsArray; //---------------------------------------------------------------------------------------------------------------------- -function TVirtualTreeColumns.GetVisibleFixedWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; +function TVirtualTreeColumns.GetVisibleFixedWidth: TDimension; // Determines the horizontal space all visible and fixed columns occupy. @@ -9465,13 +9127,13 @@ procedure TVirtualTreeColumns.LoadFromStream(const Stream: TStream; Version: Int //---------------------------------------------------------------------------------------------------------------------- -procedure TVirtualTreeColumns.PaintHeader({$IFDEF VT_FMX}ACanvas: TCanvas{$ELSE}DC: HDC{$ENDIF}; R: TRect; HOffset: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); +procedure TVirtualTreeColumns.PaintHeader(ACanvas: TCanvas; R: TRect; HOffset: TDimension); // Backward compatible header paint method. This method takes care of visually moving floating columns var - VisibleFixedWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; - RTLOffset: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + VisibleFixedWidth: TDimension; + RTLOffset: TDimension; procedure PaintFixedArea; begin @@ -9518,14 +9180,14 @@ procedure TVirtualTreeColumns.PaintHeader({$IFDEF VT_FMX}ACanvas: TCanvas{$ELSE} , 1.0 , false); {$ELSE} - BitBlt(DC, Left, Top, Right - Left, Bottom - Top, FHeaderBitmap.Canvas.Handle, Left, Top, SRCCOPY); + BitBlt(ACanvas.Handle, Left, Top, Right - Left, Bottom - Top, FHeaderBitmap.Canvas.Handle, Left, Top, SRCCOPY); {$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- procedure TVirtualTreeColumns.PaintHeader(TargetCanvas: TCanvas; R: TRect; const Target: TPoint; - RTLOffset: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} = 0); + RTLOffset: TDimension = 0); // Main paint method to draw the header. // This procedure will paint the a slice (given in R) out of HeaderRect into TargetCanvas starting at position Target. @@ -9647,7 +9309,7 @@ procedure TVirtualTreeColumns.PaintHeader(TargetCanvas: TCanvas; R: TRect; const // this procedure is called. var - Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + Y: TDimension; SavedDC: Integer; ColCaptionText: string; ColImageInfo: TVTImageInfo; @@ -9784,7 +9446,7 @@ procedure TVirtualTreeColumns.PaintHeader(TargetCanvas: TCanvas; R: TRect; const end; if UseRightToLeftReading then DrawFormat := DrawFormat + DT_RTLREADING; - ComputeHeaderLayout(TargetCanvas{$IFDEF VT_VCL}.Handle{$ENDIF}, PaintRectangle, ShowHeaderGlyph, ShowSortGlyph, GlyphPos, + ComputeHeaderLayout(TargetCanvas, PaintRectangle, ShowHeaderGlyph, ShowSortGlyph, GlyphPos, SortGlyphPos, SortGlyphSize, TextRectangle, DrawFormat); // Move glyph and text one pixel to the right and down to simulate a pressed button. @@ -9814,7 +9476,7 @@ procedure TVirtualTreeColumns.PaintHeader(TargetCanvas: TCanvas; R: TRect; const if not FCheckBox then begin ColImageInfo.Images := Images; - Images.Draw(TargetCanvas, {$IFDEF VT_FMX}RectF(GlyphPos.X, GlyphPos.Y, GlyphPos.X+16, GlyphPos.Y+16){$ELSE}GlyphPos.X, GlyphPos.Y({$ENDIF}, FImageIndex{$IFDEF VT_VCL}, IsEnabled{$ENDIF}); //TODO: 16px Image!!! + Images.Draw(TargetCanvas, {$IFDEF VT_FMX}RectF(GlyphPos.X, GlyphPos.Y, GlyphPos.X+16, GlyphPos.Y+16){$ELSE}GlyphPos.X, GlyphPos.Y{$ENDIF}, FImageIndex{$IFDEF VT_VCL}, IsEnabled{$ENDIF}); //TODO: 16px Image!!! end else begin @@ -9851,7 +9513,7 @@ procedure TVirtualTreeColumns.PaintHeader(TargetCanvas: TCanvas; R: TRect; const else DrawHot := (IsHoverIndex and (hoHotTrack in FHeader.FOptions) and not(tsUseThemes in FHeader.Treeview.FStates)); if not(hpeText in ActualElements) and (Length(Text) > 0) then - DrawButtonText(TargetCanvas{$IFDEF VT_VCL}.Handle{$ENDIF}, ColCaptionText, TextRectangle, IsEnabled, DrawHot, DrawFormat, WrapCaption); + DrawButtonText(TargetCanvas, ColCaptionText, TextRectangle, IsEnabled, DrawHot, DrawFormat, WrapCaption); // sort glyph if not (hpeSortGlyph in ActualElements) and ShowSortGlyph then @@ -9913,7 +9575,7 @@ procedure TVirtualTreeColumns.PaintHeader(TargetCanvas: TCanvas; R: TRect; const var TargetRect: TRect; - MaxX: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + MaxX: TDimension; begin if IsRectEmpty(R) then Exit; @@ -9969,7 +9631,7 @@ procedure TVirtualTreeColumns.PaintHeader(TargetCanvas: TCanvas; R: TRect; const // TargetRect.Right will be set in the loop ShowRightBorder := (FHeader.Style = hsThickButtons) or not (hoAutoResize in FHeader.FOptions) or - (FHeader.Treeview.BevelKind = bkNone); + (FHeader.Treeview.BevelKind = TBevelKind.bkNone); // Now go for each button. while (Run > NoColumn) and (TargetRect.Left < MaxX) do @@ -10022,7 +9684,7 @@ procedure TVirtualTreeColumns.SaveToStream(const Stream: TStream); //---------------------------------------------------------------------------------------------------------------------- -function TVirtualTreeColumns.TotalWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; +function TVirtualTreeColumns.TotalWidth: TDimension; var LastColumn: TColumnIndex; @@ -10181,7 +9843,7 @@ destructor TVTHeader.Destroy; procedure TVTHeader.FontChanged(Sender: TObject); var I: Integer; - lMaxHeight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + lMaxHeight: TDimension; begin if toAutoChangeScale in Treeview.TreeOptions.AutoOptions then begin @@ -10267,7 +9929,7 @@ procedure TVTHeader.SetColumns(Value: TVirtualTreeColumns); //---------------------------------------------------------------------------------------------------------------------- -procedure TVTHeader.SetDefaultHeight(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); +procedure TVTHeader.SetDefaultHeight(Value: TDimension); begin if Value < FMinHeight then @@ -10291,13 +9953,13 @@ procedure TVTHeader.SetFont(const Value: TFont); //---------------------------------------------------------------------------------------------------------------------- -procedure TVTHeader.SetHeight(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); +procedure TVTHeader.SetHeight(Value: TDimension); var RelativeMaxHeight, RelativeMinHeight, EffectiveMaxHeight, - EffectiveMinHeight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + EffectiveMinHeight: TDimension; begin if not TreeView.HandleAllocated then @@ -10392,7 +10054,7 @@ procedure TVTHeader.SetMainColumn(Value: TColumnIndex); //---------------------------------------------------------------------------------------------------------------------- -procedure TVTHeader.SetMaxHeight(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); +procedure TVTHeader.SetMaxHeight(Value: TDimension); begin if Value < FMinHeight then @@ -10403,7 +10065,7 @@ procedure TVTHeader.SetMaxHeight(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$END //---------------------------------------------------------------------------------------------------------------------- -procedure TVTHeader.SetMinHeight(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); +procedure TVTHeader.SetMinHeight(Value: TDimension); begin if Value < 0 then @@ -10519,7 +10181,7 @@ function TVTHeader.CanWriteColumns: Boolean; //---------------------------------------------------------------------------------------------------------------------- -procedure TVTHeader.ChangeScale(M, D: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); +procedure TVTHeader.ChangeScale(M, D: TDimension); var I: Integer; begin @@ -10545,8 +10207,8 @@ function TVTHeader.DetermineSplitterIndex(P: TPoint): Boolean; // columns possible. var - VisibleFixedWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; - SplitPoint: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + VisibleFixedWidth: TDimension; + SplitPoint: TDimension; //--------------- local function -------------------------------------------- @@ -10792,7 +10454,7 @@ procedure TVTHeader.DragTo(P: TPoint); // optimized drag image move support ClientP: TPoint; Left, - Right: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + Right: TDimension; NeedRepaint: Boolean; // True if the screen needs an update (changed drop target or drop side) begin @@ -11488,7 +11150,7 @@ procedure TVTHeader.PrepareDrag(P, Start: TPoint); Image: TBitmap; ImagePos: TPoint; DragColumn: TVirtualTreeColumn; - RTLOffset: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + RTLOffset: TDimension; begin // Determine initial position of drag image (screen coordinates). @@ -11576,7 +11238,7 @@ procedure TVTHeader.RescaleHeader; var FixedWidth, MaxFixedWidth, - MinFixedWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + MinFixedWidth: TDimension; //--------------- local function -------------------------------------------- @@ -12093,8 +11755,8 @@ procedure TVTHeader.LoadFromStream(const Stream: TStream); //---------------------------------------------------------------------------------------------------------------------- -function TVTHeader.ResizeColumns(ChangeBy: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; RangeStartCol: TColumnIndex; RangeEndCol: TColumnIndex; - Options: TVTColumnOptions = [coVisible]): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; +function TVTHeader.ResizeColumns(ChangeBy: TDimension; RangeStartCol: TColumnIndex; RangeEndCol: TColumnIndex; + Options: TVTColumnOptions = [coVisible]): TDimension; // Distribute the given width change to a range of columns. A 'fair' way is used to distribute ChangeBy to the columns, // while ensuring that everything that can be distributed will be distributed. @@ -12104,9 +11766,9 @@ function TVTHeader.ResizeColumns(ChangeBy: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ I: TColumnIndex; ColCount, Sign: Integer; - ToGo, MaxDelta, Difference, Rest: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + ToGo, MaxDelta, Difference, Rest: TDimension; Constraints, - Widths: array of {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + Widths: array of TDimension; BonusPixel: Boolean; //--------------- local functions ------------------------------------------- @@ -12133,7 +11795,7 @@ function TVTHeader.ResizeColumns(ChangeBy: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ //--------------------------------------------------------------------------- - function ChangeWidth(Column: TColumnIndex; Delta: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + function ChangeWidth(Column: TColumnIndex; Delta: TDimension): TDimension; begin if Delta > 0 then @@ -12151,7 +11813,7 @@ function TVTHeader.ResizeColumns(ChangeBy: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ function ReduceConstraints: Boolean; var - MaxWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + MaxWidth: TDimension; MaxReserveCol, Column: TColumnIndex; @@ -12677,6 +12339,7 @@ constructor TBaseVirtualTree.Create(AOwner: TComponent); InitializeGlobalStructures(); inherited; + dummyCanvas:= TCanvas.Create; {$IFDEF VT_FMX} FHandleAllocated:= true; FUseRightToLeftAlignment:= false; @@ -12686,10 +12349,10 @@ constructor TBaseVirtualTree.Create(AOwner: TComponent); FTextMargin:= 4; FDefaultNodeHeight:= 18; //??? FIndent:= 18; //??? - FBevelEdges:= [beLeft, beTop, beRight, beBottom]; - FBevelInner:= bvRaised; - FBevelOuter:= bvLowered; - FBevelKind:= bkNone; + FBevelEdges:= [TBevelEdge.beLeft, TBevelEdge.beTop, TBevelEdge.beRight, TBevelEdge.beBottom]; + FBevelInner:= TBevelCut.bvRaised; + FBevelOuter:= TBevelCut.bvLowered; + FBevelKind:= TBevelKind.bkNone; FBevelWidth:= 1; FBorderWidth:= 0; {$ELSE} @@ -12723,7 +12386,7 @@ constructor TBaseVirtualTree.Create(AOwner: TComponent); FSelectedHotPlusBM := TBitmap.Create; FSelectedHotMinusBM := TBitmap.Create; - FBorderStyle := bsSingle; + FBorderStyle := TFormBorderStyle.bsSingle; FButtonStyle := bsRectangle; FButtonFillMode := fmTreeColor; @@ -12865,6 +12528,8 @@ destructor TBaseVirtualTree.Destroy; FSelectedHotPlusBM.Free; FSelectedHotMinusBM.Free; + FreeAndNil(dummyCanvas); + inherited; end; @@ -12898,12 +12563,12 @@ procedure TBaseVirtualTree.AdjustTotalCount(Node: PVirtualNode; Value: Integer; //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.AdjustTotalHeight(Node: PVirtualNode; Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; Relative: Boolean = False); +procedure TBaseVirtualTree.AdjustTotalHeight(Node: PVirtualNode; Value: TDimension; Relative: Boolean = False); // Sets a node's total height to the given value and recursively adjusts the parent's total height. var - Difference: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + Difference: TDimension; Run: PVirtualNode; begin @@ -12950,7 +12615,7 @@ function TBaseVirtualTree.CalculateCacheEntryCount: Integer; //---------------------------------------------------------------------------------------------------------------------- procedure TBaseVirtualTree.CalculateVerticalAlignments(ShowImages, ShowStateImages: Boolean; Node: PVirtualNode; - var VAlign, VButtonAlign: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); + var VAlign, VButtonAlign: TDimension); // Calculates the vertical alignment of the given node and its associated expand/collapse button during // a node paint cycle depending on the required node alignment style. @@ -13158,7 +12823,7 @@ function TBaseVirtualTree.ChangeCheckState(Node: PVirtualNode; Value: TCheckStat //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.CollectSelectedNodesLTR(MainColumn: Integer; NodeLeft, NodeRight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; Alignment: TAlignment; +function TBaseVirtualTree.CollectSelectedNodesLTR(MainColumn: Integer; NodeLeft, NodeRight: TDimension; Alignment: TAlignment; OldRect, NewRect: TRect): Boolean; // Helper routine used when a draw selection takes place. This version handles left-to-right directionality. @@ -13173,17 +12838,17 @@ function TBaseVirtualTree.CollectSelectedNodesLTR(MainColumn: Integer; NodeLeft, TextLeft, CurrentTop, CurrentRight, - NextTop: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + NextTop: TDimension; NextColumn, Dummy: Integer; {$IFDEF VT_FMX} DummySingle: Single; {$ENDIF} - MinY, MaxY: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; - LabelOffset: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + MinY, MaxY: TDimension; + LabelOffset: TDimension; IsInOldRect, IsInNewRect: Boolean; - NodeWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + NodeWidth: TDimension; // quick check variables for various parameters DoSwitch, @@ -13312,7 +12977,7 @@ function TBaseVirtualTree.CollectSelectedNodesLTR(MainColumn: Integer; NodeLeft, //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.CollectSelectedNodesRTL(MainColumn: Integer; NodeLeft, NodeRight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; Alignment: TAlignment; +function TBaseVirtualTree.CollectSelectedNodesRTL(MainColumn: Integer; NodeLeft, NodeRight: TDimension; Alignment: TAlignment; OldRect, NewRect: TRect): Boolean; // Helper routine used when a draw selection takes place. This version handles right-to-left directionality. @@ -13332,7 +12997,7 @@ function TBaseVirtualTree.CollectSelectedNodesRTL(MainColumn: Integer; NodeLeft, CheckOffset, CurrentTop, CurrentLeft, - MinY, MaxY: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + MinY, MaxY: TDimension; {$IFDEF VT_FMX} DummySingle: Single; @@ -13564,7 +13229,7 @@ procedure TBaseVirtualTree.ClearNodeBackground(const PaintInfo: TVTPaintInfo; Us {$IFDEF VT_FMX} DrawRect(RectF(Left, Top, Right, Bottom), FSelectionCurveRadius, FSelectionCurveRadius, AllCorners, 1.0); {$ELSE} - DrawRect(Rect(Left, Top, Right, Bottom), FSelectionCurveRadius, FSelectionCurveRadius); + RoundRect(Rect(Left, Top, Right, Bottom), FSelectionCurveRadius, FSelectionCurveRadius); {$ENDIF} end else @@ -13651,7 +13316,7 @@ procedure TBaseVirtualTree.DrawLineImage(const PaintInfo: TVTPaintInfo; X, Y, H, var HalfWidth, - TargetX: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + TargetX: TDimension; begin HalfWidth := FIndent {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2; @@ -13704,7 +13369,7 @@ procedure TBaseVirtualTree.DrawLineImage(const PaintInfo: TVTPaintInfo; X, Y, H, //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.FindInPositionCache(Node: PVirtualNode; var CurrentPos: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}): PVirtualNode; +function TBaseVirtualTree.FindInPositionCache(Node: PVirtualNode; var CurrentPos: TDimension): PVirtualNode; // Looks through the position cache and returns the node whose top position is the largest one which is smaller or equal // to the position of the given node. @@ -13737,7 +13402,7 @@ function TBaseVirtualTree.FindInPositionCache(Node: PVirtualNode; var CurrentPos //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.FindInPositionCache(Position: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; var CurrentPos: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}): PVirtualNode; +function TBaseVirtualTree.FindInPositionCache(Position: TDimension; var CurrentPos: TDimension): PVirtualNode; // Looks through the position cache and returns the node whose top position is the largest one which is smaller or equal // to the given vertical position. @@ -14009,7 +13674,7 @@ function TBaseVirtualTree.GetMultiline(Node: PVirtualNode): Boolean; //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.GetNodeHeight(Node: PVirtualNode): {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; +function TBaseVirtualTree.GetNodeHeight(Node: PVirtualNode): TDimension; begin if Assigned(Node) and (Node <> FRoot) then @@ -14041,7 +13706,7 @@ function TBaseVirtualTree.GetNodeParent(Node: PVirtualNode): PVirtualNode; //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.GetOffset(pElement: TVTElement; pNode: PVirtualNode): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; +function TBaseVirtualTree.GetOffset(pElement: TVTElement; pNode: PVirtualNode): TDimension; // Calculates the offset of the given element var lOffsets: TVTOffsets; @@ -14116,7 +13781,7 @@ function TBaseVirtualTree.GetOffsetXY: TPoint; //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.GetRangeX: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; +function TBaseVirtualTree.GetRangeX: TDimension; begin Result := Max(0, FRangeX); end; @@ -14154,7 +13819,7 @@ function TBaseVirtualTree.GetSelectedData: TArray; function TBaseVirtualTree.GetTopNode: PVirtualNode; var - Dummy: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + Dummy: TDimension; begin Result := GetNodeAt(0, 0, True, Dummy); @@ -14276,7 +13941,7 @@ procedure TBaseVirtualTree.HandleClickSelection(LastFocused, NewNode: PVirtualNo //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.HandleDrawSelection(X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}): Boolean; +function TBaseVirtualTree.HandleDrawSelection(X, Y: TDimension): Boolean; // Handles multi-selection with a focus rectangle. // Result is True if something changed in selection. @@ -14289,7 +13954,7 @@ function TBaseVirtualTree.HandleDrawSelection(X, Y: {$IFDEF VT_FMX}Single{$ELSE} // limits of a node and its text NodeLeft, - NodeRight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + NodeRight: TDimension; // alignment and directionality CurrentBidiMode: TBidiMode; @@ -14803,7 +14468,7 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean); if FButtonStyle = bsTriangle then begin FMinusBM.Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := clBlack; - FMinusBM.Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := clBlack; + FMinusBM.Canvas.{$IFDEF VT_FMX}Stroke{$ELSE}Pen{$ENDIF}.Color := clBlack; FMinusBM.Canvas.{$IFDEF VT_FMX}DrawPolygon{$ELSE}Polygon{$ENDIF}([Point(0, 2), Point(8, 2), Point(4, 6)]{$IFDEF VT_FMX}, 1.0{$ENDIF}); end else @@ -15000,8 +14665,6 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean); DeleteObject(PatternBitmap); {$ENDIF} end; - FMinusBM.SaveToFile('R:\Minus.png'); - FPlusBM.SaveToFile('R:\Plus.png'); end; //---------------------------------------------------------------------------------------------------------------------- @@ -15059,7 +14722,7 @@ procedure TBaseVirtualTree.SetBackGroundImageTransparent(const Value: Boolean); //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.SetBackgroundOffset(const Index: Integer; const Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); +procedure TBaseVirtualTree.SetBackgroundOffset(const Index: Integer; const Value: TDimension); begin case Index of @@ -15117,7 +14780,7 @@ procedure TBaseVirtualTree.SetBottomNode(Node: PVirtualNode); //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.SetBottomSpace(const Value: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}); +procedure TBaseVirtualTree.SetBottomSpace(const Value: TDimension); begin if FBottomSpace <> Value then @@ -15270,7 +14933,7 @@ procedure TBaseVirtualTree.SetChildCount(Node: PVirtualNode; NewChildCount: Card Index: Cardinal; Child: PVirtualNode; Count: Integer; - NewHeight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + NewHeight: TDimension; begin if not (toReadOnly in FOptions.FMiscOptions) then begin @@ -15429,7 +15092,7 @@ procedure TBaseVirtualTree.SetCustomCheckImages(const Value: TCustomImageList); //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.SetDefaultNodeHeight(Value: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}); +procedure TBaseVirtualTree.SetDefaultNodeHeight(Value: TDimension); begin if Value = 0 then @@ -15437,11 +15100,11 @@ procedure TBaseVirtualTree.SetDefaultNodeHeight(Value: {$IFDEF VT_FMX}Single{$EL if FDefaultNodeHeight <> Value then begin {$IFDEF VT_FMX} - Inc(FRoot.TotalHeight, (Value) - (FDefaultNodeHeight)); - Inc(FRoot.NodeHeight, (Value) - (FDefaultNodeHeight)); + Inc(FRoot.TotalHeight, Value - FDefaultNodeHeight); + Inc(FRoot.NodeHeight, Value - FDefaultNodeHeight); {$ELSE} - Inc(Integer(FRoot.TotalHeight), Integer(Value) - Integer(FDefaultNodeHeight)); - Inc(SmallInt(FRoot.NodeHeight), Integer(Value) - Integer(FDefaultNodeHeight)); + Inc(FRoot.TotalHeight, Value - FDefaultNodeHeight); + Inc(FRoot.NodeHeight, Value - FDefaultNodeHeight); {$ENDIF} FDefaultNodeHeight := Value; InvalidateCache; @@ -15712,7 +15375,7 @@ procedure TBaseVirtualTree.SetImages(const Value: TCustomImageList); //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.SetIndent(Value: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}); +procedure TBaseVirtualTree.SetIndent(Value: TDimension); begin if FIndent <> Value then @@ -15758,7 +15421,7 @@ procedure TBaseVirtualTree.SetLineStyle(const Value: TVTLineStyle); //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.SetMargin(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); +procedure TBaseVirtualTree.SetMargin(Value: TDimension); begin if FMargin <> Value then @@ -15858,10 +15521,10 @@ procedure TBaseVirtualTree.SetNodeDataSize(Value: Integer); //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.SetNodeHeight(Node: PVirtualNode; Value: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}); +procedure TBaseVirtualTree.SetNodeHeight(Node: PVirtualNode; Value: TDimension); var - Difference: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + Difference: TDimension; begin if Assigned(Node) and (Node <> FRoot) and (Node.NodeHeight <> Value) and not (toReadOnly in FOptions.FMiscOptions) then @@ -15903,7 +15566,7 @@ procedure TBaseVirtualTree.SetNodeParent(Node: PVirtualNode; const Value: PVirtu //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.SetOffsetX(const Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); +procedure TBaseVirtualTree.SetOffsetX(const Value: TDimension); begin DoSetOffsetXY(Point(Value, FOffsetY), DefaultScrollUpdateFlags); @@ -15919,7 +15582,7 @@ procedure TBaseVirtualTree.SetOffsetXY(const Value: TPoint); //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.SetOffsetY(const Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); +procedure TBaseVirtualTree.SetOffsetY(const Value: TDimension); begin DoSetOffsetXY(Point(FOffsetX, Value), DefaultScrollUpdateFlags); @@ -15935,7 +15598,7 @@ procedure TBaseVirtualTree.SetOptions(const Value: TCustomVirtualTreeOptions); //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.SetRangeX(value: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}); +procedure TBaseVirtualTree.SetRangeX(value: TDimension); begin FRangeX := value; end; @@ -16072,7 +15735,7 @@ procedure TBaseVirtualTree.SetStateImages(const Value: TCustomImageList); //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.SetTextMargin(Value: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); +procedure TBaseVirtualTree.SetTextMargin(Value: TDimension); begin if FTextMargin <> Value then @@ -16220,7 +15883,7 @@ procedure TBaseVirtualTree.SetVisiblePath(Node: PVirtualNode; Value: Boolean); // ---------------------------------------------------------------------------------------------------------------------- procedure TBaseVirtualTree.PrepareBackGroundPicture(Source: {$IFDEF VT_FMX}TImage{$ELSE}TPicture{$ENDIF}; - DrawBitmap: TBitmap; DrawBitmapWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; DrawBitMapHeight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; ABkgcolor: TColor); + DrawBitmap: TBitmap; DrawBitmapWidth: TDimension; DrawBitMapHeight: TDimension; ABkgcolor: TColor); const DST = $00AA0029; // Ternary Raster Operation - Destination unchanged @@ -16264,7 +15927,7 @@ procedure TBaseVirtualTree.PrepareBackGroundPicture(Source: {$IFDEF VT_FMX}TImag //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.StaticBackground(Source: {$IFDEF VT_FMX}TImage{$ELSE}TPicture{$ENDIF}; Target: TCanvas; OffsetPosition: TPoint; R: TRectF; aBkgColor: TColor); +procedure TBaseVirtualTree.StaticBackground(Source: {$IFDEF VT_FMX}TImage{$ELSE}TPicture{$ENDIF}; Target: TCanvas; OffsetPosition: TPoint; R: TRect; aBkgColor: TColor); // Draws the given source graphic so that it stays static in the given rectangle which is relative to the target bitmap. // The graphic is aligned so that it always starts at the upper left corner of the target canvas. @@ -18662,7 +18325,10 @@ procedure TBaseVirtualTree.WMPaint(var Message: TWMPaint); DC := GetDCEx(Handle, 0, DCX_CACHE or DCX_CLIPSIBLINGS or DCX_WINDOW or DCX_VALIDATE); if DC <> 0 then try - FHeader.FColumns.PaintHeader(DC, FHeaderRect, -FEffectiveOffsetX); + begin + dummyCanvas.Handle:= DC; + FHeader.FColumns.PaintHeader(dummyCanvas, FHeaderRect, -FEffectiveOffsetX); + end; finally ReleaseDC(Handle, DC); end; @@ -18683,11 +18349,13 @@ procedure TBaseVirtualTree.WMPrint(var Message: TWMPrint); // This message is sent to request that the tree draws itself to a given device context. This includes not only // the client area but also the non-client area (header!). - begin // Draw only if the window is visible or visibility is not required. if ((Message.Flags and PRF_CHECKVISIBLE) = 0) or IsWindowVisible(Handle) then - Header.Columns.PaintHeader(Message.DC, FHeaderRect, -FEffectiveOffsetX); + begin + dummyCanvas.Handle:= Message.DC; + Header.Columns.PaintHeader(dummyCanvas, FHeaderRect, -FEffectiveOffsetX); + end; inherited; end; @@ -19108,7 +18776,7 @@ procedure TBaseVirtualTree.AdjustPaintCellRect(var PaintInfo: TVTPaintInfo; var //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.AdjustPanningCursor(X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); +procedure TBaseVirtualTree.AdjustPanningCursor(X, Y: TDimension); // Triggered by a mouse move when wheel panning/scrolling is active. // Loads the proper cursor which indicates into which direction scrolling is done. @@ -19350,13 +19018,13 @@ procedure TBaseVirtualTree.StartOperation(OperationKind: TVTOperationKind); //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.CalculateSelectionRect(X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}): Boolean; +function TBaseVirtualTree.CalculateSelectionRect(X, Y: TDimension): Boolean; // Recalculates old and new selection rectangle given that X, Y are new mouse coordinates. // Returns True if there was a change since the last call. var - MaxValue: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + MaxValue: TDimension; begin if tsDrawSelecting in FStates then @@ -19609,13 +19277,13 @@ function TBaseVirtualTree.ColumnIsEmpty(Node: PVirtualNode; Column: TColumnIndex //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.ComputeRTLOffset(ExcludeScrollBar: Boolean): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; +function TBaseVirtualTree.ComputeRTLOffset(ExcludeScrollBar: Boolean): TDimension; // Computes the horizontal offset needed when all columns are automatically right aligned (in RTL bidi mode). // ExcludeScrollBar determines if the left-hand vertical scrollbar is to be included (if visible) or not. var - HeaderWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + HeaderWidth: TDimension; ScrollBarVisible: Boolean; begin ScrollBarVisible := ({$IFDEF VT_VCL}Integer{$ENDIF}(FRangeY) > ClientHeight) and (ScrollBarOptions.ScrollBars in [TScrollStyle.ssVertical, TScrollStyle.ssBoth]); @@ -19895,7 +19563,7 @@ procedure TBaseVirtualTree.DetermineHiddenChildrenFlagAllNodes; //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.DetermineHitPositionLTR(var HitInfo: THitInfo; Offset, Right: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; +procedure TBaseVirtualTree.DetermineHitPositionLTR(var HitInfo: THitInfo; Offset, Right: TDimension; Alignment: TAlignment); // This method determines the hit position within a node with left-to-right orientation. @@ -19904,7 +19572,7 @@ procedure TBaseVirtualTree.DetermineHitPositionLTR(var HitInfo: THitInfo; Offset MainColumnHit: Boolean; lIndent, TextWidth, - ImageOffset: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + ImageOffset: TDimension; lOffsets: TVTOffsets; begin MainColumnHit := HitInfo.HitColumn = FHeader.MainColumn; @@ -20006,7 +19674,7 @@ procedure TBaseVirtualTree.DetermineHitPositionLTR(var HitInfo: THitInfo; Offset //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.DetermineHitPositionRTL(var HitInfo: THitInfo; Offset, Right: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; Alignment: TAlignment); +procedure TBaseVirtualTree.DetermineHitPositionRTL(var HitInfo: THitInfo; Offset, Right: TDimension; Alignment: TAlignment); // This method determines the hit position within a node with right-to-left orientation. @@ -20015,7 +19683,7 @@ procedure TBaseVirtualTree.DetermineHitPositionRTL(var HitInfo: THitInfo; Offset Run: PVirtualNode; Indent, TextWidth, - ImageOffset: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + ImageOffset: TDimension; begin MainColumnHit := HitInfo.HitColumn = FHeader.MainColumn; @@ -20300,7 +19968,7 @@ function TBaseVirtualTree.DetermineNextCheckState(CheckType: TCheckType; CheckSt //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.DetermineScrollDirections(X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}): TScrollDirections; +function TBaseVirtualTree.DetermineScrollDirections(X, Y: TDimension): TScrollDirections; // Determines which direction the client area must be scrolled depending on the given position. @@ -20400,7 +20068,7 @@ procedure TBaseVirtualTree.DoAfterPaint(Canvas: TCanvas); //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.DoAutoScroll(X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); +procedure TBaseVirtualTree.DoAutoScroll(X, Y: TDimension); begin FScrollDirections := DetermineScrollDirections(X, Y); @@ -20914,7 +20582,7 @@ function TBaseVirtualTree.DoDragOver(Source: TObject; Shift: TShiftState; State: //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.DoDragDrop(Source: TObject; const DataObject: {$IFDEF VT_FMX}TDragObject{$ELSE}IDragObject{$ENDIF}; const Formats: TFormatArray; +procedure TBaseVirtualTree.DoDragDrop(Source: TObject; const DataObject: {$IFDEF VT_FMX}TDragObject{$ELSE}IDataObject{$ENDIF}; const Formats: TFormatArray; Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode); begin @@ -21287,7 +20955,7 @@ function TBaseVirtualTree.DoGetNodeTooltip(Node: PVirtualNode; Column: TColumnIn //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.DoGetNodeExtraWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; +function TBaseVirtualTree.DoGetNodeExtraWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): TDimension; // Returns the pixel width of extra space occupied by node contents (for example, static text). @@ -21297,7 +20965,7 @@ function TBaseVirtualTree.DoGetNodeExtraWidth(Node: PVirtualNode; Column: TColum //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; +function TBaseVirtualTree.DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): TDimension; // Returns the pixel width of a node. @@ -21511,7 +21179,7 @@ procedure TBaseVirtualTree.DoLoadUserData(Node: PVirtualNode; Stream: TStream); //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.DoMeasureItem(TargetCanvas: TCanvas; Node: PVirtualNode; var NodeHeight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); +procedure TBaseVirtualTree.DoMeasureItem(TargetCanvas: TCanvas; Node: PVirtualNode; var NodeHeight: TDimension); begin if not (vsInitialized in Node.States) then @@ -21745,7 +21413,7 @@ procedure TBaseVirtualTree.DoSaveUserData(Node: PVirtualNode; Stream: TStream); //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.DoScroll(DeltaX, DeltaY: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); +procedure TBaseVirtualTree.DoScroll(DeltaX, DeltaY: TDimension); begin if Assigned(FOnScroll) then @@ -21760,8 +21428,8 @@ function TBaseVirtualTree.DoSetOffsetXY(Value: TPoint; Options: TScrollUpdateOpt // Returns True if the offset really changed otherwise False is returned. var - DeltaX: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; - DeltaY: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + DeltaX: TDimension; + DeltaY: TDimension; {$IFDEF VT_VCL} DWPStructure: HDWP; {$ENDIF} @@ -22109,7 +21777,7 @@ function TBaseVirtualTree.DoValidateCache: Boolean; Index: Cardinal; CurrentNode, Temp: PVirtualNode; - CurrentTop: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; + CurrentTop: TDimension; begin EntryCount := 0; if not (tsStopValidation in FStates) then @@ -22199,7 +21867,7 @@ function TBaseVirtualTree.DoValidateCache: Boolean; //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.DragAndDrop(AllowedEffects: Dword; const DataObject: {$IFDEF VT_FMX}TDragObject{$ELSE}IDragObject{$ENDIF}; var DragEffect: Integer); +procedure TBaseVirtualTree.DragAndDrop(AllowedEffects: Dword; const DataObject: {$IFDEF VT_FMX}TDragObject{$ELSE}IDataObject{$ENDIF}; var DragEffect: Integer); var lDragEffect: DWord; // required for type compatibility with SHDoDragDrop begin @@ -22230,7 +21898,7 @@ procedure TBaseVirtualTree.DragCanceled; end; //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.DragDrop(const DataObject: {$IFDEF VT_FMX}TDragObject{$ELSE}IDragObject{$ENDIF}; KeyState: Integer; Pt: TPoint; +function TBaseVirtualTree.DragDrop(const DataObject: {$IFDEF VT_FMX}TDragObject{$ELSE}IDataObject{$ENDIF}; KeyState: Integer; Pt: TPoint; var Effect: Integer): HResult; {$IFDEF VT_VCL} var @@ -22435,7 +22103,7 @@ function TBaseVirtualTree.DragOver(Source: TObject; KeyState: Integer; DragState Tree: TBaseVirtualTree; LastNode: PVirtualNode; DeltaX, - DeltaY: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + DeltaY: TDimension; ScrollOptions: TScrollUpdateOptions; begin @@ -22618,7 +22286,7 @@ function TBaseVirtualTree.DragOver(Source: TObject; KeyState: Integer; DragState //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.DrawDottedHLine(const PaintInfo: TVTPaintInfo; Left, Right, Top: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); +procedure TBaseVirtualTree.DrawDottedHLine(const PaintInfo: TVTPaintInfo; Left, Right, Top: TDimension); // Draws a horizontal line with alternating pixels (this style is not supported for pens under Win9x). @@ -22642,7 +22310,7 @@ procedure TBaseVirtualTree.DrawDottedHLine(const PaintInfo: TVTPaintInfo; Left, //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.DrawDottedVLine(const PaintInfo: TVTPaintInfo; Top, Bottom, Left: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; UseSelectedBkColor: Boolean = False); +procedure TBaseVirtualTree.DrawDottedVLine(const PaintInfo: TVTPaintInfo; Top, Bottom, Left: TDimension; UseSelectedBkColor: Boolean = False); // Draws a horizontal line with alternating pixels (this style is not supported for pens under Win9x). @@ -23009,7 +22677,7 @@ function TBaseVirtualTree.GetNodeImageSize(Node: PVirtualNode): TSize; //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.GetMaxRightExtend(): {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; +function TBaseVirtualTree.GetMaxRightExtend(): TDimension; // Determines the maximum with of the currently visible part of the tree, depending on the length // of the node texts. This method is used for determining the horizontal scroll range if no columns are used. @@ -23017,8 +22685,8 @@ function TBaseVirtualTree.GetMaxRightExtend(): {$IFDEF VT_FMX}Single{$ELSE}Cardi var Node, NextNode: PVirtualNode; - TopPosition: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; - CurrentWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + TopPosition: TDimension; + CurrentWidth: TDimension; begin Node := GetNodeAt(0, 0, True, TopPosition); @@ -23076,7 +22744,7 @@ function TBaseVirtualTree.GetOptionsClass: TTreeOptionsClass; //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.GetTreeFromDataObject(const DataObject: {$IFDEF VT_FMX}TDragObject{$ELSE}IDragObject{$ENDIF}): TBaseVirtualTree; +function TBaseVirtualTree.GetTreeFromDataObject(const DataObject: {$IFDEF VT_FMX}TDragObject{$ELSE}IDataObject{$ENDIF}): TBaseVirtualTree; // Returns the owner/sender of the given data object by means of a special clipboard format // or nil if the sender is in another process or no virtual tree at all. @@ -23110,7 +22778,7 @@ function TBaseVirtualTree.GetTreeFromDataObject(const DataObject: {$IFDEF VT_FMX //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.HandleHotTrack(X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); +procedure TBaseVirtualTree.HandleHotTrack(X, Y: TDimension); // Updates the current "hot" node. @@ -24148,7 +23816,7 @@ procedure TBaseVirtualTree.InternalAddFromStream(Stream: TStream; Version: Integ var Stop: PVirtualNode; Index: Integer; - LastTotalHeight: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; + LastTotalHeight: TDimension; WasFullyVisible: Boolean; begin @@ -25040,9 +24708,9 @@ procedure TBaseVirtualTree.Paint; var Window: TRect; Target: TPoint; - Temp: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + Temp: TDimension; Options: TVTInternalPaintOptions; - RTLOffset: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + RTLOffset: TDimension; begin @@ -25104,12 +24772,13 @@ procedure TBaseVirtualTree.Paint; procedure TBaseVirtualTree.PaintCheckImage(Canvas: TCanvas; const ImageInfo: TVTImageInfo; Selected: Boolean); var -{$IFDEF VT_VCL} - ForegroundColor: COLORREF; +{$IFDEF VT_FMX} + ForegroundColor: TColor; +{$ELSE} + ForegroundColor: COLORREF; Details: TThemedElementDetails; Theme: HTHEME; {$ENDIF} - ForegroundColor: TColor; R: TRect; lSize: TSize; begin @@ -25290,11 +24959,11 @@ procedure TBaseVirtualTree.PaintImage(var PaintInfo: TVTPaintInfo; ImageInfoInde //---------------------------------------------------------------------------------------------------------------------- procedure TBaseVirtualTree.PaintNodeButton(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const R: TRect; - ButtonX, ButtonY: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; BidiMode: TBiDiMode); + ButtonX, ButtonY: TDimension; BidiMode: TBiDiMode); var Bitmap: TBitmap; - XPos: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + XPos: TDimension; IsHot: Boolean; IsSelected : boolean; {$IFDEF VT_VCL} @@ -25365,12 +25034,12 @@ procedure TBaseVirtualTree.PaintNodeButton(Canvas: TCanvas; Node: PVirtualNode; //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.PaintTreeLines(const PaintInfo: TVTPaintInfo; VAlignment, IndentSize: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; const LineImage: TLineImage); +procedure TBaseVirtualTree.PaintTreeLines(const PaintInfo: TVTPaintInfo; VAlignment, IndentSize: TDimension; const LineImage: TLineImage); var I: Integer; XPos, - Offset: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + Offset: TDimension; NewStyles: TLineImage; begin NewStyles := nil; @@ -25447,7 +25116,7 @@ procedure TBaseVirtualTree.PaintTreeLines(const PaintInfo: TVTPaintInfo; VAlignm //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.PaintSelectionRectangle(Target: TCanvas; WindowOrgX: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; const SelectionRect: TRect; +procedure TBaseVirtualTree.PaintSelectionRectangle(Target: TCanvas; WindowOrgX: TDimension; const SelectionRect: TRect; TargetRect: TRect); // Helper routine to draw a selection rectangle in the mode determined by DrawSelectionMode. @@ -25477,7 +25146,9 @@ procedure TBaseVirtualTree.PaintSelectionRectangle(Target: TCanvas; WindowOrgX: if IntersectRect(BlendRect, OrderRect(SelectionRect), TargetRect) then begin OffsetRect(BlendRect, -WindowOrgX, 0); - AlphaBlend(0, Target.Handle, BlendRect, Point(0, 0), bmConstantAlphaAndColor, FSelectionBlendFactor, + + dummyCanvas.Handle:= 0; + AlphaBlend(dummyCanvas, Target, BlendRect, Point(0, 0), bmConstantAlphaAndColor, FSelectionBlendFactor, ColorToRGB(FColors.SelectionRectangleBlendColor)); Target.{$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := FColors.SelectionRectangleBorderColor; @@ -25518,7 +25189,7 @@ procedure TBaseVirtualTree.PanningWindowProc(var Message: TMessage); //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX, MaxWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); +procedure TBaseVirtualTree.PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX, MaxWidth: TDimension); // This method is called immediately before a cell's content is drawn und is responsible to paint selection colors etc. {$IFDEF VT_VCL} @@ -25538,7 +25209,6 @@ procedure TBaseVirtualTree.PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX, var R: TRect; - begin // Take into account any window offset and size limitations in the target bitmap, as this is only as large // as necessary and might not cover the whole node. For normal painting this does not matter (because of @@ -25550,7 +25220,9 @@ procedure TBaseVirtualTree.PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX, R.Left := 0; if R.Right > MaxWidth then R.Right := MaxWidth; - AlphaBlend(0, PaintInfo.Canvas.Handle, R, Point(0, 0), bmConstantAlphaAndColor, + + dummyCanvas.Handle:= 0; + AlphaBlend(dummyCanvas, PaintInfo.Canvas, R, Point(0, 0), bmConstantAlphaAndColor, FSelectionBlendFactor, ColorToRGB(Color)); end; @@ -25757,7 +25429,7 @@ function TBaseVirtualTree.ReadChunk(Stream: TStream; Version: Integer; Node: PVi type TAdvancedVersion2Identifier = packed record ChildCount: Cardinal; - NodeHeight: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; + NodeHeight: TDimension; States: Word; Align: Byte; CheckState: TCheckState; @@ -26653,8 +26325,8 @@ procedure TBaseVirtualTree.UpdateHeaderRect; var OffsetX, - OffsetY: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; - EdgeSize: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + OffsetY: TDimension; + EdgeSize: TDimension; Size: TSize; begin @@ -26667,16 +26339,16 @@ procedure TBaseVirtualTree.UpdateHeaderRect; // ... and bevels. OffsetX := BorderWidth; OffsetY := BorderWidth; - if BevelKind <> bkNone then + if BevelKind <> TBevelKind.bkNone then begin EdgeSize := 0; - if BevelInner <> bvNone then + if BevelInner <> TBevelCut.bvNone then Inc(EdgeSize, BevelWidth); - if BevelOuter <> bvNone then + if BevelOuter <> TBevelCut.bvNone then Inc(EdgeSize, BevelWidth); - if beLeft in BevelEdges then + if TBevelEdge.beLeft in BevelEdges then Inc(OffsetX, EdgeSize); - if beTop in BevelEdges then + if TBevelEdge.beTop in BevelEdges then Inc(OffsetY, EdgeSize); end; @@ -26704,7 +26376,7 @@ procedure TBaseVirtualTree.UpdateEditBounds; CurrentAlignment: TAlignment; CurrentBidiMode: TBidiMode; offsets : TVTOffsets; - offset : {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + offset : TDimension; begin if (tsEditing in FStates) and Assigned(FFocusedNode) and @@ -27288,7 +26960,7 @@ procedure TBaseVirtualTree.AutoScale(isDpiChange: Boolean); // isDPIChnage is True, if the DPI of the form has changed. In this case the font may not yet be adapted to this, so do not adjust DefualtNodeHeight. var - lTextHeight: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; + lTextHeight: TDimension; begin if HandleAllocated and (toAutoChangeScale in TreeOptions.AutoOptions) and not isDpiChange then begin @@ -27541,7 +27213,7 @@ procedure TBaseVirtualTree.ClearSelection(pFireChangeEvent: Boolean); var Node: PVirtualNode; - Dummy: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + Dummy: TDimension; R: TRect; Counter: Integer; @@ -27745,7 +27417,7 @@ procedure TBaseVirtualTree.DeleteChildren(Node: PVirtualNode; ResetHasChildren: Run, Mark: PVirtualNode; LastTop, - LastLeft: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + LastLeft: TDimension; NewSize: Integer; ParentVisible: Boolean; @@ -27839,7 +27511,7 @@ procedure TBaseVirtualTree.DeleteNode(Node: PVirtualNode; Reindex: Boolean; Pare var LastTop, - LastLeft: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + LastLeft: TDimension; LastParent: PVirtualNode; WasInSynchMode: Boolean; @@ -28309,15 +27981,15 @@ function TBaseVirtualTree.GetDisplayRect(Node: PVirtualNode; Column: TColumnInde var Temp: PVirtualNode; - LeftOffset: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; - TopOffset: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; + LeftOffset: TDimension; + TopOffset: TDimension; CacheIsAvailable: Boolean; - TextWidth: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; + TextWidth: TDimension; CurrentBidiMode: TBidiMode; CurrentAlignment: TAlignment; - MaxUnclippedHeight: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; + MaxUnclippedHeight: TDimension; TM: TTextMetric; - ExtraVerticalMargin: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; + ExtraVerticalMargin: TDimension; lOffsets: TVTOffsets; begin Assert(Assigned(Node), 'Node must not be nil.'); @@ -28882,7 +28554,7 @@ function TBaseVirtualTree.GetFirstVisibleNoInit(Node: PVirtualNode = nil; //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.GetHitTestInfoAt(X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; Relative: Boolean; var HitInfo: THitInfo); +procedure TBaseVirtualTree.GetHitTestInfoAt(X, Y: TDimension; Relative: Boolean; var HitInfo: THitInfo); // Determines the node that occupies the specified point or nil if there's none. The parameter Relative determines // whether to consider X and Y as being client coordinates (if True) or as being absolute tree coordinates. @@ -28890,8 +28562,8 @@ procedure TBaseVirtualTree.GetHitTestInfoAt(X, Y: {$IFDEF VT_FMX}Single{$ELSE}In var ColLeft, - ColRight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; - NodeTop: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + ColRight: TDimension; + NodeTop: TDimension; InitialColumn, NextColumn: TColumnIndex; CurrentBidiMode: TBidiMode; @@ -29210,7 +28882,7 @@ function TBaseVirtualTree.GetLastVisibleNoInit(Node: PVirtualNode = nil; //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.GetMaxColumnWidth(Column: TColumnIndex; UseSmartColumnWidth: Boolean = False): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; +function TBaseVirtualTree.GetMaxColumnWidth(Column: TColumnIndex; UseSmartColumnWidth: Boolean = False): TDimension; // This method determines the width of the largest node in the given column. // If UseSmartColumnWidth is True then only the visible nodes which are in view will be considered @@ -29222,7 +28894,7 @@ function TBaseVirtualTree.GetMaxColumnWidth(Column: TColumnIndex; UseSmartColumn LastNode, NextNode: PVirtualNode; TextLeft, - CurrentWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + CurrentWidth: TDimension; lOffsets: TVTOffsets; begin if OperationCanceled then @@ -29877,13 +29549,13 @@ function TBaseVirtualTree.GetNextVisibleSiblingNoInit(Node: PVirtualNode; Includ //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.GetNodeAt(X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}): PVirtualNode; +function TBaseVirtualTree.GetNodeAt(X, Y: TDimension): PVirtualNode; // Overloaded variant of GetNodeAt to easy life of application developers which do not need to have the exact // top position returned and always use client coordinates. var - Dummy: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + Dummy: TDimension; begin Result := GetNodeAt(X, Y, True, Dummy); @@ -29896,7 +29568,7 @@ function TBaseVirtualTree.GetNodeAt(const P: TPoint): PVirtualNode; //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.GetNodeAt(X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; Relative: Boolean; var NodeTop: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}): PVirtualNode; +function TBaseVirtualTree.GetNodeAt(X, Y: TDimension; Relative: Boolean; var NodeTop: TDimension): PVirtualNode; // This method returns the node that occupies the specified point, or nil if there's none. // If Releative is True then X and Y are given in client coordinates otherwise they are considered as being @@ -29906,7 +29578,7 @@ function TBaseVirtualTree.GetNodeAt(X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$E var AbsolutePos, - CurrentPos: {$IFDEF VT_FMX}Single{$ELSE}Cardinal{$ENDIF}; + CurrentPos: TDimension; begin if Y < 0 then Y := 0; @@ -31435,7 +31107,7 @@ procedure TBaseVirtualTree.MeasureItemHeight(const Canvas: TCanvas; Node: PVirtu // If the height of the given node has not yet been measured then do it now. var - NewNodeHeight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + NewNodeHeight: TDimension; begin if not (vsHeightMeasured in Node.States) then @@ -31683,7 +31355,7 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe VAlign, IndentSize, - ButtonY: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; // Y position of toggle button within the node's rect + ButtonY: TDimension; // Y position of toggle button within the node's rect LineImage: TLineImage; PaintInfo: TVTPaintInfo; // all necessary information about a node to pass to the paint routines @@ -31692,20 +31364,20 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe SelectionRect, // ordered rectangle used for drawing the selection focus rect ClipRect: TRect; // area to which the canvas will be clipped when painting a node's content NextColumn: TColumnIndex; - BaseOffset: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; // top position of the top node to draw given in absolute tree coordinates + BaseOffset: TDimension; // top position of the top node to draw given in absolute tree coordinates NodeBitmap: TBitmap; // small buffer to draw flicker free MaximumRight, // maximum horizontal target position - MaximumBottom: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; // maximum vertical target position + MaximumBottom: TDimension; // maximum vertical target position SelectLevel: Integer; // > 0 if current node is selected or child/grandchild etc. of a selected node FirstColumn: TColumnIndex; // index of first column which is at least partially visible in the given window MaxRight, ColLeft, - ColRight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + ColRight: TDimension; SavedTargetDC: Integer; - PaintWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; - CurrentNodeHeight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + PaintWidth: TDimension; + CurrentNodeHeight: TDimension; lUseSelectedBkColor: Boolean; // determines if the dotted grid lines need to be painted in selection color of background color CellIsTouchingClientRight: Boolean; @@ -32408,7 +32080,7 @@ function TBaseVirtualTree.PasteFromClipboard: Boolean; //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.PrepareDragImage(HotSpot: TPoint; const DataObject: {$IFDEF VT_FMX}TDragObject{$ELSE}IDragObject{$ENDIF}); +procedure TBaseVirtualTree.PrepareDragImage(HotSpot: TPoint; const DataObject: {$IFDEF VT_FMX}TDragObject{$ELSE}IDataObject{$ENDIF}); // Initiates an image drag operation. HotSpot is the position of the mouse in client coordinates. @@ -32561,7 +32233,7 @@ procedure TBaseVirtualTree.Print(Printer: TPrinter; PrintHeader: Boolean); LogFont.lfQuality := ANTIALIASED_QUALITY; FHeader.Font.Handle := CreateFontIndirect(LogFont); ImgRect.Bottom := FHeader.Height; - FHeader.FColumns.PaintHeader(Image.Canvas.Handle, ImgRect, 0); + FHeader.FColumns.PaintHeader(Image.Canvas, ImgRect, 0); FHeader.Font := SaveHeaderFont; finally SaveHeaderFont.Free; @@ -32639,7 +32311,7 @@ procedure TBaseVirtualTree.Print(Printer: TPrinter; PrintHeader: Boolean); //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.ProcessDrop(const DataObject: {$IFDEF VT_FMX}TDragObject{$ELSE}IDragObject{$ENDIF}; TargetNode: PVirtualNode; var Effect: Integer; +function TBaseVirtualTree.ProcessDrop(const DataObject: {$IFDEF VT_FMX}TDragObject{$ELSE}IDataObject{$ENDIF}; TargetNode: PVirtualNode; var Effect: Integer; Mode: TVTNodeAttachMode): Boolean; // Recreates the (sub) tree structure serialized into memory and provided by DataObject. The new nodes are attached to @@ -33118,7 +32790,7 @@ function TBaseVirtualTree.ScrollIntoView(Node: PVirtualNode; Center: Boolean; Ho //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.ScaledPixels(pPixels: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; +function TBaseVirtualTree.ScaledPixels(pPixels: TDimension): TDimension; /// Returns the given pixels scaled to the current dpi assuming that we designed at 96dpi (100%) begin @@ -33136,8 +32808,8 @@ function TBaseVirtualTree.ScrollIntoView(Column: TColumnIndex; Center: Boolean; var ColumnLeft, - ColumnRight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; - NewOffset: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + ColumnRight: TDimension; + NewOffset: TDimension; R: TRect; begin @@ -33500,7 +33172,7 @@ procedure TBaseVirtualTree.ToggleNode(Node: PVirtualNode); FirstVisible: PVirtualNode; HeightDelta, StepsR1, - StepsR2: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + StepsR2: TDimension; Steps: Integer; TogglingTree, ChildrenInView, @@ -33519,7 +33191,7 @@ procedure TBaseVirtualTree.ToggleNode(Node: PVirtualNode); var R: TRect; - S: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + S: TDimension; M: TToggleAnimationMode; begin @@ -34775,7 +34447,7 @@ procedure TStringEditLink.SetBounds(R: TRect); // Sets the outer bounds of the edit control and the actual edit area in the control. var - lOffset, tOffset, height: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + lOffset, tOffset, height: TDimension; offsets : TVTOffsets; begin {$IFDEF VT_VCL} @@ -35066,11 +34738,11 @@ procedure TCustomVirtualStringTree.PaintNormalText(var PaintInfo: TVTPaintInfo; // the node rectangle. The clipping rectangle comprises the entire node (including tree lines, buttons etc.). var - TripleWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + TripleWidth: TDimension; R: TRect; DrawFormat: Cardinal; Size: TSize; - Height: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + Height: TDimension; begin InitializeTextProperties(PaintInfo); @@ -35375,7 +35047,7 @@ procedure TCustomVirtualStringTree.AdjustPaintCellRect(var PaintInfo: TVTPaintIn //---------------------------------------------------------------------------------------------------------------------- -function TCustomVirtualStringTree.CalculateStaticTextWidth(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const Text: string): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; +function TCustomVirtualStringTree.CalculateStaticTextWidth(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const Text: string): TDimension; begin Result := 0; @@ -35391,7 +35063,7 @@ function TCustomVirtualStringTree.CalculateStaticTextWidth(Canvas: TCanvas; Node //---------------------------------------------------------------------------------------------------------------------- function TCustomVirtualStringTree.CalculateTextWidth(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; - const Text: string): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + const Text: string): TDimension; // Determines the width of the given text. @@ -35483,7 +35155,7 @@ function TCustomVirtualStringTree.DoGetNodeTooltip(Node: PVirtualNode; Column: T //---------------------------------------------------------------------------------------------------------------------- function TCustomVirtualStringTree.DoGetNodeExtraWidth(Node: PVirtualNode; Column: TColumnIndex; - Canvas: TCanvas = nil): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + Canvas: TCanvas = nil): TDimension; begin if not (toShowStaticText in TreeOptions.FStringOptions) then @@ -35495,7 +35167,7 @@ function TCustomVirtualStringTree.DoGetNodeExtraWidth(Node: PVirtualNode; Column //---------------------------------------------------------------------------------------------------------------------- -function TCustomVirtualStringTree.DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; +function TCustomVirtualStringTree.DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): TDimension; // Returns the text width of the given node in pixels. // This width is stored in the node's data member to increase access speed. @@ -35631,7 +35303,7 @@ procedure TCustomVirtualStringTree.DoPaintText(Node: PVirtualNode; const Canvas: //---------------------------------------------------------------------------------------------------------------------- function TCustomVirtualStringTree.DoShortenString(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; - const S: string; Width: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; EllipsisWidth: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF} = 0): string; + const S: string; Width: TDimension; EllipsisWidth: TDimension = 0): string; var Done: Boolean; @@ -35641,7 +35313,7 @@ function TCustomVirtualStringTree.DoShortenString(Canvas: TCanvas; Node: PVirtua if Assigned(FOnShortenString) then FOnShortenString(Self, Canvas, Node, Column, S, Width, Result, Done); if not Done then - Result := ShortenString(Canvas{$IFDEF VT_VCL}.Handle{$ENDIF}, S, Width, EllipsisWidth); + Result := ShortenString(Canvas, S, Width, EllipsisWidth); end; //---------------------------------------------------------------------------------------------------------------------- @@ -35878,7 +35550,7 @@ procedure TCustomVirtualStringTree.WriteChunks(Stream: TStream; Node: PVirtualNo //---------------------------------------------------------------------------------------------------------------------- function TCustomVirtualStringTree.ComputeNodeHeight(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; - S: string): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + S: string): TDimension; // Default node height calculation for multi line nodes. This method can be used by the application to delegate the // computation to the string tree. @@ -36109,7 +35781,7 @@ procedure TCustomVirtualStringTree.GetTextInfo(Node: PVirtualNode; Column: TColu // bounding rectangle around Text. var - NewHeight: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; + NewHeight: TDimension; TM: TTextMetric; begin @@ -36269,7 +35941,7 @@ function TCustomVirtualDrawTree.DoGetCellContentMargin(Node: PVirtualNode; Colum //---------------------------------------------------------------------------------------------------------------------- -function TCustomVirtualDrawTree.DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}; +function TCustomVirtualDrawTree.DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): TDimension; begin Result := 2 * FTextMargin; @@ -36452,28 +36124,9 @@ function TSortDirectionHelper.ToInt(): Integer; Result := cSortDirectionToInt[Self]; end; -{ TChangeLink } -{$IFDEF VT_FMX} -constructor TChangeLink.Create; -begin - inherited; - IgnoreIndex := True; - IgnoreImages := True; -end; - -function TChangeLink.GetSender: TCustomImageList; -begin - Result := TCustomImageList(Images); -end; - -procedure TChangeLink.SetSender(const Value: TCustomImageList); -begin - Images := TBaseImageList(Value); -end; -{$ENDIF} { TVTPaintInfo } -procedure TVTPaintInfo.AdjustImageCoordinates(VAlign: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); +procedure TVTPaintInfo.AdjustImageCoordinates(VAlign: TDimension); // During painting of the main column some coordinates must be adjusted due to the tree lines. begin ContentRect := CellRect; From 545c10f5c60ce19b1f6a997991ef8611b59755a8 Mon Sep 17 00:00:00 2001 From: karol Date: Wed, 7 Nov 2018 11:31:32 +0100 Subject: [PATCH 03/61] added safer prevDC: HDC; when using dummyCanvas added safer prevDC: HDC; when using dummyCanvas --- Source/VirtualTrees.pas | 41 ++++++++++++++++++++++++++++++++--------- 1 file changed, 32 insertions(+), 9 deletions(-) diff --git a/Source/VirtualTrees.pas b/Source/VirtualTrees.pas index 2de06343c..87e93f20d 100644 --- a/Source/VirtualTrees.pas +++ b/Source/VirtualTrees.pas @@ -18307,6 +18307,7 @@ procedure TBaseVirtualTree.WMNCPaint(var Message: TWMNCPaint); procedure TBaseVirtualTree.WMPaint(var Message: TWMPaint); var DC: HDC; + prevDC: HDC; begin if tsVCLDragging in FStates then ImageList_DragShowNolock(False); @@ -18326,8 +18327,13 @@ procedure TBaseVirtualTree.WMPaint(var Message: TWMPaint); if DC <> 0 then try begin + prevDC:= dummyCanvas.Handle; dummyCanvas.Handle:= DC; - FHeader.FColumns.PaintHeader(dummyCanvas, FHeaderRect, -FEffectiveOffsetX); + try + FHeader.FColumns.PaintHeader(dummyCanvas, FHeaderRect, -FEffectiveOffsetX); + finally + dummyCanvas.Handle:= prevDC; + end; end; finally ReleaseDC(Handle, DC); @@ -18349,12 +18355,18 @@ procedure TBaseVirtualTree.WMPrint(var Message: TWMPrint); // This message is sent to request that the tree draws itself to a given device context. This includes not only // the client area but also the non-client area (header!). +Var prevDC: HDC; begin // Draw only if the window is visible or visibility is not required. if ((Message.Flags and PRF_CHECKVISIBLE) = 0) or IsWindowVisible(Handle) then begin - dummyCanvas.Handle:= Message.DC; - Header.Columns.PaintHeader(dummyCanvas, FHeaderRect, -FEffectiveOffsetX); + prevDC:= dummyCanvas.Handle; + try + dummyCanvas.Handle:= Message.DC; + Header.Columns.PaintHeader(dummyCanvas, FHeaderRect, -FEffectiveOffsetX); + finally + dummyCanvas.Handle:= prevDC; + end; end; inherited; @@ -25125,6 +25137,7 @@ procedure TBaseVirtualTree.PaintSelectionRectangle(Target: TCanvas; WindowOrgX: BlendRect: TRect; TextColorBackup, BackColorBackup: COLORREF; // used to restore forground and background colors when drawing a selection rectangle + prevDC: HDC; {$ENDIF} begin {$IFDEF VT_VCL} @@ -25146,10 +25159,14 @@ procedure TBaseVirtualTree.PaintSelectionRectangle(Target: TCanvas; WindowOrgX: if IntersectRect(BlendRect, OrderRect(SelectionRect), TargetRect) then begin OffsetRect(BlendRect, -WindowOrgX, 0); - - dummyCanvas.Handle:= 0; - AlphaBlend(dummyCanvas, Target, BlendRect, Point(0, 0), bmConstantAlphaAndColor, FSelectionBlendFactor, - ColorToRGB(FColors.SelectionRectangleBlendColor)); + prevDC:= dummyCanvas.Handle; + try + dummyCanvas.Handle:= 0; + AlphaBlend(dummyCanvas, Target, BlendRect, Point(0, 0), bmConstantAlphaAndColor, FSelectionBlendFactor, + ColorToRGB(FColors.SelectionRectangleBlendColor)); + finally + dummyCanvas.Handle:= prevDC; + end; Target.{$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := FColors.SelectionRectangleBorderColor; Target.FrameRect(SelectionRect); @@ -25209,6 +25226,7 @@ procedure TBaseVirtualTree.PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX, var R: TRect; + prevDC: HDC; begin // Take into account any window offset and size limitations in the target bitmap, as this is only as large // as necessary and might not cover the whole node. For normal painting this does not matter (because of @@ -25221,9 +25239,14 @@ procedure TBaseVirtualTree.PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX, if R.Right > MaxWidth then R.Right := MaxWidth; + prevDC:= dummyCanvas.Handle; dummyCanvas.Handle:= 0; - AlphaBlend(dummyCanvas, PaintInfo.Canvas, R, Point(0, 0), bmConstantAlphaAndColor, - FSelectionBlendFactor, ColorToRGB(Color)); + try + AlphaBlend(dummyCanvas, PaintInfo.Canvas, R, Point(0, 0), bmConstantAlphaAndColor, + FSelectionBlendFactor, ColorToRGB(Color)); + finally + dummyCanvas.Handle:= prevDC; + end; end; //--------------------------------------------------------------------------- From eabd4c676b3bb26e72ee044299cff0113a3896f9 Mon Sep 17 00:00:00 2001 From: karol Date: Wed, 7 Nov 2018 11:40:21 +0100 Subject: [PATCH 04/61] move some specific function sto VirtualTrees.FMX move some specific function sto VirtualTrees.FMX - DrawTextW - GetTextExtentPoint32W - DrawEdge --- Source/VirtualTrees.FMX.pas | 60 +++++++++++++++++++++++++++++++++++ Source/VirtualTrees.Utils.pas | 15 ++------- 2 files changed, 62 insertions(+), 13 deletions(-) diff --git a/Source/VirtualTrees.FMX.pas b/Source/VirtualTrees.FMX.pas index c2fb71c35..192736ff9 100644 --- a/Source/VirtualTrees.FMX.pas +++ b/Source/VirtualTrees.FMX.pas @@ -208,9 +208,43 @@ TTextMetric = record procedure CopyMemory(Destination: Pointer; Source: Pointer; Length: NativeUInt); +procedure DrawTextW(ACanvas: TCanvas; CaptionText: String; Len: Integer; Bounds: TRectF; DrawFormat: Cardinal{this is windows format - must be converted to FMX}); +procedure GetTextExtentPoint32W(ACanvas: TCanvas; CaptionText: String; Len: Integer; Var Size: TSizeF); +{--}procedure DrawEdge(TargetCanvas: TCanvas; PaintRectangle: TRectF; PressedButtonStyle, PressedButtonFlags: Cardinal); + implementation uses FMX.TextLayout, System.SysUtils; +//---------------------------------------------------------------------------------------------------------------------- + +procedure DrawTextW(ACanvas: TCanvas; CaptionText: String; Len: Integer; Bounds: TRectF; DrawFormat: Cardinal{this is windows format - must be converted to FMX}); +begin + //TTextLayout. render + //DrawFormat: Cardinal{this is windows format - must be converted to FMX} + ACanvas.FillText(Bounds, CaptionText, false, 1.0, [], TTextAlign.Leading, TTextAlign.Center); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure DrawEdge(TargetCanvas: TCanvas; PaintRectangle: TRectF; PressedButtonStyle, PressedButtonFlags: Cardinal); +begin + //TODO: DrawEdge + //NormalButtonStyle + //RaisedButtonStyle + //RaisedButtonFlags or RightBorderFlag + //NormalButtonFlags or RightBorderFlag +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure GetTextExtentPoint32W(ACanvas: TCanvas; CaptionText: String; Len: Integer; Var Size: TSizeF); +begin + Size.cx:= ACanvas.TextWidth(Copy(CaptionText, 1, Len)); + Size.cy:= ACanvas.TextHeight(Copy(CaptionText, 1, Len)); +end; + +//---------------------------------------------------------------------------------------------------------------------- + procedure GetTextMetrics(ACanvas: TCanvas; var TM: TTextMetric); Var P: TPathData; tx: TTextLayout; @@ -290,52 +324,72 @@ procedure GetTextMetrics(ACanvas: TCanvas; var TM: TTextMetric); end; end; +//---------------------------------------------------------------------------------------------------------------------- + function Rect(ALeft, ATop, ARight, ABottom: Single): TRect; begin Result:= RectF(ALeft, ATop, ARight, ABottom); end; +//---------------------------------------------------------------------------------------------------------------------- + function Rect(const ATopLeft, ABottomRight: TPoint): TRect; begin Result:= RectF(ATopLeft.X, ATopLeft.Y, ABottomRight.X, ABottomRight.Y); end; +//---------------------------------------------------------------------------------------------------------------------- + function Point(AX, AY: Single): TPoint; begin Result.X:= AX; Result.Y:= AY; end; +//---------------------------------------------------------------------------------------------------------------------- + procedure Inc(Var V: Single; OIle: Single=1.0); begin V:= V + OIle; end; +//---------------------------------------------------------------------------------------------------------------------- + procedure Dec(Var V: Single; OIle: Single=1.0); begin V:= V - OIle; end; +//---------------------------------------------------------------------------------------------------------------------- + function MulDiv(const A, B, C: Single): Single; begin Result:= (A * B) / C; end; +//---------------------------------------------------------------------------------------------------------------------- + procedure FillMemory(Destination: Pointer; Length: NativeUInt; Fill: Byte); begin FillChar(Destination^, Length, Fill); end; +//---------------------------------------------------------------------------------------------------------------------- + procedure ZeroMemory(Destination: Pointer; Length: NativeUInt); begin FillChar(Destination^, Length, 0); end; +//---------------------------------------------------------------------------------------------------------------------- + procedure MoveMemory(Destination: Pointer; Source: Pointer; Length: NativeUInt); begin Move(Source^, Destination^, Length); end; +//---------------------------------------------------------------------------------------------------------------------- + procedure CopyMemory(Destination: Pointer; Source: Pointer; Length: NativeUInt); begin Move(Source^, Destination^, Length); @@ -343,6 +397,8 @@ procedure CopyMemory(Destination: Pointer; Source: Pointer; Length: NativeUInt); { TChangeLink } +//---------------------------------------------------------------------------------------------------------------------- + constructor TChangeLink.Create; begin inherited; @@ -350,11 +406,15 @@ constructor TChangeLink.Create; IgnoreImages := True; end; +//---------------------------------------------------------------------------------------------------------------------- + function TChangeLink.GetSender: TCustomImageList; begin Result := TCustomImageList(Images); end; +//---------------------------------------------------------------------------------------------------------------------- + procedure TChangeLink.SetSender(const Value: TCustomImageList); begin Images := TBaseImageList(Value); diff --git a/Source/VirtualTrees.Utils.pas b/Source/VirtualTrees.Utils.pas index 9cfc8a231..edbf6de82 100644 --- a/Source/VirtualTrees.Utils.pas +++ b/Source/VirtualTrees.Utils.pas @@ -90,11 +90,7 @@ function WrapString(ACanvas: TCanvas; const S: string; const Bounds: TRect; RTL: // Calculates bounds of a drawing rectangle for the given string procedure GetStringDrawRect(ACanvas: TCanvas; const S: string; var Bounds: TRect; DrawFormat: Cardinal); -{$IFDEF VT_FMX} -procedure DrawTextW(ACanvas: TCanvas; CaptionText: String; Len: Integer; Bounds: TRectF; DrawFormat: Cardinal{this is windows format - must be converted to FMX}); -procedure GetTextExtentPoint32W(ACanvas: TCanvas; CaptionText: String; Len: Integer; Var Size: TSizeF); -{--}procedure DrawEdge(TargetCanvas: TCanvas; PaintRectangle: TRectF; PressedButtonStyle, PressedButtonFlags: Cardinal); -{$ENDIF} + // Converts the incoming rectangle so that left and top are always less than or equal to right and bottom. function OrderRect(const R: TRect): TRect; @@ -189,14 +185,7 @@ function OrderRect(const R: TRect): TRect; end; //---------------------------------------------------------------------------------------------------------------------- -{$IFDEF VT_FMX} -procedure DrawTextW(ACanvas: TCanvas; CaptionText: String; Len: Integer; Bounds: TRectF; DrawFormat: Cardinal{this is windows format - must be converted to FMX}); -begin - //TTextLayout. render - //DrawFormat: Cardinal{this is windows format - must be converted to FMX} - ACanvas.FillText(Bounds, CaptionText, false, 1.0, [], TTextAlign.Leading, TTextAlign.Center); -end; -{$ELSE} +{$IFDEF VT_VCL} procedure SetBrushOrigin(Canvas: TCanvas; X, Y: Integer); // Set the brush origin of a given canvas. From 619cacec3c8a374974c6cb71abaf4adfc319f440 Mon Sep 17 00:00:00 2001 From: karol Date: Wed, 7 Nov 2018 11:46:46 +0100 Subject: [PATCH 05/61] fix introduced warnings fix introduced warnings --- Source/VirtualTrees.pas | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/Source/VirtualTrees.pas b/Source/VirtualTrees.pas index 87e93f20d..699d130bb 100644 --- a/Source/VirtualTrees.pas +++ b/Source/VirtualTrees.pas @@ -13042,9 +13042,9 @@ function TBaseVirtualTree.CollectSelectedNodesRTL(MainColumn: Integer; NodeLeft, begin // The initial minimal left border is determined by the identation level of the node and is dynamically adjusted. if toShowRoot in FOptions.FPaintOptions then - Dec(NodeRight, {$IFDEF VT_VCL}Integer{$ENDIF}((GetNodeLevel(Run) + 1) * FIndent) + FMargin) + Dec(NodeRight, {$IFDEF VT_VCL}Integer{$ENDIF}(({$IFDEF VT_VCL}Integer{$ENDIF}(GetNodeLevel(Run)) + 1) * FIndent) + FMargin) else - Dec(NodeRight, {$IFDEF VT_VCL}Integer{$ENDIF}(GetNodeLevel(Run) * FIndent) + FMargin); + Dec(NodeRight, {$IFDEF VT_VCL}Integer{$ENDIF}({$IFDEF VT_VCL}Integer{$ENDIF}(GetNodeLevel(Run)) * FIndent) + FMargin); // ----- main loop // Change selection depending on the node's rectangle being in the selection rectangle or not, but @@ -16826,7 +16826,7 @@ procedure TBaseVirtualTree.CMMouseWheel(var Message: TCMMouseWheel); begin Result := 1; WheelFactor := WheelDelta / WHEEL_DELTA; - if (FRangeY > Cardinal(ClientHeight)) and (not (ssShift in ShiftState)) then + if (FRangeY > ClientHeight) and (not (ssShift in ShiftState)) then begin // Scroll vertically if there's something to scroll... if ssCtrl in ShiftState then @@ -19047,12 +19047,12 @@ function TBaseVirtualTree.CalculateSelectionRect(X, Y: TDimension): Boolean; if FNewSelRect.Bottom < 0 then FNewSelRect.Bottom := 0; MaxValue := ClientWidth; - if FRangeX > {$IFDEF VT_VCL}Cardinal{$ENDIF}(MaxValue) then + if FRangeX > MaxValue then MaxValue := FRangeX; if FNewSelRect.Right > MaxValue then FNewSelRect.Right := MaxValue; MaxValue := ClientHeight; - if FRangeY > {$IFDEF VT_VCL}Cardinal{$ENDIF}(MaxValue) then + if FRangeY > MaxValue then MaxValue := FRangeY; if FNewSelRect.Bottom > MaxValue then FNewSelRect.Bottom := MaxValue; From cc9c95e213ff235f5c55c3bf13dbdb12bde00284 Mon Sep 17 00:00:00 2001 From: karol Date: Wed, 7 Nov 2018 11:49:58 +0100 Subject: [PATCH 06/61] missed uses "FMX.Types" missed uses "FMX.Types" --- Source/VirtualTrees.FMX.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Source/VirtualTrees.FMX.pas b/Source/VirtualTrees.FMX.pas index 192736ff9..0e39364a4 100644 --- a/Source/VirtualTrees.FMX.pas +++ b/Source/VirtualTrees.FMX.pas @@ -213,7 +213,7 @@ procedure GetTextExtentPoint32W(ACanvas: TCanvas; CaptionText: String; Len: Inte {--}procedure DrawEdge(TargetCanvas: TCanvas; PaintRectangle: TRectF; PressedButtonStyle, PressedButtonFlags: Cardinal); implementation -uses FMX.TextLayout, System.SysUtils; +uses FMX.TextLayout, System.SysUtils, FMX.Types; //---------------------------------------------------------------------------------------------------------------------- From a5113f5db9961309150cc7f44119688c25b76400 Mon Sep 17 00:00:00 2001 From: Karol Bieniaszewski Date: Wed, 7 Nov 2018 18:52:38 +0100 Subject: [PATCH 07/61] code cleanup cast to integer not needed after TDimension introduced code cleanup - removed unnescessary cast to integer not needed after TDimension introduced in the same time many ifdefs specific to VCL are not needed - fixed some comments positions --- Source/VirtualTrees.pas | 174 ++++++++++++++++++++-------------------- 1 file changed, 85 insertions(+), 89 deletions(-) diff --git a/Source/VirtualTrees.pas b/Source/VirtualTrees.pas index 699d130bb..74ab7f867 100644 --- a/Source/VirtualTrees.pas +++ b/Source/VirtualTrees.pas @@ -693,14 +693,14 @@ TVTReference = record TVirtualNode = packed record Index, // index of node with regard to its parent ChildCount: Cardinal; // number of child nodes - NodeHeight: TDimension; // height in pixels + NodeHeight: TDimension; // height in pixels States: TVirtualNodeStates; // states describing various properties of the node (expanded, initialized etc.) Align: Byte; // line/button alignment CheckState: TCheckState; // indicates the current check state (e.g. checked, pressed etc.) CheckType: TCheckType; // indicates which check type shall be used for this node Dummy: Byte; // dummy value to fill DWORD boundary TotalCount: Cardinal; // sum of this node, all of its child nodes and their child nodes etc. - TotalHeight: TDimension; // height in pixels this node covers on screen including the height of all of its + TotalHeight: TDimension; // height in pixels this node covers on screen including the height of all of its // children // Note: Some copy routines require that all pointers (as well as the data area) in a node are // located at the end of the node! Hence if you want to add new member fields (except pointers to internal @@ -1298,13 +1298,13 @@ TVTHeader = class(TPersistent) FFixedAreaConstraints: TVTFixedAreaConstraints; // Percentages for the fixed area (header, fixed columns). FImages: TCustomImageList; FImageChangeLink: TChangeLink; // connections to the image list to get notified about changes - fSplitterHitTolerance: Integer; // For property SplitterHitTolerance + fSplitterHitTolerance: Integer; // For property SplitterHitTolerance FSortColumn: TColumnIndex; FSortDirection: TSortDirection; {$IFDEF VT_VCL} FDragImage: TVTDragImage; // drag image management during header drag {$ENDIF} - FLastWidth: TDimension; // Used to adjust spring columns. This is the width of all visible columns, + FLastWidth: TDimension; // Used to adjust spring columns. This is the width of all visible columns, // not the header rectangle. procedure FontChanged(Sender: TObject); function GetMainColumn: TColumnIndex; @@ -1695,9 +1695,9 @@ TVTColors = class(TPersistent) // For painting a node and its columns/cells a lot of information must be passed frequently around. TVTImageInfo = record - Index: TImageIndex; // Index in the associated image list. + Index: TImageIndex; // Index in the associated image list. XPos, // Horizontal position in the current target canvas. - YPos: TDimension; // Vertical position in the current target canvas. + YPos: TDimension; // Vertical position in the current target canvas. Ghosted: Boolean; // Flag to indicate that the image must be drawn slightly lighter. Images: TCustomImageList; // The image list to be used for painting. function Equals(const pImageInfo2: TVTImageInfo): Boolean; @@ -1740,7 +1740,7 @@ TVTPaintInfo = record Position: TColumnPosition; // the column position of the node CellRect: TRect; // the node cell ContentRect: TRect; // the area of the cell used for the node's content - NodeWidth: TDimension; // the actual node width + NodeWidth: TDimension; // the actual node width Alignment: TAlignment; // how to align within the node rectangle CaptionAlignment: TAlignment; // how to align text within the caption rectangle BidiMode: TBidiMode; // directionality to be used for painting @@ -2085,17 +2085,17 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF FBackgroundImageTransparent: Boolean; // By default, this is off. When switched on, will try to draw the image // transparent by using the color of the component as transparent color - FMargin: TDimension; // horizontal distance to border and columns - FTextMargin: TDimension; // space between the node's text and its horizontal bounds + FMargin: TDimension; // horizontal distance to border and columns + FTextMargin: TDimension; // space between the node's text and its horizontal bounds FBackgroundOffsetX, - FBackgroundOffsetY: TDimension; // used to fine tune the position of the background image + FBackgroundOffsetY: TDimension; // used to fine tune the position of the background image FAnimationDuration: Cardinal; // specifies how long an animation shall take (expanding, hint) FWantTabs: Boolean; // If True then the tree also consumes the tab key. FNodeAlignment: TVTNodeAlignment; // determines how to interpret the align member of a node FHeaderRect: TRect; // Space which the header currently uses in the control (window coords). FLastHintRect: TRect; // Area which the mouse must leave to reshow a hint. FUpdateRect: TRect; - FEmptyListMessage: string; // Optional message that will be displayed if no nodes exist in the control. + FEmptyListMessage: string; // Optional message that will be displayed if no nodes exist in the control. // paint support and images FPlusBM, @@ -2110,7 +2110,7 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF FCheckImageKind: TCheckImageKind; // light or dark, cross marks or tick marks FCheckImages: TCustomImageList; // Reference to global image list to be used for the check images. //TODO: Use this margin for other images as well - FImagesMargin: TDimension; // The margin used left and right of the checkboxes. + FImagesMargin: TDimension; // The margin used left and right of the checkboxes. FImageChangeLink, FStateChangeLink, FCustomCheckChangeLink: TChangeLink; // connections to the image lists @@ -2157,11 +2157,11 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF FAutoExpandDelay: Cardinal; // amount of milliseconds to wait until a node is expanded if it is the // drop target FOffsetX: TDimension; - FOffsetY: TDimension; // Determines left and top scroll offset. - FEffectiveOffsetX: TDimension; // Actual position of the horizontal scroll bar (varies depending on bidi mode). + FOffsetY: TDimension; // Determines left and top scroll offset. + FEffectiveOffsetX: TDimension; // Actual position of the horizontal scroll bar (varies depending on bidi mode). FRangeX, - FRangeY: TDimension; // current virtual width and height of the tree - FBottomSpace: TDimension; // Extra space below the last node. + FRangeY: TDimension; // current virtual width and height of the tree + FBottomSpace: TDimension; // Extra space below the last node. FDefaultPasteMode: TVTNodeAttachMode; // Used to determine where to add pasted nodes to. FSingletonNodeArray: TNodeArray; // Contains only one element for quick addition of single nodes @@ -2171,7 +2171,7 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF // search FIncrementalSearch: TVTIncrementalSearch; // Used to determine whether and how incremental search is to be used. FSearchTimeout: Cardinal; // Number of milliseconds after which to stop incremental searching. - FSearchBuffer: string; // Collects a sequence of keypresses used to do incremental searching. + FSearchBuffer: string; // Collects a sequence of keypresses used to do incremental searching. FLastSearchNode: PVirtualNode; // Reference to node which was last found as search fit. FSearchDirection: TVTSearchDirection; // Direction to incrementally search the tree. FSearchStart: TVTSearchStart; // Where to start iteration on each key press. @@ -8322,7 +8322,7 @@ function TVirtualTreeColumns.HandleClick(P: TPoint; Button: TMouseButton; {$IFDE Self.FDownIndex := NoColumn; Self.FTrackIndex := NoColumn; Self.FCheckBoxHit := False; - Menu := Header.DoGetPopupMenu(Self.ColumnFromPosition(Point(P.X, P.Y + {$IFDEF VT_VCL}Integer{$ENDIF}(Header.Treeview.Height))), P); + Menu := Header.DoGetPopupMenu(Self.ColumnFromPosition(Point(P.X, P.Y + Header.Treeview.Height)), P); if Assigned(Menu) then begin Header.Treeview.StopTimer(ScrollTimer); @@ -8892,7 +8892,7 @@ function TVirtualTreeColumns.GetScrollWidth: TDimension; if ScrollColumnCount > 0 then // use average width Result := Round(Result / ScrollColumnCount) else // use indent - Result := {$IFDEF VT_VCL}Integer{$ENDIF}(FHeader.Treeview.FIndent); + Result := FHeader.Treeview.FIndent; end; @@ -12575,16 +12575,12 @@ procedure TBaseVirtualTree.AdjustTotalHeight(Node: PVirtualNode; Value: TDimensi if Relative then Difference := Value else - Difference := Value - {$IFDEF VT_VCL}Integer{$ENDIF}(Node.TotalHeight); + Difference := Value - Node.TotalHeight; if Difference <> 0 then begin Run := Node; repeat -{$IFDEF VT_FMX} Inc(Run.TotalHeight, Difference); -{$ELSE} - Inc(Integer(Run.TotalHeight), Difference); -{$ENDIF} // If the node is not visible or the parent node is not expanded or we are already at the top // then nothing more remains to do. @@ -12626,7 +12622,7 @@ procedure TBaseVirtualTree.CalculateVerticalAlignments(ShowImages, ShowStateImag naFromTop: VAlign := Node.Align; naFromBottom: - VAlign := {$IFDEF VT_VCL}Integer{$ENDIF}(NodeHeight[Node]) - Node.Align; + VAlign := NodeHeight[Node] - Node.Align; else // naProportional // Consider button and line alignment, but make sure neither the image nor the button (whichever is taller) // go out of the entire node height (100% means bottom alignment to the node's bounds). @@ -12635,14 +12631,14 @@ procedure TBaseVirtualTree.CalculateVerticalAlignments(ShowImages, ShowStateImag if ShowImages then VAlign := GetImageSize(Node).cy else - VAlign := {$IFDEF VT_FMX}16{$ELSE}FStateImages.Height{$ENDIF}; //TODO: 16px Image! - VAlign := MulDiv(({$IFDEF VT_VCL}Integer{$ENDIF}(NodeHeight[Node]) - VAlign), Node.Align, 100) + VAlign {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2; + VAlign := {$IFDEF VT_FMX}16{$ELSE}FStateImages.Height{$ENDIF}; //TODO: 16px Image! + VAlign := MulDiv((NodeHeight[Node] - VAlign), Node.Align, 100) + VAlign {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2; end else if toShowButtons in FOptions.FPaintOptions then - VAlign := MulDiv(({$IFDEF VT_VCL}Integer{$ENDIF}(NodeHeight[Node]) - FPlusBM.Height), Node.Align, 100) + FPlusBM.Height {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2 + VAlign := MulDiv((NodeHeight[Node] - FPlusBM.Height), Node.Align, 100) + FPlusBM.Height {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2 else - VAlign := MulDiv({$IFDEF VT_VCL}Integer{$ENDIF}(Node.NodeHeight), Node.Align, 100); + VAlign := MulDiv(Node.NodeHeight, Node.Align, 100); end; VButtonAlign := VAlign - FPlusBM.Height div 2 - (FPlusBM.Height and 1); @@ -12880,7 +12876,7 @@ function TBaseVirtualTree.CollectSelectedNodesLTR(MainColumn: Integer; NodeLeft, repeat // Collect offsets for check, normal and state images. TextLeft := NodeLeft + LabelOffset; - NextTop := CurrentTop + {$IFDEF VT_VCL}Integer{$ENDIF}(NodeHeight[Run]); + NextTop := CurrentTop + NodeHeight[Run]; // Simple selection allows to draw the selection rectangle anywhere. No intersection with node captions is // required. Only top and bottom bounds of the rectangle matter. @@ -12969,7 +12965,7 @@ function TBaseVirtualTree.CollectSelectedNodesLTR(MainColumn: Integer; NodeLeft, NextNode := GetNextVisibleNoInit(Run, True); if NextNode = nil then Break; - Inc(NodeLeft, CountLevelDifference(Run, NextNode) * {$IFDEF VT_VCL}Integer{$ENDIF}(FIndent)); + Inc(NodeLeft, CountLevelDifference(Run, NextNode) * FIndent); Run := NextNode; until CurrentTop > MaxY; end; @@ -13042,9 +13038,9 @@ function TBaseVirtualTree.CollectSelectedNodesRTL(MainColumn: Integer; NodeLeft, begin // The initial minimal left border is determined by the identation level of the node and is dynamically adjusted. if toShowRoot in FOptions.FPaintOptions then - Dec(NodeRight, {$IFDEF VT_VCL}Integer{$ENDIF}(({$IFDEF VT_VCL}Integer{$ENDIF}(GetNodeLevel(Run)) + 1) * FIndent) + FMargin) + Dec(NodeRight, (({$IFDEF VT_VCL}Integer{$ENDIF}(GetNodeLevel(Run)) + 1) * FIndent) + FMargin) else - Dec(NodeRight, {$IFDEF VT_VCL}Integer{$ENDIF}({$IFDEF VT_VCL}Integer{$ENDIF}(GetNodeLevel(Run)) * FIndent) + FMargin); + Dec(NodeRight, ({$IFDEF VT_VCL}Integer{$ENDIF}(GetNodeLevel(Run)) * FIndent) + FMargin); // ----- main loop // Change selection depending on the node's rectangle being in the selection rectangle or not, but @@ -13057,7 +13053,7 @@ function TBaseVirtualTree.CollectSelectedNodesRTL(MainColumn: Integer; NodeLeft, Dec(TextRight, GetImageSize(Run, ikNormal, MainColumn).cx); if WithStateImages then Dec(TextRight, GetImageSize(Run, ikState, MainColumn).cx); - NextTop := CurrentTop + {$IFDEF VT_VCL}Integer{$ENDIF}(NodeHeight[Run]); + NextTop := CurrentTop + NodeHeight[Run]; // Simple selection allows to draw the selection rectangle anywhere. No intersection with node captions is // required. Only top and bottom bounds of the rectangle matter. @@ -13142,7 +13138,7 @@ function TBaseVirtualTree.CollectSelectedNodesRTL(MainColumn: Integer; NodeLeft, NextNode := GetNextVisibleNoInit(Run, True); if NextNode = nil then Break; - Dec(NodeRight, CountLevelDifference(Run, NextNode) * {$IFDEF VT_VCL}Integer{$ENDIF}(FIndent)); + Dec(NodeRight, CountLevelDifference(Run, NextNode) * FIndent); Run := NextNode; until CurrentTop > MaxY; end; @@ -13323,7 +13319,7 @@ procedure TBaseVirtualTree.DrawLineImage(const PaintInfo: TVTPaintInfo; X, Y, H, if Reverse then TargetX := 0 else - TargetX := {$IFDEF VT_VCL}Integer{$ENDIF}(FIndent) + ScaledPixels(FImagesMargin); + TargetX := FIndent + ScaledPixels(FImagesMargin); with PaintInfo.Canvas do begin @@ -13349,19 +13345,19 @@ procedure TBaseVirtualTree.DrawLineImage(const PaintInfo: TVTPaintInfo; X, Y, H, end; ltLeft: // left can also mean right for RTL context if Reverse then - DrawDottedVLine(PaintInfo, Y, Y + H, X + {$IFDEF VT_VCL}Integer{$ENDIF}(FIndent)) + DrawDottedVLine(PaintInfo, Y, Y + H, X + FIndent) else DrawDottedVLine(PaintInfo, Y, Y + H, X); ltLeftBottom: if Reverse then begin - DrawDottedVLine(PaintInfo, Y, Y + H, X + {$IFDEF VT_VCL}Integer{$ENDIF}(FIndent)); - DrawDottedHLine(PaintInfo, X, X + {$IFDEF VT_VCL}Integer{$ENDIF}(FIndent), Y + H); + DrawDottedVLine(PaintInfo, Y, Y + H, X + FIndent); + DrawDottedHLine(PaintInfo, X, X + FIndent, Y + H); end else begin DrawDottedVLine(PaintInfo, Y, Y + H, X); - DrawDottedHLine(PaintInfo, X, X + {$IFDEF VT_VCL}Integer{$ENDIF}(FIndent), Y + H); + DrawDottedHLine(PaintInfo, X, X + FIndent, Y + H); end; end; end; @@ -13739,9 +13735,9 @@ procedure TBaseVirtualTree.GetOffsets(pNode: PVirtualNode; out pOffsets: TVTOffs end else lNodeLevel := 1; - Inc(pOffsets[TVTElement.ofsCheckBox], lNodeLevel * {$IFDEF VT_VCL}Integer{$ENDIF}(FIndent)); + Inc(pOffsets[TVTElement.ofsCheckBox], lNodeLevel * FIndent); // toggle buttons - pOffsets[TVTElement.ofsToggleButton] := pOffsets[TVTElement.ofsCheckBox] - fImagesMargin - (({$IFDEF VT_VCL}Integer{$ENDIF}(FIndent) - FPlusBM.Width) {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2) + 1 - FPlusBM.Width; //Compare PaintTree() relative line 107 + pOffsets[TVTElement.ofsToggleButton] := pOffsets[TVTElement.ofsCheckBox] - fImagesMargin - ((FIndent - FPlusBM.Width) {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2) + 1 - FPlusBM.Width; //Compare PaintTree() relative line 107 end;//if MainColumn // The area in which the toggle buttons are painted must have exactly the size of one indent level @@ -14773,7 +14769,7 @@ procedure TBaseVirtualTree.SetBottomNode(Node: PVirtualNode); Run := Run.Parent; end; R := GetDisplayRect(Node, FHeader.MainColumn, True); - DoSetOffsetXY(Point(FOffsetX, FOffsetY + ClientHeight - R.Top - {$IFDEF VT_VCL}Integer{$ENDIF}(NodeHeight[Node])), + DoSetOffsetXY(Point(FOffsetX, FOffsetY + ClientHeight - R.Top - NodeHeight[Node]), [suoRepaintScrollBars, suoUpdateNCArea]); end; end; @@ -15299,7 +15295,7 @@ procedure TBaseVirtualTree.SetFiltered(Node: PVirtualNode; Value: Boolean); if (vsInitializing in Node.States) and not (vsHasChildren in Node.States) then AdjustTotalHeight(Node, 0, False) else - AdjustTotalHeight(Node, -{$IFDEF VT_VCL}Integer{$ENDIF}(NodeHeight[Node]), True); + AdjustTotalHeight(Node, -NodeHeight[Node], True); if FullyVisible[Node] then begin System.Dec(FVisibleCount); @@ -15319,7 +15315,7 @@ procedure TBaseVirtualTree.SetFiltered(Node: PVirtualNode; Value: Boolean); Exclude(Node.States, vsFiltered); if not (toShowFilteredNodes in FOptions.FPaintOptions) then begin - AdjustTotalHeight(Node, {$IFDEF VT_VCL}Integer{$ENDIF}(NodeHeight[Node]), True); + AdjustTotalHeight(Node, NodeHeight[Node], True); if FullyVisible[Node] then begin System.Inc(FVisibleCount); @@ -15529,7 +15525,7 @@ procedure TBaseVirtualTree.SetNodeHeight(Node: PVirtualNode; Value: TDimension); begin if Assigned(Node) and (Node <> FRoot) and (Node.NodeHeight <> Value) and not (toReadOnly in FOptions.FMiscOptions) then begin - Difference := {$IFDEF VT_VCL}Integer{$ENDIF}(Value) - {$IFDEF VT_VCL}Integer{$ENDIF}(Node.NodeHeight); + Difference := Value - Node.NodeHeight; Node.NodeHeight := Value; // If the node is effectively filtered out, nothing else has to be done, as it is not visible anyway. @@ -15836,7 +15832,7 @@ procedure TBaseVirtualTree.SetVisible(Node: PVirtualNode; Value: Boolean); else begin if vsExpanded in Node.Parent.States then - AdjustTotalHeight(Node.Parent, -{$IFDEF VT_VCL}Integer{$ENDIF}(Node.TotalHeight), True); + AdjustTotalHeight(Node.Parent, -Node.TotalHeight, True); if VisiblePath[Node] then begin System.Dec(FVisibleCount, CountVisibleChildren(Node) + Cardinal(IfThen(IsEffectivelyVisible[Node], 1))); @@ -19298,7 +19294,7 @@ function TBaseVirtualTree.ComputeRTLOffset(ExcludeScrollBar: Boolean): TDimensio HeaderWidth: TDimension; ScrollBarVisible: Boolean; begin - ScrollBarVisible := ({$IFDEF VT_VCL}Integer{$ENDIF}(FRangeY) > ClientHeight) and (ScrollBarOptions.ScrollBars in [TScrollStyle.ssVertical, TScrollStyle.ssBoth]); + ScrollBarVisible := (FRangeY > ClientHeight) and (ScrollBarOptions.ScrollBars in [TScrollStyle.ssVertical, TScrollStyle.ssBoth]); if ScrollBarVisible then Result := {$IFDEF VT_FMX}16{$ELSE}GetSystemMetrics(SM_CXVSCROLL){$ENDIF} else @@ -19306,8 +19302,8 @@ function TBaseVirtualTree.ComputeRTLOffset(ExcludeScrollBar: Boolean): TDimensio // Make everything right aligned. HeaderWidth := FHeaderRect.Right - FHeaderRect.Left; - if {$IFDEF VT_VCL}Integer{$ENDIF}(FRangeX) + Result <= HeaderWidth then - Result := HeaderWidth - {$IFDEF VT_VCL}Integer{$ENDIF}(FRangeX); + if FRangeX + Result <= HeaderWidth then + Result := HeaderWidth - FRangeX; // Otherwise take only left-hand vertical scrollbar into account. if ScrollBarVisible and ExcludeScrollBar then @@ -19599,7 +19595,7 @@ procedure TBaseVirtualTree.DetermineHitPositionLTR(var HitInfo: THitInfo; Offset // Position of button is interpreted very generously to avoid forcing the user // to click exactly into the 9x9 pixels area. The entire node height and one full // indentation level is accepted as button hit. - if Offset >= lOffsets[ofsCheckbox] - {$IFDEF VT_VCL}Integer{$ENDIF}(FIndent) then + if Offset >= lOffsets[ofsCheckbox] - FIndent then Include(HitInfo.HitPositions, hiOnItemButton); if Offset > lOffsets[ofsToggleButton] then Include(HitInfo.HitPositions, hiOnItemButtonExact); @@ -19727,7 +19723,7 @@ procedure TBaseVirtualTree.DetermineHitPositionRTL(var HitInfo: THitInfo; Offset // Position of button is interpreted very generously to avoid forcing the user // to click exactly into the 9x9 pixels area. The entire node height and one full // indentation level is accepted as button hit. - if Offset <= Right + {$IFDEF VT_VCL}Integer{$ENDIF}(FIndent) then + if Offset <= Right + FIndent then Include(HitInfo.HitPositions, hiOnItemButton); if Offset <= Right + FPlusBM.Width then Include(HitInfo.HitPositions, hiOnItemButtonExact); @@ -20004,14 +20000,14 @@ function TBaseVirtualTree.DetermineScrollDirections(X, Y: TDimension): TScrollDi end else begin - if (X < {$IFDEF VT_VCL}Integer{$ENDIF}(FDefaultNodeHeight)) and (FEffectiveOffsetX <> 0) then + if (X < FDefaultNodeHeight) and (FEffectiveOffsetX <> 0) then Include(Result, sdLeft); - if (ClientWidth + FEffectiveOffsetX < {$IFDEF VT_VCL}Integer{$ENDIF}(FRangeX)) and (X > ClientWidth - {$IFDEF VT_VCL}Integer{$ENDIF}(FDefaultNodeHeight)) then + if (ClientWidth + FEffectiveOffsetX < FRangeX) and (X > ClientWidth - FDefaultNodeHeight) then Include(Result, sdRight); - if (Y < {$IFDEF VT_VCL}Integer{$ENDIF}(FDefaultNodeHeight)) and (FOffsetY <> 0) then + if (Y < FDefaultNodeHeight) and (FOffsetY <> 0) then Include(Result, sdUp); - if (ClientHeight - FOffsetY < {$IFDEF VT_VCL}Integer{$ENDIF}(FRangeY)) and (Y > ClientHeight - {$IFDEF VT_VCL}Integer{$ENDIF}(FDefaultNodeHeight)) then + if (ClientHeight - FOffsetY < FRangeY) and (Y > ClientHeight - FDefaultNodeHeight) then Include(Result, sdDown); // Since scrolling during dragging is not handled via the timer we do a check here whether the auto @@ -21451,15 +21447,15 @@ function TBaseVirtualTree.DoSetOffsetXY(Value: TPoint; Options: TScrollUpdateOpt begin // Range check, order is important here. - if Value.X < (ClientWidth - {$IFDEF VT_VCL}Integer{$ENDIF}(FRangeX)) then - Value.X := ClientWidth - {$IFDEF VT_VCL}Integer{$ENDIF}(FRangeX); + if Value.X < (ClientWidth - FRangeX) then + Value.X := ClientWidth - FRangeX; if Value.X > 0 then Value.X := 0; DeltaX := Value.X - FOffsetX; if UseRightToLeftAlignment then DeltaX := -DeltaX; - if Value.Y < (ClientHeight - {$IFDEF VT_VCL}Integer{$ENDIF}(FRangeY)) then - Value.Y := ClientHeight - {$IFDEF VT_VCL}Integer{$ENDIF}(FRangeY); + if Value.Y < (ClientHeight - FRangeY) then + Value.Y := ClientHeight - FRangeY; if Value.Y > 0 then Value.Y := 0; DeltaY := Value.Y - FOffsetY; @@ -22151,7 +22147,7 @@ function TBaseVirtualTree.DragOver(Source: TObject; KeyState: Integer; DragState if sdDown in FScrollDirections then begin DeltaY := -Min(FScrollBarOptions.FIncrementY, ClientHeight); - if (ClientHeight - FOffsetY) = {$IFDEF VT_VCL}Integer{$ENDIF}(FRangeY) then + if (ClientHeight - FOffsetY) = FRangeY then Exclude(FScrollDirections, sdDown); end; if sdLeft in FScrollDirections then @@ -22163,7 +22159,7 @@ function TBaseVirtualTree.DragOver(Source: TObject; KeyState: Integer; DragState if sdRight in FScrollDirections then begin DeltaX := -FScrollBarOptions.FIncrementX; - if (ClientWidth + FEffectiveOffsetX) = {$IFDEF VT_VCL}Integer{$ENDIF}(FRangeX) then + if (ClientWidth + FEffectiveOffsetX) = FRangeX then Exclude(FScrollDirections, sdRight); end; WindowScrolled := DoSetOffsetXY(Point(FOffsetX + DeltaX, FOffsetY + DeltaY), ScrollOptions, nil); @@ -22711,7 +22707,7 @@ function TBaseVirtualTree.GetMaxRightExtend(): TDimension; if not (vsInitialized in Node.States) then InitNode(Node); CurrentWidth := GetOffset(TVTElement.ofsRightOfText, Node); - if {$IFDEF VT_VCL}Integer{$ENDIF}(Result) < (CurrentWidth) then + if Result < (CurrentWidth) then Result := CurrentWidth; Inc(TopPosition, NodeHeight[Node]); if TopPosition > Height then @@ -23847,7 +23843,7 @@ procedure TBaseVirtualTree.InternalAddFromStream(Stream: TStream; Version: Integ FixupTotalCount(Node); AdjustTotalCount(Node.Parent, Node.TotalCount - 1, True); // -1 because Node itself was already set. FixupTotalHeight(Node); - AdjustTotalHeight(Node.Parent, {$IFDEF VT_VCL}Integer{$ENDIF}(Node.TotalHeight) - {$IFDEF VT_VCL}Integer{$ENDIF}(LastTotalHeight), True); + AdjustTotalHeight(Node.Parent, Node.TotalHeight - LastTotalHeight, True); // New nodes are always visible, so the visible node count has been increased already. // If Node is now invisible we have to take back this increment and don't need to add any visible child node. @@ -24291,7 +24287,7 @@ procedure TBaseVirtualTree.InternalDisconnectNode(Node: PVirtualNode; KeepFocus: end; AdjustTotalCount(Parent, -Integer(Node.TotalCount), True); if AdjustHeight then - AdjustTotalHeight(Parent, -{$IFDEF VT_VCL}Integer{$ENDIF}(Node.TotalHeight), True); + AdjustTotalHeight(Parent, -Node.TotalHeight, True); if FullyVisible[Node] then System.Dec(FVisibleCount, CountVisibleChildren(Node) + Cardinal(IfThen(IsEffectivelyVisible[Node], 1))); @@ -26380,7 +26376,7 @@ procedure TBaseVirtualTree.UpdateHeaderRect; if hoVisible in FHeader.FOptions then begin if FHeaderRect.Left <= FHeaderRect.Right then - FHeaderRect.Bottom := FHeaderRect.Top + {$IFDEF VT_VCL}Integer{$ENDIF}(FHeader.FHeight) + FHeaderRect.Bottom := FHeaderRect.Top + FHeader.FHeight else FHeaderRect := Rect(0, 0, 0, 0); end @@ -27256,7 +27252,7 @@ procedure TBaseVirtualTree.ClearSelection(pFireChangeEvent: Boolean); while Assigned(Node) do begin - R.Bottom := R.Top + {$IFDEF VT_VCL}Integer{$ENDIF}(NodeHeight[Node]); + R.Bottom := R.Top + NodeHeight[Node]; if vsSelected in Node.States then begin {$IFDEF VT_FMX} @@ -31387,7 +31383,7 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe SelectionRect, // ordered rectangle used for drawing the selection focus rect ClipRect: TRect; // area to which the canvas will be clipped when painting a node's content NextColumn: TColumnIndex; - BaseOffset: TDimension; // top position of the top node to draw given in absolute tree coordinates + BaseOffset: TDimension; // top position of the top node to draw given in absolute tree coordinates NodeBitmap: TBitmap; // small buffer to draw flicker free MaximumRight, // maximum horizontal target position MaximumBottom: TDimension; // maximum vertical target position @@ -31699,12 +31695,12 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe begin if BidiMode = bdLeftToRight then begin - DrawDottedHLine(PaintInfo, CellRect.Left + IfThen(toFixedIndent in FOptions.FPaintOptions, 1, IndentSize) * {$IFDEF VT_VCL}Integer{$ENDIF}(FIndent), CellRect.Right - 1, + DrawDottedHLine(PaintInfo, CellRect.Left + IfThen(toFixedIndent in FOptions.FPaintOptions, 1, IndentSize) * FIndent, CellRect.Right - 1, CellRect.Bottom - 1); end else begin - DrawDottedHLine(PaintInfo, CellRect.Left, CellRect.Right - IfThen(toFixedIndent in FOptions.FPaintOptions, 1, IndentSize) * {$IFDEF VT_VCL}Integer{$ENDIF}(FIndent) - 1, + DrawDottedHLine(PaintInfo, CellRect.Left, CellRect.Right - IfThen(toFixedIndent in FOptions.FPaintOptions, 1, IndentSize) * FIndent - 1, CellRect.Bottom - 1); end; end @@ -32789,7 +32785,7 @@ function TBaseVirtualTree.ScrollIntoView(Node: PVirtualNode; Center: Boolean; Ho if (R.Bottom > ClientHeight) or Center then begin HScrollBarVisible := (ScrollBarOptions.ScrollBars in [System.UITypes.TScrollStyle.ssBoth, System.UITypes.TScrollStyle.ssHorizontal]) and - (ScrollBarOptions.AlwaysVisible or ({$IFDEF VT_VCL}Integer{$ENDIF}(FRangeX) > ClientWidth)); + (ScrollBarOptions.AlwaysVisible or (FRangeX > ClientWidth)); if Center then SetOffsetY(FOffsetY - R.Bottom + ClientHeight {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2) else @@ -32797,7 +32793,7 @@ function TBaseVirtualTree.ScrollIntoView(Node: PVirtualNode; Center: Boolean; Ho // When scrolling up and the horizontal scroll appears because of the operation // then we have to move up the node the horizontal scrollbar's height too // in order to avoid that the scroll bar hides the node which we wanted to have in view. - if not UseColumns and not HScrollBarVisible and ({$IFDEF VT_VCL}Integer{$ENDIF}(FRangeX) > ClientWidth) then + if not UseColumns and not HScrollBarVisible and (FRangeX > ClientWidth) then SetOffsetY(FOffsetY - {$IFDEF VT_FMX}3{$ELSE}GetSystemMetrics(SM_CYHSCROLL){$ENDIF}); ScrolledVertically := True; end; @@ -32860,7 +32856,7 @@ function TBaseVirtualTree.ScrollIntoView(Column: TColumnIndex; Center: Boolean; if NewOffset <> FEffectiveOffsetX then begin if UseRightToLeftAlignment then - SetOffsetX(-{$IFDEF VT_VCL}Integer{$ENDIF}(FRangeX) + ClientWidth + NewOffset) + SetOffsetX(-FRangeX + ClientWidth + NewOffset) else SetOffsetX(-NewOffset); end; @@ -32872,7 +32868,7 @@ function TBaseVirtualTree.ScrollIntoView(Column: TColumnIndex; Center: Boolean; if NewOffset <> FEffectiveOffsetX then begin if UseRightToLeftAlignment then - SetOffsetX(-{$IFDEF VT_VCL}Integer{$ENDIF}(FRangeX) + ClientWidth + NewOffset) + SetOffsetX(-FRangeX + ClientWidth + NewOffset) else SetOffsetX(-NewOffset); end; @@ -33294,7 +33290,7 @@ procedure TBaseVirtualTree.ToggleNode(Node: PVirtualNode); NeedUpdate := True; // Calculate the height delta right now as we need it for toChildrenAbove anyway. - HeightDelta := -{$IFDEF VT_VCL}Integer{$ENDIF}(Node.TotalHeight) + {$IFDEF VT_VCL}Integer{$ENDIF}(NodeHeight[Node]); + HeightDelta := -Node.TotalHeight + NodeHeight[Node]; if (FUpdateCount = 0) and (toAnimatedToggle in FOptions.FAnimationOptions) and not (tsCollapsing in FStates) then begin @@ -33315,7 +33311,7 @@ procedure TBaseVirtualTree.ToggleNode(Node: PVirtualNode); Mode2 := tamNoScroll; if toChildrenAbove in FOptions.FPaintOptions then begin - PosHoldable := (FOffsetY + ({$IFDEF VT_VCL}Integer{$ENDIF}(Node.TotalHeight) - {$IFDEF VT_VCL}Integer{$ENDIF}(NodeHeight[Node]))) <= 0; + PosHoldable := (FOffsetY + (Node.TotalHeight - NodeHeight[Node])) <= 0; NodeInView := R1.Top < ClientHeight; StepsR1 := 0; @@ -33327,7 +33323,7 @@ procedure TBaseVirtualTree.ToggleNode(Node: PVirtualNode); Mode1 := tamScrollDown; R1.Bottom := R1.Top; R1.Top := 0; - StepsR1 := Min(R1.Bottom - R1.Top + 1, {$IFDEF VT_VCL}Integer{$ENDIF}(Node.TotalHeight) - {$IFDEF VT_VCL}Integer{$ENDIF}(NodeHeight[Node])); + StepsR1 := Min(R1.Bottom - R1.Top + 1, Node.TotalHeight - NodeHeight[Node]); end else begin @@ -33341,8 +33337,8 @@ procedure TBaseVirtualTree.ToggleNode(Node: PVirtualNode); end else begin - if ({$IFDEF VT_VCL}Integer{$ENDIF}(FRangeY) + FOffsetY - R1.Bottom + HeightDelta >= ClientHeight - R1.Bottom) or - ({$IFDEF VT_VCL}Integer{$ENDIF}(FRangeY) <= ClientHeight) or (FOffsetY = 0) or not + if (FRangeY + FOffsetY - R1.Bottom + HeightDelta >= ClientHeight - R1.Bottom) or + (FRangeY <= ClientHeight) or (FOffsetY = 0) or not (toAdvancedAnimatedToggle in FOptions.FAnimationOptions) then begin // Do a simple scroll up over the child nodes. @@ -33356,7 +33352,7 @@ procedure TBaseVirtualTree.ToggleNode(Node: PVirtualNode); // Scroll the node down to its future position. As FOffsetY will change we need to invalidate the // whole tree. Mode1 := tamScrollDown; - StepsR1 := Min(-FOffsetY, ClientHeight - {$IFDEF VT_VCL}Integer{$ENDIF}(FRangeY) -FOffsetY - HeightDelta); + StepsR1 := Min(-FOffsetY, ClientHeight - FRangeY -FOffsetY - HeightDelta); R1.Top := 0; R1.Bottom := Min(ClientHeight, R1.Bottom + Steps); NeedFullInvalidate := True; @@ -33426,13 +33422,13 @@ procedure TBaseVirtualTree.ToggleNode(Node: PVirtualNode); begin R1 := GetDisplayRect(Node, NoColumn, False); Mode2 := tamNoScroll; - TotalFit := HeightDelta + {$IFDEF VT_VCL}Integer{$ENDIF}(NodeHeight[Node]) <= ClientHeight; + TotalFit := HeightDelta + NodeHeight[Node] <= ClientHeight; if toChildrenAbove in FOptions.FPaintOptions then begin // The main goal with toChildrenAbove being set is to keep the nodes visual position so the user does // not get confused. Therefore we need to scroll the view when the expanding is done. - PosHoldable := TotalFit and ({$IFDEF VT_VCL}Integer{$ENDIF}(FRangeY) - ClientHeight >= 0) ; + PosHoldable := TotalFit and (FRangeY - ClientHeight >= 0) ; ChildrenInView := (R1.Top - HeightDelta) >= 0; NodeInView := R1.Bottom <= ClientHeight; end @@ -33483,25 +33479,25 @@ procedure TBaseVirtualTree.ToggleNode(Node: PVirtualNode); begin // If we shall not or cannot scroll to the desired extent we calculate the new position (with // max FOffsetY applied) and animate it that way. - StepsR1 := -FOffsetY - Max({$IFDEF VT_VCL}Integer{$ENDIF}(FRangeY) + HeightDelta - ClientHeight, 0) + HeightDelta; - if ({$IFDEF VT_VCL}Integer{$ENDIF}(FRangeY) + HeightDelta - ClientHeight) <= 0 then + StepsR1 := -FOffsetY - Max(FRangeY + HeightDelta - ClientHeight, 0) + HeightDelta; + if (FRangeY + HeightDelta - ClientHeight) <= 0 then Mode2 := tamNoScroll else - StepsR2 := Min({$IFDEF VT_VCL}Integer{$ENDIF}(FRangeY) + HeightDelta - ClientHeight, R2.Bottom); + StepsR2 := Min(FRangeY + HeightDelta - ClientHeight, R2.Bottom); end else begin - if TotalFit and NodeInView and ({$IFDEF VT_VCL}Integer{$ENDIF}(FRangeY) + HeightDelta > ClientHeight) then + if TotalFit and NodeInView and (FRangeY + HeightDelta > ClientHeight) then begin // If the whole subtree will fit into the client area and the node is currently fully visible, // the first child will be made the top node if possible. if HeightDelta >= R1.Top then StepsR1 := Abs(R1.Top - HeightDelta) else - StepsR1 := ClientHeight - {$IFDEF VT_VCL}Integer{$ENDIF}(FRangeY); + StepsR1 := ClientHeight - FRangeY; end else - if {$IFDEF VT_VCL}Integer{$ENDIF}(FRangeY) + HeightDelta <= ClientHeight then + if FRangeY + HeightDelta <= ClientHeight then begin // We cannot make the first child the top node as we cannot scroll to that extent, // so we do a simple scroll down. @@ -33511,7 +33507,7 @@ procedure TBaseVirtualTree.ToggleNode(Node: PVirtualNode); else // If the subtree does not fit into the client area at once, the expanded node will // be made the bottom node. - StepsR1 := ClientHeight - R1.Top - {$IFDEF VT_VCL}Integer{$ENDIF}(NodeHeight[Node]); + StepsR1 := ClientHeight - R1.Top - NodeHeight[Node]; if Mode2 <> tamNoScroll then begin From 300e77e23047299e685b5db467780e09cb8879f2 Mon Sep 17 00:00:00 2001 From: karol Date: Thu, 8 Nov 2018 11:39:32 +0100 Subject: [PATCH 08/61] VCL Fixing HandleAllocated of dummyCanvas (Canvas does not allow drawing) - VCL Fix - if handle was not allocated we got "Canvas does not allow drawing" for dummyCanvas - FMX Added header columns (header still is not drawed but cells are - FMX OnBeforePaintCell is working now --- Source/VirtualTrees.Utils.pas | 61 ++++++++- Source/VirtualTrees.pas | 224 +++++++++++++++++++++++++++------- 2 files changed, 240 insertions(+), 45 deletions(-) diff --git a/Source/VirtualTrees.Utils.pas b/Source/VirtualTrees.Utils.pas index edbf6de82..7491e56ee 100644 --- a/Source/VirtualTrees.Utils.pas +++ b/Source/VirtualTrees.Utils.pas @@ -62,8 +62,9 @@ interface bmConstantAlphaAndColor // blend the destination color with the given constant color und the constant alpha value ); -{$IFDEF VT_VCL} + procedure AlphaBlend(Source, Destination: TCanvas; R: TRect; Target: TPoint; Mode: TBlendMode; ConstantAlpha, Bias: Integer); +{$IFDEF VT_VCL} function GetRGBColor(Value: TColor): DWORD; procedure PrtStretchDrawDIB(Canvas: TCanvas; DestRect: TRect; ABitmap: TBitmap); @@ -1071,7 +1072,63 @@ procedure AlphaBlendLineMasterAndColor(Destination: Pointer; Count: Integer; Con {$endif CPUX64} //---------------------------------------------------------------------------------------------------------------------- +{$ENDIF} + +{$IFDEF VT_FMX} +procedure AlphaBlend(Source, Destination: TCanvas; R: TRect; Target: TPoint; Mode: TBlendMode; ConstantAlpha, Bias: Integer); + +// R describes the source rectangle to work on. +// Target is the place (upper left corner) in the target bitmap where to blend to. Note that source width + X offset +// must be less or equal to the target width. Similar for the height. +// If Mode is bmConstantAlpha then the blend operation uses the given ConstantAlpha value for all pixels. +// If Mode is bmPerPixelAlpha then each pixel is blended using its individual alpha value (the alpha value of the source). +// If Mode is bmMasterAlpha then each pixel is blended using its individual alpha value multiplied by ConstantAlpha. +// If Mode is bmConstantAlphaAndColor then each destination pixel is blended using ConstantAlpha but also a constant +// color which will be obtained from Bias. In this case no offset value is added, otherwise Bias is used as offset. +// Blending of a color into target only (bmConstantAlphaAndColor) ignores Source (the DC) and Target (the position). +// CAUTION: This procedure does not check whether MMX instructions are actually available! Call it only if MMX is really +// usable. + + +Var SrcRect: TRect; +begin + if not IsRectEmpty(R) then + begin + SrcRect.Left:= Target.X; + SrcRect.Top:= Target.Y; + SrcRect.Width:= R.Width; + SrcRect.Height:= R.Height; + // Note: it is tempting to optimize the special cases for constant alpha 0 and 255 by just ignoring soure + // (alpha = 0) or simply do a blit (alpha = 255). But this does not take the bias into account. + case Mode of + bmConstantAlpha: + begin + //this should be ok + Destination.DrawBitmap(Source.Bitmap, SrcRect, R, ConstantAlpha/255.0, false); + end; + bmPerPixelAlpha: + begin + //TODO: AlphaBlend temporary not what asked! AlphaColorToScanline + Destination.DrawBitmap(Source.Bitmap, SrcRect, R, ConstantAlpha/255.0, false); + end; + bmMasterAlpha: + begin + //TODO: AlphaBlend temporary not what asked! AlphaColorToScanline + Destination.DrawBitmap(Source.Bitmap, SrcRect, R, ConstantAlpha/255.0, false); + end; + bmConstantAlphaAndColor: + begin + // Source is ignored since there is a constant color value. + // it looks like dummyCanvas is not needed for bmConstantAlphaAndColor as Source is simply ignored and we can pass nil instead of dummyCanvas with handle=0 + // i leave it. because maybe in the future someone change bmConstantAlphaAndColor to something else + Destination.Fill.Color:= bias; + Destination.FillRect(R, 0, 0, [], ConstantAlpha/255.0); + end; + end; + end; +end; +{$ELSE} procedure AlphaBlend(Source, Destination: TCanvas; R: TRect; Target: TPoint; Mode: TBlendMode; ConstantAlpha, Bias: Integer); // Optimized alpha blend procedure using MMX instructions to perform as quick as possible. @@ -1176,7 +1233,9 @@ procedure AlphaBlend(Source, Destination: TCanvas; R: TRect; Target: TPoint; Mod end; end; end; +{$ENDIF} +{$IFDEF VT_VCL} function GetRGBColor(Value: TColor): DWORD; // Little helper to convert a Delphi color to an image list color. diff --git a/Source/VirtualTrees.pas b/Source/VirtualTrees.pas index 74ab7f867..4143656d9 100644 --- a/Source/VirtualTrees.pas +++ b/Source/VirtualTrees.pas @@ -4213,7 +4213,8 @@ implementation VirtualTrees.Export, VirtualTrees.HeaderPopup {$IFDEF VT_FMX} - ,FMX.TextLayout + , FMX.TextLayout + , FMX.Utils {$ENDIF} ; @@ -14342,17 +14343,19 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean); const LineBitsDotted: array [0..8] of Word = ($55, $AA, $55, $AA, $55, $AA, $55, $AA, $55); LineBitsSolid: array [0..7] of Word = (0, 0, 0, 0, 0, 0, 0, 0); - var PatternBitmap: {$IFDEF VT_FMX}TBitmap{$ELSE}HBITMAP{$ENDIF}; Bits: Pointer; Size: TSize; {$IFDEF VT_FMX} Theme: Integer; + BitmapData: TBitmapData; + DestPitch: Integer; {$ELSE} Theme: HTHEME; {$ENDIF} R: TRect; + bit, line, LineLen: Integer; //--------------- local function -------------------------------------------- @@ -14480,7 +14483,10 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean); end; {$IFDEF VT_FMX} FMinusBM.Canvas.BeginScene(); + FMinusBM.Canvas.Blending:= false; + FMinusBM.Canvas.Stroke.Kind := TBrushKind.bkSolid; FMinusBM.Canvas.Stroke.Color := FColors.TreeLineColor; + FMinusBM.Canvas.FillRect(Rect(1, 1, FMinusBM.Width-1, FMinusBM.Height-1), 0, 0, [], 1.0); FMinusBM.Canvas.DrawRect(Rect(1, 1, FMinusBM.Width-1, FMinusBM.Height-1), 0, 0, [], 1.0); FMinusBM.Canvas.Stroke.Color := FColors.NodeFontColor; FMinusBM.Canvas.DrawLine(Point(2, FMinusBM.Width / 2), Point(FMinusBM.Width - 2, FMinusBM.Width / 2), 1.0); @@ -14554,8 +14560,11 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean); end; {$IFDEF VT_FMX} FPlusBM.Canvas.BeginScene(); + FPlusBM.Canvas.Blending := false; + FPlusBM.Canvas.Stroke.Kind := TBrushKind.bkSolid; FPlusBM.Canvas.Stroke.Color := FColors.TreeLineColor; - FPlusBM.Canvas.DrawRect(Rect(1, 1, FPlusBM.Width-1, FPlusBM.Height-1), 0, 0, [], 1.0); //###!!! czy jeszcze fill + FPlusBM.Canvas.FillRect(Rect(1, 1, FPlusBM.Width-1, FPlusBM.Height-1), 0, 0, [], 1.0); + FPlusBM.Canvas.DrawRect(Rect(1, 1, FPlusBM.Width-1, FPlusBM.Height-1), 0, 0, [], 1.0); FPlusBM.Canvas.Stroke.Color := FColors.NodeFontColor; FPlusBM.Canvas.DrawLine(Point(2, FPlusBM.Canvas.Width / 2), Point(FPlusBM.Canvas.Width - 2, FPlusBM.Canvas.Width / 2), 1.0); FPlusBM.Canvas.DrawLine(Point(FPlusBM.Canvas.Width / 2, 2), Point(FPlusBM.Canvas.Width / 2, FPlusBM.Canvas.Width - 2), 1.0); @@ -14643,16 +14652,48 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean); {$ENDIF} case FLineStyle of lsDotted: - Bits := @LineBitsDotted; + begin + Bits := @LineBitsDotted; + LineLen:= Length(LineBitsDotted); + end; lsSolid: - Bits := @LineBitsSolid; + begin + Bits := @LineBitsSolid; + LineLen:= Length(LineBitsSolid); + end else // lsCustomStyle Bits := @LineBitsDotted; DoGetLineStyle(Bits); + LineLen:= Length(LineBitsDotted); //??? what if custom end; {$IFDEF VT_FMX} - PatternBitmap := TBitmap.Create(8, 8); //###!!! CreateBitmap(8, 8, 1, 1, Bits); - FDottedBrush := TBrush.Create(TBrushKind.Bitmap, clWhite); //###!!! CreatePatternBrush(PatternBitmap); + PatternBitmap := TBitmap.Create(8, LineLen); //###!!! CreateBitmap(8, 8, 1, 1, Bits); + PatternBitmap.Clear($00FF00FF); //fully transparent + PatternBitmap.Canvas.BeginScene; + + PatternBitmap.Map(TMapAccess.ReadWrite, BitmapData); + try + { + //AlphaColorToPixel PixelToAlphaColor ScanlineToAlphaColor + DestPitch := PixelFormatBytes[PatternBitmap.PixelFormat]; + System.Move(PAlphaColorArray(BitmapData.Data)[0], PAlphaColorArray(Bits)[0], 8 * 4); + } + for line:= 0 to LineLen-1 do + begin + for bit:= 0 to 7 do + begin + if PWordArray(Bits)^[line] and (1 shl bit)=0 then + BitmapData.SetPixel(bit, line, clWhite) else + BitmapData.SetPixel(bit, line, clBlack); + end; + end; + finally + PatternBitmap.UnMap(BitmapData); + end; + + PatternBitmap.Canvas.EndScene; + PatternBitmap.SaveToFile('R:\pattern.bmp'); + FDottedBrush := TBrush.Create(TBrushKind.Bitmap, clWhite); //###!!! CreatePatternBrush(PatternBitmap) FDottedBrush.Bitmap.Bitmap.Assign(PatternBitmap); FreeAndNil(PatternBitmap); {$ELSE} @@ -18304,6 +18345,7 @@ procedure TBaseVirtualTree.WMPaint(var Message: TWMPaint); var DC: HDC; prevDC: HDC; + wasPrevDC: Boolean; begin if tsVCLDragging in FStates then ImageList_DragShowNolock(False); @@ -18323,12 +18365,20 @@ procedure TBaseVirtualTree.WMPaint(var Message: TWMPaint); if DC <> 0 then try begin - prevDC:= dummyCanvas.Handle; + if dummyCanvas.HandleAllocated then + begin + prevDC:= dummyCanvas.Handle; + wasPrevDC:= true; + end else + begin + wasPrevDC:= false; + end; dummyCanvas.Handle:= DC; try FHeader.FColumns.PaintHeader(dummyCanvas, FHeaderRect, -FEffectiveOffsetX); finally - dummyCanvas.Handle:= prevDC; + if wasPrevDC then + dummyCanvas.Handle:= prevDC; end; end; finally @@ -18352,16 +18402,25 @@ procedure TBaseVirtualTree.WMPrint(var Message: TWMPrint); // This message is sent to request that the tree draws itself to a given device context. This includes not only // the client area but also the non-client area (header!). Var prevDC: HDC; + wasPrevDC: Boolean; begin // Draw only if the window is visible or visibility is not required. if ((Message.Flags and PRF_CHECKVISIBLE) = 0) or IsWindowVisible(Handle) then begin - prevDC:= dummyCanvas.Handle; + if dummyCanvas.HandleAllocated then + begin + prevDC:= dummyCanvas.Handle; + wasPrevDC:= true; + end else + begin + wasPrevDC:= false; + end; try dummyCanvas.Handle:= Message.DC; Header.Columns.PaintHeader(dummyCanvas, FHeaderRect, -FEffectiveOffsetX); finally - dummyCanvas.Handle:= prevDC; + if wasPrevDC then + dummyCanvas.Handle:= prevDC; end; end; @@ -22306,7 +22365,7 @@ procedure TBaseVirtualTree.DrawDottedHLine(const PaintInfo: TVTPaintInfo; Left, begin {$IFDEF VT_FMX} Fill.Color := FColors.BackGroundColor; - R := RectF(Min(Left, Right), Top, Max(Left, Right) + 1, Top + 1); + R := Rect(Min(Left, Right), Top, Max(Left, Right) + 1, Top + 1); FillRect(R, 0, 0, [], 1.0, FDottedBrush); {$ELSE} Brush.Color := FColors.BackGroundColor; @@ -25134,6 +25193,7 @@ procedure TBaseVirtualTree.PaintSelectionRectangle(Target: TCanvas; WindowOrgX: TextColorBackup, BackColorBackup: COLORREF; // used to restore forground and background colors when drawing a selection rectangle prevDC: HDC; + wasPrevDC: Boolean; {$ENDIF} begin {$IFDEF VT_VCL} @@ -25155,13 +25215,21 @@ procedure TBaseVirtualTree.PaintSelectionRectangle(Target: TCanvas; WindowOrgX: if IntersectRect(BlendRect, OrderRect(SelectionRect), TargetRect) then begin OffsetRect(BlendRect, -WindowOrgX, 0); - prevDC:= dummyCanvas.Handle; + if dummyCanvas.HandleAllocated then + begin + prevDC:= dummyCanvas.Handle; + wasPrevDC:= true; + end else + begin + wasPrevDC:= false; + end; try dummyCanvas.Handle:= 0; AlphaBlend(dummyCanvas, Target, BlendRect, Point(0, 0), bmConstantAlphaAndColor, FSelectionBlendFactor, ColorToRGB(FColors.SelectionRectangleBlendColor)); finally - dummyCanvas.Handle:= prevDC; + if wasPrevDC then + dummyCanvas.Handle:= prevDC; end; Target.{$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := FColors.SelectionRectangleBorderColor; @@ -25205,14 +25273,19 @@ procedure TBaseVirtualTree.PanningWindowProc(var Message: TMessage); procedure TBaseVirtualTree.PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX, MaxWidth: TDimension); // This method is called immediately before a cell's content is drawn und is responsible to paint selection colors etc. -{$IFDEF VT_VCL} var +{$IFDEF VT_FMX} + TextColorBackup, + BackColorBackup: TColor; + Theme: Integer; +{$ELSE} TextColorBackup, BackColorBackup: COLORREF; + Theme: HTHEME; +{$ENDIF} FocusRect, InnerRect: TRect; RowRect: TRect; - Theme: HTHEME; const TREIS_HOTSELECTED = 6; @@ -25222,7 +25295,10 @@ procedure TBaseVirtualTree.PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX, var R: TRect; +{$IFDEF VT_VCL} prevDC: HDC; + wasPrevDC: Boolean; +{$ENDIF} begin // Take into account any window offset and size limitations in the target bitmap, as this is only as large // as necessary and might not cover the whole node. For normal painting this does not matter (because of @@ -25234,19 +25310,31 @@ procedure TBaseVirtualTree.PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX, R.Left := 0; if R.Right > MaxWidth then R.Right := MaxWidth; - - prevDC:= dummyCanvas.Handle; +{$IFDEF VT_FMX} + AlphaBlend(nil, PaintInfo.Canvas, R, Point(0, 0), bmConstantAlphaAndColor, + FSelectionBlendFactor, Color); +{$ELSE} + if dummyCanvas.HandleAllocated then + begin + prevDC:= dummyCanvas.Handle; + wasPrevDC:= true; + end else + begin + wasPrevDC:= false; + end; dummyCanvas.Handle:= 0; try AlphaBlend(dummyCanvas, PaintInfo.Canvas, R, Point(0, 0), bmConstantAlphaAndColor, FSelectionBlendFactor, ColorToRGB(Color)); finally - dummyCanvas.Handle:= prevDC; + if wasPrevDC then + dummyCanvas.Handle:= prevDC; end; +{$ENDIF} end; //--------------------------------------------------------------------------- - +{$IFDEF VT_VCL} procedure DrawBackground(State: Integer); begin // if the full row selection is disabled or toGridExtensions is in the MiscOptions, draw the selection @@ -25282,6 +25370,7 @@ procedure TBaseVirtualTree.PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX, if toShowVertGridLines in FOptions.PaintOptions then Dec(RowRect.Right); end; +{$ENDIF} with PaintInfo, Canvas do begin @@ -25289,8 +25378,8 @@ procedure TBaseVirtualTree.PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX, with FHeader.FColumns do if poColumnColor in PaintOptions then begin - Brush.Color := Items[Column].GetEffectiveColor; - FillRect(CellRect); + {$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := Items[Column].GetEffectiveColor; + FillRect(CellRect{$IFDEF VT_FMX}, 0, 0, [], 1.0{$ENDIF}); end; // Let the application customize the cell background and the content rectangle. @@ -25310,7 +25399,7 @@ procedure TBaseVirtualTree.PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX, with TWithSafeRect(InnerRect) do if (Right - Left) > NodeWidth then begin - Left := (Left + Right - NodeWidth) div 2; + Left := (Left + Right - NodeWidth) {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2; Right := Left + NodeWidth; end; taRightJustify: @@ -25329,43 +25418,57 @@ procedure TBaseVirtualTree.PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX, begin if (FLastDropMode = dmOnNode) or (vsSelected in Node.States) then begin - Brush.Color := FColors.DropTargetColor; - Pen.Color := FColors.DropTargetBorderColor; + {$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := FColors.DropTargetColor; + {$IFDEF VT_FMX}Stroke{$ELSE}Pen{$ENDIF}.Color := FColors.DropTargetBorderColor; if (toGridExtensions in FOptions.FMiscOptions) or (toFullRowSelect in FOptions.FSelectionOptions) then InnerRect := CellRect; if not IsRectEmpty(InnerRect) then +{$IFDEF VT_VCL} if tsUseExplorerTheme in FStates then DrawBackground(TREIS_SELECTED) else +{$ENDIF} if (toUseBlendedSelection in FOptions.PaintOptions) then - AlphaBlendSelection(Brush.Color) + AlphaBlendSelection({$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color) else with TWithSafeRect(InnerRect) do - RoundRect(Left, Top, Right, Bottom, FSelectionCurveRadius, FSelectionCurveRadius); + begin +{$IFDEF VT_FMX} + //TODO: should we also use FillRect? + //FillRect(Rect(Left, Top, Right, Bottom), FSelectionCurveRadius, FSelectionCurveRadius, allCorners, 1.0); + DrawRect(Rect(Left, Top, Right, Bottom), FSelectionCurveRadius, FSelectionCurveRadius, allCorners, 1.0); +{$ELSE} + RoundRect(Left, Top, Right, Bottom, FSelectionCurveRadius, FSelectionCurveRadius); +{$ENDIF} + end; end else begin + //TODO: set flag somwhere that Fill is not needed +{$IFDEF VT_VCL} Brush.Style := bsClear; +{$ENDIF} end; end else if vsSelected in Node.States then begin - if Focused or (toPopupMode in FOptions.FPaintOptions) then + if {$IFDEF VT_FMX}IsFocused{$ELSE}Focused{$ENDIF} or (toPopupMode in FOptions.FPaintOptions) then begin - Brush.Color := FColors.FocusedSelectionColor; - Pen.Color := FColors.FocusedSelectionBorderColor; + {$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := FColors.FocusedSelectionColor; + {$IFDEF VT_FMX}Stroke{$ELSE}Pen{$ENDIF}.Color := FColors.FocusedSelectionBorderColor; end else begin - Brush.Color := FColors.UnfocusedSelectionColor; - Pen.Color := FColors.UnfocusedSelectionBorderColor; + {$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := FColors.UnfocusedSelectionColor; + {$IFDEF VT_FMX}Stroke{$ELSE}Pen{$ENDIF}.Color := FColors.UnfocusedSelectionBorderColor; end; if (toGridExtensions in FOptions.FMiscOptions) or (toFullRowSelect in FOptions.FSelectionOptions) then InnerRect := CellRect; if not IsRectEmpty(InnerRect) then +{$IFDEF VT_VCL} if tsUseExplorerTheme in FStates then begin // If the node is also hot, its background will be drawn later. @@ -25374,46 +25477,72 @@ procedure TBaseVirtualTree.PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX, DrawBackground(IfThen(Self.Focused, TREIS_SELECTED, TREIS_SELECTEDNOTFOCUS)); end else + {$ENDIF} if (toUseBlendedSelection in FOptions.PaintOptions) then - AlphaBlendSelection(Brush.Color) + AlphaBlendSelection({$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color) else with TWithSafeRect(InnerRect) do - RoundRect(Left, Top, Right, Bottom, FSelectionCurveRadius, FSelectionCurveRadius); +{$IFDEF VT_FMX} + //TODO: should we also use FillRect? + //FillRect(Rect(Left, Top, Right, Bottom), FSelectionCurveRadius, FSelectionCurveRadius, allCorners, 1.0); + DrawRect(Rect(Left, Top, Right, Bottom), FSelectionCurveRadius, FSelectionCurveRadius, allCorners, 1.0); +{$ELSE} + RoundRect(Left, Top, Right, Bottom, FSelectionCurveRadius, FSelectionCurveRadius); +{$ENDIF} end; end; end; +{$IFDEF VT_VCL} if (tsUseExplorerTheme in FStates) and (toHotTrack in FOptions.FPaintOptions) and (Node = FCurrentHotNode) and ((Column = FCurrentHotColumn) or (toFullRowSelect in FOptions.FSelectionOptions)) then DrawBackground(IfThen((vsSelected in Node.States) and not (toAlwaysHideSelection in FOptions.FPaintOptions), TREIS_HOTSELECTED, TREIS_HOT)); +{$ENDIF} if (Column = FFocusedColumn) or (toFullRowSelect in FOptions.FSelectionOptions) then begin // draw focus rect if (poDrawFocusRect in PaintOptions) and - (Focused or (toPopupMode in FOptions.FPaintOptions)) and (FFocusedNode = Node) and - ( (Column = FFocusedColumn) or + ({$IFDEF VT_FMX}IsFocused{$ELSE}Focused{$ENDIF} or (toPopupMode in FOptions.FPaintOptions)) and (FFocusedNode = Node) and + ( (Column = FFocusedColumn) +{$IFDEF VT_VCL} + or ((not (toExtendedFocus in FOptions.FSelectionOptions) or IsWinVistaOrAbove) and (toFullRowSelect in FOptions.FSelectionOptions) and - (tsUseExplorerTheme in FStates) ) ) then + (tsUseExplorerTheme in FStates) + ) +{$ENDIF} + ) then begin - TextColorBackup := GetTextColor(Handle); - SetTextColor(Handle, $FFFFFF); - BackColorBackup := GetBkColor(Handle); - SetBkColor(Handle, 0); - +{$IFDEF VT_VCL} if not (toExtendedFocus in FOptions.FSelectionOptions) and (toFullRowSelect in FOptions.FSelectionOptions) and (tsUseExplorerTheme in FStates) then FocusRect := RowRect else +{$ENDIF} if toGridExtensions in FOptions.FMiscOptions then FocusRect := CellRect else FocusRect := InnerRect; + {$IFDEF VT_VCL} if tsUseExplorerTheme in FStates then InflateRect(FocusRect, -1, -1); +{$ENDIF} + +{$IFDEF VT_FMX} + TextColorBackup := Stroke.Color; + //Fill.Color:= clWhite; font + //Fill.Color:= clBlack; background + DrawDashRect(FocusRect, 0, 0, AllCorners, 1.0{?}, $A0909090); + + Stroke.Color:= TextColorBackup; +{$ELSE} + TextColorBackup := GetTextColor(Handle); + SetTextColor(Handle, $FFFFFF); + BackColorBackup := GetBkColor(Handle); + SetBkColor(Handle, 0); if (tsUseExplorerTheme in FStates) and IsWinVistaOrAbove then begin @@ -25425,12 +25554,14 @@ procedure TBaseVirtualTree.PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX, end else Winapi.Windows.DrawFocusRect(Handle, FocusRect); + SetTextColor(Handle, TextColorBackup); SetBkColor(Handle, BackColorBackup); +{$ENDIF} end; end; end; - +{$IFDEF VT_VCL} if tsUseExplorerTheme in FStates then CloseThemeData(Theme); {$ENDIF} @@ -31869,7 +32000,7 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe end; // Erase rest of window not covered by a node. - if TargetRect.Top < MaximumBottom then + if (TargetRect.Top < MaximumBottom) then begin // Keep the horizontal target position to determine the selection rectangle offset later (if necessary). BaseOffset := Target.X; @@ -31934,6 +32065,11 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe R.Right := R.Left + Items[FirstColumn].FWidth; end; +{$IFDEF VT_FMX} + R.Top:= TargetRect.Top; +{$ENDIF} + + // Initialize MaxRight. MaxRight := Target.X - 1; From 4b0e1619210c86db73c797632e851166601e4508 Mon Sep 17 00:00:00 2001 From: karol Date: Thu, 8 Nov 2018 15:38:04 +0100 Subject: [PATCH 09/61] TreeLines, HorzGridLines, VertGridLines, FullVertGridLines + fixes Added paintiong of: - treeLines - toShowHorzGridLines - toShowVertGridLines - toFullVertGridLines - fixed buttons + and - - fixed drawing text for additional columns at level>0 --- Source/VirtualTrees.pas | 40 +++++++++++++++++++++------------------- 1 file changed, 21 insertions(+), 19 deletions(-) diff --git a/Source/VirtualTrees.pas b/Source/VirtualTrees.pas index 4143656d9..645b08739 100644 --- a/Source/VirtualTrees.pas +++ b/Source/VirtualTrees.pas @@ -1961,7 +1961,7 @@ TClipboardFormats = class(TStringList) TVTGetHintSizeEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var R: TRect) of object; // miscellaneous - TVTBeforeDrawLineImageEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Level: Integer; var PosX: Integer) of object; + TVTBeforeDrawLineImageEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Level: Integer; var PosX: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}) of object; TVTGetNodeDataSizeEvent = procedure(Sender: TBaseVirtualTree; var NodeDataSize: Integer) of object; TVTKeyActionEvent = procedure(Sender: TBaseVirtualTree; var CharCode: Word; var Shift: TShiftState; var DoDefault: Boolean) of object; @@ -2389,7 +2389,7 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF NewRect: TRect): Boolean; procedure ClearNodeBackground(const PaintInfo: TVTPaintInfo; UseBackground, Floating: Boolean; R: TRect); function CompareNodePositions(Node1, Node2: PVirtualNode; ConsiderChildrenAbove: Boolean = False): Integer; - procedure DrawLineImage(const PaintInfo: TVTPaintInfo; X, Y, H, VAlign: Integer; Style: TVTLineType; Reverse: Boolean); + procedure DrawLineImage(const PaintInfo: TVTPaintInfo; X, Y, H, VAlign: TDimension; Style: TVTLineType; Reverse: Boolean); function FindInPositionCache(Node: PVirtualNode; var CurrentPos: TDimension): PVirtualNode; overload; function FindInPositionCache(Position: TDimension; var CurrentPos: TDimension): PVirtualNode; overload; procedure FixupTotalCount(Node: PVirtualNode); @@ -2641,7 +2641,7 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF function DoCreateEditor(Node: PVirtualNode; Column: TColumnIndex): IVTEditLink; virtual; procedure DoDragging(P: TPoint); virtual; procedure DoDragExpand; virtual; - procedure DoBeforeDrawLineImage(Node: PVirtualNode; Level: Integer; var XPos: Integer); virtual; + procedure DoBeforeDrawLineImage(Node: PVirtualNode; Level: Integer; var XPos: TDimension); virtual; function DoDragOver(Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode; var Effect: Integer): Boolean; virtual; procedure DoDragDrop(Source: TObject; const DataObject: {$IFDEF VT_FMX}TDragObject{$ELSE}IDataObject{$ENDIF}; const Formats: TFormatArray; Shift: TShiftState; Pt: TPoint; @@ -12355,7 +12355,8 @@ constructor TBaseVirtualTree.Create(AOwner: TComponent); FBevelOuter:= TBevelCut.bvLowered; FBevelKind:= TBevelKind.bkNone; FBevelWidth:= 1; - FBorderWidth:= 0; + FBorderWidth:= 0; + FFont:= TFont.Create; {$ELSE} ControlStyle := ControlStyle - [csSetCaption] + [csCaptureMouse, csOpaque, csReplicatable, csDisplayDragImage, csReflector]; @@ -12510,6 +12511,7 @@ destructor TBaseVirtualTree.Destroy; {$IFDEF VT_FMX} if FDottedBrush <> nil then FreeAndNil(FDottedBrush); + FreeAndNil(FFont); {$ELSE} if FDottedBrush <> 0 then DeleteObject(FDottedBrush); @@ -13304,7 +13306,7 @@ function TBaseVirtualTree.CompareNodePositions(Node1, Node2: PVirtualNode; Consi //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.DrawLineImage(const PaintInfo: TVTPaintInfo; X, Y, H, VAlign: Integer; Style: TVTLineType; +procedure TBaseVirtualTree.DrawLineImage(const PaintInfo: TVTPaintInfo; X, Y, H, VAlign: TDimension; Style: TVTLineType; Reverse: Boolean); // Draws (depending on Style) one of the 5 line types of the tree. @@ -14486,8 +14488,8 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean); FMinusBM.Canvas.Blending:= false; FMinusBM.Canvas.Stroke.Kind := TBrushKind.bkSolid; FMinusBM.Canvas.Stroke.Color := FColors.TreeLineColor; - FMinusBM.Canvas.FillRect(Rect(1, 1, FMinusBM.Width-1, FMinusBM.Height-1), 0, 0, [], 1.0); - FMinusBM.Canvas.DrawRect(Rect(1, 1, FMinusBM.Width-1, FMinusBM.Height-1), 0, 0, [], 1.0); + FMinusBM.Canvas.FillRect(Rect(0, 0, FMinusBM.Width, FMinusBM.Height), 0, 0, [], 1.0); + FMinusBM.Canvas.DrawRect(Rect(0, 0, FMinusBM.Width, FMinusBM.Height), 0, 0, [], 1.0); FMinusBM.Canvas.Stroke.Color := FColors.NodeFontColor; FMinusBM.Canvas.DrawLine(Point(2, FMinusBM.Width / 2), Point(FMinusBM.Width - 2, FMinusBM.Width / 2), 1.0); FMinusBM.Canvas.EndScene(); @@ -14563,8 +14565,8 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean); FPlusBM.Canvas.Blending := false; FPlusBM.Canvas.Stroke.Kind := TBrushKind.bkSolid; FPlusBM.Canvas.Stroke.Color := FColors.TreeLineColor; - FPlusBM.Canvas.FillRect(Rect(1, 1, FPlusBM.Width-1, FPlusBM.Height-1), 0, 0, [], 1.0); - FPlusBM.Canvas.DrawRect(Rect(1, 1, FPlusBM.Width-1, FPlusBM.Height-1), 0, 0, [], 1.0); + FPlusBM.Canvas.FillRect(Rect(0, 0, FPlusBM.Width, FPlusBM.Height), 0, 0, [], 1.0); + FPlusBM.Canvas.DrawRect(Rect(0, 0, FPlusBM.Width, FPlusBM.Height), 0, 0, [], 1.0); FPlusBM.Canvas.Stroke.Color := FColors.NodeFontColor; FPlusBM.Canvas.DrawLine(Point(2, FPlusBM.Canvas.Width / 2), Point(FPlusBM.Canvas.Width - 2, FPlusBM.Canvas.Width / 2), 1.0); FPlusBM.Canvas.DrawLine(Point(FPlusBM.Canvas.Width / 2, 2), Point(FPlusBM.Canvas.Width / 2, FPlusBM.Canvas.Width - 2), 1.0); @@ -14692,7 +14694,6 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean); end; PatternBitmap.Canvas.EndScene; - PatternBitmap.SaveToFile('R:\pattern.bmp'); FDottedBrush := TBrush.Create(TBrushKind.Bitmap, clWhite); //###!!! CreatePatternBrush(PatternBitmap) FDottedBrush.Bitmap.Bitmap.Assign(PatternBitmap); FreeAndNil(PatternBitmap); @@ -20659,7 +20660,7 @@ procedure TBaseVirtualTree.DoDragDrop(Source: TObject; const DataObject: {$IFDEF //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.DoBeforeDrawLineImage(Node: PVirtualNode; Level: Integer; var XPos: Integer); +procedure TBaseVirtualTree.DoBeforeDrawLineImage(Node: PVirtualNode; Level: Integer; var XPos: TDimension); begin if Assigned(FOnBeforeDrawLineImage) then @@ -25110,7 +25111,7 @@ procedure TBaseVirtualTree.PaintTreeLines(const PaintInfo: TVTPaintInfo; VAlignm NewStyles: TLineImage; begin NewStyles := nil; -{$IFDEF VT_VCL} + with PaintInfo do begin if BidiMode = bdLeftToRight then @@ -25120,7 +25121,7 @@ procedure TBaseVirtualTree.PaintTreeLines(const PaintInfo: TVTPaintInfo; VAlignm end else begin - Offset := -Integer(FIndent); + Offset := -FIndent; XPos := CellRect.Right - PaintInfo.Offsets[ofsMargin] + Offset; end; @@ -25130,7 +25131,7 @@ procedure TBaseVirtualTree.PaintTreeLines(const PaintInfo: TVTPaintInfo; VAlignm begin // Convert the line images in correct bands. SetLength(NewStyles, Length(LineImage)); - for I := IndentSize - 1 downto 0 do + for I := {$IFDEF VT_FMX}Round{$ENDIF}(IndentSize) - 1 downto 0 do //TODO: round! begin if (vsExpanded in Node.States) and not (vsAllChildrenHidden in Node.States) then NewStyles[I] := ltLeft @@ -25158,8 +25159,8 @@ procedure TBaseVirtualTree.PaintTreeLines(const PaintInfo: TVTPaintInfo; VAlignm end; end; - PaintInfo.Canvas.Font.Color := FColors.GridLineColor; - for I := 0 to IndentSize - 1 do + PaintInfo.Canvas.{$IFDEF VT_FMX}Stroke{$ELSE}Font{$ENDIF}.Color := FColors.GridLineColor; //Stroke or Fill? and at this point? + for I := 0 to {$IFDEF VT_FMX}Round{$ENDIF}(IndentSize) - 1 do //TODO: round! begin DoBeforeDrawLineImage(PaintInfo.Node, I + Ord(not (toShowRoot in TreeOptions.PaintOptions)), XPos); DrawLineImage(PaintInfo, XPos, CellRect.Top, NodeHeight[Node] - 1, VAlignment - 1, NewStyles[I], @@ -25168,8 +25169,8 @@ procedure TBaseVirtualTree.PaintTreeLines(const PaintInfo: TVTPaintInfo; VAlignm end; end; else // lmNormal - PaintInfo.Canvas.Font.Color := FColors.TreeLineColor; - for I := 0 to IndentSize - 1 do + PaintInfo.Canvas.{$IFDEF VT_FMX}Stroke{$ELSE}Font{$ENDIF}.Color := FColors.TreeLineColor; + for I := 0 to {$IFDEF VT_FMX}Round{$ENDIF}(IndentSize) - 1 do begin DoBeforeDrawLineImage(PaintInfo.Node, I + Ord(not (toShowRoot in TreeOptions.PaintOptions)), XPos); DrawLineImage(PaintInfo, XPos, CellRect.Top, NodeHeight[Node], VAlignment - 1, LineImage[I], @@ -25178,7 +25179,6 @@ procedure TBaseVirtualTree.PaintTreeLines(const PaintInfo: TVTPaintInfo; VAlignm end; end; end; -{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -31949,8 +31949,10 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe with PaintInfo do begin Items[NextColumn].GetAbsoluteBounds(CellRect.Left, CellRect.Right); +{$IFDEF VT_VCL} CellRect.Bottom := Node.NodeHeight; ContentRect.Bottom := Node.NodeHeight; +{$ENDIF} end; end; end; From 5bb5d784afdcb68b1fc5143c77d92cb826149613 Mon Sep 17 00:00:00 2001 From: livius2 Date: Thu, 8 Nov 2018 23:07:48 +0100 Subject: [PATCH 10/61] Cliping, Text alignment - clipping cell painting - column text alignment --- Source/VirtualTrees.pas | 343 +++++++++++++++++++++++----------------- 1 file changed, 198 insertions(+), 145 deletions(-) diff --git a/Source/VirtualTrees.pas b/Source/VirtualTrees.pas index 645b08739..de7e96c28 100644 --- a/Source/VirtualTrees.pas +++ b/Source/VirtualTrees.pas @@ -14686,7 +14686,7 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean); begin if PWordArray(Bits)^[line] and (1 shl bit)=0 then BitmapData.SetPixel(bit, line, clWhite) else - BitmapData.SetPixel(bit, line, clBlack); + BitmapData.SetPixel(bit, line, FColors.TreeLineColor); end; end; finally @@ -31525,7 +31525,7 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe ColLeft, ColRight: TDimension; - SavedTargetDC: Integer; + SavedTargetDC: {$IFDEF VT_FMX}TCanvasSaveState{$ELSE}Integer{$ENDIF}; PaintWidth: TDimension; CurrentNodeHeight: TDimension; lUseSelectedBkColor: Boolean; // determines if the dotted grid lines need to be painted in selection color of background color @@ -31533,7 +31533,9 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe CellIsTouchingClientRight: Boolean; CellIsInLastColumn: Boolean; ColumnIsFixed: Boolean; - +{$IFDEF VT_FMX} + WasDecLine: Integer; +{$ENDIF} begin {$IFDEF VT_FMX} PaintOptions:= PaintOptions + [poUnbuffered]; //!!!!!!! @@ -31645,6 +31647,9 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe // ----- main node paint loop while Assigned(PaintInfo.Node) do begin +{$IFDEF VT_FMX} + WasDecLine := 0; +{$ENDIF} // Determine LineImage, SelectionLevel and IndentSize SelectLevel := DetermineLineImageAndSelectLevel(PaintInfo.Node, LineImage); IndentSize := Length(LineImage); @@ -31698,6 +31703,15 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe CurrentNodeHeight := PaintInfo.Node.NodeHeight; {$IFDEF VT_FMX} R := TargetRect; + if (poGridLines in PaintOptions) and (toShowHorzGridLines in FOptions.FPaintOptions) then + begin + if WasDecLine=0 then + begin + Dec(R.Bottom); + end; + System.inc(WasDecLine); + end; + {$ELSE} R.Bottom := CurrentNodeHeight; {$ENDIF} @@ -31762,177 +31776,192 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe if PaintInfo.BidiMode <> bdLeftToRight then ChangeBiDiModeAlignment(PaintInfo.Alignment); {$ENDIF} - - // Paint the current cell if it is marked as being visible or columns aren't used and - // if this cell belongs to the main column if only the main column should be drawn. - if (not UseColumns or (coVisible in Items[PaintInfo.Column].FOptions)) and - (not (poMainOnly in PaintOptions) or IsMainColumn) then - begin - AdjustPaintCellRect(PaintInfo, NextColumn); - - // Paint the cell only if it is in the current window. - if PaintInfo.CellRect.Right > Window.Left then +{$IFDEF VT_FMX} + SavedTargetDC := TargetCanvas.SaveState; +{$ENDIF} + try + // Paint the current cell if it is marked as being visible or columns aren't used and + // if this cell belongs to the main column if only the main column should be drawn. + if (not UseColumns or (coVisible in Items[PaintInfo.Column].FOptions)) and + (not (poMainOnly in PaintOptions) or IsMainColumn) then begin - with PaintInfo do - begin - // Fill in remaining values in the paint info structure. - NodeWidth := DoGetNodeWidth(Node, Column, Canvas); + + AdjustPaintCellRect(PaintInfo, NextColumn); - if ShowCheckImages and IsMainColumn then + // Paint the cell only if it is in the current window. + if PaintInfo.CellRect.Right > Window.Left then + begin + with PaintInfo do begin - ImageInfo[iiCheck].Index := GetCheckImage(Node); - ImageInfo[iiCheck].Images := FCheckImages; - ImageInfo[iiCheck].Ghosted := False; - end - else - ImageInfo[iiCheck].Index := -1; - if ShowStateImages then - GetImageIndex(PaintInfo, ikState, iiState) - else - ImageInfo[iiState].Index := -1; - if ShowImages then - GetImageIndex(PaintInfo, ImageKind[vsSelected in Node.States], iiNormal) - else - ImageInfo[iiNormal].Index := -1; + // Fill in remaining values in the paint info structure. + NodeWidth := DoGetNodeWidth(Node, Column, Canvas); - // Take the space for the tree lines into account. - PaintInfo.AdjustImageCoordinates(VAlign); - if UseColumns then - begin - ClipRect := CellRect; - if poUnbuffered in PaintOptions then + if ShowCheckImages and IsMainColumn then begin - ClipRect.Left := Max(ClipRect.Left, Window.Left); - ClipRect.Right := Min(ClipRect.Right, Window.Right); - ClipRect.Top := Max(ClipRect.Top, Window.Top - (BaseOffset - CurrentNodeHeight)); - ClipRect.Bottom := ClipRect.Bottom - Max(TargetRect.Bottom - MaximumBottom, 0); - end; + ImageInfo[iiCheck].Index := GetCheckImage(Node); + ImageInfo[iiCheck].Images := FCheckImages; + ImageInfo[iiCheck].Ghosted := False; + end + else + ImageInfo[iiCheck].Index := -1; + if ShowStateImages then + GetImageIndex(PaintInfo, ikState, iiState) + else + ImageInfo[iiState].Index := -1; + if ShowImages then + GetImageIndex(PaintInfo, ImageKind[vsSelected in Node.States], iiNormal) + else + ImageInfo[iiNormal].Index := -1; + + // Take the space for the tree lines into account. + PaintInfo.AdjustImageCoordinates(VAlign); + if UseColumns then + begin + ClipRect := CellRect; + if poUnbuffered in PaintOptions then + begin + ClipRect.Left := Max(ClipRect.Left, Window.Left); + ClipRect.Right := Min(ClipRect.Right, Window.Right); + ClipRect.Top := Max(ClipRect.Top, Window.Top - (BaseOffset - CurrentNodeHeight)); + ClipRect.Bottom := ClipRect.Bottom - Max(TargetRect.Bottom - MaximumBottom, 0){$IFDEF VT_FMX}+1{$ENDIF}; + end; {$IFDEF VT_FMX} - //Canvas.IntersectClipRect(ClipRect); + Canvas.IntersectClipRect(ClipRect); {$ELSE} - ClipCanvas(Canvas, ClipRect); + ClipCanvas(Canvas, ClipRect); {$ENDIF} - end; + end; - // Paint the horizontal grid line. - if (poGridLines in PaintOptions) and (toShowHorzGridLines in FOptions.FPaintOptions) then - begin + // Paint the horizontal grid line. + if (poGridLines in PaintOptions) and (toShowHorzGridLines in FOptions.FPaintOptions) then + begin {$IFDEF VT_FMX} - Canvas.Fill.Color := FColors.GridLineColor; + Canvas.Fill.Color := FColors.GridLineColor; {$ELSE} - Canvas.Font.Color := FColors.GridLineColor; + Canvas.Font.Color := FColors.GridLineColor; {$ENDIF} - if IsMainColumn and (FLineMode = lmBands) then - begin - if BidiMode = bdLeftToRight then + if IsMainColumn and (FLineMode = lmBands) then begin - DrawDottedHLine(PaintInfo, CellRect.Left + IfThen(toFixedIndent in FOptions.FPaintOptions, 1, IndentSize) * FIndent, CellRect.Right - 1, - CellRect.Bottom - 1); + if BidiMode = bdLeftToRight then + begin + DrawDottedHLine(PaintInfo, CellRect.Left + IfThen(toFixedIndent in FOptions.FPaintOptions, 1, IndentSize) * FIndent, CellRect.Right - 1, + CellRect.Bottom - 1); + end + else + begin + DrawDottedHLine(PaintInfo, CellRect.Left, CellRect.Right - IfThen(toFixedIndent in FOptions.FPaintOptions, 1, IndentSize) * FIndent - 1, + CellRect.Bottom - 1); + end; end else - begin - DrawDottedHLine(PaintInfo, CellRect.Left, CellRect.Right - IfThen(toFixedIndent in FOptions.FPaintOptions, 1, IndentSize) * FIndent - 1, - CellRect.Bottom - 1); - end; - end - else - DrawDottedHLine(PaintInfo, CellRect.Left, CellRect.Right, CellRect.Bottom - 1); - - Dec(CellRect.Bottom); - Dec(ContentRect.Bottom); - end; + DrawDottedHLine(PaintInfo, CellRect.Left, CellRect.Right, CellRect.Bottom - 1); +{$IFDEF VT_FMX} + if WasDecLine=0 then + begin + Dec(CellRect.Bottom); + Dec(ContentRect.Bottom); + end; + System.inc(WasDecLine); +{$ELSE} + Dec(CellRect.Bottom); + Dec(ContentRect.Bottom); +{$ENDIF} + end; - if UseColumns then - begin - // Paint vertical grid line. - if (poGridLines in PaintOptions) and (toShowVertGridLines in FOptions.FPaintOptions) then + if UseColumns then begin - // These variables and the nested if conditions shall make the logic - // easier to understand. - CellIsTouchingClientRight := PaintInfo.CellRect.Right = {$IFDEF VT_FMX}ClipRect{$ELSE}ClientRect{$ENDIF}.Right; - CellIsInLastColumn := Position = TColumnPosition(Count - 1); - ColumnIsFixed := coFixed in FHeader.FColumns[Column].Options; - - // Don't draw if this is the last column and the header is in autosize mode. - if not ((hoAutoResize in FHeader.FOptions) and CellIsInLastColumn) then + // Paint vertical grid line. + if (poGridLines in PaintOptions) and (toShowVertGridLines in FOptions.FPaintOptions) then begin - // We have to take spanned cells into account which we determine - // by checking if CellRect.Right equals the Window.Right. - // But since the PaintTree procedure is called twice in - // TBaseVirtualTree.Paint (i.e. for fixed columns and other columns. - // CellIsTouchingClientRight does not work for fixed columns.) - // we have to paint fixed column grid line anyway. - if not CellIsTouchingClientRight or ColumnIsFixed then + // These variables and the nested if conditions shall make the logic + // easier to understand. + CellIsTouchingClientRight := PaintInfo.CellRect.Right = {$IFDEF VT_FMX}ClipRect{$ELSE}ClientRect{$ENDIF}.Right; + CellIsInLastColumn := Position = TColumnPosition(Count - 1); + ColumnIsFixed := coFixed in FHeader.FColumns[Column].Options; + + // Don't draw if this is the last column and the header is in autosize mode. + if not ((hoAutoResize in FHeader.FOptions) and CellIsInLastColumn) then begin - if (BidiMode = bdLeftToRight) or not ColumnIsEmpty(Node, Column) then + // We have to take spanned cells into account which we determine + // by checking if CellRect.Right equals the Window.Right. + // But since the PaintTree procedure is called twice in + // TBaseVirtualTree.Paint (i.e. for fixed columns and other columns. + // CellIsTouchingClientRight does not work for fixed columns.) + // we have to paint fixed column grid line anyway. + if not CellIsTouchingClientRight or ColumnIsFixed then begin -{$IFDEF VT_FMX} - Canvas.Fill.Color := FColors.GridLineColor; -{$ELSE} - Canvas.Font.Color := FColors.GridLineColor; -{$ENDIF} - lUseSelectedBkColor := (poDrawSelection in PaintOptions) and (toFullRowSelect in FOptions.FSelectionOptions) and - (vsSelected in Node.States) and not (toUseBlendedSelection in FOptions.PaintOptions) - {$IFDEF VT_VCL}and not (tsUseExplorerTheme in FStates){$ENDIF}; - DrawDottedVLine(PaintInfo, CellRect.Top, CellRect.Bottom, CellRect.Right - 1, lUseSelectedBkColor); + if (BidiMode = bdLeftToRight) or not ColumnIsEmpty(Node, Column) then + begin + {$IFDEF VT_FMX} + Canvas.Fill.Color := FColors.GridLineColor; + {$ELSE} + Canvas.Font.Color := FColors.GridLineColor; + {$ENDIF} + lUseSelectedBkColor := (poDrawSelection in PaintOptions) and (toFullRowSelect in FOptions.FSelectionOptions) and + (vsSelected in Node.States) and not (toUseBlendedSelection in FOptions.PaintOptions) + {$IFDEF VT_VCL}and not (tsUseExplorerTheme in FStates){$ENDIF}; + DrawDottedVLine(PaintInfo, CellRect.Top, CellRect.Bottom, CellRect.Right - 1, lUseSelectedBkColor); + end; + + Dec(CellRect.Right); + Dec(ContentRect.Right); end; - - Dec(CellRect.Right); - Dec(ContentRect.Right); end; end; end; - end; - // Prepare background and focus rect for the current cell. - PrepareCell(PaintInfo, Window.Left, PaintWidth); + // Prepare background and focus rect for the current cell. + PrepareCell(PaintInfo, Window.Left, PaintWidth); - // Some parts are only drawn for the main column. - if IsMainColumn then - begin - if (toShowTreeLines in FOptions.FPaintOptions) and - (not (toHideTreeLinesIfThemed in FOptions.FPaintOptions) or - not (tsUseThemes in FStates)) then - PaintTreeLines(PaintInfo, VAlign, IfThen(toFixedIndent in FOptions.FPaintOptions, 1, - IndentSize), LineImage); - // Show node button if allowed, if there child nodes and at least one of the child - // nodes is visible or auto button hiding is disabled. - if (toShowButtons in FOptions.FPaintOptions) and (vsHasChildren in Node.States) and - not ((vsAllChildrenHidden in Node.States) and - (toAutoHideButtons in TreeOptions.FAutoOptions)) and - ((toShowRoot in TreeOptions.PaintOptions) or (GetNodeLevel(Node) > 0)) - then - PaintNodeButton(Canvas, Node, Column, CellRect, Offsets[ofsToggleButton], ButtonY, BidiMode); // Relative X position of toggle button is needed for proper BiDi calculation - - if ImageInfo[iiCheck].Index > -1 then - PaintCheckImage(Canvas, PaintInfo.ImageInfo[iiCheck], vsSelected in PaintInfo.Node.States); - end; + // Some parts are only drawn for the main column. + if IsMainColumn then + begin + if (toShowTreeLines in FOptions.FPaintOptions) and + (not (toHideTreeLinesIfThemed in FOptions.FPaintOptions) or + not (tsUseThemes in FStates)) then + PaintTreeLines(PaintInfo, VAlign, IfThen(toFixedIndent in FOptions.FPaintOptions, 1, + IndentSize), LineImage); + // Show node button if allowed, if there child nodes and at least one of the child + // nodes is visible or auto button hiding is disabled. + if (toShowButtons in FOptions.FPaintOptions) and (vsHasChildren in Node.States) and + not ((vsAllChildrenHidden in Node.States) and + (toAutoHideButtons in TreeOptions.FAutoOptions)) and + ((toShowRoot in TreeOptions.PaintOptions) or (GetNodeLevel(Node) > 0)) + then + PaintNodeButton(Canvas, Node, Column, CellRect, Offsets[ofsToggleButton], ButtonY, BidiMode); // Relative X position of toggle button is needed for proper BiDi calculation + + if ImageInfo[iiCheck].Index > -1 then + PaintCheckImage(Canvas, PaintInfo.ImageInfo[iiCheck], vsSelected in PaintInfo.Node.States); + end; - if ImageInfo[iiState].Index > -1 then - PaintImage(PaintInfo, iiState, False); - if ImageInfo[iiNormal].Index > -1 then - PaintImage(PaintInfo, iiNormal, True); + if ImageInfo[iiState].Index > -1 then + PaintImage(PaintInfo, iiState, False); + if ImageInfo[iiNormal].Index > -1 then + PaintImage(PaintInfo, iiNormal, True); - // Now let descendants or applications draw whatever they want, - // but don't draw the node if it is currently being edited. - if not ((tsEditing in FStates) and (Node = FFocusedNode) and - ((Column = FEditColumn) or not UseColumns)) then - DoPaintNode(PaintInfo); + // Now let descendants or applications draw whatever they want, + // but don't draw the node if it is currently being edited. + if not ((tsEditing in FStates) and (Node = FFocusedNode) and + ((Column = FEditColumn) or not UseColumns)) then + DoPaintNode(PaintInfo); - DoAfterCellPaint(Canvas, Node, Column, CellRect); + DoAfterCellPaint(Canvas, Node, Column, CellRect); + end; end; - end; - - // leave after first run if columns aren't used - if not UseColumns then - Break; - end - else - NextColumn := GetNextVisibleColumn(PaintInfo.Column); + // leave after first run if columns aren't used + if not UseColumns then + Break; + end + else + NextColumn := GetNextVisibleColumn(PaintInfo.Column); + finally {$IFDEF VT_FMX} - //PaintInfo.Canvas.IntersectClipRect(Rect(0, 0, 0, 0)); -{$ELSE} + PaintInfo.Canvas.RestoreState(SavedTargetDC); +{$ENDIF} + end; + +{$IFDEF VT_VCL} SelectClipRgn(PaintInfo.Canvas.Handle, 0); {$ENDIF} @@ -32160,7 +32189,9 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe end; finally PaintInfo.Canvas.Unlock; -{$IFDEF VT_VCL} +{$IFDEF VT_FMX} + //TargetCanvas.RestoreState(SavedTargetDC); +{$ELSE} if poUnbuffered in PaintOptions then RestoreDC(TargetCanvas.Handle, SavedTargetDC) else @@ -35480,14 +35511,36 @@ procedure TCustomVirtualStringTree.DoTextDrawing(var PaintInfo: TVTPaintInfo; co var DefaultDraw: Boolean; - +{$IFDEF VT_FMX} + hAlign: TTextAlign; + vAlign: TTextAlign; + Flags: TFillTextFlags; +{$ENDIF} begin DefaultDraw := True; if Assigned(FOnDrawText) then FOnDrawText(Self, PaintInfo.Canvas, PaintInfo.Node, PaintInfo.Column, Text, CellRect, DefaultDraw); if DefaultDraw then {$IFDEF VT_FMX} - PaintInfo.Canvas.FillText(CellRect, (Text), true, 1.0, [], TTextAlign.Leading); + hAlign:= TTextAlign.Leading; + if DrawFormat and DT_CENTER<>0 then + hAlign:= TTextAlign.Center; + if DrawFormat and DT_RIGHT<>0 then + hAlign:= TTextAlign.Trailing; + + + vAlign:= TTextAlign.Center; + if DrawFormat and DT_VCENTER<>0 then + vAlign:= TTextAlign.Center; + if DrawFormat and DT_BOTTOM<>0 then + vAlign:= TTextAlign.Trailing; + + Flags:= []; + + if DrawFormat and DT_RTLREADING<>0 then + Flags:= Flags + [TFillTextFlag.RightToLeft]; + + PaintInfo.Canvas.FillText(CellRect, Text, true, 1.0, Flags, hAlign, vAlign); {$ELSE} Winapi.Windows.DrawTextW(PaintInfo.Canvas.Handle, PWideChar(Text), Length(Text), CellRect, DrawFormat); {$ENDIF} From 8f7297802a045c8b578952c2f1d2f22d6a0373a3 Mon Sep 17 00:00:00 2001 From: Karol Bieniaszewski Date: Fri, 9 Nov 2018 08:17:07 +0100 Subject: [PATCH 11/61] Update README.md --- README.md | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/README.md b/README.md index 01a79f715..18ae7f08c 100644 --- a/README.md +++ b/README.md @@ -1,3 +1,20 @@ +About this prot to Firemonkey: + +What is working +1. It compiles under FMX - this was main task of this pull request. +2. It draw tree nodes structure with apropiate levels +3. It draw buttons plus/minus. +4. It drwa tree lines, horizontal lines, vertical lines, full vertical lines (some pixel improvement needed but it work) +5. it support cliping during cell draw +6. it support multiple columns but it does not support header drawing + +What is not working yet: +1. any mouse action like click, drag-drop +2. clipboard +3. drawing and supoport of tree border +4. drawing background +5. drawing header + point 1. + # Virtual-TreeView Virtual Treeview is a Delphi treeview control built from ground up. Many years of development made it one of the most flexible and advanced tree controls available today. Virtual Treeview starts off with the claim to improve many aspects of existing solutions and introduces some new technologies and principles which were not available before. From 7a480eb1b3107658e4311433e7b8c2e515950f71 Mon Sep 17 00:00:00 2001 From: Karol Bieniaszewski Date: Fri, 9 Nov 2018 08:17:23 +0100 Subject: [PATCH 12/61] Update README.md --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 18ae7f08c..99d915cf3 100644 --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -About this prot to Firemonkey: +About this port to Firemonkey: What is working 1. It compiles under FMX - this was main task of this pull request. From 85df81447c21d4ddfc6b94440bba00cf2d5bbe04 Mon Sep 17 00:00:00 2001 From: Karol Bieniaszewski Date: Fri, 9 Nov 2018 08:18:23 +0100 Subject: [PATCH 13/61] Update README.md --- README.md | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/README.md b/README.md index 99d915cf3..18c47bb18 100644 --- a/README.md +++ b/README.md @@ -3,10 +3,11 @@ About this port to Firemonkey: What is working 1. It compiles under FMX - this was main task of this pull request. 2. It draw tree nodes structure with apropiate levels -3. It draw buttons plus/minus. -4. It drwa tree lines, horizontal lines, vertical lines, full vertical lines (some pixel improvement needed but it work) -5. it support cliping during cell draw -6. it support multiple columns but it does not support header drawing +3. It draw nodes text with alignment +4. It draw buttons plus/minus. +5. It draw tree lines, horizontal lines, vertical lines, full vertical lines (some pixel improvement needed but it work) +6. it support cliping during cell draw +7. it support multiple columns but it does not support header drawing What is not working yet: 1. any mouse action like click, drag-drop From 86fcfc09d3737a8211217579454687eae0df9d0c Mon Sep 17 00:00:00 2001 From: Karol Bieniaszewski Date: Fri, 9 Nov 2018 08:18:57 +0100 Subject: [PATCH 14/61] Update README.md --- README.md | 1 + 1 file changed, 1 insertion(+) diff --git a/README.md b/README.md index 18c47bb18..d5f2224f1 100644 --- a/README.md +++ b/README.md @@ -15,6 +15,7 @@ What is not working yet: 3. drawing and supoport of tree border 4. drawing background 5. drawing header + point 1. +6. drawing selection and focus rect # Virtual-TreeView Virtual Treeview is a Delphi treeview control built from ground up. Many years of development made it one of the most flexible and advanced tree controls available today. Virtual Treeview starts off with the claim to improve many aspects of existing solutions and introduces some new technologies and principles which were not available before. From 15756c8a70a8933fd3604f85bf2e7d6d28414fb1 Mon Sep 17 00:00:00 2001 From: Karol Bieniaszewski Date: Fri, 9 Nov 2018 08:21:38 +0100 Subject: [PATCH 15/61] Update README.md --- README.md | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/README.md b/README.md index d5f2224f1..e6b7f8565 100644 --- a/README.md +++ b/README.md @@ -17,6 +17,11 @@ What is not working yet: 5. drawing header + point 1. 6. drawing selection and focus rect +Also it is derived from TRectangle. +Will be good to have it as presented control with appropiate TDataModel. +This will bring more possibilities like have e.g. 2 tree on the form based on same data. +One will be i scale 1 seconde smaller in scale e.g 0.2 as a preview. + # Virtual-TreeView Virtual Treeview is a Delphi treeview control built from ground up. Many years of development made it one of the most flexible and advanced tree controls available today. Virtual Treeview starts off with the claim to improve many aspects of existing solutions and introduces some new technologies and principles which were not available before. From 9bc27eb50a9a51009385600ef0443b4381366e06 Mon Sep 17 00:00:00 2001 From: Karol Bieniaszewski Date: Fri, 9 Nov 2018 08:22:03 +0100 Subject: [PATCH 16/61] Update README.md --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index e6b7f8565..c484e26cb 100644 --- a/README.md +++ b/README.md @@ -17,7 +17,7 @@ What is not working yet: 5. drawing header + point 1. 6. drawing selection and focus rect -Also it is derived from TRectangle. +Current VT is derived from TRectangle. Will be good to have it as presented control with appropiate TDataModel. This will bring more possibilities like have e.g. 2 tree on the form based on same data. One will be i scale 1 seconde smaller in scale e.g 0.2 as a preview. From 9de9ad0dce9491a09b7229f2cc8fa917fe63aee0 Mon Sep 17 00:00:00 2001 From: Karol Bieniaszewski Date: Fri, 9 Nov 2018 08:22:40 +0100 Subject: [PATCH 17/61] Update README.md --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index c484e26cb..414a3f5c5 100644 --- a/README.md +++ b/README.md @@ -20,7 +20,7 @@ What is not working yet: Current VT is derived from TRectangle. Will be good to have it as presented control with appropiate TDataModel. This will bring more possibilities like have e.g. 2 tree on the form based on same data. -One will be i scale 1 seconde smaller in scale e.g 0.2 as a preview. +One will be i scale 1 second smaller in scale e.g 0.2 as a preview. # Virtual-TreeView Virtual Treeview is a Delphi treeview control built from ground up. Many years of development made it one of the most flexible and advanced tree controls available today. Virtual Treeview starts off with the claim to improve many aspects of existing solutions and introduces some new technologies and principles which were not available before. From 3056fd225092023836e34cd3b71260abe79190dc Mon Sep 17 00:00:00 2001 From: Karol Bieniaszewski Date: Fri, 9 Nov 2018 08:17:07 +0100 Subject: [PATCH 18/61] Update README.md Update README.md Update README.md Update README.md Update README.md Update README.md Update README.md --- README.md | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/README.md b/README.md index 01a79f715..414a3f5c5 100644 --- a/README.md +++ b/README.md @@ -1,3 +1,27 @@ +About this port to Firemonkey: + +What is working +1. It compiles under FMX - this was main task of this pull request. +2. It draw tree nodes structure with apropiate levels +3. It draw nodes text with alignment +4. It draw buttons plus/minus. +5. It draw tree lines, horizontal lines, vertical lines, full vertical lines (some pixel improvement needed but it work) +6. it support cliping during cell draw +7. it support multiple columns but it does not support header drawing + +What is not working yet: +1. any mouse action like click, drag-drop +2. clipboard +3. drawing and supoport of tree border +4. drawing background +5. drawing header + point 1. +6. drawing selection and focus rect + +Current VT is derived from TRectangle. +Will be good to have it as presented control with appropiate TDataModel. +This will bring more possibilities like have e.g. 2 tree on the form based on same data. +One will be i scale 1 second smaller in scale e.g 0.2 as a preview. + # Virtual-TreeView Virtual Treeview is a Delphi treeview control built from ground up. Many years of development made it one of the most flexible and advanced tree controls available today. Virtual Treeview starts off with the claim to improve many aspects of existing solutions and introduces some new technologies and principles which were not available before. From cfef0eb16c824ed0739f7b524d6670ddd8baa308 Mon Sep 17 00:00:00 2001 From: livius2 Date: Fri, 9 Nov 2018 15:56:17 +0100 Subject: [PATCH 19/61] soft fix for + bitmap soft fix for + bitmap --- Source/VirtualTrees.FMX.pas | 17 ++++++++++++++++- Source/VirtualTrees.pas | 26 ++++++++++++++++++++------ 2 files changed, 36 insertions(+), 7 deletions(-) diff --git a/Source/VirtualTrees.FMX.pas b/Source/VirtualTrees.FMX.pas index 0e39364a4..0c87123d9 100644 --- a/Source/VirtualTrees.FMX.pas +++ b/Source/VirtualTrees.FMX.pas @@ -6,7 +6,7 @@ interface uses System.UITypes, System.Types, System.ImageList, FMX.ImgList, FMX.Graphics; const - clBtnFace = TAlphaColorRec.Gray; + clBtnFace = TAlphaColor($FFF0F0F0); //TAlphaColorRec.Gray; clBtnText = TAlphaColorRec.Black; clBtnHighlight = TAlphaColorRec.DkGray; clBtnShadow = TAlphaColorRec.Darkgray; @@ -212,6 +212,12 @@ procedure DrawTextW(ACanvas: TCanvas; CaptionText: String; Len: Integer; Bounds: procedure GetTextExtentPoint32W(ACanvas: TCanvas; CaptionText: String; Len: Integer; Var Size: TSizeF); {--}procedure DrawEdge(TargetCanvas: TCanvas; PaintRectangle: TRectF; PressedButtonStyle, PressedButtonFlags: Cardinal); +type + THighQualityBitmap = class(TBitmap) + public + constructor Create; override; + end; + implementation uses FMX.TextLayout, System.SysUtils, FMX.Types; @@ -422,4 +428,13 @@ procedure TChangeLink.SetSender(const Value: TCustomImageList); +{ THighQualityBitmap } + +constructor THighQualityBitmap.Create; +begin + + inherited; + +end; + end. diff --git a/Source/VirtualTrees.pas b/Source/VirtualTrees.pas index de7e96c28..3b8eedda7 100644 --- a/Source/VirtualTrees.pas +++ b/Source/VirtualTrees.pas @@ -2120,7 +2120,7 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF FButtonFillMode: TVTButtonFillMode; // for rectangular tree buttons only: how to fill them FLineStyle: TVTLineStyle; // style of the tree lines FLineMode: TVTLineMode; // tree lines or bands etc. - FDottedBrush: {$IFDEF VT_FMX}TBrush{$ELSE}HBRUSH{$ENDIF}; // used to paint dotted lines without special pens + FDottedBrush: {$IFDEF VT_FMX}TStrokeBrush{$ELSE}HBRUSH{$ENDIF}; // used to paint dotted lines without special pens FSelectionCurveRadius: Cardinal; // radius for rounded selection rectangles FSelectionBlendFactor: Byte; // Determines the factor by which the selection rectangle is to be // faded if enabled. @@ -14367,7 +14367,7 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean); {$IFDEF VT_FMX} ABitmap.SetSize(9, 9); - ABitmap.Canvas.Fill.Color := $00FF00FF; // TAlphaColorRec.Fuchsia; + ABitmap.Canvas.Fill.Color := TAlphaColorRec.Null; ABitmap.Clear(ABitmap.Canvas.Fill.Color); {$ELSE} with ABitmap, Canvas do @@ -14565,11 +14565,16 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean); FPlusBM.Canvas.Blending := false; FPlusBM.Canvas.Stroke.Kind := TBrushKind.bkSolid; FPlusBM.Canvas.Stroke.Color := FColors.TreeLineColor; - FPlusBM.Canvas.FillRect(Rect(0, 0, FPlusBM.Width, FPlusBM.Height), 0, 0, [], 1.0); - FPlusBM.Canvas.DrawRect(Rect(0, 0, FPlusBM.Width, FPlusBM.Height), 0, 0, [], 1.0); + FPlusBM.Canvas.FillRect(Rect(0, 0, FPlusBM.Width-1, FPlusBM.Height), 0, 0, [], 1.0); + FPlusBM.Canvas.DrawRect(Rect(0, 0, FPlusBM.Width-1, FPlusBM.Height), 0, 0, [], 1.0); FPlusBM.Canvas.Stroke.Color := FColors.NodeFontColor; + FPlusBM.Canvas.DrawLine(Point(2, 4.5), Point(FPlusBM.Canvas.Width - 2, 4.5), 1.0); + FPlusBM.Canvas.DrawLine(Point(4.0, 2), Point(4.0, FPlusBM.Canvas.Width - 2), 1.0); + + { FPlusBM.Canvas.DrawLine(Point(2, FPlusBM.Canvas.Width / 2), Point(FPlusBM.Canvas.Width - 2, FPlusBM.Canvas.Width / 2), 1.0); FPlusBM.Canvas.DrawLine(Point(FPlusBM.Canvas.Width / 2, 2), Point(FPlusBM.Canvas.Width / 2, FPlusBM.Canvas.Width - 2), 1.0); + } FPlusBM.Canvas.EndScene(); {$ELSE} Pen.Color := FColors.TreeLineColor; @@ -14673,7 +14678,7 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean); PatternBitmap.Clear($00FF00FF); //fully transparent PatternBitmap.Canvas.BeginScene; - PatternBitmap.Map(TMapAccess.ReadWrite, BitmapData); + PatternBitmap.Map(TMapAccess.Write, BitmapData); try { //AlphaColorToPixel PixelToAlphaColor ScanlineToAlphaColor @@ -14694,9 +14699,18 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean); end; PatternBitmap.Canvas.EndScene; - FDottedBrush := TBrush.Create(TBrushKind.Bitmap, clWhite); //###!!! CreatePatternBrush(PatternBitmap) + + //FMX pattern brush is different then VCL. Where color is derived from current one... + //We should have 2 brushes 1 for Tree lines 1 for grid lines + //and recreate it every time when color is changing + FDottedBrush := TStrokeBrush.Create(TBrushKind.Bitmap, clWhite); //###!!! CreatePatternBrush(PatternBitmap) FDottedBrush.Bitmap.Bitmap.Assign(PatternBitmap); FreeAndNil(PatternBitmap); + (* + FDottedBrush := TStrokeBrush.Create(TBrushKind.Solid, {FColors.GridLineColor}clBlue); //###!!! CreatePatternBrush(PatternBitmap) + (FDottedBrush as TStrokeBrush).Dash:= TStrokeDash.Dot; + FreeAndNil(PatternBitmap); + *) {$ELSE} PatternBitmap := CreateBitmap(8, 8, 1, 1, Bits); FDottedBrush := CreatePatternBrush(PatternBitmap); From 93be8bcf8b7c9884cd6efd9ed4c9cb9653c12073 Mon Sep 17 00:00:00 2001 From: livius2 Date: Fri, 9 Nov 2018 23:23:45 +0100 Subject: [PATCH 20/61] Added header drawing - added header columns drawing with button styles - DrawEdge (still some issues but near to compleated) --- README.md | 29 ++++---- Source/VirtualTrees.FMX.pas | 144 +++++++++++++++++++++++++++++++++--- Source/VirtualTrees.pas | 36 +++++++-- 3 files changed, 177 insertions(+), 32 deletions(-) diff --git a/README.md b/README.md index 414a3f5c5..681e2aa89 100644 --- a/README.md +++ b/README.md @@ -1,21 +1,22 @@ About this port to Firemonkey: -What is working -1. It compiles under FMX - this was main task of this pull request. -2. It draw tree nodes structure with apropiate levels -3. It draw nodes text with alignment -4. It draw buttons plus/minus. -5. It draw tree lines, horizontal lines, vertical lines, full vertical lines (some pixel improvement needed but it work) -6. it support cliping during cell draw -7. it support multiple columns but it does not support header drawing +What is working: +1. it compiles under FMX - this was main task of this pull request; +2. it draw tree nodes structure with apropiate levels; +3. it draw nodes text with alignment; +4. it draw buttons plus/minus; +5. it draw tree lines, horizontal lines, vertical lines, full vertical lines (some pixel improvement needed but it work); +6. it support cliping during cell draw; +7. it support multiple columns; +8. it draw header columns. What is not working yet: -1. any mouse action like click, drag-drop -2. clipboard -3. drawing and supoport of tree border -4. drawing background -5. drawing header + point 1. -6. drawing selection and focus rect +1. any mouse action like click, drag-drop; +2. clipboard; +3. drawing and supoport of tree border; +4. drawing background; +5. mouse ations on header (point 1); +6. drawing selection and focus rect. Current VT is derived from TRectangle. Will be good to have it as presented control with appropiate TDataModel. diff --git a/Source/VirtualTrees.FMX.pas b/Source/VirtualTrees.FMX.pas index 0c87123d9..ec6cc2563 100644 --- a/Source/VirtualTrees.FMX.pas +++ b/Source/VirtualTrees.FMX.pas @@ -208,9 +208,9 @@ TTextMetric = record procedure CopyMemory(Destination: Pointer; Source: Pointer; Length: NativeUInt); -procedure DrawTextW(ACanvas: TCanvas; CaptionText: String; Len: Integer; Bounds: TRectF; DrawFormat: Cardinal{this is windows format - must be converted to FMX}); -procedure GetTextExtentPoint32W(ACanvas: TCanvas; CaptionText: String; Len: Integer; Var Size: TSizeF); -{--}procedure DrawEdge(TargetCanvas: TCanvas; PaintRectangle: TRectF; PressedButtonStyle, PressedButtonFlags: Cardinal); +procedure DrawTextW(ACanvas: TCanvas; CaptionText: String; Len: Integer; Bounds: TRect; DrawFormat: Cardinal{this is windows format - must be converted to FMX}); +procedure GetTextExtentPoint32W(ACanvas: TCanvas; CaptionText: String; Len: Integer; Var Size: TSize); +procedure DrawEdge(Canvas: TCanvas; R: TRect; edge, grfFlags: Cardinal); type THighQualityBitmap = class(TBitmap) @@ -223,7 +223,7 @@ implementation //---------------------------------------------------------------------------------------------------------------------- -procedure DrawTextW(ACanvas: TCanvas; CaptionText: String; Len: Integer; Bounds: TRectF; DrawFormat: Cardinal{this is windows format - must be converted to FMX}); +procedure DrawTextW(ACanvas: TCanvas; CaptionText: String; Len: Integer; Bounds: TRect; DrawFormat: Cardinal{this is windows format - must be converted to FMX}); begin //TTextLayout. render //DrawFormat: Cardinal{this is windows format - must be converted to FMX} @@ -232,18 +232,140 @@ procedure DrawTextW(ACanvas: TCanvas; CaptionText: String; Len: Integer; Bounds: //---------------------------------------------------------------------------------------------------------------------- -procedure DrawEdge(TargetCanvas: TCanvas; PaintRectangle: TRectF; PressedButtonStyle, PressedButtonFlags: Cardinal); +procedure DrawEdge(Canvas: TCanvas; R: TRect; edge, grfFlags: Cardinal); +Var tmpR: TRect; begin - //TODO: DrawEdge - //NormalButtonStyle - //RaisedButtonStyle - //RaisedButtonFlags or RightBorderFlag - //NormalButtonFlags or RightBorderFlag + if grfFlags and BF_MIDDLE<>0 then + begin + Canvas.Fill.Color:= clBtnFace;//clBtnFace; + Canvas.FillRect(R, 0, 0, [], 1.0); + end; + tmpR:= R; + if grfFlags and BF_LEFT<>0 then + begin + tmpR:= R; + if edge and BDR_RAISEDINNER<>0 then + begin + Canvas.Stroke.Color:= TAlphaColorRec.White; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Left, tmpR.Bottom), 1.0); + Inc(tmpR.left); + end; + + if edge and BDR_SUNKENINNER<>0 then + begin + Canvas.Stroke.Color:= $FF696969; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Left, tmpR.Bottom), 1.0); + end; + + if edge and BDR_RAISEDOUTER<>0 then + begin + Canvas.Stroke.Color:= $FFE3E3E3; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Left, tmpR.Bottom), 1.0); + Inc(tmpR.left); + end; + + if edge and BDR_SUNKENOUTER<>0 then + begin + Canvas.Stroke.Color:= $FFA0A0A0; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Left, tmpR.Bottom), 1.0); + end; + end; + + if grfFlags and BF_TOP<>0 then + begin + tmpR:= R; + if edge and BDR_RAISEDINNER<>0 then + begin + Canvas.Stroke.Color:= TAlphaColorRec.White; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Right, tmpR.Top), 1.0); + Inc(tmpR.Top); + end; + + if edge and BDR_SUNKENINNER<>0 then + begin + Canvas.Stroke.Color:= $FF696969; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Right, tmpR.Top), 1.0); + end; + + if edge and BDR_RAISEDOUTER<>0 then + begin + Canvas.Stroke.Color:= $FFE3E3E3; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Right, tmpR.Top), 1.0); + Inc(tmpR.Top); + end; + + if edge and BDR_SUNKENOUTER<>0 then + begin + Canvas.Stroke.Color:= $FFA0A0A0; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Right, tmpR.Top), 1.0); + end; + end; + + if grfFlags and BF_RIGHT<>0 then + begin + tmpR:= R; + if edge and BDR_RAISEDOUTER<>0 then + begin + Canvas.Stroke.Color:= $FF696969; + Canvas.DrawLine(Point(tmpR.Right-1, tmpR.Top), Point(tmpR.Right-1, tmpR.Bottom), 1.0); + Dec(tmpR.Right); + end; + + if edge and BDR_SUNKENOUTER<>0 then + begin + Canvas.Stroke.Color:= TAlphaColorRec.White; + Canvas.DrawLine(Point(tmpR.Right-1, tmpR.Top), Point(tmpR.Right-1, tmpR.Bottom), 1.0); + end; + + Dec(tmpR.Right); + + if edge and BDR_RAISEDINNER<>0 then + begin + Canvas.Stroke.Color:= $FFA0A0A0; + Canvas.DrawLine(Point(tmpR.Right, tmpR.Top), Point(tmpR.Right, tmpR.Bottom), 1.0); + end; + + if edge and BDR_SUNKENINNER<>0 then + begin + Canvas.Stroke.Color:= $FFE3E3E3; + Canvas.DrawLine(Point(tmpR.Right, tmpR.Top), Point(tmpR.Right, tmpR.Bottom), 1.0); + end; + end; + + if grfFlags and BF_BOTTOM<>0 then + begin + tmpR:= R; + Dec(tmpR.Bottom); + if edge and BDR_RAISEDOUTER<>0 then + begin + Canvas.Stroke.Color:= $FF696969; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Bottom), Point(tmpR.Right, tmpR.Bottom), 1.0); + Dec(tmpR.Bottom); + end; + + if edge and BDR_SUNKENOUTER<>0 then + begin + Canvas.Stroke.Color:= TAlphaColorRec.White; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Bottom), Point(tmpR.Right, tmpR.Bottom), 1.0); + end; + + if edge and BDR_RAISEDINNER<>0 then + begin + Canvas.Stroke.Color:= $FFA0A0A0; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Bottom), Point(tmpR.Right, tmpR.Bottom), 1.0); + end; + + if edge and BDR_SUNKENINNER<>0 then + begin + Canvas.Stroke.Color:= $FFE3E3E3; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Bottom), Point(tmpR.Right, tmpR.Bottom), 1.0); + end; + end; end; //---------------------------------------------------------------------------------------------------------------------- -procedure GetTextExtentPoint32W(ACanvas: TCanvas; CaptionText: String; Len: Integer; Var Size: TSizeF); +procedure GetTextExtentPoint32W(ACanvas: TCanvas; CaptionText: String; Len: Integer; Var Size: TSize); begin Size.cx:= ACanvas.TextWidth(Copy(CaptionText, 1, Len)); Size.cy:= ACanvas.TextHeight(Copy(CaptionText, 1, Len)); diff --git a/Source/VirtualTrees.pas b/Source/VirtualTrees.pas index 3b8eedda7..57cf80ebb 100644 --- a/Source/VirtualTrees.pas +++ b/Source/VirtualTrees.pas @@ -2556,6 +2556,7 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF procedure SetFont(const Value: TFont); function GetClientHeight: Single; function GetClientWidth: Single; + function GetClientRect: TRect; {$ENDIF} protected @@ -3314,7 +3315,8 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF property VisiblePath[Node: PVirtualNode]: Boolean read GetVisiblePath write SetVisiblePath; property UpdateCount: Cardinal read FUpdateCount; property DoubleBuffered: Boolean read GetDoubleBuffered write SetDoubleBuffered default True; -{$IFDEF VT_FMX} +{$IFDEF VT_FMX} + property ClientRect: TRect read GetClientRect; property ClientWidth: Single read GetClientWidth; property ClientHeight: Single read GetClientHeight; property UseRightToLeftAlignment: Boolean read FUseRightToLeftAlignment write FUseRightToLeftAlignment default false; @@ -9146,10 +9148,12 @@ procedure TVirtualTreeColumns.PaintHeader(ACanvas: TCanvas; R: TRect; HOffset: T begin // Adjust size of the header bitmap +{$IFDEF VT_VCL} with TWithSafeRect(FHeader.Treeview.FHeaderRect) do begin - FHeaderBitmap.SetSize({$IFDEF VT_FMX}Round{$ENDIF}(Max(Right, R.Right - R.Left)), {$IFDEF VT_FMX}Round{$ENDIF}(Bottom)); //TODO: round added!!! + FHeaderBitmap.SetSize(Max(Right, R.Right - R.Left), Bottom); end; +{$ENDIF} VisibleFixedWidth := GetVisibleFixedWidth; @@ -9163,7 +9167,7 @@ procedure TVirtualTreeColumns.PaintHeader(ACanvas: TCanvas; R: TRect; HOffset: T PaintFixedArea; // Paint the floating part of the header. - PaintHeader(FHeaderBitmap.Canvas, + PaintHeader({$IFDEF VT_FMX}ACanvas{$ELSE}FHeaderBitmap.Canvas{$ENDIF}, Rect(VisibleFixedWidth - HOffset, 0, R.Right + VisibleFixedWidth - HOffset, R.Bottom - R.Top), Point(R.Left + VisibleFixedWidth, R.Top), RTLOffset); @@ -9172,14 +9176,17 @@ procedure TVirtualTreeColumns.PaintHeader(ACanvas: TCanvas; R: TRect; HOffset: T PaintFixedArea; // Blit the result to target. + with TWithSafeRect(R) do {$IFDEF VT_FMX} - ACanvas.DrawBitmap( + {ACanvas.DrawBitmap( FHeaderBitmap , Rect(Left, Top, Right - Left, Bottom - Top) , Rect(Left, Top, Left+FHeaderBitmap.Width, Top+FHeaderBitmap.Height) , 1.0 - , false); + , false)} + ; + {$ELSE} BitBlt(ACanvas.Handle, Left, Top, Right - Left, Bottom - Top, FHeaderBitmap.Canvas.Handle, Left, Top, SRCCOPY); {$ENDIF} @@ -13564,6 +13571,15 @@ function TBaseVirtualTree.GetClientWidth: Single; begin Result:= Width; end; + +function TBaseVirtualTree.GetClientRect: TRect; +begin + Result:= ClipRect; + if hoVisible in FHeader.FOptions then + Result.Top:= Result.Top + FHeader.Height; + if Result.Top>Result.Bottom then + Result.Top:= Result.Bottom; +end; {$ENDIF} //---------------------------------------------------------------------------------------------------------------------- @@ -24804,6 +24820,12 @@ procedure TBaseVirtualTree.Paint; RTLOffset := ComputeRTLOffset(True) else RTLOffset := 0; +{$IFDEF VT_FMX} + if hoVisible in FHeader.FOptions then + begin + FHeader.FColumns.PaintHeader(Canvas, FHeaderRect, -FEffectiveOffsetX); + end;//if header visible +{$ENDIF} // The update rect has already been filled in WMPaint, as it is the window's update rect, which gets // reset when BeginPaint is called (in the ancestor). @@ -24816,7 +24838,7 @@ procedure TBaseVirtualTree.Paint; Temp := Header.Columns.GetVisibleFixedWidth; if Temp = 0 then begin - Window := {$IFDEF VT_FMX}ClipRect{$ELSE}FUpdateRect{$ENDIF}; + Window := {$IFDEF VT_FMX}ClientRect{$ELSE}FUpdateRect{$ENDIF}; Target := Window.TopLeft; // The clipping rectangle is given in client coordinates of the window. We have to convert it into @@ -24835,7 +24857,7 @@ procedure TBaseVirtualTree.Paint; PaintTree(Canvas, Window, Target, Options); // Second part, other columns - Window := {$IFDEF VT_FMX}ClipRect{$ELSE}GetClientRect{$ENDIF}; + Window := GetClientRect; if Temp > Window.Right then Exit; From 0787e1ac1d805198ef37027b10ecc38a25ed1bc8 Mon Sep 17 00:00:00 2001 From: livius2 Date: Fri, 9 Nov 2018 23:53:09 +0100 Subject: [PATCH 21/61] Fix Vertical lines across cells Fix Vertical lines across cells. Previously not painted at all now painted ok --- Source/VirtualTrees.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Source/VirtualTrees.pas b/Source/VirtualTrees.pas index 57cf80ebb..1daadefb9 100644 --- a/Source/VirtualTrees.pas +++ b/Source/VirtualTrees.pas @@ -31911,7 +31911,7 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe begin // These variables and the nested if conditions shall make the logic // easier to understand. - CellIsTouchingClientRight := PaintInfo.CellRect.Right = {$IFDEF VT_FMX}ClipRect{$ELSE}ClientRect{$ENDIF}.Right; + CellIsTouchingClientRight := PaintInfo.CellRect.Right = ClientRect.Right; CellIsInLastColumn := Position = TColumnPosition(Count - 1); ColumnIsFixed := coFixed in FHeader.FColumns[Column].Options; From d47d2fa21e5949b81f55ff1a7bd1eac2afde4809 Mon Sep 17 00:00:00 2001 From: livius2 Date: Sat, 10 Nov 2018 19:51:29 +0100 Subject: [PATCH 22/61] Full DrawEdge implementation added Full DrawEdge implementation only Diagonal is not supported but not used in VT --- Source/VirtualTrees.FMX.pas | 399 +++++++++++++++++++++++++++++++----- 1 file changed, 352 insertions(+), 47 deletions(-) diff --git a/Source/VirtualTrees.FMX.pas b/Source/VirtualTrees.FMX.pas index ec6cc2563..20060ccc3 100644 --- a/Source/VirtualTrees.FMX.pas +++ b/Source/VirtualTrees.FMX.pas @@ -2,6 +2,14 @@ {$SCOPEDENUMS ON} +{***********************************************************} +{ Project : VirtualTrees } +{ } +{ author : Karol Bieniaszewski } +{ year : 2018 } +{ } +{***********************************************************} + interface uses System.UITypes, System.Types, System.ImageList, FMX.ImgList, FMX.Graphics; @@ -234,71 +242,230 @@ procedure DrawTextW(ACanvas: TCanvas; CaptionText: String; Len: Integer; Bounds: procedure DrawEdge(Canvas: TCanvas; R: TRect; edge, grfFlags: Cardinal); Var tmpR: TRect; + dL, dT, dR, dB: Integer; + IsSoft, IsFlat, IsMono: Boolean; begin + dL:= 0; + dT:= 0; + dR:= 0; + dB:= 0; + + if grfFlags and BF_SOFT<>0 then + IsSoft:= true else + IsSoft:= false; + + if grfFlags and BF_FLAT<>0 then + IsFlat:= true else + IsFlat:= false; + + if grfFlags and BF_MONO<>0 then + IsMono:= true else + IsMono:= false; + if grfFlags and BF_MIDDLE<>0 then begin - Canvas.Fill.Color:= clBtnFace;//clBtnFace; + Canvas.Fill.Color:= clBtnFace; Canvas.FillRect(R, 0, 0, [], 1.0); end; tmpR:= R; if grfFlags and BF_LEFT<>0 then begin tmpR:= R; - if edge and BDR_RAISEDINNER<>0 then + + if edge and BDR_RAISEDOUTER<>0 then begin - Canvas.Stroke.Color:= TAlphaColorRec.White; - Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Left, tmpR.Bottom), 1.0); - Inc(tmpR.left); + if isSoft then + begin + Canvas.Stroke.Color:= TColors.White; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Left, tmpR.Bottom), 1.0); + end else + if IsFlat then + begin + Canvas.Stroke.Color:= $FFA0A0A0; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Left, tmpR.Bottom), 1.0); + end else + if isMono then + begin + Canvas.Stroke.Color:= $FF646464; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Left, tmpR.Bottom), 1.0); + end else + begin + Canvas.Stroke.Color:= $FFE3E3E3; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Left, tmpR.Bottom), 1.0); + end; + InflateRect(tmpR, -1, -1) end; - if edge and BDR_SUNKENINNER<>0 then + if edge and BDR_SUNKENOUTER<>0 then begin - Canvas.Stroke.Color:= $FF696969; - Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Left, tmpR.Bottom), 1.0); + if isSoft then + begin + Canvas.Stroke.Color:= $FF696969; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Left, tmpR.Bottom), 1.0); + end else + if IsFlat then + begin + Canvas.Stroke.Color:= $FFA0A0A0; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Left, tmpR.Bottom), 1.0); + end else + if isMono then + begin + Canvas.Stroke.Color:= $FF646464; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Left, tmpR.Bottom), 1.0); + end else + begin + Canvas.Stroke.Color:= $FFA0A0A0; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Left, tmpR.Bottom), 1.0); + end; + InflateRect(tmpR, -1, -1) end; - if edge and BDR_RAISEDOUTER<>0 then + if edge and BDR_RAISEDINNER<>0 then begin - Canvas.Stroke.Color:= $FFE3E3E3; - Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Left, tmpR.Bottom), 1.0); - Inc(tmpR.left); + if isSoft then + begin + Canvas.Stroke.Color:= $FFE3E3E3; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Left, tmpR.Bottom), 1.0); + end else + if IsFlat then + begin + Canvas.Stroke.Color:= $FFF0F0F0; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Left, tmpR.Bottom), 1.0); + end else + if isMono then + begin + Canvas.Stroke.Color:= TAlphaColorRec.White; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Left, tmpR.Bottom), 1.0); + end else + begin + Canvas.Stroke.Color:= TAlphaColorRec.White; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Left, tmpR.Bottom), 1.0); + end; end; - if edge and BDR_SUNKENOUTER<>0 then + if edge and BDR_SUNKENINNER<>0 then begin - Canvas.Stroke.Color:= $FFA0A0A0; - Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Left, tmpR.Bottom), 1.0); + if isSoft then + begin + Canvas.Stroke.Color:= $FFA0A0A0; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Left, tmpR.Bottom), 1.0); + end else + if IsFlat then + begin + Canvas.Stroke.Color:= $FFF0F0F0; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Left, tmpR.Bottom), 1.0); + end else + if isMono then + begin + Canvas.Stroke.Color:= TAlphaColorRec.White; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Left, tmpR.Bottom), 1.0); + end else + begin + Canvas.Stroke.Color:= $FF696969; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Left, tmpR.Bottom), 1.0); + end; end; end; if grfFlags and BF_TOP<>0 then begin tmpR:= R; - if edge and BDR_RAISEDINNER<>0 then + + if edge and BDR_RAISEDOUTER<>0 then begin - Canvas.Stroke.Color:= TAlphaColorRec.White; - Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Right, tmpR.Top), 1.0); - Inc(tmpR.Top); + if isSoft then + begin + Canvas.Stroke.Color:= TAlphaColorRec.White; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Right, tmpR.Top), 1.0); + end else + if IsFlat then + begin + Canvas.Stroke.Color:= $FFA0A0A0; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Right, tmpR.Top), 1.0); + end else + if isMono then + begin + Canvas.Stroke.Color:= $FF646464; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Right, tmpR.Top), 1.0); + end else + begin + Canvas.Stroke.Color:= $FFE3E3E3; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Right, tmpR.Top), 1.0); + end; + InflateRect(tmpR, -1, -1) end; - if edge and BDR_SUNKENINNER<>0 then + if edge and BDR_SUNKENOUTER<>0 then begin - Canvas.Stroke.Color:= $FF696969; - Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Right, tmpR.Top), 1.0); + if isSoft then + begin + Canvas.Stroke.Color:= $FF696969; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Right, tmpR.Top), 1.0); + end else + if IsFlat then + begin + Canvas.Stroke.Color:= $FFA0A0A0; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Right, tmpR.Top), 1.0); + end else + if isMono then + begin + Canvas.Stroke.Color:= $FF646464; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Right, tmpR.Top), 1.0); + end else + begin + Canvas.Stroke.Color:= $FFA0A0A0; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Right, tmpR.Top), 1.0); + end; + InflateRect(tmpR, -1, -1) end; - if edge and BDR_RAISEDOUTER<>0 then + if edge and BDR_RAISEDINNER<>0 then begin - Canvas.Stroke.Color:= $FFE3E3E3; - Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Right, tmpR.Top), 1.0); - Inc(tmpR.Top); + if isSoft then + begin + Canvas.Stroke.Color:= $FFE3E3E3; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Right, tmpR.Top), 1.0); + end else + if IsFlat then + begin + Canvas.Stroke.Color:= $FFF0F0F0; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Right, tmpR.Top), 1.0); + end else + if isMono then + begin + Canvas.Stroke.Color:= TAlphaColorRec.White; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Right, tmpR.Top), 1.0); + end else + begin + Canvas.Stroke.Color:= TAlphaColorRec.White; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Right, tmpR.Top), 1.0); + end; end; - if edge and BDR_SUNKENOUTER<>0 then + if edge and BDR_SUNKENINNER<>0 then begin - Canvas.Stroke.Color:= $FFA0A0A0; - Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Right, tmpR.Top), 1.0); + if isSoft then + begin + Canvas.Stroke.Color:= $FFA0A0A0; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Right, tmpR.Top), 1.0); + end else + if IsFlat then + begin + Canvas.Stroke.Color:= $FFF0F0F0; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Right, tmpR.Top), 1.0); + end else + if isMono then + begin + Canvas.Stroke.Color:= TAlphaColorRec.White; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Right, tmpR.Top), 1.0); + end else + begin + Canvas.Stroke.Color:= $FF696969; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Right, tmpR.Top), 1.0); + end; end; + + end; if grfFlags and BF_RIGHT<>0 then @@ -306,29 +473,98 @@ procedure DrawEdge(Canvas: TCanvas; R: TRect; edge, grfFlags: Cardinal); tmpR:= R; if edge and BDR_RAISEDOUTER<>0 then begin - Canvas.Stroke.Color:= $FF696969; - Canvas.DrawLine(Point(tmpR.Right-1, tmpR.Top), Point(tmpR.Right-1, tmpR.Bottom), 1.0); - Dec(tmpR.Right); + if isSoft then + begin + Canvas.Stroke.Color:= $FF696969; + Canvas.DrawLine(Point(tmpR.Right-1, tmpR.Top), Point(tmpR.Right-1, tmpR.Bottom), 1.0); + end else + if IsFlat then + begin + Canvas.Stroke.Color:= $FFA0A0A0; + Canvas.DrawLine(Point(tmpR.Right-1, tmpR.Top), Point(tmpR.Right-1, tmpR.Bottom), 1.0); + end else + if isMono then + begin + Canvas.Stroke.Color:= $FF646464; + Canvas.DrawLine(Point(tmpR.Right-1, tmpR.Top), Point(tmpR.Right-1, tmpR.Bottom), 1.0); + end else + begin + Canvas.Stroke.Color:= $FF696969; + Canvas.DrawLine(Point(tmpR.Right-1, tmpR.Top), Point(tmpR.Right-1, tmpR.Bottom), 1.0); + end; + InflateRect(tmpR, -1, -1) end; if edge and BDR_SUNKENOUTER<>0 then begin - Canvas.Stroke.Color:= TAlphaColorRec.White; - Canvas.DrawLine(Point(tmpR.Right-1, tmpR.Top), Point(tmpR.Right-1, tmpR.Bottom), 1.0); + if isSoft then + begin + Canvas.Stroke.Color:= TAlphaColorRec.White; + Canvas.DrawLine(Point(tmpR.Right-1, tmpR.Top), Point(tmpR.Right-1, tmpR.Bottom), 1.0); + end else + if IsFlat then + begin + Canvas.Stroke.Color:= $FFA0A0A0; + Canvas.DrawLine(Point(tmpR.Right-1, tmpR.Top), Point(tmpR.Right-1, tmpR.Bottom), 1.0); + end else + if isMono then + begin + Canvas.Stroke.Color:= $FF646464; + Canvas.DrawLine(Point(tmpR.Right-1, tmpR.Top), Point(tmpR.Right-1, tmpR.Bottom), 1.0); + end else + begin + Canvas.Stroke.Color:= TAlphaColorRec.White; + Canvas.DrawLine(Point(tmpR.Right-1, tmpR.Top), Point(tmpR.Right-1, tmpR.Bottom), 1.0); + end; + InflateRect(tmpR, -1, -1) end; Dec(tmpR.Right); if edge and BDR_RAISEDINNER<>0 then begin - Canvas.Stroke.Color:= $FFA0A0A0; - Canvas.DrawLine(Point(tmpR.Right, tmpR.Top), Point(tmpR.Right, tmpR.Bottom), 1.0); + if isSoft then + begin + Canvas.Stroke.Color:= $FFA0A0A0; + Canvas.DrawLine(Point(tmpR.Right, tmpR.Top), Point(tmpR.Right, tmpR.Bottom), 1.0); + end else + if IsFlat then + begin + Canvas.Stroke.Color:= $FFF0F0F0; + Canvas.DrawLine(Point(tmpR.Right, tmpR.Top), Point(tmpR.Right, tmpR.Bottom), 1.0); + end else + if isMono then + begin + Canvas.Stroke.Color:= TAlphaColorRec.White; + Canvas.DrawLine(Point(tmpR.Right, tmpR.Top), Point(tmpR.Right, tmpR.Bottom), 1.0); + end else + begin + Canvas.Stroke.Color:= $FFA0A0A0; + Canvas.DrawLine(Point(tmpR.Right, tmpR.Top), Point(tmpR.Right, tmpR.Bottom), 1.0); + end; end; if edge and BDR_SUNKENINNER<>0 then begin - Canvas.Stroke.Color:= $FFE3E3E3; - Canvas.DrawLine(Point(tmpR.Right, tmpR.Top), Point(tmpR.Right, tmpR.Bottom), 1.0); + if isSoft then + begin + Canvas.Stroke.Color:= $FFE3E3E3; + Canvas.DrawLine(Point(tmpR.Right, tmpR.Top), Point(tmpR.Right, tmpR.Bottom), 1.0); + end else + if IsFlat then + begin + Canvas.Stroke.Color:= $FFE3E3E3; + Canvas.DrawLine(Point(tmpR.Right, tmpR.Top), Point(tmpR.Right, tmpR.Bottom), 1.0); + end else + if isMono then + begin + Canvas.Stroke.Color:= TAlphaColorRec.White; + Canvas.DrawLine(Point(tmpR.Right, tmpR.Top), Point(tmpR.Right, tmpR.Bottom), 1.0); + end else + begin + Canvas.Stroke.Color:= $FFE3E3E3; + Canvas.DrawLine(Point(tmpR.Right, tmpR.Top), Point(tmpR.Right, tmpR.Bottom), 1.0); + end; end; end; @@ -338,27 +574,96 @@ procedure DrawEdge(Canvas: TCanvas; R: TRect; edge, grfFlags: Cardinal); Dec(tmpR.Bottom); if edge and BDR_RAISEDOUTER<>0 then begin - Canvas.Stroke.Color:= $FF696969; - Canvas.DrawLine(Point(tmpR.Left, tmpR.Bottom), Point(tmpR.Right, tmpR.Bottom), 1.0); - Dec(tmpR.Bottom); + if isSoft then + begin + Canvas.Stroke.Color:= $FF696969; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Bottom), Point(tmpR.Right, tmpR.Bottom), 1.0); + end else + if IsFlat then + begin + Canvas.Stroke.Color:= $FFA0A0A0; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Bottom), Point(tmpR.Right, tmpR.Bottom), 1.0); + end else + if isMono then + begin + Canvas.Stroke.Color:= $FF646464; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Bottom), Point(tmpR.Right, tmpR.Bottom), 1.0); + end else + begin + Canvas.Stroke.Color:= $FF696969; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Bottom), Point(tmpR.Right, tmpR.Bottom), 1.0); + end; + InflateRect(tmpR, -1, -1) end; if edge and BDR_SUNKENOUTER<>0 then begin - Canvas.Stroke.Color:= TAlphaColorRec.White; - Canvas.DrawLine(Point(tmpR.Left, tmpR.Bottom), Point(tmpR.Right, tmpR.Bottom), 1.0); + if isSoft then + begin + Canvas.Stroke.Color:= TAlphaColorRec.White; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Bottom), Point(tmpR.Right, tmpR.Bottom), 1.0); + end else + if IsFlat then + begin + Canvas.Stroke.Color:= $FFA0A0A0; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Bottom), Point(tmpR.Right, tmpR.Bottom), 1.0); + end else + if isMono then + begin + Canvas.Stroke.Color:= $FF646464; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Bottom), Point(tmpR.Right, tmpR.Bottom), 1.0); + end else + begin + Canvas.Stroke.Color:= TAlphaColorRec.White; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Bottom), Point(tmpR.Right, tmpR.Bottom), 1.0); + end; + InflateRect(tmpR, -1, -1) end; if edge and BDR_RAISEDINNER<>0 then begin - Canvas.Stroke.Color:= $FFA0A0A0; - Canvas.DrawLine(Point(tmpR.Left, tmpR.Bottom), Point(tmpR.Right, tmpR.Bottom), 1.0); + if isSoft then + begin + Canvas.Stroke.Color:= $FFA0A0A0; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Bottom), Point(tmpR.Right, tmpR.Bottom), 1.0); + end else + if IsFlat then + begin + Canvas.Stroke.Color:= $FFF0F0F0; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Bottom), Point(tmpR.Right, tmpR.Bottom), 1.0); + end else + if isMono then + begin + Canvas.Stroke.Color:= TAlphaColorRec.White; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Bottom), Point(tmpR.Right, tmpR.Bottom), 1.0); + end else + begin + Canvas.Stroke.Color:= $FFA0A0A0; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Bottom), Point(tmpR.Right, tmpR.Bottom), 1.0); + end; end; if edge and BDR_SUNKENINNER<>0 then begin - Canvas.Stroke.Color:= $FFE3E3E3; - Canvas.DrawLine(Point(tmpR.Left, tmpR.Bottom), Point(tmpR.Right, tmpR.Bottom), 1.0); + if isSoft then + begin + Canvas.Stroke.Color:= $FFE3E3E3; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Bottom), Point(tmpR.Right, tmpR.Bottom), 1.0); + end else + if IsFlat then + begin + Canvas.Stroke.Color:= $FFE3E3E3; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Bottom), Point(tmpR.Right, tmpR.Bottom), 1.0); + end else + if isMono then + begin + Canvas.Stroke.Color:= $FFE3E3E3; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Bottom), Point(tmpR.Right, tmpR.Bottom), 1.0); + end else + begin + Canvas.Stroke.Color:= $FFE3E3E3; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Bottom), Point(tmpR.Right, tmpR.Bottom), 1.0); + end; end; end; end; From efd6fca905434a29f35163b0df1b4979783ee69f Mon Sep 17 00:00:00 2001 From: livius2 Date: Mon, 12 Nov 2018 00:46:02 +0100 Subject: [PATCH 23/61] Added expanding and collapsing by mouse click - Added expanding and collapsing by mouse click - focusing node by mouse click is also working but in limited way --- README.md | 3 +- Source/VirtualTrees.FMX.pas | 228 +++++++++++++++++++++++++++- Source/VirtualTrees.pas | 289 +++++++++++++++++++++++++++--------- 3 files changed, 450 insertions(+), 70 deletions(-) diff --git a/README.md b/README.md index 681e2aa89..0fcd5c9c6 100644 --- a/README.md +++ b/README.md @@ -9,9 +9,10 @@ What is working: 6. it support cliping during cell draw; 7. it support multiple columns; 8. it draw header columns. +9. expanding, colapsing by mouse click. What is not working yet: -1. any mouse action like click, drag-drop; +1. some mouse action like click, drag-drop, mouse move, hover; 2. clipboard; 3. drawing and supoport of tree border; 4. drawing background; diff --git a/Source/VirtualTrees.FMX.pas b/Source/VirtualTrees.FMX.pas index 20060ccc3..be30f7d14 100644 --- a/Source/VirtualTrees.FMX.pas +++ b/Source/VirtualTrees.FMX.pas @@ -11,7 +11,7 @@ {***********************************************************} interface -uses System.UITypes, System.Types, System.ImageList, FMX.ImgList, FMX.Graphics; +uses System.Classes, System.UITypes, System.Types, System.ImageList, FMX.ImgList, FMX.Graphics; const clBtnFace = TAlphaColor($FFF0F0F0); //TAlphaColorRec.Gray; @@ -179,7 +179,178 @@ TChangeLink = class(TImageLink) constructor Create; override; property Sender: TCustomImageList read GetSender write SetSender; end; - + + INT_PTR = Integer; //do not change on Int64 //System.IntPtr; // NativeInt; + {$EXTERNALSYM INT_PTR} + UINT_PTR = Cardinal; //do not change on Int64 //System.UIntPtr; // NativeUInt; + + WPARAM = UINT_PTR; + {$EXTERNALSYM WPARAM} + LPARAM = INT_PTR; + {$EXTERNALSYM LPARAM} + LRESULT = INT_PTR; + {$EXTERNALSYM LRESULT} + + TDWordFiller = record + {$IFDEF CPUX64} + Filler: array[1..4] of Byte; // Pad DWORD to make it 8 bytes (4+4) [x64 only] + {$ENDIF} + end; + +const + WM_MOUSEFIRST = $0200; + WM_MOUSEMOVE = $0200; + WM_LBUTTONDOWN = $0201; + WM_LBUTTONUP = $0202; + WM_LBUTTONDBLCLK = $0203; + WM_RBUTTONDOWN = $0204; + WM_RBUTTONUP = $0205; + WM_RBUTTONDBLCLK = $0206; + WM_MBUTTONDOWN = $0207; + WM_MBUTTONUP = $0208; + WM_MBUTTONDBLCLK = $0209; + WM_MOUSEWHEEL = $020A; + WM_SIZE = $0005; + WM_NCMBUTTONDOWN = $00A7; + WM_NCMBUTTONUP = $00A8; + WM_NCMBUTTONDBLCLK = $00A9; + WM_NCLBUTTONDBLCLK = $00A3; + WM_NCRBUTTONDOWN = $00A4; + WM_NCRBUTTONUP = $00A5; + WM_NCRBUTTONDBLCLK = $00A6; + WM_NCLBUTTONDOWN = $00A1; + WM_NCLBUTTONUP = $00A2; + WM_NCMOUSEMOVE = $00A0; + WM_KEYDOWN = $0100; + WM_KEYUP = $0101; + WM_SETFOCUS = $0007; + WM_KILLFOCUS = $0008; + WM_SETCURSOR = $0020; + + CM_BASE = $B000; +{$IF DEFINED(CLR)} + CM_CLROFFSET = $100; +{$ELSE} + CM_CLROFFSET = $0; // Only applicable in CLR +{$ENDIF} + CM_ACTIVATE = CM_BASE + 0; + CM_DEACTIVATE = CM_BASE + 1; + CM_GOTFOCUS = CM_BASE + 2; + CM_LOSTFOCUS = CM_BASE + 3; + CM_CANCELMODE = CM_BASE + CM_CLROFFSET + 4; + CM_DIALOGKEY = CM_BASE + 5; + CM_DIALOGCHAR = CM_BASE + 6; +{$IF NOT DEFINED(CLR)} + CM_FOCUSCHANGED = CM_BASE + 7; +{$ENDIF} + CM_PARENTFONTCHANGED = CM_BASE + CM_CLROFFSET + 8; + CM_PARENTCOLORCHANGED = CM_BASE + 9; + CM_BIDIMODECHANGED = CM_BASE + 60; + CM_PARENTBIDIMODECHANGED = CM_BASE + 61; + + VK_ESCAPE = 27; + +type + PMessage = ^TMessage; + TMessage = record + Msg: Cardinal; //4 + tmp: Integer; //4 + case Integer of + 0: ( + WParam: WPARAM; //4 + LParam: LPARAM; //4 + Result: LRESULT //4 + ); //= 12 + 4 = 16 + 1: ( + WParamLo: Word; //2 + WParamHi: Word; //2 + //WParamFiller: TDWordFiller; + LParamLo: Word; //2 + LParamHi: Word; //2 + //LParamFiller: TDWordFiller; + ResultLo: Word; //2 + ResultHi: Word; //2 + //=12 + 8 = 20 + ); + end; + + TWMMouse = record + Msg: Cardinal; //4 + Keys: Longint; //TShiftState; //4 + //KeysFiller: TDWordFiller; + case Integer of + 0: ( + XPos: Single; //4 + YPos: Single; //4 + Result: LRESULT; //4 + ); + 1: ( + Pos: TPoint; //8 + ResultLo: Word; //2 + ResultHi: Word; //2 + ); //=12 + 8=20 + end; + + TWMMouseMove = TWMMouse; + + TWMNCHitTest = record + Msg: Cardinal; + //MsgFiller: TDWordFiller; + Unused: WPARAM; + case Integer of + 0: ( + XPos: Single; + YPos: Single; + //XYPosFiller: TDWordFiller + ); + 1: ( + Pos: TPoint; + //PosFiller: TDWordFiller; + Result: LRESULT); + end; + + TWMNCHitMessage = record + Msg: Cardinal; //4 + //MsgFiller: TDWordFiller; + HitTest: Longint; //4 + //HitTestFiller: TDWordFiller; + XCursor: Single; //4 + YCursor: Single; //4 + //XYCursorFiller: TDWordFiller; + Result: LRESULT; //4 + end; + + TWMNCLButtonDblClk = TWMNCHitMessage; + TWMNCLButtonDown = TWMNCHitMessage; + TWMNCLButtonUp = TWMNCHitMessage; + TWMNCMButtonDblClk = TWMNCHitMessage; + TWMNCMButtonDown = TWMNCHitMessage; + TWMNCMButtonUp = TWMNCHitMessage; + TWMNCMouseMove = TWMNCHitMessage; + TWMNCRButtonDblClk = TWMNCHitMessage; + TWMNCRButtonDown = TWMNCHitMessage; + TWMNCRButtonUp = TWMNCHitMessage; + + TWMLButtonDblClk = TWMMouse; + TWMLButtonDown = TWMMouse; + TWMLButtonUp = TWMMouse; + TWMMButtonDblClk = TWMMouse; + TWMMButtonDown = TWMMouse; + TWMMButtonUp = TWMMouse; + + + TWMKey = record + Msg: Cardinal; //4 + tmp: Integer; //4 + CharCode: Word; //4 + Unused: Word; //2 + KeyData: Longint; //4 + Result: LRESULT; //4 + end; + + TWMKeyDown = TWMKey; + TWMKeyUp = TWMKey; + TTextMetric = record tmHeight: Single; //The height (ascent + descent) of characters. tmAscent: Single; //The ascent (units above the base line) of characters. @@ -226,11 +397,64 @@ THighQualityBitmap = class(TBitmap) constructor Create; override; end; +procedure FillTWMMouse(Var MM: TWMMouse; Button: TMouseButton; Shift: TShiftState; X: Single; Y: Single; IsNC: Boolean); implementation uses FMX.TextLayout, System.SysUtils, FMX.Types; //---------------------------------------------------------------------------------------------------------------------- +procedure FillTWMMouse(Var MM: TWMMouse; Button: TMouseButton; Shift: TShiftState; X: Single; Y: Single; IsNC: Boolean); +begin + MM.Msg:= 0; + if ssDouble in Shift then + begin + if ssLeft in Shift then + begin + if IsNC then + MM.Msg:= WM_NCLBUTTONDBLCLK else + MM.Msg:= WM_LBUTTONDBLCLK; + end else + if ssRight in Shift then + begin + if IsNC then + MM.Msg:= WM_NCRBUTTONDBLCLK else + MM.Msg:= WM_RBUTTONDBLCLK; + end else + if ssMiddle in Shift then + begin + if IsNC then + MM.Msg:= WM_NCMBUTTONDBLCLK else + MM.Msg:= WM_MBUTTONDBLCLK; + end; + end else + begin + if ssLeft in Shift then + begin + if IsNC then + MM.Msg:= WM_NCLBUTTONDOWN else + MM.Msg:= WM_LBUTTONDOWN; + end else + if ssRight in Shift then + begin + if IsNC then + MM.Msg:= WM_NCRBUTTONDOWN else + MM.Msg:= WM_RBUTTONDOWN; + end else + if ssMiddle in Shift then + begin + if IsNC then + MM.Msg:= WM_NCMBUTTONDOWN else + MM.Msg:= WM_MBUTTONDOWN; + end; + end; + + MM.XPos:= X; + MM.YPos:= Y; + MM.Keys:= LongInt(Word(Shift)); +end; + +//---------------------------------------------------------------------------------------------------------------------- + procedure DrawTextW(ACanvas: TCanvas; CaptionText: String; Len: Integer; Bounds: TRect; DrawFormat: Cardinal{this is windows format - must be converted to FMX}); begin //TTextLayout. render diff --git a/Source/VirtualTrees.pas b/Source/VirtualTrees.pas index 1daadefb9..7c83aeb6b 100644 --- a/Source/VirtualTrees.pas +++ b/Source/VirtualTrees.pas @@ -1355,9 +1355,9 @@ TVTHeader = class(TPersistent) function GetOwner: TPersistent; override; {$IFDEF VT_VCL} function GetShiftState: TShiftState; +{$ENDIF} function HandleHeaderMouseMove(var Message: TWMMouseMove): Boolean; function HandleMessage(var Message: TMessage): Boolean; virtual; -{$ENDIF} procedure ImageListChange(Sender: TObject); procedure PrepareDrag(P, Start: TPoint); procedure ReadColumns(Reader: TReader); @@ -2689,9 +2689,9 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF procedure DoHeaderDraw(Canvas: TCanvas; Column: TVirtualTreeColumn; R: TRect; Hover, Pressed: Boolean; DropMark: TVTDropMarkMode); virtual; procedure DoHeaderDrawQueryElements(var PaintInfo: THeaderPaintInfo; var Elements: THeaderPaintElements); virtual; - procedure DoHeaderMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); virtual; - procedure DoHeaderMouseMove(Shift: TShiftState; X, Y: Integer); virtual; - procedure DoHeaderMouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); virtual; + procedure DoHeaderMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); virtual; + procedure DoHeaderMouseMove(Shift: TShiftState; X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); virtual; + procedure DoHeaderMouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); virtual; procedure DoHotChange(Old, New: PVirtualNode); virtual; function DoIncrementalSearch(Node: PVirtualNode; const Text: string): Integer; virtual; function DoInitChildren(Node: PVirtualNode; var ChildCount: Cardinal): Boolean; virtual; @@ -2772,11 +2772,12 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF procedure HandleIncrementalSearch(CharCode: Word); virtual; {$IFDEF VT_FMX} procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Single; Y: Single); override; -{$ELSE} + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Single; Y: Single); override; +{$ENDIF} procedure HandleMouseDblClick(var Message: TWMMouse; const HitInfo: THitInfo); virtual; procedure HandleMouseDown(var Message: TWMMouse; var HitInfo: THitInfo); virtual; procedure HandleMouseUp(var Message: TWMMouse; const HitInfo: THitInfo); virtual; -{$ENDIF} + procedure HandleClickSelection(LastFocused, NewNode: PVirtualNode; Shift: TShiftState; DragPending: Boolean); function HasImage(Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex): Boolean; virtual; deprecated 'Use GetImageSize instead'; function HasPopupMenu(Node: PVirtualNode; Column: TColumnIndex; Pos: TPoint): Boolean; virtual; @@ -8254,7 +8255,9 @@ function TVirtualTreeColumns.HandleClick(P: TPoint; Button: TMouseButton; {$IFDE if (csDesigning in Header.Treeview.ComponentState) then exit; // Convert vertical position to local coordinates. +{$IFDEF VT_VCL} Inc(P.Y, FHeader.FHeight); +{$ENDIF} NewClickIndex := ColumnFromPosition(P); with HitInfo do begin @@ -10581,14 +10584,14 @@ function TVTHeader.GetShiftState: TShiftState; //---------------------------------------------------------------------------------------------------------------------- -{$IFDEF VT_VCL} + function TVTHeader.HandleHeaderMouseMove(var Message: TWMMouseMove): Boolean; var P: TPoint; NextColumn, I: TColumnIndex; - NewWidth: Integer; + NewWidth: TDimension; begin Result := False; @@ -10613,7 +10616,7 @@ function TVTHeader.HandleHeaderMouseMove(var Message: TWMMouseMove): Boolean; else if hsColumnWidthTracking in FStates then begin - if DoColumnWidthTracking(FColumns.FTrackIndex, GetShiftState, FTrackPoint, P) then + if DoColumnWidthTracking(FColumns.FTrackIndex, {$IFDEF VT_FMX}TShiftState(Word(Message.Keys)){$ELSE}GetShiftState{$ENDIF}, FTrackPoint, P) then begin if Treeview.UseRightToLeftAlignment then begin @@ -10625,7 +10628,8 @@ function TVTHeader.HandleHeaderMouseMove(var Message: TWMMouseMove): Boolean; NewWidth := XPos - FTrackPoint.X; NextColumn := FColumns.GetNextVisibleColumn(FColumns.FTrackIndex); end; - + if FColumns.FTrackIndex<0 then + exit; //!!! // The autosized column cannot be resized using the mouse normally. Instead we resize the next // visible column, so it look as we directly resize the autosized column. if (hoAutoResize in FOptions) and (FColumns.FTrackIndex = FAutoSizeIndex) and @@ -10643,8 +10647,8 @@ function TVTHeader.HandleHeaderMouseMove(var Message: TWMMouseMove): Boolean; else if hsHeightTracking in FStates then begin - if DoHeightTracking(P, GetShiftState) then - SetHeight(Integer(FHeight) + P.Y); + if DoHeightTracking(P, {$IFDEF VT_FMX}TShiftState(Word(Message.Keys)){$ELSE}GetShiftState{$ENDIF}) then + SetHeight(FHeight + P.Y); HandleHeaderMouseMove := True; Result := 0; end @@ -10656,8 +10660,8 @@ function TVTHeader.HandleHeaderMouseMove(var Message: TWMMouseMove): Boolean; // start actual dragging if allowed if (hoDrag in FOptions) and Treeview.DoHeaderDragging(FColumns.FDownIndex) then begin - if ((Abs(FDragStart.X - P.X) > Mouse.DragThreshold) or - (Abs(FDragStart.Y - P.Y) > Mouse.DragThreshold)) then + if ((Abs(FDragStart.X - P.X) > {$IFDEF VT_FMX}3{$ELSE}Mouse.DragThreshold{$ENDIF}) or + (Abs(FDragStart.Y - P.Y) > {$IFDEF VT_FMX}3{$ELSE}Mouse.DragThreshold{$ENDIF})) then begin Treeview.StopTimer(HeaderTimer); I := FColumns.FDownIndex; @@ -10699,11 +10703,14 @@ function TVTHeader.HandleMessage(var Message: TMessage): Boolean; I: TColumnIndex; OldPosition: Integer; HitIndex: TColumnIndex; - NewCursor: HCURSOR; + NewCursor: {$IFDEF VT_FMX}TCursor{$ELSE}HCURSOR{$ENDIF}; Button: TMouseButton; IsInHeader, IsHSplitterHit, IsVSplitterHit: Boolean; +{$IFDEF VT_FMX} + cursorService: IFMXCursorService; +{$ENDIF} //--------------- local function -------------------------------------------- @@ -10718,7 +10725,7 @@ function TVTHeader.HandleMessage(var Message: TMessage): Boolean; begin NextCol := FColumns.GetNextVisibleColumn(FColumns.FTrackIndex); if not (coFixed in FColumns[FColumns.FTrackIndex].Options) or (NextCol <= NoColumn) or - (coFixed in FColumns[NextCol].Options) or (P.Y > Integer(Treeview.FRangeY)) then + (coFixed in FColumns[NextCol].Options) or (P.Y > Treeview.FRangeY) then Result := False; end; end; @@ -10755,7 +10762,7 @@ function TVTHeader.HandleMessage(var Message: TMessage): Boolean; with TWMNCMButtonDown(Message) do P := Treeview.ScreenToClient(Point(XCursor, YCursor)); if InHeader(P) then - FOwner.DoHeaderMouseDown(mbMiddle, GetShiftState, P.X, P.Y + Integer(FHeight)); + FOwner.DoHeaderMouseDown(TMOuseButton.mbMiddle, {$IFDEF VT_FMX}TShiftState(Word(TWMMouse(Message).Keys)){$ELSE}GetShiftState{$ENDIF}, P.X, P.Y + FHeight); end; WM_NCMBUTTONUP: begin @@ -10763,8 +10770,8 @@ function TVTHeader.HandleMessage(var Message: TMessage): Boolean; P := FOwner.ScreenToClient(Point(XCursor, YCursor)); if InHeader(P) then begin - FColumns.HandleClick(P, mbMiddle, True, False); - FOwner.DoHeaderMouseUp(mbMiddle, GetShiftState, P.X, P.Y + Integer(FHeight)); + FColumns.HandleClick(P, TmouseButton.mbMiddle, {$IFDEF VT_FMX}TShiftState(Word(TWMMouse(Message).Keys)),{$ENDIF} True, False); + FOwner.DoHeaderMouseUp(TmouseButton.mbMiddle, {$IFDEF VT_FMX}TShiftState(Word(TWMMouse(Message).Keys)){$ELSE}GetShiftState{$ENDIF}, P.X, P.Y + FHeight); FColumns.FDownIndex := NoColumn; FColumns.FCheckBoxHit := False; end; @@ -10783,7 +10790,7 @@ function TVTHeader.HandleMessage(var Message: TMessage): Boolean; if (hoHeightDblClickResize in FOptions) and InHeaderSplitterArea(P) and (FDefaultHeight > 0) then begin - if DoHeightDblClickResize(P, GetShiftState) and (FDefaultHeight > 0) then + if DoHeightDblClickResize(P, {$IFDEF VT_FMX}TShiftState(Word(TWMMouse(Message).Keys)){$ELSE}GetShiftState{$ENDIF}) and (FDefaultHeight > 0) then SetHeight(FMinHeight); Result := True; end @@ -10792,7 +10799,7 @@ function TVTHeader.HandleMessage(var Message: TMessage): Boolean; (hoDblClickResize in FOptions) and (FColumns.FTrackIndex > NoColumn) then begin // If the click was on a splitter then resize column to smallest width. - if DoColumnWidthDblClickResize(FColumns.FTrackIndex, P, GetShiftState) then + if DoColumnWidthDblClickResize(FColumns.FTrackIndex, P, {$IFDEF VT_FMX}TShiftState(Word(TWMMouse(Message).Keys)){$ELSE}GetShiftState{$ENDIF}) then AutoFitColumns(True, smaUseColumnOption, FColumns[FColumns.FTrackIndex].FPosition, FColumns[FColumns.FTrackIndex].FPosition); Message.Result := 0; @@ -10803,16 +10810,16 @@ function TVTHeader.HandleMessage(var Message: TMessage): Boolean; begin case Message.Msg of WM_NCMBUTTONDBLCLK: - Button := mbMiddle; + Button := TMouseButton.mbMiddle; WM_NCRBUTTONDBLCLK: - Button := mbRight; + Button := TMouseButton.mbRight; else // WM_NCLBUTTONDBLCLK - Button := mbLeft; + Button := TMouseButton.mbLeft; end; - if Button = mbLeft then + if Button = TMouseButton.mbLeft then Columns.AdjustDownColumn(P); - FColumns.HandleClick(P, Button, True, True); + FColumns.HandleClick(P, Button, {$IFDEF VT_FMX}TShiftState(Word(TWMMouse(Message).Keys)),{$ENDIF} True, True); end; end; // The "hot" area of the headers horizontal splitter is partly within the client area of the the tree, so we need @@ -10860,17 +10867,20 @@ function TVTHeader.HandleMessage(var Message: TMessage): Boolean; if IsVSplitterHit then begin if not (csDesigning in Treeview.ComponentState) then - DoBeforeHeightTracking(GetShiftState); + DoBeforeHeightTracking({$IFDEF VT_FMX}TShiftState(Word(TWMMouse(Message).Keys)){$ELSE}GetShiftState{$ENDIF}); Include(FStates, hsHeightTrackPending); end else begin if not (csDesigning in Treeview.ComponentState) then - DoBeforeColumnWidthTracking(FColumns.FTrackIndex, GetShiftState); + DoBeforeColumnWidthTracking(FColumns.FTrackIndex, {$IFDEF VT_FMX}TShiftState(Word(TWMMouse(Message).Keys)){$ELSE}GetShiftState{$ENDIF}); Include(FStates, hsColumnWidthTrackPending); end; - +{$IFDEF VT_FMX} + Treeview.SetFocus; +{$ELSE} SetCapture(Treeview.Handle); +{$ENDIF} Result := True; Message.Result := 0; end @@ -10885,7 +10895,11 @@ function TVTHeader.HandleMessage(var Message: TMessage): Boolean; // Show potential drag operation. // Disabled columns do not start a drag operation because they can't be clicked. Include(FStates, hsDragPending); - SetCapture(Treeview.Handle); +{$IFDEF VT_FMX} + Treeview.SetFocus; +{$ELSE} + SetCapture(Treeview.Handle); +{$ENDIF} Result := True; Message.Result := 0; end; @@ -10893,14 +10907,14 @@ function TVTHeader.HandleMessage(var Message: TMessage): Boolean; // This is a good opportunity to notify the application. if not (csDesigning in Treeview.ComponentState) and IsInHeader then - FOwner.DoHeaderMouseDown(mbLeft, GetShiftState, P.X, P.Y + Integer(FHeight)); + FOwner.DoHeaderMouseDown(TMouseButton.mbLeft, {$IFDEF VT_FMX}TShiftState(Word(TWMMouse(Message).Keys)){$ELSE}GetShiftState{$ENDIF}, P.X, P.Y + FHeight); end; WM_NCRBUTTONDOWN: begin with TWMNCRButtonDown(Message) do P := FOwner.ScreenToClient(Point(XCursor, YCursor)); if InHeader(P) then - FOwner.DoHeaderMouseDown(mbRight, GetShiftState, P.X, P.Y + Integer(FHeight)); + FOwner.DoHeaderMouseDown(TMouseButton.mbRight, {$IFDEF VT_FMX}TShiftState(Word(TWMMouse(Message).Keys)){$ELSE}GetShiftState{$ENDIF}, P.X, P.Y + FHeight); end; WM_NCRBUTTONUP: if not (csDesigning in FOwner.ComponentState) then @@ -10910,8 +10924,8 @@ function TVTHeader.HandleMessage(var Message: TMessage): Boolean; P := FOwner.ScreenToClient(Point(XCursor, YCursor)); if InHeader(P) then begin - HandleMessage := FColumns.HandleClick(P, mbRight, True, False); - FOwner.DoHeaderMouseUp(mbRight, GetShiftState, P.X, P.Y + Integer(FHeight)); + HandleMessage := FColumns.HandleClick(P, TMouseButton.mbRight, {$IFDEF VT_FMX}TShiftState(Word(TWMMouse(Message).Keys)),{$ENDIF} True, False); + FOwner.DoHeaderMouseUp(TMouseButton.mbRight, {$IFDEF VT_FMX}TShiftState(Word(TWMMouse(Message).Keys)){$ELSE}GetShiftState{$ENDIF}, P.X, P.Y + FHeight); end; end; // When the tree window has an active mouse capture then we only get "client-area" messages. @@ -10922,16 +10936,24 @@ function TVTHeader.HandleMessage(var Message: TMessage): Boolean; if FStates <> [] then begin +{$IFDEF VT_VCL} ReleaseCapture; +{$ENDIF} if hsDragging in FStates then begin // successfull dragging moves columns with TWMLButtonUp(Message) do P := Treeview.ClientToScreen(Point(XPos, YPos)); +{$IFDEF VT_FMX} + R:= TreeView.BoundsRect; +{$ELSE} GetWindowRect(Treeview.Handle, R); +{$ENDIF} with FColumns do begin +{$IFDEF VT_VCL} FDragImage.EndDrag; +{$ENDIF} //Problem fixed: //Column Header does not paint correctly after a drop in certain conditions @@ -10986,16 +11008,16 @@ function TVTHeader.HandleMessage(var Message: TMessage): Boolean; with TWMLButtonUp(Message) do begin if FColumns.FDownIndex > NoColumn then - FColumns.HandleClick(Point(XPos, YPos), mbLeft, False, False); + FColumns.HandleClick(Point(XPos, YPos), TMouseButton.mbLeft, {$IFDEF VT_FMX}TShiftState(Word(TWMMouse(Message).Keys)), {$ENDIF} False, False); if FStates <> [] then - FOwner.DoHeaderMouseUp(mbLeft, KeysToShiftState(Keys), XPos, YPos); + FOwner.DoHeaderMouseUp(TMouseButton.mbLeft, {$IFDEF VT_FMX}TShiftState(Word(TWMMouse(Message).Keys)){$ELSE}KeysToShiftState(Keys){$ENDIF}, XPos, YPos); end; WM_NCLBUTTONUP: with TWMNCLButtonUp(Message) do begin P := FOwner.ScreenToClient(Point(XCursor, YCursor)); - FColumns.HandleClick(P, mbLeft, False, False); - FOwner.DoHeaderMouseUp(mbLeft, GetShiftState, P.X, P.Y + Integer(FHeight)); + FColumns.HandleClick(P, TMouseButton.mbLeft, {$IFDEF VT_FMX}TShiftState(Word(TWMMouse(Message).Keys)), {$ENDIF} False, False); + FOwner.DoHeaderMouseUp(TMouseButton.mbLeft, {$IFDEF VT_FMX}TShiftState(Word(TWMMouse(Message).Keys)){$ELSE}GetShiftState{$ENDIF}, P.X, P.Y + FHeight); end; end; @@ -11023,24 +11045,29 @@ function TVTHeader.HandleMessage(var Message: TMessage): Boolean; with TWMNCMouseMove(Message), FColumns do begin P := Treeview.ScreenToClient(Point(XCursor, YCursor)); - Treeview.DoHeaderMouseMove(GetShiftState, P.X, P.Y + Integer(FHeight)); + Treeview.DoHeaderMouseMove({$IFDEF VT_FMX}TShiftState(Word(TWMMouse(Message).Keys)){$ELSE}GetShiftState{$ENDIF}, P.X, P.Y + FHeight); if InHeader(P) and ((AdjustHoverColumn(P)) or ((FDownIndex >= 0) and (FHoverIndex <> FDownIndex))) then begin // We need a mouse leave detection from here for the non client area. // TODO: The best solution available would be the TrackMouseEvent API. // With the drop of the support of Win95 totally and WinNT4 we should replace the timer. +{$IFDEF VT_VCL} Treeview.StopTimer(HeaderTimer); SetTimer(Treeview.Handle, HeaderTimer, 50, nil); +{$ENDIF} // use Delphi's internal hint handling for header hints too if hoShowHint in FOptions then begin // client coordinates! XCursor := P.X; - YCursor := P.Y + Integer(FHeight); + YCursor := P.Y + FHeight; +{$IFDEF VT_VCL} Application.HintMouseMessage(Treeview, Message); +{$ENDIF} end; end; end; +{$IFDEF VT_VCL} WM_TIMER: if TWMTimer(Message).TimerID = HeaderTimer then begin @@ -11062,14 +11089,22 @@ function TVTHeader.HandleMessage(var Message: TMessage): Boolean; end; end; end; +{$ENDIF} +{$IFDEF VT_FMX} + WM_MOUSEMOVE,WM_SETCURSOR: // mouse capture and general message redirection + begin + Result := HandleHeaderMouseMove(TWMMouseMove(Message)); +{$ELSE} WM_MOUSEMOVE: // mouse capture and general message redirection Result := HandleHeaderMouseMove(TWMMouseMove(Message)); +//{$IFDEF VT_VCL} WM_SETCURSOR: +{$ENDIF} // Feature: design-time header if (FStates = []) then begin // Retrieve last cursor position (GetMessagePos does not work here, I don't know why). - GetCursorPos(P); + {$IFDEF VT_FMX}P:= TWMMouse(Message).Pos{$ELSE}GetCursorPos(P){$ENDIF}; // Is the mouse in the header rectangle and near the splitters? P := Treeview.ScreenToClient(P); @@ -11082,19 +11117,30 @@ function TVTHeader.HandleMessage(var Message: TMessage): Boolean; if IsVSplitterHit or IsHSplitterHit then begin + cursorService:= TPlatformServices.Current.GetPlatformservice(IFMXCursorService) as IFMXCursorService; + {$IFDEF VT_FMX} + if Assigned(cursorService) then + NewCursor:= cursorService.GetCursor; + {$ELSE} NewCursor := Screen.Cursors[Treeview.Cursor]; + {$ENDIF} if IsVSplitterHit and ((hoHeightResize in FOptions) or (csDesigning in Treeview.ComponentState)) then - NewCursor := Screen.Cursors[crVertSplit] + NewCursor := {$IFDEF VT_FMX}crVSplit{$ELSE}Screen.Cursors[crVertSplit]{$ENDIF} else if IsHSplitterHit then - NewCursor := Screen.Cursors[crHeaderSplit]; + NewCursor := {$IFDEF VT_FMX}crHSplit{$ELSE}Screen.Cursors[crHeaderSplit]{$ENDIF}; if not (csDesigning in Treeview.ComponentState) then Treeview.DoGetHeaderCursor(NewCursor); - Result := NewCursor <> Screen.Cursors[crDefault]; + Result := NewCursor <> {$IFDEF VT_FMX}crDefault{$ELSE}Screen.Cursors[crDefault]{$ENDIF}; if Result then begin +{$IFDEF VT_FMX} + if Assigned(cursorService) then + cursorService.SetCursor(NewCursor); +{$ELSE} Winapi.Windows.SetCursor(NewCursor); +{$ENDIF} Message.Result := 1; end; end; @@ -11104,6 +11150,10 @@ function TVTHeader.HandleMessage(var Message: TMessage): Boolean; Message.Result := 1; Result := True; end; +{$IFDEF VT_FMX} + end; +{$ENDIF} +//{$ENDIF} WM_KEYDOWN, WM_KILLFOCUS: if (Message.Msg = WM_KILLFOCUS) or @@ -11111,8 +11161,10 @@ function TVTHeader.HandleMessage(var Message: TMessage): Boolean; begin if hsDragging in FStates then begin +{$IFDEF VT_VCL} ReleaseCapture; FDragImage.EndDrag; +{$ENDIF} Exclude(FStates, hsDragging); FColumns.FDropTarget := NoColumn; Invalidate(nil); @@ -11123,7 +11175,9 @@ function TVTHeader.HandleMessage(var Message: TMessage): Boolean; begin if [hsColumnWidthTracking, hsHeightTracking] * FStates <> [] then begin +{$IFDEF VT_VCL} ReleaseCapture; +{$ENDIF} if hsColumnWidthTracking in FStates then DoAfterColumnWidthTracking(FColumns.FTrackIndex); if hsHeightTracking in FStates then @@ -11138,7 +11192,7 @@ function TVTHeader.HandleMessage(var Message: TMessage): Boolean; end; end; end; -{$ENDIF} + //---------------------------------------------------------------------------------------------------------------------- procedure TVTHeader.ImageListChange(Sender: TObject); @@ -13564,12 +13618,12 @@ function TBaseVirtualTree.GetChildrenInitialized(Node: PVirtualNode): Boolean; {$IFDEF VT_FMX} function TBaseVirtualTree.GetClientHeight: Single; begin - Result:= Height; + Result:= ClientRect.Height; end; function TBaseVirtualTree.GetClientWidth: Single; begin - Result:= Width; + Result:= ClientRect.Width; end; function TBaseVirtualTree.GetClientRect: TRect; @@ -14585,7 +14639,7 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean); FPlusBM.Canvas.DrawRect(Rect(0, 0, FPlusBM.Width-1, FPlusBM.Height), 0, 0, [], 1.0); FPlusBM.Canvas.Stroke.Color := FColors.NodeFontColor; FPlusBM.Canvas.DrawLine(Point(2, 4.5), Point(FPlusBM.Canvas.Width - 2, 4.5), 1.0); - FPlusBM.Canvas.DrawLine(Point(4.0, 2), Point(4.0, FPlusBM.Canvas.Width - 2), 1.0); + FPlusBM.Canvas.DrawLine(Point(4.5, 2), Point(4.5, FPlusBM.Canvas.Width - 2), 1.0); { FPlusBM.Canvas.DrawLine(Point(2, FPlusBM.Canvas.Width / 2), Point(FPlusBM.Canvas.Width - 2, FPlusBM.Canvas.Width / 2), 1.0); @@ -21186,7 +21240,7 @@ procedure TBaseVirtualTree.DoHeaderDrawQueryElements(var PaintInfo: THeaderPaint //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.DoHeaderMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +procedure TBaseVirtualTree.DoHeaderMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); begin if Assigned(FOnHeaderMouseDown) then @@ -21195,7 +21249,7 @@ procedure TBaseVirtualTree.DoHeaderMouseDown(Button: TMouseButton; Shift: TShift //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.DoHeaderMouseMove(Shift: TShiftState; X, Y: Integer); +procedure TBaseVirtualTree.DoHeaderMouseMove(Shift: TShiftState; X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); begin if Assigned(FOnHeaderMouseMove) then @@ -21204,7 +21258,7 @@ procedure TBaseVirtualTree.DoHeaderMouseMove(Shift: TShiftState; X, Y: Integer); //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.DoHeaderMouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +procedure TBaseVirtualTree.DoHeaderMouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: {$IFDEF VT_FMX}Single{$ELSE}Integer{$ENDIF}); begin if Assigned(FOnHeaderMouseUp) then @@ -23213,13 +23267,61 @@ procedure TBaseVirtualTree.HandleIncrementalSearch(CharCode: Word); //---------------------------------------------------------------------------------------------------------------------- {$IFDEF VT_FMX} procedure TBaseVirtualTree.MouseDown(Button: TMouseButton; Shift: TShiftState; X: Single; Y: Single); +Var MM: TWMMouse; + hInfo: THitInfo; + P: TPoint; + isNC: Boolean; begin - //TODO: MouseDown + P.X:= X; + P.Y:= Y; + if ClientRect.Contains(P) then + begin + isNc:= false; + end else + begin + isNC:= true; + P:= ClientToScreen(P); + end; + FillTWMMouse(MM, Button, Shift, P.X, P.Y, isNC); + if FHeader.HandleMessage(TMessage(MM)) then + exit;//!!! + + FillTWMMouse(MM, Button, Shift, X, Y, isNC); + // get information about the hit + GetHitTestInfoAt(X, Y, True, hInfo); + + HandleMouseDown(MM, hInfo); +end; + +procedure TBaseVirtualTree.MouseUp(Button: TMouseButton; Shift: TShiftState; X: Single; Y: Single); +Var MM: TWMMouse; + hInfo: THitInfo; + P: TPoint; + isNC: Boolean; +begin + P.X:= X; + P.Y:= Y; + if ClientRect.Contains(P) then + begin + isNc:= false; + end else + begin + isNC:= true; + P:= ClientToScreen(P); + end; + FillTWMMouse(MM, Button, Shift, P.X, P.Y, isNC); + if FHeader.HandleMessage(TMessage(MM)) then + exit;//!!! + + FillTWMMouse(MM, Button, Shift, X, Y, isNC); + // get information about the hit + GetHitTestInfoAt(X, Y, True, hInfo); + HandleMouseUp(MM, hInfo); end; {$ENDIF} //---------------------------------------------------------------------------------------------------------------------- -{$IFDEF VT_VCL} +//{$IFDEF VT_VCL} procedure TBaseVirtualTree.HandleMouseDblClick(var Message: TWMMouse; const HitInfo: THitInfo); var @@ -23238,7 +23340,7 @@ procedure TBaseVirtualTree.HandleMouseDblClick(var Message: TWMMouse; const HitI if not (tsEditing in FStates) or DoEndEdit then begin if HitInfo.HitColumn = FHeader.FColumns.FClickIndex then - DoColumnDblClick(HitInfo.HitColumn, KeysToShiftState(Message.Keys)); + DoColumnDblClick(HitInfo.HitColumn, {$IFDEF VT_FMX}TShiftState(Word(Message.Keys)){$ELSE}KeysToShiftState(Message.Keys){$ENDIF}); if HitInfo.HitNode <> nil then DoNodeDblClick(HitInfo); @@ -23256,10 +23358,14 @@ procedure TBaseVirtualTree.HandleMouseDblClick(var Message: TWMMouse; const HitI if Assigned(Node) and (Node <> FRoot) and (toNodeHeightDblClickResize in FOptions.FMiscOptions) then begin - if DoNodeHeightDblClickResize(Node, HitInfo.HitColumn, KeysToShiftState(Message.Keys), Point(Message.XPos, Message.YPos)) then + if DoNodeHeightDblClickResize(Node, HitInfo.HitColumn, {$IFDEF VT_FMX}TShiftState(Word(Message.Keys)){$ELSE}KeysToShiftState(Message.Keys){$ENDIF}, Point(Message.XPos, Message.YPos)) then begin SetNodeHeight(Node, FDefaultNodeHeight); +{$IFDEF VT_FMX} + Repaint; +{$ELSE} UpdateWindow(Handle); +{$ENDIF} MayEdit := False; end; end @@ -23270,7 +23376,7 @@ procedure TBaseVirtualTree.HandleMouseDblClick(var Message: TWMMouse; const HitI begin with HitInfo.HitNode^ do NewCheckState := DetermineNextCheckState(CheckType, CheckState); - if (ssLeft in KeysToShiftState(Message.Keys)) and DoChecking(HitInfo.HitNode, NewCheckState) then + if (ssLeft in {$IFDEF VT_FMX}TShiftState(Word(Message.Keys)){$ELSE}KeysToShiftState(Message.Keys){$ENDIF}) and DoChecking(HitInfo.HitNode, NewCheckState) then begin DoStateChange([tsMouseCheckPending]); FCheckNode := HitInfo.HitNode; @@ -23308,7 +23414,9 @@ procedure TBaseVirtualTree.HandleMouseDblClick(var Message: TWMMouse; const HitI begin DoStateChange([tsEditPending]); FEditColumn := FFocusedColumn; +{$IFDEF VT_VCL} SetTimer(Handle, EditTimer, 0, nil); +{$ENDIF} end; end; @@ -23400,9 +23508,13 @@ procedure TBaseVirtualTree.HandleMouseDown(var Message: TWMMouse; var HitInfo: T end;//if tsEditing // Focus change. Don't use the SetFocus method as this does not work for MDI Winapi.Windows. - if not Focused and CanFocus then + if not {$IFDEF VT_FMX}IsFocused{$ELSE}Focused and CanFocus{$ENDIF} then begin +{$IFDEF VT_FMX} + SetFocus; +{$ELSE} Winapi.Windows.SetFocus(Handle); +{$ENDIF} // Repeat the hit test as an OnExit event might got triggered that could modify the tree. GetHitTestInfoAt(Message.XPos, Message.YPos, True, HitInfo); end; @@ -23436,7 +23548,7 @@ procedure TBaseVirtualTree.HandleMouseDown(var Message: TWMMouse; var HitInfo: T NewNode := FFocusedNode <> HitInfo.HitNode; // Translate keys and filter out shift and control key. - ShiftState := KeysToShiftState(Message.Keys) * [ssShift, ssCtrl, ssAlt]; + ShiftState := {$IFDEF VT_FMX}TShiftState(Word(Message.Keys)){$ELSE}KeysToShiftState(Message.Keys){$ENDIF} * [ssShift, ssCtrl, ssAlt]; if ssAlt in ShiftState then begin AltPressed := True; @@ -23481,10 +23593,10 @@ procedure TBaseVirtualTree.HandleMouseDown(var Message: TWMMouse; var HitInfo: T // Dragging might be started in the inherited handler manually (which is discouraged for stability reasons) // the test for manual mode is done below (after the focused node is set). - AutoDrag := ((DragMode = dmAutomatic) or Dragging) and (not IsCellHit or FullRowDrag); + AutoDrag := ((DragMode = TDragMode.dmAutomatic) or Dragging) and (not IsCellHit or FullRowDrag); // Query the application to learn if dragging may start now (if set to dmManual). - if Assigned(HitInfo.HitNode) and not AutoDrag and (DragMode = dmManual) then + if Assigned(HitInfo.HitNode) and not AutoDrag and (DragMode = TDragMode.dmManual) then AutoDrag := DoBeforeDrag(HitInfo.HitNode, Column) and (FullRowDrag or IsLabelHit); // handle node height tracking @@ -23519,7 +23631,7 @@ procedure TBaseVirtualTree.HandleMouseDown(var Message: TWMMouse; var HitInfo: T begin with HitInfo.HitNode^ do NewCheckState := DetermineNextCheckState(CheckType, CheckState); - if (ssLeft in KeysToShiftState(Message.Keys)) and DoChecking(HitInfo.HitNode, NewCheckState) then + if (ssLeft in {$IFDEF VT_FMX}TShiftState(Word(Message.Keys)){$ELSE}KeysToShiftState(Message.Keys){$ENDIF}) and DoChecking(HitInfo.HitNode, NewCheckState) then begin if Self.SelectedCount > 1 then SetCheckStateForAll(NewCheckState, True) @@ -23558,7 +23670,11 @@ procedure TBaseVirtualTree.HandleMouseDown(var Message: TWMMouse; var HitInfo: T // User starts a selection with a selection rectangle. if not (toDisableDrawSelection in FOptions.FSelectionOptions) and not (IsLabelHit or FullRowDrag) and MultiSelect then begin +{$IFDEF VT_FMX} + SetFocus; +{$ELSE} SetCapture(Handle); +{$ENDIF} DoStateChange([tsDrawSelPending]); FDrawSelShiftState := ShiftState; FNewSelRect := Rect(Message.XPos + FEffectiveOffsetX, Message.YPos - FOffsetY, Message.XPos + FEffectiveOffsetX, @@ -23599,7 +23715,7 @@ procedure TBaseVirtualTree.HandleMouseDown(var Message: TWMMouse; var HitInfo: T end; // pending node edit - if Focused and + if {$IFDEF VT_FMX}IsFocused{$ELSE}Focused{$ENDIF} and ((hiOnItemLabel in HitInfo.HitPositions) or ((toGridExtensions in FOptions.FMiscOptions) and (hiOnItem in HitInfo.HitPositions))) and NodeSelected and not NewColumn and ShiftEmpty and (SelectedCount = 1) then begin @@ -23635,11 +23751,13 @@ procedure TBaseVirtualTree.HandleMouseDown(var Message: TWMMouse; var HitInfo: T invalidateWithAutoSpan(Column, HitInfo.HitNode); //fix: issue 310 FFocusedColumn := Column; end; +{$IFDEF VT_VCL} if DragKind = dkDock then begin StopTimer(ScrollTimer); DoStateChange([], [tsScrollPending, tsScrolling]); end; +{$ENDIF} // Get the currently focused node to make multiple multi-selection blocks possible. LastFocused := FFocusedNode; if NewNode then @@ -23717,7 +23835,7 @@ procedure TBaseVirtualTree.HandleMouseUp(var Message: TWMMouse; const HitInfo: T InvalidateNode(HitInfo.HitNode); end; - DoStateChange([], [tsOLEDragPending, tsOLEDragging, tsClearPending, tsDrawSelPending, tsToggleFocusedSelection, + DoStateChange([], [{$IFDEF VT_VCL}tsOLEDragPending, tsOLEDragging, {$ENDIF}tsClearPending, tsDrawSelPending, tsToggleFocusedSelection, tsScrollPending, tsScrolling]); StopTimer(ScrollTimer); @@ -23741,7 +23859,7 @@ procedure TBaseVirtualTree.HandleMouseUp(var Message: TWMMouse; const HitInfo: T end; if (FHeader.FColumns.FClickIndex > NoColumn) and (FHeader.FColumns.FClickIndex = HitInfo.HitColumn) then - DoColumnClick(HitInfo.HitColumn, KeysToShiftState(Message.Keys)); + DoColumnClick(HitInfo.HitColumn, {$IFDEF VT_FMX}TShiftState(Word(Message.Keys)){$ELSE}KeysToShiftState(Message.Keys){$ENDIF}); if FLastHitInfo.HitNode <> nil then begin // Use THitInfo of mouse down here, see issue #692 DoNodeClick(FLastHitInfo); @@ -23757,14 +23875,16 @@ procedure TBaseVirtualTree.HandleMouseUp(var Message: TWMMouse; const HitInfo: T CanEdit(FFocusedNode, HitInfo.HitColumn) then begin FEditColumn := FFocusedColumn; +{$IFDEF VT_VCL} SetTimer(Handle, EditTimer, FEditDelay, nil); +{$ENDIF} end else DoStateChange([], [tsEditPending]); end; end; end; -{$ENDIF} +//{$ENDIF} //---------------------------------------------------------------------------------------------------------------------- function TBaseVirtualTree.HasImage(Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex): Boolean; @@ -24543,8 +24663,37 @@ procedure TBaseVirtualTree.MouseMove(Shift: TShiftState; X, Y: {$IFDEF VT_FMX}Si var R: TRect; - +{$IFDEF VT_FMX} + MM: TWMMouse; + P: TPoint; + isNC: Boolean; +{$ENDIF} begin +{$IFDEF VT_FMX} + P.X:= X; + P.Y:= Y; + if ClientRect.Contains(P) then + begin + isNC:= false; + end else + begin + P:= ClientToScreen(P); + isNC:= true; + end; + + FillTWMMouse(MM, TMouseButton.mbLeft, Shift, P.X, P.Y, isNC); + if isNC then + begin + MM.Msg:= WM_NCMOUSEMOVE; + end else + begin + MM.Msg:= WM_MOUSEMOVE; + end; + if FHeader.HandleMessage(TMessage(MM)) then + exit;//!!! + + +{$ENDIF} if tsNodeHeightTrackPending in FStates then begin // Remove hint if shown currently. @@ -29775,7 +29924,11 @@ function TBaseVirtualTree.GetNodeAt(X, Y: TDimension; Relative: Boolean; var Nod // CurrentPos tracks a running term of the current position to test for. // It corresponds always to the top position of the currently considered node. +{$IFDEF VT_FMX} + CurrentPos := ClientRect.Top; +{$ELSE} CurrentPos := 0; +{$ENDIF} // If the cache is available then use it. if tsUseCache in FStates then @@ -32074,8 +32227,10 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe Target := TargetRect.TopLeft; R := Rect(TargetRect.Left, 0, TargetRect.Left, MaximumBottom - Target.Y); {$IFDEF VT_FMX} - TargetRect := Rect(0, TargetRect.Top, MaximumRight - Target.X, MaximumBottom - Target.Y); + R := Rect(TargetRect.Left, 0, TargetRect.Left, MaximumBottom{ - Target.Y}); + TargetRect := Rect(0, TargetRect.Top, MaximumRight - Target.X, MaximumBottom{ - Target.Y}); {$ELSE} + R := Rect(TargetRect.Left, 0, TargetRect.Left, MaximumBottom - Target.Y); TargetRect := Rect(0, 0, MaximumRight - Target.X, MaximumBottom - Target.Y); {$ENDIF} From b3e252b773d9e0685743407a63df44e2837630eb Mon Sep 17 00:00:00 2001 From: livius2 Date: Mon, 12 Nov 2018 15:29:00 +0100 Subject: [PATCH 24/61] Added header column resizing by mouse Added header column resizing by mouse --- README.md | 3 ++- Source/VirtualTrees.FMX.pas | 53 +++++++++++++++++++++++++++---------- Source/VirtualTrees.pas | 39 ++++++++++++++++++--------- 3 files changed, 68 insertions(+), 27 deletions(-) diff --git a/README.md b/README.md index 0fcd5c9c6..c04a1af68 100644 --- a/README.md +++ b/README.md @@ -9,7 +9,8 @@ What is working: 6. it support cliping during cell draw; 7. it support multiple columns; 8. it draw header columns. -9. expanding, colapsing by mouse click. +9. expanding, collapsing by mouse click. +10. mouse cursor and header column resize by mouse. What is not working yet: 1. some mouse action like click, drag-drop, mouse move, hover; diff --git a/Source/VirtualTrees.FMX.pas b/Source/VirtualTrees.FMX.pas index be30f7d14..86ba9ea1a 100644 --- a/Source/VirtualTrees.FMX.pas +++ b/Source/VirtualTrees.FMX.pas @@ -397,13 +397,13 @@ THighQualityBitmap = class(TBitmap) constructor Create; override; end; -procedure FillTWMMouse(Var MM: TWMMouse; Button: TMouseButton; Shift: TShiftState; X: Single; Y: Single; IsNC: Boolean); +procedure FillTWMMouse(Var MM: TWMMouse; Button: TMouseButton; Shift: TShiftState; X: Single; Y: Single; IsNC: Boolean; IsUp: Boolean); implementation uses FMX.TextLayout, System.SysUtils, FMX.Types; //---------------------------------------------------------------------------------------------------------------------- -procedure FillTWMMouse(Var MM: TWMMouse; Button: TMouseButton; Shift: TShiftState; X: Single; Y: Single; IsNC: Boolean); +procedure FillTWMMouse(Var MM: TWMMouse; Button: TMouseButton; Shift: TShiftState; X: Single; Y: Single; IsNC: Boolean; IsUp: Boolean); begin MM.Msg:= 0; if ssDouble in Shift then @@ -428,23 +428,48 @@ procedure FillTWMMouse(Var MM: TWMMouse; Button: TMouseButton; Shift: TShiftStat end; end else begin - if ssLeft in Shift then + if (ssLeft in Shift) or (Button=TMouseButton.mbLeft) then begin - if IsNC then - MM.Msg:= WM_NCLBUTTONDOWN else - MM.Msg:= WM_LBUTTONDOWN; + if IsUp then + begin + if IsNC then + MM.Msg:= WM_NCLBUTTONUP else + MM.Msg:= WM_LBUTTONUP; + end else + begin + if IsNC then + MM.Msg:= WM_NCLBUTTONDOWN else + MM.Msg:= WM_LBUTTONDOWN; + end; end else - if ssRight in Shift then + if (ssRight in Shift) or (Button=TMouseButton.mbRight) then begin - if IsNC then - MM.Msg:= WM_NCRBUTTONDOWN else - MM.Msg:= WM_RBUTTONDOWN; + if IsUp then + begin + if IsNC then + MM.Msg:= WM_NCRBUTTONUP else + MM.Msg:= WM_RBUTTONUP; + end else + begin + if IsNC then + MM.Msg:= WM_NCRBUTTONDOWN else + MM.Msg:= WM_RBUTTONDOWN; + end; + end else - if ssMiddle in Shift then + if (ssMiddle in Shift) or (Button=TMouseButton.mbMiddle) then begin - if IsNC then - MM.Msg:= WM_NCMBUTTONDOWN else - MM.Msg:= WM_MBUTTONDOWN; + if IsUp then + begin + if IsNC then + MM.Msg:= WM_NCMBUTTONUP else + MM.Msg:= WM_MBUTTONUP; + end else + begin + if IsNC then + MM.Msg:= WM_NCMBUTTONDOWN else + MM.Msg:= WM_MBUTTONDOWN; + end; end; end; diff --git a/Source/VirtualTrees.pas b/Source/VirtualTrees.pas index 7c83aeb6b..b59ca2de8 100644 --- a/Source/VirtualTrees.pas +++ b/Source/VirtualTrees.pas @@ -11117,18 +11117,18 @@ function TVTHeader.HandleMessage(var Message: TMessage): Boolean; if IsVSplitterHit or IsHSplitterHit then begin - cursorService:= TPlatformServices.Current.GetPlatformservice(IFMXCursorService) as IFMXCursorService; {$IFDEF VT_FMX} + cursorService:= TPlatformServices.Current.GetPlatformservice(IFMXCursorService) as IFMXCursorService; if Assigned(cursorService) then - NewCursor:= cursorService.GetCursor; + NewCursor:= Treeview.Cursor;//cursorService.GetCursor; {$ELSE} NewCursor := Screen.Cursors[Treeview.Cursor]; {$ENDIF} if IsVSplitterHit and ((hoHeightResize in FOptions) or (csDesigning in Treeview.ComponentState)) then - NewCursor := {$IFDEF VT_FMX}crVSplit{$ELSE}Screen.Cursors[crVertSplit]{$ENDIF} + NewCursor := {$IFDEF VT_FMX}crSizeNS{$ELSE}Screen.Cursors[crVertSplit]{$ENDIF} else if IsHSplitterHit then - NewCursor := {$IFDEF VT_FMX}crHSplit{$ELSE}Screen.Cursors[crHeaderSplit]{$ENDIF}; + NewCursor := {$IFDEF VT_FMX}crSizeWE{$ELSE}Screen.Cursors[crHeaderSplit]{$ENDIF}; if not (csDesigning in Treeview.ComponentState) then Treeview.DoGetHeaderCursor(NewCursor); @@ -11136,13 +11136,19 @@ function TVTHeader.HandleMessage(var Message: TMessage): Boolean; if Result then begin {$IFDEF VT_FMX} - if Assigned(cursorService) then - cursorService.SetCursor(NewCursor); + {if Assigned(cursorService) then + cursorService.SetCursor(NewCursor); } + TreeView.Cursor:= NewCursor; {$ELSE} Winapi.Windows.SetCursor(NewCursor); {$ENDIF} Message.Result := 1; end; + end else + begin +{$IFDEF VT_FMX} + TreeView.Cursor:= crDefault; +{$ENDIF} end; end else @@ -23282,11 +23288,11 @@ procedure TBaseVirtualTree.MouseDown(Button: TMouseButton; Shift: TShiftState; X isNC:= true; P:= ClientToScreen(P); end; - FillTWMMouse(MM, Button, Shift, P.X, P.Y, isNC); + FillTWMMouse(MM, Button, Shift, P.X, P.Y, isNC, false); if FHeader.HandleMessage(TMessage(MM)) then exit;//!!! - FillTWMMouse(MM, Button, Shift, X, Y, isNC); + FillTWMMouse(MM, Button, Shift, X, Y, isNC, false); // get information about the hit GetHitTestInfoAt(X, Y, True, hInfo); @@ -23309,11 +23315,11 @@ procedure TBaseVirtualTree.MouseUp(Button: TMouseButton; Shift: TShiftState; X: isNC:= true; P:= ClientToScreen(P); end; - FillTWMMouse(MM, Button, Shift, P.X, P.Y, isNC); + FillTWMMouse(MM, Button, Shift, P.X, P.Y, isNC, true); if FHeader.HandleMessage(TMessage(MM)) then exit;//!!! - FillTWMMouse(MM, Button, Shift, X, Y, isNC); + FillTWMMouse(MM, Button, Shift, X, Y, isNC, true); // get information about the hit GetHitTestInfoAt(X, Y, True, hInfo); HandleMouseUp(MM, hInfo); @@ -24681,7 +24687,7 @@ procedure TBaseVirtualTree.MouseMove(Shift: TShiftState; X, Y: {$IFDEF VT_FMX}Si isNC:= true; end; - FillTWMMouse(MM, TMouseButton.mbLeft, Shift, P.X, P.Y, isNC); + FillTWMMouse(MM, TMouseButton.mbLeft, Shift, P.X, P.Y, isNC, false); if isNC then begin MM.Msg:= WM_NCMOUSEMOVE; @@ -24690,7 +24696,16 @@ procedure TBaseVirtualTree.MouseMove(Shift: TShiftState; X, Y: {$IFDEF VT_FMX}Si MM.Msg:= WM_MOUSEMOVE; end; if FHeader.HandleMessage(TMessage(MM)) then - exit;//!!! + exit else + begin + if MM.Msg=WM_NCMOUSEMOVE then + begin + MM.Msg:= WM_SETCURSOR; + if FHeader.HandleMessage(TMessage(MM)) then + exit;//!!! + end; + end; + {$ENDIF} From 88c2bfdc91f2aa6865e71ee6099cb60ea5931f25 Mon Sep 17 00:00:00 2001 From: livius2 Date: Mon, 12 Nov 2018 18:37:27 +0100 Subject: [PATCH 25/61] Accept focus, draw focus rect - added accept focus - draw focus rect - draw unfocussed rect --- README.md | 1 + Source/VirtualTrees.pas | 14 +++++++++++--- 2 files changed, 12 insertions(+), 3 deletions(-) diff --git a/README.md b/README.md index c04a1af68..5c0e22b8e 100644 --- a/README.md +++ b/README.md @@ -11,6 +11,7 @@ What is working: 8. it draw header columns. 9. expanding, collapsing by mouse click. 10. mouse cursor and header column resize by mouse. +11. it accept focus, it draw focus rect and unfocussed rect What is not working yet: 1. some mouse action like click, drag-drop, mouse move, hover; diff --git a/Source/VirtualTrees.pas b/Source/VirtualTrees.pas index b59ca2de8..ee7424d62 100644 --- a/Source/VirtualTrees.pas +++ b/Source/VirtualTrees.pas @@ -45,6 +45,8 @@ // https://github.com/Virtual-TreeView/Virtual-TreeView // Accessability implementation: // Marco Zehe (with help from Sebastian Modersohn) +// Port to Firemonkey: +// Karol Bieniaszewski (github user livius2) //---------------------------------------------------------------------------------------------------------------------- interface @@ -3081,7 +3083,7 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF function CancelEditNode: Boolean; procedure CancelOperation; function CanEdit(Node: PVirtualNode; Column: TColumnIndex): Boolean; virtual; - function CanFocus: Boolean; {$IFDEF VT_FMX}virtual{$ELSE}override{$ENDIF}; + {$IFDEF VT_VCL}function CanFocus: Boolean; override;{$ENDIF} procedure Clear; virtual; procedure ClearChecked; procedure ClearSelection(); overload; inline; @@ -12424,6 +12426,9 @@ constructor TBaseVirtualTree.Create(AOwner: TComponent); FBevelWidth:= 1; FBorderWidth:= 0; FFont:= TFont.Create; + DisableFocusEffect := True; + CanFocus := True; + AutoCapture := True; {$ELSE} ControlStyle := ControlStyle - [csSetCaption] + [csCaptureMouse, csOpaque, csReplicatable, csDisplayDragImage, csReflector]; @@ -25684,8 +25689,10 @@ procedure TBaseVirtualTree.PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX, with TWithSafeRect(InnerRect) do {$IFDEF VT_FMX} //TODO: should we also use FillRect? - //FillRect(Rect(Left, Top, Right, Bottom), FSelectionCurveRadius, FSelectionCurveRadius, allCorners, 1.0); + begin + FillRect(Rect(Left, Top, Right, Bottom), FSelectionCurveRadius, FSelectionCurveRadius, allCorners, 1.0); DrawRect(Rect(Left, Top, Right, Bottom), FSelectionCurveRadius, FSelectionCurveRadius, allCorners, 1.0); + end; {$ELSE} RoundRect(Left, Top, Right, Bottom, FSelectionCurveRadius, FSelectionCurveRadius); {$ENDIF} @@ -27472,7 +27479,7 @@ function TBaseVirtualTree.CanEdit(Node: PVirtualNode; Column: TColumnIndex): Boo end; //---------------------------------------------------------------------------------------------------------------------- - +{$IFDEF VT_VCL} function TBaseVirtualTree.CanFocus: Boolean; var @@ -27492,6 +27499,7 @@ function TBaseVirtualTree.CanFocus: Boolean; {$ENDIF} end; end; +{$ENDIF} //---------------------------------------------------------------------------------------------------------------------- From ddbad39761535f1f1246d5ec1dbc62c9cf3285f1 Mon Sep 17 00:00:00 2001 From: livius2 Date: Tue, 13 Nov 2018 15:47:53 +0100 Subject: [PATCH 26/61] Update README.md Update info how to use this port. Updated also info what is working and what not --- README.md | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/README.md b/README.md index 5c0e22b8e..1614f3d31 100644 --- a/README.md +++ b/README.md @@ -4,28 +4,32 @@ What is working: 1. it compiles under FMX - this was main task of this pull request; 2. it draw tree nodes structure with apropiate levels; 3. it draw nodes text with alignment; -4. it draw buttons plus/minus; -5. it draw tree lines, horizontal lines, vertical lines, full vertical lines (some pixel improvement needed but it work); +4. it draw buttons plus/minus (toShowButtons); +5. it draw tree lines (toShowTreeLines), horizontal lines (toShowHorzGridLines), vertical lines (toShowVertGridLines), full vertical lines (toFullVertGridLines) (some pixel improvement needed but it is working); 6. it support cliping during cell draw; 7. it support multiple columns; 8. it draw header columns. 9. expanding, collapsing by mouse click. 10. mouse cursor and header column resize by mouse. -11. it accept focus, it draw focus rect and unfocussed rect +11. it accept focus, it draw focus rect and unfocussed rect, toExtendedFocus, toFullRowSelect, toHotTrack, toUseBlendedSelection. What is not working yet: 1. some mouse action like click, drag-drop, mouse move, hover; 2. clipboard; 3. drawing and supoport of tree border; 4. drawing background; -5. mouse ations on header (point 1); -6. drawing selection and focus rect. +5. some mouse ations on header; +6. inplace editors. Current VT is derived from TRectangle. Will be good to have it as presented control with appropiate TDataModel. This will bring more possibilities like have e.g. 2 tree on the form based on same data. One will be i scale 1 second smaller in scale e.g 0.2 as a preview. +To test FMX prot of VT - you must add in the e.g. Delphi project->Options->Conditional defines +**VT_FMX**. It have not currently package. But you can test it from the code. +Remember to add also to uses clause unit VirtualTrees.FMX. + # Virtual-TreeView Virtual Treeview is a Delphi treeview control built from ground up. Many years of development made it one of the most flexible and advanced tree controls available today. Virtual Treeview starts off with the claim to improve many aspects of existing solutions and introduces some new technologies and principles which were not available before. From e30cf516ac6a15384ae47e96350bec23789b2699 Mon Sep 17 00:00:00 2001 From: livius2 Date: Wed, 14 Nov 2018 08:38:38 +0100 Subject: [PATCH 27/61] Checkbox support Fix of checkbox support. It is working only with custom images. --- README.md | 2 ++ Source/VirtualTrees.pas | 4 ++-- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 1614f3d31..d83cfc71f 100644 --- a/README.md +++ b/README.md @@ -12,6 +12,7 @@ What is working: 9. expanding, collapsing by mouse click. 10. mouse cursor and header column resize by mouse. 11. it accept focus, it draw focus rect and unfocussed rect, toExtendedFocus, toFullRowSelect, toHotTrack, toUseBlendedSelection. +12. checkbox support (only with custom imageList). What is not working yet: 1. some mouse action like click, drag-drop, mouse move, hover; @@ -20,6 +21,7 @@ What is not working yet: 4. drawing background; 5. some mouse ations on header; 6. inplace editors. +7. system check box support (now only custom checkbox list is working). Current VT is derived from TRectangle. Will be good to have it as presented control with appropiate TDataModel. diff --git a/Source/VirtualTrees.pas b/Source/VirtualTrees.pas index ee7424d62..30c056b77 100644 --- a/Source/VirtualTrees.pas +++ b/Source/VirtualTrees.pas @@ -13680,7 +13680,7 @@ function TBaseVirtualTree.GetSyncCheckstateWithSelection(Node: PVirtualNode): Bo Result := (toSyncCheckboxesWithSelection in FOptions.FSelectionOptions) and (toCheckSupport in FOptions.FMiscOptions) and Assigned(FCheckImages) - and (Node.CheckType = ctCheckBox); ; + and (Node.CheckType = ctCheckBox); end; //---------------------------------------------------------------------------------------------------------------------- @@ -25130,7 +25130,7 @@ procedure TBaseVirtualTree.PaintCheckImage(Canvas: TCanvas; const ImageInfo: TVT else {$IFDEF VT_FMX} ForegroundColor := clWhite; - Draw(Canvas, Rect(XPos, YPos, 16, 16), Index, 1.0); //TODO: 16px Image! + Draw(Canvas, Rect(XPos, YPos, XPos+16, YPos+16), Index, 1.0); //TODO: 16px Image! {$ELSE} ForegroundColor := GetRGBColor(BlendColor); From f79264a776b8c7f4c8af1273c137f6c1c7f5327c Mon Sep 17 00:00:00 2001 From: livius2 Date: Wed, 14 Nov 2018 09:15:32 +0100 Subject: [PATCH 28/61] Added package for FMX for Delphi Tokyo Added package for FMX for Delphi Tokyo --- Design/VirtualTreesReg.pas | 23 +- .../VirtualTreeViewFMX.groupproj | 48 ++ .../RAD Studio 10.2 FMX/VirtualTreesD_FMX.dpk | 38 ++ .../VirtualTreesD_FMX.dproj | 588 +++++++++++++++++ .../RAD Studio 10.2 FMX/VirtualTreesR_FMX.dpk | 36 ++ .../VirtualTreesR_FMX.dproj | 591 ++++++++++++++++++ README.md | 4 +- 7 files changed, 1325 insertions(+), 3 deletions(-) create mode 100644 Packages/RAD Studio 10.2 FMX/VirtualTreeViewFMX.groupproj create mode 100644 Packages/RAD Studio 10.2 FMX/VirtualTreesD_FMX.dpk create mode 100644 Packages/RAD Studio 10.2 FMX/VirtualTreesD_FMX.dproj create mode 100644 Packages/RAD Studio 10.2 FMX/VirtualTreesR_FMX.dpk create mode 100644 Packages/RAD Studio 10.2 FMX/VirtualTreesR_FMX.dproj diff --git a/Design/VirtualTreesReg.pas b/Design/VirtualTreesReg.pas index 094fe6351..3d9ba7b8b 100644 --- a/Design/VirtualTreesReg.pas +++ b/Design/VirtualTreesReg.pas @@ -5,20 +5,30 @@ interface +//{$DEFINE VT_FMX} +{$IFNDEF VT_FMX} + {$DEFINE VT_VCL} +{$ENDIF} + // For some things to work we need code, which is classified as being unsafe for .NET. {$warn UNSAFE_TYPE off} {$warn UNSAFE_CAST off} {$warn UNSAFE_CODE off} - uses +{$IFDEF VT_FMX} + Classes, VirtualTrees, VirtualTrees.FMX; +{$ELSE} Windows, Classes, DesignIntf, DesignEditors, VCLEditors, PropertyCategories, ColnEdit, VirtualTrees, VirtualTrees.HeaderPopup; +{$ENDIF} +{$IFDEF VT_VCL} type TVirtualTreeEditor = class (TDefaultEditor) public procedure Edit; override; end; +{$ENDIF} procedure Register; @@ -27,9 +37,14 @@ procedure Register; implementation uses +{$IFDEF VT_FMX} + SysUtils; +{$ELSE} StrEdit, Dialogs, TypInfo, SysUtils, Graphics, CommCtrl, ImgList, Controls, VirtualTrees.ClipBoard, VirtualTrees.Actions; +{$ENDIF} +{$IFDEF VT_VCL} type // The usual trick to make a protected property accessible in the ShowCollectionEditor call below. TVirtualTreeCast = class(TBaseVirtualTree); @@ -287,11 +302,16 @@ procedure TClipboardFormatsProperty.PropDrawValue(ACanvas: TCanvas; const ARect: // Nothing to do here. end; +{$ENDIF} + //---------------------------------------------------------------------------------------------------------------------- procedure Register; begin +{$IFDEF VT_FMX} + RegisterComponents('Virtual Controls', [TVirtualStringTree, TVirtualDrawTree]); +{$ELSE} RegisterComponents('Virtual Controls', [TVirtualStringTree, TVirtualDrawTree, TVTHeaderPopupMenu]); RegisterComponentEditor(TVirtualStringTree, TVirtualTreeEditor); RegisterComponentEditor(TVirtualDrawTree, TVirtualTreeEditor); @@ -393,6 +413,7 @@ procedure Register; RegisterPropertiesInCategory(sVTIncremenalCategoryName, TBaseVirtualTree, ['*Incremental*']); +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- diff --git a/Packages/RAD Studio 10.2 FMX/VirtualTreeViewFMX.groupproj b/Packages/RAD Studio 10.2 FMX/VirtualTreeViewFMX.groupproj new file mode 100644 index 000000000..93d2ffdd3 --- /dev/null +++ b/Packages/RAD Studio 10.2 FMX/VirtualTreeViewFMX.groupproj @@ -0,0 +1,48 @@ + + + {476E8067-4918-45C9-BEC3-C3941CF2E6D0} + + + + + + + + + + + Default.Personality.12 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Packages/RAD Studio 10.2 FMX/VirtualTreesD_FMX.dpk b/Packages/RAD Studio 10.2 FMX/VirtualTreesD_FMX.dpk new file mode 100644 index 000000000..fff69bc6c --- /dev/null +++ b/Packages/RAD Studio 10.2 FMX/VirtualTreesD_FMX.dpk @@ -0,0 +1,38 @@ +package VirtualTreesD_FMX; + +{$R *.res} +{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DEFINE VT_FMX} +{$DEFINE RELEASE} +{$ENDIF IMPLICITBUILDING} +{$IMPLICITBUILD ON} + +requires + rtl, + fmx; + +contains + VirtualTreesReg in '..\..\Design\VirtualTreesReg.pas'; + +end. diff --git a/Packages/RAD Studio 10.2 FMX/VirtualTreesD_FMX.dproj b/Packages/RAD Studio 10.2 FMX/VirtualTreesD_FMX.dproj new file mode 100644 index 000000000..f7ab4229b --- /dev/null +++ b/Packages/RAD Studio 10.2 FMX/VirtualTreesD_FMX.dproj @@ -0,0 +1,588 @@ + + + {2B5EB14C-740A-4933-9110-86A014DED21E} + VirtualTreesD_FMX.dpk + 18.4 + None + True + Release + Win32 + 1 + Package + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + .\$(Platform)\$(Config) + .\$(Platform)\$(Config) + false + false + false + false + false + true + true + System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) + All + VirtualTreesD_FMX + + + None + android-support-v4.dex.jar;cloud-messaging.dex.jar;fmx.dex.jar;google-analytics-v2.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar;google-play-services-ads-7.0.0.dex.jar;google-play-services-analytics-7.0.0.dex.jar;google-play-services-base-7.0.0.dex.jar;google-play-services-identity-7.0.0.dex.jar;google-play-services-maps-7.0.0.dex.jar;google-play-services-panorama-7.0.0.dex.jar;google-play-services-plus-7.0.0.dex.jar;google-play-services-wallet-7.0.0.dex.jar + rtl;fmx;$(DCC_UsePackage) + + + None + rtl;fmx;$(DCC_UsePackage) + + + None + rtl;fmx;$(DCC_UsePackage) + + + None + rtl;fmx;$(DCC_UsePackage) + + + rtl;$(DCC_UsePackage) + + + rtl;fmx;$(DCC_UsePackage) + + + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + rtl;fmx;$(DCC_UsePackage) + + + rtl;fmx;$(DCC_UsePackage) + + + DEBUG;$(DCC_Define) + true + false + true + true + true + + + false + + + false + RELEASE;$(DCC_Define) + 0 + 0 + + + ..\..\source;.\$(Platform)\$(Config);$(DCC_UnitSearchPath) + VT_FMX;$(DCC_Define) + true + 1033 + + + + MainSource + + + + + + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + + + + Delphi.Personality.12 + Package + + + + VirtualTreesD_FMX.dpk + + + Microsoft Office 2000 Sample Automation Server Wrapper Components + Microsoft Office XP Sample Automation Server Wrapper Components + + + + + + true + + + + + true + + + + + true + + + + + true + + + + + VirtualTreesD_FMX.bpl + true + + + + + VirtualTreesD_FMX.bpl + true + + + + + 1 + + + Contents\MacOS + 0 + + + + + classes + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\armeabi + 1 + + + + + library\lib\mips + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + res\drawable + 1 + + + + + res\values + 1 + + + + + res\drawable + 1 + + + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-ldpi + 1 + + + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + + + res\drawable-small + 1 + + + + + res\drawable-normal + 1 + + + + + res\drawable-large + 1 + + + + + res\drawable-xlarge + 1 + + + + + 1 + + + 1 + + + 0 + + + + + 1 + .framework + + + 0 + + + + + 1 + .dylib + + + 0 + .dll;.bpl + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + 0 + .bpl + + + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + + + + 1 + + + 1 + + + 1 + + + + + + + Contents\Resources + 1 + + + + + library\lib\armeabi-v7a + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + 0 + + + + + 1 + + + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + + + + + + + + + False + False + False + False + False + False + True + False + + + 12 + + + + + diff --git a/Packages/RAD Studio 10.2 FMX/VirtualTreesR_FMX.dpk b/Packages/RAD Studio 10.2 FMX/VirtualTreesR_FMX.dpk new file mode 100644 index 000000000..aa40a5bfe --- /dev/null +++ b/Packages/RAD Studio 10.2 FMX/VirtualTreesR_FMX.dpk @@ -0,0 +1,36 @@ +package VirtualTreesR_FMX; + +{$R *.res} +{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DEFINE VT_FMX} +{$DEFINE RELEASE} +{$ENDIF IMPLICITBUILDING} +{$IMPLICITBUILD ON} + +requires + rtl, + fmx, + VirtualTreesD_FMX; + +end. diff --git a/Packages/RAD Studio 10.2 FMX/VirtualTreesR_FMX.dproj b/Packages/RAD Studio 10.2 FMX/VirtualTreesR_FMX.dproj new file mode 100644 index 000000000..3c6172d25 --- /dev/null +++ b/Packages/RAD Studio 10.2 FMX/VirtualTreesR_FMX.dproj @@ -0,0 +1,591 @@ + + + {90631997-93D1-43A7-BE73-73F181248F39} + VirtualTreesR_FMX.dpk + 18.4 + FMX + True + Release + Win32 + 1 + Package + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + .\$(Platform)\$(Config) + .\$(Platform)\$(Config) + false + false + false + false + false + true + true + System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) + All + VirtualTreesR_FMX + + + None + android-support-v4.dex.jar;cloud-messaging.dex.jar;fmx.dex.jar;google-analytics-v2.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar;google-play-services-ads-7.0.0.dex.jar;google-play-services-analytics-7.0.0.dex.jar;google-play-services-base-7.0.0.dex.jar;google-play-services-identity-7.0.0.dex.jar;google-play-services-maps-7.0.0.dex.jar;google-play-services-panorama-7.0.0.dex.jar;google-play-services-plus-7.0.0.dex.jar;google-play-services-wallet-7.0.0.dex.jar + rtl;fmx;$(DCC_UsePackage) + + + None + rtl;fmx;$(DCC_UsePackage) + + + None + rtl;fmx;$(DCC_UsePackage) + + + None + rtl;fmx;$(DCC_UsePackage) + + + rtl;$(DCC_UsePackage) + + + rtl;fmx;$(DCC_UsePackage) + + + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + rtl;fmx;VirtualTreesD_FMX;$(DCC_UsePackage) + + + rtl;fmx;$(DCC_UsePackage) + + + DEBUG;$(DCC_Define) + true + false + true + true + true + + + false + VT_FMX;$(DCC_Define) + true + 1033 + + + false + RELEASE;$(DCC_Define) + 0 + 0 + + + VT_FMX;$(DCC_Define) + true + 1033 + ..\..\source;.\$(Platform)\$(Config);$(DCC_UnitSearchPath) + + + + MainSource + + + + + + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + + + + Delphi.Personality.12 + Package + + + + VirtualTreesR_FMX.dpk + + + Microsoft Office 2000 Sample Automation Server Wrapper Components + Microsoft Office XP Sample Automation Server Wrapper Components + + + + + + true + + + + + true + + + + + true + + + + + true + + + + + VirtualTreesR_FMX.bpl + true + + + + + VirtualTreesR_FMX.bpl + true + + + + + 1 + + + Contents\MacOS + 0 + + + + + classes + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\armeabi + 1 + + + + + library\lib\mips + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + res\drawable + 1 + + + + + res\values + 1 + + + + + res\drawable + 1 + + + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-ldpi + 1 + + + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + + + res\drawable-small + 1 + + + + + res\drawable-normal + 1 + + + + + res\drawable-large + 1 + + + + + res\drawable-xlarge + 1 + + + + + 1 + + + 1 + + + 0 + + + + + 1 + .framework + + + 0 + + + + + 1 + .dylib + + + 0 + .dll;.bpl + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + 0 + .bpl + + + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + + + + 1 + + + 1 + + + 1 + + + + + + + Contents\Resources + 1 + + + + + library\lib\armeabi-v7a + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + 0 + + + + + 1 + + + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + + + + + + + + + False + False + False + False + False + False + True + False + + + 12 + + + + + diff --git a/README.md b/README.md index d83cfc71f..c47ccb794 100644 --- a/README.md +++ b/README.md @@ -28,8 +28,8 @@ Will be good to have it as presented control with appropiate TDataModel. This will bring more possibilities like have e.g. 2 tree on the form based on same data. One will be i scale 1 second smaller in scale e.g 0.2 as a preview. -To test FMX prot of VT - you must add in the e.g. Delphi project->Options->Conditional defines -**VT_FMX**. It have not currently package. But you can test it from the code. +To test FMX port of VT - you must add in the e.g. Delphi project->Options->Conditional defines +**VT_FMX**. There is only package for Delphi Tokyo (but you can test it from the code). Remember to add also to uses clause unit VirtualTrees.FMX. # Virtual-TreeView From 05ee7d4b43eda7511c4c418fe4aba888b01588a7 Mon Sep 17 00:00:00 2001 From: livius2 Date: Wed, 14 Nov 2018 09:41:10 +0100 Subject: [PATCH 29/61] Take action when VT is resized Take action when VT is resized: - update header .. simulate WM_SIZE - some code cleanup --- Source/VirtualTrees.FMX.pas | 75 ++++++++++--------------------------- Source/VirtualTrees.pas | 42 +++++++++++++++++---- 2 files changed, 53 insertions(+), 64 deletions(-) diff --git a/Source/VirtualTrees.FMX.pas b/Source/VirtualTrees.FMX.pas index 86ba9ea1a..4f70b80da 100644 --- a/Source/VirtualTrees.FMX.pas +++ b/Source/VirtualTrees.FMX.pas @@ -32,125 +32,80 @@ interface const { 3D border styles } - {$EXTERNALSYM BDR_RAISEDOUTER} BDR_RAISEDOUTER = 1; - {$EXTERNALSYM BDR_SUNKENOUTER} BDR_SUNKENOUTER = 2; - {$EXTERNALSYM BDR_RAISEDINNER} BDR_RAISEDINNER = 4; - {$EXTERNALSYM BDR_SUNKENINNER} BDR_SUNKENINNER = 8; - {$EXTERNALSYM BDR_OUTER} BDR_OUTER = 3; - {$EXTERNALSYM BDR_INNER} BDR_INNER = 12; - {$EXTERNALSYM BDR_RAISED} BDR_RAISED = 5; - {$EXTERNALSYM BDR_SUNKEN} BDR_SUNKEN = 10; - {$EXTERNALSYM EDGE_RAISED} EDGE_RAISED = (BDR_RAISEDOUTER or BDR_RAISEDINNER); - {$EXTERNALSYM EDGE_SUNKEN} EDGE_SUNKEN = (BDR_SUNKENOUTER or BDR_SUNKENINNER); - {$EXTERNALSYM EDGE_ETCHED} EDGE_ETCHED = (BDR_SUNKENOUTER or BDR_RAISEDINNER); - {$EXTERNALSYM EDGE_BUMP} EDGE_BUMP = (BDR_RAISEDOUTER or BDR_SUNKENINNER); - {$EXTERNALSYM ETO_OPAQUE} ETO_OPAQUE = 2; - {$EXTERNALSYM ETO_CLIPPED} ETO_CLIPPED = 4; - {$EXTERNALSYM ETO_RTLREADING} ETO_RTLREADING = $80; RTLFlag: array[Boolean] of Integer = (0, ETO_RTLREADING); { Border flags } - {$EXTERNALSYM BF_LEFT} BF_LEFT = 1; - {$EXTERNALSYM BF_TOP} BF_TOP = 2; - {$EXTERNALSYM BF_RIGHT} BF_RIGHT = 4; - {$EXTERNALSYM BF_BOTTOM} BF_BOTTOM = 8; - {$EXTERNALSYM BF_TOPLEFT} BF_TOPLEFT = (BF_TOP or BF_LEFT); - {$EXTERNALSYM BF_TOPRIGHT} BF_TOPRIGHT = (BF_TOP or BF_RIGHT); - {$EXTERNALSYM BF_BOTTOMLEFT} BF_BOTTOMLEFT = (BF_BOTTOM or BF_LEFT); - {$EXTERNALSYM BF_BOTTOMRIGHT} BF_BOTTOMRIGHT = (BF_BOTTOM or BF_RIGHT); - {$EXTERNALSYM BF_RECT} BF_RECT = (BF_LEFT or BF_TOP or BF_RIGHT or BF_BOTTOM); - {$EXTERNALSYM BF_MIDDLE} BF_MIDDLE = $800; { Fill in the middle } - {$EXTERNALSYM BF_SOFT} BF_SOFT = $1000; { For softer buttons } - {$EXTERNALSYM BF_ADJUST} BF_ADJUST = $2000; { Calculate the space left over } - {$EXTERNALSYM BF_FLAT} BF_FLAT = $4000; { For flat rather than 3D borders } - {$EXTERNALSYM BF_MONO} BF_MONO = $8000; { For monochrome borders } { DrawText() Format Flags } DT_TOP = 0; - {$EXTERNALSYM DT_TOP} DT_LEFT = 0; - {$EXTERNALSYM DT_LEFT} DT_CENTER = 1; - {$EXTERNALSYM DT_CENTER} DT_RIGHT = 2; - {$EXTERNALSYM DT_RIGHT} DT_VCENTER = 4; - {$EXTERNALSYM DT_VCENTER} DT_BOTTOM = 8; - {$EXTERNALSYM DT_BOTTOM} DT_WORDBREAK = $10; - {$EXTERNALSYM DT_WORDBREAK} DT_SINGLELINE = $20; - {$EXTERNALSYM DT_SINGLELINE} DT_EXPANDTABS = $40; - {$EXTERNALSYM DT_EXPANDTABS} DT_TABSTOP = $80; - {$EXTERNALSYM DT_TABSTOP} DT_NOCLIP = $100; - {$EXTERNALSYM DT_NOCLIP} DT_EXTERNALLEADING = $200; - {$EXTERNALSYM DT_EXTERNALLEADING} DT_CALCRECT = $400; - {$EXTERNALSYM DT_CALCRECT} DT_NOPREFIX = $800; - {$EXTERNALSYM DT_NOPREFIX} DT_INTERNAL = $1000; - {$EXTERNALSYM DT_INTERNAL} DT_EDITCONTROL = $2000; - {$EXTERNALSYM DT_EDITCONTROL} DT_PATH_ELLIPSIS = $4000; - {$EXTERNALSYM DT_PATH_ELLIPSIS} DT_END_ELLIPSIS = $8000; - {$EXTERNALSYM DT_END_ELLIPSIS} DT_MODIFYSTRING = $10000; - {$EXTERNALSYM DT_MODIFYSTRING} DT_RTLREADING = $20000; - {$EXTERNALSYM DT_RTLREADING} DT_WORD_ELLIPSIS = $40000; - {$EXTERNALSYM DT_WORD_ELLIPSIS} DT_NOFULLWIDTHCHARBREAK = $0080000; - {$EXTERNALSYM DT_NOFULLWIDTHCHARBREAK} DT_HIDEPREFIX = $00100000; - {$EXTERNALSYM DT_HIDEPREFIX} DT_PREFIXONLY = $00200000; - {$EXTERNALSYM DT_PREFIXONLY} + + + { WM_SIZE message wParam values } + SIZE_RESTORED = 0; + SIZE_MINIMIZED = 1; + SIZE_MAXIMIZED = 2; + SIZE_MAXSHOW = 3; + SIZE_MAXHIDE = 4; type TRect = System.Types.TRectF; @@ -185,11 +140,8 @@ TChangeLink = class(TImageLink) UINT_PTR = Cardinal; //do not change on Int64 //System.UIntPtr; // NativeUInt; WPARAM = UINT_PTR; - {$EXTERNALSYM WPARAM} LPARAM = INT_PTR; - {$EXTERNALSYM LPARAM} LRESULT = INT_PTR; - {$EXTERNALSYM LRESULT} TDWordFiller = record {$IFDEF CPUX64} @@ -351,6 +303,17 @@ TWMKey = record TWMKeyDown = TWMKey; TWMKeyUp = TWMKey; + TWMSize = record //4 + Msg: Cardinal; + //MsgFiller: TDWordFiller; + SizeType: WPARAM; { SIZE_MAXIMIZED, SIZE_MINIMIZED, SIZE_RESTORED, //4 + SIZE_MAXHIDE, SIZE_MAXSHOW } + Width: Single; //4 + Height: Single; //4 + //WidthHeightFiller: TDWordFiller; + Result: LRESULT; //4 + end; + TTextMetric = record tmHeight: Single; //The height (ascent + descent) of characters. tmAscent: Single; //The ascent (units above the base line) of characters. diff --git a/Source/VirtualTrees.pas b/Source/VirtualTrees.pas index 30c056b77..42fbc5533 100644 --- a/Source/VirtualTrees.pas +++ b/Source/VirtualTrees.pas @@ -2364,6 +2364,7 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF FOnEndOperation: TVTOperationEvent; // Called when an operation ends FVclStyleEnabled: Boolean; + FInCreate: Boolean; {$IFDEF VT_FMX} FFont: TFont; FBevelEdges: TBevelEdges; @@ -2546,11 +2547,11 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF procedure WMRButtonUp(var Message: TWMRButtonUp); message WM_RBUTTONUP; procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR; procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS; - procedure WMSize(var Message: TWMSize); message WM_SIZE; procedure WMTimer(var Message: TWMTimer); message WM_TIMER; procedure WMThemeChanged(var Message: TMessage); message WM_THEMECHANGED; procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL; {$ENDIF} + procedure WMSize(var Message: TWMSize); {$IFDEF VT_FMX}virtual;{$ELSE}message WM_SIZE;{$ENDIF} function GetRangeX: TDimension; function GetDoubleBuffered: Boolean; procedure SetDoubleBuffered(const Value: Boolean); @@ -2559,6 +2560,7 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF function GetClientHeight: Single; function GetClientWidth: Single; function GetClientRect: TRect; + procedure Resize; override; {$ENDIF} protected @@ -12406,6 +12408,7 @@ procedure TClipboardFormats.Insert(Index: Integer; const S: string); constructor TBaseVirtualTree.Create(AOwner: TComponent); begin + FInCreate:= true; InitializeGlobalStructures(); inherited; @@ -12530,6 +12533,7 @@ constructor TBaseVirtualTree.Create(AOwner: TComponent); {$IFDEF VT_FMX} PrepareBitmaps(True, True); {$ENDIF} + FInCreate:= false; end; //---------------------------------------------------------------------------------------------------------------------- @@ -13640,11 +13644,30 @@ function TBaseVirtualTree.GetClientWidth: Single; function TBaseVirtualTree.GetClientRect: TRect; begin Result:= ClipRect; - if hoVisible in FHeader.FOptions then - Result.Top:= Result.Top + FHeader.Height; + if Assigned(FHeader) then + begin + if hoVisible in FHeader.FOptions then + Result.Top:= Result.Top + FHeader.Height; + end; if Result.Top>Result.Bottom then Result.Top:= Result.Bottom; end; + +procedure TBaseVirtualTree.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; {$ENDIF} //---------------------------------------------------------------------------------------------------------------------- @@ -18718,7 +18741,7 @@ procedure TBaseVirtualTree.WMSetFocus(var Msg: TWMSetFocus); if (FSelectionCount > 0) or not (toGhostedIfUnfocused in FOptions.FPaintOptions) then Invalidate; end; - +{$ENDIF} //---------------------------------------------------------------------------------------------------------------------- procedure TBaseVirtualTree.WMSize(var Message: TWMSize); @@ -18734,8 +18757,11 @@ procedure TBaseVirtualTree.WMSize(var Message: TWMSize); try DoStateChange([tsSizing]); // This call will invalidate the entire non-client area which needs recalculation on resize. - FHeader.RescaleHeader; - FHeader.UpdateSpringColumns; + if Assigned(FHeader) then + begin + FHeader.RescaleHeader; + FHeader.UpdateSpringColumns; + end; UpdateScrollBars(True); if (tsEditing in FStates) and not FHeader.UseColumns then @@ -18746,7 +18772,7 @@ procedure TBaseVirtualTree.WMSize(var Message: TWMSize); end; //---------------------------------------------------------------------------------------------------------------------- - +{$IFDEF VT_VCL} procedure TBaseVirtualTree.WMThemeChanged(var Message: TMessage); begin @@ -34158,7 +34184,7 @@ procedure TBaseVirtualTree.UpdateVerticalRange; begin // Total node height includes the height of the invisible root node. - FRangeY := {$IFDEF VT_VCL}Cardinal{$ENDIF}({$IFDEF VT_VCL}Int64{$ENDIF}(FRoot.TotalHeight) - FRoot.NodeHeight + FBottomSpace); + FRangeY := FRoot.TotalHeight - FRoot.NodeHeight + FBottomSpace; end; //---------------------------------------------------------------------------------------------------------------------- From 78ff50215cb12bea8b6636429a31c034ba8d0277 Mon Sep 17 00:00:00 2001 From: livius2 Date: Wed, 14 Nov 2018 19:11:00 +0100 Subject: [PATCH 30/61] System checkboxes and Android port - added system checkboxes (Platform specific e.g Android) - add support for Android platform :) --- README.md | 4 +- Source/VirtualTrees.Classes.pas | 23 +-- Source/VirtualTrees.Export.pas | 2 - Source/VirtualTrees.FMX.pas | 292 +++++++++++++++++++++++++++++++- Source/VirtualTrees.Utils.pas | 4 +- Source/VirtualTrees.pas | 18 +- 6 files changed, 322 insertions(+), 21 deletions(-) diff --git a/README.md b/README.md index c47ccb794..d6b1c917a 100644 --- a/README.md +++ b/README.md @@ -12,7 +12,8 @@ What is working: 9. expanding, collapsing by mouse click. 10. mouse cursor and header column resize by mouse. 11. it accept focus, it draw focus rect and unfocussed rect, toExtendedFocus, toFullRowSelect, toHotTrack, toUseBlendedSelection. -12. checkbox support (only with custom imageList). +12. checkbox support system checkboxes (platform specific) + custom checkboxes. +13. support for Android :) What is not working yet: 1. some mouse action like click, drag-drop, mouse move, hover; @@ -21,7 +22,6 @@ What is not working yet: 4. drawing background; 5. some mouse ations on header; 6. inplace editors. -7. system check box support (now only custom checkbox list is working). Current VT is derived from TRectangle. Will be good to have it as presented control with appropiate TDataModel. diff --git a/Source/VirtualTrees.Classes.pas b/Source/VirtualTrees.Classes.pas index bce291001..486dbd101 100644 --- a/Source/VirtualTrees.Classes.pas +++ b/Source/VirtualTrees.Classes.pas @@ -33,8 +33,13 @@ interface {$DEFINE VT_VCL} {$ENDIF} +{$IFDEF MSWINDOWS} uses Winapi.Windows; +{$ELSE} +uses + VirtualTrees.FMX; +{$ENDIF} type // Helper classes to speed up rendering text formats for clipboard and drag'n drop transfers. @@ -68,7 +73,6 @@ TBufferedString = class property AsString: string read GetAsString; end; - implementation //----------------- TBufferedRawByteString ------------------------------------------------------------------------------------ @@ -113,8 +117,8 @@ procedure TBufferedRawByteString.Add(const S: RawByteString); FPosition := FStart + LastOffset; FEnd := FStart + NewLen; end; - Move(PAnsiChar(S)^, FPosition^, Len); - Inc(FPosition, Len); + System.Move(PAnsiChar(S)^, FPosition^, Len); + System.Inc(FPosition, Len); end; //---------------------------------------------------------------------------------------------------------------------- @@ -138,9 +142,9 @@ procedure TBufferedRawByteString.AddNewLine; FEnd := FStart + NewLen; end; FPosition^ := #13; - Inc(FPosition); + System.Inc(FPosition); FPosition^ := #10; - Inc(FPosition); + System.Inc(FPosition); end; //----------------- TBufferedString -------------------------------------------------------------------------------- @@ -184,8 +188,8 @@ procedure TBufferedString.Add(const S: string); FPosition := FStart + LastOffset; FEnd := FStart + NewLen; end; - Move(PWideChar(S)^, FPosition^, 2 * Len); - Inc(FPosition, Len); + System.Move(PWideChar(S)^, FPosition^, 2 * Len); + System.Inc(FPosition, Len); end; //---------------------------------------------------------------------------------------------------------------------- @@ -209,10 +213,9 @@ procedure TBufferedString.AddNewLine; FEnd := FStart + NewLen; end; FPosition^ := #13; - Inc(FPosition); + System.Inc(FPosition); FPosition^ := #10; - Inc(FPosition); + System.Inc(FPosition); end; - end. diff --git a/Source/VirtualTrees.Export.pas b/Source/VirtualTrees.Export.pas index 9f3fb8bdf..0d92d0205 100644 --- a/Source/VirtualTrees.Export.pas +++ b/Source/VirtualTrees.Export.pas @@ -21,7 +21,6 @@ interface VirtualTrees, VirtualTrees.Classes; {$ENDIF} - function ContentToHTML(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceType; const Caption: string = ''): String; function ContentToRTF(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceType): RawByteString; function ContentToUnicodeString(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceType; const Separator: string): string; @@ -31,7 +30,6 @@ function ContentToClipboard(Tree: TCustomVirtualStringTree; Format: Word; Source procedure ContentToCustom(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceType); implementation - uses UITypes; diff --git a/Source/VirtualTrees.FMX.pas b/Source/VirtualTrees.FMX.pas index 4f70b80da..8c8964e96 100644 --- a/Source/VirtualTrees.FMX.pas +++ b/Source/VirtualTrees.FMX.pas @@ -11,7 +11,7 @@ {***********************************************************} interface -uses System.Classes, System.UITypes, System.Types, System.ImageList, FMX.ImgList, FMX.Graphics; +uses System.Classes, System.UITypes, System.Types, System.ImageList, FMX.ImgList, FMX.Graphics, FMX.Controls, FMX.Types; const clBtnFace = TAlphaColor($FFF0F0F0); //TAlphaColorRec.Gray; @@ -126,6 +126,8 @@ interface TFormBorderStyle = (bsNone, bsSingle, bsSizeable, bsDialog, bsToolWindow, bsSizeToolWin); TBorderStyle = TFormBorderStyle.bsNone..TFormBorderStyle.bsSingle; + PAnsiChar = System.MarshaledAString; + TChangeLink = class(TImageLink) private function GetSender: TCustomImageList; inline; @@ -361,8 +363,294 @@ THighQualityBitmap = class(TBitmap) end; procedure FillTWMMouse(Var MM: TWMMouse; Button: TMouseButton; Shift: TShiftState; X: Single; Y: Single; IsNC: Boolean; IsUp: Boolean); + +procedure FillCheckImages(Parent: TFmxObject; List: TImageList); + implementation -uses FMX.TextLayout, System.SysUtils, FMX.Types; +uses FMX.TextLayout, System.SysUtils, FMX.StdCtrls, FMX.MultiResBitmap, FMX.Objects; + +type + TImageListHelper = class helper for TImageList + function Add(aBitmap: TBitmap): integer; + end; + +function TImageListHelper.Add(aBitmap: TBitmap): integer; +const + SCALE = 1; +var + vSource: TCustomSourceItem; + vBitmapItem: TCustomBitmapItem; + vDest: TCustomDestinationItem; + vLayer: TLayer; +begin + Result := -1; + if (aBitmap.Width = 0) or (aBitmap.Height = 0) then exit; + + // add source bitmap + vSource := Source.Add; + vSource.MultiResBitmap.TransparentColor := TColorRec.Fuchsia; + vSource.MultiResBitmap.SizeKind := TSizeKind.Source; + vSource.MultiResBitmap.Width := Round(aBitmap.Width / SCALE); + vSource.MultiResBitmap.Height := Round(aBitmap.Height / SCALE); + vBitmapItem := vSource.MultiResBitmap.ItemByScale(SCALE, True, True); + if vBitmapItem = nil then + begin + vBitmapItem := vSource.MultiResBitmap.Add; + vBitmapItem.Scale := Scale; + end; + vBitmapItem.Bitmap.Assign(aBitmap); + + vDest := Destination.Add; + vLayer := vDest.Layers.Add; + vLayer.SourceRect.Rect := TRectF.Create(TPoint.Zero, vSource.MultiResBitmap.Width, + vSource.MultiResBitmap.Height); + vLayer.Name := vSource.Name; + Result := vDest.Index; +end; + +//---------------------------------------------------------------------------------------------------------------------- +//https://stackoverflow.com/questions/22813461/is-there-an-equivalent-to-floodfill-in-fmx-for-a-tbitmap +procedure Bitmap_FloodFill(fBitmap: TBitmap; StartX,StartY : Integer; FillColor: TAlphaColor); +var + fBitmapData : TBitmapData; + X, Y : Integer; + ReplaceColor : TAlphaColor; + Stack : Array of System.Types.TPoint; + fHeight : Integer; + fWidth : Integer; + + procedure PutInStack(X, Y: Integer); + begin + SetLength(Stack, Length(Stack)+1); + Stack[Length(Stack)-1] := Point(X, Y); + end; + + procedure GetFromStack(var X, Y: Integer); + begin + X := Stack[Length(Stack)-1].X; + Y := Stack[Length(Stack)-1].Y; + SetLength(Stack, Length(Stack)-1); + end; + +begin + X := StartX; + Y := StartY; + fHeight := fBitmap.Height; + fWidth := fBitmap.Width; + if (X >= fWidth) or (Y >= fHeight) then Exit; + + if fBitmap.Map(TMapAccess.ReadWrite,fBitmapData) then + try + ReplaceColor := fBitmapData.GetPixel(X,Y); + if ReplaceColor <> FillColor then + begin + PutInStack(X,Y); + while Length(Stack) > 0 do + begin + GetFromStack(X,Y); + while (X > 0) and (fBitmapData.GetPixel(X-1, Y) = ReplaceColor) do System.Dec(X); + while (X < fWidth) and (fBitmapData.GetPixel(X , Y) = ReplaceColor) do + begin + if Y > 0 then If fBitmapData.GetPixel(X, Y-1) = ReplaceColor then PutInStack(X, Y-1); + if Y+1 < fHeight then If fBitmapData.GetPixel(X, Y+1) = ReplaceColor then PutInStack(X, Y+1); + fBitmapData.SetPixel(X,Y,FillColor); + System.Inc(X); + end; + end; + end; + finally + fBitmap.Canvas.Bitmap.Unmap(fBitmapData); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +{ + ckEmpty = 0; // an empty image used as place holder + // radio buttons + ckRadioUncheckedNormal = 1; + ckRadioUncheckedHot = 2; + ckRadioUncheckedPressed = 3; + ckRadioUncheckedDisabled = 4; + ckRadioCheckedNormal = 5; + ckRadioCheckedHot = 6; + ckRadioCheckedPressed = 7; + ckRadioCheckedDisabled = 8; + // check boxes + ckCheckUncheckedNormal = 9; + ckCheckUncheckedHot = 10; + ckCheckUncheckedPressed = 11; + ckCheckUncheckedDisabled = 12; + ckCheckCheckedNormal = 13; + ckCheckCheckedHot = 14; + ckCheckCheckedPressed = 15; + ckCheckCheckedDisabled = 16; + ckCheckMixedNormal = 17; + ckCheckMixedHot = 18; + ckCheckMixedPressed = 19; + ckCheckMixedDisabled = 20; + // simple button + ckButtonNormal = 21; //??? + ckButtonHot = 22; //??? + ckButtonPressed = 23; //??? + ckButtonDisabled = 24; //??? +} +procedure FillCheckImages(Parent: TFmxObject; List: TImageList); +Var cb: TCheckBox; + rb: TRadioButton; + BMP: TBitmap; + procedure AddCtrlBmp(c: TControl; SaveToFile: Boolean=false); + Var tmpBMP: TBitmap; + begin + tmpBMP:= c.MakeScreenshot; + try + BMP.SetSize(tmpBMP.Height, tmpBMP.Height); + BMP.Clear(TAlphaColorRec.Null); //this somehow can sometimes clear BeginSceneCount + if BMP.Canvas.BeginScene() then + begin + try + BMP.Canvas.DrawBitmap( + tmpBMP + , Rect(0, 0, BMP.Width, BMP.Height) + , Rect(0, 0, BMP.Width, BMP.Height) + , 1.0 + , false + ); + finally + BMP.Canvas.EndScene; + end; + end; + finally + FreeAndNil(tmpBMP); + end; + end; +begin + BMP:= TBitmap.Create; + try + BMP.SetSize(16, 16); + BMP.Clear(TAlphaColorRec.Null); + List.Add(BMP); //ckEmpty + + + rb:= TRadioButton.Create(Parent); + try + rb.Parent:= Parent; + rb.Text:= ' '; + + //------------------IsUnChecked-------------------------- + + rb.IsChecked:= false; + //rb.MakeScreenshot + AddCtrlBmp(rb); + //BMP.SaveToFile('C:\BMP.png'); + List.Add(BMP); //ckRadioUncheckedNormal + List.Add(BMP); //ckRadioUncheckedHot + + //rb.IsPressed:= true; + AddCtrlBmp(rb); + List.Add(BMP); //ckRadioUncheckedPressed + + //rb.IsPressed:= false; + rb.Enabled:= false; + AddCtrlBmp(rb); + List.Add(BMP); //ckRadioUncheckedDisabled + + + //------------------IsChecked--------------------------- + + rb.IsChecked:= true; + + //rb.IsPressed:= false; + rb.Enabled:= true; + AddCtrlBmp(rb); + List.Add(BMP); //ckRadioCheckedNormal + List.Add(BMP); //ckRadioCheckedHot + + //rb.IsPressed:= true; + rb.Enabled:= true; + AddCtrlBmp(rb); + List.Add(BMP); //ckRadioCheckedPressed + + //rb.IsPressed:= false; + rb.Enabled:= false; + AddCtrlBmp(rb); + List.Add(BMP); //ckRadioCheckedDisabled + finally + FreeAndNil(rb); + end; + + cb:= TCheckBox.Create(Parent); + try + cb.Parent:= Parent; + cb.Text:= ' '; + //------------------IsUnChecked-------------------------- + + cb.IsChecked:= false; + + AddCtrlBmp(cb); + + List.Add(BMP); //ckCheckUncheckedNormal + List.Add(BMP); //ckCheckUncheckedHot + + //cb.IsPressed:= true; + AddCtrlBmp(cb); + List.Add(BMP); //ckCheckUncheckedPressed + + //cb.IsPressed:= false; + cb.Enabled:= false; + AddCtrlBmp(cb); + List.Add(BMP); //ckCheckUncheckedDisabled + + //------------------IsChecked--------------------------- + + cb.IsChecked:= true; + + //cb.IsPressed:= false; + cb.Enabled:= true; + AddCtrlBmp(cb); + List.Add(BMP); //ckCheckCheckedNormal + List.Add(BMP); //ckCheckCheckedHot + + //cb.IsPressed:= true; + cb.Enabled:= true; + AddCtrlBmp(cb); + List.Add(BMP); //ckCheckCheckedPressed + + //cb.IsPressed:= false; + cb.Enabled:= false; + AddCtrlBmp(cb); + List.Add(BMP); //ckCheckCheckedDisabled + + //------------------Mixed--------------------------- + + //how to support mixed style? + //maybe draw unchecked and fill in the center of bitmap??? + //i use teal for fill + + cb.IsChecked:= false; + + AddCtrlBmp(cb); + Bitmap_FloodFill(BMP, BMP.Width div 2, BMP.Height div 2, $FF009191{TAlphaColorRec.Teal}); + List.Add(BMP); //ckCheckMixedNormal + List.Add(BMP); //ckCheckMixedHot + + //cb.IsPressed:= true; + AddCtrlBmp(cb); + Bitmap_FloodFill(BMP, BMP.Width div 2, BMP.Height div 2, $FF009191{TAlphaColorRec.Teal}); + List.Add(BMP); //ckCheckMixedPressed + + //cb.IsPressed:= false; + cb.Enabled:= false; + AddCtrlBmp(cb); + Bitmap_FloodFill(BMP, BMP.Width div 2, BMP.Height div 2, $FF009191{TAlphaColorRec.Teal}); + List.Add(BMP); //ckCheckMixedDisabled + finally + FreeAndNil(cb); + end; + finally + FreeAndNil(BMP); + end; +end; //---------------------------------------------------------------------------------------------------------------------- diff --git a/Source/VirtualTrees.Utils.pas b/Source/VirtualTrees.Utils.pas index 7491e56ee..b6286a126 100644 --- a/Source/VirtualTrees.Utils.pas +++ b/Source/VirtualTrees.Utils.pas @@ -486,7 +486,7 @@ function WrapString(ACanvas: TCanvas; const S: string; const Bounds: TRect; RTL: //---------------------------------------------------------------------------------------------------------------------- - +{$IFDEF VT_VCL} function CalculateScanline(Bits: Pointer; Width, Height, Row: Integer): Pointer; // Helper function to calculate the start address for the given row. @@ -501,7 +501,7 @@ function CalculateScanline(Bits: Pointer; Width, Height, Row: Integer): Pointer; //---------------------------------------------------------------------------------------------------------------------- -{$IFDEF VT_VCL} + function GetBitmapBitsFromDeviceContext(ACanvas: TCanvas; var Width, Height: Integer): Pointer; // Helper function used to retrieve the bitmap selected into the given device context. If there is a bitmap then diff --git a/Source/VirtualTrees.pas b/Source/VirtualTrees.pas index 42fbc5533..01f25c4c4 100644 --- a/Source/VirtualTrees.pas +++ b/Source/VirtualTrees.pas @@ -4624,7 +4624,7 @@ procedure InitializeGlobalStructures(); // This watcher is used whenever a global structure could be modified by more than one thread. gWatcher := TCriticalSection.Create(); - IsWinVistaOrAbove := (Win32MajorVersion >= 6); + IsWinVistaOrAbove := {$IFDEF MSWINDOWS}(Win32MajorVersion >= 6){$ELSE}false{$ENDIF}; // Initialize OLE subsystem for drag'n drop and clipboard operations. NeedToUnitialize := {$IFDEF VT_FMX}false{$ELSE}not IsLibrary and Succeeded(OleInitialize(nil)){$ENDIF}; @@ -4646,10 +4646,15 @@ procedure InitializeGlobalStructures(); with UtilityImages do Handle := ImageList_Create(UtilityImageSize, UtilityImageSize, Flags, 0, AllocBy); ConvertImageList(UtilityImages, 'VT_UTILITIES'); +{$ENDIF} +{$IFDEF VT_FMX} + SystemCheckImages:= TImageList.Create(nil); +{$ELSE} CreateSystemImageSet(0, SystemCheckImages, Flags, False); {$ENDIF} + // Delphi (at least version 6 and lower) does not provide a standard split cursor. // Hence we have to load our own. {$IFDEF VT_VCL} @@ -11728,7 +11733,7 @@ procedure TVTHeader.LoadFromStream(const Stream: TStream); var Dummy, Version: Integer; - S: AnsiString; + S: {$IFDEF MSWINDOWS}AnsiString{$ELSE}String{$ENDIF}; OldOptions: TVTHeaderOptions; begin @@ -12022,7 +12027,7 @@ procedure TVTHeader.SaveToStream(const Stream: TStream); {$IFDEF VT_FMX} DummySingle: Single; {$ENDIF} - Tmp: AnsiString; + Tmp: {$IFDEF MSWINDOWS}AnsiString{$ELSE}String{$ENDIF}; begin with Stream do @@ -12474,6 +12479,7 @@ constructor TBaseVirtualTree.Create(AOwner: TComponent); inherited DoubleBuffered := False; {$ENDIF} FCheckImageKind := ckSystemDefault; + FCheckImages := SystemCheckImages; FImageChangeLink := TChangeLink.Create; @@ -25006,6 +25012,10 @@ procedure TBaseVirtualTree.Paint; RTLOffset: TDimension; begin +{$IFDEF VT_FMX} + if SystemCheckImages.Count=0 then + FillCheckImages(Self, SystemCheckImages); +{$ENDIF} Options := [poBackground, poColumnColor, poDrawFocusRect, poDrawDropMark, poDrawSelection, poGridLines]; {$IFDEF VT_FMX} @@ -26694,8 +26704,10 @@ procedure TBaseVirtualTree.UpdateDesigner; {$ELSE} ParentForm := GetParentForm(Self); {$ENDIF} +{$IFDEF MSWINDOWS} if Assigned(ParentForm) and Assigned(ParentForm.Designer) then ParentForm.Designer.Modified; +{$ENDIF} end; end; From 6c78b76300061c9c6370414a408fb476726e3dc3 Mon Sep 17 00:00:00 2001 From: livius2 Date: Wed, 14 Nov 2018 19:21:37 +0100 Subject: [PATCH 31/61] code cleanup --- Source/VirtualTrees.FMX.pas | 67 +++++++++++++++++++++++-------------- Source/VirtualTrees.pas | 3 +- 2 files changed, 43 insertions(+), 27 deletions(-) diff --git a/Source/VirtualTrees.FMX.pas b/Source/VirtualTrees.FMX.pas index 8c8964e96..ff8805fcc 100644 --- a/Source/VirtualTrees.FMX.pas +++ b/Source/VirtualTrees.FMX.pas @@ -13,6 +13,20 @@ interface uses System.Classes, System.UITypes, System.Types, System.ImageList, FMX.ImgList, FMX.Graphics, FMX.Controls, FMX.Types; +//-------- type aliasing ------------------------------------------------------------------------------------------------------------------- + +type + TRect = System.Types.TRectF; + PRect = System.Types.PRectF; + TPoint = System.Types.TPointF; + PPoint = System.Types.PPointF; + PSize = System.Types.PSizeF; + TSize = System.Types.TSizeF; + TColor = System.UITypes.TAlphaColor; + PAnsiChar = System.MarshaledAString; + +//------- color aliasing ------------------------------------------------------------------------------------------------------------------- + const clBtnFace = TAlphaColor($FFF0F0F0); //TAlphaColorRec.Gray; clBtnText = TAlphaColorRec.Black; @@ -30,6 +44,8 @@ interface clBlue = TAlphaColorRec.Blue; clGrayText = TAlphaColorRec.DkGray; +//------- needed for migration ------------------------------------------------------------------------------------------------------------- + const { 3D border styles } BDR_RAISEDOUTER = 1; @@ -106,16 +122,8 @@ interface SIZE_MAXIMIZED = 2; SIZE_MAXSHOW = 3; SIZE_MAXHIDE = 4; - -type - TRect = System.Types.TRectF; - PRect = System.Types.PRectF; - TPoint = System.Types.TPointF; - PPoint = System.Types.PPointF; - PSize = System.Types.PSizeF; - TSize = System.Types.TSizeF; - TColor = System.UITypes.TAlphaColor; +type TBorderWidth = Single; TBevelCut = (bvNone, bvLowered, bvRaised, bvSpace); TBevelEdge = (beLeft, beTop, beRight, beBottom); @@ -126,7 +134,7 @@ interface TFormBorderStyle = (bsNone, bsSingle, bsSizeable, bsDialog, bsToolWindow, bsSizeToolWin); TBorderStyle = TFormBorderStyle.bsNone..TFormBorderStyle.bsSingle; - PAnsiChar = System.MarshaledAString; + TChangeLink = class(TImageLink) private @@ -151,6 +159,8 @@ TDWordFiller = record {$ENDIF} end; +//--------- Windows messages simulations --------------------------------------------------------------------------------------------------- + const WM_MOUSEFIRST = $0200; WM_MOUSEMOVE = $0200; @@ -316,6 +326,10 @@ TWMSize = record //4 Result: LRESULT; //4 end; +procedure FillTWMMouse(Var MM: TWMMouse; Button: TMouseButton; Shift: TShiftState; X: Single; Y: Single; IsNC: Boolean; IsUp: Boolean); + +//--------- Text metrics ------------------------------------------------------------------------------------------------------------------- +type TTextMetric = record tmHeight: Single; //The height (ascent + descent) of characters. tmAscent: Single; //The ascent (units above the base line) of characters. @@ -339,18 +353,20 @@ TTextMetric = record tmCharSet: Byte; //The character set of the font. The character set can be one of the following values. ANSI_CHARSET, GREEK_CHARSET.... end; procedure GetTextMetrics(ACanvas: TCanvas; var TM: TTextMetric); - function Rect(ALeft, ATop, ARight, ABottom: Single): TRect; overload; inline; - function Rect(const ATopLeft, ABottomRight: TPoint): TRect; overload; inline; - function Point(AX, AY: Single): TPoint; overload; inline; - - procedure Inc(Var V: Single; OIle: Single=1.0); overload; - procedure Dec(Var V: Single; OIle: Single=1.0); overload; - function MulDiv(const A, B, C: Single): Single; overload; - procedure FillMemory(Destination: Pointer; Length: NativeUInt; Fill: Byte); - procedure ZeroMemory(Destination: Pointer; Length: NativeUInt); - procedure MoveMemory(Destination: Pointer; Source: Pointer; Length: NativeUInt); - procedure CopyMemory(Destination: Pointer; Source: Pointer; Length: NativeUInt); - + +//-------- function aliassing -------------------------------------------------------------------------------------------------------------- + +function Rect(ALeft, ATop, ARight, ABottom: Single): TRect; overload; inline; +function Rect(const ATopLeft, ABottomRight: TPoint): TRect; overload; inline; +function Point(AX, AY: Single): TPoint; overload; inline; + +procedure Inc(Var V: Single; OIle: Single=1.0); overload; +procedure Dec(Var V: Single; OIle: Single=1.0); overload; +function MulDiv(const A, B, C: Single): Single; overload; +procedure FillMemory(Destination: Pointer; Length: NativeUInt; Fill: Byte); +procedure ZeroMemory(Destination: Pointer; Length: NativeUInt); +procedure MoveMemory(Destination: Pointer; Source: Pointer; Length: NativeUInt); +procedure CopyMemory(Destination: Pointer; Source: Pointer; Length: NativeUInt); procedure DrawTextW(ACanvas: TCanvas; CaptionText: String; Len: Integer; Bounds: TRect; DrawFormat: Cardinal{this is windows format - must be converted to FMX}); procedure GetTextExtentPoint32W(ACanvas: TCanvas; CaptionText: String; Len: Integer; Var Size: TSize); @@ -362,9 +378,8 @@ THighQualityBitmap = class(TBitmap) constructor Create; override; end; -procedure FillTWMMouse(Var MM: TWMMouse; Button: TMouseButton; Shift: TShiftState; X: Single; Y: Single; IsNC: Boolean; IsUp: Boolean); - -procedure FillCheckImages(Parent: TFmxObject; List: TImageList); +//fill system images +procedure FillSystemCheckImages(Parent: TFmxObject; List: TImageList); implementation uses FMX.TextLayout, System.SysUtils, FMX.StdCtrls, FMX.MultiResBitmap, FMX.Objects; @@ -495,7 +510,7 @@ procedure Bitmap_FloodFill(fBitmap: TBitmap; StartX,StartY : Integer; FillColor: ckButtonPressed = 23; //??? ckButtonDisabled = 24; //??? } -procedure FillCheckImages(Parent: TFmxObject; List: TImageList); +procedure FillSystemCheckImages(Parent: TFmxObject; List: TImageList); Var cb: TCheckBox; rb: TRadioButton; BMP: TBitmap; diff --git a/Source/VirtualTrees.pas b/Source/VirtualTrees.pas index 01f25c4c4..39662f65a 100644 --- a/Source/VirtualTrees.pas +++ b/Source/VirtualTrees.pas @@ -25013,8 +25013,9 @@ procedure TBaseVirtualTree.Paint; begin {$IFDEF VT_FMX} + //it must be in paint - without this images are empty if SystemCheckImages.Count=0 then - FillCheckImages(Self, SystemCheckImages); + FillSystemCheckImages(Self, SystemCheckImages); {$ENDIF} Options := [poBackground, poColumnColor, poDrawFocusRect, poDrawDropMark, poDrawSelection, poGridLines]; From a06e055cde01fcc2fed763729d6bfa42262481cb Mon Sep 17 00:00:00 2001 From: livius2 Date: Wed, 14 Nov 2018 23:27:03 +0100 Subject: [PATCH 32/61] added Hot and Selected plus/minus buttons - fixed drawing plus/minus buttons when toFullRowSelect - added Hot and Selected plus/minus buttons. --- README.md | 10 ++-- Source/VirtualTrees.pas | 109 +++++++++++++++++++++++++++++++--------- 2 files changed, 90 insertions(+), 29 deletions(-) diff --git a/README.md b/README.md index d6b1c917a..27563e7a5 100644 --- a/README.md +++ b/README.md @@ -14,14 +14,16 @@ What is working: 11. it accept focus, it draw focus rect and unfocussed rect, toExtendedFocus, toFullRowSelect, toHotTrack, toUseBlendedSelection. 12. checkbox support system checkboxes (platform specific) + custom checkboxes. 13. support for Android :) +14. "hot" and "selected" plus/minus buttons. What is not working yet: -1. some mouse action like click, drag-drop, mouse move, hover; +1. some mouse action; 2. clipboard; -3. drawing and supoport of tree border; +3. drawing and support of tree border; 4. drawing background; -5. some mouse ations on header; -6. inplace editors. +5. some mouse actions on header; +6. inplace editors; +8. scrollbars/scrolling. Current VT is derived from TRectangle. Will be good to have it as presented control with appropiate TDataModel. diff --git a/Source/VirtualTrees.pas b/Source/VirtualTrees.pas index 39662f65a..bb9949308 100644 --- a/Source/VirtualTrees.pas +++ b/Source/VirtualTrees.pas @@ -14623,18 +14623,46 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean); end; {$IFDEF VT_FMX} - FHotMinusBM.Canvas.DrawBitmap(//###!!! - FMinusBM - , RectF(0, 0, FMinusBM.Width, FMinusBM.Height) - , RectF(0, 0, FMinusBM.Width, FMinusBM.Height) - , 1.0 - ); - FSelectedHotMinusBM.Canvas.DrawBitmap(//###!!! - FMinusBM - , RectF(0, 0, FMinusBM.Width, FMinusBM.Height) - , RectF(0, 0, FMinusBM.Width, FMinusBM.Height) - , 1.0 - ); + if FHotMinusBM.Canvas.BeginScene() then + try + FHotMinusBM.Canvas.DrawBitmap(//###!!! + FMinusBM + , RectF(0, 0, FMinusBM.Width, FMinusBM.Height) + , RectF(0, 0, FMinusBM.Width, FMinusBM.Height) + , 1.0 + ); + AlphaBlend( + FHotMinusBM.Canvas + , FHotMinusBM.Canvas + , Rect(0, 0, FHotMinusBM.Width, FHotMinusBM.Height) + , Point(0, 0) + , TBlendMode.bmConstantAlphaAndColor + , 40 + , TAlphaColorRec.White + ); + finally + FHotMinusBM.Canvas.EndScene(); + end; + if FSelectedHotMinusBM.Canvas.BeginScene() then + try + FSelectedHotMinusBM.Canvas.DrawBitmap(//###!!! + FMinusBM + , RectF(0, 0, FMinusBM.Width, FMinusBM.Height) + , RectF(0, 0, FMinusBM.Width, FMinusBM.Height) + , 1.0 + ); + AlphaBlend( + FSelectedHotMinusBM.Canvas + , FSelectedHotMinusBM.Canvas + , Rect(0, 0, FSelectedHotMinusBM.Width, FSelectedHotMinusBM.Height) + , Point(0, 0) + , TBlendMode.bmConstantAlphaAndColor + , 40 + , TAlphaColorRec.Blue + ); + finally + FSelectedHotMinusBM.Canvas.EndScene(); + end; {$ELSE} FHotMinusBM.Canvas.Draw(0, 0, FMinusBM); FSelectedHotMinusBM.Canvas.Draw(0, 0, FMinusBM); @@ -14706,19 +14734,47 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean); end; end; {$IFDEF VT_FMX} - FHotPlusBM.Canvas.DrawBitmap(//###!!! - FMinusBM - , Rect(0, 0, FMinusBM.Width, FMinusBM.Height) - , Rect(0, 0, FMinusBM.Width, FMinusBM.Height) - , 1.0 - ); - - FSelectedHotPlusBM.Canvas.DrawBitmap(//###!!! - FPlusBM - , Rect(0, 0, FPlusBM.Width, FPlusBM.Height) - , Rect(0, 0, FPlusBM.Width, FPlusBM.Height) - , 1.0 - ); + if FHotPlusBM.Canvas.BeginScene() then + try + FHotPlusBM.Canvas.DrawBitmap(//###!!! + FPlusBM + , Rect(0, 0, FPlusBM.Width, FPlusBM.Height) + , Rect(0, 0, FPlusBM.Width, FPlusBM.Height) + , 1.0 + ); + AlphaBlend( + FHotPlusBM.Canvas + , FHotPlusBM.Canvas + , Rect(0, 0, FHotPlusBM.Width, FHotPlusBM.Height) + , Point(0, 0) + , TBlendMode.bmConstantAlphaAndColor + , 40 + , TAlphaColorRec.White + ); + finally + FHotPlusBM.Canvas.EndScene(); + end; + + if FSelectedHotPlusBM.Canvas.BeginScene() then + try + FSelectedHotPlusBM.Canvas.DrawBitmap(//###!!! + FPlusBM + , Rect(0, 0, FPlusBM.Width, FPlusBM.Height) + , Rect(0, 0, FPlusBM.Width, FPlusBM.Height) + , 1.0 + ); + AlphaBlend( + FSelectedHotPlusBM.Canvas + , FSelectedHotPlusBM.Canvas + , Rect(0, 0, FSelectedHotPlusBM.Width, FSelectedHotPlusBM.Height) + , Point(0, 0) + , TBlendMode.bmConstantAlphaAndColor + , 40 + , TAlphaColorRec.Blue + ); + finally + FSelectedHotPlusBM.Canvas.EndScene(); + end; {$ELSE} FHotPlusBM.Canvas.Draw(0, 0, FPlusBM); FSelectedHotPlusBM.Canvas.Draw(0, 0, FPlusBM); @@ -34073,6 +34129,9 @@ procedure TBaseVirtualTree.ToggleNode(Node: PVirtualNode); if not TogglingTree then DoStateChange([], [tsToggling]); end; +{$IFDEF VT_FMX} + Repaint; //prevent hide of +/- buttons +{$ENDIF} end; end; From 0c4110ba57963b04a806a8fa96ae25c658d3bf08 Mon Sep 17 00:00:00 2001 From: livius2 Date: Thu, 15 Nov 2018 08:04:43 +0100 Subject: [PATCH 33/61] GreedLines now have dedicated brush - added dedicated brush for drawing GridLines because FMX do not support same convention of pattern brush as Windows --- Source/VirtualTrees.pas | 157 +++++++++++++++++++++++++--------------- 1 file changed, 97 insertions(+), 60 deletions(-) diff --git a/Source/VirtualTrees.pas b/Source/VirtualTrees.pas index bb9949308..d974e27eb 100644 --- a/Source/VirtualTrees.pas +++ b/Source/VirtualTrees.pas @@ -625,7 +625,7 @@ TCheckStateHelper = record helper for TCheckState coShowDropmark, coVisible, coAllowFocus, coEditable, coStyleColor]; type - TBaseVirtualTree = class; + TBaseVirtualTree = class; //forward TVirtualTreeClass = class of TBaseVirtualTree; PVirtualNode = ^TVirtualNode; @@ -2122,7 +2122,14 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF FButtonFillMode: TVTButtonFillMode; // for rectangular tree buttons only: how to fill them FLineStyle: TVTLineStyle; // style of the tree lines FLineMode: TVTLineMode; // tree lines or bands etc. - FDottedBrush: {$IFDEF VT_FMX}TStrokeBrush{$ELSE}HBRUSH{$ENDIF}; // used to paint dotted lines without special pens + {$IFDEF VT_FMX} + FDottedBrush: TStrokeBrush; // used to paint dotted lines without special pens + FDottedBrushGrid: TStrokeBrush; // used to paint dotted lines without special pens + {$ELSE} + FDottedBrush: HBRUSH; // used to paint dotted lines without special pens + {$ENDIF} + + FSelectionCurveRadius: Cardinal; // radius for rounded selection rectangles FSelectionBlendFactor: Byte; // Determines the factor by which the selection rectangle is to be // faded if enabled. @@ -2392,7 +2399,7 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF NewRect: TRect): Boolean; procedure ClearNodeBackground(const PaintInfo: TVTPaintInfo; UseBackground, Floating: Boolean; R: TRect); function CompareNodePositions(Node1, Node2: PVirtualNode; ConsiderChildrenAbove: Boolean = False): Integer; - procedure DrawLineImage(const PaintInfo: TVTPaintInfo; X, Y, H, VAlign: TDimension; Style: TVTLineType; Reverse: Boolean); + procedure DrawLineImage(const PaintInfo: TVTPaintInfo; X, Y, H, VAlign: TDimension; Style: TVTLineType; Reverse: Boolean{$IFDEF VT_FMX}; dottedBrush: TBrush{$ENDIF}); function FindInPositionCache(Node: PVirtualNode; var CurrentPos: TDimension): PVirtualNode; overload; function FindInPositionCache(Position: TDimension; var CurrentPos: TDimension): PVirtualNode; overload; procedure FixupTotalCount(Node: PVirtualNode); @@ -2745,8 +2752,8 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF procedure DragLeave; virtual; function DragOver(Source: TObject; KeyState: Integer; DragState: TDragState; Pt: TPoint; var Effect: Integer): HResult; reintroduce; virtual; - procedure DrawDottedHLine(const PaintInfo: TVTPaintInfo; Left, Right, Top: TDimension); virtual; - procedure DrawDottedVLine(const PaintInfo: TVTPaintInfo; Top, Bottom, Left: TDimension; UseSelectedBkColor: Boolean = False); virtual; + procedure DrawDottedHLine(const PaintInfo: TVTPaintInfo; Left, Right, Top: TDimension{$IFDEF VT_FMX}; dottedBrush: TBrush{$ENDIF}); virtual; + procedure DrawDottedVLine(const PaintInfo: TVTPaintInfo; Top, Bottom, Left: TDimension{$IFDEF VT_FMX}; dottedBrush: TBrush{$ENDIF}; UseSelectedBkColor: Boolean = False); virtual; procedure EndOperation(OperationKind: TVTOperationKind); procedure EnsureNodeFocused(); virtual; function FindNodeInSelection(P: PVirtualNode; var Index: Integer; LowBound, HighBound: Integer): Boolean; virtual; @@ -12326,12 +12333,23 @@ procedure TVTColors.SetColor(const Index: Integer; const Value: TColor); begin // Cause helper bitmap rebuild if the button color changed. case Index of - 5: + 4: // GridLineColor begin - FOwner.PrepareBitmaps(True, False); +{$IFDEF VT_FMX} + FOwner.PrepareBitmaps(False, True); +{$ENDIF} + FOwner.Invalidate; + end; + 5: // TreeLineColor + begin +{$IFDEF VT_FMX} + FOwner.PrepareBitmaps(False, True); +{$ELSE} + FOwner.PrepareBitmaps(True, False); //TODO: Is this valid for VCL? Why here are not NeedLines=True? +{$ENDIF} FOwner.Invalidate; end; - 7: + 7: // BorderColor {$IFDEF VT_FMX} FOwner.Repaint; {$ELSE} @@ -12593,6 +12611,8 @@ destructor TBaseVirtualTree.Destroy; {$IFDEF VT_FMX} if FDottedBrush <> nil then FreeAndNil(FDottedBrush); + if FDottedBrushGrid <> nil then + FreeAndNil(FDottedBrushGrid); FreeAndNil(FFont); {$ELSE} if FDottedBrush <> 0 then @@ -13389,7 +13409,7 @@ function TBaseVirtualTree.CompareNodePositions(Node1, Node2: PVirtualNode; Consi //---------------------------------------------------------------------------------------------------------------------- procedure TBaseVirtualTree.DrawLineImage(const PaintInfo: TVTPaintInfo; X, Y, H, VAlign: TDimension; Style: TVTLineType; - Reverse: Boolean); + Reverse: Boolean{$IFDEF VT_FMX}; dottedBrush: TBrush{$ENDIF}); // Draws (depending on Style) one of the 5 line types of the tree. // If Reverse is True then a right-to-left column is being drawn, hence horizontal lines must be mirrored. @@ -13411,38 +13431,38 @@ procedure TBaseVirtualTree.DrawLineImage(const PaintInfo: TVTPaintInfo; X, Y, H, case Style of ltBottomRight: begin - DrawDottedVLine(PaintInfo, Y + VAlign, Y + H, X + HalfWidth); - DrawDottedHLine(PaintInfo, X + HalfWidth, X + TargetX, Y + VAlign); + DrawDottedVLine(PaintInfo, Y + VAlign, Y + H, X + HalfWidth{$IFDEF VT_FMX}, dottedBrush{$ENDIF}); + DrawDottedHLine(PaintInfo, X + HalfWidth, X + TargetX, Y + VAlign{$IFDEF VT_FMX}, dottedBrush{$ENDIF}); end; ltTopDown: - DrawDottedVLine(PaintInfo, Y, Y + H, X + HalfWidth); + DrawDottedVLine(PaintInfo, Y, Y + H, X + HalfWidth{$IFDEF VT_FMX}, dottedBrush{$ENDIF}); ltTopDownRight: begin - DrawDottedVLine(PaintInfo, Y, Y + H, X + HalfWidth); - DrawDottedHLine(PaintInfo, X + HalfWidth, X + TargetX, Y + VAlign); + DrawDottedVLine(PaintInfo, Y, Y + H, X + HalfWidth{$IFDEF VT_FMX}, dottedBrush{$ENDIF}); + DrawDottedHLine(PaintInfo, X + HalfWidth, X + TargetX, Y + VAlign{$IFDEF VT_FMX}, dottedBrush{$ENDIF}); end; ltRight: - DrawDottedHLine(PaintInfo, X + HalfWidth, X + TargetX, Y + VAlign); + DrawDottedHLine(PaintInfo, X + HalfWidth, X + TargetX, Y + VAlign{$IFDEF VT_FMX}, dottedBrush{$ENDIF}); ltTopRight: begin - DrawDottedVLine(PaintInfo, Y, Y + VAlign, X + HalfWidth); - DrawDottedHLine(PaintInfo, X + HalfWidth, X + TargetX, Y + VAlign); + DrawDottedVLine(PaintInfo, Y, Y + VAlign, X + HalfWidth{$IFDEF VT_FMX}, dottedBrush{$ENDIF}); + DrawDottedHLine(PaintInfo, X + HalfWidth, X + TargetX, Y + VAlign{$IFDEF VT_FMX}, dottedBrush{$ENDIF}); end; ltLeft: // left can also mean right for RTL context if Reverse then - DrawDottedVLine(PaintInfo, Y, Y + H, X + FIndent) + DrawDottedVLine(PaintInfo, Y, Y + H, X + FIndent{$IFDEF VT_FMX}, dottedBrush{$ENDIF}) else - DrawDottedVLine(PaintInfo, Y, Y + H, X); + DrawDottedVLine(PaintInfo, Y, Y + H, X{$IFDEF VT_FMX}, dottedBrush{$ENDIF}); ltLeftBottom: if Reverse then begin - DrawDottedVLine(PaintInfo, Y, Y + H, X + FIndent); - DrawDottedHLine(PaintInfo, X, X + FIndent, Y + H); + DrawDottedVLine(PaintInfo, Y, Y + H, X + FIndent{$IFDEF VT_FMX}, dottedBrush{$ENDIF}); + DrawDottedHLine(PaintInfo, X, X + FIndent, Y + H{$IFDEF VT_FMX}, dottedBrush{$ENDIF}); end else begin - DrawDottedVLine(PaintInfo, Y, Y + H, X); - DrawDottedHLine(PaintInfo, X, X + FIndent, Y + H); + DrawDottedVLine(PaintInfo, Y, Y + H, X{$IFDEF VT_FMX}, dottedBrush{$ENDIF}); + DrawDottedHLine(PaintInfo, X, X + FIndent, Y + H{$IFDEF VT_FMX}, dottedBrush{$ENDIF}); end; end; end; @@ -14463,6 +14483,7 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean); Theme: Integer; BitmapData: TBitmapData; DestPitch: Integer; + i_bmp: Integer; {$ELSE} Theme: HTHEME; {$ENDIF} @@ -14819,6 +14840,7 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean); begin {$IFDEF VT_FMX} FreeAndNil(FDottedBrush); + FreeAndNil(FDottedBrushGrid); {$ELSE} if FDottedBrush <> 0 then DeleteObject(FDottedBrush); @@ -14840,38 +14862,53 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean); LineLen:= Length(LineBitsDotted); //??? what if custom end; {$IFDEF VT_FMX} - PatternBitmap := TBitmap.Create(8, LineLen); //###!!! CreateBitmap(8, 8, 1, 1, Bits); - PatternBitmap.Clear($00FF00FF); //fully transparent - PatternBitmap.Canvas.BeginScene; + for i_bmp:= 1 to 2 do + begin + PatternBitmap := TBitmap.Create(8, LineLen); //###!!! CreateBitmap(8, 8, 1, 1, Bits); + PatternBitmap.Clear(TAlphaColorRec.Null); //fully transparent + PatternBitmap.Canvas.BeginScene; - PatternBitmap.Map(TMapAccess.Write, BitmapData); - try - { - //AlphaColorToPixel PixelToAlphaColor ScanlineToAlphaColor - DestPitch := PixelFormatBytes[PatternBitmap.PixelFormat]; - System.Move(PAlphaColorArray(BitmapData.Data)[0], PAlphaColorArray(Bits)[0], 8 * 4); - } - for line:= 0 to LineLen-1 do - begin - for bit:= 0 to 7 do + PatternBitmap.Map(TMapAccess.Write, BitmapData); + try + { + //AlphaColorToPixel PixelToAlphaColor ScanlineToAlphaColor + DestPitch := PixelFormatBytes[PatternBitmap.PixelFormat]; + System.Move(PAlphaColorArray(BitmapData.Data)[0], PAlphaColorArray(Bits)[0], 8 * 4); + } + for line:= 0 to LineLen-1 do begin - if PWordArray(Bits)^[line] and (1 shl bit)=0 then - BitmapData.SetPixel(bit, line, clWhite) else - BitmapData.SetPixel(bit, line, FColors.TreeLineColor); + for bit:= 0 to 7 do + begin + if PWordArray(Bits)^[line] and (1 shl bit)=0 then + BitmapData.SetPixel(bit, line, clWhite) else + begin + if i_bmp=1 then + BitmapData.SetPixel(bit, line, FColors.TreeLineColor) else + BitmapData.SetPixel(bit, line, FColors.GridLineColor); + end; + end; end; + finally + PatternBitmap.UnMap(BitmapData); end; - finally - PatternBitmap.UnMap(BitmapData); - end; - PatternBitmap.Canvas.EndScene; + PatternBitmap.Canvas.EndScene; - //FMX pattern brush is different then VCL. Where color is derived from current one... - //We should have 2 brushes 1 for Tree lines 1 for grid lines - //and recreate it every time when color is changing - FDottedBrush := TStrokeBrush.Create(TBrushKind.Bitmap, clWhite); //###!!! CreatePatternBrush(PatternBitmap) - FDottedBrush.Bitmap.Bitmap.Assign(PatternBitmap); - FreeAndNil(PatternBitmap); + //FMX pattern brush is different then VCL. Where color is derived from current one... + //We should have 2 brushes 1 for Tree lines 1 for grid lines + //and recreate it every time when color is changing + if i_bmp=1 then + begin + FDottedBrush := TStrokeBrush.Create(TBrushKind.Bitmap, clWhite); //###!!! CreatePatternBrush(PatternBitmap) + FDottedBrush.Bitmap.Bitmap.Assign(PatternBitmap); + end else + begin + FDottedBrushGrid := TStrokeBrush.Create(TBrushKind.Bitmap, clWhite); //###!!! CreatePatternBrush(PatternBitmap) + FDottedBrushGrid.Bitmap.Bitmap.Assign(PatternBitmap); + end; + FreeAndNil(PatternBitmap); + end; + (* FDottedBrush := TStrokeBrush.Create(TBrushKind.Solid, {FColors.GridLineColor}clBlue); //###!!! CreatePatternBrush(PatternBitmap) (FDottedBrush as TStrokeBrush).Dash:= TStrokeDash.Dot; @@ -22537,7 +22574,7 @@ function TBaseVirtualTree.DragOver(Source: TObject; KeyState: Integer; DragState //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.DrawDottedHLine(const PaintInfo: TVTPaintInfo; Left, Right, Top: TDimension); +procedure TBaseVirtualTree.DrawDottedHLine(const PaintInfo: TVTPaintInfo; Left, Right, Top: TDimension{$IFDEF VT_FMX}; dottedBrush: TBrush{$ENDIF}); // Draws a horizontal line with alternating pixels (this style is not supported for pens under Win9x). @@ -22550,7 +22587,7 @@ procedure TBaseVirtualTree.DrawDottedHLine(const PaintInfo: TVTPaintInfo; Left, {$IFDEF VT_FMX} Fill.Color := FColors.BackGroundColor; R := Rect(Min(Left, Right), Top, Max(Left, Right) + 1, Top + 1); - FillRect(R, 0, 0, [], 1.0, FDottedBrush); + FillRect(R, 0, 0, [], 1.0, dottedBrush); {$ELSE} Brush.Color := FColors.BackGroundColor; R := Rect(Min(Left, Right), Top, Max(Left, Right) + 1, Top + 1); @@ -22561,7 +22598,7 @@ procedure TBaseVirtualTree.DrawDottedHLine(const PaintInfo: TVTPaintInfo; Left, //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.DrawDottedVLine(const PaintInfo: TVTPaintInfo; Top, Bottom, Left: TDimension; UseSelectedBkColor: Boolean = False); +procedure TBaseVirtualTree.DrawDottedVLine(const PaintInfo: TVTPaintInfo; Top, Bottom, Left: TDimension{$IFDEF VT_FMX}; dottedBrush: TBrush{$ENDIF}; UseSelectedBkColor: Boolean = False); // Draws a horizontal line with alternating pixels (this style is not supported for pens under Win9x). @@ -22582,7 +22619,7 @@ procedure TBaseVirtualTree.DrawDottedVLine(const PaintInfo: TVTPaintInfo; Top, B {$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := FColors.BackGroundColor; R := Rect(Left, Min(Top, Bottom), Left + 1, Max(Top, Bottom) + 1); {$IFDEF VT_FMX} - FillRect(R, 0, 0, [], 1.0, FDottedBrush); + FillRect(R, 0, 0, [], 1.0, dottedBrush); {$ELSE} Winapi.Windows.FillRect(Handle, R, FDottedBrush); {$ENDIF} @@ -25462,7 +25499,7 @@ procedure TBaseVirtualTree.PaintTreeLines(const PaintInfo: TVTPaintInfo; VAlignm begin DoBeforeDrawLineImage(PaintInfo.Node, I + Ord(not (toShowRoot in TreeOptions.PaintOptions)), XPos); DrawLineImage(PaintInfo, XPos, CellRect.Top, NodeHeight[Node] - 1, VAlignment - 1, NewStyles[I], - BidiMode <> bdLeftToRight); + BidiMode <> bdLeftToRight{$IFDEF VT_FMX}, FDottedBrush{$ENDIF}); Inc(XPos, Offset); end; end; @@ -25472,7 +25509,7 @@ procedure TBaseVirtualTree.PaintTreeLines(const PaintInfo: TVTPaintInfo; VAlignm begin DoBeforeDrawLineImage(PaintInfo.Node, I + Ord(not (toShowRoot in TreeOptions.PaintOptions)), XPos); DrawLineImage(PaintInfo, XPos, CellRect.Top, NodeHeight[Node], VAlignment - 1, LineImage[I], - BidiMode <> bdLeftToRight); + BidiMode <> bdLeftToRight{$IFDEF VT_FMX}, FDottedBrush{$ENDIF}); Inc(XPos, Offset); end; end; @@ -32152,16 +32189,16 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe if BidiMode = bdLeftToRight then begin DrawDottedHLine(PaintInfo, CellRect.Left + IfThen(toFixedIndent in FOptions.FPaintOptions, 1, IndentSize) * FIndent, CellRect.Right - 1, - CellRect.Bottom - 1); + CellRect.Bottom - 1{$IFDEF VT_FMX}, FDottedBrushGrid{$ENDIF}); end else begin DrawDottedHLine(PaintInfo, CellRect.Left, CellRect.Right - IfThen(toFixedIndent in FOptions.FPaintOptions, 1, IndentSize) * FIndent - 1, - CellRect.Bottom - 1); + CellRect.Bottom - 1{$IFDEF VT_FMX}, FDottedBrushGrid{$ENDIF}); end; end else - DrawDottedHLine(PaintInfo, CellRect.Left, CellRect.Right, CellRect.Bottom - 1); + DrawDottedHLine(PaintInfo, CellRect.Left, CellRect.Right, CellRect.Bottom - 1{$IFDEF VT_FMX}, FDottedBrushGrid{$ENDIF}); {$IFDEF VT_FMX} if WasDecLine=0 then begin @@ -32207,7 +32244,7 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe lUseSelectedBkColor := (poDrawSelection in PaintOptions) and (toFullRowSelect in FOptions.FSelectionOptions) and (vsSelected in Node.States) and not (toUseBlendedSelection in FOptions.PaintOptions) {$IFDEF VT_VCL}and not (tsUseExplorerTheme in FStates){$ENDIF}; - DrawDottedVLine(PaintInfo, CellRect.Top, CellRect.Bottom, CellRect.Right - 1, lUseSelectedBkColor); + DrawDottedVLine(PaintInfo, CellRect.Top, CellRect.Bottom, CellRect.Right - 1{$IFDEF VT_FMX}, FDottedBrushGrid{$ENDIF}, lUseSelectedBkColor); end; Dec(CellRect.Right); @@ -32432,7 +32469,7 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe (toShowVertGridLines in FOptions.FPaintOptions) and (not (hoAutoResize in FHeader.FOptions) or (Cardinal(FirstColumn) < TColumnPosition(Count - 1))) then begin - DrawDottedVLine(PaintInfo, R.Top, R.Bottom, R.Right - 1); + DrawDottedVLine(PaintInfo, R.Top, R.Bottom, R.Right - 1{$IFDEF VT_FMX}, FDottedBrushGrid{$ENDIF}); Dec(R.Right); end; From 6fadd51c2fa8c71accc5262802496cfd1a9ef564 Mon Sep 17 00:00:00 2001 From: livius2 Date: Thu, 15 Nov 2018 14:11:57 +0100 Subject: [PATCH 34/61] Better procedure which create images for system platform check and radio buttons - added better images generator for system platform specific check and radio buttons indicating state like pressed, hot, disabled, mixed --- README.md | 6 +- Source/VirtualTrees.FMX.pas | 133 +++++++++++++++++++++++++++++------- 2 files changed, 110 insertions(+), 29 deletions(-) diff --git a/README.md b/README.md index 27563e7a5..7798d377b 100644 --- a/README.md +++ b/README.md @@ -17,13 +17,13 @@ What is working: 14. "hot" and "selected" plus/minus buttons. What is not working yet: -1. some mouse action; +1. some mouse actions; 2. clipboard; -3. drawing and support of tree border; +3. drawing tree border; 4. drawing background; 5. some mouse actions on header; 6. inplace editors; -8. scrollbars/scrolling. +7. scrollbars/scrolling. Current VT is derived from TRectangle. Will be good to have it as presented control with appropiate TDataModel. diff --git a/Source/VirtualTrees.FMX.pas b/Source/VirtualTrees.FMX.pas index ff8805fcc..593b444ca 100644 --- a/Source/VirtualTrees.FMX.pas +++ b/Source/VirtualTrees.FMX.pas @@ -382,7 +382,7 @@ THighQualityBitmap = class(TBitmap) procedure FillSystemCheckImages(Parent: TFmxObject; List: TImageList); implementation -uses FMX.TextLayout, System.SysUtils, FMX.StdCtrls, FMX.MultiResBitmap, FMX.Objects; +uses FMX.TextLayout, System.SysUtils, FMX.StdCtrls, FMX.MultiResBitmap, FMX.Objects, VirtualTrees.Utils, FMX.Effects; type TImageListHelper = class helper for TImageList @@ -514,20 +514,21 @@ procedure FillSystemCheckImages(Parent: TFmxObject; List: TImageList); Var cb: TCheckBox; rb: TRadioButton; BMP: TBitmap; - procedure AddCtrlBmp(c: TControl; SaveToFile: Boolean=false); + eff: TInnerGlowEffect; + procedure AddCtrlBmp(c: TControl); Var tmpBMP: TBitmap; begin tmpBMP:= c.MakeScreenshot; try BMP.SetSize(tmpBMP.Height, tmpBMP.Height); - BMP.Clear(TAlphaColorRec.Null); //this somehow can sometimes clear BeginSceneCount + BMP.Clear(TAlphaColorRec.Null); //this somehow can sometimes clear BeginSceneCount and must be before BeginScene if BMP.Canvas.BeginScene() then begin try BMP.Canvas.DrawBitmap( tmpBMP - , Rect(0, 0, BMP.Width, BMP.Height) - , Rect(0, 0, BMP.Width, BMP.Height) + , Rect(1, 1, BMP.Width, BMP.Height) + , Rect(0, 0, BMP.Width-1, BMP.Height-1) , 1.0 , false ); @@ -552,24 +553,42 @@ procedure FillSystemCheckImages(Parent: TFmxObject; List: TImageList); rb.Parent:= Parent; rb.Text:= ' '; + eff:= TInnerGlowEffect.Create(rb); //auto free + eff.Parent:= rb; + eff.GlowColor:= TAlphaColorRec.Teal; + eff.Softness:= 8; + eff.Opacity:= 0.7; + eff.Enabled:= false; + //------------------IsUnChecked-------------------------- rb.IsChecked:= false; - //rb.MakeScreenshot + eff.Enabled:= false; AddCtrlBmp(rb); - //BMP.SaveToFile('C:\BMP.png'); List.Add(BMP); //ckRadioUncheckedNormal + eff.Enabled:= false; + + + AddCtrlBmp(rb); + eff.Enabled:= true; + eff.GlowColor:= TAlphaColorRec.Lightyellow; List.Add(BMP); //ckRadioUncheckedHot + eff.Enabled:= false; + - //rb.IsPressed:= true; + eff.Enabled:= true; + eff.GlowColor:= TAlphaColorRec.Lightblue; AddCtrlBmp(rb); List.Add(BMP); //ckRadioUncheckedPressed + eff.Enabled:= false; + - //rb.IsPressed:= false; rb.Enabled:= false; + eff.Enabled:= true; + eff.GlowColor:= TAlphaColorRec.Gray; AddCtrlBmp(rb); List.Add(BMP); //ckRadioUncheckedDisabled - + eff.Enabled:= false; //------------------IsChecked--------------------------- @@ -577,19 +596,33 @@ procedure FillSystemCheckImages(Parent: TFmxObject; List: TImageList); //rb.IsPressed:= false; rb.Enabled:= true; + eff.Enabled:= false; AddCtrlBmp(rb); List.Add(BMP); //ckRadioCheckedNormal + eff.Enabled:= false; + + + eff.Enabled:= true; + eff.GlowColor:= TAlphaColorRec.Lightyellow; + AddCtrlBmp(rb); List.Add(BMP); //ckRadioCheckedHot + eff.Enabled:= false; + - //rb.IsPressed:= true; rb.Enabled:= true; + eff.Enabled:= true; + eff.GlowColor:= TAlphaColorRec.Lightblue; AddCtrlBmp(rb); List.Add(BMP); //ckRadioCheckedPressed + eff.Enabled:= false; + - //rb.IsPressed:= false; rb.Enabled:= false; + eff.Enabled:= true; + eff.GlowColor:= TAlphaColorRec.Gray; AddCtrlBmp(rb); List.Add(BMP); //ckRadioCheckedDisabled + eff.Enabled:= false; finally FreeAndNil(rb); end; @@ -598,70 +631,118 @@ procedure FillSystemCheckImages(Parent: TFmxObject; List: TImageList); try cb.Parent:= Parent; cb.Text:= ' '; + + eff:= TInnerGlowEffect.Create(cb); //auto free + eff.Parent:= cb; + eff.GlowColor:= TAlphaColorRec.Teal; + eff.Softness:= 8; + eff.Opacity:= 0.7; + eff.Enabled:= false; + //------------------IsUnChecked-------------------------- cb.IsChecked:= false; - + eff.Enabled:= false; AddCtrlBmp(cb); - List.Add(BMP); //ckCheckUncheckedNormal + eff.Enabled:= false; + + eff.Enabled:= true; + eff.GlowColor:= TAlphaColorRec.Lightyellow; + AddCtrlBmp(cb); List.Add(BMP); //ckCheckUncheckedHot + eff.Enabled:= false; + //cb.IsPressed:= true; + eff.Enabled:= true; + eff.GlowColor:= TAlphaColorRec.Lightblue; AddCtrlBmp(cb); List.Add(BMP); //ckCheckUncheckedPressed + eff.Enabled:= false; + //cb.IsPressed:= false; cb.Enabled:= false; + eff.Enabled:= true; + eff.GlowColor:= TAlphaColorRec.Gray; AddCtrlBmp(cb); + eff.Enabled:= false; List.Add(BMP); //ckCheckUncheckedDisabled //------------------IsChecked--------------------------- cb.IsChecked:= true; - //cb.IsPressed:= false; cb.Enabled:= true; + eff.Enabled:= false; AddCtrlBmp(cb); List.Add(BMP); //ckCheckCheckedNormal + eff.Enabled:= false; + + eff.Enabled:= true; + eff.GlowColor:= TAlphaColorRec.Lightyellow; List.Add(BMP); //ckCheckCheckedHot + eff.Enabled:= false; + eff.Enabled:= false; + - //cb.IsPressed:= true; cb.Enabled:= true; + eff.Enabled:= true; + eff.GlowColor:= TAlphaColorRec.Lightblue; AddCtrlBmp(cb); List.Add(BMP); //ckCheckCheckedPressed + eff.Enabled:= false; + - //cb.IsPressed:= false; cb.Enabled:= false; + eff.Enabled:= true; + eff.GlowColor:= TAlphaColorRec.Gray; AddCtrlBmp(cb); List.Add(BMP); //ckCheckCheckedDisabled - + eff.Enabled:= false; //------------------Mixed--------------------------- //how to support mixed style? //maybe draw unchecked and fill in the center of bitmap??? - //i use teal for fill - - cb.IsChecked:= false; + //i use ~teal for fill + //changed to InnerGlowEffect + cb.IsChecked:= true; + eff.Enabled:= true; + eff.GlowColor:= TAlphaColorRec.Green; AddCtrlBmp(cb); - Bitmap_FloodFill(BMP, BMP.Width div 2, BMP.Height div 2, $FF009191{TAlphaColorRec.Teal}); List.Add(BMP); //ckCheckMixedNormal + eff.Enabled:= false; + + + eff.Enabled:= true; + eff.GlowColor:= TAlphaColorRec.Lightyellow; + AddCtrlBmp(cb); List.Add(BMP); //ckCheckMixedHot + eff.Enabled:= false; - //cb.IsPressed:= true; + + eff.Enabled:= true; + eff.GlowColor:= TAlphaColorRec.Lightblue; AddCtrlBmp(cb); - Bitmap_FloodFill(BMP, BMP.Width div 2, BMP.Height div 2, $FF009191{TAlphaColorRec.Teal}); List.Add(BMP); //ckCheckMixedPressed + eff.Enabled:= false; + - //cb.IsPressed:= false; cb.Enabled:= false; + eff.Enabled:= true; + eff.GlowColor:= TAlphaColorRec.Gray; AddCtrlBmp(cb); - Bitmap_FloodFill(BMP, BMP.Width div 2, BMP.Height div 2, $FF009191{TAlphaColorRec.Teal}); List.Add(BMP); //ckCheckMixedDisabled + eff.Enabled:= false; + finally FreeAndNil(cb); end; + eff.Enabled:= false; + eff.Parent:= nil; + finally FreeAndNil(BMP); end; From 4ec248d4aa4c1ec7d90292e43913b147e48c9f11 Mon Sep 17 00:00:00 2001 From: livius2 Date: Thu, 15 Nov 2018 15:23:06 +0100 Subject: [PATCH 35/61] Fix header resize column when VT is on the Right of parent control Fix header resize column when VT is on the Right of parent control. When it not on the most left all was ok, but when Left was <>0 messages was translated in vrong coordinates. It is fixed now. --- Source/VirtualTrees.pas | 45 ++++++++++++++++++++++++----------------- 1 file changed, 26 insertions(+), 19 deletions(-) diff --git a/Source/VirtualTrees.pas b/Source/VirtualTrees.pas index d974e27eb..f4f01b6fb 100644 --- a/Source/VirtualTrees.pas +++ b/Source/VirtualTrees.pas @@ -10726,6 +10726,7 @@ function TVTHeader.HandleMessage(var Message: TMessage): Boolean; IsVSplitterHit: Boolean; {$IFDEF VT_FMX} cursorService: IFMXCursorService; + pomMsg: TMessage; {$ENDIF} //--------------- local function -------------------------------------------- @@ -11057,9 +11058,11 @@ function TVTHeader.HandleMessage(var Message: TMessage): Boolean; hsHeightTracking, hsHeightTrackPending]; end;// WM_NCLBUTTONUP // hovering, mouse leave detection +{$IFDEF VT_VCL} //in FMX it is not needed because we have AutoCapture, and can cause more problems then fixes, and this event can be captured below now. It fixes header column resizes. WM_NCMOUSEMOVE: with TWMNCMouseMove(Message), FColumns do - begin + begin + P := Treeview.ScreenToClient(Point(XCursor, YCursor)); Treeview.DoHeaderMouseMove({$IFDEF VT_FMX}TShiftState(Word(TWMMouse(Message).Keys)){$ELSE}GetShiftState{$ENDIF}, P.X, P.Y + FHeight); if InHeader(P) and ((AdjustHoverColumn(P)) or ((FDownIndex >= 0) and (FHoverIndex <> FDownIndex))) then @@ -11067,22 +11070,23 @@ function TVTHeader.HandleMessage(var Message: TMessage): Boolean; // We need a mouse leave detection from here for the non client area. // TODO: The best solution available would be the TrackMouseEvent API. // With the drop of the support of Win95 totally and WinNT4 we should replace the timer. -{$IFDEF VT_VCL} + {$IFDEF VT_VCL} Treeview.StopTimer(HeaderTimer); SetTimer(Treeview.Handle, HeaderTimer, 50, nil); -{$ENDIF} + {$ENDIF} // use Delphi's internal hint handling for header hints too if hoShowHint in FOptions then begin // client coordinates! XCursor := P.X; YCursor := P.Y + FHeight; -{$IFDEF VT_VCL} + {$IFDEF VT_VCL} Application.HintMouseMessage(Treeview, Message); -{$ENDIF} + {$ENDIF} end; end; end; +{$ENDIF} {$IFDEF VT_VCL} WM_TIMER: if TWMTimer(Message).TimerID = HeaderTimer then @@ -11107,15 +11111,22 @@ function TVTHeader.HandleMessage(var Message: TMessage): Boolean; end; {$ENDIF} {$IFDEF VT_FMX} - WM_MOUSEMOVE,WM_SETCURSOR: // mouse capture and general message redirection + WM_MOUSEMOVE, WM_NCMOUSEMOVE{,WM_SETCURSOR}: // mouse capture and general message redirection begin - Result := HandleHeaderMouseMove(TWMMouseMove(Message)); + pomMsg:= Message; + if Message.Msg<>{WM_SETCURSOR}WM_MOUSEMOVE then + begin + P := FOwner.ScreenToClient(Point(TWMMouseMove(pomMsg).XPos, TWMMouseMove(pomMsg).YPos)); + TWMMouseMove(pomMsg).XPos:= P.X; + TWMMouseMove(pomMsg).YPos:= P.Y; + end; + Result := HandleHeaderMouseMove(TWMMouseMove(pomMsg)); + end; {$ELSE} WM_MOUSEMOVE: // mouse capture and general message redirection Result := HandleHeaderMouseMove(TWMMouseMove(Message)); -//{$IFDEF VT_VCL} - WM_SETCURSOR: {$ENDIF} + WM_SETCURSOR: // Feature: design-time header if (FStates = []) then begin @@ -11172,10 +11183,6 @@ function TVTHeader.HandleMessage(var Message: TMessage): Boolean; Message.Result := 1; Result := True; end; -{$IFDEF VT_FMX} - end; -{$ENDIF} -//{$ENDIF} WM_KEYDOWN, WM_KILLFOCUS: if (Message.Msg = WM_KILLFOCUS) or @@ -24825,18 +24832,18 @@ procedure TBaseVirtualTree.MouseMove(Shift: TShiftState; X, Y: {$IFDEF VT_FMX}Si begin MM.Msg:= WM_MOUSEMOVE; end; + if FHeader.HandleMessage(TMessage(MM)) then exit else - begin + begin if MM.Msg=WM_NCMOUSEMOVE then begin + FillTWMMouse(MM, TMouseButton.mbLeft, Shift, P.X, P.Y, isNC, false); //MM is as Var and can be modified inside above HandleMessage MM.Msg:= WM_SETCURSOR; if FHeader.HandleMessage(TMessage(MM)) then - exit;//!!! - end; - end; - - + exit;//!!! + end; + end; {$ENDIF} if tsNodeHeightTrackPending in FStates then From 8244ca3612bb8cd9b5d14de5928f5d34603484ef Mon Sep 17 00:00:00 2001 From: livius2 Date: Thu, 15 Nov 2018 16:03:49 +0100 Subject: [PATCH 36/61] Manual Merge Manual Merge --- Source/VirtualTrees.WorkerThread.pas | 17 +++++++++-------- Source/VirtualTrees.pas | 11 +++++++++-- 2 files changed, 18 insertions(+), 10 deletions(-) diff --git a/Source/VirtualTrees.WorkerThread.pas b/Source/VirtualTrees.WorkerThread.pas index 16fd7680a..1da9e947e 100644 --- a/Source/VirtualTrees.WorkerThread.pas +++ b/Source/VirtualTrees.WorkerThread.pas @@ -122,20 +122,21 @@ destructor TWorkerThread.Destroy; procedure TWorkerThread.CancelValidation(Tree: TBaseVirtualTree); -var - Msg: TMsg; +//var +// Msg: TMsg; begin // Wait for any references to this tree to be released. // Pump WM_CHANGESTATE messages so the thread doesn't block on SendMessage calls. while FCurrentTree = Tree do begin - if Tree.HandleAllocated and PeekMessage(Msg, Tree.Handle, WM_CHANGESTATE, WM_CHANGESTATE, PM_REMOVE) then - begin - TranslateMessage(Msg); - DispatchMessage(Msg); - Continue; - end; +// if Tree.HandleAllocated and PeekMessage(Msg, Tree.Handle, WM_CHANGESTATE, WM_CHANGESTATE, PM_REMOVE) then +// begin +// TranslateMessage(Msg); +// DispatchMessage(Msg); +// Continue; +// end; + Yield(); if (toVariableNodeHeight in TBaseVirtualTreeCracker(Tree).TreeOptions.MiscOptions) then CheckSynchronize(); // We need to call CheckSynchronize here because we are using TThread.Synchronize in TBaseVirtualTree.MeasureItemHeight() end; diff --git a/Source/VirtualTrees.pas b/Source/VirtualTrees.pas index f4f01b6fb..d00579eaa 100644 --- a/Source/VirtualTrees.pas +++ b/Source/VirtualTrees.pas @@ -19468,11 +19468,18 @@ procedure TBaseVirtualTree.ChangeScale(M, D: Integer{$if CompilerVersion >= 31}; //---------------------------------------------------------------------------------------------------------------------- procedure TBaseVirtualTree.ChangeTreeStatesAsync(EnterStates, LeaveStates: TChangeStates); - +var + lMessage: TMessage; begin {$IFDEF VT_VCL} + //TODO: If this works reliable, move to TWorkerThread and do not use TMessage as parameter type. See issue #844 + LMessage.Msg := WM_CHANGESTATE; + lMessage.WParam := Byte(EnterStates); + lMessage.LParam := Byte(LeaveStates); + if (Self.HandleAllocated) then - SendMessage(Self.Handle, WM_CHANGESTATE, Byte(EnterStates), Byte(LeaveStates)); + TThread.Synchronize(nil, procedure begin WMChangeState(lMessage) end); +// SendMessage(Self.Handle, WM_CHANGESTATE, Byte(EnterStates), Byte(LeaveStates)); {$ENDIF} end; From 2d0cfe4331454a5775dcbfb5cd857727d9d54067 Mon Sep 17 00:00:00 2001 From: livius2 Date: Thu, 15 Nov 2018 22:42:23 +0100 Subject: [PATCH 37/61] Update VirtualTrees.WorkerThread.pas --- Source/VirtualTrees.WorkerThread.pas | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Source/VirtualTrees.WorkerThread.pas b/Source/VirtualTrees.WorkerThread.pas index 1da9e947e..286cabaa3 100644 --- a/Source/VirtualTrees.WorkerThread.pas +++ b/Source/VirtualTrees.WorkerThread.pas @@ -188,10 +188,10 @@ procedure TWorkerThread.Execute; EnterStates := [csUseCache]; finally - LeaveStates := [csValidating, csStopValidation]; - TBaseVirtualTreeCracker(FCurrentTree).ChangeTreeStatesAsync(EnterStates, LeaveStates); lCurrentTree := FCurrentTree; // Save reference in a local variable for later use FCurrentTree := nil; //Clear variable to prevent deadlock in CancelValidation. See #434 + LeaveStates := [csValidating, csStopValidation]; + TBaseVirtualTreeCracker(FCurrentTree).ChangeTreeStatesAsync(EnterStates, LeaveStates); Queue(TBaseVirtualTreeCracker(lCurrentTree).UpdateEditBounds); end; end; From 956d65f6db61e7b8b158847dd7cf8c770f874558 Mon Sep 17 00:00:00 2001 From: livius2 Date: Thu, 15 Nov 2018 23:02:50 +0100 Subject: [PATCH 38/61] Fixes after merge with master Fixes after merge with master --- Source/VirtualTrees.pas | 19 ++++++++----------- 1 file changed, 8 insertions(+), 11 deletions(-) diff --git a/Source/VirtualTrees.pas b/Source/VirtualTrees.pas index 00c0c4bda..ab1150de0 100644 --- a/Source/VirtualTrees.pas +++ b/Source/VirtualTrees.pas @@ -1,4 +1,4 @@ - + unit VirtualTrees; // The contents of this file are subject to the Mozilla Public License @@ -226,9 +226,6 @@ interface // Alias defintions for convenience TImageIndex = System.UITypes.TImageIndex; - // For Firemonkey support, see #841 - TDimension = Integer; - // The exception used by the trees. EVirtualTreeError = class(Exception); @@ -999,7 +996,7 @@ TVirtualTreeColumn = class(TCollectionItem) FSpacing: TDimension; FOptions: TVTColumnOptions; FEditOptions: TVTEditOptions; - FEditNextColumn: Integer; + FEditNextColumn: TDimension; FTag: NativeInt; FAlignment: TAlignment; FCaptionAlignment: TAlignment; // Alignment of the caption. @@ -1087,7 +1084,7 @@ TVirtualTreeColumn = class(TCollectionItem) property MinWidth: TDimension read FMinWidth write SetMinWidth{$IFDEF VT_VCL} default 10{$ENDIF}; property Options: TVTColumnOptions read FOptions write SetOptions default DefaultColumnOptions; property EditOptions: TVTEditOptions read FEditOptions write FEditOptions default toDefaultEdit; - property EditNextColumn: TDimension read FEditNextColumn write FEditNextColumn default -1; + property EditNextColumn: TDimension read FEditNextColumn write FEditNextColumn{$IFDEF VT_VCL} default -1{$ENDIF}; property Position: TColumnPosition read FPosition write SetPosition; property Spacing: TDimension read FSpacing write SetSpacing{$IFDEF VT_VCL} default 3{$ENDIF}; property Style: TVirtualTreeColumnStyle read FStyle write SetStyle default vsText; @@ -1117,7 +1114,7 @@ TVirtualTreeColumns = class(TCollection) FClearing: Boolean; // True if columns are being deleted entirely. FColumnPopupMenu: TPopupMenu; // Member for storing the TVTHeaderPopupMenu - function GetCount: TDimension; + function GetCount: Integer; function GetItem(Index: TColumnIndex): TVirtualTreeColumn; function GetNewIndex(P: TPoint; var OldIndex: TColumnIndex): Boolean; procedure SetDefaultWidth(Value: TDimension); @@ -1411,7 +1408,7 @@ TVTHeader = class(TPersistent) property PopupMenu: TPopupMenu read FPopupMenu write FPopupMenu; property SortColumn: TColumnIndex read FSortColumn write SetSortColumn default NoColumn; property SortDirection: TSortDirection read FSortDirection write SetSortDirection default sdAscending; - property SplitterHitTolerance: Integer read fSplitterHitTolerance write fSplitterHitTolerance default 8; // The area in pixels around a spliter which is sensitive for resizing + property SplitterHitTolerance: TDimension read fSplitterHitTolerance write fSplitterHitTolerance{$IFDEF VT_VCL} default 8{$ENDIF}; // The area in pixels around a spliter which is sensitive for resizing property Style: TVTHeaderStyle read FStyle write SetStyle default hsThickButtons; end; @@ -7963,7 +7960,7 @@ function TVirtualTreeColumns.GetNewIndex(P: TPoint; var OldIndex: TColumnIndex): //---------------------------------------------------------------------------------------------------------------------- -procedure TVirtualTreeColumns.SetDefaultWidth(Value: Integer); +procedure TVirtualTreeColumns.SetDefaultWidth(Value: TDimension); begin FDefaultWidth := Value; @@ -10242,7 +10239,7 @@ function TVTHeader.DetermineSplitterIndex(P: TPoint): Boolean; //--------------- local function -------------------------------------------- - function IsNearBy(IsFixedCol: Boolean; LeftTolerance, RightTolerance: Integer): Boolean; + function IsNearBy(IsFixedCol: Boolean; LeftTolerance, RightTolerance: TDimension): Boolean; begin if IsFixedCol then @@ -10255,7 +10252,7 @@ function TVTHeader.DetermineSplitterIndex(P: TPoint): Boolean; var I: Integer; - LeftTolerance: Integer; // The area left of the column divider which allows column resizing + LeftTolerance: TDimension; // The area left of the column divider which allows column resizing begin Result := False; From 9224b62bf28fda30545cc213f2a73346f7fad9ea Mon Sep 17 00:00:00 2001 From: livius2 Date: Thu, 15 Nov 2018 23:08:41 +0100 Subject: [PATCH 39/61] softer glow effect on checked hot --- Source/VirtualTrees.FMX.pas | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/Source/VirtualTrees.FMX.pas b/Source/VirtualTrees.FMX.pas index 593b444ca..345a79e68 100644 --- a/Source/VirtualTrees.FMX.pas +++ b/Source/VirtualTrees.FMX.pas @@ -680,9 +680,13 @@ procedure FillSystemCheckImages(Parent: TFmxObject; List: TImageList); List.Add(BMP); //ckCheckCheckedNormal eff.Enabled:= false; + eff.Enabled:= true; eff.GlowColor:= TAlphaColorRec.Lightyellow; + eff.Opacity:= 0.3; + AddCtrlBmp(cb); List.Add(BMP); //ckCheckCheckedHot + eff.Opacity:= 0.7; eff.Enabled:= false; eff.Enabled:= false; From b2265714e645b47796d2999eb3f18cede7997830 Mon Sep 17 00:00:00 2001 From: livius2 Date: Sat, 17 Nov 2018 21:44:13 +0100 Subject: [PATCH 40/61] First attempt to ScrollBars support - many issues First attempt to ScrollBars support . Many painting issues but now work go to good direction after many hard and wrong attempts. --- Source/VirtualTrees.FMX.pas | 77 ++++++++- Source/VirtualTrees.pas | 302 ++++++++++++++++++++++++++++++------ 2 files changed, 320 insertions(+), 59 deletions(-) diff --git a/Source/VirtualTrees.FMX.pas b/Source/VirtualTrees.FMX.pas index 345a79e68..046781cbf 100644 --- a/Source/VirtualTrees.FMX.pas +++ b/Source/VirtualTrees.FMX.pas @@ -11,7 +11,8 @@ {***********************************************************} interface -uses System.Classes, System.UITypes, System.Types, System.ImageList, FMX.ImgList, FMX.Graphics, FMX.Controls, FMX.Types; +uses System.Classes, System.UITypes, System.Types, System.ImageList, FMX.ImgList, FMX.Graphics, FMX.Controls, FMX.Types + , FMX.StdCtrls; //-------- type aliasing ------------------------------------------------------------------------------------------------------------------- @@ -24,6 +25,8 @@ interface TSize = System.Types.TSizeF; TColor = System.UITypes.TAlphaColor; PAnsiChar = System.MarshaledAString; + UINT = LongWord; + PUINT = ^UINT; //------- color aliasing ------------------------------------------------------------------------------------------------------------------- @@ -123,7 +126,50 @@ interface SIZE_MAXSHOW = 3; SIZE_MAXHIDE = 4; + { Scroll Bar Constants } + SB_HORZ = 0; + SB_VERT = 1; + SB_CTL = 2; + SB_BOTH = 3; + + SIF_RANGE = 1; + SIF_PAGE = 2; + SIF_POS = 4; + SIF_DISABLENOSCROLL = 8; + SIF_TRACKPOS = $10; + SIF_ALL = (SIF_RANGE or SIF_PAGE or SIF_POS or SIF_TRACKPOS); + + { Scroll Bar Commands } + SB_LINEUP = 0; + SB_LINELEFT = 0; + SB_LINEDOWN = 1; + SB_LINERIGHT = 1; + SB_PAGEUP = 2; + SB_PAGELEFT = 2; + SB_PAGEDOWN = 3; + SB_PAGERIGHT = 3; + SB_THUMBPOSITION = 4; + SB_THUMBTRACK = 5; + SB_TOP = 6; + SB_LEFT = 6; + SB_BOTTOM = 7; + SB_RIGHT = 7; + SB_ENDSCROLL = 8; + type + tagSCROLLINFO = record + cbSize: UINT; + fMask: UINT; + nMin: Single; + nMax: Single; + nPage: Single; + nPos: Single; + nTrackPos: Single; + end; + PScrollInfo = ^TScrollInfo; + TScrollInfo = tagSCROLLINFO; + SCROLLINFO = tagSCROLLINFO; + TBorderWidth = Single; TBevelCut = (bvNone, bvLowered, bvRaised, bvSpace); TBevelEdge = (beLeft, beTop, beRight, beBottom); @@ -190,6 +236,8 @@ TDWordFiller = record WM_SETFOCUS = $0007; WM_KILLFOCUS = $0008; WM_SETCURSOR = $0020; + WM_HSCROLL = $0114; + WM_VSCROLL = $0115; CM_BASE = $B000; {$IF DEFINED(CLR)} @@ -282,7 +330,7 @@ TWMNCHitMessage = record YCursor: Single; //4 //XYCursorFiller: TDWordFiller; Result: LRESULT; //4 - end; + end; //=20 TWMNCLButtonDblClk = TWMNCHitMessage; TWMNCLButtonDown = TWMNCHitMessage; @@ -307,16 +355,16 @@ TWMKey = record Msg: Cardinal; //4 tmp: Integer; //4 CharCode: Word; //4 - Unused: Word; //2 + //Unused: Word; //2 KeyData: Longint; //4 Result: LRESULT; //4 - end; + end; //=20 TWMKeyDown = TWMKey; TWMKeyUp = TWMKey; - TWMSize = record //4 - Msg: Cardinal; + TWMSize = record + Msg: Cardinal; //4 //MsgFiller: TDWordFiller; SizeType: WPARAM; { SIZE_MAXIMIZED, SIZE_MINIMIZED, SIZE_RESTORED, //4 SIZE_MAXHIDE, SIZE_MAXSHOW } @@ -324,7 +372,20 @@ TWMSize = record //4 Height: Single; //4 //WidthHeightFiller: TDWordFiller; Result: LRESULT; //4 - end; + end; //=20 + + TWMScroll = record + Msg: Cardinal; //4 + //MsgFiller: TDWordFiller; + ScrollCode: {Smallint}Integer; { SB_xxxx } //4 + Pos: Single; //4 + //ScrollCodePosFiller: TDWordFiller; + ScrollBar: Integer; //4 nBar + Result: LRESULT; //4 + end; //=20 + + TWMHScroll = TWMScroll; + TWMVScroll = TWMScroll; procedure FillTWMMouse(Var MM: TWMMouse; Button: TMouseButton; Shift: TShiftState; X: Single; Y: Single; IsNC: Boolean; IsUp: Boolean); @@ -382,7 +443,7 @@ THighQualityBitmap = class(TBitmap) procedure FillSystemCheckImages(Parent: TFmxObject; List: TImageList); implementation -uses FMX.TextLayout, System.SysUtils, FMX.StdCtrls, FMX.MultiResBitmap, FMX.Objects, VirtualTrees.Utils, FMX.Effects; +uses FMX.TextLayout, System.SysUtils, FMX.MultiResBitmap, FMX.Objects, VirtualTrees.Utils, FMX.Effects; type TImageListHelper = class helper for TImageList diff --git a/Source/VirtualTrees.pas b/Source/VirtualTrees.pas index ab1150de0..7e5e61822 100644 --- a/Source/VirtualTrees.pas +++ b/Source/VirtualTrees.pas @@ -2382,6 +2382,8 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF FBorderWidth: TBorderWidth; FHandleAllocated: Boolean; FBiDiMode: TBiDiMode; + FHScrollBar: TScrollBar; + FVScrollBar: TScrollBar; {$ENDIF} {$IFDEF VT_VCL} procedure CMStyleChanged(var Message: TMessage); message CM_STYLECHANGED; @@ -2530,8 +2532,7 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF procedure WMEnable(var Message: TWMEnable); message WM_ENABLE; procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND; procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE; - procedure WMGetObject(var Message: TMessage); message WM_GETOBJECT; - procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL; + procedure WMGetObject(var Message: TMessage); message WM_GETOBJECT; procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN; procedure WMKeyUp(var Message: TWMKeyUp); message WM_KEYUP; procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS; @@ -2555,9 +2556,10 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR; procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS; procedure WMTimer(var Message: TWMTimer); message WM_TIMER; - procedure WMThemeChanged(var Message: TMessage); message WM_THEMECHANGED; - procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL; + procedure WMThemeChanged(var Message: TMessage); message WM_THEMECHANGED; {$ENDIF} + procedure WMHScroll(var Message: TWMHScroll); {$IFDEF VT_FMX}virtual;{$ELSE}message WM_HSCROLL;{$ENDIF} + procedure WMVScroll(var Message: TWMVScroll); {$IFDEF VT_FMX}virtual;{$ELSE}message WM_VSCROLL;{$ENDIF} procedure WMSize(var Message: TWMSize); {$IFDEF VT_FMX}virtual;{$ELSE}message WM_SIZE;{$ENDIF} function GetRangeX: TDimension; function GetDoubleBuffered: Boolean; @@ -3249,7 +3251,7 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF procedure SortTree(Column: TColumnIndex; Direction: TSortDirection; DoInit: Boolean = True); virtual; procedure ToggleNode(Node: PVirtualNode); procedure UpdateHorizontalRange; virtual; - procedure UpdateHorizontalScrollBar(DoRepaint: Boolean); + procedure UpdateHorizontalScrollBar(DoRepaint: Boolean{$IFDEF VT_FMX}; FromSetOffsetXY: Boolean=False{$ENDIF}); procedure UpdateRanges; procedure UpdateScrollBars(DoRepaint: Boolean); virtual; procedure UpdateVerticalRange; @@ -3339,10 +3341,19 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF 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; procedure Invalidate(); 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); + procedure VScrollChangeProc(Sender: TObject); {$ENDIF} end; @@ -12462,6 +12473,24 @@ constructor TBaseVirtualTree.Create(AOwner: TComponent); 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); {$ELSE} ControlStyle := ControlStyle - [csSetCaption] + [csCaptureMouse, csOpaque, csReplicatable, csDisplayDragImage, csReflector]; @@ -13680,10 +13709,22 @@ function TBaseVirtualTree.GetClientRect: TRect; if Assigned(FHeader) then begin if hoVisible in FHeader.FOptions then - Result.Top:= Result.Top + FHeader.Height; - end; + 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 TBaseVirtualTree.Resize; @@ -16319,12 +16360,127 @@ procedure TBaseVirtualTree.Invalidate(); begin Repaint; end; + //---------------------------------------------------------------------------------------------------------------------- procedure TBaseVirtualTree.RecreateWnd(); begin Repaint; end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.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; + Repaint; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.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 TBaseVirtualTree.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 TBaseVirtualTree.GetScrollPos(Bar: Integer): TDimension; +Var ScrollInfo: TScrollInfo; +begin + GetScrollInfo(Bar, ScrollInfo); //ignore result + Result:= ScrollInfo.nPos; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.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 TBaseVirtualTree.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 TBaseVirtualTree.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 TBaseVirtualTree.SetBiDiMode(Value: TBiDiMode); @@ -17429,14 +17585,14 @@ procedure TBaseVirtualTree.WMGetObject(var Message: TMessage); Message.Result := 0; end; end; - +{$ENDIF} //---------------------------------------------------------------------------------------------------------------------- procedure TBaseVirtualTree.WMHScroll(var Message: TWMHScroll); //--------------- local functions ------------------------------------------- - function GetRealScrollPosition: Integer; + function GetRealScrollPosition: TDimension; var SI: TScrollInfo; @@ -17446,7 +17602,7 @@ procedure TBaseVirtualTree.WMHScroll(var Message: TWMHScroll); SI.cbSize := SizeOf(TScrollInfo); SI.fMask := SIF_TRACKPOS; Code := SB_HORZ; - GetScrollInfo(Handle, Code, SI); + GetScrollInfo({$IFDEF VT_VCL}Handle, {$ENDIF}Code, SI); Result := SI.nTrackPos; end; @@ -17463,7 +17619,7 @@ procedure TBaseVirtualTree.WMHScroll(var Message: TWMHScroll); case Message.ScrollCode of SB_BOTTOM: - SetOffsetX(-Integer(FRangeX)); + SetOffsetX(-FRangeX); SB_ENDSCROLL: begin DoStateChange([], [tsThumbTracking]); @@ -17484,7 +17640,7 @@ procedure TBaseVirtualTree.WMHScroll(var Message: TWMHScroll); begin DoStateChange([tsThumbTracking]); if UseRightToLeftAlignment then - SetOffsetX(-Integer(FRangeX) + ClientWidth + GetRealScrollPosition) + SetOffsetX(-FRangeX + ClientWidth + GetRealScrollPosition) else SetOffsetX(-GetRealScrollPosition); end; @@ -17496,7 +17652,7 @@ procedure TBaseVirtualTree.WMHScroll(var Message: TWMHScroll); end; //---------------------------------------------------------------------------------------------------------------------- - +{$IFDEF VT_VCL} procedure TBaseVirtualTree.WMKeyDown(var Message: TWMKeyDown); // Keyboard event handling for node focus, selection, node specific popup menus and help invokation. @@ -18943,14 +19099,14 @@ procedure TBaseVirtualTree.WMTimer(var Message: TWMTimer); end; end; end; - +{$ENDIF} //---------------------------------------------------------------------------------------------------------------------- procedure TBaseVirtualTree.WMVScroll(var Message: TWMVScroll); //--------------- local functions ------------------------------------------- - function GetRealScrollPosition: Integer; + function GetRealScrollPosition: TDimension; var SI: TScrollInfo; @@ -18960,7 +19116,7 @@ procedure TBaseVirtualTree.WMVScroll(var Message: TWMVScroll); SI.cbSize := SizeOf(TScrollInfo); SI.fMask := SIF_TRACKPOS; Code := SB_VERT; - GetScrollInfo(Handle, Code, SI); + GetScrollInfo({$IFDEF VT_VCL}Handle, {$ENDIF}Code, SI); Result := SI.nTrackPos; end; @@ -18969,7 +19125,7 @@ procedure TBaseVirtualTree.WMVScroll(var Message: TWMVScroll); begin case Message.ScrollCode of SB_BOTTOM: - SetOffsetY(-Integer(FRoot.TotalHeight)); + SetOffsetY(-FRoot.TotalHeight); SB_ENDSCROLL: begin DoStateChange([], [tsThumbTracking]); @@ -18979,7 +19135,11 @@ procedure TBaseVirtualTree.WMVScroll(var Message: TWMVScroll); // Really weird invalidation needed here (and I do it only because it happens so rarely), because // when showing the horizontal scrollbar while scrolling down using the down arrow button, // the button will be repainted on mouse up (at the wrong place in the far right lower corner)... +{$IFDEF VT_FMX} + Repaint; +{$ELSE} RedrawWindow(Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE or RDW_NOERASE or RDW_NOCHILDREN); +{$ENDIF} end; SB_LINEUP: SetOffsetY(FOffsetY + FScrollBarOptions.FIncrementY); @@ -19001,7 +19161,7 @@ procedure TBaseVirtualTree.WMVScroll(var Message: TWMVScroll); end; Message.Result := 0; end; -{$ENDIF} + //---------------------------------------------------------------------------------------------------------------------- procedure TBaseVirtualTree.AddToSelection(Node: PVirtualNode); @@ -21755,7 +21915,9 @@ function TBaseVirtualTree.DoSetOffsetXY(Value: TPoint; Options: TScrollUpdateOpt DeltaY := Value.Y - FOffsetY; Result := (DeltaX <> 0) or (DeltaY <> 0); +{$IFDEF VT_VCL} if Result then +{$ENDIF} begin FOffsetX := Value.X; FOffsetY := Value.Y; @@ -21843,6 +22005,7 @@ function TBaseVirtualTree.DoSetOffsetXY(Value: TPoint; Options: TScrollUpdateOpt HandleHotTrack(P.X, P.Y); DoScroll(DeltaX, DeltaY); + UpdateHorizontalScrollBar(true, True); {$ELSE} GetCursorPos(P); P := ScreenToClient(P); @@ -21860,7 +22023,9 @@ function TBaseVirtualTree.DoSetOffsetXY(Value: TPoint; Options: TScrollUpdateOpt procedure TBaseVirtualTree.DoShowScrollBar(Bar: Integer; Show: Boolean); begin -{$IFDEF VT_VCL} +{$IFDEF VT_FMX} + ShowScrollBar(Bar, Show); +{$ELSE} ShowScrollBar(Handle, Bar, Show); {$ENDIF} if Assigned(FOnShowScrollBar) then @@ -25156,7 +25321,12 @@ procedure TBaseVirtualTree.Paint; // The clipping rectangle is given in client coordinates of the window. We have to convert it into // a sliding window of the tree image. + {$IFDEF VT_FMX} OffsetRect(Window, FEffectiveOffsetX - RTLOffset, -FOffsetY); + {$ELSE} + OffsetRect(Window, FEffectiveOffsetX - RTLOffset, -FOffsetY); + {$ENDIF} + PaintTree(Canvas, Window, Target, Options); end else @@ -26951,10 +27121,11 @@ procedure TBaseVirtualTree.UpdateEditBounds; end; //---------------------------------------------------------------------------------------------------------------------- -{$IFDEF VT_VCL} + const ScrollMasks: array[Boolean] of Cardinal = (0, SIF_DISABLENOSCROLL); - + +{$IFDEF VT_VCL} const // Region identifiers for GetRandomRgn CLIPRGN = 1; METARGN = 2; @@ -31893,10 +32064,12 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe ColumnIsFixed: Boolean; {$IFDEF VT_FMX} WasDecLine: Integer; + tmpR: TRect; {$ENDIF} begin {$IFDEF VT_FMX} PaintOptions:= PaintOptions + [poUnbuffered]; //!!!!!!! + //TargetCanvas.Offset:= Point(OffsetX, OffsetY); {$ENDIF} if not (tsPainting in FStates) then @@ -31990,6 +32163,7 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe TargetRect := Rect(Target.X, Target.Y - (Window.Top - BaseOffset), MaximumRight, 0); TargetRect.Bottom := TargetRect.Top; {$IFDEF VT_FMX} + OffsetRect(TargetRect, -FEffectiveOffsetX, 0); TargetCanvas.Font.Assign(Self.Font); {$ELSE} TargetCanvas.Font := Self.Font; @@ -32032,6 +32206,9 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe // which are children of selected nodes. if (SelectLevel > 0) or not (poSelectedOnly in PaintOptions) then begin +{$IFDEF VT_FMX} + //Canvas.Offset:= Point(-EffectiveOffsetX, 0); +{$ENDIF} {$IFDEF VT_VCL} if not (poUnbuffered in PaintOptions) then begin @@ -32061,6 +32238,8 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe CurrentNodeHeight := PaintInfo.Node.NodeHeight; {$IFDEF VT_FMX} R := TargetRect; + //R.Top:= TargetRect.Top; + //R.Bottom:= TargetRect.Bottom; if (poGridLines in PaintOptions) and (toShowHorzGridLines in FOptions.FPaintOptions) then begin if WasDecLine=0 then @@ -32178,10 +32357,21 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe ClipRect := CellRect; if poUnbuffered in PaintOptions then begin + {$IFDEF VT_FMX} + (* ClipRect.Left := Max(ClipRect.Left, Window.Left); ClipRect.Right := Min(ClipRect.Right, Window.Right); - ClipRect.Top := Max(ClipRect.Top, Window.Top - (BaseOffset - CurrentNodeHeight)); + if hoVisible in FHeader.Options then + ClipRect.Top := Max(Max(ClipRect.Top, Window.Top - (BaseOffset - CurrentNodeHeight)), FHeader.Height) else + ClipRect.Top := Max(ClipRect.Top, Window.Top - (BaseOffset - CurrentNodeHeight)); ClipRect.Bottom := ClipRect.Bottom - Max(TargetRect.Bottom - MaximumBottom, 0){$IFDEF VT_FMX}+1{$ENDIF}; + *) + {$ELSE} + ClipRect.Left := Max(ClipRect.Left, Window.Left); + ClipRect.Right := Min(ClipRect.Right, Window.Right); + ClipRect.Top := Max(ClipRect.Top, Window.Top - (BaseOffset - CurrentNodeHeight)); + ClipRect.Bottom := ClipRect.Bottom - Max(TargetRect.Bottom - MaximumBottom, 0); + {$ENDIF} end; {$IFDEF VT_FMX} Canvas.IntersectClipRect(ClipRect); @@ -32335,8 +32525,13 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe if coVisible in Items[NextColumn].FOptions then with PaintInfo do begin +{$IFDEF VT_FMX} + tmpR:= CellRect; + CellRect.Left:= CellRect.Right; + Items[NextColumn].GetAbsoluteBounds(tmpR.Left, tmpR.Right); + CellRect.Right:= CellRect.Left + tmpR.Width; +{$ELSE} Items[NextColumn].GetAbsoluteBounds(CellRect.Left, CellRect.Right); -{$IFDEF VT_VCL} CellRect.Bottom := Node.NodeHeight; ContentRect.Bottom := Node.NodeHeight; {$ENDIF} @@ -34199,23 +34394,18 @@ procedure TBaseVirtualTree.UpdateHorizontalRange; //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.UpdateHorizontalScrollBar(DoRepaint: Boolean); -{$IFDEF VT_VCL} +procedure TBaseVirtualTree.UpdateHorizontalScrollBar(DoRepaint: Boolean{$IFDEF VT_FMX}; FromSetOffsetXY: Boolean=False{$ENDIF}); var ScrollInfo: TScrollInfo; -{$ENDIF} begin UpdateHorizontalRange; if (tsUpdating in FStates) or not HandleAllocated then Exit; - -{$IFDEF VT_VCL} - // Adjust effect scroll offset depending on bidi mode. if UseRightToLeftAlignment then - FEffectiveOffsetX := Integer(FRangeX) - ClientWidth + FOffsetX + FEffectiveOffsetX := FRangeX - ClientWidth + FOffsetX else FEffectiveOffsetX := -FOffsetX; @@ -34224,9 +34414,9 @@ procedure TBaseVirtualTree.UpdateHorizontalScrollBar(DoRepaint: Boolean); ZeroMemory (@ScrollInfo, SizeOf(ScrollInfo)); ScrollInfo.cbSize := SizeOf(ScrollInfo); ScrollInfo.fMask := SIF_ALL; - GetScrollInfo(Handle, SB_HORZ, ScrollInfo); + GetScrollInfo({$IFDEF VT_VCL}Handle,{$ENDIF} SB_HORZ, ScrollInfo); - if (Integer(FRangeX) > ClientWidth) or FScrollBarOptions.AlwaysVisible then + if (FRangeX > ClientWidth) or FScrollBarOptions.AlwaysVisible then begin DoShowScrollBar(SB_HORZ, True); @@ -34236,9 +34426,13 @@ procedure TBaseVirtualTree.UpdateHorizontalScrollBar(DoRepaint: Boolean); ScrollInfo.nPage := Max(0, ClientWidth + 1); ScrollInfo.fMask := SIF_ALL or ScrollMasks[FScrollBarOptions.AlwaysVisible]; - SetScrollInfo(Handle, SB_HORZ, ScrollInfo, DoRepaint); + SetScrollInfo({$IFDEF VT_VCL}Handle,{$ENDIF} SB_HORZ, ScrollInfo, DoRepaint); if DoRepaint then +{$IFDEF VT_FMX} + Repaint; +{$ELSE} RedrawWindow(Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE); // Fixes issue #698 +{$ENDIF} end else begin @@ -34247,25 +34441,34 @@ procedure TBaseVirtualTree.UpdateHorizontalScrollBar(DoRepaint: Boolean); ScrollInfo.nPos := 0; ScrollInfo.nPage := 0; DoShowScrollBar(SB_HORZ, False); - SetScrollInfo(Handle, SB_HORZ, ScrollInfo, False); + SetScrollInfo({$IFDEF VT_VCL}Handle,{$ENDIF} SB_HORZ, ScrollInfo, False); end; // Since the position is automatically changed if it doesn't meet the range // we better read the current position back to stay synchronized. - FEffectiveOffsetX := GetScrollPos(Handle, SB_HORZ); - if UseRightToLeftAlignment then - SetOffsetX(-Integer(FRangeX) + ClientWidth + FEffectiveOffsetX) - else - SetOffsetX(-FEffectiveOffsetX); + FEffectiveOffsetX := GetScrollPos({$IFDEF VT_VCL}Handle,{$ENDIF} SB_HORZ); +{$IFDEF VT_FMX} + if not FromSetOffsetXY then +{$ENDIF} + begin + if UseRightToLeftAlignment then + SetOffsetX(-FRangeX + ClientWidth + FEffectiveOffsetX) + else + SetOffsetX(-FEffectiveOffsetX); + end; end else begin DoShowScrollBar(SB_HORZ, False); // Reset the current horizontal offset to account for window resize etc. - SetOffsetX(FOffsetX); +{$IFDEF VT_FMX} + if not FromSetOffsetXY then +{$ENDIF} + begin + SetOffsetX(FOffsetX); + end; end; -{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -34313,10 +34516,8 @@ procedure TBaseVirtualTree.UpdateVerticalRange; //---------------------------------------------------------------------------------------------------------------------- procedure TBaseVirtualTree.UpdateVerticalScrollBar(DoRepaint: Boolean); -{$IFDEF VT_VCL} var ScrollInfo: TScrollInfo; -{$ENDIF} begin UpdateVerticalRange; @@ -34324,14 +34525,14 @@ procedure TBaseVirtualTree.UpdateVerticalScrollBar(DoRepaint: Boolean); Exit; {$IFDEF VT_VCL} Assert(GetCurrentThreadId = MainThreadId, 'UI controls like ' + Classname + ' and its scrollbars should only be manipulated through the main thread.'); - - if FScrollBarOptions.ScrollBars in [ssVertical, ssBoth] then +{$ENDIF} + if FScrollBarOptions.ScrollBars in [TScrollStyle.ssVertical, TScrollStyle.ssBoth] then begin ScrollInfo.cbSize := SizeOf(ScrollInfo); ScrollInfo.fMask := SIF_ALL; - GetScrollInfo(Handle, SB_VERT, ScrollInfo); + GetScrollInfo({$IFDEF VT_VCL}Handle, {$ENDIF}SB_VERT, ScrollInfo); - if (Integer(FRangeY) > ClientHeight) or FScrollBarOptions.AlwaysVisible then + if (FRangeY > ClientHeight) or FScrollBarOptions.AlwaysVisible then begin DoShowScrollBar(SB_VERT, True); @@ -34341,7 +34542,7 @@ procedure TBaseVirtualTree.UpdateVerticalScrollBar(DoRepaint: Boolean); ScrollInfo.nPage := Max(0, ClientHeight + 1); ScrollInfo.fMask := SIF_ALL or ScrollMasks[FScrollBarOptions.AlwaysVisible]; - SetScrollInfo(Handle, SB_VERT, ScrollInfo, DoRepaint); + SetScrollInfo({$IFDEF VT_VCL}Handle, {$ENDIF}SB_VERT, ScrollInfo, DoRepaint); end else begin @@ -34350,12 +34551,12 @@ procedure TBaseVirtualTree.UpdateVerticalScrollBar(DoRepaint: Boolean); ScrollInfo.nPos := 0; ScrollInfo.nPage := 0; DoShowScrollBar(SB_VERT, False); - SetScrollInfo(Handle, SB_VERT, ScrollInfo, False); + SetScrollInfo({$IFDEF VT_VCL}Handle, {$ENDIF}SB_VERT, ScrollInfo, False); end; // Since the position is automatically changed if it doesn't meet the range // we better read the current position back to stay synchronized. - SetOffsetY(-GetScrollPos(Handle, SB_VERT)); + SetOffsetY(-GetScrollPos({$IFDEF VT_VCL}Handle, {$ENDIF}SB_VERT)); end else begin @@ -34364,7 +34565,6 @@ procedure TBaseVirtualTree.UpdateVerticalScrollBar(DoRepaint: Boolean); // Reset the current vertical offset to account for window resize etc. SetOffsetY(FOffsetY); end; -{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- From 373d5f18f903cfda036afd128dfd7c2830fd1033 Mon Sep 17 00:00:00 2001 From: livius2 Date: Sat, 17 Nov 2018 23:56:35 +0100 Subject: [PATCH 41/61] Fix painting header when vertical scrollbar position>0 Fix painting header when vertical scrollbar position>0 --- README.md | 3 ++- Source/VirtualTrees.pas | 10 +++++++++- 2 files changed, 11 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 7798d377b..1cff87be1 100644 --- a/README.md +++ b/README.md @@ -15,6 +15,8 @@ What is working: 12. checkbox support system checkboxes (platform specific) + custom checkboxes. 13. support for Android :) 14. "hot" and "selected" plus/minus buttons. +15. scrollbars/scrolling (with issues: paintin focus rect when horizontal scrollbar and also when horizontal near to max). + What is not working yet: 1. some mouse actions; @@ -23,7 +25,6 @@ What is not working yet: 4. drawing background; 5. some mouse actions on header; 6. inplace editors; -7. scrollbars/scrolling. Current VT is derived from TRectangle. Will be good to have it as presented control with appropiate TDataModel. diff --git a/Source/VirtualTrees.pas b/Source/VirtualTrees.pas index 7e5e61822..4805ab77b 100644 --- a/Source/VirtualTrees.pas +++ b/Source/VirtualTrees.pas @@ -32262,8 +32262,14 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe PaintInfo.PaintOptions := PaintOptions; // The node background can contain a single color, a bitmap or can be drawn by the application. - ClearNodeBackground(PaintInfo, UseBackground, {$IFDEF VT_FMX}False{$ELSE}True{$ENDIF}, Rect(Window.Left, TargetRect.Top, Window.Right, + {$IFDEF VT_FMX} + ClearNodeBackground(PaintInfo, UseBackground, False, + Rect(Window.Left, Max(Byte(hoVisible in FHeader.Options)*FHeader.Height, TargetRect.Top), Window.Right, TargetRect.Bottom) + ); + {$ELSE} + ClearNodeBackground(PaintInfo, UseBackground, True, Rect(Window.Left, TargetRect.Top, Window.Right, TargetRect.Bottom)); + {$ENDIF} // Prepare column, position and node clipping rectangle. PaintInfo.CellRect := R; @@ -32358,6 +32364,8 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe if poUnbuffered in PaintOptions then begin {$IFDEF VT_FMX} + if hoVisible in FHeader.Options then + ClipRect.Top:= Max(ClipRect.Top, FHeader.Height); (* ClipRect.Left := Max(ClipRect.Left, Window.Left); ClipRect.Right := Min(ClipRect.Right, Window.Right); From 66a4a75ead09f58b52135281bb5629fb2a59c407 Mon Sep 17 00:00:00 2001 From: livius2 Date: Sun, 18 Nov 2018 18:30:30 +0100 Subject: [PATCH 42/61] Fixing horiz and vert scroll - fix clear background when horizontal scrolling - fix horizontal scroll range - fix vertical scroll range --- Source/VirtualTrees.pas | 24 ++++++++++++++++++++++-- 1 file changed, 22 insertions(+), 2 deletions(-) diff --git a/Source/VirtualTrees.pas b/Source/VirtualTrees.pas index 4805ab77b..a9f0c4b44 100644 --- a/Source/VirtualTrees.pas +++ b/Source/VirtualTrees.pas @@ -32264,7 +32264,7 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe // The node background can contain a single color, a bitmap or can be drawn by the application. {$IFDEF VT_FMX} ClearNodeBackground(PaintInfo, UseBackground, False, - Rect(Window.Left, Max(Byte(hoVisible in FHeader.Options)*FHeader.Height, TargetRect.Top), Window.Right, TargetRect.Bottom) + Rect(Window.Left-FEffectiveOffsetX, Max(Byte(hoVisible in FHeader.Options)*FHeader.Height, TargetRect.Top), Window.Right, TargetRect.Bottom) ); {$ELSE} ClearNodeBackground(PaintInfo, UseBackground, True, Rect(Window.Left, TargetRect.Top, Window.Right, @@ -34429,9 +34429,20 @@ procedure TBaseVirtualTree.UpdateHorizontalScrollBar(DoRepaint: Boolean{$IFDEF V DoShowScrollBar(SB_HORZ, True); ScrollInfo.nMin := 0; - ScrollInfo.nMax := FRangeX; ScrollInfo.nPos := FEffectiveOffsetX; + {$IFDEF VT_FMX} + if hoVisible in Header.Options then + begin + ScrollInfo.nPage := Max(0, FRangeX-ClientWidth + 1); + ScrollInfo.nMax := Max(0, FRangeX-ClientWidth + 1); + end else + begin + ScrollInfo.nPage := Max(0, ClientWidth + 1); + ScrollInfo.nMax := FRangeX; + end; + {$ELSE} ScrollInfo.nPage := Max(0, ClientWidth + 1); + {$ENDIF} ScrollInfo.fMask := SIF_ALL or ScrollMasks[FScrollBarOptions.AlwaysVisible]; SetScrollInfo({$IFDEF VT_VCL}Handle,{$ENDIF} SB_HORZ, ScrollInfo, DoRepaint); @@ -34544,10 +34555,19 @@ procedure TBaseVirtualTree.UpdateVerticalScrollBar(DoRepaint: Boolean); begin DoShowScrollBar(SB_VERT, True); + {$IFDEF VT_FMX} + ScrollInfo.nMin := 0; + ScrollInfo.nMax := Max(0, FRangeY-ClientHeight+1); + ScrollInfo.nPos := -FOffsetY; + ScrollInfo.nPage := Max(0, FRangeY-ClientHeight + 1); + {$ELSE} ScrollInfo.nMin := 0; ScrollInfo.nMax := FRangeY; ScrollInfo.nPos := -FOffsetY; ScrollInfo.nPage := Max(0, ClientHeight + 1); + {$ENDIF} + + ScrollInfo.fMask := SIF_ALL or ScrollMasks[FScrollBarOptions.AlwaysVisible]; SetScrollInfo({$IFDEF VT_VCL}Handle, {$ENDIF}SB_VERT, ScrollInfo, DoRepaint); From 4812f4ed82329e3d82ea4efc89fbce5eb32f1701 Mon Sep 17 00:00:00 2001 From: livius2 Date: Sun, 18 Nov 2018 22:39:05 +0100 Subject: [PATCH 43/61] Fix horizontal scroll content painting Fix horizontal scroll content painting when scroll was > Window.Left --- Source/VirtualTrees.pas | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/Source/VirtualTrees.pas b/Source/VirtualTrees.pas index a9f0c4b44..0500788d8 100644 --- a/Source/VirtualTrees.pas +++ b/Source/VirtualTrees.pas @@ -32332,7 +32332,7 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe AdjustPaintCellRect(PaintInfo, NextColumn); // Paint the cell only if it is in the current window. - if PaintInfo.CellRect.Right > Window.Left then + if PaintInfo.CellRect.Right > Window.Left{$IFDEF VT_FMX}-FEffectiveOffsetX{$ENDIF} then begin with PaintInfo do begin @@ -32568,9 +32568,7 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe end; // Put the constructed node image onto the target canvas. -{$IFDEF VT_FMX} - //TODO: -{$ELSE} +{$IFDEF VT_VCL} if not (poUnbuffered in PaintOptions) then with TWithSafeRect(TargetRect), NodeBitmap do BitBlt(TargetCanvas.Handle, Left, Top, Width, Height, Canvas.Handle, Window.Left, 0, SRCCOPY); From 91426b704d15d2002075f310d19cc89368e514c6 Mon Sep 17 00:00:00 2001 From: livius2 Date: Mon, 19 Nov 2018 08:22:41 +0100 Subject: [PATCH 44/61] Fix focus rect and area between scrollbars - fixed focus rect when horizontal scrolling - fixed drawing area between scrollbars --- Source/VirtualTrees.pas | 20 +++++++++++++++++++- 1 file changed, 19 insertions(+), 1 deletion(-) diff --git a/Source/VirtualTrees.pas b/Source/VirtualTrees.pas index 0500788d8..4a51806d3 100644 --- a/Source/VirtualTrees.pas +++ b/Source/VirtualTrees.pas @@ -16377,6 +16377,11 @@ procedure TBaseVirtualTree.ShowScrollBar(Bar: Integer; AShow: Boolean); 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; @@ -32467,7 +32472,7 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe end; // Prepare background and focus rect for the current cell. - PrepareCell(PaintInfo, Window.Left, PaintWidth); + PrepareCell(PaintInfo, Window.Left{$IFDEF VT_FMX}-FEffectiveOffsetX{$ENDIF}, PaintWidth); // Some parts are only drawn for the main column. if IsMainColumn then @@ -32589,6 +32594,19 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe end; end; + {$IFDEF VT_FMX} + //Fill the area between two scrollBars + if FHScrollBar.Visible and FVScrollBar.Visible then + begin + TargetCanvas.Fill.Color:= clBtnFace; //this should be color from the style of scrollbar - how to get it? + TargetCanvas.FillRect( + Rect(Width-FHScrollBar.Margins.Right, Height-FHScrollBar.Margins.Right, Width, Height) + , 0, 0, [], 1.0 + ); + end; + {$ENDIF} + + // Erase rest of window not covered by a node. if (TargetRect.Top < MaximumBottom) then begin From 5372d565a1ab7189b75e37fc80c1e9b445df63f9 Mon Sep 17 00:00:00 2001 From: livius2 Date: Mon, 19 Nov 2018 08:52:52 +0100 Subject: [PATCH 45/61] Update README.md --- README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 1cff87be1..3516066c4 100644 --- a/README.md +++ b/README.md @@ -15,11 +15,11 @@ What is working: 12. checkbox support system checkboxes (platform specific) + custom checkboxes. 13. support for Android :) 14. "hot" and "selected" plus/minus buttons. -15. scrollbars/scrolling (with issues: paintin focus rect when horizontal scrollbar and also when horizontal near to max). +15. scrollbars/scrolling. What is not working yet: -1. some mouse actions; +1. some mouse actions (drag/drop); 2. clipboard; 3. drawing tree border; 4. drawing background; From e544584e29d3d9fa9ce5a36af7d3ae6783a240b7 Mon Sep 17 00:00:00 2001 From: livius2 Date: Tue, 20 Nov 2018 09:50:08 +0100 Subject: [PATCH 46/61] Remove many unnescessary ifdefs by providing canvas helper - added canvas helper with Brush, Pen, FillRect aliases to remove unnescessary ifdefs - replace TImage by TBitmap --- .../VirtualTreesD_FMX.dproj | 2 +- .../RAD Studio 10.2 FMX/VirtualTreesR_FMX.dpk | 1 + .../VirtualTreesR_FMX.dproj | 1 + README.md | 3 + Source/VirtualTrees.FMX.pas | 37 +++- Source/VirtualTrees.pas | 182 ++++++++++-------- 6 files changed, 142 insertions(+), 84 deletions(-) diff --git a/Packages/RAD Studio 10.2 FMX/VirtualTreesD_FMX.dproj b/Packages/RAD Studio 10.2 FMX/VirtualTreesD_FMX.dproj index f7ab4229b..0a0d4fcb8 100644 --- a/Packages/RAD Studio 10.2 FMX/VirtualTreesD_FMX.dproj +++ b/Packages/RAD Studio 10.2 FMX/VirtualTreesD_FMX.dproj @@ -3,7 +3,7 @@ {2B5EB14C-740A-4933-9110-86A014DED21E} VirtualTreesD_FMX.dpk 18.4 - None + FMX True Release Win32 diff --git a/Packages/RAD Studio 10.2 FMX/VirtualTreesR_FMX.dpk b/Packages/RAD Studio 10.2 FMX/VirtualTreesR_FMX.dpk index aa40a5bfe..6cc748ec0 100644 --- a/Packages/RAD Studio 10.2 FMX/VirtualTreesR_FMX.dpk +++ b/Packages/RAD Studio 10.2 FMX/VirtualTreesR_FMX.dpk @@ -26,6 +26,7 @@ package VirtualTreesR_FMX; {$DEFINE VT_FMX} {$DEFINE RELEASE} {$ENDIF IMPLICITBUILDING} +{$RUNONLY} {$IMPLICITBUILD ON} requires diff --git a/Packages/RAD Studio 10.2 FMX/VirtualTreesR_FMX.dproj b/Packages/RAD Studio 10.2 FMX/VirtualTreesR_FMX.dproj index 3c6172d25..f5c569328 100644 --- a/Packages/RAD Studio 10.2 FMX/VirtualTreesR_FMX.dproj +++ b/Packages/RAD Studio 10.2 FMX/VirtualTreesR_FMX.dproj @@ -88,6 +88,7 @@ System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) All VirtualTreesR_FMX + true None diff --git a/README.md b/README.md index 3516066c4..291228394 100644 --- a/README.md +++ b/README.md @@ -25,6 +25,7 @@ What is not working yet: 4. drawing background; 5. some mouse actions on header; 6. inplace editors; +7. installing package for both VCL and FMX in the same time. Current VT is derived from TRectangle. Will be good to have it as presented control with appropiate TDataModel. @@ -34,6 +35,8 @@ One will be i scale 1 second smaller in scale e.g 0.2 as a preview. To test FMX port of VT - you must add in the e.g. Delphi project->Options->Conditional defines **VT_FMX**. There is only package for Delphi Tokyo (but you can test it from the code). Remember to add also to uses clause unit VirtualTrees.FMX. +WARNING. if you install package for FMX you can not use installed package for VCL and vice-versa. +I still look for the way to do this. # Virtual-TreeView Virtual Treeview is a Delphi treeview control built from ground up. Many years of development made it one of the most flexible and advanced tree controls available today. Virtual Treeview starts off with the claim to improve many aspects of existing solutions and introduces some new technologies and principles which were not available before. diff --git a/Source/VirtualTrees.FMX.pas b/Source/VirtualTrees.FMX.pas index 046781cbf..a50293097 100644 --- a/Source/VirtualTrees.FMX.pas +++ b/Source/VirtualTrees.FMX.pas @@ -7,7 +7,7 @@ { } { author : Karol Bieniaszewski } { year : 2018 } -{ } +{ contibutors : } {***********************************************************} interface @@ -208,6 +208,7 @@ TDWordFiller = record //--------- Windows messages simulations --------------------------------------------------------------------------------------------------- const + WM_APP = $8000; WM_MOUSEFIRST = $0200; WM_MOUSEMOVE = $0200; WM_LBUTTONDOWN = $0201; @@ -238,6 +239,7 @@ TDWordFiller = record WM_SETCURSOR = $0020; WM_HSCROLL = $0114; WM_VSCROLL = $0115; + WM_CHANGESTATE = WM_APP + 32; CM_BASE = $B000; {$IF DEFINED(CLR)} @@ -442,9 +444,38 @@ THighQualityBitmap = class(TBitmap) //fill system images procedure FillSystemCheckImages(Parent: TFmxObject; List: TImageList); +type + TCanvasHelper = class helper for TCanvas + private + function GetBrush: TBrush; inline; + function GetPen: TStrokeBrush; inline; + public + property Brush: TBrush read GetBrush; + property Pen: TStrokeBrush read GetPen; + procedure FillRect(const ARect: TRectF); overload; inline; + end; + implementation uses FMX.TextLayout, System.SysUtils, FMX.MultiResBitmap, FMX.Objects, VirtualTrees.Utils, FMX.Effects; + +{ TCanvasHelper } + +procedure TCanvasHelper.FillRect(const ARect: TRectF); +begin + FillRect(ARect, 0, 0, [], 1.0); +end; + +function TCanvasHelper.GetBrush: TBrush; +begin + Result:= Fill; +end; + +function TCanvasHelper.GetPen: TStrokeBrush; +begin + Result:= Stroke; +end; + type TImageListHelper = class helper for TImageList function Add(aBitmap: TBitmap): integer; @@ -1514,8 +1545,6 @@ procedure TChangeLink.SetSender(const Value: TCustomImageList); Images := TBaseImageList(Value); end; - - { THighQualityBitmap } constructor THighQualityBitmap.Create; @@ -1525,4 +1554,6 @@ constructor THighQualityBitmap.Create; end; + + end. diff --git a/Source/VirtualTrees.pas b/Source/VirtualTrees.pas index ea8e4fe85..e20ed8540 100644 --- a/Source/VirtualTrees.pas +++ b/Source/VirtualTrees.pas @@ -2083,7 +2083,7 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF FEditLink: IVTEditLink; // used to comunicate with an application defined editor FTempNodeCache: TNodeArray; // used at various places to hold temporarily a bunch of node refs. FTempNodeCount: Cardinal; // number of nodes in FTempNodeCache - FBackground: {$IFDEF VT_FMX}TImage{$ELSE}TPicture{$ENDIF}; // A background image loadable at design and runtime. + FBackground: {$IFDEF VT_FMX}TBitmap{$ELSE}TPicture{$ENDIF}; // A background image loadable at design and runtime. FBackgroundImageTransparent: Boolean; // By default, this is off. When switched on, will try to draw the image // transparent by using the color of the component as transparent color @@ -2446,7 +2446,7 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF procedure FakeReadIdent(Reader: TReader); procedure SetAlignment(const Value: TAlignment); procedure SetAnimationDuration(const Value: Cardinal); - procedure SetBackground(const Value: {$IFDEF VT_FMX}TImage{$ELSE}TPicture{$ENDIF}); + procedure SetBackground(const Value: {$IFDEF VT_FMX}TBitmap{$ELSE}TPicture{$ENDIF}); procedure SetBackGroundImageTransparent(const Value: Boolean); procedure SetBackgroundOffset(const Index: Integer; const Value: TDimension); procedure SetBorderStyle(Value: TBorderStyle); @@ -2497,11 +2497,11 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF procedure SetVerticalAlignment(Node: PVirtualNode; Value: Byte); procedure SetVisible(Node: PVirtualNode; Value: Boolean); procedure SetVisiblePath(Node: PVirtualNode; Value: Boolean); - procedure PrepareBackGroundPicture(Source: {$IFDEF VT_FMX}TImage{$ELSE}TPicture{$ENDIF}; DrawBitmap: TBitmap; DrawBitmapWidth: TDimension; DrawBitMapHeight: TDimension; ABkgcolor: TColor); - procedure StaticBackground(Source: {$IFDEF VT_FMX}TImage{$ELSE}TPicture{$ENDIF}; Target: TCanvas; OffsetPosition: TPoint; R: TRect; aBkgColor: TColor); + procedure PrepareBackGroundPicture(Source: {$IFDEF VT_FMX}TBitmap{$ELSE}TPicture{$ENDIF}; ADrawBitmap: TBitmap; DrawBitmapWidth: TDimension; DrawBitMapHeight: TDimension; ABkgcolor: TColor); + procedure StaticBackground(Source: {$IFDEF VT_FMX}TBitmap{$ELSE}TPicture{$ENDIF}; Target: TCanvas; OffsetPosition: TPoint; R: TRect; aBkgColor: TColor); procedure StopTimer(ID: Integer); procedure SetWindowTheme(const Theme: string); - procedure TileBackground(Source: {$IFDEF VT_FMX}TImage{$ELSE}TPicture{$ENDIF}; Target: TCanvas; Offset: TPoint; R: TRect; aBkgColor: TColor); + procedure TileBackground(Source: {$IFDEF VT_FMX}TBitmap{$ELSE}TPicture{$ENDIF}; Target: TCanvas; Offset: TPoint; R: TRect; aBkgColor: TColor); {$IFDEF VT_VCL} function ToggleCallback(Step, StepSize: Integer; Data: Pointer): Boolean; @@ -2523,8 +2523,7 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF procedure TVMGetItem(var Message: TMessage); message TVM_GETITEM; procedure TVMGetItemRect(var Message: TMessage); message TVM_GETITEMRECT; procedure TVMGetNextItem(var Message: TMessage); message TVM_GETNEXTITEM; - procedure WMCancelMode(var Message: TWMCancelMode); message WM_CANCELMODE; - procedure WMChangeState(var Message: TMessage); message WM_CHANGESTATE; + procedure WMCancelMode(var Message: TWMCancelMode); message WM_CANCELMODE; procedure WMChar(var Message: TWMChar); message WM_CHAR; procedure WMContextMenu(var Message: TWMContextMenu); message WM_CONTEXTMENU; procedure WMCopy(var Message: TWMCopy); message WM_COPY; @@ -2558,6 +2557,7 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF procedure WMTimer(var Message: TWMTimer); message WM_TIMER; procedure WMThemeChanged(var Message: TMessage); message WM_THEMECHANGED; {$ENDIF} + procedure WMChangeState(var Message: TMessage); message WM_CHANGESTATE; procedure WMHScroll(var Message: TWMHScroll); {$IFDEF VT_FMX}virtual;{$ELSE}message WM_HSCROLL;{$ENDIF} procedure WMVScroll(var Message: TWMVScroll); {$IFDEF VT_FMX}virtual;{$ELSE}message WM_VSCROLL;{$ENDIF} procedure WMSize(var Message: TWMSize); {$IFDEF VT_FMX}virtual;{$ELSE}message WM_SIZE;{$ENDIF} @@ -2876,7 +2876,7 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF property AutoExpandDelay: Cardinal read FAutoExpandDelay write FAutoExpandDelay default 1000; property AutoScrollDelay: Cardinal read FAutoScrollDelay write FAutoScrollDelay default 1000; property AutoScrollInterval: TAutoScrollInterval read FAutoScrollInterval write FAutoScrollInterval default 1; - property Background: {$IFDEF VT_FMX}TImage{$ELSE}TPicture{$ENDIF} read FBackground write SetBackground; + property Background: {$IFDEF VT_FMX}TBitmap{$ELSE}TPicture{$ENDIF} read FBackground write SetBackground; property BackGroundImageTransparent: Boolean read FBackGroundImageTransparent write SetBackGroundImageTransparent default False; property BackgroundOffsetX: TDimension index 0 read FBackgroundOffsetX write SetBackgroundOffset{$IFDEF VT_VCL} default 0{$ENDIF}; property BackgroundOffsetY: TDimension index 1 read FBackgroundOffsetY write SetBackgroundOffset{$IFDEF VT_VCL} default 0{$ENDIF}; @@ -9332,8 +9332,8 @@ procedure TVirtualTreeColumns.PaintHeader(TargetCanvas: TCanvas; R: TRect; const else {$ENDIF} begin - {$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := FHeader.FBackgroundColor; - FillRect(BackgroundRect{$IFDEF VT_FMX}, 0, 0, [], 1.0{$ENDIF}); + Brush.Color := FHeader.FBackgroundColor; + FillRect(BackgroundRect); end; end; end; @@ -11272,8 +11272,8 @@ procedure TVTHeader.PrepareDrag(P, Start: TPoint); // Erase the entire image with the color key value, for the case not everything // in the image is covered by the header image. - Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := clBtnFace; - Canvas.FillRect(Rect(0, 0, Width, Height){$IFDEF VT_FMX}, 0, 0, [], 1.0{$ENDIF}); + Canvas.Brush.Color := clBtnFace; + Canvas.FillRect(Rect(0, 0, Width, Height)); if TreeView.UseRightToLeftAlignment then RTLOffset := Treeview.ComputeRTLOffset @@ -12547,7 +12547,7 @@ constructor TBaseVirtualTree.Create(AOwner: TComponent); FAutoScrollDelay := 1000; FAutoScrollInterval := 1; - FBackground := {$IFDEF VT_FMX}TImage.Create(Self){$ELSE}TPicture.Create{$ENDIF}; + FBackground := {$IFDEF VT_FMX}TBitmap.Create{$ELSE}TPicture.Create{$ENDIF}; // Similar to the Transparent property of TImage, // this flag is Off by default. FBackGroundImageTransparent := False; @@ -13347,19 +13347,19 @@ procedure TBaseVirtualTree.ClearNodeBackground(const PaintInfo: TVTPaintInfo; Us begin if toShowHorzGridLines in FOptions.PaintOptions then begin - {$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := BackColor; - FillRect(Rect(R.Left, R.Bottom - 1, R.Right, R.Bottom){$IFDEF VT_FMX}, 0, 0, [], 1.0{$ENDIF}); + Brush.Color := BackColor; + FillRect(Rect(R.Left, R.Bottom - 1, R.Right, R.Bottom)); Dec(R.Bottom); end; if {$IFDEF VT_FMX}IsFocused{$ELSE}Focused{$ENDIF} or (toPopupMode in FOptions.FPaintOptions) then begin - {$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := FColors.FocusedSelectionColor; - {$IFDEF VT_FMX}Stroke{$ELSE}Pen{$ENDIF}.Color := FColors.FocusedSelectionBorderColor; + Brush.Color := FColors.FocusedSelectionColor; + Pen.Color := FColors.FocusedSelectionBorderColor; end else begin - {$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := FColors.UnfocusedSelectionColor; - {$IFDEF VT_FMX}Stroke{$ELSE}Pen{$ENDIF}.Color := FColors.UnfocusedSelectionBorderColor; + Brush.Color := FColors.UnfocusedSelectionColor; + Pen.Color := FColors.UnfocusedSelectionBorderColor; end; with TWithSafeRect(R) do @@ -13371,8 +13371,8 @@ procedure TBaseVirtualTree.ClearNodeBackground(const PaintInfo: TVTPaintInfo; Us end else begin - {$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := BackColor; - FillRect(R{$IFDEF VT_FMX}, 0, 0, [], 1.0{$ENDIF}); + Brush.Color := BackColor; + FillRect(R); end; end; end; @@ -14647,8 +14647,8 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean); begin if FButtonStyle = bsTriangle then begin - FMinusBM.Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := clBlack; - FMinusBM.Canvas.{$IFDEF VT_FMX}Stroke{$ELSE}Pen{$ENDIF}.Color := clBlack; + FMinusBM.Canvas.Brush.Color := clBlack; + FMinusBM.Canvas.Pen.Color := clBlack; FMinusBM.Canvas.{$IFDEF VT_FMX}DrawPolygon{$ELSE}Polygon{$ENDIF}([Point(0, 2), Point(8, 2), Point(4, 6)]{$IFDEF VT_FMX}, 1.0{$ENDIF}); end else @@ -14658,9 +14658,9 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean); begin case FButtonFillMode of fmTreeColor: - FMinusBM.Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := FColors.BackGroundColor; + FMinusBM.Canvas.Brush.Color := FColors.BackGroundColor; fmWindowColor: - FMinusBM.Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := clWindow; + FMinusBM.Canvas.Brush.Color := clWindow; end; {$IFDEF VT_FMX} FMinusBM.Canvas.BeginScene(); @@ -14752,8 +14752,8 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean); begin if FButtonStyle = bsTriangle then begin - FPlusBM.Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := clBlack; - FPlusBM.Canvas.{$IFDEF VT_FMX}Stroke{$ELSE}Pen{$ENDIF}.Color := clBlack; + FPlusBM.Canvas.Brush.Color := clBlack; + FPlusBM.Canvas.Pen.Color := clBlack; FPlusBM.Canvas.{$IFDEF VT_FMX}DrawPolygon{$ELSE}Polygon{$ENDIF}([Point(2, 0), Point(6, 4), Point(2, 8)]{$IFDEF VT_FMX}, 1.0{$ENDIF}); end else @@ -14763,9 +14763,9 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean); begin case FButtonFillMode of fmTreeColor: - FPlusBM.Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := FColors.BackGroundColor; + FPlusBM.Canvas.Brush.Color := FColors.BackGroundColor; fmWindowColor: - FPlusBM.Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := clWindow; + FPlusBM.Canvas.Brush.Color := clWindow; end; {$IFDEF VT_FMX} FPlusBM.Canvas.BeginScene(); @@ -15004,7 +15004,7 @@ procedure TBaseVirtualTree.SetAnimationDuration(const Value: Cardinal); set the flag BackgroundTransparentExternalType explicitly in order to properly do transparent painting. } -procedure TBaseVirtualTree.SetBackground(const Value: {$IFDEF VT_FMX}TImage{$ELSE}TPicture{$ENDIF}); +procedure TBaseVirtualTree.SetBackground(const Value: {$IFDEF VT_FMX}TBitmap{$ELSE}TPicture{$ENDIF}); begin FBackground.Assign(Value); @@ -16185,8 +16185,8 @@ procedure TBaseVirtualTree.SetVisiblePath(Node: PVirtualNode; Value: Boolean); end; // ---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.PrepareBackGroundPicture(Source: {$IFDEF VT_FMX}TImage{$ELSE}TPicture{$ENDIF}; - DrawBitmap: TBitmap; DrawBitmapWidth: TDimension; DrawBitMapHeight: TDimension; ABkgcolor: TColor); +procedure TBaseVirtualTree.PrepareBackGroundPicture(Source: {$IFDEF VT_FMX}TBitmap{$ELSE}TPicture{$ENDIF}; + ADrawBitmap: TBitmap; DrawBitmapWidth: TDimension; DrawBitMapHeight: TDimension; ABkgcolor: TColor); const DST = $00AA0029; // Ternary Raster Operation - Destination unchanged @@ -16194,26 +16194,34 @@ procedure TBaseVirtualTree.PrepareBackGroundPicture(Source: {$IFDEF VT_FMX}TImag // will not disturb non-transparent ones procedure FillDrawBitmapWithBackGroundColor; begin - DrawBitmap.Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := ABkgcolor; - DrawBitmap.Canvas.FillRect(Rect(0, 0, DrawBitmap.Width, DrawBitmap.Height){$IFDEF VT_FMX}, 0, 0, [], 1.0{$ENDIF}); + ADrawBitmap.Canvas.Brush.Color := ABkgcolor; + ADrawBitmap.Canvas.FillRect(Rect(0, 0, ADrawBitmap.Width, ADrawBitmap.Height)); end; begin - DrawBitmap.SetSize({$IFDEF VT_FMX}Round{$ENDIF}(DrawBitmapWidth), {$IFDEF VT_FMX}Round{$ENDIF}(DrawBitMapHeight)); //TODO: round is not good at all!!! + ADrawBitmap.SetSize({$IFDEF VT_FMX}Round{$ENDIF}(DrawBitmapWidth), {$IFDEF VT_FMX}Round{$ENDIF}(DrawBitMapHeight)); //TODO: round is not good at all!!! {$IFDEF VT_FMX} - DrawBitmap.Canvas.DrawBitmap(//###!!! - Source.Bitmap + if ADrawBitmap.Canvas.BeginScene() then + try + ADrawBitmap.Canvas.DrawBitmap(//###!!! + Source , Rect(0, 0, Source.Width, Source.Height) , Rect(0, 0, Source.Width, Source.Height) , 1.0 ); + + finally + ADrawBitmap.Canvas.EndScene(); + end; + ADrawBitmap.SaveToFile('C:\ADrawBitmap.bmp'); + Source.SaveToFile('C:\Source.bmp'); {$ELSE} if (Source.Graphic is TBitmap) and (FBackGroundImageTransparent or Source.Bitmap.TRANSPARENT) then begin FillDrawBitmapWithBackGroundColor; - MaskBlt(DrawBitmap.Canvas.Handle, 0, 0, Source.Width, Source.Height, + MaskBlt(ADrawBitmap.Canvas.Handle, 0, 0, Source.Width, Source.Height, Source.Bitmap.Canvas.Handle, 0, 0, Source.Bitmap.MaskHandle, 0, 0, MakeROP4(DST, SRCCOPY)); end @@ -16223,14 +16231,14 @@ procedure TBaseVirtualTree.PrepareBackGroundPicture(Source: {$IFDEF VT_FMX}TImag // to draw transparent if the following flag is OFF. if FBackGroundImageTransparent then FillDrawBitmapWithBackGroundColor; - DrawBitmap.Canvas.Draw(0, 0, Source.Graphic); + ADrawBitmap.Canvas.Draw(0, 0, Source.Graphic); end {$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.StaticBackground(Source: {$IFDEF VT_FMX}TImage{$ELSE}TPicture{$ENDIF}; Target: TCanvas; OffsetPosition: TPoint; R: TRect; aBkgColor: TColor); +procedure TBaseVirtualTree.StaticBackground(Source: {$IFDEF VT_FMX}TBitmap{$ELSE}TPicture{$ENDIF}; Target: TCanvas; OffsetPosition: TPoint; R: TRect; aBkgColor: TColor); // Draws the given source graphic so that it stays static in the given rectangle which is relative to the target bitmap. // The graphic is aligned so that it always starts at the upper left corner of the target canvas. @@ -16248,8 +16256,8 @@ procedure TBaseVirtualTree.StaticBackground(Source: {$IFDEF VT_FMX}TImage{$ELSE} DrawBitmap := TBitmap.Create; try // clear background - Target.{$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := aBkgColor; - Target.FillRect(R{$IFDEF VT_FMX}, 0, 0, [], 1.0{$ENDIF}); + Target.Brush.Color := aBkgColor; + Target.FillRect(R); // Picture rect in relation to client viewscreen. PicRect := Rect(FBackgroundOffsetX, FBackgroundOffsetY, FBackgroundOffsetX + Source.Width, FBackgroundOffsetY + Source.Height); @@ -16521,7 +16529,7 @@ procedure TBaseVirtualTree.SetWindowTheme(const Theme: string); //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.TileBackground(Source: {$IFDEF VT_FMX}TImage{$ELSE}TPicture{$ENDIF}; Target: TCanvas; Offset: TPoint; R: TRect; aBkgColor: TColor); +procedure TBaseVirtualTree.TileBackground(Source: {$IFDEF VT_FMX}TBitmap{$ELSE}TPicture{$ENDIF}; Target: TCanvas; Offset: TPoint; R: TRect; aBkgColor: TColor); // Draws the given source graphic so that it tiles into the given rectangle which is relative to the target bitmap. // The graphic is aligned so that it always starts at the upper left corner of the target canvas. @@ -16531,16 +16539,19 @@ procedure TBaseVirtualTree.TileBackground(Source: {$IFDEF VT_FMX}TImage{$ELSE}TP SourceX, SourceY, TargetX, - DeltaY: Integer; - DrawBitmap: TBitmap; -begin -{$IFDEF VT_VCL} - DrawBitmap := TBitmap.Create; + DeltaY: TDimension; + BMP: TBitmap; +begin + BMP := TBitmap.Create; try - PrepareBackGroundPicture(Source, DrawBitmap, Source.Width, Source.Height, aBkgColor); + PrepareBackGroundPicture(Source, BMP, Source.Width, Source.Height, aBkgColor); with Target do begin + {$IFDEF VT_FMX} + SourceY := FMod((R.Top + Offset.Y + FBackgroundOffsetY), Source.Height); + {$ELSE} SourceY := (R.Top + Offset.Y + FBackgroundOffsetY) mod Source.Height; + {$ENDIF} // Always wrap the source coordinates into positive range. if SourceY < 0 then SourceY := Source.Height + SourceY; @@ -16548,7 +16559,11 @@ procedure TBaseVirtualTree.TileBackground(Source: {$IFDEF VT_FMX}TImage{$ELSE}TP // Tile image vertically until target rect is filled. while R.Top < R.Bottom do begin + {$IFDEF VT_FMX} + SourceX := FMod((R.Left + Offset.X + FBackgroundOffsetX), Source.Width); + {$ELSE} SourceX := (R.Left + Offset.X + FBackgroundOffsetX) mod Source.Width; + {$ENDIF} // always wrap the source coordinates into positive range if SourceX < 0 then SourceX := Source.Width + SourceX; @@ -16560,8 +16575,17 @@ procedure TBaseVirtualTree.TileBackground(Source: {$IFDEF VT_FMX}TImage{$ELSE}TP // tile the image horizontally while TargetX < R.Right do begin + {$IFDEF VT_FMX} + Target.DrawBitmap(//###!!! + BMP + , Rect(TargetX, R.Top, TargetX + Min(R.Right - TargetX, Source.Width - SourceX), R.Top+DeltaY) + , Rect(SourceX, SourceY, SourceX + Min(R.Right - TargetX, Source.Width - SourceX), SourceY+R.Top+DeltaY) + , 1.0 + ); + {$ELSE} BitBlt(Handle, TargetX, R.Top, Min(R.Right - TargetX, Source.Width - SourceX), DeltaY, - DrawBitmap.Canvas.Handle, SourceX, SourceY, SRCCOPY); + BMP.Canvas.Handle, SourceX, SourceY, SRCCOPY); + {$ENDIF} Inc(TargetX, Source.Width - SourceX); SourceX := 0; end; @@ -16570,9 +16594,8 @@ procedure TBaseVirtualTree.TileBackground(Source: {$IFDEF VT_FMX}TImage{$ELSE}TP end; end; finally - DrawBitmap.Free; + BMP.Free; end; -{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -17467,7 +17490,7 @@ procedure TBaseVirtualTree.WMCancelMode(var Message: TWMCancelMode); inherited; end; - +{$ENDIF} //---------------------------------------------------------------------------------------------------------------------- procedure TBaseVirtualTree.WMChangeState(var Message: TMessage); @@ -17501,7 +17524,7 @@ procedure TBaseVirtualTree.WMChangeState(var Message: TMessage); end; //---------------------------------------------------------------------------------------------------------------------- - +{$IFDEF VT_VCL} procedure TBaseVirtualTree.WMChar(var Message: TWMChar); begin @@ -19644,7 +19667,6 @@ procedure TBaseVirtualTree.ChangeTreeStatesAsync(EnterStates, LeaveStates: TChan if (Self.HandleAllocated) then TThread.Queue(nil, procedure begin WMChangeState(lMessage) end); // SendMessage(Self.Handle, WM_CHANGESTATE, Byte(EnterStates), Byte(LeaveStates)); -{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -22794,12 +22816,12 @@ procedure TBaseVirtualTree.DrawDottedVLine(const PaintInfo: TVTPaintInfo; Top, B if UseSelectedBkColor then begin if {$IFDEF VT_FMX}IsFocused{$ELSE}Focused{$ENDIF} or (toPopupMode in FOptions.FPaintOptions) then - {$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := FColors.FocusedSelectionColor + Brush.Color := FColors.FocusedSelectionColor else - {$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := FColors.UnfocusedSelectionColor; + Brush.Color := FColors.UnfocusedSelectionColor; end else - {$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := FColors.BackGroundColor; + Brush.Color := FColors.BackGroundColor; R := Rect(Left, Min(Top, Bottom), Left + 1, Max(Top, Bottom) + 1); {$IFDEF VT_FMX} FillRect(R, 0, 0, [], 1.0, dottedBrush); @@ -25268,7 +25290,7 @@ procedure TBaseVirtualTree.OriginalWMNCPaint({$IFDEF VT_FMX}ACanvas: TCanvas{$EL ExcludeClipRect(DC, RC.Left, RC.Top, RC.Right, RC.Bottom); // Erase parts not drawn. - {$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := FColors.BorderColor; + Brush.Color := FColors.BorderColor; Winapi.Windows.FillRect(DC, RW, Brush.Handle); end; {$ENDIF} @@ -25755,7 +25777,7 @@ procedure TBaseVirtualTree.PaintSelectionRectangle(Target: TCanvas; WindowOrgX: dummyCanvas.Handle:= prevDC; end; - Target.{$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := FColors.SelectionRectangleBorderColor; + Target.Brush.Color := FColors.SelectionRectangleBorderColor; Target.FrameRect(SelectionRect); end; end; @@ -25901,8 +25923,8 @@ procedure TBaseVirtualTree.PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX, with FHeader.FColumns do if poColumnColor in PaintOptions then begin - {$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := Items[Column].GetEffectiveColor; - FillRect(CellRect{$IFDEF VT_FMX}, 0, 0, [], 1.0{$ENDIF}); + Brush.Color := Items[Column].GetEffectiveColor; + FillRect(CellRect); end; // Let the application customize the cell background and the content rectangle. @@ -25941,8 +25963,8 @@ procedure TBaseVirtualTree.PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX, begin if (FLastDropMode = dmOnNode) or (vsSelected in Node.States) then begin - {$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := FColors.DropTargetColor; - {$IFDEF VT_FMX}Stroke{$ELSE}Pen{$ENDIF}.Color := FColors.DropTargetBorderColor; + Brush.Color := FColors.DropTargetColor; + Pen.Color := FColors.DropTargetBorderColor; if (toGridExtensions in FOptions.FMiscOptions) or (toFullRowSelect in FOptions.FSelectionOptions) then @@ -25954,7 +25976,7 @@ procedure TBaseVirtualTree.PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX, else {$ENDIF} if (toUseBlendedSelection in FOptions.PaintOptions) then - AlphaBlendSelection({$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color) + AlphaBlendSelection(Brush.Color) else with TWithSafeRect(InnerRect) do begin @@ -25980,13 +26002,13 @@ procedure TBaseVirtualTree.PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX, begin if {$IFDEF VT_FMX}IsFocused{$ELSE}Focused{$ENDIF} or (toPopupMode in FOptions.FPaintOptions) then begin - {$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := FColors.FocusedSelectionColor; - {$IFDEF VT_FMX}Stroke{$ELSE}Pen{$ENDIF}.Color := FColors.FocusedSelectionBorderColor; + Brush.Color := FColors.FocusedSelectionColor; + Pen.Color := FColors.FocusedSelectionBorderColor; end else begin - {$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := FColors.UnfocusedSelectionColor; - {$IFDEF VT_FMX}Stroke{$ELSE}Pen{$ENDIF}.Color := FColors.UnfocusedSelectionBorderColor; + Brush.Color := FColors.UnfocusedSelectionColor; + Pen.Color := FColors.UnfocusedSelectionBorderColor; end; if (toGridExtensions in FOptions.FMiscOptions) or (toFullRowSelect in FOptions.FSelectionOptions) then InnerRect := CellRect; @@ -26002,7 +26024,7 @@ procedure TBaseVirtualTree.PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX, else {$ENDIF} if (toUseBlendedSelection in FOptions.PaintOptions) then - AlphaBlendSelection({$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color) + AlphaBlendSelection(Brush.Color) else with TWithSafeRect(InnerRect) do {$IFDEF VT_FMX} @@ -32134,7 +32156,7 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe R := Rect(0, 0, Max(FRangeX, ClientWidth), 0); // For quick checks some intermediate variables are used. - UseBackground := (toShowBackground in FOptions.FPaintOptions) and Assigned(FBackground.{$IFDEF VT_FMX}Bitmap{$ELSE}Graphic{$ENDIF}) and + UseBackground := (toShowBackground in FOptions.FPaintOptions) and {$IFDEF VT_FMX}Assigned(FBackground) and not FBackground.IsEmpty{$ELSE}Assigned(FBackground.Graphic){$ENDIF} and (poBackground in PaintOptions); ShowImages := Assigned(FImages) or Assigned(OnGetImageIndexEx); ShowStateImages := Assigned(FStateImages) or Assigned(OnGetImageIndexEx); @@ -32706,10 +32728,10 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe end; if not (coParentColor in Items[FirstColumn].FOptions) then - PaintInfo.Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := Items[FirstColumn].FColor + PaintInfo.Canvas.Brush.Color := Items[FirstColumn].FColor else - PaintInfo.Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := FColors.BackGroundColor; - PaintInfo.Canvas.FillRect(R{$IFDEF VT_FMX}, 0, 0, [], 1.0{$ENDIF}); + PaintInfo.Canvas.Brush.Color := FColors.BackGroundColor; + PaintInfo.Canvas.FillRect(R); end; FirstColumn := GetNextVisibleColumn(FirstColumn); end; @@ -32724,8 +32746,8 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe (toFullVertGridLines in FOptions.FPaintOptions) and (toShowVertGridLines in FOptions.FPaintOptions) and (not (hoAutoResize in FHeader.FOptions)) then Inc(R.Left); - PaintInfo.Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := FColors.BackGroundColor; - PaintInfo.Canvas.FillRect(R{$IFDEF VT_FMX}, 0, 0, [], 1.0{$ENDIF}); + PaintInfo.Canvas.Brush.Color := FColors.BackGroundColor; + PaintInfo.Canvas.FillRect(R); end; end; {$IFDEF VT_VCL} @@ -32738,8 +32760,8 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe {$IFDEF VT_VCL} SetCanvasOrigin(PaintInfo.Canvas, 0, 0); {$ENDIF} - PaintInfo.Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := FColors.BackGroundColor; - PaintInfo.Canvas.FillRect(TargetRect{$IFDEF VT_FMX}, 0, 0, [], 1.0{$ENDIF}); + PaintInfo.Canvas.Brush.Color := FColors.BackGroundColor; + PaintInfo.Canvas.FillRect(TargetRect); end; end; end; @@ -32898,7 +32920,7 @@ procedure TBaseVirtualTree.PrepareDragImage(HotSpot: TPoint; const DataObject: { SetSize(TreeRect.Right - TreeRect.Left, TreeRect.Bottom - TreeRect.Top); // Erase the entire image with the color key value, for the case not everything // in the image is covered by the tree image. - Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := FColors.BackGroundColor; + Canvas.Brush.Color := FColors.BackGroundColor; Canvas.FillRect(Rect(0, 0, Width, Height)); PaintOptions := [poDrawSelection, poSelectedOnly]; @@ -33051,7 +33073,7 @@ procedure TBaseVirtualTree.Print(Printer: TPrinter; PrintHeader: Boolean); SrcRect.Bottom := SrcRect.Top + vPageHeight; // Clear the image - PrinterImage.Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Brush{$ENDIF}.Color := clWhite; + PrinterImage.Canvas.Brush.Color := clWhite; PrinterImage.Canvas.FillRect(Rect(0, 0, PrinterImage.Width, PrinterImage.Height)); PrinterImage.Canvas.CopyRect(DestRect, Image.Canvas, SrcRect); PrtStretchDrawDIB(Printer.Canvas, Rect(0, 0, Printer.PageWidth, Printer.PageHeight - 1), PrinterImage); From 6a4e5cdbcb40b124bdb6d1f74d1e6e53531bc63c Mon Sep 17 00:00:00 2001 From: livius2 Date: Tue, 20 Nov 2018 13:23:03 +0100 Subject: [PATCH 47/61] Fix warnings nad some hints --- Source/VirtualTrees.Export.pas | 6 +- Source/VirtualTrees.FMX.pas | 36 ++++++-- Source/VirtualTrees.Utils.pas | 10 +- Source/VirtualTrees.pas | 161 ++++++++++++++++++--------------- 4 files changed, 122 insertions(+), 91 deletions(-) diff --git a/Source/VirtualTrees.Export.pas b/Source/VirtualTrees.Export.pas index 0d92d0205..0bbbb6ec0 100644 --- a/Source/VirtualTrees.Export.pas +++ b/Source/VirtualTrees.Export.pas @@ -14,11 +14,11 @@ interface {$IFDEF VT_FMX} uses System.SysUtils, FMX.Graphics, System.Classes, FMX.Forms, FMX.Controls, System.StrUtils, System.Generics.Collections, - VirtualTrees, VirtualTrees.Classes, FMX.Types, VirtualTrees.FMX; + VirtualTrees, VirtualTrees.Classes, FMX.Types, System.UITypes, VirtualTrees.FMX; {$ELSE} uses Winapi.Windows, System.SysUtils, Vcl.Graphics, System.Classes, Vcl.Forms, Vcl.Controls, System.StrUtils, System.Generics.Collections, - VirtualTrees, VirtualTrees.Classes; + VirtualTrees, VirtualTrees.Classes, UITypes; {$ENDIF} function ContentToHTML(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceType; const Caption: string = ''): String; @@ -30,8 +30,6 @@ function ContentToClipboard(Tree: TCustomVirtualStringTree; Format: Word; Source procedure ContentToCustom(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceType); implementation -uses - UITypes; type TCustomVirtualStringTreeCracker = class(TCustomVirtualStringTree) diff --git a/Source/VirtualTrees.FMX.pas b/Source/VirtualTrees.FMX.pas index a50293097..698abb16a 100644 --- a/Source/VirtualTrees.FMX.pas +++ b/Source/VirtualTrees.FMX.pas @@ -431,7 +431,7 @@ procedure ZeroMemory(Destination: Pointer; Length: NativeUInt); procedure MoveMemory(Destination: Pointer; Source: Pointer; Length: NativeUInt); procedure CopyMemory(Destination: Pointer; Source: Pointer; Length: NativeUInt); -procedure DrawTextW(ACanvas: TCanvas; CaptionText: String; Len: Integer; Bounds: TRect; DrawFormat: Cardinal{this is windows format - must be converted to FMX}); +procedure DrawTextW(ACanvas: TCanvas; CaptionText: String; Len: Integer; Var Bounds: TRect; DrawFormat: Cardinal{this is windows format - must be converted to FMX}); procedure GetTextExtentPoint32W(ACanvas: TCanvas; CaptionText: String; Len: Integer; Var Size: TSize); procedure DrawEdge(Canvas: TCanvas; R: TRect; edge, grfFlags: Cardinal); @@ -923,24 +923,42 @@ procedure FillTWMMouse(Var MM: TWMMouse; Button: TMouseButton; Shift: TShiftStat //---------------------------------------------------------------------------------------------------------------------- -procedure DrawTextW(ACanvas: TCanvas; CaptionText: String; Len: Integer; Bounds: TRect; DrawFormat: Cardinal{this is windows format - must be converted to FMX}); +procedure DrawTextW(ACanvas: TCanvas; CaptionText: String; Len: Integer; Var Bounds: TRect; DrawFormat: Cardinal{this is windows format - must be converted to FMX}); +Var + hAlign: TTextAlign; + vAlign: TTextAlign; + Flags: TFillTextFlags; begin //TTextLayout. render - //DrawFormat: Cardinal{this is windows format - must be converted to FMX} - ACanvas.FillText(Bounds, CaptionText, false, 1.0, [], TTextAlign.Leading, TTextAlign.Center); + //TODO: DrawFormat: Cardinal{this is windows format - must be converted to FMX} + + hAlign:= TTextAlign.Leading; + if DrawFormat and DT_CENTER<>0 then + hAlign:= TTextAlign.Center; + if DrawFormat and DT_RIGHT<>0 then + hAlign:= TTextAlign.Trailing; + + + vAlign:= TTextAlign.Center; + if DrawFormat and DT_VCENTER<>0 then + vAlign:= TTextAlign.Center; + if DrawFormat and DT_BOTTOM<>0 then + vAlign:= TTextAlign.Trailing; + + Flags:= []; + + if DrawFormat and DT_RTLREADING<>0 then + Flags:= Flags + [TFillTextFlag.RightToLeft]; + + ACanvas.FillText(Bounds, CaptionText, false, 1.0, Flags, hAlign, vAlign); end; //---------------------------------------------------------------------------------------------------------------------- procedure DrawEdge(Canvas: TCanvas; R: TRect; edge, grfFlags: Cardinal); Var tmpR: TRect; - dL, dT, dR, dB: Integer; IsSoft, IsFlat, IsMono: Boolean; begin - dL:= 0; - dT:= 0; - dR:= 0; - dB:= 0; if grfFlags and BF_SOFT<>0 then IsSoft:= true else diff --git a/Source/VirtualTrees.Utils.pas b/Source/VirtualTrees.Utils.pas index b6286a126..584955761 100644 --- a/Source/VirtualTrees.Utils.pas +++ b/Source/VirtualTrees.Utils.pas @@ -42,7 +42,8 @@ interface System.ImageList, FMX.Types, VirtualTrees, - VirtualTrees.FMX; + VirtualTrees.FMX, + System.UITypes; {$ELSE} Winapi.Windows, Winapi.ActiveX, @@ -63,7 +64,7 @@ interface ); -procedure AlphaBlend(Source, Destination: TCanvas; R: TRect; Target: TPoint; Mode: TBlendMode; ConstantAlpha, Bias: Integer); +procedure AlphaBlend(Source, Destination: TCanvas; R: TRect; Target: TPoint; Mode: TBlendMode; ConstantAlpha: Integer; Bias: {$IFDEF VT_FMX}TAlphaColor{$ELSE}Integer{$ENDIF}); {$IFDEF VT_VCL} function GetRGBColor(Value: TColor): DWORD; procedure PrtStretchDrawDIB(Canvas: TCanvas; DestRect: TRect; ABitmap: TBitmap); @@ -331,7 +332,7 @@ procedure GetTextExtentPoint32W(ACanvas: TCanvas; CaptionText: String; Len: Inte //---------------------------------------------------------------------------------------------------------------------- function WrapString(ACanvas: TCanvas; const S: string; const Bounds: TRect; RTL: Boolean; DrawFormat: Cardinal): string; - +{$IFDEF VT_VCL} var Width, Len, @@ -342,6 +343,7 @@ function WrapString(ACanvas: TCanvas; const S: string; const Bounds: TRect; RTL: Line: string; Words: array of string; R: TRect; +{$ENDIF} begin {$IFDEF VT_FMX} Result:= S; @@ -1075,7 +1077,7 @@ procedure AlphaBlendLineMasterAndColor(Destination: Pointer; Count: Integer; Con {$ENDIF} {$IFDEF VT_FMX} -procedure AlphaBlend(Source, Destination: TCanvas; R: TRect; Target: TPoint; Mode: TBlendMode; ConstantAlpha, Bias: Integer); +procedure AlphaBlend(Source, Destination: TCanvas; R: TRect; Target: TPoint; Mode: TBlendMode; ConstantAlpha: Integer; Bias: {$IFDEF VT_FMX}TAlphaColor{$ELSE}Integer{$ENDIF}); // R describes the source rectangle to work on. // Target is the place (upper left corner) in the target bitmap where to blend to. Note that source width + X offset diff --git a/Source/VirtualTrees.pas b/Source/VirtualTrees.pas index e20ed8540..577377c87 100644 --- a/Source/VirtualTrees.pas +++ b/Source/VirtualTrees.pas @@ -2430,7 +2430,7 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF function GetTopNode: PVirtualNode; function GetTotalCount: Cardinal; function GetVerticalAlignment(Node: PVirtualNode): Byte; - function GetVisible(Node: PVirtualNode): Boolean; + function GetIsVisible(Node: PVirtualNode): Boolean; function GetVisiblePath(Node: PVirtualNode): Boolean; function HandleDrawSelection(X, Y: TDimension): Boolean; function HasVisibleNextSibling(Node: PVirtualNode): Boolean; @@ -2495,7 +2495,7 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF procedure SetTopNode(Node: PVirtualNode); procedure SetUpdateState(Updating: Boolean); procedure SetVerticalAlignment(Node: PVirtualNode; Value: Byte); - procedure SetVisible(Node: PVirtualNode; Value: Boolean); + procedure SetIsVisible(Node: PVirtualNode; Value: Boolean); procedure SetVisiblePath(Node: PVirtualNode; Value: Boolean); procedure PrepareBackGroundPicture(Source: {$IFDEF VT_FMX}TBitmap{$ELSE}TPicture{$ENDIF}; ADrawBitmap: TBitmap; DrawBitmapWidth: TDimension; DrawBitMapHeight: TDimension; ABkgcolor: TColor); procedure StaticBackground(Source: {$IFDEF VT_FMX}TBitmap{$ELSE}TPicture{$ENDIF}; Target: TCanvas; OffsetPosition: TPoint; R: TRect; aBkgColor: TColor); @@ -2569,12 +2569,13 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF function GetClientHeight: Single; function GetClientWidth: Single; function GetClientRect: TRect; - procedure Resize; override; {$ENDIF} protected FFontChanged: Boolean; // flag for keeping informed about font changes in the off screen buffer // [IPK] - private to protected + {$IFDEF VT_VCL} dummyCanvas: TCanvas; // for painting using native handle + {$ENDIF} {$IFDEF VT_FMX} FUseRightToLeftAlignment: Boolean; procedure SetBevelCut(Index: Integer; const Value: TBevelCut); @@ -2712,8 +2713,8 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF 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(); {$IFDEF VT_FMX}reintroduce; overload;{$ENDIF} virtual; + procedure DoMouseLeave(); {$IFDEF VT_FMX}reintroduce; overload;{$ENDIF} virtual; procedure DoNodeCopied(Node: PVirtualNode); virtual; function DoNodeCopying(Node, NewParent: PVirtualNode): Boolean; virtual; procedure DoNodeClick(const HitInfo: THitInfo); virtual; @@ -2749,9 +2750,9 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF procedure DragCanceled; {$IFDEF VT_FMX}virtual{$ELSE}override{$ENDIF}; function DragDrop(const DataObject: {$IFDEF VT_FMX}TDragObject{$ELSE}IDataObject{$ENDIF}; KeyState: Integer; Pt: TPoint; var Effect: Integer): HResult; reintroduce; virtual; - function DragEnter(KeyState: Integer; Pt: TPoint; var Effect: Integer): HResult; virtual; + function DragEnter(KeyState: Integer; Pt: TPoint; var Effect: Integer): HResult; {$IFDEF VT_FMX}reintroduce; overload;{$ENDIF} virtual; procedure DragFinished; virtual; - procedure DragLeave; virtual; + procedure DragLeave; {$IFDEF VT_FMX}reintroduce; overload;{$ENDIF} virtual; function DragOver(Source: TObject; KeyState: Integer; DragState: TDragState; Pt: TPoint; var Effect: Integer): HResult; reintroduce; virtual; procedure DrawDottedHLine(const PaintInfo: TVTPaintInfo; Left, Right, Top: TDimension{$IFDEF VT_FMX}; dottedBrush: TBrush{$ENDIF}); virtual; @@ -2786,6 +2787,7 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF {$IFDEF VT_FMX} procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Single; Y: Single); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Single; Y: Single); override; + procedure Resize; override; {$ENDIF} procedure HandleMouseDblClick(var Message: TWMMouse; const HitInfo: THitInfo); virtual; procedure HandleMouseDown(var Message: TWMMouse; var HitInfo: THitInfo); virtual; @@ -3089,7 +3091,7 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF procedure Assign(Source: TPersistent); override; procedure BeginDrag(Immediate: Boolean; Threshold: Integer = -1); procedure BeginSynch; - procedure BeginUpdate; virtual; + procedure BeginUpdate; {$IFDEF VT_FMX}reintroduce; overload;{$ENDIF} virtual; procedure CancelCutOrCopy; function CancelEditNode: Boolean; procedure CancelOperation; @@ -3112,7 +3114,7 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF function EditNode(Node: PVirtualNode; Column: TColumnIndex): Boolean; virtual; function EndEditNode: Boolean; procedure EndSynch; - procedure EndUpdate; virtual; + procedure EndUpdate; {$IFDEF VT_FMX}reintroduce; overload;{$ENDIF} virtual; procedure EnsureNodeSelected(); virtual; function ExecuteAction(Action: TBasicAction): Boolean; override; procedure FinishCutOrCopy; @@ -3247,7 +3249,7 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF 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); {$IFDEF VT_FMX}reintroduce; overload;{$ENDIF} virtual; procedure SortTree(Column: TColumnIndex; Direction: TSortDirection; DoInit: Boolean = True); virtual; procedure ToggleNode(Node: PVirtualNode); procedure UpdateHorizontalRange; virtual; @@ -3308,7 +3310,7 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF property IsEffectivelyFiltered[Node: PVirtualNode]: Boolean read GetEffectivelyFiltered; property IsEffectivelyVisible[Node: PVirtualNode]: Boolean read GetEffectivelyVisible; property IsFiltered[Node: PVirtualNode]: Boolean read GetFiltered write SetFiltered; - property IsVisible[Node: PVirtualNode]: Boolean read GetVisible write SetVisible; + property IsVisible[Node: PVirtualNode]: Boolean read GetIsVisible write SetIsVisible; property MultiLine[Node: PVirtualNode]: Boolean read GetMultiline write SetMultiline; property NodeHeight[Node: PVirtualNode]: TDimension read GetNodeHeight write SetNodeHeight; property NodeParent[Node: PVirtualNode]: PVirtualNode read GetNodeParent write SetNodeParent; @@ -3427,9 +3429,8 @@ TVTEdit = class(TCustomEdit) {$ENDIF} public constructor Create(Link: TStringEditLink); reintroduce; - - procedure Release; virtual; {$IFDEF VT_VCL} + procedure Release; virtual; property AutoSelect; property AutoSize; property BorderStyle; @@ -5920,7 +5921,7 @@ function TVirtualTreeHintWindow.CalcHintRect(MaxWidth: Integer; const AHint: str // If the node height and the column width are both already large enough to cover the entire text, // then we don't need the hint, though. // However if the text is partially scrolled out of the client area then a hint is useful as well. - if (Tree.Header.Columns.Count > 0) and ((Integer(Tree.NodeHeight[Node]) + 2) >= (Result.Bottom - Result.Top)) and + if (Tree.Header.Columns.Count > 0) and ((Tree.NodeHeight[Node] + 2) >= (Result.Bottom - Result.Top)) and ((Tree.Header.Columns[Column].Width + 2) >= (Result.Right - Result.Left)) and not ((Result.Left < 0) or (Result.Right > Tree.ClientWidth + 3) or (Result.Top < 0) or (Result.Bottom > Tree.ClientHeight + 3)) then @@ -7240,12 +7241,12 @@ procedure TVirtualTreeColumn.ComputeHeaderLayout(ACanvas: TCanvas; Client: TRect begin if UseHeaderGlyph then if not FCheckBox then - HeaderGlyphSize := {$IFDEF VT_FMX}PointF(16, 16){$ELSE}Point(FImages.Width, FImages.Height){$ENDIF} //TODO: 16px Image! + HeaderGlyphSize := {$IFDEF VT_FMX}Point(16, 16){$ELSE}Point(FImages.Width, FImages.Height){$ENDIF} //TODO: 16px Image! else with Self.Owner.Header.Treeview do begin if Assigned(FCheckImages) then - HeaderGlyphSize := {$IFDEF VT_FMX}PointF(16, 16){$ELSE}Point(FCheckImages.Width, FCheckImages.Height){$ENDIF}; //TODO: 16px Image! + HeaderGlyphSize := {$IFDEF VT_FMX}Point(16, 16){$ELSE}Point(FCheckImages.Width, FCheckImages.Height){$ENDIF}; //TODO: 16px Image! end else HeaderGlyphSize := Point(0, 0); @@ -8148,10 +8149,10 @@ procedure TVirtualTreeColumns.DrawButtonText(ACanvas: TCanvas; Caption: string; begin {$IFDEF VT_FMX} ACanvas.Fill.Color:= FHeader.Treeview.FColors.HeaderFontColor; - DrawTextW(ACanvas, Caption, Length(Caption), Bounds, DrawFormat); + DrawTextW(ACanvas, Caption, Length(Caption), Bounds, DrawFormat); {$ELSE} SetTextColor(ACanvas.Handle, ColorToRGB(FHeader.Treeview.FColors.HeaderFontColor)); - Winapi.Windows.DrawTextW(ACanvas.Handle, PWideChar(Caption), Length(Caption), Bounds, DrawFormat); + Winapi.Windows.DrawTextW(ACanvas.Handle, PWideChar(Caption), Length(Caption), Bounds, DrawFormat); {$ENDIF} end else @@ -12453,7 +12454,10 @@ constructor TBaseVirtualTree.Create(AOwner: TComponent); InitializeGlobalStructures(); inherited; + {$IFDEF VT_VCL} dummyCanvas:= TCanvas.Create; + {$ENDIF} + {$IFDEF VT_FMX} FHandleAllocated:= true; FUseRightToLeftAlignment:= false; @@ -12668,9 +12672,9 @@ destructor TBaseVirtualTree.Destroy; FHotMinusBM.Free; FSelectedHotPlusBM.Free; FSelectedHotMinusBM.Free; - + {$IFDEF VT_VCL} FreeAndNil(dummyCanvas); - + {$ENDIF} inherited; end; @@ -13323,13 +13327,8 @@ procedure TBaseVirtualTree.ClearNodeBackground(const PaintInfo: TVTPaintInfo; Us eaColor: begin // User has given a new background color. -{$IFDEF VT_FMX} - Fill.Color := BackColor; - FillRect(R, 0, 0, [], 1.0); -{$ELSE} Brush.Color := BackColor; FillRect(R); -{$ENDIF} end; else // eaDefault if UseBackground then @@ -14027,7 +14026,7 @@ function TBaseVirtualTree.GetVerticalAlignment(Node: PVirtualNode): Byte; //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.GetVisible(Node: PVirtualNode): Boolean; +function TBaseVirtualTree.GetIsVisible(Node: PVirtualNode): Boolean; // Determines if the given node is marked as being visible. @@ -14665,7 +14664,7 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean); {$IFDEF VT_FMX} FMinusBM.Canvas.BeginScene(); FMinusBM.Canvas.Blending:= false; - FMinusBM.Canvas.Stroke.Kind := TBrushKind.bkSolid; + FMinusBM.Canvas.Stroke.Kind := TBrushKind.Solid; FMinusBM.Canvas.Stroke.Color := FColors.TreeLineColor; FMinusBM.Canvas.FillRect(Rect(0, 0, FMinusBM.Width, FMinusBM.Height), 0, 0, [], 1.0); FMinusBM.Canvas.DrawRect(Rect(0, 0, FMinusBM.Width, FMinusBM.Height), 0, 0, [], 1.0); @@ -14770,7 +14769,7 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean); {$IFDEF VT_FMX} FPlusBM.Canvas.BeginScene(); FPlusBM.Canvas.Blending := false; - FPlusBM.Canvas.Stroke.Kind := TBrushKind.bkSolid; + FPlusBM.Canvas.Stroke.Kind := TBrushKind.Solid; FPlusBM.Canvas.Stroke.Color := FColors.TreeLineColor; FPlusBM.Canvas.FillRect(Rect(0, 0, FPlusBM.Width-1, FPlusBM.Height), 0, 0, [], 1.0); FPlusBM.Canvas.DrawRect(Rect(0, 0, FPlusBM.Width-1, FPlusBM.Height), 0, 0, [], 1.0); @@ -16106,7 +16105,7 @@ procedure TBaseVirtualTree.SetVerticalAlignment(Node: PVirtualNode; Value: Byte) //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.SetVisible(Node: PVirtualNode; Value: Boolean); +procedure TBaseVirtualTree.SetIsVisible(Node: PVirtualNode; Value: Boolean); // Sets the visibility style of the given node according to Value. @@ -16741,7 +16740,7 @@ procedure TBaseVirtualTree.CMBiDiModeChanged(var Message: TMessage); inherited; if UseRightToLeftAlignment then - FEffectiveOffsetX := Integer(FRangeX) - ClientWidth + FOffsetX + FEffectiveOffsetX := FRangeX - ClientWidth + FOffsetX else FEffectiveOffsetX := -FOffsetX; if FEffectiveOffsetX < 0 then @@ -18015,7 +18014,7 @@ procedure TBaseVirtualTree.WMKeyDown(var Message: TWMKeyDown); begin // scrolling without selection change if ssCtrl in Shift then - SetOffsetY(FOffsetY + Integer(FDefaultNodeHeight)) + SetOffsetY(FOffsetY + FDefaultNodeHeight) else begin if FFocusedNode = nil then @@ -18043,7 +18042,7 @@ procedure TBaseVirtualTree.WMKeyDown(var Message: TWMKeyDown); begin // scrolling without selection change if ssCtrl in Shift then - SetOffsetY(FOffsetY - Integer(FDefaultNodeHeight)) + SetOffsetY(FOffsetY - FDefaultNodeHeight) else begin if FFocusedNode = nil then @@ -18590,7 +18589,7 @@ procedure TBaseVirtualTree.WMMButtonDown(var Message: TWMMButtonDown); // Start wheel panning or scrolling if not already active, allowed and scrolling is useful at all. if (toWheelPanning in FOptions.FMiscOptions) and ([tsWheelScrolling, tsWheelPanning] * FStates = []) and - ((Integer(FRangeX) > ClientWidth) or (Integer(FRangeY) > ClientHeight)) then + ((FRangeX > ClientWidth) or (FRangeY > ClientHeight)) then begin FLastClickPos := SmallPointToPoint(Message.Pos); StartWheelPanning(FLastClickPos); @@ -19272,8 +19271,8 @@ procedure TBaseVirtualTree.AdjustPanningCursor(X, Y: TDimension); {$ENDIF} begin {$IFDEF VT_VCL} - ScrollHorizontal := Integer(FRangeX) > ClientWidth; - ScrollVertical := Integer(FRangeY) > ClientHeight; + ScrollHorizontal := FRangeX > ClientWidth; + ScrollVertical := FRangeY > ClientHeight; if (Abs(X - FLastClickPos.X) < 8) and (Abs(Y - FLastClickPos.Y) < 8) then begin @@ -22167,7 +22166,7 @@ procedure TBaseVirtualTree.DoTimerScroll; DeltaY := -Min(FScrollBarOptions.FIncrementY, ClientHeight) else DeltaY := -Min(FScrollBarOptions.FIncrementY, ClientHeight) * Abs(P.Y - R.Bottom); - if (ClientHeight - FOffsetY) = Integer(FRangeY) then + if (ClientHeight - FOffsetY) = FRangeY then Exclude(FScrollDirections, sdDown); end; @@ -22194,7 +22193,7 @@ procedure TBaseVirtualTree.DoTimerScroll; else DeltaX := -FScrollBarOptions.FIncrementX * Abs(P.X - R.Right); - if (ClientWidth + FEffectiveOffsetX) = Integer(FRangeX) then + if (ClientWidth + FEffectiveOffsetX) = FRangeX then Exclude(FScrollDirections, sdRight); end; @@ -22454,6 +22453,9 @@ function TBaseVirtualTree.DragDrop(const DataObject: {$IFDEF VT_FMX}TDragObject{ end; end; {$ENDIF} +{$IFDEF VT_FMX} + Result:= 0; //remove warning +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -22517,6 +22519,9 @@ function TBaseVirtualTree.DragEnter(KeyState: Integer; Pt: TPoint; var Effect: I Result := E_UNEXPECTED; end; {$ENDIF} +{$IFDEF VT_FMX} + Result:= 0; //remove warning +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -22583,7 +22588,7 @@ function TBaseVirtualTree.DragOver(Source: TObject; KeyState: Integer; DragState var Effect: Integer): HResult; // callback routine for the drop target interface - +{$IFDEF VT_VCL} var Shift: TShiftState; Accept, @@ -22598,7 +22603,7 @@ function TBaseVirtualTree.DragOver(Source: TObject; KeyState: Integer; DragState DeltaX, DeltaY: TDimension; ScrollOptions: TScrollUpdateOptions; - +{$ENDIF} begin {$IFDEF VT_VCL} if not DragManager.DropTargetHelperSupported and (Source is TBaseVirtualTree) then @@ -22775,6 +22780,9 @@ function TBaseVirtualTree.DragOver(Source: TObject; KeyState: Integer; DragState Result := E_UNEXPECTED; end; {$ENDIF} +{$IFDEF VT_FMX} + Result:= E_UNEXPECTED; //remove warning +{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -26700,9 +26708,9 @@ procedure TBaseVirtualTree.StartWheelPanning(Position: TPoint); 32, 32, Handle, 0, HInstance, nil); FPanningImage := TBitmap.Create; - if Integer(FRangeX) > ClientWidth then + if FRangeX > ClientWidth then begin - if Integer(FRangeY) > ClientHeight then + if FRangeY > ClientHeight then ImageName := 'VT_MOVEALL' else ImageName := 'VT_MOVEEW'; @@ -26731,10 +26739,10 @@ procedure TBaseVirtualTree.StartWheelPanning(Position: TPoint); procedure TBaseVirtualTree.StopWheelPanning; // Stops panning if currently active and destroys the helper window. - +{$IFDEF VT_VCL} var Instance: Pointer; - +{$ENDIF} begin {$IFDEF VT_VCL} if [tsWheelPanning, tsWheelScrolling] * FStates <> [] then @@ -32871,7 +32879,7 @@ function TBaseVirtualTree.PasteFromClipboard: Boolean; procedure TBaseVirtualTree.PrepareDragImage(HotSpot: TPoint; const DataObject: {$IFDEF VT_FMX}TDragObject{$ELSE}IDataObject{$ENDIF}); // Initiates an image drag operation. HotSpot is the position of the mouse in client coordinates. - +{$IFDEF VT_VCL} var PaintOptions: TVTInternalPaintOptions; TreeRect, @@ -32880,7 +32888,7 @@ procedure TBaseVirtualTree.PrepareDragImage(HotSpot: TPoint; const DataObject: { ImagePos, PaintTarget: TPoint; Image: TBitmap; - +{$ENDIF} begin {$IFDEF VT_VCL} {$IFDEF VT_FMX}PaintOptions:= PaintOptions + [poUnbuffered];{$ENDIF} @@ -32945,7 +32953,7 @@ procedure TBaseVirtualTree.PrepareDragImage(HotSpot: TPoint; const DataObject: { //---------------------------------------------------------------------------------------------------------------------- procedure TBaseVirtualTree.Print(Printer: TPrinter; PrintHeader: Boolean); - +{$IFDEF VT_VCL} var SaveTreeFont: TFont; // Remembers the tree's current font. SaveHeaderFont: TFont; // Remembers the header's current font. @@ -32965,7 +32973,7 @@ procedure TBaseVirtualTree.Print(Printer: TPrinter; PrintHeader: Boolean); xPageNum, yPageNum, // # of pages (except the occasional last one) xPage, yPage: Integer; // Loop counter Scale: Extended; // Scale factor between Printer Canvas and VTree Canvas -{$IFDEF VT_VCL} + LogFont: TLogFont; {$ENDIF} begin @@ -33106,10 +33114,10 @@ function TBaseVirtualTree.ProcessDrop(const DataObject: {$IFDEF VT_FMX}TDragObje // the passed node or FRoot if TargetNode is nil. // Returns True on success, i.e. the CF_VIRTUALTREE format is supported by the data object and the structure could be // recreated, otherwise False. - +{$IFDEF VT_VCL} var Source: TBaseVirtualTree; - +{$ENDIF} begin Result := False; {$IFDEF VT_VCL} @@ -35077,16 +35085,15 @@ function TVTEdit.GetTextSize: TSize; end; {$ENDIF} //---------------------------------------------------------------------------------------------------------------------- - +{$IFDEF VT_VCL} procedure TVTEdit.Release; begin -{$IFDEF VT_VCL} + if HandleAllocated then PostMessage(Handle, CM_RELEASE, 0, 0); -{$ENDIF} end; - +{$ENDIF} //----------------- TStringEditLink ------------------------------------------------------------------------------------ constructor TStringEditLink.Create; @@ -35110,7 +35117,7 @@ destructor TStringEditLink.Destroy; begin if Assigned(FEdit) then - FEdit.Release; + FEdit.{$IFDEF VT_FMX}Free{$ELSE}Release{$ENDIF}; inherited; end; @@ -35261,10 +35268,11 @@ procedure TStringEditLink.ProcessMessage(var Message: TMessage); procedure TStringEditLink.SetBounds(R: TRect); // Sets the outer bounds of the edit control and the actual edit area in the control. - +{$IFDEF VT_VCL} var lOffset, tOffset, height: TDimension; offsets : TVTOffsets; +{$ENDIF} begin {$IFDEF VT_VCL} if not FStopping then @@ -35336,9 +35344,9 @@ procedure TStringEditLink.SetBounds(R: TRect); end; R.Top := Max(-1, R.Top); // A value smaller than -1 will prevent the edit cursor from being shown by Windows, see issue #159 R.Left := Max(-1, R.Left); -{$IFDEF VT_VCL} + {$IFDEF VT_VCL} SendMessage(FEdit.Handle, EM_SETRECTNP, 0, LPARAM(@R)); -{$ENDIF} + {$ENDIF} end; {$ENDIF} end; @@ -35691,7 +35699,8 @@ procedure TCustomVirtualStringTree.PaintStaticText(const PaintInfo: TVTPaintInfo else Inc(R.Left, NodeWidth + FTextMargin); {$IFDEF VT_FMX} - Canvas.FillText(R, (Text), true, 1.0, [], TTextAlign.Leading); + DrawTextW(Canvas, Text, Length(Text), R, DrawFormat); + //Canvas.FillText(R, (Text), true, 1.0, [], TTextAlign.Leading); {$ELSE} if Canvas.TextFlags and ETO_OPAQUE = 0 then SetBkMode(Canvas.Handle, TRANSPARENT) @@ -36149,29 +36158,31 @@ procedure TCustomVirtualStringTree.DoTextDrawing(var PaintInfo: TVTPaintInfo; co if Assigned(FOnDrawText) then FOnDrawText(Self, PaintInfo.Canvas, PaintInfo.Node, PaintInfo.Column, Text, CellRect, DefaultDraw); if DefaultDraw then + begin {$IFDEF VT_FMX} - hAlign:= TTextAlign.Leading; - if DrawFormat and DT_CENTER<>0 then - hAlign:= TTextAlign.Center; - if DrawFormat and DT_RIGHT<>0 then - hAlign:= TTextAlign.Trailing; + hAlign:= TTextAlign.Leading; + if DrawFormat and DT_CENTER<>0 then + hAlign:= TTextAlign.Center; + if DrawFormat and DT_RIGHT<>0 then + hAlign:= TTextAlign.Trailing; - vAlign:= TTextAlign.Center; - if DrawFormat and DT_VCENTER<>0 then vAlign:= TTextAlign.Center; - if DrawFormat and DT_BOTTOM<>0 then - vAlign:= TTextAlign.Trailing; + if DrawFormat and DT_VCENTER<>0 then + vAlign:= TTextAlign.Center; + if DrawFormat and DT_BOTTOM<>0 then + vAlign:= TTextAlign.Trailing; - Flags:= []; + Flags:= []; - if DrawFormat and DT_RTLREADING<>0 then - Flags:= Flags + [TFillTextFlag.RightToLeft]; + if DrawFormat and DT_RTLREADING<>0 then + Flags:= Flags + [TFillTextFlag.RightToLeft]; - PaintInfo.Canvas.FillText(CellRect, Text, true, 1.0, Flags, hAlign, vAlign); + PaintInfo.Canvas.FillText(CellRect, Text, true, 1.0, Flags, hAlign, vAlign); {$ELSE} - Winapi.Windows.DrawTextW(PaintInfo.Canvas.Handle, PWideChar(Text), Length(Text), CellRect, DrawFormat); + Winapi.Windows.DrawTextW(PaintInfo.Canvas.Handle, PWideChar(Text), Length(Text), CellRect, DrawFormat); {$ENDIF} + end; end; //---------------------------------------------------------------------------------------------------------------------- @@ -36195,7 +36206,8 @@ function TCustomVirtualStringTree.DoTextMeasuring(Canvas: TCanvas; Node: PVirtua R := Rect(0, 0, Result.cx, MaxInt); {$IFDEF VT_FMX} - Canvas.FillText(R, Text, true, 1.0, [], TTextAlign.Leading); + DrawTextW(Canvas, Text, Length(Text), R, DrawFormat); + //Canvas.FillText(R, Text, true, 1.0, [], TTextAlign.Leading); {$ELSE} Winapi.Windows.DrawTextW(Canvas.Handle, PWideChar(Text), Length(Text), R, DrawFormat); {$ENDIF} @@ -36455,7 +36467,8 @@ function TCustomVirtualStringTree.ComputeNodeHeight(Canvas: TCanvas; Node: PVirt else DrawFormat := DrawFormat or DT_LEFT; {$IFDEF VT_FMX} - Canvas.FillText(PaintInfo.CellRect, S, true, 1.0, [], TTextAlign.Leading); + DrawTextW(Canvas, S, Length(S), PaintInfo.CellRect, DrawFormat); + //Canvas.FillText(PaintInfo.CellRect, S, true, 1.0, [], TTextAlign.Leading); {$ELSE} Winapi.Windows.DrawTextW(Canvas.Handle, PWideChar(S), Length(S), PaintInfo.CellRect, DrawFormat); {$ENDIF} From dc8da09a032806305e5038847eadc43d91765ef4 Mon Sep 17 00:00:00 2001 From: livius2 Date: Tue, 20 Nov 2018 23:32:00 +0100 Subject: [PATCH 48/61] corner case fixes --- Source/VirtualTrees.FMX.pas | 4 ++-- Source/VirtualTrees.pas | 6 +++--- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/Source/VirtualTrees.FMX.pas b/Source/VirtualTrees.FMX.pas index 698abb16a..c703f1589 100644 --- a/Source/VirtualTrees.FMX.pas +++ b/Source/VirtualTrees.FMX.pas @@ -619,8 +619,8 @@ procedure FillSystemCheckImages(Parent: TFmxObject; List: TImageList); try BMP.Canvas.DrawBitmap( tmpBMP - , Rect(1, 1, BMP.Width, BMP.Height) - , Rect(0, 0, BMP.Width-1, BMP.Height-1) + , Rect(2, 2, BMP.Width, BMP.Height) + , Rect(0, 0, BMP.Width-2, BMP.Height-2) , 1.0 , false ); diff --git a/Source/VirtualTrees.pas b/Source/VirtualTrees.pas index 577377c87..8ab1490c1 100644 --- a/Source/VirtualTrees.pas +++ b/Source/VirtualTrees.pas @@ -14706,7 +14706,7 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean); , Point(0, 0) , TBlendMode.bmConstantAlphaAndColor , 40 - , TAlphaColorRec.White + , TAlphaColorRec.Lightyellow ); finally FHotMinusBM.Canvas.EndScene(); @@ -14774,8 +14774,8 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean); FPlusBM.Canvas.FillRect(Rect(0, 0, FPlusBM.Width-1, FPlusBM.Height), 0, 0, [], 1.0); FPlusBM.Canvas.DrawRect(Rect(0, 0, FPlusBM.Width-1, FPlusBM.Height), 0, 0, [], 1.0); FPlusBM.Canvas.Stroke.Color := FColors.NodeFontColor; - FPlusBM.Canvas.DrawLine(Point(2, 4.5), Point(FPlusBM.Canvas.Width - 2, 4.5), 1.0); - FPlusBM.Canvas.DrawLine(Point(4.5, 2), Point(4.5, FPlusBM.Canvas.Width - 2), 1.0); + FPlusBM.Canvas.DrawLine(Point(2, FPlusBM.Canvas.Width/2), Point(FPlusBM.Canvas.Width - 2, FPlusBM.Canvas.Width/2), 1.0); + FPlusBM.Canvas.DrawLine(Point(FPlusBM.Canvas.Width/2, 2), Point(FPlusBM.Canvas.Width/2, FPlusBM.Canvas.Width - 2), 1.0); { FPlusBM.Canvas.DrawLine(Point(2, FPlusBM.Canvas.Width / 2), Point(FPlusBM.Canvas.Width - 2, FPlusBM.Canvas.Width / 2), 1.0); From 013ff40dd7ea227155904272bca97e3769520137 Mon Sep 17 00:00:00 2001 From: livius2 Date: Wed, 21 Nov 2018 10:05:52 +0100 Subject: [PATCH 49/61] added MultiSelect with smDottedRectangle and with smBlendedRectangle added support for Multiselction (toMultiSelect) with: - smDottedRectangle - smBlendedRectangle --- Source/VirtualTrees.FMX.pas | 18 ++++++++++++++++++ Source/VirtualTrees.pas | 34 ++++++++++++++++++++-------------- 2 files changed, 38 insertions(+), 14 deletions(-) diff --git a/Source/VirtualTrees.FMX.pas b/Source/VirtualTrees.FMX.pas index 698abb16a..b68ff682c 100644 --- a/Source/VirtualTrees.FMX.pas +++ b/Source/VirtualTrees.FMX.pas @@ -453,6 +453,9 @@ TCanvasHelper = class helper for TCanvas property Brush: TBrush read GetBrush; property Pen: TStrokeBrush read GetPen; procedure FillRect(const ARect: TRectF); overload; inline; + procedure DrawRect(const ARect: TRectF); overload; inline; + procedure DrawFocusRect(const AFocusRect: TRect); + procedure FrameRect(const AFocusRect: TRect); end; implementation @@ -461,11 +464,26 @@ implementation { TCanvasHelper } +procedure TCanvasHelper.DrawFocusRect(const AFocusRect: TRect); +begin + DrawDashRect(AFocusRect, 0, 0, AllCorners, 1.0{?}, $A0909090); +end; + +procedure TCanvasHelper.DrawRect(const ARect: TRectF); +begin + DrawRect(ARect, 0, 0, [], 1.0); +end; + procedure TCanvasHelper.FillRect(const ARect: TRectF); begin FillRect(ARect, 0, 0, [], 1.0); end; +procedure TCanvasHelper.FrameRect(const AFocusRect: TRect); +begin + DrawRect(AFocusRect); +end; + function TCanvasHelper.GetBrush: TBrush; begin Result:= Fill; diff --git a/Source/VirtualTrees.pas b/Source/VirtualTrees.pas index 577377c87..aaf9365f7 100644 --- a/Source/VirtualTrees.pas +++ b/Source/VirtualTrees.pas @@ -25740,18 +25740,19 @@ procedure TBaseVirtualTree.PaintSelectionRectangle(Target: TCanvas; WindowOrgX: TargetRect: TRect); // Helper routine to draw a selection rectangle in the mode determined by DrawSelectionMode. -{$IFDEF VT_VCL} + var BlendRect: TRect; TextColorBackup, - BackColorBackup: COLORREF; // used to restore forground and background colors when drawing a selection rectangle - prevDC: HDC; + BackColorBackup: {$IFDEF VT_FMX}TColor{$ELSE}COLORREF{$ENDIF}; // used to restore forground and background colors when drawing a selection rectangle + prevDC: {$IFDEF VT_FMX}TCanvas{$ELSE}HDC{$ENDIF}; wasPrevDC: Boolean; -{$ENDIF} begin -{$IFDEF VT_VCL} if ((FDrawSelectionMode = smDottedRectangle) and not (tsUseThemes in FStates)) then begin + {$IFDEF VT_FMX} + Target.DrawFocusRect(SelectionRect) + {$ELSE} // Classical selection rectangle using dotted borderlines. TextColorBackup := GetTextColor(Target.Handle); SetTextColor(Target.Handle, $FFFFFF); @@ -25760,6 +25761,7 @@ procedure TBaseVirtualTree.PaintSelectionRectangle(Target: TCanvas; WindowOrgX: Target.DrawFocusRect(SelectionRect); SetTextColor(Target.Handle, TextColorBackup); SetBkColor(Target.Handle, BackColorBackup); + {$ENDIF} end else begin @@ -25768,6 +25770,10 @@ procedure TBaseVirtualTree.PaintSelectionRectangle(Target: TCanvas; WindowOrgX: if IntersectRect(BlendRect, OrderRect(SelectionRect), TargetRect) then begin OffsetRect(BlendRect, -WindowOrgX, 0); + {$IFDEF VT_FMX} + AlphaBlend(Target, Target, BlendRect, Point(0, 0), bmConstantAlphaAndColor, FSelectionBlendFactor, + FColors.SelectionRectangleBlendColor); + {$ELSE} if dummyCanvas.HandleAllocated then begin prevDC:= dummyCanvas.Handle; @@ -25778,18 +25784,18 @@ procedure TBaseVirtualTree.PaintSelectionRectangle(Target: TCanvas; WindowOrgX: end; try dummyCanvas.Handle:= 0; + AlphaBlend(dummyCanvas, Target, BlendRect, Point(0, 0), bmConstantAlphaAndColor, FSelectionBlendFactor, ColorToRGB(FColors.SelectionRectangleBlendColor)); finally if wasPrevDC then dummyCanvas.Handle:= prevDC; end; - + {$ENDIF} Target.Brush.Color := FColors.SelectionRectangleBorderColor; Target.FrameRect(SelectionRect); end; end; -{$ENDIF} end; //---------------------------------------------------------------------------------------------------------------------- @@ -26088,10 +26094,7 @@ procedure TBaseVirtualTree.PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX, {$IFDEF VT_FMX} TextColorBackup := Stroke.Color; - //Fill.Color:= clWhite; font - //Fill.Color:= clBlack; background - DrawDashRect(FocusRect, 0, 0, AllCorners, 1.0{?}, $A0909090); - + DrawFocusRect(FocusRect); Stroke.Color:= TextColorBackup; {$ELSE} TextColorBackup := GetTextColor(Handle); @@ -32187,7 +32190,7 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe // Transform selection rectangle into node bitmap coordinates. if DrawSelectionRect then - OffsetRect(SelectionRect, 0, -BaseOffset); + OffsetRect(SelectionRect, 0, {$IFDEF VT_FMX}0{$ELSE}-BaseOffset{$ENDIF}); // The target rectangle holds the coordinates of the exact area to blit in target canvas coordinates. // It is usually smaller than an entire node and wanders while the paint loop advances. @@ -32597,10 +32600,13 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe begin if DrawSelectionRect then begin + {$IFDEF VT_FMX} + PaintSelectionRectangle(PaintInfo.Canvas, Window.Left, SelectionRect, TargetRect); + {$ELSE} PaintSelectionRectangle(PaintInfo.Canvas, Window.Left, SelectionRect, Rect(0, 0, PaintWidth, CurrentNodeHeight)); + {$ENDIF} end; - // Put the constructed node image onto the target canvas. {$IFDEF VT_VCL} if not (poUnbuffered in PaintOptions) then @@ -32616,7 +32622,7 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe // Keep selection rectangle coordinates in sync. if DrawSelectionRect then - OffsetRect(SelectionRect, 0, -PaintInfo.Node.NodeHeight); + OffsetRect(SelectionRect, 0, {$IFDEF VT_FMX}0{$ELSE}-PaintInfo.Node.NodeHeight{$ENDIF}); // Advance to next visible node. PaintInfo.Node := GetNextVisible(PaintInfo.Node, True); From 5241c2aad2129d9f42fbb7e98de4fe355f9c7bc2 Mon Sep 17 00:00:00 2001 From: livius2 Date: Wed, 21 Nov 2018 10:36:15 +0100 Subject: [PATCH 50/61] Fix cursor changes when back from header splitter --- README.md | 1 + Source/VirtualTrees.pas | 13 +++++++++---- 2 files changed, 10 insertions(+), 4 deletions(-) diff --git a/README.md b/README.md index 291228394..21137587b 100644 --- a/README.md +++ b/README.md @@ -16,6 +16,7 @@ What is working: 13. support for Android :) 14. "hot" and "selected" plus/minus buttons. 15. scrollbars/scrolling. +16. toMultiSelect with smDottedRectangle and with smBlendedRectangle. What is not working yet: diff --git a/Source/VirtualTrees.pas b/Source/VirtualTrees.pas index 20e8082d8..4ca77a030 100644 --- a/Source/VirtualTrees.pas +++ b/Source/VirtualTrees.pas @@ -11157,9 +11157,9 @@ function TVTHeader.HandleMessage(var Message: TMessage): Boolean; if IsVSplitterHit or IsHSplitterHit then begin {$IFDEF VT_FMX} - cursorService:= TPlatformServices.Current.GetPlatformservice(IFMXCursorService) as IFMXCursorService; - if Assigned(cursorService) then - NewCursor:= Treeview.Cursor;//cursorService.GetCursor; + {cursorService:= TPlatformServices.Current.GetPlatformservice(IFMXCursorService) as IFMXCursorService; + if Assigned(cursorService) then } + NewCursor:= Treeview.Cursor;// cursorService.GetCursor; {$ELSE} NewCursor := Screen.Cursors[Treeview.Cursor]; {$ENDIF} @@ -11176,7 +11176,7 @@ function TVTHeader.HandleMessage(var Message: TMessage): Boolean; begin {$IFDEF VT_FMX} {if Assigned(cursorService) then - cursorService.SetCursor(NewCursor); } + cursorService.SetCursor(NewCursor); } TreeView.Cursor:= NewCursor; {$ELSE} Winapi.Windows.SetCursor(NewCursor); @@ -24153,7 +24153,9 @@ procedure TBaseVirtualTree.HandleMouseUp(var Message: TWMMouse; const HitInfo: T ReselectFocusedNode: Boolean; begin +{$IFDEF VT_VCL} ReleaseCapture; +{$ENDIF} if not (tsVCLDragPending in FStates) then begin @@ -25051,6 +25053,9 @@ procedure TBaseVirtualTree.MouseMove(Shift: TShiftState; X, Y: {$IFDEF VT_FMX}Si end; end; + if not isNC then + Cursor:= crDefault; + {$ENDIF} if tsNodeHeightTrackPending in FStates then begin From 2f1ebbc6054557de4639a90bd55094ea41b7218e Mon Sep 17 00:00:00 2001 From: livius2 Date: Wed, 21 Nov 2018 11:25:25 +0100 Subject: [PATCH 51/61] added mouse wheel scrolling added mouse wheel scrolling --- README.md | 1 + Source/VirtualTrees.FMX.pas | 24 +++++++++++++++ Source/VirtualTrees.pas | 60 +++++++++++++++++++++++++++++++++---- 3 files changed, 79 insertions(+), 6 deletions(-) diff --git a/README.md b/README.md index 21137587b..35f636d35 100644 --- a/README.md +++ b/README.md @@ -17,6 +17,7 @@ What is working: 14. "hot" and "selected" plus/minus buttons. 15. scrollbars/scrolling. 16. toMultiSelect with smDottedRectangle and with smBlendedRectangle. +17. mouse wheel scrolling What is not working yet: diff --git a/Source/VirtualTrees.FMX.pas b/Source/VirtualTrees.FMX.pas index 482b4e698..ee31c38d8 100644 --- a/Source/VirtualTrees.FMX.pas +++ b/Source/VirtualTrees.FMX.pas @@ -118,6 +118,9 @@ interface DT_HIDEPREFIX = $00100000; DT_PREFIXONLY = $00200000; + MAXDWORD = DWORD($FFFFFFFF); + WHEEL_DELTA = 120; { Value for rolling one detent } + WHEEL_PAGESCROLL = MAXDWORD; { Scroll one page } { WM_SIZE message wParam values } SIZE_RESTORED = 0; @@ -261,6 +264,7 @@ TDWordFiller = record CM_PARENTCOLORCHANGED = CM_BASE + 9; CM_BIDIMODECHANGED = CM_BASE + 60; CM_PARENTBIDIMODECHANGED = CM_BASE + 61; + CM_MOUSEWHEEL = CM_BASE + 67; VK_ESCAPE = 27; @@ -389,6 +393,26 @@ TWMScroll = record TWMHScroll = TWMScroll; TWMVScroll = TWMScroll; + TCMMouseWheel = record + Msg: Cardinal; //4 + //MsgFiller: TDWordFiller; + ShiftState: TShiftState; //2 + WheelDelta: SmallInt; //2 + //ShiftStateWheel: TDWordFiller; + case Integer of + 0: ( + XPos: Single; //4 + YPos: Single; //4 + //XYPos: TDWordFiller + ); //=24! + 1: ( + Pos: TPoint; //8 + //PosFiller: TDWordFiller; + Result: LRESULT //4 + ); //=28! + end; + + procedure FillTWMMouse(Var MM: TWMMouse; Button: TMouseButton; Shift: TShiftState; X: Single; Y: Single; IsNC: Boolean; IsUp: Boolean); //--------- Text metrics ------------------------------------------------------------------------------------------------------------------- diff --git a/Source/VirtualTrees.pas b/Source/VirtualTrees.pas index 4ca77a030..29029ac2c 100644 --- a/Source/VirtualTrees.pas +++ b/Source/VirtualTrees.pas @@ -2518,7 +2518,6 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF procedure CMHintShowPause(var Message: TCMHintShowPause); message CM_HINTSHOWPAUSE; procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER; procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE; - procedure CMMouseWheel(var Message: TCMMouseWheel); message CM_MOUSEWHEEL; procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE; procedure TVMGetItem(var Message: TMessage); message TVM_GETITEM; procedure TVMGetItemRect(var Message: TMessage); message TVM_GETITEMRECT; @@ -2557,6 +2556,7 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF procedure WMTimer(var Message: TWMTimer); message WM_TIMER; procedure WMThemeChanged(var Message: TMessage); message WM_THEMECHANGED; {$ENDIF} + procedure CMMouseWheel(var Message: TCMMouseWheel); message CM_MOUSEWHEEL; procedure WMChangeState(var Message: TMessage); message WM_CHANGESTATE; procedure WMHScroll(var Message: TWMHScroll); {$IFDEF VT_FMX}virtual;{$ELSE}message WM_HSCROLL;{$ENDIF} procedure WMVScroll(var Message: TWMVScroll); {$IFDEF VT_FMX}virtual;{$ELSE}message WM_VSCROLL;{$ENDIF} @@ -2787,6 +2787,7 @@ TBaseVirtualTree = class({$IFDEF VT_FMX}TRectangle{$ELSE}TCustomControl{$ENDIF {$IFDEF VT_FMX} procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Single; Y: Single); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Single; Y: Single); override; + procedure MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); override; procedure Resize; override; {$ENDIF} procedure HandleMouseDblClick(var Message: TWMMouse; const HitInfo: THitInfo); virtual; @@ -17249,13 +17250,13 @@ procedure TBaseVirtualTree.CMMouseLeave(var Message: TMessage); DoMouseLeave(); inherited; end; - +{$ENDIF} //---------------------------------------------------------------------------------------------------------------------- procedure TBaseVirtualTree.CMMouseWheel(var Message: TCMMouseWheel); var - ScrollAmount: Integer; + ScrollAmount: TDimension; ScrollLines: DWORD; RTLFactor: Integer; WheelFactor: Double; @@ -17275,16 +17276,28 @@ procedure TBaseVirtualTree.CMMouseWheel(var Message: TCMMouseWheel); begin // Scroll vertically if there's something to scroll... if ssCtrl in ShiftState then - ScrollAmount := Trunc(WheelFactor * ClientHeight) + ScrollAmount := {$IFDEF VT_VCL}Trunc{$ENDIF}(WheelFactor * ClientHeight) else begin + {$IFDEF VT_FMX} + ScrollLines:= WHEEL_PAGESCROLL; + if ScrollLines = WHEEL_PAGESCROLL then + ScrollAmount := WheelFactor * ClientHeight + else + ScrollAmount := WheelFactor * ScrollLines * FDefaultNodeHeight; + {$ELSE} SystemParametersInfo(SPI_GETWHEELSCROLLLINES, 0, @ScrollLines, 0); if ScrollLines = WHEEL_PAGESCROLL then ScrollAmount := Trunc(WheelFactor * ClientHeight) else ScrollAmount := Integer(Trunc(WheelFactor * ScrollLines * FDefaultNodeHeight)); + {$ENDIF} end; + {$IFDEF VT_FMX} + FVScrollBar.Value:= FVScrollBar.Value - ScrollAmount; + {$ELSE} SetOffsetY(FOffsetY + ScrollAmount); + {$ENDIF} end else begin @@ -17295,20 +17308,30 @@ procedure TBaseVirtualTree.CMMouseWheel(var Message: TCMMouseWheel); RTLFactor := 1; if ssCtrl in ShiftState then - ScrollAmount := Trunc(WheelFactor * (ClientWidth - FHeader.Columns.GetVisibleFixedWidth)) + ScrollAmount := {$IFDEF VT_VCL}Trunc{$ENDIF}(WheelFactor * (ClientWidth - FHeader.Columns.GetVisibleFixedWidth)) else begin + {$IFDEF VT_FMX} + ScrollLines:= WHEEL_PAGESCROLL; + ScrollAmount := WheelFactor * ScrollLines * FHeader.Columns.GetScrollWidth; + {$ELSE} SystemParametersInfo(SPI_GETWHEELSCROLLLINES, 0, @ScrollLines, 0); ScrollAmount := Trunc(WheelFactor * ScrollLines * FHeader.Columns.GetScrollWidth); + {$ENDIF} end; + + {$IFDEF VT_FMX} + FHScrollBar.Value:= FHScrollBar.Value - RTLFactor * ScrollAmount; + {$ELSE} SetOffsetX(FOffsetX + RTLFactor * ScrollAmount); + {$ENDIF} end; end; end; end; - +{$IFDEF VT_VCL} //---------------------------------------------------------------------------------------------------------------------- procedure TBaseVirtualTree.CMSysColorChange(var Message: TMessage); @@ -23668,6 +23691,31 @@ procedure TBaseVirtualTree.MouseUp(Button: TMouseButton; Shift: TShiftState; X: HandleMouseUp(MM, hInfo); end; +procedure TBaseVirtualTree.MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); +Var M: TCMMouseWheel; + hInfo: THitInfo; + P: TPoint; + isNC: Boolean; +begin + P:= Screen.MousePos; + if ClientRect.Contains(P) then + begin + isNc:= false; + end else + begin + isNC:= true; + P:= ClientToScreen(P); + end; + M.Msg:= CM_MOUSEWHEEL; + M.ShiftState:= Shift; + M.WheelDelta:= WheelDelta; + M.XPos:= P.X; + M.YPos:= P.Y; + M.Result:= 0; + CMMouseWheel(M); + Handled:= M.Result<>0; +end; + {$ENDIF} //---------------------------------------------------------------------------------------------------------------------- //{$IFDEF VT_VCL} From 09a060238e15c546c985cffdc2ccfbd355f97a0e Mon Sep 17 00:00:00 2001 From: livius2 Date: Wed, 21 Nov 2018 15:13:01 +0100 Subject: [PATCH 52/61] remove debug code --- README.md | 63 +++++++++++++++++++++-------------------- Source/VirtualTrees.pas | 2 -- 2 files changed, 32 insertions(+), 33 deletions(-) diff --git a/README.md b/README.md index 35f636d35..0cf8f4621 100644 --- a/README.md +++ b/README.md @@ -1,33 +1,33 @@ -About this port to Firemonkey: - -What is working: -1. it compiles under FMX - this was main task of this pull request; -2. it draw tree nodes structure with apropiate levels; -3. it draw nodes text with alignment; -4. it draw buttons plus/minus (toShowButtons); -5. it draw tree lines (toShowTreeLines), horizontal lines (toShowHorzGridLines), vertical lines (toShowVertGridLines), full vertical lines (toFullVertGridLines) (some pixel improvement needed but it is working); -6. it support cliping during cell draw; -7. it support multiple columns; -8. it draw header columns. -9. expanding, collapsing by mouse click. -10. mouse cursor and header column resize by mouse. -11. it accept focus, it draw focus rect and unfocussed rect, toExtendedFocus, toFullRowSelect, toHotTrack, toUseBlendedSelection. -12. checkbox support system checkboxes (platform specific) + custom checkboxes. -13. support for Android :) -14. "hot" and "selected" plus/minus buttons. -15. scrollbars/scrolling. -16. toMultiSelect with smDottedRectangle and with smBlendedRectangle. -17. mouse wheel scrolling - - -What is not working yet: -1. some mouse actions (drag/drop); -2. clipboard; -3. drawing tree border; -4. drawing background; -5. some mouse actions on header; -6. inplace editors; -7. installing package for both VCL and FMX in the same time. +## About this port to Firemonkey: + +### What is working: +- [x] it compiles under FMX - this was main task of this pull request; +- [x] it draw tree nodes structure with apropiate levels; +- [x] it draw nodes text with alignment; +- [x] it draw buttons plus/minus (toShowButtons); +- [x] it draw tree lines (toShowTreeLines), horizontal lines (toShowHorzGridLines), vertical lines (toShowVertGridLines), full vertical lines (toFullVertGridLines) (some pixel improvement needed but it is working); +- [x] it support cliping during cell draw; +- [x] it support multiple columns; +- [x] it draw header columns. +- [x] expanding, collapsing by mouse click. +- [x] mouse cursor and header column resize by mouse. +- [x] it accept focus, it draw focus rect and unfocussed rect, toExtendedFocus, toFullRowSelect, toHotTrack, toUseBlendedSelection. +- [x] checkbox support system checkboxes (platform specific) + custom checkboxes. +- [x] support for Android :) +- [x] "hot" and "selected" plus/minus buttons. +- [x] scrollbars/scrolling. +- [x] toMultiSelect with smDottedRectangle and with smBlendedRectangle. +- [x] mouse wheel scrolling + + +### What is not working yet: +- [ ] some mouse actions (drag/drop); +- [ ] clipboard; +- [ ] drawing tree border; +- [ ] drawing background; +- [ ] some mouse actions on header; +- [ ] inplace editors; +- [ ] installing package for both VCL and FMX in the same time. Current VT is derived from TRectangle. Will be good to have it as presented control with appropiate TDataModel. @@ -37,7 +37,8 @@ One will be i scale 1 second smaller in scale e.g 0.2 as a preview. To test FMX port of VT - you must add in the e.g. Delphi project->Options->Conditional defines **VT_FMX**. There is only package for Delphi Tokyo (but you can test it from the code). Remember to add also to uses clause unit VirtualTrees.FMX. -WARNING. if you install package for FMX you can not use installed package for VCL and vice-versa. +#### WARNING. +If you install package for FMX you can not use installed package for VCL and vice-versa. I still look for the way to do this. # Virtual-TreeView diff --git a/Source/VirtualTrees.pas b/Source/VirtualTrees.pas index 29029ac2c..9dfc7608b 100644 --- a/Source/VirtualTrees.pas +++ b/Source/VirtualTrees.pas @@ -16213,8 +16213,6 @@ procedure TBaseVirtualTree.PrepareBackGroundPicture(Source: {$IFDEF VT_FMX}TBitm finally ADrawBitmap.Canvas.EndScene(); end; - ADrawBitmap.SaveToFile('C:\ADrawBitmap.bmp'); - Source.SaveToFile('C:\Source.bmp'); {$ELSE} if (Source.Graphic is TBitmap) and (FBackGroundImageTransparent or Source.Bitmap.TRANSPARENT) From eaf960f6f127d31ef173744971f33c5fd6d81dfd Mon Sep 17 00:00:00 2001 From: livius2 Date: Wed, 21 Nov 2018 15:47:48 +0100 Subject: [PATCH 53/61] Added draw static background Added draw static background --- README.md | 4 ++-- Source/VirtualTrees.pas | 12 +++++++++--- 2 files changed, 11 insertions(+), 5 deletions(-) diff --git a/README.md b/README.md index 0cf8f4621..98837f8ab 100644 --- a/README.md +++ b/README.md @@ -18,13 +18,13 @@ - [x] scrollbars/scrolling. - [x] toMultiSelect with smDottedRectangle and with smBlendedRectangle. - [x] mouse wheel scrolling - +- [x] it draw static background ### What is not working yet: - [ ] some mouse actions (drag/drop); - [ ] clipboard; - [ ] drawing tree border; -- [ ] drawing background; +- [ ] drawing background tiled; - [ ] some mouse actions on header; - [ ] inplace editors; - [ ] installing package for both VCL and FMX in the same time. diff --git a/Source/VirtualTrees.pas b/Source/VirtualTrees.pas index 9dfc7608b..1362e84e4 100644 --- a/Source/VirtualTrees.pas +++ b/Source/VirtualTrees.pas @@ -16271,7 +16271,7 @@ procedure TBaseVirtualTree.StaticBackground(Source: {$IFDEF VT_FMX}TBitmap{$ELSE {$IFDEF VT_FMX} Target.DrawBitmap(DrawBitmap ,Rect(DrawRect.Left - OffsetPosition.X, DrawRect.Top - OffsetPosition.Y, (DrawRect.Right - OffsetPosition.X) - (DrawRect.Left - OffsetPosition.X), (DrawRect.Bottom - OffsetPosition.Y) - (DrawRect.Top - OffsetPosition.Y) + R.Top) - ,Rect(DrawRect.Left - PicRect.Left, DrawRect.Top - PicRect.Top, DrawRect.Left, DrawRect.Top) + ,Rect(DrawRect.Left - PicRect.Left, DrawRect.Top - PicRect.Top, DrawRect.Left+DrawRect.Width, DrawRect.Top + DrawRect.Height) , 1.0 ); {$ELSE} @@ -16539,6 +16539,9 @@ procedure TBaseVirtualTree.TileBackground(Source: {$IFDEF VT_FMX}TBitmap{$ELSE}T TargetX, DeltaY: TDimension; BMP: TBitmap; +{$IFDEF VT_FMX} + RSrc, RDest: TRect; +{$ENDIF} begin BMP := TBitmap.Create; try @@ -16574,10 +16577,13 @@ procedure TBaseVirtualTree.TileBackground(Source: {$IFDEF VT_FMX}TBitmap{$ELSE}T while TargetX < R.Right do begin {$IFDEF VT_FMX} + RSrc:= Rect(TargetX, R.Top, TargetX + Min(R.Right - TargetX, Source.Width - SourceX), R.Top+DeltaY); + RDest:= Rect(SourceX, SourceY, SourceX + Min(R.Right - TargetX, Source.Width - SourceX), SourceY+R.Top+DeltaY); + Target.DrawBitmap(//###!!! BMP - , Rect(TargetX, R.Top, TargetX + Min(R.Right - TargetX, Source.Width - SourceX), R.Top+DeltaY) - , Rect(SourceX, SourceY, SourceX + Min(R.Right - TargetX, Source.Width - SourceX), SourceY+R.Top+DeltaY) + , RSrc + , RDest , 1.0 ); {$ELSE} From 180eea59e3a2fe83f9f26f39fb6c55de9c15e7cc Mon Sep 17 00:00:00 2001 From: livius2 Date: Fri, 30 Nov 2018 22:10:06 +0100 Subject: [PATCH 54/61] fix after merge with master --- Source/VirtualTrees.pas | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/Source/VirtualTrees.pas b/Source/VirtualTrees.pas index 226bd62f7..5a01d17fe 100644 --- a/Source/VirtualTrees.pas +++ b/Source/VirtualTrees.pas @@ -166,8 +166,6 @@ interface // Decoupling message for auto-adjusting the internal edit window. CM_AUTOADJUST = CM_BASE + 2005; - {$ENDIF} - // VT's own clipboard formats, // Note: The reference format is used internally to allow to link to a tree reference @@ -221,7 +219,6 @@ interface type // Alias defintions for convenience TImageIndex = System.UITypes.TImageIndex; - TCanvas = Vcl.Graphics.TCanvas; // The exception used by the trees. EVirtualTreeError = class(Exception); @@ -17508,7 +17505,7 @@ procedure TBaseVirtualTree.WMCancelMode(var Message: TWMCancelMode); inherited; end; -{$ENDIF} + //---------------------------------------------------------------------------------------------------------------------- procedure TBaseVirtualTree.WMChar(var Message: TWMChar); From 58a984fa84cbbfd2f1a095fc73e3d0dfa75f5101 Mon Sep 17 00:00:00 2001 From: Joachim Marder Date: Fri, 14 Dec 2018 22:12:39 +0100 Subject: [PATCH 55/61] Fix after merge with master --- Source/VirtualTrees.pas | 319 +++++++++++++++++++--------------------- 1 file changed, 151 insertions(+), 168 deletions(-) diff --git a/Source/VirtualTrees.pas b/Source/VirtualTrees.pas index 865d53f3b..120b8c258 100644 --- a/Source/VirtualTrees.pas +++ b/Source/VirtualTrees.pas @@ -1734,7 +1734,7 @@ TVTPaintInfo = record BrushOrigin: TPoint; // the alignment for the brush used to draw dotted lines ImageInfo: array[TVTImageInfoIndex] of TVTImageInfo; // info about each possible node image Offsets: TVTOffsets; // The offsets of the various elements of a tree node - VAlign: Integer; + VAlign: TDimension; procedure AdjustImageCoordinates(); end; @@ -12774,10 +12774,10 @@ procedure TBaseVirtualTree.CalculateVerticalAlignments(var PaintInfo: TVTPaintIn if (ImageInfo[iiNormal].Index >= 0) or (ImageInfo[iiState].Index >= 0) then begin if (ImageInfo[iiNormal].Index >= 0) then - VAlign := {$IFDEF VT_FMX}16{$ELSE}ImageInfo[iiNormal].Images.Height{$ENDIF}; //TODO: 16px Image! + VAlign := {$IFDEF VT_FMX}16{$ELSE}ImageInfo[iiNormal].Images.Height{$ENDIF} //TODO: 16px Image! else VAlign := {$IFDEF VT_FMX}16{$ELSE}ImageInfo[iiState].Images.Height{$ENDIF}; //TODO: 16px Image! - VAlign := MulDiv((Integer(NodeHeight[Node]) - VAlign), Node.Align, 100) + VAlign {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2; + VAlign := MulDiv((NodeHeight[Node] - VAlign), Node.Align, 100) + VAlign {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2; end else if toShowButtons in FOptions.FPaintOptions then @@ -23681,7 +23681,7 @@ procedure TBaseVirtualTree.HandleMouseDblClick(var Message: TWMMouse; const HitI if hiOnItemCheckBox in HitInfo.HitPositions then begin NewCheckState := DetermineNextCheckState(HitInfo.HitNode.CheckType, HitInfo.HitNode.CheckState); - if (ssLeft in KeysToShiftState(Message.Keys)) and DoChecking(HitInfo.HitNode, NewCheckState) then + if (ssLeft in {$IFDEF VT_FMX}TShiftState(Word(Message.Keys)){$ELSE}KeysToShiftState(Message.Keys){$ENDIF}) and DoChecking(HitInfo.HitNode, NewCheckState) then begin SetCheckState(HitInfo.HitNode, NewCheckState); MayEdit := False; @@ -23928,7 +23928,7 @@ procedure TBaseVirtualTree.HandleMouseDown(var Message: TWMMouse; var HitInfo: T if hiOnItemCheckBox in HitInfo.HitPositions then begin NewCheckState := DetermineNextCheckState(HitInfo.HitNode.CheckType, HitInfo.HitNode.CheckState); - if (ssLeft in KeysToShiftState(Message.Keys)) and DoChecking(HitInfo.HitNode, NewCheckState) then + if (ssLeft in {$IFDEF VT_FMX}TShiftState(Word(Message.Keys)){$ELSE}KeysToShiftState(Message.Keys){$ENDIF}) and DoChecking(HitInfo.HitNode, NewCheckState) then begin if Self.SelectedCount > 1 then SetCheckStateForAll(NewCheckState, True) @@ -32283,196 +32283,179 @@ procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Targe // Paint the cell only if it is in the current window. if PaintInfo.CellRect.Right > Window.Left{$IFDEF VT_FMX}-FEffectiveOffsetX{$ENDIF} then - begin - with PaintInfo do - begin - ImageInfo[iiCheck].Index := GetCheckImage(Node); - ImageInfo[iiCheck].Images := FCheckImages; - ImageInfo[iiCheck].Ghosted := False; - end - else - ImageInfo[iiCheck].Index := -1; - GetImageIndex(PaintInfo, ikState, iiState); - GetImageIndex(PaintInfo, ImageKind[vsSelected in Node.States], iiNormal); - - CalculateVerticalAlignments(PaintInfo, ButtonY); - // Take the space for the tree lines into account. - PaintInfo.AdjustImageCoordinates(); - if UseColumns then begin - ClipRect := CellRect; - if poUnbuffered in PaintOptions then + with PaintInfo do begin - ImageInfo[iiCheck].Index := GetCheckImage(Node); - ImageInfo[iiCheck].Images := FCheckImages; - ImageInfo[iiCheck].Ghosted := False; - end - else - ImageInfo[iiCheck].Index := -1; - if ShowStateImages then - GetImageIndex(PaintInfo, ikState, iiState) - else - ImageInfo[iiState].Index := -1; - if ShowImages then - GetImageIndex(PaintInfo, ImageKind[vsSelected in Node.States], iiNormal) - else - ImageInfo[iiNormal].Index := -1; - - // Take the space for the tree lines into account. - PaintInfo.AdjustImageCoordinates(VAlign); - if UseColumns then - begin - ClipRect := CellRect; - if poUnbuffered in PaintOptions then + // Fill in remaining values in the paint info structure. + NodeWidth := DoGetNodeWidth(Node, Column, Canvas); + + if ShowCheckImages and IsMainColumn then begin - {$IFDEF VT_FMX} - if hoVisible in FHeader.Options then - ClipRect.Top:= Max(ClipRect.Top, FHeader.Height); - (* - ClipRect.Left := Max(ClipRect.Left, Window.Left); - ClipRect.Right := Min(ClipRect.Right, Window.Right); - if hoVisible in FHeader.Options then - ClipRect.Top := Max(Max(ClipRect.Top, Window.Top - (BaseOffset - CurrentNodeHeight)), FHeader.Height) else - ClipRect.Top := Max(ClipRect.Top, Window.Top - (BaseOffset - CurrentNodeHeight)); - ClipRect.Bottom := ClipRect.Bottom - Max(TargetRect.Bottom - MaximumBottom, 0){$IFDEF VT_FMX}+1{$ENDIF}; - *) - {$ELSE} - ClipRect.Left := Max(ClipRect.Left, Window.Left); - ClipRect.Right := Min(ClipRect.Right, Window.Right); - ClipRect.Top := Max(ClipRect.Top, Window.Top - (BaseOffset - CurrentNodeHeight)); - ClipRect.Bottom := ClipRect.Bottom - Max(TargetRect.Bottom - MaximumBottom, 0); - {$ENDIF} - end; + ImageInfo[iiCheck].Index := GetCheckImage(Node); + ImageInfo[iiCheck].Images := FCheckImages; + ImageInfo[iiCheck].Ghosted := False; + end + else + ImageInfo[iiCheck].Index := -1; + GetImageIndex(PaintInfo, ikState, iiState); + GetImageIndex(PaintInfo, ImageKind[vsSelected in Node.States], iiNormal); + + CalculateVerticalAlignments(PaintInfo, ButtonY); + // Take the space for the tree lines into account. + PaintInfo.AdjustImageCoordinates(); + if UseColumns then + begin + ClipRect := CellRect; + if poUnbuffered in PaintOptions then + begin + {$IFDEF VT_FMX} + if hoVisible in FHeader.Options then + ClipRect.Top:= Max(ClipRect.Top, FHeader.Height); + (* + ClipRect.Left := Max(ClipRect.Left, Window.Left); + ClipRect.Right := Min(ClipRect.Right, Window.Right); + if hoVisible in FHeader.Options then + ClipRect.Top := Max(Max(ClipRect.Top, Window.Top - (BaseOffset - CurrentNodeHeight)), FHeader.Height) else + ClipRect.Top := Max(ClipRect.Top, Window.Top - (BaseOffset - CurrentNodeHeight)); + ClipRect.Bottom := ClipRect.Bottom - Max(TargetRect.Bottom - MaximumBottom, 0){$IFDEF VT_FMX}+1{$ENDIF}; + *) + {$ELSE} + ClipRect.Left := Max(ClipRect.Left, Window.Left); + ClipRect.Right := Min(ClipRect.Right, Window.Right); + ClipRect.Top := Max(ClipRect.Top, Window.Top - (BaseOffset - CurrentNodeHeight)); + ClipRect.Bottom := ClipRect.Bottom - Max(TargetRect.Bottom - MaximumBottom, 0); + {$ENDIF} + end; {$IFDEF VT_FMX} - Canvas.IntersectClipRect(ClipRect); + Canvas.IntersectClipRect(ClipRect); {$ELSE} - ClipCanvas(Canvas, ClipRect); + ClipCanvas(Canvas, ClipRect); {$ENDIF} - end; + end; - // Paint the horizontal grid line. - if (poGridLines in PaintOptions) and (toShowHorzGridLines in FOptions.FPaintOptions) then - begin + // Paint the horizontal grid line. + if (poGridLines in PaintOptions) and (toShowHorzGridLines in FOptions.FPaintOptions) then + begin {$IFDEF VT_FMX} - Canvas.Fill.Color := FColors.GridLineColor; + Canvas.Fill.Color := FColors.GridLineColor; {$ELSE} - Canvas.Font.Color := FColors.GridLineColor; + Canvas.Font.Color := FColors.GridLineColor; {$ENDIF} - if IsMainColumn and (FLineMode = lmBands) then - begin - if BidiMode = bdLeftToRight then - begin - DrawDottedHLine(PaintInfo, CellRect.Left + IfThen(toFixedIndent in FOptions.FPaintOptions, 1, IndentSize) * FIndent, CellRect.Right - 1, - CellRect.Bottom - 1{$IFDEF VT_FMX}, FDottedBrushGrid{$ENDIF}); - end - else - begin - DrawDottedHLine(PaintInfo, CellRect.Left, CellRect.Right - IfThen(toFixedIndent in FOptions.FPaintOptions, 1, IndentSize) * FIndent - 1, - CellRect.Bottom - 1{$IFDEF VT_FMX}, FDottedBrushGrid{$ENDIF}); - end; - end - else - DrawDottedHLine(PaintInfo, CellRect.Left, CellRect.Right, CellRect.Bottom - 1{$IFDEF VT_FMX}, FDottedBrushGrid{$ENDIF}); + if IsMainColumn and (FLineMode = lmBands) then + begin + if BidiMode = bdLeftToRight then + begin + DrawDottedHLine(PaintInfo, CellRect.Left + IfThen(toFixedIndent in FOptions.FPaintOptions, 1, IndentSize) * FIndent, CellRect.Right - 1, + CellRect.Bottom - 1{$IFDEF VT_FMX}, FDottedBrushGrid{$ENDIF}); + end + else + begin + DrawDottedHLine(PaintInfo, CellRect.Left, CellRect.Right - IfThen(toFixedIndent in FOptions.FPaintOptions, 1, IndentSize) * FIndent - 1, + CellRect.Bottom - 1{$IFDEF VT_FMX}, FDottedBrushGrid{$ENDIF}); + end; + end + else + DrawDottedHLine(PaintInfo, CellRect.Left, CellRect.Right, CellRect.Bottom - 1{$IFDEF VT_FMX}, FDottedBrushGrid{$ENDIF}); {$IFDEF VT_FMX} - if WasDecLine=0 then - begin + if WasDecLine=0 then + begin + Dec(CellRect.Bottom); + Dec(ContentRect.Bottom); + end; + System.inc(WasDecLine); +{$ELSE} Dec(CellRect.Bottom); Dec(ContentRect.Bottom); - end; - System.inc(WasDecLine); -{$ELSE} - Dec(CellRect.Bottom); - Dec(ContentRect.Bottom); {$ENDIF} - end; + end; - if UseColumns then - begin - // Paint vertical grid line. - if (poGridLines in PaintOptions) and (toShowVertGridLines in FOptions.FPaintOptions) then - begin - // These variables and the nested if conditions shall make the logic - // easier to understand. - CellIsTouchingClientRight := PaintInfo.CellRect.Right = ClientRect.Right; - CellIsInLastColumn := Position = TColumnPosition(Count - 1); - ColumnIsFixed := coFixed in FHeader.FColumns[Column].Options; - - // Don't draw if this is the last column and the header is in autosize mode. - if not ((hoAutoResize in FHeader.FOptions) and CellIsInLastColumn) then + if UseColumns then begin - // We have to take spanned cells into account which we determine - // by checking if CellRect.Right equals the Window.Right. - // But since the PaintTree procedure is called twice in - // TBaseVirtualTree.Paint (i.e. for fixed columns and other columns. - // CellIsTouchingClientRight does not work for fixed columns.) - // we have to paint fixed column grid line anyway. - if not CellIsTouchingClientRight or ColumnIsFixed then + // Paint vertical grid line. + if (poGridLines in PaintOptions) and (toShowVertGridLines in FOptions.FPaintOptions) then begin - if (BidiMode = bdLeftToRight) or not ColumnIsEmpty(Node, Column) then + // These variables and the nested if conditions shall make the logic + // easier to understand. + CellIsTouchingClientRight := PaintInfo.CellRect.Right = ClientRect.Right; + CellIsInLastColumn := Position = TColumnPosition(Count - 1); + ColumnIsFixed := coFixed in FHeader.FColumns[Column].Options; + + // Don't draw if this is the last column and the header is in autosize mode. + if not ((hoAutoResize in FHeader.FOptions) and CellIsInLastColumn) then begin - {$IFDEF VT_FMX} - Canvas.Fill.Color := FColors.GridLineColor; - {$ELSE} - Canvas.Font.Color := FColors.GridLineColor; - {$ENDIF} - lUseSelectedBkColor := (poDrawSelection in PaintOptions) and (toFullRowSelect in FOptions.FSelectionOptions) and - (vsSelected in Node.States) and not (toUseBlendedSelection in FOptions.PaintOptions) - {$IFDEF VT_VCL}and not (tsUseExplorerTheme in FStates){$ENDIF}; - DrawDottedVLine(PaintInfo, CellRect.Top, CellRect.Bottom, CellRect.Right - 1{$IFDEF VT_FMX}, FDottedBrushGrid{$ENDIF}, lUseSelectedBkColor); - end; + // We have to take spanned cells into account which we determine + // by checking if CellRect.Right equals the Window.Right. + // But since the PaintTree procedure is called twice in + // TBaseVirtualTree.Paint (i.e. for fixed columns and other columns. + // CellIsTouchingClientRight does not work for fixed columns.) + // we have to paint fixed column grid line anyway. + if not CellIsTouchingClientRight or ColumnIsFixed then + begin + if (BidiMode = bdLeftToRight) or not ColumnIsEmpty(Node, Column) then + begin +{$IFDEF VT_FMX} + Canvas.Fill.Color := FColors.GridLineColor; +{$ELSE} + Canvas.Font.Color := FColors.GridLineColor; +{$ENDIF} + lUseSelectedBkColor := (poDrawSelection in PaintOptions) and (toFullRowSelect in FOptions.FSelectionOptions) and + (vsSelected in Node.States) and not (toUseBlendedSelection in FOptions.PaintOptions) + {$IFDEF VT_VCL}and not (tsUseExplorerTheme in FStates){$ENDIF}; + DrawDottedVLine(PaintInfo, CellRect.Top, CellRect.Bottom, CellRect.Right - 1{$IFDEF VT_FMX}, FDottedBrushGrid{$ENDIF}, lUseSelectedBkColor); + end; - Dec(CellRect.Right); - Dec(ContentRect.Right); + Dec(CellRect.Right); + Dec(ContentRect.Right); + end; + end; end; end; - end; - end; - // Prepare background and focus rect for the current cell. - PrepareCell(PaintInfo, Window.Left{$IFDEF VT_FMX}-FEffectiveOffsetX{$ENDIF}, PaintWidth); + // Prepare background and focus rect for the current cell. + PrepareCell(PaintInfo, Window.Left{$IFDEF VT_FMX}-FEffectiveOffsetX{$ENDIF}, PaintWidth); - // Some parts are only drawn for the main column. - if IsMainColumn then - begin - if (toShowTreeLines in FOptions.FPaintOptions) and - (not (toHideTreeLinesIfThemed in FOptions.FPaintOptions) or - not (tsUseThemes in FStates)) then - PaintTreeLines(PaintInfo, IfThen(toFixedIndent in FOptions.FPaintOptions, 1, - IndentSize), LineImage); - // Show node button if allowed, if there child nodes and at least one of the child - // nodes is visible or auto button hiding is disabled. - if (toShowButtons in FOptions.FPaintOptions) and (vsHasChildren in Node.States) and - not ((vsAllChildrenHidden in Node.States) and - (toAutoHideButtons in TreeOptions.FAutoOptions)) and - ((toShowRoot in TreeOptions.PaintOptions) or (GetNodeLevel(Node) > 0)) - then - PaintNodeButton(Canvas, Node, Column, CellRect, Offsets[ofsToggleButton], ButtonY, BidiMode); // Relative X position of toggle button is needed for proper BiDi calculation - - if ImageInfo[iiCheck].Index > -1 then - PaintCheckImage(Canvas, PaintInfo.ImageInfo[iiCheck], vsSelected in PaintInfo.Node.States); - end; + // Some parts are only drawn for the main column. + if IsMainColumn then + begin + if (toShowTreeLines in FOptions.FPaintOptions) and + (not (toHideTreeLinesIfThemed in FOptions.FPaintOptions) or + not (tsUseThemes in FStates)) then + PaintTreeLines(PaintInfo, IfThen(toFixedIndent in FOptions.FPaintOptions, 1, + IndentSize), LineImage); + // Show node button if allowed, if there child nodes and at least one of the child + // nodes is visible or auto button hiding is disabled. + if (toShowButtons in FOptions.FPaintOptions) and (vsHasChildren in Node.States) and + not ((vsAllChildrenHidden in Node.States) and + (toAutoHideButtons in TreeOptions.FAutoOptions)) and + ((toShowRoot in TreeOptions.PaintOptions) or (GetNodeLevel(Node) > 0)) + then + PaintNodeButton(Canvas, Node, Column, CellRect, Offsets[ofsToggleButton], ButtonY, BidiMode); // Relative X position of toggle button is needed for proper BiDi calculation + + if ImageInfo[iiCheck].Index > -1 then + PaintCheckImage(Canvas, PaintInfo.ImageInfo[iiCheck], vsSelected in PaintInfo.Node.States); + end; - if ImageInfo[iiState].Index > -1 then - PaintImage(PaintInfo, iiState, False); - if ImageInfo[iiNormal].Index > -1 then - PaintImage(PaintInfo, iiNormal, True); + if ImageInfo[iiState].Index > -1 then + PaintImage(PaintInfo, iiState, False); + if ImageInfo[iiNormal].Index > -1 then + PaintImage(PaintInfo, iiNormal, True); - // Now let descendants or applications draw whatever they want, - // but don't draw the node if it is currently being edited. - if not ((tsEditing in FStates) and (Node = FFocusedNode) and - ((Column = FEditColumn) or not UseColumns)) then - DoPaintNode(PaintInfo); + // Now let descendants or applications draw whatever they want, + // but don't draw the node if it is currently being edited. + if not ((tsEditing in FStates) and (Node = FFocusedNode) and + ((Column = FEditColumn) or not UseColumns)) then + DoPaintNode(PaintInfo); - DoAfterCellPaint(Canvas, Node, Column, CellRect); - end; - end; + DoAfterCellPaint(Canvas, Node, Column, CellRect); + end; + end; - // leave after first run if columns aren't used - if not UseColumns then - Break; - end - else - NextColumn := GetNextVisibleColumn(PaintInfo.Column); + // leave after first run if columns aren't used + if not UseColumns then + Break; + end + else + NextColumn := GetNextVisibleColumn(PaintInfo.Column); finally {$IFDEF VT_FMX} PaintInfo.Canvas.RestoreState(SavedTargetDC); From 892db4d71d365708a813aca3e14426e66c1fc352 Mon Sep 17 00:00:00 2001 From: livius2 Date: Mon, 8 Apr 2019 22:34:55 +0200 Subject: [PATCH 56/61] Fix FMX after merge with master --- Source/VirtualTrees.FMX.pas | 16 ++++++++++ Source/VirtualTrees.Utils.pas | 5 +-- Source/VirtualTrees.pas | 59 +++++++++++++++++++++++++---------- 3 files changed, 61 insertions(+), 19 deletions(-) diff --git a/Source/VirtualTrees.FMX.pas b/Source/VirtualTrees.FMX.pas index ee31c38d8..b8671cd37 100644 --- a/Source/VirtualTrees.FMX.pas +++ b/Source/VirtualTrees.FMX.pas @@ -46,6 +46,10 @@ interface clGreen = TAlphaColorRec.Green; clBlue = TAlphaColorRec.Blue; clGrayText = TAlphaColorRec.DkGray; + clInactiveCaption = TAlphaColorRec.Darkblue; //TODO: color + clInactiveCaptionText = TAlphaColorRec.Yellow; //TODO: color + clDkGray = TAlphaColorRec.DkGray; + //------- needed for migration ------------------------------------------------------------------------------------------------------------- @@ -482,9 +486,21 @@ TCanvasHelper = class helper for TCanvas procedure FrameRect(const AFocusRect: TRect); end; +{ Draws a solid triangular arrow that can point in any TScrollDirection } + +type + TScrollDirection = (sdLeft, sdRight, sdUp, sdDown); + TArrowType = (atSolid, atArrows); + +procedure DrawArrow(ACanvas: TCanvas; Direction: TScrollDirection; Location: TPoint; Size: Single); + implementation uses FMX.TextLayout, System.SysUtils, FMX.MultiResBitmap, FMX.Objects, VirtualTrees.Utils, FMX.Effects; +procedure DrawArrow(ACanvas: TCanvas; Direction: TScrollDirection; Location: TPoint; Size: Single); +begin + //TODO: DrawArrow implementation +end; { TCanvasHelper } diff --git a/Source/VirtualTrees.Utils.pas b/Source/VirtualTrees.Utils.pas index f68c0674b..31bca8356 100644 --- a/Source/VirtualTrees.Utils.pas +++ b/Source/VirtualTrees.Utils.pas @@ -111,10 +111,10 @@ procedure ApplyDragImage(const pDataObject: IDataObject; pBitmap: TBitmap); function IsMouseCursorVisible(): Boolean; procedure ScaleImageList(const ImgList: TImageList; M, D: Integer); -{$ENDIF} /// Returns True if the high contrast theme is anabled in the system settings, False otherwise. function IsHighContrastEnabled(): Boolean; +{$ENDIF} implementation uses @@ -1481,7 +1481,7 @@ procedure ScaleImageList(const ImgList: TImageList; M, D: Integer); TmpImgList.Free; end; end; -{$ENDIF} + function IsHighContrastEnabled(): Boolean; var @@ -1491,5 +1491,6 @@ function IsHighContrastEnabled(): Boolean; Result := SystemParametersInfo(SPI_GETHIGHCONTRAST, 0, @l, 0) and ((l.dwFlags and HCF_HIGHCONTRASTON) <> 0); end; +{$ENDIF} end. diff --git a/Source/VirtualTrees.pas b/Source/VirtualTrees.pas index 2018a8302..c22f81de2 100644 --- a/Source/VirtualTrees.pas +++ b/Source/VirtualTrees.pas @@ -7357,7 +7357,7 @@ procedure TVirtualTreeColumn.ComputeHeaderLayout(var PaintInfo: THeaderPaintInfo begin PaintInfo.GlyphPos.X := (ClientSize.X - HeaderGlyphSize.X) {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2; TextPos.X := (ClientSize.X - TextSize.cx) {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2; - if UseSortGlyph then + if PaintInfo.ShowSortGlyph then Dec(TextPos.X, PaintInfo.SortGlyphSize.cx {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2); end else @@ -9537,13 +9537,13 @@ procedure TVirtualTreeColumns.PaintHeader(TargetCanvas: TCanvas; R: TRect; const // Show an indication if this column is the current drop target in a header drag operation. if not (hpeDropMark in ActualElements) and (DropMark <> dmmNone) then begin -{ +(* Y := (PaintRectangle.Top + PaintRectangle.Bottom - {$IFDEF VT_FMX}16{$ELSE}UtilityImages.Height{$ENDIF}) {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2;//TODO: 16px Image!!! if DropMark = dmmLeft then UtilityImages.Draw(TargetCanvas, {$IFDEF VT_FMX}RectF(PaintRectangle.Left, Y, PaintRectangle.Left+16, Y+16){$ELSE}PaintRectangle.Left, Y{$ENDIF}, 0)//TODO: 16px Image!!! else UtilityImages.Draw(TargetCanvas, {$IFDEF VT_FMX}RectF(PaintRectangle.Right - 16, Y, PaintRectangle.Right, Y + 16){$ELSE}PaintRectangle.Right - 16 , Y{$ENDIF}, 1);//TODO: 16px Image!!! -} +*) PaintInfo.DrawDropMark(); end; @@ -12281,10 +12281,12 @@ function TVTColors.GetNodeFontColor: TColor; function TVTColors.GetSelectedNodeFontColor(Focused: boolean): TColor; begin if Focused then begin +{$IFDEF VT_VCL} if (tsUseExplorerTheme in FOwner.FStates) and not IsHighContrastEnabled then begin Result := NodeFontColor end else +{$ENDIF} Result := SelectionTextColor end// if Focused else @@ -12640,7 +12642,7 @@ procedure TBaseVirtualTree.AdjustTotalCount(Node: PVirtualNode; Value: Integer; // Root node has as parent the tree view. while Assigned(Run) and (Run <> Pointer(Self)) do begin - Inc(Integer(Run.TotalCount), Difference); + System.Inc(Integer(Run.TotalCount), Difference); Run := Run.Parent; end; end; @@ -15283,9 +15285,20 @@ procedure TBaseVirtualTree.SetCheckImageKind(Value: TCheckImageKind); if Value = ckCustom then FCheckImages := FCustomCheckImages else if HandleAllocated then - FCheckImages := CreateSystemImageSet(Self); + begin + {$IFDEF VT_FMX} + FCheckImages:= TImageList.Create(Self); + FillSystemCheckImages(Self, FCheckImages as TImageList); + {$ELSE} + FCheckImages := CreateSystemImageSet(Self); + {$ENDIF} + end; + {$IFDEF VT_FMX} + Repaint; + {$ELSE} if HandleAllocated and (FUpdateCount = 0) and not (csLoading in ComponentState) then InvalidateRect(Handle, nil, False); + {$ENDIF} end; end; @@ -22942,8 +22955,8 @@ function TBaseVirtualTree.GetCheckImage(Node: PVirtualNode; ImgCheckType: TCheck if ImgCheckType = ctTriStateCheckBox then ImgCheckType := ctCheckBox; - if IsHot and (ImgCheckState in [csCheckedNormal, csUncheckedNormal]) and (GetKeyState(VK_LBUTTON) < 0) and (hiOnItemCheckbox in FLastHitInfo.HitPositions) then - Inc(ImgCheckState); // Advance to pressed state + if IsHot and (ImgCheckState in [csCheckedNormal, csUncheckedNormal]){$IFDEF VT_VCL}and (GetKeyState(VK_LBUTTON) < 0){$ENDIF} and (hiOnItemCheckbox in FLastHitInfo.HitPositions) then //TODO: GetKeyState + System.Inc(ImgCheckState); // Advance to pressed state if ImgCheckType = ctNone then Result := -1 @@ -25186,8 +25199,16 @@ procedure TBaseVirtualTree.Paint; begin {$IFDEF VT_FMX} //it must be in paint - without this images are empty - if SystemCheckImages.Count=0 then - FillSystemCheckImages(Self, SystemCheckImages); + if not Assigned(FCheckImages) or (FCheckImages.Count=0) then + begin + if not (FCheckImages is TImageList) then + begin + FreeAndNil(FCheckImages); + FCheckImages:= TImageList.Create(Self); + end; + + FillSystemCheckImages(Self, FCheckImages as TImageList); + end; {$ENDIF} Options := [poBackground, poColumnColor, poDrawFocusRect, poDrawDropMark, poDrawSelection, poGridLines]; @@ -35408,12 +35429,12 @@ procedure TCustomVirtualStringTree.InitializeTextProperties(var PaintInfo: TVTPa if Node = FDropTargetNode then begin if ((FLastDropMode = dmOnNode) or (vsSelected in Node.States)) then - Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Font{$ENDIF}.Color := FColors.GetSelectedNodeFontColor(Focused); + Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Font{$ENDIF}.Color := FColors.GetSelectedNodeFontColor({$IFDEF VT_FMX}IsFocused{$ELSE}Focused{$ENDIF}); end else if vsSelected in Node.States then begin - Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Font{$ENDIF}.Color := FColors.GetSelectedNodeFontColor(Focused); + Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Font{$ENDIF}.Color := FColors.GetSelectedNodeFontColor({$IFDEF VT_FMX}IsFocused{$ELSE}Focused{$ENDIF}); end; end; end; @@ -35448,7 +35469,11 @@ procedure TCustomVirtualStringTree.PaintNormalText(var PaintInfo: TVTPaintInfo; InflateRect(R, -FTextMargin, 0); if (vsDisabled in Node.States) or not Enabled then +{$IFDEF VT_FMX} + Canvas.Fill.Color := FColors.DisabledColor; +{$ELSE} Canvas.Font.Color := FColors.DisabledColor; +{$ENDIF} // Multiline nodes don't need special font handling or text manipulation. // Note: multiline support requires the Unicode version of DrawText, which is able to do word breaking. // The emulation in this unit does not support this so we have to use the OS version. However @@ -35533,7 +35558,7 @@ procedure TCustomVirtualStringTree.PaintStaticText(const PaintInfo: TVTPaintInfo if Node = FDropTargetNode then begin if (FLastDropMode = dmOnNode) or (vsSelected in Node.States) then - Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Font{$ENDIF}.Color := FColors.GetSelectedNodeFontColor(Focused) + Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Font{$ENDIF}.Color := FColors.GetSelectedNodeFontColor({$IFDEF VT_FMX}IsFocused{$ELSE}Focused{$ENDIF}) else Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Font{$ENDIF}.Color := FColors.NodeFontColor; end @@ -35541,7 +35566,7 @@ procedure TCustomVirtualStringTree.PaintStaticText(const PaintInfo: TVTPaintInfo if vsSelected in Node.States then begin if {$IFDEF VT_FMX}IsFocused{$ELSE}Focused{$ENDIF} or (toPopupMode in FOptions.FPaintOptions) then - Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Font{$ENDIF}.Color := FColors.GetSelectedNodeFontColor(Focused) + Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Font{$ENDIF}.Color := FColors.GetSelectedNodeFontColor({$IFDEF VT_FMX}IsFocused{$ELSE}Focused{$ENDIF}) else Canvas.{$IFDEF VT_FMX}Fill{$ELSE}Font{$ENDIF}.Color := FColors.NodeFontColor; end; @@ -36889,15 +36914,15 @@ procedure TVTPaintInfo.AdjustImageCoordinates(); procedure THeaderPaintInfo.DrawDropMark(); var - Y: Integer; - lArrowWidth: Integer; + Y: TDimension; + lArrowWidth: TDimension; begin lArrowWidth := Self.Column.Owner.Header.Treeview.ScaledPixels(5); - Y := (PaintRectangle.Top + PaintRectangle.Bottom - 3 * lArrowWidth) div 2; + Y := (PaintRectangle.Top + PaintRectangle.Bottom - 3 * lArrowWidth) {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2; if DropMark = dmmLeft then DrawArrow(TargetCanvas, TScrollDirection.sdLeft, Point(PaintRectangle.Left, Y), lArrowWidth) else - DrawArrow(TargetCanvas, TScrollDirection.sdRight, Point(PaintRectangle.Right - lArrowWidth - (lArrowWidth div 2) {spacing}, Y), lArrowWidth); + DrawArrow(TargetCanvas, TScrollDirection.sdRight, Point(PaintRectangle.Right - lArrowWidth - (lArrowWidth {$IFDEF VT_FMX}/{$ELSE}div{$ENDIF} 2) {spacing}, Y), lArrowWidth); end; procedure THeaderPaintInfo.DrawSortArrow(pDirection: TSortDirection); From a8a0e0c7427a19a3634b3bf7d05678941a90af32 Mon Sep 17 00:00:00 2001 From: livius2 Date: Wed, 10 Apr 2019 22:31:26 +0200 Subject: [PATCH 57/61] Added screenshot from Android --- README.md | 4 ++++ ScreenShots/VT_Android_8_0.jpg | Bin 0 -> 113794 bytes 2 files changed, 4 insertions(+) create mode 100644 ScreenShots/VT_Android_8_0.jpg diff --git a/README.md b/README.md index 495c1b68a..693b41123 100644 --- a/README.md +++ b/README.md @@ -41,6 +41,10 @@ Remember to add also to uses clause unit VirtualTrees.FMX. If you install package for FMX you can not use installed package for VCL and vice-versa. I still look for the way to do this. +Sample view on Android :) + +![VT_Android](Screenshots/VT_Android_8_0.jpg) + # Virtual-TreeView Virtual Treeview is a Delphi treeview control built from ground up. Many years of development made it one of the most flexible and advanced tree controls available today. Virtual Treeview starts off with the claim to improve many aspects of existing solutions and introduces some new technologies and principles which were not available before. diff --git a/ScreenShots/VT_Android_8_0.jpg b/ScreenShots/VT_Android_8_0.jpg new file mode 100644 index 0000000000000000000000000000000000000000..62a59dcf072ed08dc67e4fbc4d43f03f82474394 GIT binary patch literal 113794 zcmeFZ2UJtr+AbUf>4^3tpHG(iPF+nbaKalMyh_qpV`!xu}!UD1%0)eoDpYcPO!M~WmpWj~FqmYx39ZXC= ze*gJm-pTyq#md6MypxTUjqS(9&cVgO&d$ls#>UCR$;rhHzSuZ+@$zu*`tkRVMt*$# z$G5;=Zgw{IA9wuEy|x=5eC$k%EGT9sX~+&fCT2dS?G^|W?CVZ&L_Y@g&ll4UW|p0- zV3#<#z#GbUgWYFl-T`)YCkqRBcM$kFgoSS>ztq9wtOAx-*ra^~HSQ%mW0yHm+$eOe zhb*gk^=1eMr?AMLy`pmR3W`emwX}6~4;?;o@|2;Gv5BeK`3qLoHWzK}oSa>*xw^S~ z_};qh=N}MwC-i<;ctm7WbmGHDNy(3&q@+I2dXb%zo0tExq_nKOqOz*Grm4B5wT;-` z@wT_Ge_(Lv#7cKCxAGat)Nse`Qi$1T~e_y|aA++!C!k?^dzkwZrF99ih<%^pr+S*(0~M>DT+{0#ha=`?N4* z%;<0(ws zWFU{ac{O~8j(TZb#8wvK$Tp<$BxW)snZU)6@W?m>=we=Z_-(3K_~!+9&|_k7Qbx{+ zgI1i*iq%d6MWmN4dI#8#!4A4*uH!wn?!&I~@-xN}Vov0YP>s0?o!48X7Y9B^cI-;J zzDMb1X58vQsdEP!ijSTMzsy7`vsvVA!3{T4^|wN9$LTiQ$!$jLK{-;!2C&q)uJTv` zkD5n19}ich$RzK%a=z@rOI@aL{oO<{k~*E=cM`Kip@E%kYTrup$|aBIkt~H%v`Vzo zyWU+EDakl&n=yF9Y$|C4mVSowbz(3~?rXsvMp)of(9N~e{e@~OwxnVWd6w|jekDPB!J9`|9i>20mx z5_j#a+q+1Kdsm*~M%5WS>tuK|eQ)4P`rbrZv!g<3Y^QM4-GCuGbbc`AR-zfIUDoT} z`;MnO1SRH~fCa;g17&H2%vLqU_2pG1^(9G@Rh1c<;;&8a7swP`E>L3GZFGFk%Wn`% zL&5)Emvxy1|3=HmKt@{5@R)~a_%jWAyOGgTy6sb`2y_wK?tfTA6Za-3^w>x-Dkn3}-4aad{Kw zC7USbcS9~g;GMI>>WLYzeZH}=o6(Ty=*_#--fc)oU^7{_QBoXuNFHsmpomRQ#7IYZ zqD~aEXZNX@oTYB$y@(V;9~+C^ZTY(MJ)SP8&fu7P#%O^t)$j61u9uZmq_D*ouBffs zFDTznGflAa9Ot`s!6l1JNz&cvbI_#Vm1Arjk8B1I72S)MCbuCUiBwnM%C2YrMGH`2 z{XhssqIImq^Mj|>und!@WxKTd0JYfJi#feP`IP-T%vHkh=<%&=11VUE7AbZE+q1(J+ zj?Dc<-1X32?KJ2TX1C#WpR!Lac+OMy$$X_Le707M8v|!(40gj@#`_G-ssRI8Ad%KG z!8!9fV|?22gA`5fOW5)yzt*5YH(KX#+o$U2lcfd*S<$U-7|EG6-Q@jNW>|t&DQd9W>jD zN=j}NzD|?EYP$T~?OUL#kDtrEy4Nzixq*pH@{9VO9TE_OGHX8h4lW9%JmqO`tx5{AKVFtudn7s_tEr0keAwjE3G(S6d+O$EN^+rkq%#>4PM7lF=s)wA zx(%rq7gDQe55E|}m!iL88+<<+|vo*>i1Q+Z*3_C;3?MN%J1sfMf&Y`viOc$3+ z@>dORL&{`auC98=yS3akVP+9u?)IR1?*`dS8@+o1{SL#2mIGv{(N&ZrTyyQkjL&Rj z?#=5qBAPm#cYU-fQCir0Nj9SoOlF*!Nt?=x&~O6zG!JhZgOiMY7)X(}(41y#fpb|* z^YQ=}-L4_UVhl~QLzM8Sso5_58?||S52_juOV>Ns0(vBK=zVLnewtY-lw)4>MXGj1 z=JGw)+Ia1xX{+~ZzeFeGL^8xnobZxN(|LTlG6_+~1?pI#M*D0=XIYHI!R=YpSP>m6z{?rG3 zbY_J}`=-~9wqxU+`8=?t30D&-cldJM$I|pn*MK(PZZilaT6x|(9$Gxnz#Bo}(0=3F zgee!o#?cLP8%i#IHJyw}6YhW79)0%o5VuTIsg4=0HrAKec_?#7^u`LH0AJ)Qz%(95 zAL^PyT3FWUX3hDjV+xQ)E#s=u&a!4QYcjmDi5hu`gJ(W0y>C+1or+jA#-rS~D%8dNnw>(ZR>OGVp_wk(>{h5v5s#!ij4d&b`+J=OB zZ$oB?bynLDr>+Uc1NU_x3sF8n_S}ZhpKL@E76WUyA-y~X!7xGOdMJaZ7i&sJG<3&} zA50u1ZJg_KE~lOHD~?i29pt*3(&D4MTi2wqfhF(Ssg6A?X!uY+j%)@46s5NAF^)Q1 zn*Z?0F+ic!(%1!me8+OKL~NT_-Vl%>y|S8-FB^Q*5P}{+x4|l~p%`yy_(r`vdH;gt zsCy+5URyG-FIsHDT_@byjg)M~KAB!voBrwm`>Toj(8`Tq#v#VQxC(G`susiNA-Ruy zTB9r91LktC%xTtC@SM>@l{TX*vd<1&J!>oO3K5`u&fkWxR0Ahz<^d(!5R%B^7UesN zD+hR@RTCEe_)xOqsr#C3G6Khs*6?dwc_NW}ulz(_XbV)rU?=FgLIl?dz5v%Lo5(@~ zDb!Vp=>24heEdTDBW~Hpydulb!o^EpF{K*$iN*I`ItJ4uAmLnd8SGmx>*d{Q_P@BJ zgC)H=_qOr;a$%i+;)~07J+1KlctEGG`A$&f;uuBXV*H-Ag1e-Pua@PA@2^A;NXl(` zr8=z}G!Z26D>?luIn`CE<}oo*qP8vxG5YaDxu~P2vQLMGCdkI#fFc@4Z8I@W4emGH->@*`_h^4+E|Z zdJ8$)k6yGmTDiP(yTe@8Z?H=WwtvUVcgNaIqL`w?4im^{V8hrJSShxN2ffyI?jmto zJ(3|+O+lAmxmtVuTi|jCuEYrTk(npNXu3?8bI&?dd}avd<{d1&fnmD_*iS2`b#~s3 z39LK0XW*9YWwDsoe9K#3-!9EzpNL<;RKS-y$s1G!vi9d<(%993@{?i}X_>7DJdLd$ z@Foc#OpH9kY&I!9vwDUJLbn4!r8fXgY=)7~!=r^aQ3o5j``kAY_j5CAZF;`y(;di8 z_(*$*xB%*`v|geQ9$Bx7j4keXH8MI^VL8Lo;VsiG`-JKmuCfiOQeMMM3s@`%Oo(Ru#?sHIm^AzhSCKP^y-R3(N+WViu%V;s(X(CGp5l--)9OJ>0c8XP%{1* z!;jLaNnDz`bgh@NY|xwC$fKWjiQ`_3VnC4zn>yi}NF#I)N}Zz6QZL{0jpr_Wpxk@s zcu{(h-DpRRh1z7%lz6B_z?FoAY6;)!J-lK-H5otom@f2q^61k80ikCoa3x>~ar zd!A3KtPLMm$(`@jJG|kGP#c0%vPjG2lob*&66H=(%1X1NXwz%LMvbzaZ2aE$vn28v z2_0A9%yb?)cuX>vwg;s`R&T?MD4!&+v|xq7d6dAE*zD7>`TFZOzF&V(+m>-Xm?*hn zb!nM>?}kt_>Qs*wjt5w??fWL-%HUTOeoMWmq75%8$5UfDXJp6E^Y^Tr6+_~=enG@elCw!z`=au+ETk90pfd&%S*3}?1AzIC5|I1fEI zQQDR@jg7%^y()w5p`ZFdn1T*?U3v16fYo|kF#E}ThtL7dm5<_=lP+I)bxj-5gb%~; zsWJHIW*<Lcpg(rcPdacO5Wh`w$ueGX`~?Mi8yL0;*bq zf?qnU9$#nWesZXM?DWiDKaqD#$~$o!df?y;j&x0>wVkaKK|a3?8Id8m zwyMWlOu-}r+zlk=(9GMA6FvGONd8vWXAM?2p7Zx#H zWpHbpzp8e`r8I$3+vyjp<(c^ExU5R-C>>7?1ix5EzX`}tTrDW9`P1D(0c&QJL61kE zk=jwqOX`!}^;z$(t-c^C?~l!AmU>j8J3K)?hX<6)GqTBC4K=u?H|9;_`#zxMzt+@0 zCP8@@tc%CGa*BoD=G+Zx%t{r}xUX8Hq*=uwf`ssjf)9ImTpbh|AdguDb$e9kHdGAI zJ$H)234ETP@=_($xxKLNT?&@Vyx4s3!L41#Qk3AeLpRRF~ z)>7Pp9-vk|3Fj=>*BIv)GA%1rIkrZm3uLv5ZiEuNc*Fh2_x6{mDqp;GbI-XTk43w= z&xbX|d%C1#*eP03Vc(-Ji>QEM!WT@V=`GmqfHbNgkmfXHf9Wc%#ox{u>BRad(e$ng z&LcQs5B7^{na+u|SlS?A5l=foq#Xy2d>+R@P!{CC4@-sDmz^j@AvJFOoh?@MgwO3R z$6qgh5?RUnqQFmA+^RzFqTlGp7orp>%1w6JpVNKiUR89VEBca+M(ng6JDKm5iIU-t zWtWO`r5l3gx(9G-y#eUKfh5qx7{aXOER?Uw{&tVkoz;cq-IABx{N-vyI1kFm=-db{ z-VqFgY(uVlN8Islf{sj(BEoLn=9`lgqd4Z~*cyrXC$Z?>B#H{mzs!W*K=y&ToDmqw zb+L=47%)OKCD%*R%&SL?++}SAlWx2-<$e*e%UEcAqZvLt)JiCa()qKRYIyH0 z-rBOa>1D`z_*Yu@A%*?axmBI6M{h&s_}kc36WZ>aW%Kc#f{*x5Vi#$pwp(c{HZ2%l zlw2O**G$w+aLAsB_@)%r{7L3mNu)%An%W7ouVw`qdxDXfKrEQlQ`w5sN0L_fP!lI=~a z5_@i2=n^I6!{=GjWfS=g-sS3G;TJ`!d z!~>^?EMx8ln226}eB*nu@CnzMu@4WAL7$ed!xl$rZYT}1_o7ukT?|N?LMjLNBG}R02ywI+pxz`Y z-KV7H46fyPqp1pB>-%2@; zj)FRS@!6rntE*nD=u5BedwPymin|1AVLYHwHHa2(0e9?+E@U7Qc{Q?6uHd9}NAjop zCHeagHOz27y{*O6N;m7*Qne?JbPa{8+~!elt`te^$QeP5aTOFGZ?-%)SG3wSb%Sf? zUVT#WlB)BYn)p3V?(!*3(uy5^3J~7>oJIk-MqAaV8O4rDRf#1w74GZWfmSJj;z74tJwhj4qdSEV&qS@@|glRRM zV&pQep2bkCW)KzrG2h}aQ{lK>xB_?oHMM-PGQT08cW>)2WXUQi?A_-&F?S5A2bedd zMu60n{WaC%)zC;qslQNMQrSs$AN?YJErj1SW(xizVwl&lm%)nePem+_PNn6kfl+iA zhWGZ}ZHVBwJ#K8CAyZ@SSA7!`b@}8>PM|{#u10wkOLgDMEXNKzO`}7nS9pi#L`H@p zWD}7l<%dM?o?8)Utxm8t-7jA9pqcySU7N4DbOCP$XYr392j+++qM?Auq=_t59OoF5MOV!D}k_mv3s01jAH}?P&JY_87)qWd=th*?aPx!XjfI5Z*;m zXmxv05SDbxdUusRMf52iqQ7@04C|BP?g` z*JHC_73-gV)FRl^0Gwu zSt{lIFsI*vbMI_`K*Z?ilt^ry{p6S$EP}C{qLWKAp!1bsc;?3CLeF4cd-$6xF?t8M zf{zP028O<4$-Fqd_Z+*V4NV$_0U>p^bQ|ZP=oI9PS+G64 z?Vi)ArLj~Qb!O12u~`XfiHIHNPr5>JOkUM^uKLL^C4NWnbRu%|5rM*r^9|BUm={GQ zbjWCwe0pZhGPB#a3xak;T>pZ55DoS@1OY*|eRHz~44Muy_P0_O zpgIA!TH5LL%44AH{C?j zJ*Dk!q#dRTiKbuVs|bLs{}S^gY`B#AU}zl-mFxyShrSpKFt+Sd^;)`~vFuXwq~#@_ zl|9dFlv%QvKZFA^_+@cpI-S=Xw4cLt^aroKXx1Sh;V&Pd`K1h^mvJ*ipNWNy>h3EhiHrz13zzhE5Kw)}Ma3bh+Mg z=c@DDke9nOA22N#7;HT-U}1bfl!(OD%c7Y2>!pT~FwR(kfY4Kv8x`*O>oa=j9=_lt zhbyBilF|=6*{*ow>SgF?a(5i&n)eO>3J1KWme^Vx1*@uYXDOG;!tmv@j}r40M-DmM zThrWX9ewQ#eRWGcd=pHih)@-PF&7e;OyO;jGyvY@9-r#sJxTstl$v6Gsr$>Nx9tXo zN-{|*tfwzKCpUagg@-EBj?m=*IORF9&5?;BpIv}dy;U!?hVHqYtNpaGZ|TO2fWRZB zM@v)vJN%s?L1Q#gTVvX8y4hB`0qd#f6GQ@^_LDkK%Fah5^NaOeK3nNIhv#*a)-Lgy zLS&>0?t#+vXG}9VgJ>4x#;cz$el<9d$|m82sbEU@K7ju?!QkS*&S)gZTl^zFC#jms#CwB8=ud{qD+{w-*Zu`zDk?&SG#1O@WpZQh^*H#%7WIBT&5g zBS=X|)qpa`^up1JhcMcqV?Zv5{#qD1*7%QKg<#ZD zd1KeHoUdZC=SPxLOT??ns{{PE{1Q@g^E_-s%NHN(+6Xv&I(>8X?d({0zQRL9KjDv! z{BJ#9RoG^2uJn8InuWLg!Ft{OA2*}pX51xGQc|AGBnHY8@(I9w5$Z9&);Q8v1~oS)KWk?;Jo+){jopY==8(U|Gx2W@%(QYg@^gwjzZn<8XY1}!gW8k z`sdH*_Cw7WIRw&f_%IudAOs_4|HiLBViTA%beRsWKQtwSu}LQHYb`fo-)JjF>Y1)GIJz`h(Aa5tI0bGk^JBQRTnd>R-Q8ya&<0 zK|k?_!Ga;vuY+WwzwSx>s}lXoqW{Y`{&gK4&eGn3|4}7i82ShO9)ou7`s*;({a4%M z+51E*SIzy`?XQ0Jj-$b#i8ZdG}; zv<+6u*4iC0@}@PulxAM`u1?iHX z)uC%86xOQOSU{{Md>axRa&%!ZH>nN7W4NKYdfhc@;C0Ma78Cf4Pi8i>>LPS+peN{Q zNs_jpFWM0V^z}&Hkw*$Y#M7wBl<>sDZHTHfg|%ECxxPB1`dtZs`U9GsZbmsAx`?RY zOYzzxeVB5sBI@DC(gR#Tf|W|PF)5XnlFZv`_5?q9*?AkXET_lNfZ5VZ8HSR!-9H|o z8$lOvqCVP&WIY({?rYf`+J=aLQ}SIOx3V?2AqvnU%oMy3L%H3(egw9*9`tSlHb|ew zET$3wAsEACYv1a7*k*sAD?OS%u?>m1j_!T34S9$if{}9v2|x{OY7|hi*^UroL3x2-flFm=rsggZM6RwZf0Mq_hn&{?|ZmVVWyo?x(jQ9mEA3aDD+n zzXUxGPIO>4pPIM4-^0G1x7mj50B3L=&=>#E0`^CPh%|8evxFTv4_)=y{K63YO-{yi zy?==A_wgF!8Z*%N>WIy;r`wPZIe5lSa5|X?Gtn=_G0Oj`RNZaJ52@r}ej3bgy~KV$ zv;}sXGYGj2iOHJ3h50g1dx9w(?%v`A3ppl1Hux^{EwmFhV>t`9zFx3~VMr9y%rHH_ zk3{{q4t3L?{#o8X)W!(Y#*p`8=n0#!*{7KGyw&%Z&4KTPe`x#QPul*U6Vf(B8mltB z4JrIxNQ`)x1IS%CaG{;_^*@-!?_!$xk75EFB>b0B`dODjXR!1wgfH)UE$BhdED&@~ z+%`lO{opq{`c39&?`_C$3dj7U@81*&`&p6wU@yA|HV$kejpx{s zG3{BuVSvqNu&m{e`u@$n{|mGH@&~j00!qjjZ0>if#Qmc0KkD+|R_XPht@1~Ezf1hj zX89Ma;5Z0tia#9qcO!s({kMbtk8JY$A8hjQzd-VzHtEVZ^Ct_yef!CCeiC@;9|Z0L zdTv(dj~0IyIq?^Z{xdq=`rQx+e>4Pow06gB4rbEAP)_;aB zp#Kv*{Tt@~j86X%=3s-1Ke^rUzuoS?vD^KIbH8}qf55q4?BXY!!~DVqphZgB{tRv!v}1-;@In1gM3{9@j}^4gyX>u0ya{Tb)L=Kt++9^&*Na2IJWg-S=t&g0&{4-1N?)^ z{tXTwNc|qW$o#LyK!55b=IukTo#-3Cg($xu72bL)mf#GFoq(Wqj7hxWD98S~+nGf; zpX(zRMm}fXDpXz?mhTKdNUzeLmeIe^&1H7bOIu*If1!b5fJE?dYTtbOXj=Z^!$+z@ zV=q>`PcFW`srU*Hn2a)lMi~rF*p!U-_YH5_cL#-0(K2frx~%6m#9(O~f>GRt+>axC z86&LBLOgnG5#)qQI<0bxp2gtT0pl;fZ3y8JQ-PrirpahxZFyp275lG7&$1Q@C2d1E z#4z2pn2EQ)KjPT`-4Ad;#2RRf0-Be|%Q&ChF$;xAyySb4c*9Wv6$_iT`)e2Wz|iTc?)) z7XANa54b3)33PZ*#@RGeD@B9eb(2(2xqm3TsV0q4o%uApbYCVuFmqRLbO(Ze<*Z?? zZ}(;+IG_2K8UCLri*hGMK4BaT{Abpokrj6gn~1k7_U`o$b3YQBkde_=R(E(BdGuPx z%)NvpXGIe-@e_oYP2OHwy0p>g&E~jJQBz6vj2nD*!>gz$ z$2=f5HsRD6Q=*}R05})IC!$=YgUlJi{;_H*s^imV2XxGAq#Efd)9nM1Yv_N{uQavLJ11>H+OT};lvWp)(Rwf7I*PruBh$nsgI^Phi=j7+pQB1-`)`L72azB9BI<7^jj4AI_ zg*Nl2Lyda1V(xi*b+IVRbSUm0?cB@k*LkoJ!em;xR}LDHKXBXK6G9E5S$Hruo^oRg!}$GQ*7yr6jf@xbLiXhECw`tbtp&6qXXe$!FsUaE1m> zK6udwkt1r4r?%|dka=aBeyP3Mg@oa9y;|*$&MIG&yk6aeza#G1Bed#I=RZ%ap;+e! zQJSfNl<-XLCv@J)cDn7<(c=%e?q!dkl7!9g*Otb-P*$IMoU#>eEDJKd7T@GaO+uSvUj#+AAFhQ=SqKWs5hev$PVbJ02A zab#znHO7Mv69Nltu|4{AwM1{I8A`sn(TW%P(P+p8V7kSTgQE6katqzvB6|9)hn*_D zLgYr)_{*AC#Tu`z#dq&wpQJd#Y3NTV3!oJ&>@3~NK=XpN*{~MxFtiYb(9A`96G+$0 zdy<HiM;9jF`p0ZM<-+5El>qid?my>~2IvVaR8}B*K1$ zrNT)GUuq=KH;D*?@uJ|_ukJwaYfpp4Q9oB7BewrgYUaUm!g3fW(s|PIm7>EFdqkBvFJO!jR$c&}|5R9h~Y* zf{O&)6ic_9j5HMAP+Vb2ypKpiwMEtsFkPqy_fTi@-WoP~ds`4P_UL-99qO}l|Hgjl^kuDK1tGl9`8f9;YwLtloDNy+4tJVL3D zAvZT3Ax7yNzqI{Y4<&Cs8cEL0yJXO=QuyqoY)SRv%a^7rL`W(C1Eax^DWGp!J*=qC zpNyp*2PP;olS^rxm8~(p$ed3eJ*QfoGl=jTtDo99D|FI{doIT%fza95%}}l<6X|@R zqzgKl`doz`c4}#UbIpM~dCfB1)Sb@_4Kg1DXj3;D2^@0-9>#7!_t=M}>Ea%`-m{DD zHMi?zJnZcoJ;i;bcfEc2lC3xR5bk3EwTmo57i6a1`T&BaE}^E5{JG3I>RDaX<@!D~ zC(n|RPc3`z`%1MPyJl@|WbN$Yw7@FQw>&Z$z@ z3PMs3P`VeFUVPmYPAD{_<0D+ z5gM=~XPPH5&4@6@L12mUa>a}>UQ1rS=i}|3TUQ3 zrrlulE76cB{vUWiw-&xJHzau&n4LO$VzpQNyLIK&+tHs7t(vY52F!9iOn>Ivg^n3T zu>btR4X@X|1|AM3cE^s4(OpStT_>EQ?NtqS#_K%p0&DSnPI5Z81V-~iuqs!)d=9x`Gw0||nP8ad zHf=*_yTD}Si2X#Tz4o@)$fJReBT>_NJeJvsn zhMP&Ww9!j;6Q=G@R6O$BJ}hNl*vF}DnHvKN7b z#C#$66>!LWGFF>24IFNL=^pD8^Vk-oSKNm3D+y31c35sW$y@v8u?2L zVz*kkPmZIbvKW%4R9E%R@YK1|JO`*U_eGOu5QA5M3oQVdp$|4vPCvW#^z(;XNDME) z)v$?)UMhc-3a=QmxG{L|`2&I3NaBbX3j}>U@g}mv3A}$KAYxjrn3R5Ul6SF_a&o$| z8OMU?%9+nN(05zRLT8ZS7Wl~hwRw&GWLCm!*6a9oU8O^a9V)#T;P3=Bp)x}|@vs4p zTaQV+Mp2H1*6!o;?CsKTbg9+A90khY$S1FMgGN+pvls?z;pLi3)!NLi1@|G2p6>mo zM@+ruhADj>+kIG;R-L!NkgE^rwLi329+fUkYCo=ME3;~S===kgr|ksU7{u8>G?mF~8oG4? zQ=`=X5!SCjd!GJZn!hB5a&fw)0?fhB6E?+@-jHJ$hNIZcP46uxWi}Fl9{V3ZQe<9p zqB;UoMds4K3lifb`Ql%59ytH44*lG4GGb& z)bNDMf>V|dYx-pX4C+~{0obH@z%@_aX@&bMUgcl)_42v}`7N~U7|(9L7Ezro=s^0s z(LHd^Y=_NZ=nF?CcuYMvSu*T-Wpj|EU(dG%B(ow#6#wLEl+zeiId-WFiQ_{#Y(t*A zW`S!!CNQ826=&;f(bXDM*a(@T~ z{T_@sRp`q34k#EI+kEuA;h=Ww!L2lSU9#A$3F7k@cp8bg67ww4>U3F* z2<&SLxHbZu<7H^trhj<{Er%}-Om~Z88htS?D^WG@uyv5UAb>(s>QZ=ZVcU7ILu;*m z#WJ&@E-{&V&TmB2Yr&9+;l4J;56J386SpCJ-!MEA699CI`jAA!@FDq@Xa-4gG2*#|jJ%4=T1KT?s*`j;6fQVruOlHF>6=Lh) zQ|TuS$%K|}0dNnvNWZJnEb?sQuFO(>`-@MdlJ%FFSForXFm}upLUd~G(i@O>h3kiyyE%CvhBN@td(3g^?3}6%Uw@`Bj+^v<6D;ligwg{^!WKG5YFRU03qm{ijY1E>}L@X*zQ8N?=-~RJE zf8Y3%)czLF-`4a0n$PS|A6Z~n;My?jldx}BZGu2BA>RKnlb(i2WC8eTSm^k^-Xa6B zk!GHCeDaFRtDur8qji|9^gaj52hn*I{gV_o+nnz38a;JcC}7git-we*%LZoScJgh- zl}!MO3X8TB=1E3=&{krGM&F>G#j!SL(V!UtV_)RKv&R)nnDPh{I6@ih0~C8I2+|?P=obKAia$}=pE5el z7AZ>^?Knz*oC*)uW=VG`?~@LCFZ^l$5xrBKZC(!h60V+G1V(9B7{kzVg~ha2blwQ6 zDJ3@ytr0M4h~WwdZL^CnaLeF+9Z%Bq4$N!5b-!RG?uAPj$H5e|by_EwYD0m=5hp3W zjHnDOSQi5l^|V%23qk};QY5;*z)XS1UUWfFM`_@6tWle8ORk;7(*?dvRW@(Q)7nxo z4Y25X(f&Gk{zyx)tZ>Du?Bkl4ES+=mDLD@mRo=d0>xv!vA@X!^BbOU=B!>Fr16p{L z&JLtc!-p}=c+UbLL0>L^WY_^^T)R5xwm6$UV;%l>?;hpMof#%6;p|b0i_k5JUP5n@Raf_W`R`fAcA(uNQ1^ zm?q<2J?&3#Fn!hf`?jC4=&uT7&4w<7p{fB`3Y3IsoEQ)Cyu7nKXSQ+BzcQ8Q%<^@NM z19Rijl!=&fx9hJ^%ATKPJ{`?!6E@FrF+N7|^elXE|Mlob6h)-9c^jhDZ43hG0}Le< z4w#_ToEWD6##1Kn$cX|P2mQ=ehJh-h3tVh9V43sB3G3U?U;#G(u@(cd{@Zeu1NxrN z>R5Hs)m&tQUguxlM@22xo@D1>LFgBDGFIKw~ zFWSLv*Bw=Ee%3HMyZm{2=bka?vKL9pniVIdWpM#uzYKphJMa`B5jJ|?Z(+IRZ(;do zSQxYvh6Q<19Ye%Mi=^(#&q2W`{!Lw)CwlA5p6i4lXOI$ed&a720&j|I+@qCtpZ*S3 zrge{MQk%BGrJq3ZG>N$Qg`!D~rG&@iIp8De_XV8U9HQyACa)-)GQIJvE>^B~l6&yr zrAEq$Zt4nM7V-0h&J<)x-k(|W16wdiIRb>M1aWjLqQpB=3Ov}T77+;*)JNvij}2)R z9vn2c;Jn+z$)$BmPR!$2tY6~G_ZNh@s%UuP%6IYlJ>bcH?_u9k@09c*PO?SB1 zk7+9HJ+$Xb%a2JQ$Z3D{=f7&L|E;|otizbrf)Iqj5?2>6LxHyf%S&epSMDQL)jnZ{ z`Y>NP9CT{)fzS)}yd(?$q2v8B2vyI*l~z*O<)?>l6og!SJ&K)T)2DnwNhvV+{+X;& zWFA^jZ&l67d8jcJhHL4g%7|q)eDeuZAZn<_M&{U8}k;d?U=z;zlCI1d3*CfEPq*Wu;5Lz zgpqpURtUy}h5%!v-6&HM60?JDN`40${`|>(WI2TD-_X)pa#cYOu}|si8Dl|Yzh!iE znI+W;)rm;NkZlm73MBtf%ymyh6Izmz^Jc1$t(j_#HmrXbKt&@vcf4JZk=i+`9?a3e zdFZ|A)=?a3q}fvjG%ww0w$()$!p9nW;j4?r55Q2$p{m0%n6Crh&I|1C4!`Xkg(II+ z7jPfhg)Q(%&3WdYyGKQ}P|`mCpp)1EzC6_imW)G?p~8o48u*nWEGFSQEcW9oEADXE zg-2OR7os=pE#_3UhH{ADxSFq{oQd=#L?i-$RfEN{FYRHYn$ylL zD@BjE8B|n2dEAoR0>GLoPp0$i@eREB#;VOIU?+M~Dn@A2j?u(x&(>;p6YePCm84+cbcz0$&+nBeAti z0Q(;=Q6{&{TWv;iqR5*IO+EqeGyT`xRkU=f`|!?>JCDcZtx9W7KPGUjbg*^U}Hg$#Tk+@VYeRStXvrIN**8QeA%xdp7SqR4=d>Y{j0#L1NR0ovUmQ=ye1^7POIwao3 zc~DLU)+NUun9`q4%1YMkurb5^4rCYta2=KO!^HPMC%bywQjH;e-^HdvG zk~@uh7aMtesqF3y^Eak5hSr1HX>eY5f8C)C9jcDb**C4NT`eJpJg1M@rVmGQzRXNC zZGa55V4%10qa_p5@Te@{?lj`#XJVrgdfKp(qH?5TV5(x;NiBI!D{ z0vs}@x&vu61fV>L149}C4+LMG)wG4Rg`9es7^^1~o*?aRo3VUe^mMIFsOOhm#?tlU zCzJ4>$H>BT#)pQ7b1AR27u z-M?E0vwD_gxS+x4q!FwXb@Psaieo09PjF(KChntk`VGJ}>n7W&0-R*PL|f|ZGJnzR z9ISZhah~#on=CiY^>-ES``-61D%|Q46i)TrN`tv~e^jS_CP#!%fk$X|k7!bFQwDJX zHJ@{*?PmH zZlP(}#}${}bye8;a+=z+=M$&$dhHyDiNc1qGTuokCbz+3&tkAfTR6gG7@^ody1W1! z`xGnSn?3$%VWYS!51!{ZUlZ5h@WR4J##FndP3zQ&tq7^(GH(f!6WznOHUt;Obs`EX zR4?VG5un#PQHG5#=Z!1@u9Or`b(-gNm6t_ZnWXKUxgMtH9A|4ekQ{8V@jO})@)xfi zZ<;YJZDaoGMu&(B_r_mY*+(7gFC6k^y*#7t6bvJ-7hL#Dr(d6)xYcv~bFh98#v^co z`q4WSLoQ-S1*M>r!8lBvE}sjkJK80!n=k0T!xyM~<5+3Y(Q5o<3FRp$FA75`9HNUy z717lnwv5!$k5&S#_0loTpM9x<{bwp!U>X0x~QZkyaL4HC*ss!PH--$PAFexL=6J@q*Ty$P%kM-;$iLALn}X^MPduGlQ*%S;FO;HCK(0!T=BR;lk zr6+s3PLArOeA6pD_$+2a#L`h%!^C;bUuh?&2Dc<~dK(hY;Ob#WU>e^MO36NgU}--pa(M2TaNhH1h~j^7k#TX*RlN={pxA~`UnCX(ylx1cHm1j~VuoN_`Eu7$ z(%wL>7iM9O@Qo#t*RkmQ^uhkLsrC7}BMu`2RG_Zb#3f$gL10YPazc`kh{D5>8lk)K zn&JT+@1d0*`kha?iNbzsYq&R~m1YotKz+28x{esRYe;_okTelquLv#}FHr0E^$qsf zmEGSe8TB=;dR2#4*f%Lk?H*ofs^5<#Ems#I84|T0JXf@ULekpu^*?*B*Io5w@_w|&DSq9Q7UETgO?M9OYdzep;n zq^w0H#E?DASh8ddMcIZVAzSu!jBS!FDLZ3kL}Hk+4zu)pMxEz*UHAQ5_w)R7|MBbf z`VGEwe2>p@ypR3(ymU!6LCrB&ru__~JCED^n0zj|o;PMLx)*%|Hw^} zmSBKxJ;W=BJYXb^szDPZ&_dA7{3h|a-w=Jry5A7oC?8$)JE3puXp{K*Z^$z>9NoL| zv&IL(qaH_bgIh{n=g8wLVKqZ1a}EifaN2Ltd8S2Yh3RKu(M7gC_-=_V+Kl{)P(s$f z{S6`gK%^?~Xu1ZJ#081b@robTpkgZd_#G!@-~y*!nYuh!e={Pv^6|=yOM3(Ek;_I& zzF@INw>wcz12IuJyK<;3Khh&~fXT+#iSNB0)#Zx_=M$B%NSLYXA6P!KzkCwV-ZyP!7q+1dH@ z14n;DDBST2a=#(}sQ-p2!}cMU0|S3a*Ai9Q>)|j>+C;r)_S-s4oBQIZ$_m(TY`%Mg zi<_nZ_Aj$BqV%{P;`TB{9>T~mROMEZ_AN)8OKsya&q~8GbDdx$n^RP=1kq=!hEk70 zQIQ>~CGKI}?i&*kb8}IU%JXI`N>zVo=w(NSaTlNXr$BIN_8S77*?hoSD z+#TQ>|AiN0u2w7aVDgRiMlKs{=5MfP@-RQ>4ayOWrLJ7atu%(EcXQt^8<+L9pjSY)bk}M!TkbVs${Jf{PFFSx4i2gVW>Tu+`x-4! z@3z{6lB0|ALHXGl?jIe!y}@RY$8Xu6+S<|QzGA2Gta&Wum;ZWB04;tI93q#G#uD`l zSI2LNIC5$dKD@D>M#T`IP%076w~mW$xb3?YUWf!v&CP0;_586VSjt|4!E5Y4W)k1$ zp`}Z7eyJ%Wo!{p&MFxd|18<^52u>JLocW$av-=G(rCryT-Y+)Mcl7d`+j=wOi?bTS z8<3SBKEPIq(HZsjlVOQO_6>JW&DPAu_v};3)MJJis7L_FGKN$#o15gxAX`sAU+fFV zXw62wqwwb6%`;hRLjM$mQf&hZgoA6H()VdGdo zwOZL!0(Y0NaJ=qU{}5|7o_|c^U)mTQS%5v@8$%IiNhF#L)oG;##TDRAHedH6e-G=< zJla6b$SQtK;1jUMJ-GdLMdb8- ztmwIt_ay=5HDkEK!79*Y`%#ookmTxZx~Ykjdcz+n*b{w-Tw{IQtzv0So!-PeHpl} zB9=0INMU#VqueTI8$0@65hki>vutRk7c7JYvgs0c#O?Htt;|&+lsjXb1$DFH0Ge17 z@#&eXU}Lc`m@6)pn?(Te4*}Z>N`!CKAeMk`)9bGGxt*-ipxMvTe**2ip@RW3-m$cV zs^9clXPJt{IK9oyttTvSeeWNeMn(I(3TH%xHu4%H?q4FEjem$$m zUoX#A2_co-wC$_c^3RR`7YHD;py%c`#``sQ*rJilN>1Y-+%EtpbZc|;zrM>5yuuX( z3)Z$BP3SomvToallGmO$n2X0r&uTM@*>Z^#x4yFN$|0Z@bY2Yq_f zue+60>vQ6pmQc%BXa?&YBkC0XVlxhZ#y`YzKQ^7`K5YYxB>pu%{InWM4N}Mq0K`YD zdk-`yHM4wwdC+vfLo-e<0;V}XM$YN3JBIW*NXi0Ss9)bUK1DLvzjhbAloBoGH>5D$ zb(@Zo!Jy;)X8)v!hyq#=@Gg*A)%Smc{zd4;Euk8j0&GqpZou%(Dn=4|IaOy%5J1S- zp%d8HR_ay>vLi@uA9)Fb61D`6Q&-(a+io2Nf*@H2yRcO!jX0tekYnsmDYpFVva=Vb z+`EiHDtnW%((mwF!1kf1MnSH;kWdm|*(cx(%C$^fF*WHb%Iq81xS%v-M?2rWtoE_9 zOxaAxqg+gW&&ePNp=t8Ak}Avxh(EBA5!FP)*Y3fuh`_F}(5e$@S2E0wm!tES<Pq#v(|OJ;5xy)kz(ynvt!+&f)dT|I7CIkJZzF<8+GSnib>S zqs`+u`5P;GKR1YKY}w~;s#-a)yb){Fm3kV4&N#VU=hn1G4;ug{b~Dcu}cz7>|Jec71`)GM@l!#%FPl%cDF zoi(6kptg?~Bp0_ux6p`Xi?(<`VLsz%;(NdeInydz$9Rt$t! z=>TwWVcWV{3p~8phuA*4HO(`tv03hs`=sJ(Pb*3VNk@kRqWo@ zU`m+Uyzd9;-Eh~O9yxAdk*OP6Z!9ye5W5r4!!@fRuSazo=Z#y9T#w%ylaAPk(1dsk zuzj^F{PiTGDgMEb(6!?yve`1~c+&a4eUF;e1Ge^4tQV7RyQT7wU8-GAcEAfJNcH|D z+M}2~uqfjzMeS*-)FhDMd35JR-SxdnhJP(aQlyVb}sY z9?kePRJA`rUqYK~x!(H)p}`!m71TR8#}udZrhK4F`|tc#sd(M+^yroR^_tWhGyz(C zTE)@5wb$P(G(I*gvuhGz0De0yJwu5gr{1Bf)murHZM#4C`r~zn!U$xWG!JK<6ONbt z@+OT{UmuCRpI~!~DE+Bd-!?^THqAr?iMh6C?<5~1%Eul>eMJog`JODkGPDzNG_TpV z%%^z*PEc=)-#1EiXtCI#U~T=mNJ?8}PlDm09m^LM^lw}>(i@SQMn|B?Znzd*BtiM9 zCrmUzm%2%|y+{rA5=Vsxm{9mICOHqazJ1)Oa@^d;K1fV;-@=Zace+1oN@SEE+AOei z0si&7ROh$M@1wTi*E?+XQtsKDs2kAX^M|ePZU6qZdiTTF^_Pw^Pcg?{OSy6<^+HNg zkyCj1ehb9t61ctNC|PI!JW5bc&UsL4Jy+F0I=;D1=54r9rEx^x;_D#!=ieXTzCzfN*C z6lu{4Exotzf+W=2@UxjU(q@2uG<)(_YAy*}S2tI+Y;8R;aj6vJyyvJxqM@Cj>5T)o zo~&U99E&v zzolL#!`FitB}fO`C=@T!IYSw56P-i-jPZ=-C%2lSZ@;T}En`{vdU4~?Bfm2jLv}f` ziOaKhdYMo)&8LbQV>dvaBm!1p5~;`USRL!&MS)$SB6TMDA|AbwdodwozWhCI_wt4V zS|8r0t&flHNOgbXTisGu8P|wMAGqEA-mxw=XDNJnw}7e^%FU4Lxvz$lASIqI z&_zJCBB`=qZG8k&@L+UqXOXRMPRlIbwiU(Meqho`?`UI91&u>xQ;PFGr%Q z^M$KFZ^v^%Su||h+piqzP!>h70$}7lWKffACDonKC;HG_LXF}Or=<3(Qd37ayIs08 zt19GC$BOas10BXZ`6_pc3G=W83f^{*Ng#mGf)(Ek~5?QW8O1C|A1AFOPvjJ zpeaY?QthW^hdwl@!?d$&(=S9yU;ZGhH1#1a=3GtzgPq3597pa&PGzInjyFjM9H;D< zpA@glSjgk!Kj-ysqC=q5*@Hiz|5A2;Rpy>Ltz^TSdS2vKJQt|KQ4bF-I1pp+dR;zu zhRmCW^dpdvHwKmUMgsl)+)PdS!W?rGlI3&sxlan1COUVZrzTKAAjm>4tWeGomZCh5 z>WC|o4pZ1osS$6fjvw>Re_gzAI(qvHL%ozPDmq^F<#5rT6%c z>bv|K3ij6Ki1nX`2?!OHQZf>yvrT5{n^A zB!<&>@XIb>&MHa;+(T&>WBTtuZU-M${V)Ij=a*7j_qbolT9#+W3axj4v0a~p2jR$Z z)Stcy+u3;dI&NJPIA#H3n*=^7l4beqqGm_WDfoUnsH3mFQ$~8dXHz?=VFVoY=nXyCP*TezKO_DD zxy4DHJEt?>cE0e*`q`VyJa|!uRQq8|xM+C{Fu*2+_%`4d1qf2TihZlwQ`_T$@#wuH z#_ydhV#m`Cmxr7>zKH$8_T^qu5S#QKs;V+o(-P=pW*R}!65mG>!sDK9HI7=0fP4KA z&_2GWu0EekWh^sh&WQ?YwE0t|9!d@s-e!Kr381I4(51LIJwfJhDl%B@S%6u=*-Y~m zhQYGN{eh{(!C#8Y6P#Wz#?RtIV&9#}2{9^B2L8Yj-HwcFfemv)M+z}aXha+O07C0l z`xF%7tJN$0;1<|oC~93dy~~AUf3@Y@a^Z(S0qrcVpS%&px2UM|zYI;HXu3nTdQWCDPd0d-jX7Fc7j}1?<&K_1Q%J z$ka@X$F_+4F+MDt(D6_T{G3yB`{!;?ntMyUenYI&HV0F}d5_=w4JnS;+|x4%n^yk! z$4KI5ldYe~=UKc3wb0mVpPMM&l2q*F#z7@B{Fw8@>~~43;DVRiZ-9OHS+!yD=&HfcTt&S?qCRG$ zS-CNpjNfHO2OEovNR;I{L_Rb_N1H@mL$x z`ZefyXoBs2Di`xQiU_CiC;f(;zhyq^;_g1Vx3FGhg^L@&(jdcm8aZmb&QEJXN$x^d$>KJZ zY{YxVi3`M%Jo=L_;4n!~)sgKh zB-JB8ka92$Kr4u%L&BVFB*{aO6=)tRVFg2R)QX*mS+A<=cAu;6?{#@_pIfN~f2-rl z*H#T_GfxnmS)%XV&_@Gc*a(i_6kmfewQaL^_=gBFpj0DRqnJc%-uy*Zr4#OOx@7z$ zuZjCWbrB@MjCRYp9K@RY(NigupQv(dOP^@K#qXBa!PCEY#uh0VqYlny1h*QotrG5BG_DwRb`Yu)aowPSI+pfIrW2Ea{SG(8jF1~%oFcD6Z z1^K#Ik!p5Lxs4#=K=l*7evfjdZU^Z#HdSvU?@Hz>D_<}q1QD;=>`-~lrPo-0?e!u% zuv+M@8ossAMR2Zb??Kw$%EayB431q|?1F}P{FT)Z!W3{#44DTmtZ;Fa&TX+mzp|Pd z4C}Lf`YT*=HFH~EUoUbltp+Tg2*7+=8molddQU|MtrnzE?w(yN2nXw>rDU>xmn2O;CQr!WK9&T1z}*?IGmRy*9eM1#1x zp+2>&tc6^Sj0Ze8kyl!b7YlOH0%mvJ-OhqJbdbH2_6rRi_GCO%7ZQen@v4?x5_hII z#9!K3YQex6<73^bH5?)iQXq? z`0BT{+3^5jiZlU_nT0iQNo3SBUw{fp;q3UrZ%8~c&DDK|uW@c*jm14Tb(iWsc4&iG zCZqo9&ZuMcm)*GSc-0|%ue5x?S}TqXj+n72S4k$>O&j{>t+}H^t4}kYN%gRleL!9i6@D9{Xd*6lxbKzTQpwO5cqIWd&&>Z$9Zqi+ zPWPve8DU=mxic9IQZzLiB}{R)*ZfqWVLE|)>}9b|RUHEJq!>_k zZ$1FNEb+fkEhP2;_g)$h>(86 z)npQV=>Fik#ckfLt!F#bX!}?alTeeqy4pUhud%JLdb!OvM~xM($ptM$MF}{ODqN|g zUue>}CrSU{!-5(A;B*$`BFF%8nUw%R47c<+7od~8TqUeD%yCn*L;~?gPtCL#i#qS6 zE&u-Y=vXvm31DV7)PEpvUZ20)o!_&A*W+u>0Fu}u=F-u>fmp(u_UJYnwAW1St$pq> zpQ(+g=(_DHRT&%b@{#OgX~@CVE&ne&N9n&9#d-qNLTi9%v9NpSgTqwYHlIoUFAbsu zV;2+4>H)cw%LBQIy=(SHi-MO-PbOxcE0z8j+$qA~@mu61Rc%h)@e8`QK}Xv<@suaC zltF0uzNtC8oL#d1R_XIG{6Q4=g|d%B}7r`^oD2SO_0aoVy@fbBEg!UzOCB12lDMULP8PD}$5L{0k9- zPliY*X~xVxWF?nXX*RRUP0(EoP$Ufs*vF-b2tBJQX(Vi-P* z1ejAAbc_psl3H#;hPT1l&!#NT&0eNdM@)ZNJJSDD)|BIE5_ zXPHjoK&(EVz?uxLX8%AbMhB#CBQVW7i?0_-Jz5gd;7fG@x?Nq@7U%5lN=LvL36C(#Hz_iA#;x{XdYf=l+ZQv z=<-w(0v|84ukKWA4>pGGKw)pKwzxc*>-qUSXanNElopxbaXeluN+2QflZiU1M2m=I ziLb=JRsZ3Nt8lRk!-Iyw=FNg^3IR&mO|$%ksscF|fs2@T?mb6{O}eMP#&+P2+%0&j)J z0>^c%^$SM3i-_a8oYfvUQ~uu4J0bp6SNUs<3s%pDILCI;;t7(d698|pz;)?2116ty zKCt0{{_|~XY_uMo1tX3-Je1nVS@IFr@(0)kjMTvR-7@&N{YEItX5#(IqB;^_HRTUh zSAz=0!-6hdj6zy~7jV?J@i2ri`w*BTk+DRb{y(Nf9@GYI&(^S2jm-w>uRuB%wY(XQ zmo`M>w_u_{05IbJqCT($%8RhbP#UIr0Z@E=gJbU?bt>r@8)iZ4Dll{~q#g@({@S`N8lvL(5SQy6teg)Z4}}8Ra`}QcgrDzw zYPei4tQhXy=HR(LkMJ>gIz(TU?GNm{2e1>1Wk7$hEXp(suFvRp7%pmzpV7O6_lK5L zvd~zu9mDR`q{{0qsi6xNJJHU6v88T^jHLVJ{Iyb+G02BwAc5Q~S~5xc`r*5Xbd59h zH{@})fI7WG#6I|1;G0<}Wr+@=rCVBCz*@5SRIJ1X`?)y<_??8Sh7Z2zb5Ekh{o87= z%&=v2OfhiCB0~ZIpPu-vzU3d^hyF>`Hj?VzK1bG>yd%tl%n3Mz1OW1@b6W$cz`t>6 z@`F4$^Dm!Zb7SX!tOr2S1XrcqR%1j>aE@Jbn@r%L0K>K(9RtprJS%Z$9+gcTY$|vc$}D0SUbb=)L*h$wOM4bN8rbxk9zj z2Jt|E`79w@8Q(kRvJ#^58Uo0xo+la4j)MYkJVM=G?+&dA&Di!oZi7C6>iKjg*?pTn zT!j^2Lp%}>e3qesyzN@r&HqjzkPkLkO<(uFP7y+dwj#L$O!??ycmm%cSU6ojlQ(7E z&syfx;J~{>_8@cNI@Y;<*S-4lNxwVQ$)et0uADfAZ8M>sE?GCH=25t9Cz(F2bj1YYlHAjmWf5M-aV zEWRYQl3;tUmA~(wHr;l(@ORyltk&l=>AlGnw9VTdLlLQ9d}n3-&6CR9O}u-JOM>= z7jFxzo-M5QN4@?uT{gMQ9P!(LfCOf}D{?T-1o#5!1OMXswm;GIjjf&8jf1)%9hX8Z zpmE0o)QPZNqw|@F9=Y}>=jOE9^OD@9x%#ReTj+KinNM1g%JFnsn8L2V#BMb`%Ru|1 zEo`-rCz+tM5&bVu^Tz&8PbFD;T_4LXdL58J!k{qbzkyot)v#L^I%n&rRGD zfMfO#%cR>6pmSO7XmoTUa7Ry801O!_ox=@=>VD!nxVd?Th=1(fb<1t|0?0;#59`bt>-q{FGp&9CHK+&j6k@|w=8I4 z7Q*%2mD@_d{v_v)BVz_n)@J7{Y(&Ea%L2<68Th`%criXC@UVFkvm3wN9guV^mW|tW zBc{IUyU3KsT7F?V6*v<|6mc{#`}wmyi>E}`Y0EXA2<4tM)QfPJ$nZF6q?0(~eD%x6 zP!TbnOx{IooO8CV#KW&n$yEx4jzxX}-N|3L!&I-B8JC)-m+kq06%W=eoZ^c`kqox1sjcMmtd!0 zL%kH{aeGIcEMD-Nc)hc_{i#GEL(}cZ%Yz0}F?X*#;rYTf`g;83W+1SBSAZTQ(k-Y8 zG;=4L-DFr~4!J2IYt-_jnuS-4kx(^OdK(9MGTWIUPEEBEg^Rud`pfnwBrB`8Fy4FLvICsNK?(A1L*z(OLuN48=h1iUv7L^4NHG~ocQeI zv0er7YXVaxnzdcY`xnxT+Ht7-oC73$QZ8ZX zR)Hk`hC^K5x1=Q7ocs;vA0G1ZghNqPxCF*^e6dooT*UjEMW)~2X_GG(za|;g&zDU@ zccNWQ*yw?bcL;?588WG(NI9ChSNADG+BjD0f=iBinOf=QwS~Q;NyMchW_o5mp2YdLSHaAQz&)#DCvMk59oi6GgrShQWP+hdWiUg=$5Oz%W`S zk#s2njz8es$JY&}#6m&xWJZo+dWmS~gAJt;56>U;8sak_qZvV~@|}{<%AaHT-^J@T z-NVNFD%g^L1@;*IkK20w&r7WSzm{D6_n+@ge;_;eWo^#XF^hYbH;KE#9zH=oc02Bf z>$t>)In%kGrVd#i(PO;&&1!6?d~t2av65yOH|&vZ1bWAs<60PHqm86RyU~9n;!?8Z z>F|D$A1iX~PAa#iCB+zhuZpK97Fd@6lN7+!vj0$li0;HP(h$4n4z*XJTftsS!J$fB zpDWJ0?jdlqWCDm@6FoSZmx`~J%i z=?gi>yRktKjzr%bO~#%;UE#CF8)@+RL3Yr72s&uQ~Rv85d& zHU~vw<2A1jtQDiD9-t_N>o_VO_Nz)1Z&aW$|H0 zJ4^(3nW5%gsV9%wX0)p5VkNZWjtI$ykrLmrt7JsR``?iJHok2Ld^KY%IXq9S>l86 zfnAbObbvJ>*+7f`(c2CFJq@!1x9N6Dh)|Kld?m#IAz)HDpUpZ#?~}it&dH0!r_P#X z5QE;+E+jgt-|L)lm0Y|}vt;g;qQPvLT~P96lTZov?>cAlsPAZJ$vx<_{J9NdpZo5! zuIb!;mb9bHKA%Yma$g%NGWC34 zRKpqKUif9L7zw^F*^c`i!g1QNHL15`V$c0Jv*)eyE19Ugg*hVM=*qeQqh1F}t|lI= zL06c!lsvO=Ss1k4uZH4`JxIiCg%$W^8svx<|2(k!%#GObMIX0wY@$UFFLXr-T_|N8 z$#~5?M(*Pe1>+(}5CpJPSBNO3BBqt!K&TFM zQ4ccG3amMEFo}j8JO$+&rz*7mhJY68Koe}H0J*zBirL-2cskmV$3AlODlcRTD|USM zO<@QFlxzO~4^UJ#Lq|{lhWy&NTL#)f^493bdT!PPfFe$_;lH{ z@tzN`%tj0`VU2)AjCt4&nZd*G@S8}ElnztJkk8N)P7dZFL%l2On{WNDbd`Jedc;f( z!6;no?-*z`WaJ@INd#D-5Uz!dAbE*Kde(0;r7&>CwKtzzL^4%XV<=&EdC#xNvy=Kn zsW>C53x2O*NRYVnJ-ztL~&{b%KaW$~~ z4LL?s0GzzCUPiUgqie>u)x~%}c9amN+-*>=+E-cG{W$Hto4ulzma5M`82mf|jJbij ze;(chG%wtV>wCWmxpFcoxS3<tFh8f&CLi5sgLhU|1cm32z2esN{X4{8AP@EH=b*=l?dRIM(n3NNOH&r&R_b!oF{cma(^94dFClv@9%$|Gea%$iu5y!Ylmb_f1t_x z+U{+L-6W1*FoHVRuRwV5pB6!@K^ZC;EdffoIEhLy+{E1Ty~MY#wa{KE?=2=TL2!D< zLx)nhl9N{YMHNJE3QQ3U(DoC@0 z?4>{MT_W*?Z<;26;kxJ#3>fii3R6s*@(I~}4v%K?Ds6(RelBjjA8Z*&fmNWLSFPhQ zE8VE*lY6-L^3;Bf4j8x^+xYf3B-Mh^`7mSDA`_HfIDw7E4z>4fc%m2$B?Hnh#Q=~^ z;CRajZSbP)tB$kn;HP?%8ZHegIMrRAF5h(KLN%s$3i$S=X0c^PMi<= zYlc-CD9Pw9FnD+5T4){YjgDGZ*)0k2R=oRjw{*Ya%wNm!WtbN5lTvNC8$neeq#cPd zytzJfy{v2q9v~#x_{A`y*LI<6)jRy`iHk|!Jwl_w5T^T((`$Kq^;EAR` zK%dbYQrW{=2j^L(9>)jVj&`#n|!VvvHG;{Y7UIXb+ zB-Dlzvus94hZEbp_2g?&HWa18tUjIP$-v|bpLJ3$EVoH*-jcqElX_GF!px};IIzzl z0!_9+j~HL3veR^Z4Y9WS^b~zd+76kusZRJ_p%yllHZAmXdi9& z_*WkDo2Kiv>cj=oMo=$)V2D+~0>3clryvMI*t>~mfclov9d}L-Lw}Msj5=8AdkB_DgihUOU1BWbKYjUhs8Cz^t-B5-TU;4RY^p^K+~-aPBl%TJ`=*6{`+XTb}|Fbk&pWORVtUNvi(k zXYidLr=KJ4HgA_O?)shP+R}dfHlfDNpRXg-?*x>xi1Xa1&TEqQ8)CysT#hc@u{^lo z2MK6RUxS71SUijTrasx>v;90)#>ukt%J|sFS%6X!s0`?%ZB~(LJAf2yv+Cg=R(Wgd zW4kri=>O(27Ej75a{wQ#~jd^gvmxOVD+#hVJuxYpy_1hJ|fVbjA_ zW7U#C9{BE3zrba=L8_Xxapr$}OPwISyS-1CH@Ito8yW9S8~!g6(dDP2kmhYQ3p+s+ zhiU1JoCcZYMZG;n z4?9@@@cl@@nI~VlJ4?|&NuQ+Yt)asR*5pvpdS?|tl6nW%zkK>Kl%xb+()HC}KBXQ* zkLLEVq~Y)B9bC4rKD}@T zp=;q9)%GiY$+E1y6~F2&V#n9L4d{R5;R1l8=>v$nEJ6R*Yfi+rmTXIu9ExG=`SZ!@ z`_=yFU5KBX2B%l)$25!IsWgpwyK>@Q1&qvZA}Ypi&x8z~I!&s*F2}(JhHGkVQ-4FM zlq0-Eaa2v`b=bG;fu(l?AL#oD_iE~meI80aC~t&l2Umi@&qUP=Yl2&PLy18^nSxHJ z^Lh*|zg?LgH%z3Cb4`N$cT14oG3p9{Sb4HCX*bwukg5Jn?<8X2koZ!RawgLSc8(e* zlbrUjC+6+G$oLdtEO%0Tt|yWkIfWVpGa-5FPSgspZ&&9oaVZic6iLdYRKe=Dr30PC zw;4^NM=$M@+d>_^@3^OIT-EzPvtr)y1s1Gn6?51sQ+2(FvJel`+~;2NN0 z@qLDgA~A>nc8dQx_fV54{R-8AB4Imf+-4(KOP(wuzYgHa->hpYQLL@L7ok$8_@P|o z{)E)UGF06n1P;QfNZWEBkTPxRu6b(DRw(H};8MBXR8aiu$0i#d%=6l$YX*4-7rcqk6SG6hS$sV(>d{&N zWp|-eg&_=x%9dAJ^`t50Eimet;wBO5s5QHBl4(6T{lN@j5qC9Fez}7)*~{S0i8r!h z4GB_P$b|{u{dsNPm^*Lb(PvGp=hWhc9JdC5x{GJ(|PZbC*2C+#>=m z512zrC^Dsd{lVnBLg8Y+ju2PqDeW2R%fhpZ;WX3byZ0>RM@&*&+sX@n1Wo>gnIY}K zw0k_bik^6#!kI>%pqtP5Ug7qG3z?I97ULolQ*P1A-4Aj7hTLrB{$kh2P@35V>&Gq5 zieg!MdcfKktavl@2->w7p|b+eC;Mwu34nj(dw2sxJ3?wO*hlFH)ZuQjWJYT+NS(?T zbom`+KfR#AQq(!>*T5=(W#xer&8}i7mfBme)ILjnOIyr-oAo)QKln(adDM8a+6VsP z8>y$B=PztB3~FE8DUlyjSU@@c8$G5P|NY8k1{Fb(aK8qx#K;XyA&4C#J@wEZs{{h&yJY%I(0J5JTJW(!b zEHmT-^ZkQDJ9@d+U!r%X!vM{}ptf^V=Jiqzyqvjs>QR-!WBq19`Gyo=p_{xH{|(6U z1wDSMz|t5#XcpeaziVl=K&m82vCR(uVG1aS8~!<}VWwKhvYik^JouQ==C)?CS{7L5 zaA9PWS3Rx?#du;~_uANQB5oJ^jM(fS&Var0FHiu*;bVVIPq3eI7c*}B?@6)XQ0R}1 zrq!4Iv0i^sS%Zc0ndp}++)t|oRVY9hd(C6rheD5&0et?5?8Sq++;&aJTqyB5z z7#!Yo$Gy`a#RrW3mw#b2DAv_mUs7jL2FzKX?dSN)E*4R)|00UT-@)bU)xgABZDal1 z&gpg}aiYB1Tb-BnVvuqJr*fN1+35a}QZ^P{IpkdR$DpY!r%IjW?Sm>xpDoW%As}sB zCce=(POFDrhL2!ek{4QV4ys^l`&d;Eb*x^DsM+pH2TduVhyXUQ#f!I*pb#Gitvnxw zjXWh9d(qO8FLK#()Kcwh#XAlAeHjV)kB&{_^+j}@7t7pb^=aA+f*yH_H-fU7r#N13 z4#?#|y>c@=14j6;dWRV=5r>f&RoGMpioXc?VB&f^?jS+V$Ot zlA`^wy9k%;7wv~iySp{D%WUNkp!`6#_zek%R{MZ?mJS@J8Y&#d-*B0xAMg)(A(cHq z1%){j)I?q{IrfP5&qt$OPZi%zT`3l>vOjCaOF|XDTeiz%h?iH0!NmhXP;`xFDtUaqULE~xYY9rL_<%5+M;}~bL$B@mSh{)*IdqO5cKsVE zC-53R6)&ZD@}3|}zHd`77hfY~Da6=9O^VU;;&wtjUw~HH#}c{&_&RFnROj2uftlpV z#i@3+m4(dlSHk=Uzz~U4_^Q~DtyO&7Oqiae?x`joy^;Qw> z{`3B#pbM+AZS;}$TFuM7-}XwC`&~=_r!^7>p<`pSv6MaK4wR&p4V=SrWuZFFH2wV0 z>qrvKJKU<)WIh6n6YuLs0)Vgw*GR5a~$Nf$AlHm7vb&bNJg(ao| zlCBrM9wNmwZ~FPx6BOur4F${{d-jR_vT)6H&Y2q=@{Wby zNnVIs)~dQlHW2WF#sBHhhuTC00 z)rW|Gyuvwid|0F%@hagJwIroGTX@Ln*qGxoEMMm&*1UaMVBYRn-N%{KS)Yc)B%}Fa zFxN{qB%#Szf;!2bXcD}o{tPifIftJ?xfINAsShjJ)AlyDxpneyl7z!A<+gD|PDHNg zYa9+*i=sxX-)DRbu%<{cxdXulZ=r9BIwzq|nc`IE){QOeo~l<;-)8*Nj2*3AmDKr< zDfB6Qm)yz0HlBF{q@In?t}^yuUTv}N(E*?Y+|`D&IHs<15RJIF6p7ql0ezau^}XRT zA=cIeBn~1xMa>((c`0lTP7Z$N5KT1_kKB{R`>x5DdJ16mF2pC8MANZ32_EuNhv?}+ z`Z>?z6*=#JKFNITkbmV$znHoD>Hd~mWqYz}#@lv|UnpdrW@MZyp&mC}5LXWYJAIZS z5XY#zqgB;{9Xa?|p^k&8Z#Pa@T>6NanZU9=%YOOYs)OH6C3}3AFx8UD{gUPru$xh- zw+l?X^9Mkyzpg1qryx`-$jPxT{_j9zA}q&OY5q#%{)?0eYiU!rGUG?l53SQLnzFm@ znSxf}Ym5B}tgZTdbWZAZf~_dE{OTc-F#6$lR`XhobKyo!osMvRW3@D?n+fZ0%0{EQ z-Gg>Z-b@Lr=!)fUeG>Tc$8_q;9~mFq`h4fgil=Yv`MN(Tq>Vo&{XxUnI+dEAAFziJ z)}%(o8Ai1P+G3hGhE8<}mt?Jw?q!adWcm)?T2}A44Y~j6)2AhUal-`$Wu*mK3B@3J z1J069=QAqt(1W*&m??qlelE;@?gMNpp9_zqhn)DltKIt)xvv>ImPGW4L{25(*qI8x zd{dbzlr${!#K1z@b+9U>#DaS9YsUy7y|UXx)mZqShxnMY5Ln|U4J)w{kTJv#z{JGj)?)+0J#aZTKe3_8C% z!9;>u-U@CCV3ZvAr8Sr%82d4^tH}UTwvdzP3mNnQN%zaXqU#vysa*OQD!k+zA)a&o z+IXvdemh)k|9E9%Th)NeZBwXI4^Nb+tFY1!nG15ANarPR$x}0Kw4Cr3Ca5Rt%V$Cv ziqcWQkEj*N>N?$4s;JjUc!%;CzTMO(9kZNXkx+JcpL>NlFoKvO+vN~k2y$s2w}trj zkbU*Q|AiG{oV_QxeTdmhrjCUlTLkwM2B-%fA zNUdX%%oYeXkr+6B_0 zx2Y$Y`}bLAYOZ!w1cKk?NTjk8Y)9bC z-9==FWK$uJy;3f=_Kp~1_iHe~d=)*6C(>;hwTy*`xRTsXNQGw@FS8+#4=Lfq6I%f=$ zR8q|yZw0jRtbh_j0j>FpkUGn#t$`Yqk*Jn9%l-I>eYus-ut18cY&on%2W|%K& zj@b*sUwK9i0MXCduJPhc>JM@BXj}aNU&d1=tH;uaDH3q9fyy8+k%XEgqIBKqM^9HD zAGEN^(XHEk_w|%Y(QsI`q}^$CIag5uwh=@Zs#>`PIcDXX%M_rF8B=;nLQn1dy5`)d zBIB=7d`Ly|)~x)I^hbAm&i3YHYZ4mm(8|cEao8S51UnT?^LqG1;&tB7I@xH-ie>4* zDvkSIRb^>)l%su=@EiRD8vTN1X8L=;J#7kWyH@mf+R+WDv03!PWZ5D@ynyo|p9s2k z)@b8mPQGn#spW0`P(`WweS-RHB|Wwws467M3%sn$ce)=DHG*wJ?a>pU3z9P%J@8B1 zlhl;+sGDd?ch&HUQbsWM&cbBtcc+wU?{9wQw~h#>?<63p%7%3QzUx#tW#t^j76TLX zRmUpi`i@=xddK&JjxpF)acS&Sv)%)gPE6d}lP~?Isdxi5#7jtUdU|@|V`Z{M->Ie*TIh)>dPNoW^$zW<_5IStTlvWL&;)f*c8#!U$Ep z9a;(tLq7l`7Pf|i;M$~{L#vIV_>%BPif@e6lB;WCy8I8x?-(5w^-4ULaJJy>w3zHN z%m^XzQ$16VED;ULB`-$XnQ3=-=JwD>R+Mw&PMN>{Xw+4D{IQ8#5#$kYBmYm^*4S?T zVEa~-=5&t>1dCIi(Ai3hf*}s1qa~voPf1wu6hGDj5dd!O|MZ_<9?6AfOV?(EF?Tyb z_ctB&4Q1{}aXETmTs#oRU6n6AzI+5Lyj(;~H0U}Zb`*O(*d{s;*IF=q#tVL=3+{2K zi@(J1rU*yinG&G9Q)pP_P!#NLA5~U4hIxdl*VkGXUYm=XOQxJDc5J=+(JOUbI4$6~ zz8(8L{x3n!O^iCUBM3un%O~scW5`fsxfM?0!`cP8r0caN;v>Frn#4c%_IKPQ$f<4y zzxv@O)P?ya&pyX)tBe3yCGzc(k?QpW{||TH9Z&W5$A6_rRwdbPMX4mIY`I!S5)G8m zEy~QwUiXIVaYHELRuUyH+4GWdm07Z`c`qXKUgNsl(eGS+=J)&kJ%0cH{!z(&JMVMO z>-l``7d4$fxb|ScrLu3;mIo_`f#SAdOeyrX<#yUXrLS^->Es7tF0Y~^JTK!MlNl*k zXMR9OQ@B9R2J9}R)jCsOx;;=jDmRZ!!PbuFtxcqHv%tWqldzE@b@P3$)h+fK?VWVW>J^g!tM-)9mS|$^7%)xpdAV^1d|U+YrJk*?%p%fJg*t=#iB4VSN0Y{d7T86M6XU3n61i z?7W>^qm%oKXIs8Z=)`cSZY+=PWL067dWQuB=G#|7=eXU8X9TW%cb4;D+zhz)%}M*6 zbHc}q5BED-eU02HJ7;xip?<=Mb9jzsxU88(tVGiHxQuy~(F}j0x2<3!Geml8WoBAE zzS^nXn9nib9LTh{5#rxb?bVj^!K-b$JqBVZ_=PS~Nd~kbOEDyOh9T`-f|UUT>qJV9 zH!M>T{Gw;`4B!3ycvf;Yw5nK_o<1*K=mb5n^trQ5f%E}di2gL%@6F`XVkB2fkkEA- zLcyo`sV06a-RJLeEo1Hv1k^e;E|}e#z(Yo5iy)8=$R0KtgwLUPhtRchr^4X+lV{ga zw@Yktwd!V+*&p89+H!T7pH=7af6oqJ5BXO)9qf;Cx(~zF%yVn-)d6g}y^k$Z1BCNf zwRe!2ocF}_Nchm@le!vw3e3~olse#DdU0RhLmYag#*RG|^dXh#Yvkt`QcVBw&1~3W zPli7FxV}@@33UOcne%iYr($oPEOA~F_$6(_77rAZrJhmpy_YokxR}flnX-17Z_fmw z%u}4t@wIXrH-cy##;!8Mj|9%OtHw>_V=#ARxiXdMGYE7Z7otr_Y5DkB8L79h=0~d7 zC{Yh@d`hTvLPzg3e%9>^O0M&1FYZf{_iIqkrrjVoINdhdV0mt^S!c+Q_M-wV(Ldy9 zdK;Q5p*i9*$GD_kVbFMRBGgMQaTh1IOdE%JY!>dC>?@l8QS{K|{$>^NDG;837wv<2 zA{XOX-I9$l(W&8eQ0md+(c`>FyD!()cAYloj>ub_?{)O`Ex#r#8NQVeCUOPj-7xGN zyRnSR{Ubsu^Rp`q$K_7ujx=y9I;pX=YxKa6Q;*+y;+GmdCXQ}konBKQRI1%5%QBC(E?-#h|iatrWYU&5SQQ5y-BQUl&*GaqB zDv$fDXhH(52Q)PY$K|&uacjQBDd_AKM$Fi=-!*bde7V#?(!9y|hs=5dX>o5S=R}~(?#k- z^gLT1jlF@+zrovddsXzAo&NLhh9x5{bas_GH%(>kRR`63Iqx(bUOaKc>t_b0+&0b{ zwEX}iwY|8!h6;@JT-DK0S@SAY%!h1lmac!S)W{uVztYqGaAIk;o} z`11j2FRODakQ1|T&*&f0h#$`8&Td_P4B4sWOYs@|zwpf(wlE))ijFtk@p%|0Cc?>; zE&EPZ(f8EydCI|bF(#icqqs{g8P4HjdX!&^d62@nfoe0gLXHKMH75Ro@V=wDF1h0x zeQ?Y{)6rH$dl^IWev4`gtsI!AhVvW)=%UW_w8Ef1T8$qwX$t)sx(D%9)UcVKDh(!# zcx`}wAKRv4vG(%2eGJVEOmDz;x=i&c4%QsH1^f1xm-A@{DfUBju;A8k-bb?IaOyEI zp3I*D;!nXWz4eT<<}SK~(|KZFGbX}2^&$0qg9$>c($e%otR+}(8L4zx{>H^9 zI2XS2e8KmQ!Z8Uud$kt?sdCiZ;*r>8Zr`fst|z}XyEpT#g~7%i_tlD$mD1iR&&Sgo z9oVl_Ma|BYp?B@p_eaY$tUr_=2%C6tH_Ufy)P^BtJ0oq95e>5%4MXmDTkYg9TZa%Y z{+93Z+Msa6;sC#5Cg+o|b4}+T3PF}rSH}@`WebPYbtTlMu)wDax~#j_vh|&+V|JEH z|AGuEVIBi5qc;;x-S1KlTU%XZz#J4o<<7yviT1V9DfVnk_v$P80T96iodP=^s#$OL zQ8cHWEw!Cnp0b&{b{T9UcBav$gvpmTU;YQxZBDQ1t_Vd3iUs{Mr2o4L;7iEsO~Gif`DM;aME3*Vf_p zqj+9WoAHD8sxavD%53k`(am?;j+1Z)t)f5@JZm-2|5y#8SdOMNI&`_B!{;Yzv;Na% zQv%!5tAGS{W8mMCFazGm%r;jxVW|HZ>>qohz-Ytq2&v4RK?DZ{G-4JGiCC$5NV3xP z^UF53rcHT^AK#hEwaoc>6m>0aA*`7b4%mw25XSU7gLi*6EEmIH_T>t=uUVSZ`}bet0K9?#CZ_%^?FyLQ*h!w~i-M-t%*+FM3! z#_rq+7@+%mzcm|HtodN)G%-{-5o!d14U4l%96vLP7Qo2uDRh6w$(j5SPO{bxLm37K zeTB|H;kZ&!!XZ}Za_Y{O6P&7aeynyqFg|+x`1D62SoU45RvDA?^P{7Fz$Vl{Fm>qwF z>BiOX8fUTtZjg8N?l*6}nWZpz&ibaA;)?rb~h&R)c_go(H9?D)%7x}7;? zKl1Ajk!x;2tjh~cgbHHE#uf)a%@ROGS8C!X*xo!Bp>d@u!t-i%A~aM;a_@Jk@90K( zwxGF}+OeOGRQ`~$_ik3&D|`6p8D+`|#v5nsSQL_U9y7o+#LF9!JyOR~`T6wj-gQnf z3wyEFXX@TRcq!qtWc@Zwl0d%xe$<`oQ4GF>4!prtPmXS5OlEkie#nmJNqVX=FeCMG zl^AAHz=U0qGMG5 z#>8YO3vy;%PjMY6q8!Ts;x2e@CYL37s@{#7+mylOvMa!xd@!dkKq26mXP|Pl)DQDE zzk%*b7)kCnT{ql61arjL!TQzH$H%p z&RLJPo~+*|`4I52cN0k827K)1hy1K-$kfJEX^Qw9sTB)QVflc~K@WN`xpy#7WybFV z(VualVK;7SNEgC?YJO-w2)LhQFFWvDhuNYR7MeLZS#13@F9)PA`KCd3JyPu)$3KFd z2H-sMgOd`)z@|vKGG5WObU_?fF9T~JJZ9`3a28gPCiWZELN~7kPoabwKm658{$?~) z+MB-TJOM@D#XSa(0SS~KTfotxlIjR1oR1v*?z|G6mM6JH>}%RM)AshJe4eB*8u4S9 zqdO$_(f!BK(C#ug$wF0A9NbccYFnC7fIjsq#z&yR+BCJ5KneBsxRN){t+(A$^M{9B zU6Ih%BJt;2aALY|wXFHq0#{2)^LyJpvyaU`Un8bF$ueC2*0W~OnQ>dGQ5p)Izy#Ti`hX7Hr3gR~*MwS*C=AOYR3^40# zj)Dav0|@|+WiB8uv5NPd&V~V@b7m7}e?ghWhx|TF%p-COY^mmX&Q0q z@7u4Ydizsvntv`;w6efR?Q>Oqr@e{%tc_qH|8I)DKg>ia;MvCb05gh>C(z_hsn^UYJl|KtYATRM*F1H|6}$!>J@O?m^DW!~1)sIjO@THyy1qgEjpYBk7iJo7H-|4;Q zYsZAqZTAL3HSV19>+5Pqn0jw&U!1ByFVY+u{H<1Paw7y}*UAI&+P8qUfyd$bUKDexF^XNcSTIf`_;S_^cjqFKGv%B8g-FogZO%zhxE2^ z4EU(4h#YzM-}xwYIPNX9w4ZZ2#Qgd_&k60^KlNmhcPZH7Rl|iZ=m10mywo%lIrb7n zAw!wReGc_m6p}ilO$c*@Ub*qIYQsZBbMKLOQ0SC#s98MtL}0EXC7F78v=~0OKJEfZ zH@{8#M8#dK_&RF*?J@j8k$yy~vR!r4{UO1K3EQn>Az^}GObcvamgQ%hBM@MrOwPi} z@P=B>Z^UoKi^WOyw%e=QWe*#D)7x+BwWGq;3es_yooKiPczyduK!~^K0qPgTu-9{d zl@$>zKH>wW@^I8(!15FSLs z@9_7dDPf=}>i+m5-k%Zy4_A{c$ptRDaJ*1>wTSzf$!af0Z{F^qcImpE-gQ;ldYX>+ z_FWua+ZZkF0lHgSk~B#L=Ug+*-h#A(_AkKuiwMctgbLv7yh$y_C%@l#))Rot=Y<=U z@b0cui#1krQ78B6lWo~sh^^jJg^3tzv1 z*$OPVFw6$U;f@r`(dlIXcE1_rn6ZyFyHUB*`>No3A?f{{SMjJaCAzObAfp230?(c` zI`4j9*h1Iop0U#_*G%_S@nt-#T$MTW5b4g6Mo&rXrETk9m_(4CLsD7Wv<7a%3yoO6 zQbu@M$E7(W=L9E1(xs9Q$Py4tRu&BW1TYTLwz38Ffuv3#1>V-5(-xgN)cqKTH$hE- zrP2+*AZc27(0{^;#hm|mfm$Go0B(Q3g2YSfpbn(ucNWe>qS}PAS-KZMR5yeke5mbY zqj(&s`;Xm+wR#EQy7I~i6)BcBZ}%Q&bccTfD4gPV9tLU_zg_?62K2Z`o8A%j=zn>V z{%p+j-Y@-i>-!;P{Cw!#U<6us|*bVcJlf-vRP-v+1C!q4=%HYHxx_ zZRd}5We^%I^}T)N&Rr&kX*Ts17M|yM$EreJA_7Z*k=)gOI)RP#wIMvSKn*DcJW`PX zhDn2^6GZqW4=YOoyL+ywIg4ORQ%l=uu?5;*YfAFOMQz@1I*qR_SE#BA#2u<5q_10JzI zo+10TO{Jro;?l`lV$KzcB!2pyHRg^K5ExJ%&qD_X2xL)_Ykv34Vkdv(ZcX9PPMX+q z`bPYg(Cu8(FOr)%P9jF&Q6r)Wf=_)yE-IA7e-Gg+?gVCc?$%vZZ*|P*K|qp5 zXLiC7LvXt=yC1=Zyf@W!V?=K0Up~v(70f?=JNde{pn`abU=OM-z^p@|!bXcMydzG) zJ*sk~V~rji!sIR@cOhG`4Wo2{A>@+55%9n{x(9S=kwgP3!WxvG2p6+eTosx#2DONO zP`04}XX@ul9KkTWKTS-k2^W>$6LIsv<=C$a*Z8IUw`fj3)J!N9;=ZEn3ZI%ls!UYh zYO2UMcz4?RP~{f`JS(xm>#IDK`}#bRD!oSEBaa&`4UePW&!Tql^Wr!{?mBrp;4Pmf z&zb2-2rI2y>Z4-huYJQ8@Ge9sis$YJ~%nctwckqYX#>u zo?WDWbPN5gt|iRA(jb;l3qP4HZ0Z(OiVr~j1RA3|kM^nk*>FMQo|Mylr)Hj}8d`dp zSu7*Dn0-)Qx*JW;CwGjQNMsyeCfWu+kXtoyX_&UKw5N2xKYdN%06q zrsLCTyb?rJv9*jYxJ-%L3MLg|nTnn`dW;&9HM1dmRP!kL%JVTK&x~kC$-A3&8=CP> z2j^EA^PkM|17}535^mjlC@6Jt+w*6SAkt4{f1pBOtW>T6L*O{Uxr{-#(;t$qiat#C@Gg-bAy=O^%r=XSBaa}y`9r^{TR1UJ<0VMFIjPO!x2+&A$(J(f` z^RejLkiA)U8%aGiA6lgyme#LiT+YvF+{XJ1r!q?_qwmF1Vi>95olyfna1>PrdS#x! z5e@~qpfKLY{F9nw>}$QZ*}?J;T((%YI8Vl@yu1*{MYM_RFQt#=TR;$f?5XwCbh6A@ z>M7FHZL)WiqPnF}LxxBJ`g)Hdckl%hudY`KdSZ|lN8hPH5@SH5nv|DBNh8!~j$W&_ zJb$&UBuX~-6*T$yePgx>yyn7>&$tJDsmxLM?kwslFpkoJ{8-H-I=`I&W1CHF^K-^H zQPN>Xj)9uKkA)QO`97&I$bT-D^z5F^BX#~@sA#n;O*=rQE5LIs-J!ejwgCC!>rwmE z*n+zf-{oG2pWu13^Q;Nm)8Oq}cUc+@R!>?Oh}I@xF~xP=OPlO(s(CdoZH1yy04&jsH^oy9-We9g#1I%7kAK?<@T&y`@J(L1YE$IRufj;Qa- zxdLW#eJ(@BZ{bLGO6&G&bgJr8X=#Igl$l>A*-{os^UQ2gI8ix_?#YpG)rDB_B5yd1 zF>)()M62imrjSzflDDwnN;gWm7Kk|94gnZB_{|8STk}NUesWSXn&6|MOn~vuh@Lww zx%Jm&oI?VK}Vtdc;`>Jc=21f64l_mBPkbqDw^ zgw;uQ%Olp`tbTvp>?{i~db4ElcaPcMUpG5Us${Y{PabXtkJ_OIerg-&5XfpJ$?6>m zT1W1Id`?+2z`1lh&pv+4O1N3*t+zFK@!I860v^-u8A+1qAfZknaI{jPYyo(elw{ij z?$ay+l&OKVi&TBWp%NlP<_Z-xo+}%B{%qHMIZC?rcJ|ZxZ?@z?w{U@p zGU}{OkwJdf#7!H~lCZICq(rR%{XSVHtojU1kbaZg8~%FqOkPTa2gCV`nB{GS7(>w$ zL+^)!RGG#-0YcP5GCOm}Et)3Xm;`S`f~z8cwRu)zaAMjOKIBlE=pgiDXbfS2&2e5j^8EU1JZ&rX;xi`ZXIJ62I`QxI%1FMDwMx7ry38XI83j%?2FqjRgP)F4)%?s=UBEo9$Xqf;9 z?J$x7GDMS|8n2u-ZpcG*80ox+$2G2y=+Z(DkA@e0ZKT>AKU`Pd{kF6BUBZ1|43?VO%8;5e=~LE6FxGn<6Wpr0_& zw*|@0Rkk8YE5*KY@*@gsZ{oPVsY+jD%3Qo}5fdMeeieR+4uYV;FQ})qs6YeW*3O94 zkRj!_8iWwn8ip^8H;pKLUuiKp;(_AUnXus=kP^@P6loPHo`AM%-eUpu_V*EpD~H*x z$ikXxkA93N4nnEn$9%I^afo&1F9XnPA|LBc_M^i?&lFD#~>@&9y*H-NH^1_@>{yKW4ZP$Td z->dtd4@ca%IUJp^WuXQ0K3sAA7D$6Q5+Fl0CxBcp>|?|ZD!guk3#2K@@BEnorJjHJ zbFWdox4lowiS^D0LiSMy%jCpSpF-S(t(4i}*>Jw%bbT$524VeSH1_(X69?mx5AY?QYNSZ+A|>UEkL zX@=NuW6UOUMm!@ob12f~70RQO*6n+F0sic6lA*(j{2+$XL46JaJQ?C8B+j|nade#0 zMw>vZzxzuEB}(L*;s-&y&mLBf4zp6|zB}8`KD`9NpkaQU_6B5emXx$^=wk8JyC zWLKZOlz>iF%aY~j8{37?2dlZH3!8`Ly^T%k>s3^i(F5Mh9T&+(;~0=0@hRgN1EqO5 zK!L>k(9Mk%aKN{xH)SO6=90dCKwDX2AzB#c%l0#MQp1*IXv3M?Ysk?=ndZ*uTD9`< zCUmiKgiK|iOVeJt_ZIcy_Eof#t#iF?WV6OlE$yuZx=GJV_d%d{>71Y~2rtc$u2@J8 zZ@})g(>zV;c$E}#?VJ4W84l0piGzl%2c~#p!>-pu`m9Dh7{5~^NY;)c2S7&?1s~W& zBv-&TYWp~59u{sUbwRG-JZHLK&yx9(K^O53YvU{1mv+qWh(vcM)3SeRNxHpZ_QLo| zuz1_+R7G3j@bPh?SM+O{2u!tRT6=q5h;ICcHm^D8>3Dio8QX!~kUNH%LGf@w>UBzb zIg9;4|LC-_HTwQqwy=)Du@|=wYaWT#8zef0Gkb&CY!ChbHMwnE`VpnBV@eA>p=566 zjuP5gA9WmlA^t7%6Hxd-GY8OxwJGWCJ15M|H)<~wzO@?1w{)$vxmxo5ahjskSO6*UVDYY?DlCxLx!tFaa<#YmmbYXm z_QuYcwS;~t{E)!`>1!9>sy|-NyQLq;ouR|o0$jP}P!8rcCiolaLZCT8i*!3&>h>)& zpX-EK_xldNU`ph+ zA@5?sm`A9pG!eQCDJAZB`&vx(DFUy&e(wU$i1%|}-ZyUTw9fH{T;9>9m^F++89R+t zaqs#ZH?jx{dx*aU9Ad@lYXAEyOV|}QMgBJ?Y<9zDtDj|O9{Mw@!kVdZ@Bh)!7{ssE zWoc=sXYp-;3c8AtoD0sr*G6YH`~z8;77Hke#YQN{a7px#p0%f|b-BrXX4 zm%HJvl=PX(jB_6;;TNV_EuE2b&g`B_){}{cx0mp9A6}{(OSmHDCM=h)*RdIUpel>8B5A&D@9J!k&No9QUp2Zi`?lUv^U`h3|D=w+t ztM%mX@#crXDWHZ&m>X7cPUgK{9S@A(GQu7Pg52$rFD15>g zUP)S42baZ=nu>*h^Uq0zM#-(n30YWjUMwgVb$-P+d#l;@dXjJhM9*Z(ahr-tJ;UB{ zu2kb4li9XzyS!mKB?PjCm|T72^OQKo>krlTW0sNbbk6VHwL&x0tfr zs}{%2k7{i6xIM=D%2y4eKsv?(&3qWl3+r4zhTe^x;{^eY%q&dLIgs78#@s$n+Z&+I zcv^eF2juCDhKpS+=~ZL^LuO?24Z zA&@%h@hzYd+KygTorbQcl7zzy^L(eKaZRvd{#e%ZuzDzREG;!W>e!-&CC%6|L!j3L z3=*yCySLLJ{^#!6L&=Jv=00WXdwXudZ=Qh0qJ$)k8h4N@C37sV@ZbC0dy0(#FW0%pW;AT3;{0c*0I`m_OEX`>~_o$ z)y-J=u_uneo6DuLH1I}8Wy<5o;DIs?pl)pSr;fhzNi(P|2VI+C4ki?3Hw%4x#hUCC zFVKAG5QwrpIvR-b+fZk65ol_oh-O$p=O=7vYSx#T)Uu!eMfozS-kyPY5vpL;#@rai)-U6yMAvt=@J@0OWDtO0nSsN5=a#w zyML-&c$Z@VOM*T>mYN+|B4e;TJfv%FwETH;A~DqX!o?l$qcr=-&<1%fYNxSsD(>-$ z<+as9uJY<{uQSeNX19I0@--2acm8#NG|44=Ro{OeR-ej;4s>oJl!xeq9l85p*OMmcUMLhX9i3$n5WKwo2^>oN>*Biu~P>c+L> zuM)5o-u#-DK{)2IbLH1v=gnfo*DJFCT^r#Szr zGSowPqi8+Qz8x7nT3NoX3k7Vn*%813K3TeM3iWpmC|YM65i%MsTT^ED^22pQH$Bo= zysG7hLFdpgN`7VITj{G}fWPSt7QUAT1BZ$#tT+${l!qA(kFDd_A zjvga3iFHJuejgF*<4T$TTF-T42=nduBCw)N{D1%ca_nblW%*Qg0(eh*Sn84c`i^iF18sLWIQ1Th-f%aE^Zx6&}HP9Wu+4lludBG~n3BhEj1z3>$ zI<%sE667bb7Q+fB+;9*9+>d%Dz{G$wOVqq1YkP)AXF4ZA&{BZ+>xtR;?%vnk*INrh zz2@;RtyOX3mw_*F!fj$msY?Y+qD6KpN~8~jbtpReCM9bm-B6MI&gO?biFD!;M2=0l z^!IolA0Kns13A^l;Gog@C*fJKIrE%r%A9tb5#RzGjqMH18leUc-bm9aOS@6X%Ud&! zmo?l{z8&$GP2j?yR- zrGnF1>D>!gM~_87CZ=W;v6DK9t|yzo?ZF|l_F;$EmYmfD+5%!gbLlTI6p~~H>+hrh zjWqZ+HP?uW@f=&EUMWHCFueQ0XUnpoy~f4+n82rv59Z^E%a0>H&Rz7_^8T(xwZFMb z4gjVzNC$bUr!9TwI3?gaIG0@1F1yq>@%4n2D19y$d8dm#?cY=He~8~FFA~>uCngtS z-M{lugCJ$NuMQQyhTWA(emcremsgI?t4lcJwj$>B{mE2p**1+jo!g?-*_3rgut(=0 z&6uj^NOW?)UPMARz(faqy03QK?f!O?epRvfWM1*fOE*uuy-7%RW#`)SF^Tg*1l!6Z zRmF7>S>;%vAMe#vMApk{YEVtjl9NkFw41$5Icma4U!&Q%T)4eF$Q@}Ei|ya)J`jtD zV)i0;Ar1woP(^ZqFl|Rb%>piwC#$<~)-T~Rp``CFIi(pTG|)g;J_YX7I^1sIkw?#_j>}y#%n#27=1L+g1BZ~&uw!p$RM`%;+4&V-qOWoV2p`7h# zUs5FbZ z&AfvMl@%vvpgZNxa$9@v(cYt!>oM^NQ@$^Ds6tDmwuTx`x?YDBb}6QH?xhMfAP!e{ zYx*B4iQUcp^H__jq`7X4(NuhyUPj4w?(J?9M3php8S6N(XKR2prJi&J|t^zWKGUB}l ztHVIvE>d3x9Cy_**f9#?YIU+X-{d~5@Tzf(aq|}p;DffFFdvK{hH`4XSJ|NsIn1sd z^`UHikd})|J7fJ51Sm z~vw(B)m`8fuIkK zFNCoK%^t+N?7>^PY7tq?#>diF^5sc@Mgr$6fWiX@XbXtnl-&zCiN1_PIk32m`E?xV zJHx|F%qH{ydqJ!RxG zT@87A%0kCO$9qz>&tc@B4{zD2Fwi-^sCnqCN2l=5Q}!Fpi5z)%_ghl>yrMNux<9#e zV&B+u%edex3S9{Zcukq+Ejs9oPad5EufDaJT14U=Zw?|Z?nd;Diqsymt5m<-rzzS? zC^hH3tg-vT>uYG`mX41+$UTl0uyE{H37p3RgSQ^%tjFTRaG$Uoo{MabiSl8nNb%Zq z;`}yh88*!R`j_3h&*XMKpi{-7bOja*k<~!Y;Ftro5iC_fvgZpha@5DrvAs&A%+n;D z@M=pJo6EgqN55mD!GqZMk;cJg;3BUVfdxvCq2WT55JqwBG5U#bivcj&5y#4T;Km6_ zP!}pLsHrS2N}-u8H1{OkI$#e*x$UuTML`;kk>^1JA1J=N9$6+cw+!Mz8?$)W^&{HD%- z?0Hb!gr*4_a$k^+<8Aq1q_BQozKFdAL)*`6M?e`7z*FjmR6mOYT^RBGhI@!dd45cv_d-K55$EYa~bOkY(wRzrgB=sl=q2W>E z*dV$xsl=sv8-GI{=O?^Lg=EFCg6Q(&6IBVsWBV*gN?qp)1t2$k{n0Cmo;*1~H9xm0 z8el-~O;Q$c#??z=tqdb16{*AIDja(63Y>RHsmv|kk@B_n)z*i{_LBOw;z@&3cmX%| zK-@voV=y)3UC<&JWbgt|{XR4*wqRewPqdA;NU))YvFv1S z_Thgv+B8-&hG^r z8v^`s)b}ugl@Abxwk9G!UBnP{9xyqxhpqePZF%xGO5%Hq(p+M6SYf1yEy^@Ws^l0! zFW!4{%>&}0(Zfa-XoRmQ09O|EWEzmx_ZtS4`fnUQD%Qlr^5~lAIrF%mPk}s3q<)@0 z+rg=b))M0+%0zV1+W?d^d9pzgSPpcT#s%09t3KeOy$|~Z5xlu##A)!_r>ar(sp#X_ zT%Xsob4syl)n<)f^WL?FtF7EH~)&RjR+1pV^I2pho7*>>P0veZlRxyCqEG+=M`~ z)Qc9!YLMX&O_am_u@`7?xENkW2IkIp4JYD}c_)*OUfr*+gUmIJSh;+#FEuXWrfCsT zF>|Ovs=NqXFsV8JK)_OUin6~_{MSw*T;$et>BiI4vM8zUMTyL?Nlf zp`R+o0h{n4=`cA#;<~_1w28YtnZGe+CYQ*+^OVAlJr1W5^yW03-FO){*KvSR@SGXsYKqt%Nb<#srZG%TY9s`<@eg*V|r6kMBU>*ZYe z@YpZ5ho627wu}FtyEsJVe8iVY_P6+UT;r@GyP58s%c}1e#>?Q$ZI4vlt6&!u6>;^4 zo#rPJnF5B}K2N@LiVSEA&R_l}g*ro02DYPzYrv``t}4Zj!4>_cCP zy#CD@0yTR#-ewW=G`+==j>|jmEdLpwJmE26jNR_DY?fB9Pmt#yXqT8|bXyvn$t=U? z*PRQf<~tWE0=%C575QnzBeh+c5c^8QDCwl?^M~FzKe$t#(pFJc${l=j;>nvSNXB?K zg#FR~*wm{4cg{0y=Ynti*J4?})cU^`tn(j>Wg$K5xBh#CBJ4b*W54k6aNS>3b_8!%& zFVkK8@-UlvVJGz2YQ9&MJTLX3BQ}V6s7L6=cR9kx>axfW)&b^23-{PwcuQ#nZi86y z1A4yu3nKNGIG&|O6AwZGqm2I67V>J?2|Q{)Vx4?Oj+2rSEt;iISd5%(--`?l8{swX z)llVZ;NSVv)ajiMvhnMO*IvOLW1mI(Z_GcLA5$KGAquJ3hHi|m+2^ne8~f(tz2&XB zZV!!9M20jU#K*aRD@Y;AM*v~{L-c{b`N;>b8cNc2sn4y65$4xRzul`5&^uCo#MxpgZ_Fj z3sWq5>3ZYxydwu|Ujc=s**4bZM#cs~B)%xD-Z`9eNwNKlS9AOHsoNoB>$;D(=z5@| zS*)L9SZ()M$~^wVs9d=d^;(^4h`3u%EX4i4?_=6!a(J|2`#E)eImgC6@9W~yC*T(9 zWnCPdf?dc@F#sUj$YV%4zYFtF5nXKDe=$5Z-(F3_b!aBFD(|sqY;ky-5mY!l?tEhX z7^D094v0(Sak}r=L~M!qsF3}vLZj1}$xpeG<(ytzln+?y&5Q%EWd)xQfUTQQIKAOi zTQas7Tq_se9P7(ln-kxZWj1P1Yk!>0>eilwFPtrU?!iu$_K(bY~Wc2kv-7oLoWZ8K)B6|o{_!*g7H9&thelwh{{rs6;T*R4S@=4aAwbltn{VRF z0)#(L`VZ>e{PbUj4eMP0`Ab>MTYxy=6N6s=dnHCdc4GMd@eS5beYHazB8NwM9-doa zz#IF@u5B?n>@sDuk0(Rf&lnDNT>5$l5xVn;_)breW*B(}Pvr!m^IK%?=4J_i`ML?Z zlXu;1XooKESK%Ce^+~_{7PD2ms1t@fa;);+N;Ut3j1Ch?KpOCAaRX3b+?F%u=# zz10Txo?MMj+5=tV!ZG_w17`&O<9zeGDKWL}WuYDnZGv;P;ahvAN$x&3sr}M>bne!> zEemu$^p9FrgG|36E5}%MCEjo{Z=8Mm`AE=l13J@Omreb=bF&XDex=EHQ-DwXC1kAI zJy1oW|0HecGf_*YnU|J2g=N4QBIaLgmbd(Z_{Z3GrKTBD<#^{G3qVDDl=#&Y6I&Bj zLvZowACyQs=g!!%qhY%OE@U#b|5hQZyg>tNoQ~rcR8;IhdprpqU9W3;tk#IOn1u-&@LmJWV+?xr%wu1 z)l^oLAF+`m;q11K1=SgG3Uih~e4kKb|6y?exUd3300osf*84a58d$h%?2XzHy8ZIk4-h_ z-}nK%V*hX`{HdY-0}}rYS%8jzt26%ret$~&KOGT;n*s*Z{Xf-{zaI4;@+R|7Y0dd> zkp6R3|5WtBdameAbh)6iHe9|eN$ zq>&p;0T(Y9YMi#n5@{Ncou9bdK*F6RpZPXR z@q6l(A)$32Tk0N}C+t4Sk2yQq?RD|t=q?SUOpK?n(>#GD8EZ|eQa2VhW{+*;C&FIB zu6f|*R>@rYN2xlEj$(H{Mw_w~c1z(?k+v{sq&o;$A|nb>>&p&{D7l461a6$VIKQJf zFjFiodJsOrQ;u36DHl__DK zt-3!VrD96b(s6EQf-pv!dwLa`Q6KnRPg%=zGS`3J_BxVn+|NjSMy6t-1n#=5TSnJefLRX=g6f&WIpvkD+!yv21-GzQ(4|)3nl(#JiJDtYKl1>ip-w(G)1!Np2Oooh z5_x>~`FC-0Xh^x`H|0B+8B`?de7h$vmBKxFq2oe;Kw`6+4VqL3NVkL3$p}043$o&8 z>Yqu?zW7z+;QQ%P=2r4Y{Hy^K|DvT?dsq4wwk4_vWlGVJ@HT!7P1QY6Q{5GC|JCQW zdV-ThR}!xjscDXt>sIYlTWyDcz1mq)bE@GN1gc@+mTMPJ4erU8KI^b%@IbKR8}wnY z442Q5wlRe>cAC{bxqWDc^f>d>XZGeS&%8XY?BoN6ELd-WiOcB>oR) z?-|wP*0qg>F3l)PlM)pa>7XVBSgob!%vob$uIGk~mn-K$*JTyxHKP5l!;+a*;CF9|+jl#TcJ z32}QB)=q{7t)i!ch_j5)4Ul5g_=y3IwPr8YM@;RI60lndo{2%ZKT68Kehm%kd;e1N z<>``N9Q!6uO(vHq_Ii~o>Z0%WS@Z0Ea%j2^8)7gR+iVDDXzTa~lHxkP*fWDK0oRv< zBd10titMQeNs+ej(KYE6(a7gJ&zla9p@513Q7YHX6R373Bt!%mIcAriIOXde_0f0# zDTek2?uTC1=Byo2IlH5vc*Zjf1##1O%K5e(Rdl#hIDQYN=&po)1FJso3;Y)}2i#rr z0#jMP4$P@%7Up79&7CGO7!mgudN71=M?rLb%8fY$#Y=C5$^b0BeI)?PHJu$l0`LJq z=qLWe3^T>kPY2eiMnNNd<~Mq<1i1&$w*TKJbTJ)~m;(?~16nhmg|FgdT}hl`l;b;% zpr^KumY_EDUUwmx+LjtT{mkfTL=JKO4y_|Pl;guS@Ku(6Rd8V2gAxVs62PCjujC7Y z;=l3Y+J7K9FpBhQQJobeNV58(YaYgz2N}1jSmEkwW z4g-v3>GuH>8pZGP4`f0iux=P@OBLPe1mTYa{{OW0)Yb)EP@MM`LwkL(TygMHX8q#~`!E87fBG4@`M9qK3yo*UfVg>Z22}Ts__c=tPkxdY2 z=|!!A zH&HHcya4+^=JcP&WOHocgTn**6Tb~ zdm3yUMe*>H7)bX5j^svpuK{YE5_(6_y)K2_5rY0MaC4G@Hk?~v5(jLj)-nf4_D-%y zNnCT{1voYuS>KFb#(Qe6nJ`Nfv>Lh$#7Kx{|I^H z!hth$oTh#5vQUa9Q7PKaHhqM2de|QMHax0WeHvL0SrWKUzc!K9aY^!qlbVb!IOp&- zJq7=>nxHsDeIeZmp**ivn?szTaX~7l?0$*{DUh%>?VgwLF|XQL+BNn>y`#kZ8WwY6 zklvOqK{QJ=KzA{$g%k}4hIFm^EGewBu7ohACGe)Me&LhSd+++Y{?sp}R|Y~F`X4@+ z7$TBTVY(0ka zY&km%OM-X{MpiJ3q#1{8qzoUY4(O3e({5P}=4CqWk96oBR`_^KWp}p4oL(o-Z8(+C z6kNrd<3JpqAXzsKYiBc?mPcpA8TdU^%DMP%z1@*wHUJC}C@-r;9ZI1$rh80kx;*G^ z>189eN&JJgz9=#N^}}>+DPh9wpb)Q}1A6(a@;?xP&%#iWr&xXVQ?$X4lVsuajEb?F z_6KKX;(?8_+M!?bOMdRdtJ1XNMH<-u$*Ea@sit7v%Q4dvwde!6%f~=Dn!F?-R$PEc zJH*9H1A4#$DMBozoYeb#GHz4KJTFg_i@o!0>*})<P){tS=wE;2Y8Cwvj`;Glc|OF&tO@0S#(DZ?^a;VIH{da{yOK z?*TDmD5APw;oGAY-e5i5BX;jE)NIgx4%-(_fX`S`f@jOAJbn} zy)^Uc8cX~QD4F3^l;Ml_rR(rR=3Xv+X+20~qG}!gd0D|D&kC}Ae(octpo&c!x3qg) z6PE|-;9Sx!&!y~wH+5&6#~#(Gz1#Zbr>Jq9G|42y!Z)LZue zMAOmu3RtjULqE0qFCs!u@%95416b4rBN1t6oK_{70|i(l$_jyqEMHW|Z0!Vq=Pdkhx(E900Gv0r*(n-HFcdw4t530G$e#vs^ zAtB6_!5-kUw4Gr|`O@m&vzzD%n70DzJMA3^OFqi zstQLvJ5kL5fnThz-n~fP$k>Fk&%y`+q{Y06J=?LufY~!l&3Edl-TAVT9tyi_`nWD{ zYn7$xQ=TrM+6wJy}=kzU}vT|>ZoP8p0@;_IZy|aa-`-|WLUdd}Fy=n(> z!4*|6`LDFJr28?m#C1WKAV$@*n^z0}ffT&KtZVh@!>18}_$MThl&QYr-XD!wqD?pA zINBggCC_kT@66nB7E#P|)r^IN@we|um|F$P?Wl2+Ll^G6x^wNuH2-(o8org}H`5IX z!TZ3gdlBy1?fQbn`tlQl#`wrZaNGKjUeA(KE`{6917mmpjN$^nhE0yA)69$BMz^lD z?uyQ5$%lwr&om?k?eY7|_b1pro*Cn>npoN_Wn4L$GWOE!gjsQWmU_I(A&g zo2GXY6vzBxhcT~`?v=}`$Z;4cUHUnlT5#{j2jABlJ9G-B{nUWD*;r3nG*`7w*nPV> zgleDJ?UeOyoY;J-p3QxT_q5Ol7Y5O-yo3fTVcx`8=l3MX`Vytj{+1x0-^2d&quKyy z0w2tOBj*_*FaOu~iNT7lxig#m-k{kB^u^pyNM`20H_h~4cLeC&cYzzA-pC&C(acbq z*%*QT4*S=ZOsDxVfbDeiKgOlW^&YT|&}{FZR%J3<8F9BAIbd$n43e?j%b(wdno57B)k#*0Ehxye^2c{`1GTD!csTBxHhO@ zHt!KuWTxrTuL|crf*2kHZr5;v9O5O<3@;m-RtYUiV&BZr#~-5t{%^7`P?jQo}9<5 zlK=Td@m=nyVZ29ze9%ez*o~3Nu+=ttb-b%KQ=fX|-qvVoh?H7lhSr| z#KDgEMvv%UVY8js12wk0=WClg5LeB*I0o|%k*=U|DpWc2APW{vj?Q;V-S3ID=0%F* z06YX@RpFsk@NBQBy8BE63fbzH_*b6TswO$efa9(4zGHRpoowl0U=-rC(Pm%iRm>O zFmQKbn%Z8?+*f@7M20ogh+;t-t=|Niws;%Qt#DvDzxBqP7ol217d)7$+fh1AzbAavrCv1pR^&yp7xN&Zv!yN3UPbaEYVE)>~LL%xT7 z9BXcBJH;@hAwn@Gbk zvA?_6!qQW(q`IIiV6|iQMDqAFD`PZ50MfF6JqC1Wj!p(9Qb7JiUQy&v)BW9SEHn^D;%cfxCQ z@7wf$AoCmwbn~$hBihI~u&9K=c%*ca1(4b#PeLiMKCtAK2$*2Cl%5=6_L;N0%K9L# zBuEbw7Jjr)$7jHDG!DCMglswZ+HIl`O5wJc7Q~degp=XaZfhnSNfDPXVE<|%nWJ~T z^MFp?1C#{MRPwK(6DG!-^@e%)2=gx;$ZtPbH8qk+t>n8D5m03*TVHt^+5infG55Om zUUqhzh8`T6FTC~v_vk~nB=>g_5BX@zl@N-S?esUU0i*5}X+>$(ofFB!3;p*J*`d=s~h0!c|AnY(V?)L?Y0| zmi)Y2YX3;Tz^!pVN8QhqcjZT6ng3rlido9T>cHLmqe>4^R%7T4^UquCNf$=(^OZ?s zDnfv;t`ul89X9;G|6`mqJU_1~xInQcyrmepGUSI=X^bmco+IBTAsys^W} z&}9voBKK@f2|udY;g$DXFpQLcg;YE#tw&|YXOUQ_+)4o{2aCYE5~P1Dy^!&SVe*C zo%yh>K?F%#~da@eLON+!asgOWY@e6Rt+uNC}juarqMfqz8OKCoR z+qm2cUD^+4TbWHFQqn;fRz3LN@=e?7FgEv2$)O ztCl-_Ho?sZnsU+q_HS|{I?3j5v3uY@`oGn>7a?LSiU4L~eaYF2&vT`1ytMR0oUgZi zX3_ZRZ+Uv*W%(`mxF|Gsa}k_Q2d=v-_7qoM3RvZn!G938)mG53ku%!Y^77L8S|L&@ zv^k%2s*`f)%w#@3=<@@>L+jSTn^c9j4e>|vLlu3uGj0@HYDk4n+I$GO;Sq7$PRMZ) zIw-sOh@?k&I}Hz2fCW>z3BSUp+%j1klHYx(5sfQpLERVoWkAPYOAk)Djly(<5iczE zv<^_=(!EpmCL>10_JzvzwA;!}rCa4H5NO3i$Gq+*&b-*K-}{w#cuvdj!#g_^@N|mA zS?SDca^EGLpYne1HFBZn=2>Z@hS<7&j!#5$M9~kqbgleeH6TL>!`;QJ zbb^hbmY!>lEgZuct0II?qCU}q{gjpj}&<9eu zroQUo!u#|*tn`M5wF=A)lBTXVz|D5eo=Ad4Zds64O1RQEgx|0w}}4H&A+M>^-WnML&)|1tH~2V z5R@x;y!_FM3efR(@bQXGL79cckZcuK$=X*}^Si3oNv4vc%(YEO(;VvpYsz8c+nxA= z$>Y8$B$FL9JmYEY70Mu>`y?*&1{~ql%sI2p$G!rQFNY z&%KN$ikS`EsUpmjhAr7ttSzmRrh6u%)1O5K*hC%pxO)<=tpOa0j#W~~Z$V%jxB-CUIY_Oo2s#W@>sOUJ{- z*-*y4>-e1k7*TRE$`5tMD;#?yGh9t<3TUza_T}cfzO@Zhg1eD<9js`~#`*L0MVnCcX%zUi zBBgBlc&2Tm!<5Xdd9Y{uXqo*u<7e+&W<5Ipv}t*hnLPxq{vG{IubW{!ZT zi^>RQIXNX^zCWbz_Js-g?T3gK-*w=iTA*ocKF+EW5WqYa8&gMYFLpocJNBr|c8x22 zMqOv>x90ppmmKWucI=mJ#Cek8ZZ_oBGW?11m^yT7$DQ_lkG|VRL$<3gp)EeiNtj&| z&TCw5l}RJ2!kAgi71}UZnzD@0y0w}-<_n~bsr`X2_$C3*-JYJ+T~%5qD;>Vbth}S7 z9tu+50XEZyfxC*9ttXL@oC!=(bsyU8t%`-0m8UqjLJetSwQJ97>gT@(d!q-9T?fVH zKsjGPM75>oqQ*G45LzVn%|$JTFXB!G+qx_>f0_hsl=V)D36zf&rY%x^*VEk1VJ?D{ zp(ZeYU?di4ZvsYKX?fJG2s5S*m+i^r{9IF6ZM*6R2J3fi0C!yzoZD0YEOrAPve+He zcg(|pkJ4s>%=|=w?@hR+DKo>Y%58IGX6oW_6#jwItT#E0IzNZrUp=;`(p+rL>tRm$ zz_6OUdk($xiP{^YGS-1ld9nfCbMKZ~#ljbj(X-oyQGbwG=lA>#TQ4UE68>wnUhj<- zbV|$NVHSCePkb9;Oa*$ZzXu8;up$oz3X`zd?f3OY}0 zArP(kr8iB%f*890KgS8P`QdEivZvGB@0AK(Y9tsge-xQnYBfQvpv~y-DO^q7L%^4;Rs?2|*UE{WNH|LY> z-0~NhQD>pGiNHUQPx`YY7V-UlV(;$rEOxCgI7rJg`XD7L{jNip7c@Z0Nh7APtA)r^ zJGS4;_tTO)pUv0M8*ki%mkwNGnHd1L!27ln$ad(K4s=2O?(=c5fx9IacBQ~p$4McLIk*jmVLY-Jg=?l&>gE%MsbCm9b z9XHC)QpB;Fw!0-o`GcJ}mf(E&14Ib*EU9?9(!v7Hxag^IL|CAZ&{7!tEqb{7tWbvB zIR)vNl4jehln*%kv)-v~Gf$}oofe-c>;_n_d<<2qw0Q&z9>t29fPLk~KP58*oMoao z67sFOF?X}!fg1eXIkx>WYG=Hs`6>FJ+J@t@zl|?G?`J7X{F(jT!hz|&$@S|OVIUlK zIg?a3Q6L+Lo_eH1Xji2BXpaM~2|`dak{|?I;+e2hMmrkRt!UgQ3fnf03K!#3c&Y_R z=Ww0aF}*sJ5`h{%-O1rl(CAu}WL4`bwcICq;}FtF+;n&@hmJ8Ib%VQLimWbMcZ4Z9 z?&FAs{f%d5^ZXfeCnrU({JgvtgyhQt*B4&tMhIyo6}sm;A@wkVA;N$B^lmk% zh|B*Y*O@9tx!NnG$Z0iUMA-fIBHMY=!W?HTI#7Dapg$SK&26*44f&;3tI=Wvr9wGO z;Kj>Nvgfl>E)eoVsvM^(%S~E8I^KL_WuXwBl*gle^z_d-w*cq`&d2CNmL+?_<4w6A zD^94x6m>$BUs~U5#YOug4z-HJC^u`>Ti!8Dqa#`c>}B{yeF(}OOj4;8aP=@5?tXOd z9CEG0@Ki|>N+)#!mwDh3!m3q7rsO2|X&Y7+?C|+G>cciZgo=Pp?84=%+MYXS$frn6 zlkNG~Z}1un6GaOwHv__o|I*Q~fmaBP1t9;x1urgRJ^HstX9nd(OY|RBgiyH9 zK(A_L_FL6%5|!Q3((2r3yFxYlSNjw9MGNKS?-qzAd!Nl)oRnPxGI^T@Redtm{76ND z7?vDqqmtfxg0LCLoILR9+3S8SHt~lUgMN=An?62Z=%nM`Hp1mw7Oz?9J0kq3hkJ(?#Vhe7CCGc<4s2L!VHQ7k0-eqn?V}1{#j(m_ZgKmW~%&1q;K=n&s z?vR$N%Dr(7EgENam*mnj(*RFUTupfI>$esj28(!(9YeJEq}2I;zMw0xEoHn+qpCmb z^+gT_A7_ln0#g3RXgz^d?lH2pOA#dDAVbzjiGYM45H_)&??YC>&|Tr8&_`V}kU2 z*M7hRE&Fk6;&)bQOhQ9p^Mx+Dq^9MNKL$qb=LCI+;6FIumheiazXtDDqS5oKaw^2zCREyXIWKagIv_S=i0IlGSyUO{- zR%27#E<@Pv0?` z!SXMUgSXtj^ruG^zJC@@O#|xjnjK6WKS0@{*-`)1CHi*SYn}q80BxYay2;JLejgi^ z)#?RS*f#(@nON9r@jxhiY1sH5h>?K9JnA^A30Qsor9`Mz6{r*%I{6fe9Y~C8+p$WL zts@J(Q6OK6OXNFp;mk4JmMq&=?&hBZgZ&`Xs0MWfrB? zr2!ipQ{bdxl6;0moQ{o?c1t{+y8MkL$6MFMD-o|l< znL1E9k~B+O2AMMhBe{>P1*mLZ44W?rHwY8;KrHBS<2cOXbsna$_?yx>vf=63)>p03 zH-Jt`U_?Z6EL{TmR5Q_=3LOFtLLwrVNV!112&^$-Cf|V{RY|kWgRYRbs5Y1HjgMbQ zc1cgOXN{H!y0XUj2>KXfXdp1rP`C_C6$C2Iiu2k*?}yvBF{eZW9uK58Kpq%^?AhWw zECMgI{sM)=7kLKsxDDpX#$R&=-!kj_D1$mRr@9I3BX{428Kv)-I8er2R9FVhGAzla zpPhw^LnxV;YrULCLW5%zi$A;kw@riPXL{!FNSb$hAOMT~o!5b$w(|A(U3W~p~mlN8m zT#WR>Ve)!9zf#YokEh0sGEcJd=SrDjF$FC3m}grl1Y_Ben{W=KY(gDMg>Z3PP~!|y zv)@H_q=D)l*W2|PFYvQ?)##)VxSw$I7SD|Kqj})pKZ|Nz_OI#;n~?hsQejw(z*XBP zbUUn1pE4)hQ*7`3VKFk27IWj?!_XuCF>MG4e!k)S&P7brG_gu00kjgui-z14CKC|Gxn;@j+8AJ6JIQX9O4#;&m(t;Pvf=(X39Hkirf>Ux)FIKiy705MRKF?L==(9tCY}j-TtrewR=FoP zqs-L1yQXnSWwJgfXln>Ew`(6^KnY_Ig(ActW@j$77fl%dNiE| zw#XR9WB1j$JYJawpg23=tv12Mq z*Ub2bB#xO`dEI{K2sq`AD@i;A3nQJ1e>)wH36Y*o5vg5qNet~T5=fF{c8`A5x)z7* zIF7`3OeCmZ(o}!6fyXE_?!)!!eIKj@XB z_kyhdt*BS(?3wC{v zX^;rf(JHq@fT0Xrw0;Nwnn^jJhfUV#)euE$?iLiuG9evE%|tQFin6x`Q3l_>^*qrR zeP&@HDKDXUXEj!iBRbfy_&PxnPUQ^l%}>~LCiSJwB{pVFgR0DjNVz!=zy*Yrm1SX% zSC=Bvt_O{*SOm1Rw5}$2R|Y^>=HpK_0_kNAnuz^>iPZ0jGDrN_`ytq2e}45_wK+^a z@y`$FtJ+$h(gz+j<$TG~;w6O6#F=I6|YE=#TNuM`~G57FWAzO*o^8I`dbrk5fqNmG^ zi9NN)o`W6LR99{s0549(fgJ06E?OlgCTWr<*@D^xEf$RIgt%Q`BJ1?tVy+j2TL(FN|xd*U&({zajuz&vTt&{!G z8~pt;n8j?gYB!;#;r|*qkR&D;mx6k1*81)W9)$FI{-4gD&m8w}-Vo#dk(cSxfcC=3 zA4Lf{ggk%J&fBPZFdpB=X6t< zFB1gnl$E|-96nL0t@zBxA}i*qVvf^|V{qkBQ&ImF>ywnzU!(K^I8Bin$GJxiYj9{A zn3u4`-5Fi8c1AzAfVv*-$#aSYlYwLj)i0TSh#iIm%*hzB(IAIO%7)sVF$wGPfr(IR4S zQ4P=|UQsn571E<3BRTxz$k0Mp+eZ&StN2r^T0G05xBRN^K5l<{p(1v_8JBFEF3hms z53Y=vd~NS7OW}D;WizVq#R`$Fy+ke4T5c*NkR<>e-99TJz|T}7bmLUA*2ynUKX9dX91Z6q zMIR~!bu2$_@C-32g`_BY88prL0J)fnqS7X3i%pPK7jWHyD!rRW5uaL#IR{4+2%82zLtZ9pkbp>*VZLRp`=kY)ZS7jm z#8lL#*-)cPTi5QJC%xz6giR+G5AX%HGcvKjGOSMYtfP4!90`uj9v)msw8~%~vc6$i zQ#dk)m5B5D5b1BGV|p~3exK-(ZM!KrI)$&@jY7JoE|g3uduK%|u#4q!5$+o{k3DJDi)@0MslPijDg=h*( ze{e6p$K$SbEInE{798iFEf_F2?LAr{JWI1dGa6-M@>Cmw0FHo+@)2?$2oh{De|uj) zMAv$TYAjvYcKFL$Xzx1hjhQnTxP@(i-~Flf(LU)B*A=s0O#gXdf7)sSO2-+_*Ty{W zYXi>#5mb)-0e!3Du>SNa*hM!L)|YO4CD=e$+k7<^cpa(Uv~!&cR6AGnn!pN%vb!RUAuJ! zjIb9G>BSF#QA>bO)x{@<n>+@pPNcE^LMoDw4=_b5bdeddiOhAuHPjiKg zn3P%$#i0!NcA;0mY?+F*S;qyyY<$3@Ohk1hzb1PM}N@&J=CELghenIz^&tArr|J|g|0Ce&Zr0m3(JqT z0fDEB8LShX*BD7AxN&!^gTWcPUotnsqH_19%V?}*`ueuN$msqew1Wk{GqG$0Lr7)K zZ1H+_TL z%5TGrC{s_(!OE&;*lXlt{1TZi~Lfz$adbQ(kRw^+dKyZceWRFz$j8%;DbC5)%| z5}`GlrAJ&saw{*-&UcN9d?-leI1q9}kjvyH-((nMI~_NG#gI;EWDwuhm%=!!kD=Oz zUH$G=dvxWxw+k327zGSOhM&7s$r1Q2P6eLfqq7vpfK*@ z3?^6Gas|ZC-dw|w6kYWP6go*F)&ZA3CK%4GIVSdw3+hExEA(SxvziPzCLY{*cUMV= z@z4^S4?g)kb+xDLAJ^EVbd-SJt)4~+!j1&#HuWPbFAV7a| z&0@2Fxc@DI7Zj`~vEvW|#UT9b?#w zTaGq6nE}TdFUDcTAMhp9K3WEV`H%Gpeu`6BQExEy%sk=5g@RRd_)P<Wv_4<96}L^)Ak|GjP`nU2Z;Y-$I0n}I^O$9&~!+13cM zT?Swbt=$Y}e6`IisjEiRKo#xAF!>Tz+*nujO=?`64i1VR&M>d*ZDX0 zp^H+j;i{<*9TV~s>D*=+xV%Y$>Jy&>VASr3{*Hj}Q(Z6Il4*Y)4idYVs zp#;F+{R3b-Hsl|+qYY1z(U_TMVi_BZK%*V@|3N$U=V`P9UX#W;&NS8$Chdhwa3-aa zDT*j?zNicClOCYW2|X%==DAP%{p1$Fc-=A?406BOPUj{hIV?|6&x7`8|2ykK4^%VC zEXN%tWoR!dWoV$32`1?{h%S@XGpIiTJ^p1{O~rE_BcZ&%I@F0Y8)4@0FW`>e6En9g z)^q24V>Uw<)wP}}bP3X?*3k0Bcte41yK^cK=)PH!UQydK;2XzE^0KF4SZk6v_dq?T zk2O2x@@^a+dFEvL!<~z&!J(hkN0siI%1Jet*}v5JA}{E|!k?exjIpy0iJvI?Fv0tt zup36XQqdI^Bs!qgJlmYf+K>JkH&*x{j=Qk*tdLuSr>$}6?Xo!3ZS$urHzC`;wZbx_ zPO>Tri$07rBpYc>qQerSLY!SUE-PR{DvY;p28RnJDwH&`*M&%WlQJYAJO zJTQ`nKRr zIkC^L!`{6Me5DDBvX8gJ8*W-t4!+$)hcxPWB-RktiXtgMlYlKi+& zzPmjC2rD8|O|sZs>p;cZcBSR_gQ%H;*}!Igav4=(evYpCX7^HU#(TfBKnbI`G42z| z{x+tnkk{wyc?m6tLg`_?4=2y^16P!D%P* zUZ;8=h?(+XzHeI)O81bNRXuxNh}u{!Mg;!t$e-W}Ks^ZX{V+3uOpttk6$5WK5FwDH z?p_9Iai;)oRy)Gif!mi0v(lDAv8f(?@2Bx}Hwx~OLUQQjTO8(|@T=0EjMTdL6&wNY zXJc<^OIFZ-zHYH1!Z8^b*vY-laMaLBIvw4jO#v<5#ex6yBxhLlV~_hCGcy)BI($RZ zru-+vJ3-$`>ZK2Zl2e$W1W?4s9Zr%#%4>^po#wzd zsT~Tm26-2RYf*!xR8~u(@1$oPoD+G87$2qFxN^wL7g5%apJ?z&iob{3Fn~=L0=qU$zX!u&EafRL3=n0sPg0q5)-Q86QMy0mCgeC{y*)H2snDh z@WobgwOu$K5p%gw{~@|`V=L%M{-7RCd-g@qH?3O){S<%q$|SV@molZTn?cV!4yo54 z)aCckB}#rSxx~I7M9GicD~mXdzjx-XDF#p~oGfg`es%En1nq1Ce@T!sd~4s4vu zb)9mp{pN@$>_(nr&UEz6v$9Yt=#+Zc=4_kP${lbYczgWH89(>Qa-wTn!TlrUaEeam zysB%Xw~ITc(J#q!=IAL7BK`K)?^6dK^&jOZq>It~<)^VU$V4w6whg1QiIKUGH+J*Y z%wU^lcy1j0nf1ORJQJoE37>3LaoT8iSyyXYMLQ^2jmt_lBcu)ek2MR1(QMEKD$W!f zzJ)0Ql@*DO+1Xi?^9nszW`4dIvF_D7Bmc8NEyf$T+GfE9?cD@BlykK~fJrqB;?l65 z+L&1kK0SzFQ~ScX_km6)UcA?U0a>j6X|;j&N41w4)@fgo&%$d)u(=(mYAmoj@JMp+!YR7I1se}1yB zhSv0;`l;0cA=+cFYW|qX&)ECrZ#3aN81d&PFHA-Rz@e?_%Dt!+C*1vWZ-Vu>YhCLy z-tHQ^&yVElWCFKKEZR4d_;jVwPjt0W;>>YYQ}xzwv0w9va(vAUBO+_uipaBMeXoSc zu~G`Jz@}3-h-gh5UV!ty=du!w^<7w${TUMbdd{Fo#oO{x8L=I9%fC6&_=vye|L zqsMp;^VQ}@pn#*Jw$A!1bZLO-TW>{2%x}n2u;%f)wy};k#ZnJSKbl=C%p6CY7Eq4d zd13hGn%Bv17MsVw1ihsk0RN2~^h#Wu?2Lpp@=&3^UK`#5+Pw-t9`uBAXzj}ED_uUQ zi_#yg={S9wZbg7e*q|M)fc~NkNL)-7&oa5f<%QkMB)&+nBN|UD*Gu~vmIf8?UKv;_ zF|wr2;$inSu0qP=ux%!B$e*A1r~z;r^bj~Hfy0d~NvFn|)izQ?aNa=AGcC5)!tjN; z%WMqcdjdz>T^-*LcjtQNJAn}fET5gY1vy^j&D^`!d@C^dd@aoX`%YMNY>ea@*vK%l zA*vly2ns@HPY={1nC3JjNM?kTS`CeUM5useSy}%w4^g9~@K)-xcJb#SK^G)ql(^2H zc;|--^|pzUvZ-c<6Q1xcolZ}Q?1qwKs(_RCJNJ@xu^Cnth;kah1BB@+NhgRCCM0z* zH5MNWvmAY_0#5cTCMiviiI%(=9A%7Yeyy=ex?wiM2a`*MW^6vDd^-3kzZFhWimL5F zsuE}MSyPo!2fPv*V!X_7rfI1s3#TR5(Af?KLoOv@7Fpkg?`DWtwn6wiAbboPs(wdo znS-zHPssoY;czN@L`6trzJS-cNpuZ7+`32<&f#jUPrP3~^*XJzd!1b0`PQB>=H1w> zOXryt3|~cN_%nY78D<}7>N$HA=*(N6l8*ud>|l~(vAtL8^;Te0?ra*jGaIf=s zORD8U)(bW9qfKX@AY*+XpD=)n@+(e~fOB}o57aAr9?1-K{aCI$Q<`{I=>40F=bdLn-BNdd z@U50MP80!k^kQe@nndaTZ+81r@@@^Dmq~YIcX=^9lWr{K@aPeDD_!%Xy8>PA44YcP z-cF7Hdz!W<4}MB*q#=T9{F#3s{pqcT!CtOp$q+W!1CZLozjv;D;BUCNdi%!=xFfic z)oZ|HKjOSD!5?R?WO54oWMu@FiHKHa>|lr4dNmo5#-?Psyhf&$js(A!Rmf#GATup}End=Nm#U0~eB~D9 zdUU4I%_;;W9o8Dd?SL}D$)^)R>((H@>s9S5udx0b3SO83cXfkNtc#)Ga&dr@vrORZ z(RZ`S4;bb!rwjo|Ap^-^WNN{s$$PL70URoXFfrBHAg-p3LvR%}f1C%*5$>pjejtBd zbQQHZ-K~;vupYmr(lN>rLq`E_+)kgZtup&a{U6hK61@W$@7DWA=l4R23xhGfPgxNFwkhJMvM=AwuSJjpLyH zbBRx56z*`iexGb^)%nL+K@ZqEFyr3;(HY1hF zbuRWsQjUZhVu+FpSBI|-tMulk@nkvO z3VPdqK>l{BbHw_IaAV>YMKF@gOOYXtmrf=5;zZ+BXG0X(BV`RsKv3tLRl?GiobC@j z;q|YlMlAX6U1kyFI-3eDd*(QQUX$g@cGHv?K6gr%B)+ngg^PT=X+wJBV?0B9Kp4HpgWKkvdsor`1HxlASi75;<-?U=w_h@)F03MkaL8VTgb5xleEHr*2R-S5FG?C+wQnN|zDi7_!;Q9SM)M3d!&U z&eh%6jvwgE4v%dxSn#NK(7QpN&0ds`0_7yYD&>x`i)v&TX3M zZO++R-Hn=QMBQohK|P^s&98+)b1Sf$zAMsF0#_Nx7to|FAbjCDdsgfhd8{yOTh^pI z?FW3a6vbUq%C+wf;g0r%i0(E;& zoAneXtk6r(8pwwWVDHzR?4CO9{c8Hjld%X%nGGAL&AwD9W-dRZiNf=>9!He|aT1sF zF2}8szlkF#Jb4Z1Ur`jDNqY37Z%|Y$-EyKb<%4Z~%H}nNl-;un*YV!@(HL9!@I`7L zytp$0dApjM$Py$4JXIg(s;#nluu@sR-bz}wf;o##R;=s!IneigN!T6gp=PIg*2Wvk)o(@EDMD7dGaKa6fn z;V-g;E@8M(A~!6|9d|IBNxkWY0sSh|L5xuG0QFD~TlvNhc+nWWLkqBBgQc-wO_7yr zm66pT(P^7~TDbunR8Spgf*wYQRJi$_fbgT-aQ)D9n)Fta*!So-P+Y>{X`lPqhxyt&aXdHrJ{=#_EtzO&GzT(!{ zf}ok9!x5s1w?8Pn)shp9UrZbZz?}aNq(vHTk075wfx}#ncAqx}FH44!@;BqaZ@*AG zG2F6wRp%TDm6O*ZbF3}ik5)P)ek}KSKYHPZGh00IV)Rwf{g>VEi3e~RgD?D|_JXVs zCiHDtVUor~EvOLgnTNC`d@P?5;)3p*Lww#%Uiej~dvMv~fX)A*>&?TV?!y1^5kiXW zyHONvmdM@=T99NZS&DfIDY6wAHD;7#H@1?*D2b9}FJZFF9pK3FPo{Z5Be1&W5*gg;6=igZ5;^T`SXSr}GlOadj1l-sc! zrM88g zop~e3zhYqa+;HrnuK|g`0K6)|0sLt;*6F`bxwc=BJg7OkCdyB9$P-ourqPpTK%MeD z%#l}D>wgpp@?ge{<~MCK&hFKmHjR75BF_Tv6L^$nT|VmyJaf~tVC8pg)3JQJ2@})9 zo|UtS_z1nFbK&8W`FQ+OWoqmJo!}yp4`YdRbM8N`WO?^A|HqXrz!i}vyk{R|{>zjk zNFwaUu%2wf-+zM;_--|#lAwm3cQ%l`XV{kV%GhHS!p*BYOi!}8!gfejz-}W)@XG?3 zr4V}jHQ!e=J+FHPZe;9Qx>3iGq;4tVx%Z84TDFYQ_fgo@H3t3CJ)IxNQV>;$^#`o$ zI<9@)+^vi@W(k%NFiV#P-B#l!vCRE7g+0@K`_50BeY56kV^6FK--Is~1eYRAnM4>& z(@PpU0y_Yb>Av)=?Q!r70%j$QFf1?~QnX-5$8JXewL; z>8kUDJ!|m6Y0@`u)Qm}TLqP%1Gph?_EW46w5NQJjy0b1%>55*M(uh#B49d74ehVtd zkb7ZyxXwIcrHUn_dFNmBbjP}`U}bD zG^AiX8*%c>B^?mkIo6HqXQC3Hnz#bX$;7a4d^wySJ`u&@_z6=⪙f(!m}v{^WPv5 zwiNMfvByE$Pgpj)k0`ajdfu)obWyM2fl*!P$)L$Dh75r&$GAyL`+zKQqFoWy8CUqC zA7AA478!G~S8MUY4ZT&jvWm}U#$(Sm#ZGAo-!ad_OyuFomNH!6Ej03ZW;+4*aTM$c#u}!3E;c zCDa3}a5Bw=)VxUXY6v@xZG;6;4Z32~XqzjT;Hky24ZY4IYY1vNGd}<`I6vW1Kw5M) zrbI-SG7lmZk}b&}p9NaldOWj>4EEdUTx+qTS#cL1uxbM|FU50Lxsork_-6B6kTdo7 zabac9$V|h26yn;Oxld))>(x)2lMbg)&5KB!99+AJx}??SyZC(V(TtS^;Sh@AI}Kr(CEx2HXpefl7;ru- z{0hJvb#cUEgy} zTPFQ+Le`b$geqf~JuEM?=t%d^Zyftzk#*g-s9M-)S6}?Dz+AUPA8cz_&P{6m_EOZwfLThicBN zF|aQCNhf(2n1LZ27fgs|&(7o~5;$nu-vcnaXcszRRi}(6L+JPH)`Vx9{q-!!|PUR)xjcwCNPj1Hh9ASv0VKhM!?jA_PCUp?^1NAJiqnTlpo1`i zg*`8QiIyWdvEB;u_dRlF*ph`=d9oom@t1bH4;#RtzK<6hfVAd0>CZ-g5IK^~uX0Tb zc?54ziACh>$umi7PYlh{Xba$Z#bEnVpcSWc(-b$&Y&E+xA7LvR&OO}k{yb~uot!EA z^=!$+xsg~tVYUy@lg`ZMm0HcF1NE0Jtsx`fo%y$e)D>V7vhqADtTNAcmLXDo*AQAh zyBb34CBMyI+;djeqXR1wG!sPL>IOj_$MQ_lfk;;2VvKPBk?c$4k-yIQS=r?=l}+nq zmayrvqCu2RSYLcLIm>fzg2qwI@n=vSYyB5&PR*%@vqe!vC$TOQRCADKiFLXemxkW? zj}uhb@WnBk>XOuZ`uKM)mVsf#v&g~*$%&Pv|}Iwtpn1au@~Qm?P- zS84#-YN)1#cch|y4F7Vm`TiPaxQl8>^QHTtMEYuE8MfWM4dZ)$Dp$N%y};`JQncz8 zedd|s^oY4^w!nKoS;{MYIgKp0=TyRbhS~K->FUDsO2BU@4sNcjFTNc(o zz4ZrDegLG8!$)o!Mi~~CFkhiQY>r!d6TTs2CrfLDXn2sQnGM4Ba8gy8phvbqJ>8h0 zQ`(zF5r6j)dH;Lhp6jh%f$CjehdiF$v{l~trLtvlIw z;LEWL;TS3~<~#~T=37#f8@jma-yw5N%jhRF@o(o+oi5~x)!dybr4~2!G#wvw3<@6~ zF*<4qK>;@p*BB5`u$`FNdf*{xjzEi==KRL+0xu@_t)THk#XV0Iy4Ns!^Nk-{KaV~r zRJM9N)*ExuOokWHXBB}EG1Q^N)ILM+Cu1YE;9|%Jw!8aZyiE)dThHjetkR_S`o`J% zBZq2r72;pl-08(k;NxkleNn*8ESG=i!lC0LhhC=twbH_R5gjZg5=R_!uq8^Zgxebt?;Dq-;vD1uj+75IrNgfRZ5H}F(7_;NASdTNAE zky-r9Qa7>Lqn`SSeFYy|8%2^F4xdrKEo|@kY^2(lY0f^mY|X2FdX5Lt8fu83N|e*q zy~y}Wh+*Moq8K&?QzO9!+12(qopCi9gPtjaSzQZ`+=#gG`7F+~&6_K}=uYYefgIo0V z)}9G7CG5hyN=3+c08T5hWKTWUH9wBIq4(wUakjso+&C(t5HC@9E&*WzLulyu3=Pn# zVP!6I=R|`2#{Gt08Mp1po@J+a&m9)Q2w?ibc5iyHWnDqhfL6s$MaQybT^&HFEMVjL zNIZ%>j4=2r@HQ;3E^FG1EUIA;aSEuY0CX_IKJAGhMgSnLVADg4IEcaU87qs zToB4L8Sz*0xOb0ON%{y&0aud6u5{=aA)|ijKg|C3RpwsZ7~C<7~!@*Z@*2o`|KWlc8{jYKBV%;Bc}D*$^23}XGt3o z6`!&Muq}wC+$qzcUOEsDsNUaM0#}-x!W@tzb>*{xzPk`tJF!0fnXb+p{OY@C%<)kV z<-&8b=uZ3?qV)@2+Tu8JpzeLroVm=H<+Re?Cl$#X$FO?%$DFNO6=J}NWEjqxV_gc# zfPcnqbikq^Q>=Y+$8tR7r5u*B%IG&fCK&qOnhAM#-ZokCHhO{bHJCLGkFGrPke42{ zX|G3-H&3G1@7D{|{aF_I_)))*(jC?By3fHe53U_!lEbP4TG37rkD&p2{-%8wrVPgr zji`ke3&t&=PQ06S**8$uHe!S7uRK%bO+`AU*=1yOyGQGADsd!-o<&D?pe!ac;S*ov zrJI?2KvjSJF^>aJX5cu5K$*FXNqg1~a8svj!HJvlKxupZfN}%`LwI9o%#bfpQB6uZ&=GEIX348siP( zf0?H)9Df_Cxbnkv3;3*SZlODIqgM3knnTR=DpNAf4xryS>qo!zZh~0){0EX8O2%BpclWDl#cKOrsy8H(_ zaoS=QhbuoNWbw$E?Z<1tCo*uKf`EPdG`b7VyHMp#x2ILA#g1!{skq?0-{J_#{ZG!| zD^Fj$nUK-wvGa^o$*&d}g^$Krg5!z8BCG<;@(aJ%gZJ`4Fx4lt7z$nj!rBJvYeaiz z`czB*Kz7gG8@4Rn=uMA#_xh1il(eJZaWgxP8*pTjS0uCQgy5dvzyin9bc7%UkIW{= zVIKvi7kHQQG2$F=XBVZ-(2pd&@>uy$@3<;G>Mh$g*kXQ<}hu5Y7aoq zgD^;9@tKpYnzmBo42?mlmiup0J#vtDttsu(^Ov7jT{IWf*~9bv?e&Cnez>o8=T(0~ z_?-knwgp`liE}RMJqkOCJU30Z{T$yvEcR#_SV6eYNJYpNab~J;E^rEiAf(IqjSj8X zd4K-^f$aaVzQIND6WIu|&D0OpK>{ro$fRQUBZj7IzrKA0-{rSloG~c^g;S;p_))7?+!=@|H4s{df2x*%8%3}`YqnU!CNTspoCjh_nYn6fW3>D4 zSg=mq7^p)2=5?sl_E^~qv$#t9Q*f|7w#Q2T%k(7nXZBdweMa=Czp%o~>I842Pp24V zgVg~<2r)C@m4Ihz|52g&cQAPqk0s?PtJk55bbTxl(VE&~wWP-WEcHtP>JMLjVO8>q z#Rblc=Q$OQN8JD73wxyhMaDdvEOYiu5MZKa#{jx*UP{@d{=9+4~#%lOicf|@y^ii`1FM?7Fwgu6 zh60(RF*x#7!6DNLiH5PewPP;pr#L#tU9z@`XIuZAvL0;y^nFgwUeAzq9Etj!l9qkqF znIz73=iW~jc~icxp*h?8=u|tYuX8dm4-PyV85PIxC{-%fQl!y zO}ZN33fUC6)xaoN54!IBxNgrHE^b`qGno*J;s~BRGUjUevy|2#fA6j0=U^$Na`UOg zmqnbO-h;1glowR!DG&lU(e|v(SFg?>*gGAiN$Fzow@qLoaI#hQ6KWBEAbc!C6uJ*4 zKgzErP5`Z{U-fG(3tpWHb86Fh{wmk`gOuprUHVI-@%cQ9aJnOHm9-04O1O#zYM)e#nbRT8(`&t@%@=t~yvyQ*->SDmll!GX18!m;6-@|g{APj`s< zf}@ECY4Zgj=N`cgECl=U|7^lwC^=d>_k#$-uDB5p;X`*m$%e0T0~9f^ELMQ^{iE%NQG9u55qv7hwE1F0wYkiNUfT25p848qL50yODjbY#cbH6}I*bw1{s z2IAJEHQLT48Ry$AzSs9g4&QKy4o(k>XcLPHNa7)o7z&>GpCNCvZJSMeM zC(`5Y44d}!UewVMb}hgE#95?3a3mOfO+%i0Bf@_4GqE6 zdcZ+Q#&G)NG6&Ll>H7TQ{gPV*9L?FhIYHJxw>`4kzi<6}m&MBl^Ip7XBR z%L3R;c0q`PtO9&fwHMK2p@3uGW=j8TEv_Cx|?V5 zW_VBt8)c3@iQ~E;vO_(cCZf9@+Zq9NGjJprCV21ijmLi4p!U< zDJtG=s&YJG?gH_f!d--0W(tRlxBoL|f{oEb$&jCbgYcd6h+T`oB3do4+T(qY_J$y( zS|fNW&&AXqBSSL|2=B{^LOl;kyS&<=V%4fR?4~$#?^rGg4j8`>25M30S46BA#%GH5 zu4n9|dh4_L%~ab)uAWjfRr1)I_%!fZg4tv!?29^(aG2#6(g#L>(zFi&Wdt+J%B)6G zS$xfuQw{JUwa7J0Bw_DVc#zLODAHQMMV3?Jhf$pXFrvK5f| zbcA4VdpaH>lW%-*EjW(j6QjWG0@J=a>yS>5T(8|t51HceepIMfny*}Fa)h*KbC zfjpJ;{(JHG@kW2oJQA`(`q-o6-nLk}^$d2nN2*qu=Io zV>6HB(XXOd6xc;jSwt`gVt&Syn)iM3G+didr4MeX{_2uRnwih9brnGT@sc0c1bt-gJ~P@4qIJv0>_ zp*O@ZxP=#5*VwcC1ogEo@3OOtLYpt|Grd%|2;mAw306Ul1XZ^K;l7Q1o>eV4HN-YumKS9i9|SdgoscAYUlZ@I6{|eW(-Fj$6l}1az*~Sp3v#>;e9N7qJS*kID`V z=}U&o)h&CkK1?R$y1e>){tGBY_&`48m6{ihF{QCPYx`lmj0F_`X3 zYi`Vh_Lg;MS{9LSq`xt%d~-aYsQMG;)D&7Ji z0jtTxJ2=@=ZHN<)`bY^$Zvd62K_TY4EocO4Hwdrn5}9>ESre+e5|nzeBSkY^)HD~# zk&eXnOuw;bwa}b#1M;&7ie{~T^ApCI+}YvIutGevh z?BvoAU+((|e*;5Pj%cvjjf^U5i+ezl zcpSLQOS{}_(UXh!Vwz0WnJLD-IB`UBO#kH61K7geV=sHw+lr@~u)du@v5Ti2UPr@+msz|8WHsst zGdp#%FwVZ|2W|MI_DS(0i!zNt_dSwtr&EM^o$rNB!zT2X^kiTDVB!GpBN3dyR0ni6!J!4<`BC0Ev1!{o#J1IKO zhxCuee$*HYgcbCJl*@ftRczAn@SB}q+sNX(nK!(2pwlhZHJMFASfF&0&PU^sxcb8X zfE!w6^?U+VpFC?+6-nAiT;ZeFXU*N*aqcj@tTBw&lmge1u_;I1o-y9}ALl zRX}x9dGr=@5swU9+v=|HFV|4Q=vcAE4aWg7iIM9gxc>m6cl_zc$*a?5G%2|HCmbfZlG;caQ*}S#=e*J%WfW?g~w}I`$4)fyA zYXk8JU(w|G*>yHS{Y%=H)?Rw2lR^?|ZU~b5fuLcoTh}>$3#hJ4M{;GGCTsf7e zW$#=2WZN1CwCFYw2e#Mb?=mRg+>B7}39pL6ZnbO)!>+Y}Y@2N!VAm7ZwuL8bK+^EL zWYhnwC3uc>Kk%=J;180)w3%({Le*#fJ_jfWN|V>vrXXieko3&)v+Bpu*S@hy?dbFR z*{j#2BaoYwy=e0b#0(giw(G%C0PCd3PZL&pV2`oS@9;Q*O#tsV?F|~2J9(3%H@0qc zabk7WdKPu7n=!&N(!o3!&p7ex`a$O8M;>Lr%{#hz3%-itHaE`bSq@$2Q0xyqWuxpDgKts>^%teHBY1JGi;Y*M-6^GIO*FhbJ-Enq!!q=vG1rPYmPm zaBPG{f7zIwVqclA?#Qvar!5H^a(Jip!a-jbS}l2=h---RBIVZN!tuMj1Jd1UN-Ag% zH1Nsxk5oJ!V6}Az?wUQcKAU|YHWo6A%TJnvKSeccMsZHhJ&4}Z=liJGG*%>`KKDL^ z#zO_IIv$}|-*CVd#}JvDX}}1wgc&-R$C=tCeQF2$Kdx0*W<=+=rV57?&jkL=H=%s5 z5LSutXc4{s2|h81h`t}e&`bXoB(L5deRJzZ#rxmmvVAAK9!d|9KAxDzae zRnc~l3g3))E>hH3d)k?4pwo00qVL$nNuIDOgUPn0KE^4c;BH#Y%z1Ku#gR`(R~=ss zzc>5l5bFuyFbRcVS-Ud8P2_tO^DP>}>ViW+w;Y5KdASa^i}nWsF0H19_WoCzi5=oi z;}e^Hbp*qn&Ys)5bJBykYwd&gaxVYWD{SeaDV%mWievE|q8sHtM5z&R(#W!!qqKxu zFQAb*LbvXxd@g2=E*NuY|6&@=BHrN2@QZ;Hn86qjBS2A{YB+9lM#~OB3y_Q1Sv&@H06UuACbw%eT?Hcp&A7*^wA%SCv>Y~ z-f7XX`}RN0Hq3M7Pq5nk^{Tt0Ib^Ccj_wO|*{ zYXv%!@Wy!qIUd`R-lMm%PpV*N>JjtD>s|#EoItKdCFtiucu5}Kc^^!>F}EZ0z;RXd z+XTlo2Q@|y!PFkD5yaG*1uk>XAw*tLWCsX>PQd}@r5R|Fg_m;1E472yudPn=lE==D z?|~rM+dzV zTiZ?OYQ^FquzL>Dc<2@k?}3_qQdPkdAT0g65#@X)ALabkF?@82A9`qau<58~Ri16* z^P;2X9|u5hV-QpTtUiOD&D6Uvac@DQYKE3X)SFr9m;FiSC}wVs2VQC<-M9t2cS|Zp zoh!*mfpc1ID4$4(2F+IxW$a9?o7kuq7hVwwLs((~C|%AHr0r*E?rDzkO(3Go^P2xa z44VXpCT~B|gX~NEh_^DTEer)lvaq{wk0Ta0C$X1kZL*htC+=5k$gsP70>W)=xBz1B z1dWa?EI$O7pHjpSyJ1}fN+hczLY9ght=zEqxWi)ot z<|S$#II#hyVh+QAr5M$+DHGAIe;))`pF6DmHBK{4WD4@~(}aAAOkS;G`}wd~AGyDB zBuMHXo!o6m@0~XpYho(J{@RX6X2Wmzg2Nw(BaqQ_puhHxr;Ih>SAOVjM-N+Xi&`vv zUPNyj*9*&b%xPB4Akr03+u_XMwQA*cm!QXw^Ns=$v7Y1A(yNyQPuXF9?b}H`)QiNq(eqymNN7%3p7$A(71Y)<~(aU>CRm9V%t z?HaKOul~kDfW&3JC6fMQ{%L{Od$F!r^Os=*^6-9TO9CofoLa2z4}j+ zIF|*OaDDI_VEPh>Bk0_|N2rpNnQo|=zYDPaqkkf+NZ*IexE^fzX+a>KAvkd90zp0I zXU_VNq?nWBdx@XfI)Q37eC3CpQV6jxa9dv(kmp%etlwcgs>fNdb4B6*=qR9S5S(Vf z!?I4L$gt{$m02$f=11WZZ?qBesti*ioOTh%h302Cm0t0}Et)g#-Y;L7Ev$qeQ{a-# zk83O%6R*BV9bm?TurV~c>wZN&G)jCUbzG!hxjb`D#$dYidDZa`Mc2>hLG=$c-(Sa; zHiPtR4+FN|UJ%v*Q#+0H+f`X zUL?be@chltAbU^^n4f^31S<7xgP0p`=t!CWCSG|1M}pGMX_;1bRCROSI=Xkvr^5eN zvvk@k%UUP(j)<$w9O~zhhe{Z2|5X7Hol^J=6g{9R>D1yz!X^W;*s^j8A`GoKOGRA6 zHjeKanCf1S^5$U_KQmh?&ic)ttuDKRN0ej5o*|-4oB<{&w`H2H4)p^KLC%y6unMcM zePJKD9w*Qiccgx6UdFkoLC>M0@kC#`XgDMVa@6eIR&EyZQFEjId7WYJ#mrZ({>fsE zAKJ8RA!Y`S<~&?NwR1;);XzbDtsX-Wz|JN!46O#@fbNpd-_MP!a(+!170LIKzwv4^ z!}iK8#qf{IJ~EP{zrqhFa=(nr8N*%!&tx+b-U3hraS*k7HIfYFpM~DbCvbeXc5gM5 zFV^e}@jsdxbVzEVSgAz+$Uowjcp#vUM@J^G#6B&o0?*$Vg0gTQ=G3C~O&7t%Nuw9_l)KRawG(G4JKw$OdRrfuubt}^^y_T$`D{}2Nk+ks?DPHkFj#6As)hBB z*=B@se<&=F`8d!w5)_)^nDo9#%B?4a!?_E!I?g`m^(7jtc`MzbjGXQW_CGY7H}TdDmIO<4q$BiD8syRL{-uZ)BeEJ%0;j^3Y z;e6M2g(uF7`>&uMq5BafYGD{}tD)rv{BG2}id1a`ZnOTw!+TqE zCawMaTFOx}0)4JHBR^CnO2cXI6zZt>V z9~J~2RBZVMS0{nnXGA~zms%jmt4aUgc{T5)%c`*X&SLQ(`T$~*oc!Vkxn1?BTdOXU zIF}2maF`u^1zl-^=|NTA&_#8jU$74!uEak*Cd$!DtGAZ+jjd9F8mwI0M`B-wJ#7)|l~DnPmy1wkEzHIEvJX&m6SEYK|b;!GuB zu4wqX+}M}IrAy6qW z_b#3Tz^ZUt{Du3=yC;)VIqLlrO(r0stok@Q0MLp;} z$hg=~Umc{u*@ue-FZcp}7p=6mwse{kr(a@g2A513;>uJT`05?D1%X`J3#=WBkPzwH zL^#+${7#h59 z4ivR7r-~fs$`s${=BOQ@#}(Fy_5nPF!LO<9VD;fkn(NXSz|_aRlleyL4itD z7DBXCBL(mW?ygY(&?b8?zEGbi2fI8vc9WCZ;`q&K>p5*^N#L;AL_D-I8gCrkK)W_! zM{@^(uj8`L7aaz8BG%fx)jjpgx`ut%1rHv;c70CeY)_*u1$`TBx4KV)doNm?`GIkT z#srNk^;cOD@dAT19s4goPx$U>oAQ!&|8Vc3;efa=Lr0@YDjQC)%M!HE_AAE(N-dym z&fO*|GtZ+Yz~(G`26saYcTM2GS+Mr7*VoAG$$KSx-sZe7 zQNl`JwNyM@I<-F~99l2b%no4Oz&{p0CC$3U|tB2oAgyncvpY#hFhccjhpc`?rcwhKPz7?5TLc&X+ zG?>p&I>g#Q6|#L~swIe+E+~DjK58zxnq6i#vh?zuhOl0O7TSU?IF2l#$^y|xpkb-b zKhOt}tCP8P&R2*@v~dHt*j%$?A4=$c#VtsrGrY5W>9LShGXrJf-!ubZo}};A1&APV zKBTs{Cw0MkmHvFQ32oe|4}AYzH#$Xt#XTE%)%3Tzj}qCyBVgKk_?*fPwIUOqt>>R5 zp$ZeW=_+PyOaUYGfG`I|ZR=##TNt6vz=o=O%A*yl*EJ>=0wND~>~r6>_5=p9fDL|7 zRs30RRiD$ta&s)sK+aHAf|>1C$!Oz_LnV*@K-yF`_24S=^T2B<6r*d(D8hb3|DHFe zsu)4P!~nb#;06z!z5Pm&c|JsAgXi3yl%trw=1$EOfiX61@S^&cn>I6g>}{=3{20?F z34*+Nm-|5}j{N{L|7W(?qElT<*Jr|31U#Koc4&I=0eG`nxr4SD=zr+3jdkmQbT;K0 z?!3)Qt`q;D!XBCq{?BWHYch7o1Tz&If)Bkn3l38!DsS~A^G83M3*y%ACM9W|Fq@`Z zutouRUt=%SFJSH6%`D!UMnU+Om`uSIy&P@7m#jJ11*=v)wu2PF9-G79I2I@mzJj2q zRdt~XlYnZ)zf`k1+}ji8&JSJJpt6KUa<<*Gx_1G$3htO=In|pmn zVnah79VL=BY{++DHvK7%>vW0i_QZ1%JtC5aXwm@{No?0Z^q^Oz1M~QaUXYGMZNV-XMEB4Dm6Ix`zB{Mx}Lo| zG}f9&=R>A}I0i zn7IXr&4J^iXcozHGu@DI3}zDvs)9&m37UvgPLDkH&-c*dkH6`K%wXO8k)D}vbtDC8KCD=M?MU#vDL29%;5z}ZDwdSLM-;sGOM(3Oduqw*FdIuRUC6X# zCD z{bCzi@Z_>JVVF*>qdla10Ja|AM@d~cb=Q|i`zTx=qw$_Mz4{O|@cf@#zVf4(JW*50HErVlq?#iW);0N`+Q2 zU$Laoy$Gl(>k#T>b??Ex0~FsF_n)PBskD!;E1vN!ylF?mZUrKqbDQKUMMoUUv;cE<@zPEzV*($5`cNY&$patcJvx2^Sm<~ zBmbUz)9oV@4Qm!;P_~zV4YAC4=q3ruqc|mZQ+yi^&WHS9e;@LM{XO{5+mkX>hnY%Y zPv>8t+J?HBoAdKV+b^Tdu0#XOiFBv~hZ1mIAVub{P*CKVk~<906<{*3+PJbM$q%Y7 z0HgnT`(J>M=V{e_L*ETwZTcUnaPb9iKTB)~GA^UgyeiAl-3O|{MnLDT&tgC8-@m8| zl@705GF&40@;oFkraxG7ooyAL-;Krv*fQgV?@pP%oLP!51E?xl{21UR8K|&M+%FXY z9`!;40@x8MHGdHfz;ceZH4dPlAyA3_@?$Uie8U3**Rvc=Ak21*s{e`r8wJ%q)dRgO z0DypswsnPrtDYoWfeq;$FO~j4-fd3_hyfnh`QXmGrGf01G^YIb%KzW&PTwZZY-p^0 z-{jHFq07QoTVY>oe$US%4uZ|*Tje?d=Kz1`S2?~zougDVf+kKvPc|+{ICa&xCHfYc zOfT(|KHD4@J7rhP680Lb(P0h2c`?Xv(CZ zI-EES=b&2dbRl{2fk9haabjt_VzeH=_TZ1f3BUJN#)y{$vb9VBoC@qmkEW0%-_Ux@ zx2%I8>~$9!%24WEUQ$KrQNSS^DoZQd-B2uL9-g+Cdk5`2(`uE@9}QtX2CM}8Au-V9&Ib*rF&e&Eh?ah#!olVI z_ZyU~GdGUfwI~}vNMh>`WDjjwbGk+A`8nE^ukgto`ai2)n20(siGVZ%Fu+qTL+#Z6dAJ%cXy*E zUS>_#_|hnJTQ4Xm)~QDkabaRnj%50zeS_J4R&)3A?ZAACYFHg}SV*zzaVhNf-t!&~ zzgkOS+gY)kZPie6^BY`cMoxt;tH)M4|J7U+{{k2L zQ-VVsd@A-o%!?c{0hqUqNN-z3aHGv#hy?Z_mxUDs9rvs_TypMxi8ka8WV*EKgumjD zd8N6Gu&g^a>qEx>E3)Nn)Fn`IfE5tj#+;hXEahls7_~(jvW0 znR1^XzwbfQUo7M&QyS+QNjTnS>MP;4K==~t`}F4EL+ln|(>?wROZDl`;C$v3=r<+s zI(@ouBlV;HM%KAEAybUsoNA3QQTapOdic^427(LoWnZCg&(A6!{;E8mm5r2lA1p~zP^12_M~51I$rwW)crHyzjr9*xp2kA3v{*pA+FWO`Kn zmdxI(@n)Qv$C1C1yq2IR?rsxW*o7NjCc(BVb=Nu=>XDYkuguxdd|5(>lID{I_~$q7 zs45=*q9FXC-mlY0vCo?4_ZczD00XW#5f7hcUmb5_827L=v}rALD;-b10tE#ivjm-f z;HMPj0i+iDzX1)MyKD=+3X_1vQEfQC4qrC2m`f5Ap_$D=hn~UsdbPfwM|htYA14sZ z{5aK{hLU+s-bFY{*+Y@{1DB1UY4{=?#)o!u)KR72 z8Wh}Pv@d4eZcC0_Pvs$7)nP}HCp{Lqa|pC(Um4Wp-lJLt*M}$PlzXp5x2n8~td)#3 z`*2xw)afkO498uUsp+hlJ8TYfkf+{OPZUPr$mUR43;IQr5P4>yjXX{CxovonsJ7>7 z+=c$}&L!kxPhg1n@sYQ|_Wn^pYU9@-N=P+^Xcvojh`x^|!Q!1F;Y5*w-)cn3x5v53 z0X0X+*x0pVd%MqHqM@aZ%hkuGM`Kcl#1Gtn;<-(VUmh8bbzZwFzWz-`e>ny#af?CUY0XCb5rS92*VN zhVqwT2@7!Q|>WlyO)P|j`8h+>3vbI@wSbIB~tFYCI6WPgCYMwK%ri+ zFLD_on8{}mBIJQAmI|0@xtg?#4WNf;?yzIszREFlG2&2UOI)#fmhXOI-76ykqA3cDDvq{?V3K+8M*3#Xe}?gqlXPO z&P2DzBF1B7YFARc^gm}M&3c#_^Z-n)GE9aw1{czT$~({F_QIqXw&d#U*-At_inFjL zs?hi*eZ#5ry`N}SfcY`yrI8IGSwK?q>3!R2XT&EonqSo8suHO2kSeRMtv zCqLg&Fu$RlxHxjVq&P2ruZ_UZs}-q|*Xy)~Io1z|67(=t)tUokJMEwi_zZ}CwC{^A z^tJ)H2i*s3(JP?OE02w(@H^Il^?B15_;G|wDP-faaR$L0J7s(0AI|E1*RXL?)j$p_Z%HVli+ZqB^7o9_k3T|NU!a%ri(1%TL_Ppv3w zg-(Eym4C-frMES^+yq0{vl0AX;u*hJ!T0Q;z#wVc2rP98T2<}e4@lMNKrE}}IvGy= z&lrHN-jnPx+Wx*ZAK19r47vCp8Ex2Yp2`2^10+zi_i)$-ph(_xdyZhXueT?${U7do z6hMIe=AF+y@`aGY$JCQ^>%UYr4IU?qZ{&6y-n3j*`NnvE5@tsi4R(jC-i`aR(d-E+ zLZo5JgW%-5xCLOUysi@sUyI(tpO1YH2YevZgm~jA zCVN)Ae8WaH{iuDSh3s2o``NR8C9s}i6&@+zHKOD$dJvamH=w13aZ25oiRXB3^s$>O zo_A!dBpY6?|66l-m00=1!MXNCFl1#f)`4YB&SUZik?2? zk~fz7&AFONy$3K!7gGzz+$tP&AzcQUq%(EETZe~Uad93-*0@)CU+)!E@;#~(grB`U zZqf8j(c5N<(K_S};wC4+zi5^s4GZXcKvrWYZG|`G2tFyZw5s3I&JI{`TD?$S=~hv% zG3Cnr%1HOp!%HERGOrxnmu(Vg%TY%P>~m=;7#jbQD&l{&n*ST^cc zON^6mHHbQJ=i{W~l5&!5?Ke=rR7z4S{Ws^D<&_hgz^%n~puArVGl9jGp4aE8ca|ZE z7b!RT3Lh&BJK>e@bwzD2eoJuaK+-QsJO5|xVNkV?N7hEDxy%nJ4!S5x{3mQb>O5r! z(xZ0R@Ka+D+WSW3O6IN0Dg$ld@+OXBrn~%KzTEwShGFe-BTwhBl~V#mBC>3cDhMs< ztx-Uk4j5X!2BE*ZQ=f?h^U2m)kxR}f@VpvHFjMH}NvsI3fgcA~27!l6Tzm-1gDA*4 zfe1#XQlHQsxDp9ZFeS^_C3l(yMTQg+_A!8|SodPzbM4frTQiH#`tOIAp6!BImzsSE>|QN7Kk!4OlXx>GhnQLdAiC}9+eatW~~ zkS-XhW9>EEQBb-l>J^kb{`~SJFLBj8W#_))=%LHsm>D+Vg|T>dENy>KJ${Hp8c(H| zHp;`non>TF;t4Tnq<*-$VOb1T$&xW`!4&Vaa~OIE*W9VF^3`04`Ty1S=HXDkZ{PSJ zjWuLnM^Qw!vXpI9pDc+{)+j2KWG~rb#*%#tp~#kf&pI;pT_S5@vJTm02%}kguF>cF z-1q%Ee#dh>|2%&<>PYi`pL1R3^?IGxxh9F zTk4Q`PIBDmC*B*|@2tCRmvO#Fc_E0rzI(bUg&cXd`BBD1Ukgl7$tCDF;2!rGCVR^H zv6?SoD(tJ<`gzOspSq%v7Cl{RZbEKZ4`Lmk6xBiQH{fvHBzDwXb0;E3Qxd-)NRjaM zAaE9WQ5Id)t?ahGbQxr=P)@&do^o@8M2`%v-6y)8LWh;nB>K6T+-(YgExGAX8^@)rhvp z9|EE2^ef$h&%H!}t`c6JZD;1$IK8rbFWT~?E1@_*LotEc+zPiJ-@mgrIrfjG(n)~w z-pYu_aRA(xbW;9hf&UHN-o+UW8mfnU0R9F*JU|M-?f@0a2LO~`-`&tjp|a0^I0j(% z5Y?pr_a9*10FnO-x@Q3YXs90khqA+m{*Q}AV*zbr*Ut?#)U?xWO=IHsV<@&Yv!asi z^1bM~9jK0)+q&8wrN*}ZwjcEtLZ!K<|8gU&LlsA*C>JVOm8lLnnHg9 zlY@HSkOfHyG1cCOBnsGsDpKS5ud#rd|7FH(LMULUF?h#+qpT&J|L`Mp33S{E`U8>F zCqx79j1yoRL$lpg*p{iE*gQ}EJc=F-T!*%Dp*A%pZrD4Km@k|TKFaSX!uN-qB2E;D z@f`QJctbdPB7JNn3ahWl7M-VL&pi{j}h?T}@qG#y=k;ruS3=-BUDT z&)&@J6YY_Fs-Zew1HHX_XG(SdS0-D3#y2p9z15az?q%o##AsCkC25RbT}+!e)dTm|gPi zt(7Y9+`+q@weKn~Me0~t)ewb(vx2pf=v`?8EqMFD>awiWfAEBJ@z1B|09H=-*d6DA8L zeo^?ALBTE?i8p^Qoxr?RnqNt{K;alsf2bK))vJ^rQu9``r^)0+`1a=y-*pMAH||@< zNy3Uhd`5GGYJ+|`CJO?DZm@O+)V2z(7n|=lM-P&C2h|aH>G|YX#TP^@*|@{THU>ZS!#{r_}WV8-!=ATPo@|3J8FQ^A7d5V&!|8oQ}o zwd0$lJ98G!N{p1upG#0YaOAKGxC-#E=_~7Mso5Wh`pN4 zw-5NZdHkua>>}Nhx%`JLVByBFM>R{t+niPB2D~`*J=LXAh4*G9sJxc<+nA z8yp1Z+xMzvqkNPts+mFk4CvhI~LGvGzwVZpwL2YagNX&#vO^}$^X;_N0dO!com zwcgUb%Rso?M`5ib=!o-Z3XdaYki#O<1fAS|uG$Qi=dod&26MW{Rc5$gb|&WAMz|-T zEbskuK#rj*&~44(DYa=XIjiaFTX|_^)3;g#d(kPNzwq-|H<_wu!kBP1 zw|JlNJnW`w+LxbnET?&iX{a=n%R|7W$Nad~=h0hxyL|ge_cQkP_72C}=}UC8Zb}Ym znVK3wz-UAWy(<6cDklYRNW0fH-AEjyFZyeC``}8c269u{V_>hSzh<0B#DigDL9e-gNVKb0GJjY_& zXUO{)ht5Sxz!qK4h-kIQI;SGG%2_Dn}8rnd)3Zd!dn+ATDG@HDA$@Ho_@tQc_d58V?OBe z_X^?o$~}ab2D!A5M=hFOLh%3+i!x5(3jd5)l)I<=^AZ<5J3mpbLX^uW&h)XNUX`wGJaDylV}b>< zCqK1cwb*R2764E0WCvSipi+4tb*q6yRFCpe-$H@|o9CV6#^jBE}f1-x8AO%vVK zl^{wGuh_`uc)v}hN~G`k7r?JeLoO5>pP3e+-6TW=o%3d_RN~;g_-VYUPAS6{cK|Py7^-SF{BRX+PYxHjCuGdWiE5aT$U6rM)&!(+?y6ymhJTbkBw+v zXRVf%^yW0VJx6-C#nZ|gU1~liMc7~&$Yu9sD-YW%82+BMnAa#f5EOSv!~XW%EiA}n z&`x8*aTHAI3Asy@UeOG)a~Ioja$4N}h&U&Y)qJ}`F#RM+%QKR7ADeAl2k}~^hZ+XQ zDirn}!H>oyDsj;;j8KkZy{f9CIf#{Fj!so|#3YRk(;8l0K)N8t?>bhMJ zxln^(^dm*Jigz(}E5<`w?7->PW~FIKo}E&Q0i%jJ4TBZJ#uvq7R5?dSM~#lq8Tdog zs}C;S=+^RyIF?ESTOH4vPSeRnT!mbobU$loYg`xTwW@>o6p-I`%(rG>W1<^nQ)+M( zqNVuFoG)7YJ1*w!+QASx^{B#P+2LaNN%=_9(&e>as|192-u@)^y#!F?1)r!J_kBu7URjR4?Ct*A?n^ z1V0W0xbg1_9Q@Y`m_%u3JG%vpXrNT#RrkOqVA0MBSn3-^RUKI|3R&MF>d)zN&y37T zyct~xQTG&HeIiNAJu(L*SP*WH38ii(wMRECRG4O!x^Qgk-xOkH6woe))323NnU~z3 zc;2OM<$($KhVZ+g7q`dN(00P)#{!O0I-8?Ty?lpS095R+0Eb#|4Q%8TvHHLt8k6bH zt-(dZI5KBTDfPbF9fQlta$h!yohpaA;<64^^Jpql0I}xa5?ze{ZZ=qa+rH~g*eH)* zK(m-eR<_=}dxN`3rxpqoKL0E4*2EPzJ5EK{wBDd<-y9#dCp8y4WPWM9F!6DlvgH_f z`mu-a%bXU&q~oz;w#FF9!t-v#r(~k$@rmtmaq#VT3yT*}vD30!{mCTm_F2t1Z+zc8 zTX2K1-`vK-Um*3zgQuz~0LPHTpSD@HVDVXMtHinevr|VWPuolM8=BqZJ@*p<90gMP z$AI<@vntaIX$L|46$VA#H)MCgwv5>P|3Fw9j8U0{NSsTX2K3JGBjx=`k8B*P>etPI z8@+lb>p0q{2B%j^SU7?my?fwphF%{peuX%9?Gl*O}|TdpzxAeK&neQla2^Os+ z0rM(3cjii)BPcRn^&@Td)>%)_mWXYi#x#s>vgwv?%;_YVt;82y4rJyQ8s{c*p<1n) zjsO zKk4eTd$S0L7q2T zfb_BJ-=1a2AonO4ooiIAj8`F{&QFew#)}(ni%*-4t>Yc!&mGKk7EeA@|v z9ysAf&DU7q^be1&-?WZ$i$TyeAN1eKWB@aCc7V#afNdYy&IN$_2U2`{$?d|b-xKgX zIPxzukS9qw)b|^Rj@*MFH!c83jlDr#SK)JP2R}00?DiYM%*^Iyk#;sv=Df zxh)Gy{tvf-oz#YVG|RemU*9EBv63dQ<*0gf*HoICkI|$f>$|ReR|tOeSVkh1pxg-{ za%T2Xf-1yg0e8`$#quK`a35Ex0@37yRDwxTW&oAgzyg2_SH0*gx0vY+DzXPx6Ra*q zBkwcf%2bgi{~_zD7)lM02r`nz2R{0jU^DGM(8S7UZVse1Qt_E*tZI^qy zGd8S2%@bHpZyJVhgelxU{!V$@47zVCzbBQ#(NU$c!Z)`6dYiTTO`izOjw^ESbFPmz zFgEE0$>|LWCDZox$=$I*s>s~DfjzWGvZm6={q(Pozh!ryRBTNg3%Hp>%OJX=CDKTK z3ngv;1@qs=sfa_w5=~ddiC2ayYpoB#n`BCD!`@4t#2w z3WeYg(ZqjVg#=Id;zYh{>)wB0sCh3V0Dk`sQWe#zO}a4)kDB3awlDq?_!||uS=w-8 zHY1S2(o|iM?!bEe|T4bhyBM>V=6Ti_<}s;n=+ffWHb)UurWos6d& zZ}QQh>RGl_^^DZtrn66_8syS0yVVJ2d10fF8p|}`pe0a`D6ZRhZI?=2<(uPD`gAc% ze{GOHSA|8L=v=p$?t;vfSMqSob&l$&=OT&V0Q^1Z2VoN64v|Y4pfcxA=areSd4Qbn zDAQvBKR%05wJTquB80+Xp7O>Dc7%G;8IHZBv)gx|8V|T!xjpw&Rf}a$`S7E^srHhX zVX*FBJ^#3BfAp>MQS}0RbphYHPXy2^{}n1j$ZHQPjQSY4e=~e0kOuVpwmYEGV-hA! zDZ)4BZkn6MJd&bW8IZox?)kLw_1ieYtNp#BmCs`jn5R(Vk0{S`=Q0S}36y%+f+SrL zNa3!Sntf3*{v$S)__${1E389~<`(JNR%utPpVDGu&4`%V69iO{}Ya?j%x;};`^uZ?VTcI!J?q!V9%DzPf#%<3>r z;r9}MI)4TZtc!d-^Zv4ZTRW!l)4HHKOm>{B*H-w|b6rm{>Eq7OUP?_>AaWDZ7IAQX z?wuU)7|?g%Uq96y(M@O38kUEA+;+TpVZLcr;>q|@Mn^`>v@kglkVysdEZ#i2Ot!j_ zhuHQ3i~XEbuJCqRT1&o&QTojTej(brOt!&EZDRh4jU1{Shol8b=>0{g*_5?Ekgy#1 zmc#oIT+<&1a;X;rXXT*P_nHB`ou9LGOD#zUV{WP>-Dd0(xq#43l7ZO)1vZcOkt(iWyLKy;@ zM1&h=5wp`ZQJ616nk0j57+sVDHIvgd)hwTsK$K&G;OD<@Wu!98k^IOn!CBOKip?56`h!CkKhLpXVsOWZ>-N)BQ7`50k6+}cCiJU40f zb=D7X(K_=kEjC98$rhDPD&}~efO~~Amgf?ctNNXU;&lRP1aF14{wixr6>>OEZ^~38 z4-uj<%%qKw{D1y)bij?-7L4V~y_)At`4al@I@o*W^t*v~$=AmExs?)khQ$4vC z&R-QXEaiCpfm7j5yyT}ckO)OLmw{z#J!efBMXDyEW)n3<2u+nwhCkp-CTpX)(oYY- zhbJDQ?YTa#e?|zUEK>vtY9^r+#ss3Z{Lrg_|LT8LSW-G@p zUi?Iscu~la1h?(|@{v`?inBwNl_6$)qA_6fNf(N63QppH?%g35HP1#+IPofx>TtI3 z24mb$W`q)GqEKGG0BT3H>S708o+|!1am2$(WQb1?kw|QreT6IoWmGPjYM`&`OMqGG zBb!z@f)*@&rn)R6pYW4% zERz7uA=D(T>1@rk_K`i?ls!Y0`^uCywh`h|Gt!1K_suW#Nd~ISW{R!;fyBbA%3JK>~yHU?ojIdwIrS# z=MUkz9~PIVd&x$IU`Jt{9!A1^P4VMkm?sf|9JS`cLp!1kYHZl=tXQA?fKI*fx~h^< zoXE3hvco5pbmG!{(`#~M^F1f?y~|^yOV0~^-3e28zvs($gGKS1=wsPDZ|>WHdCRWd z6&XmrcMB(f8$k!Tj4r(QXOjHC`;q$YOc|*?7?p)drz7ZK$-Bj-*0X>B+GaL?IV<$8 zOqUqZT;=+|`T-%D;1Kxi8kop7QJqi8;Tglh1xU=mSmtj4O$@e{QLKbPO|*|rn9Z%h zv6{KPaQKMsi~FWcW8^YdY^p^Xz-indPf$Kv zo$yIce{3Vyzk}{NdOg@9VS6cMUjRaiBNve5im~8&*9fa&ZAu`@Oj152r<)}70?J<< zUU=fsyT?;Es&Cm9cAmCRkd_ha@(#!M!x26k0jrV=14K|LzqaQ;0=L8T;rt}pmesYQbBh$G zpWP~154rdFcD${4g?PoQ-km`x&|z&vOp`P@7d{IB1f;s-yyaxojZ3{A!O&B8D(rWU zhELPiKlOg}R_vC(=Q+DZzcWYwKsKbK2l!o6O<8Wl>Kvb>AlUAr9=n z9PtnuzeG-?bC!XfZH<+PR~1-%&Imf5D+vnr;)2T*yX|GZcjRWD&9yob6%`c2(2syd zmW$&x6CYc`PjBn-Ad=smy$)(GxM+qz@fuEnl&%ch%(d+Y2xsTMGR3S z?|6CdUVZt+$>I5XgJOLb!Soy*mOS|m6wmn>>FKIBYd;LE_B6M2falspj@=8>k>aR% zI*F(gGxe*{^6TV|!Q~2UQBQ>)$4M=&Ika0N`7zxqcy0Om19O+;IT)sj@{iy^dIo;! z3UU%e;Nk{sw_^K2tEEmlZ)`s4H1ldLg(l6$-6URruDrs5&6e^j)b)05$-ivS4rA};f>MY?eWE%K?#GqT=}|a(O8fwd}3i6ddZrZcwy2jP!6k) zbDvC(QMW38yi@zmoy=^MG*vwXbu?tCHVGCtAltlXnx|3UvAJwS|14Jvi`MC5?@s6y zW}DL*o?{X0<7aCS%4qyfc31>ugHqQuW$Fmtpc4Kc$|*10Tut}hyTJLScEp1!Yl(PW zJq04yS5uo1oE=VY_7haIMtQww@5BFdS#V&u(&i9J7UI!EqZM1D=k`6`nQpzU|`8Z0g2^>Y}A% z&)zM#5|3P7)=Yd70V#1WxLvzEx+$8D5O*gPqAKTDF?}!;%6PvKS#ux!KEXb zfINbK?O<3~WaiO~jK{_{K4ITaYK)8KPIamW>zkcAh_`yc$aW@>g>x|~>6jsC>BM@t zFv+xuC)K&{wNB+tObaK}-olfonuwd1I*j^Ck6k z;9{XJ4Qjpait~2&%*-hHr%mZed*u}XCg=;T>fqXH_BfNNd4h+ieBgj~Nsh|EtQb0- zo@#%jzDZ-Kw*WjO)c2>!^4!1fkaTxp0gQ+mtT$mY3EMJ_Jcc;3s|3DXQT^5W4e~eO z{qLO>dH;HahtQp*fWEgt9vU>IF8%ObCv3LOn?P@M;4?6!^o4r(R_yQZ!e5N9Q9WY4 zIW4IukE7q?0zsP`5dJ&)cX7^8WiczrWa`hs);V^kwVdfy4*+h%0^m#6d<51;+@1RJ zGQ|R}Krx!c$QT5RPs$T}o>iUA?oUkRU~MSR!PbQ3TOoUOnY51eDBK;apywd*F0STgEg+^kJ- zo~zop_y(!VM{PB@#& zz@kex_`-DjPLEE_xqc7JuIx;{Oa?36fOh9-D_6)uy4C{HL|B!z;{c^RyRfh;%xYPl zhLoM~if|!FnzyA!!bQB=uWgZ=Vtvu+d{s#k?tb^uPIV+p4px^eo1F`OcqjM5T+T6? zUrZ}TXN(u4KXnEi*+LlWDu%H`Dhil#wWym}A~98dhFq8Z^%SUSyWtk> z?3${Azs)TUH=gT{ymDjDe!Nnzd|-it9)b9{4Q=#@cGW#(@K!HahFc0=3*L98Mqd_o zVlonu+GT0@H?aq*Al6R-sfch=arvMeK|)+a6irS!3$E~|@#u&KRFP)3yOk-P&awt4 z>dK>zZD)C5F68@mVF7d@|K41gH3f)g=7*icPoEL(1g1o)n+@BG1AA6u@M@N=6k?`o zT3F2R3S&Gev(2rlMrp9$H->x6U-72G&TehB@o61sU@npLbV z+0rRG$Li!|{i+E)#oRYZCvOQon5DlhNtE7W!0Uvmn-UdQj(cTvSSCj*Me1$JoEqC@ zaC(nvv{<-XDv6Ge^rUb3r2Vl)LPFf%XMgXuTKIO?t)PU2zGET5!&x`;`vems0~u%2 z4;4f^ffmA}M03gLoENkpn<(-<%G)6j!zQsA6SS)Y)VFBzx*W#+E)`jT!h#ss!%G;? zr1Q<62LQ}b&-O#`$hv6c?TrOIaP~^s808ls^F-KzqmP- zhM4+AHek)Y44#(nalUs6gtBUYYnk#X2ps1$3OHVk$m+=4%eig>(K&J8Va;i`!26?5 zPMOdML>Di{Aee#gnP*eb{R!6JINqBsf025+yRW^B_pL~}+Yt{=P^P_62pD11t zf(dU9e-=bA8Kp5I?zflaJ2> z#S2(}NVF^9Ah0{dCPwtOIaZ0HUGnBsFp>0=VpMUC67JyaT>z>Lqy;$1ifw34^`PYc z^dZ|9=d=Wa#lX~VQ-Q4%zyYdKrVZD}hpj3kHoaC(a0bCmQVSgblZ-_0UBJhWcO3Xu zLDkbO+!bXL|6=}ZpqE5pF_#hjjhvRELt$9bX;#mGM}11%?qXVBMgGjCzFRYaZgYxH zEldKK18^yu^}6$zz5}$&DssR4D;0`D5@-`U9JZHSB%*dnD{vsm21l9lYwE}UOHXp- znGPu^*H8BNt%fFxP;u}y)?0Z!uF=0Tnc5NPn{dw^Xu4YN9u8i-L z(^>eAlK5Aw7^jP&xoVSg!* zWrj_ZUW{^@7zO5p`S9HYkLA|ymz=4(ZXOQY!(#X&%~djlEpW-ZF)L%dv6uSXiKaAZ zPie=shqdFpPE9EEOvYvDoh70QPL3?BvjI|}P}MMs=^%71fA3D6-?WVyX#niTDEkVy z06b2CpVr7YGZ$mke6pc$k2mO6H93(aCel1#&hCXZ+b$EpS$^%u*i0upQ?QY5<+|Y; zVan_1u>F2X;;f&g63p>6QPve?{Q-g>@U5t;1!d>^rJ}=GW_(esB^Gzn8COvPR6+)< z0Wv2smtS`wu8bPFM|vDl1oX_2u&;CJug-(uy3(nCx9Uc2JH|74$9d*mM<N7Uy2Z z0KIvOJtV|{9IKbu#aIkgXAW(RNt0t%3T1qMZG~J)-^+Igwr+P9Hi6+nRTBURW;ey? z9C(Ee#X+n`x@P^OUw!5h70>@w!k*S>SCbR`aCdhQlGN%1C)(}ELb@(s#0a))kog*o zYxAtY$!umC;~^z~LF4>^S!~EIWBMn9VU^<|?Srr%1~NZGPt-M}XnO~#RS9v#G+(RA XT~V0O`c!&?zN%LwXwo14XX1YWrt Date: Wed, 10 Apr 2019 22:32:44 +0200 Subject: [PATCH 58/61] Update README.md --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 693b41123..f313b2211 100644 --- a/README.md +++ b/README.md @@ -43,7 +43,7 @@ I still look for the way to do this. Sample view on Android :) -![VT_Android](Screenshots/VT_Android_8_0.jpg) +![VT_Android](ScreenShots/VT_Android_8_0.jpg) # Virtual-TreeView Virtual Treeview is a Delphi treeview control built from ground up. Many years of development made it one of the most flexible and advanced tree controls available today. Virtual Treeview starts off with the claim to improve many aspects of existing solutions and introduces some new technologies and principles which were not available before. From 7649a6e6bd04873d4bef1ab64c6f048c2073bdae Mon Sep 17 00:00:00 2001 From: livius2 Date: Fri, 12 Apr 2019 09:15:07 +0200 Subject: [PATCH 59/61] Migrate demo - "Minimal" to FMX --- Demos/FMX/Minimal/Main.fmx | 89 ++++ Demos/FMX/Minimal/Main.pas | 185 +++++++ Demos/FMX/Minimal/Minimal.dpr | 15 + Demos/FMX/Minimal/Minimal.dproj | 866 ++++++++++++++++++++++++++++++++ Source/VirtualTrees.pas | 10 +- 5 files changed, 1163 insertions(+), 2 deletions(-) create mode 100644 Demos/FMX/Minimal/Main.fmx create mode 100644 Demos/FMX/Minimal/Main.pas create mode 100644 Demos/FMX/Minimal/Minimal.dpr create mode 100644 Demos/FMX/Minimal/Minimal.dproj diff --git a/Demos/FMX/Minimal/Main.fmx b/Demos/FMX/Minimal/Main.fmx new file mode 100644 index 000000000..fcb91ce27 --- /dev/null +++ b/Demos/FMX/Minimal/Main.fmx @@ -0,0 +1,89 @@ +object MainForm: TMainForm + Left = 0 + Top = 0 + Caption = 'Simple Virtual Treeview demo' + ClientHeight = 443 + ClientWidth = 409 + FormFactor.Width = 320 + FormFactor.Height = 480 + FormFactor.Devices = [Desktop] + OnCreate = FormCreate + DesignerMasterStyle = 0 + object AddOneButton: TButton + Anchors = [akLeft, akBottom] + Position.X = 128.000000000000000000 + Position.Y = 352.000000000000000000 + Size.Width = 130.000000000000000000 + Size.Height = 25.000000000000000000 + Size.PlatformDefault = False + TabOrder = 2 + Text = 'Add node(s) to root' + OnClick = AddOneButtonClick + Left = 96 + Top = 350 + end + object Button1: TButton + Tag = 1 + Anchors = [akLeft, akBottom] + Position.X = 128.000000000000000000 + Position.Y = 384.000000000000000000 + Size.Width = 130.000000000000000000 + Size.Height = 25.000000000000000000 + Size.PlatformDefault = False + TabOrder = 5 + Text = 'Add node(s) as children' + OnClick = AddOneButtonClick + Left = 96 + Top = 378 + end + object ClearButton: TButton + Anchors = [akLeft, akBottom] + Position.X = 128.000000000000000000 + Position.Y = 416.000000000000000000 + Size.Width = 129.000000000000000000 + Size.Height = 25.000000000000000000 + Size.PlatformDefault = False + TabOrder = 0 + Text = 'Clear tree' + OnClick = ClearButtonClick + Left = 97 + Top = 410 + end + object CloseButton: TButton + Anchors = [akRight, akBottom] + Position.X = 328.000000000000000000 + Position.Y = 416.000000000000000000 + Size.Width = 75.000000000000000000 + Size.Height = 25.000000000000000000 + Size.PlatformDefault = False + TabOrder = 4 + Text = 'Close' + OnClick = CloseButtonClick + Left = 330 + Top = 410 + end + object Edit1: TEdit + Touch.InteractiveGestures = [LongTap, DoubleTap] + Anchors = [akLeft, akBottom] + TabOrder = 1 + Text = '3' + Position.X = 24.000000000000000000 + Position.Y = 352.000000000000000000 + Size.Width = 81.000000000000000000 + Size.Height = 21.000000000000000000 + Size.PlatformDefault = False + Left = 8 + Top = 366 + end + object Label1: TLabel + Position.X = 8.000000000000000000 + Position.Y = 320.000000000000000000 + Size.Width = 116.000000000000000000 + Size.Height = 13.000000000000000000 + Size.PlatformDefault = False + Text = 'Last operation duration:' + TabOrder = 6 + Left = 10 + Top = 280 + end +end diff --git a/Demos/FMX/Minimal/Main.pas b/Demos/FMX/Minimal/Main.pas new file mode 100644 index 000000000..2cd53a533 --- /dev/null +++ b/Demos/FMX/Minimal/Main.pas @@ -0,0 +1,185 @@ +unit Main; + +interface + +uses + System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, + FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, VirtualTrees, VirtualTrees.FMX, FMX.StdCtrls, FMX.Edit, + FMX.Controls.Presentation; + +type + TMainForm = class(TForm) + AddOneButton: TButton; + Button1: TButton; + ClearButton: TButton; + CloseButton: TButton; + Edit1: TEdit; + Label1: TLabel; + procedure FormCreate(Sender: TObject); + procedure ClearButtonClick(Sender: TObject); + procedure AddOneButtonClick(Sender: TObject); + procedure CloseButtonClick(Sender: TObject); + private + { Private declarations } + public + { Public declarations } + VST: TVirtualStringTree; + + + procedure VSTFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); + procedure VSTInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; + var InitialStates: TVirtualNodeInitStates); + procedure VSTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; + Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); + end; + +var + MainForm: TMainForm; + +implementation + +{$R *.fmx} + +type + // This is a very simple record we use to store data in the nodes. + // Since the application is responsible to manage all data including the node's caption + // this record can be considered as minimal requirement in all VT applications. + // Extend it to whatever your application needs. + PMyRec = ^TMyRec; + TMyRec = record + Caption: WideString; + end; + +procedure TMainForm.AddOneButtonClick(Sender: TObject); +var + Count: Cardinal; + Start: Cardinal; + No : Integer; +begin + // Add some nodes to the treeview. + //Screen.Cursor := crHourGlass; + + try + Start := TThread.GetTickCount; + No:= (Sender as TButton).Tag; + case No of + 0: // add to root + begin + Count := StrToInt(Edit1.Text); + VST.RootNodeCount := VST.RootNodeCount + Count; + end; + 1: // add as child + if Assigned(VST.FocusedNode) then + begin + Count := StrToInt(Edit1.Text); + VST.ChildCount[VST.FocusedNode] := VST.ChildCount[VST.FocusedNode] + Count; + VST.Expanded[VST.FocusedNode] := True; + VST.InvalidateToBottom(VST.FocusedNode); + end; + end; + Label1.Text := Format('Last operation duration: %d ms', [TThread.GetTickCount - Start]); + finally + //Screen.Cursor := crDefault; + end; +end; + +procedure TMainForm.ClearButtonClick(Sender: TObject); +var + Start: Cardinal; + +begin + //Screen.Cursor := crHourGlass; + try + Start := TThread.GetTickCount; + VST.Clear; + Label1.Text := Format('Last operation duration: %d ms', [TThread.GetTickCount - Start]); + finally + //Screen.Cursor := crDefault; + end; +end; + +procedure TMainForm.CloseButtonClick(Sender: TObject); +begin + Close; +end; + +procedure TMainForm.FormCreate(Sender: TObject); +Var col: TVirtualTreeColumn; +begin + VST:= TVirtualStringTree.Create(Self); + VST.Parent:= Self; + VST.Fill.Color:= TAlphaColorRec.White; + //VST.AlignWithMargins:= true; + VST.Height:= 262; + VST.Align:= TAlignLayout.Top; + VST.Colors.BorderColor:= clWindowText; + VST.Colors.HotColor := clBlack; + //VST.DragMode := TDragMode.dmAutomatic; + VST.DragType := dtVCL; + VST.Header.AutoSizeIndex := -1; + //VST.Header.Font.Charset := DEFAULT_CHARSET; + //VST.Header.Font.Color := clWindowText; + VST.Header.Font.Size := 10; + VST.Header.Font.Family := 'Tahoma'; + VST.Header.Font.Style := []; + VST.Header.Options := [hoColumnResize, hoDrag, hoShowSortGlyphs, hoVisible]; + //VST.HintAnimation := hatNone; + VST.IncrementalSearch := isAll; + //VST.ParentBiDiMode := False; + VST.TabOrder := 0; + VST.TreeOptions.AnimationOptions := [toAnimatedToggle]; + VST.TreeOptions.MiscOptions := [toEditable, toInitOnSave, toToggleOnDblClick, toWheelPanning]; + VST.TreeOptions.PaintOptions := [toShowButtons, toShowRoot, toShowTreeLines, toThemeAware, toUseBlendedImages]; + VST.TreeOptions.SelectionOptions := [toMultiSelect]; + VST.OnFreeNode := VSTFreeNode; + VST.OnGetText := VSTGetText; + VST.OnInitNode := VSTInitNode; + col:= VST.Header.Columns.Add; + col.Position := 0; + col.Width := 300; + col.Text := 'Name'; + + + // Let the tree know how much data space we need. + VST.NodeDataSize := SizeOf(TMyRec); + // Set an initial number of nodes. + VST.RootNodeCount := 20; +end; + +procedure TMainForm.VSTFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); +var + Data: PMyRec; + +begin + Data := Sender.GetNodeData(Node); + // Explicitely free the string, the VCL cannot know that there is one but needs to free + // it nonetheless. For more fields in such a record which must be freed use Finalize(Data^) instead touching + // every member individually. + Finalize(Data^); +end; + +procedure TMainForm.VSTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; + TextType: TVSTTextType; var CellText: string); +var + Data: PMyRec; + +begin + // A handler for the OnGetText event is always needed as it provides the tree with the string data to display. + Data := Sender.GetNodeData(Node); + if Assigned(Data) then + CellText := Data.Caption; +end; + +procedure TMainForm.VSTInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; + var InitialStates: TVirtualNodeInitStates); +var + Data: PMyRec; + +begin + Data := Sender.GetNodeData(Node); + // Construct a node caption. This event is triggered once for each node but + // appears asynchronously, which means when the node is displayed not when it is added. + Data.Caption := Format('Level %d, Index %d', [Sender.GetNodeLevel(Node), Node.Index]); +end; + +end. diff --git a/Demos/FMX/Minimal/Minimal.dpr b/Demos/FMX/Minimal/Minimal.dpr new file mode 100644 index 000000000..ceb1d54a4 --- /dev/null +++ b/Demos/FMX/Minimal/Minimal.dpr @@ -0,0 +1,15 @@ +program Minimal; + +uses + System.StartUpCopy, + FMX.Forms, + Main in 'Main.pas' {MainForm}, + VirtualTrees in '..\..\..\..\Source\VirtualTrees.pas'; + +{$R *.res} + +begin + Application.Initialize; + Application.CreateForm(TMainForm, MainForm); + Application.Run; +end. diff --git a/Demos/FMX/Minimal/Minimal.dproj b/Demos/FMX/Minimal/Minimal.dproj new file mode 100644 index 000000000..d246d38df --- /dev/null +++ b/Demos/FMX/Minimal/Minimal.dproj @@ -0,0 +1,866 @@ + + + {C24D97D5-7A2F-4766-974F-412626AC4827} + 18.5 + FMX + Minimal.dpr + True + Debug + Win32 + 1119 + Application + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + .\$(Platform)\$(Config) + .\$(Platform)\$(Config) + false + false + false + false + false + System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) + true + true + true + true + true + true + true + true + $(BDS)\bin\delphi_PROJECTICON.ico + $(BDS)\bin\delphi_PROJECTICNS.icns + Minimal + + + DBXSqliteDriver;RESTComponents;DBXInterBaseDriver;emsclientfiredac;DataSnapFireDAC;tethering;bindcompfmx;FmxTeeUI;FireDACIBDriver;fmx;FireDACDBXDriver;dbexpress;IndyCore;dsnap;DataSnapCommon;emsclient;FireDACCommon;RESTBackendComponents;soapserver;bindengine;CloudService;FireDACCommonDriver;DataSnapClient;inet;bindcompdbx;IndyIPCommon;IndyIPServer;IndySystem;fmxFireDAC;FireDAC;FireDACSqliteDriver;ibmonitor;FMXTee;soaprtl;DbxCommonDriver;ibxpress;xmlrtl;soapmidas;DataSnapNativeClient;ibxbindings;rtl;DbxClientDriver;FireDACDSDriver;CustomIPTransport;bindcomp;IndyIPClient;RtmRxCtl260;dbxcds;dsnapxml;DataSnapProviderClient;dbrtl;IndyProtocols;$(DCC_UsePackage) + package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey= + Debug + true + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_36x36.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_48x48.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_72x72.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_96x96.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_144x144.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_426x320.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_470x320.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_640x480.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_960x720.png + android-support-v4.dex.jar;cloud-messaging.dex.jar;fmx.dex.jar;google-analytics-v2.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar;google-play-services-ads-7.0.0.dex.jar;google-play-services-analytics-7.0.0.dex.jar;google-play-services-base-7.0.0.dex.jar;google-play-services-gcm-7.0.0.dex.jar;google-play-services-identity-7.0.0.dex.jar;google-play-services-maps-7.0.0.dex.jar;google-play-services-panorama-7.0.0.dex.jar;google-play-services-plus-7.0.0.dex.jar;google-play-services-wallet-7.0.0.dex.jar + + + DBXSqliteDriver;RESTComponents;DBXInterBaseDriver;emsclientfiredac;DataSnapFireDAC;tethering;bindcompfmx;FmxTeeUI;FireDACIBDriver;fmx;FireDACDBXDriver;dbexpress;IndyCore;dsnap;DataSnapCommon;emsclient;FireDACCommon;RESTBackendComponents;soapserver;bindengine;CloudService;FireDACCommonDriver;DataSnapClient;inet;bindcompdbx;IndyIPCommon;IndyIPServer;IndySystem;fmxFireDAC;FireDAC;FireDACSqliteDriver;ibmonitor;FMXTee;soaprtl;DbxCommonDriver;ibxpress;xmlrtl;soapmidas;DataSnapNativeClient;ibxbindings;rtl;DbxClientDriver;FireDACDSDriver;CustomIPTransport;bindcomp;IndyIPClient;dbxcds;dsnapxml;DataSnapProviderClient;dbrtl;IndyProtocols;fmxase;$(DCC_UsePackage) + CFBundleName=$(MSBuildProjectName);CFBundleDevelopmentRegion=en;CFBundleDisplayName=$(MSBuildProjectName);CFBundleIdentifier=$(MSBuildProjectName);CFBundleInfoDictionaryVersion=7.1;CFBundleVersion=1.0.0;CFBundleShortVersionString=1.0.0;CFBundlePackageType=APPL;CFBundleSignature=????;LSRequiresIPhoneOS=true;CFBundleAllowMixedLocalizations=YES;CFBundleExecutable=$(MSBuildProjectName);UIDeviceFamily=iPhone & iPad;CFBundleResourceSpecification=ResourceRules.plist;NSLocationAlwaysUsageDescription=The reason for accessing the location information of the user;NSLocationWhenInUseUsageDescription=The reason for accessing the location information of the user;NSLocationAlwaysAndWhenInUseUsageDescription=The reason for accessing the location information of the user;FMLocalNotificationPermission=false;UIBackgroundModes=;NSContactsUsageDescription=The reason for accessing the contacts;NSPhotoLibraryUsageDescription=The reason for accessing the photo library;NSPhotoLibraryAddUsageDescription=The reason for adding to the photo library;NSCameraUsageDescription=The reason for accessing the camera;NSFaceIDUsageDescription=The reason for accessing the face id;NSMicrophoneUsageDescription=The reason for accessing the microphone;NSSiriUsageDescription=The reason for accessing Siri + iPhoneAndiPad + true + Debug + $(MSBuildProjectName) + $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_57x57.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_60x60.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_87x87.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_114x114.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_120x120.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_180x180.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_320x480.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_640x960.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_640x1136.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_750x1334.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_1242x2208.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_2208x1242.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_1125x2436.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_2436x1125.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_29x29.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_40x40.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_58x58.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_80x80.png + $(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_72x72.png + $(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_76x76.png + $(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_144x144.png + $(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_152x152.png + $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_768x1004.png + $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_768x1024.png + $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_1024x748.png + $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_1024x768.png + $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_1536x2008.png + $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_1536x2048.png + $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_2048x1496.png + $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_2048x1536.png + $(BDS)\bin\Artwork\iOS\iPad\FM_SpotlightSearchIcon_40x40.png + $(BDS)\bin\Artwork\iOS\iPad\FM_SpotlightSearchIcon_50x50.png + $(BDS)\bin\Artwork\iOS\iPad\FM_SpotlightSearchIcon_80x80.png + $(BDS)\bin\Artwork\iOS\iPad\FM_SpotlightSearchIcon_100x100.png + $(BDS)\bin\Artwork\iOS\iPad\FM_SettingIcon_29x29.png + $(BDS)\bin\Artwork\iOS\iPad\FM_SettingIcon_58x58.png + + + DBXSqliteDriver;RESTComponents;DBXInterBaseDriver;emsclientfiredac;DataSnapFireDAC;tethering;bindcompfmx;FmxTeeUI;FireDACIBDriver;fmx;FireDACDBXDriver;dbexpress;IndyCore;dsnap;DataSnapCommon;emsclient;FireDACCommon;RESTBackendComponents;soapserver;bindengine;CloudService;FireDACCommonDriver;DataSnapClient;inet;bindcompdbx;IndyIPCommon;IndyIPServer;IndySystem;fmxFireDAC;FireDAC;FireDACSqliteDriver;ibmonitor;FMXTee;soaprtl;DbxCommonDriver;ibxpress;xmlrtl;soapmidas;DataSnapNativeClient;ibxbindings;rtl;DbxClientDriver;FireDACDSDriver;CustomIPTransport;bindcomp;IndyIPClient;dbxcds;dsnapxml;DataSnapProviderClient;dbrtl;IndyProtocols;fmxase;$(DCC_UsePackage) + CFBundleName=$(MSBuildProjectName);CFBundleDevelopmentRegion=en;CFBundleDisplayName=$(MSBuildProjectName);CFBundleIdentifier=$(MSBuildProjectName);CFBundleInfoDictionaryVersion=7.1;CFBundleVersion=1.0.0;CFBundleShortVersionString=1.0.0;CFBundlePackageType=APPL;CFBundleSignature=????;LSRequiresIPhoneOS=true;CFBundleAllowMixedLocalizations=YES;CFBundleExecutable=$(MSBuildProjectName);UIDeviceFamily=iPhone & iPad;CFBundleResourceSpecification=ResourceRules.plist;NSLocationAlwaysUsageDescription=The reason for accessing the location information of the user;NSLocationWhenInUseUsageDescription=The reason for accessing the location information of the user;NSLocationAlwaysAndWhenInUseUsageDescription=The reason for accessing the location information of the user;FMLocalNotificationPermission=false;UIBackgroundModes=;NSContactsUsageDescription=The reason for accessing the contacts;NSPhotoLibraryUsageDescription=The reason for accessing the photo library;NSPhotoLibraryAddUsageDescription=The reason for adding to the photo library;NSCameraUsageDescription=The reason for accessing the camera;NSFaceIDUsageDescription=The reason for accessing the face id;NSMicrophoneUsageDescription=The reason for accessing the microphone;NSSiriUsageDescription=The reason for accessing Siri + iPhoneAndiPad + true + Debug + $(MSBuildProjectName) + $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_57x57.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_60x60.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_87x87.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_114x114.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_120x120.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_180x180.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_320x480.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_640x960.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_640x1136.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_750x1334.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_1242x2208.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_2208x1242.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_1125x2436.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_2436x1125.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_29x29.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_40x40.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_58x58.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_80x80.png + $(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_72x72.png + $(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_76x76.png + $(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_144x144.png + $(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_152x152.png + $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_768x1004.png + $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_768x1024.png + $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_1024x748.png + $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_1024x768.png + $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_1536x2008.png + $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_1536x2048.png + $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_2048x1496.png + $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_2048x1536.png + $(BDS)\bin\Artwork\iOS\iPad\FM_SpotlightSearchIcon_40x40.png + $(BDS)\bin\Artwork\iOS\iPad\FM_SpotlightSearchIcon_50x50.png + $(BDS)\bin\Artwork\iOS\iPad\FM_SpotlightSearchIcon_80x80.png + $(BDS)\bin\Artwork\iOS\iPad\FM_SpotlightSearchIcon_100x100.png + $(BDS)\bin\Artwork\iOS\iPad\FM_SettingIcon_29x29.png + $(BDS)\bin\Artwork\iOS\iPad\FM_SettingIcon_58x58.png + + + DBXSqliteDriver;RESTComponents;DBXInterBaseDriver;emsclientfiredac;DataSnapFireDAC;tethering;bindcompfmx;FmxTeeUI;FireDACIBDriver;fmx;FireDACDBXDriver;dbexpress;IndyCore;dsnap;DataSnapCommon;emsclient;FireDACCommon;RESTBackendComponents;soapserver;bindengine;CloudService;FireDACCommonDriver;DataSnapClient;inet;bindcompdbx;IndyIPCommon;IndyIPServer;IndySystem;fmxFireDAC;FireDAC;FireDACSqliteDriver;ibmonitor;FMXTee;soaprtl;DbxCommonDriver;ibxpress;xmlrtl;soapmidas;DataSnapNativeClient;ibxbindings;rtl;DbxClientDriver;FireDACDSDriver;CustomIPTransport;bindcomp;IndyIPClient;dbxcds;dsnapxml;DataSnapProviderClient;dbrtl;IndyProtocols;fmxase;$(DCC_UsePackage) + CFBundleName=$(MSBuildProjectName);CFBundleDevelopmentRegion=en;CFBundleDisplayName=$(MSBuildProjectName);CFBundleIdentifier=$(MSBuildProjectName);CFBundleInfoDictionaryVersion=7.1;CFBundleVersion=1.0.0;CFBundleShortVersionString=1.0.0;CFBundlePackageType=APPL;CFBundleSignature=????;LSRequiresIPhoneOS=true;CFBundleAllowMixedLocalizations=YES;CFBundleExecutable=$(MSBuildProjectName);UIDeviceFamily=iPhone & iPad;CFBundleResourceSpecification=ResourceRules.plist;NSLocationAlwaysUsageDescription=The reason for accessing the location information of the user;NSLocationWhenInUseUsageDescription=The reason for accessing the location information of the user;NSLocationAlwaysAndWhenInUseUsageDescription=The reason for accessing the location information of the user;FMLocalNotificationPermission=false;UIBackgroundModes=;NSContactsUsageDescription=The reason for accessing the contacts;NSPhotoLibraryUsageDescription=The reason for accessing the photo library;NSPhotoLibraryAddUsageDescription=The reason for adding to the photo library;NSCameraUsageDescription=The reason for accessing the camera;NSFaceIDUsageDescription=The reason for accessing the face id;NSMicrophoneUsageDescription=The reason for accessing the microphone;NSSiriUsageDescription=The reason for accessing Siri + iPhoneAndiPad + true + $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_57x57.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_60x60.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_87x87.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_114x114.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_120x120.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_180x180.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_320x480.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_640x960.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_640x1136.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_750x1334.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_1242x2208.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_2208x1242.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_1125x2436.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_2436x1125.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_29x29.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_40x40.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_58x58.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_80x80.png + $(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_72x72.png + $(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_76x76.png + $(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_144x144.png + $(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_152x152.png + $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_768x1004.png + $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_768x1024.png + $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_1024x748.png + $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_1024x768.png + $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_1536x2008.png + $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_1536x2048.png + $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_2048x1496.png + $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_2048x1536.png + $(BDS)\bin\Artwork\iOS\iPad\FM_SpotlightSearchIcon_40x40.png + $(BDS)\bin\Artwork\iOS\iPad\FM_SpotlightSearchIcon_50x50.png + $(BDS)\bin\Artwork\iOS\iPad\FM_SpotlightSearchIcon_80x80.png + $(BDS)\bin\Artwork\iOS\iPad\FM_SpotlightSearchIcon_100x100.png + $(BDS)\bin\Artwork\iOS\iPad\FM_SettingIcon_29x29.png + $(BDS)\bin\Artwork\iOS\iPad\FM_SettingIcon_58x58.png + + + DBXSqliteDriver;RESTComponents;DataSnapServerMidas;DBXInterBaseDriver;emsclientfiredac;DataSnapFireDAC;tethering;FireDACMSSQLDriver;bindcompfmx;DBXOracleDriver;inetdb;FmxTeeUI;FireDACIBDriver;fmx;fmxdae;FireDACDBXDriver;dbexpress;IndyCore;dsnap;DataSnapCommon;emsclient;FireDACCommon;RESTBackendComponents;soapserver;bindengine;DBXMySQLDriver;FireDACOracleDriver;CloudService;FireDACMySQLDriver;DBXFirebirdDriver;FireDACCommonODBC;FireDACCommonDriver;DataSnapClient;inet;bindcompdbx;IndyIPCommon;IndyIPServer;IndySystem;fmxFireDAC;FireDAC;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;FireDACASADriver;FireDACTDataDriver;FMXTee;soaprtl;DbxCommonDriver;ibxpress;DataSnapServer;xmlrtl;soapmidas;DataSnapNativeClient;fmxobj;ibxbindings;rtl;DbxClientDriver;FireDACDSDriver;DBXSybaseASADriver;CustomIPTransport;bindcomp;DBXInformixDriver;IndyIPClient;dbxcds;FireDACODBCDriver;DataSnapIndy10ServerTransport;dsnapxml;DataSnapProviderClient;dbrtl;inetdbxpress;FireDACMongoDBDriver;IndyProtocols;fmxase;$(DCC_UsePackage) + CFBundleName=$(MSBuildProjectName);CFBundleDisplayName=$(MSBuildProjectName);CFBundleIdentifier=$(MSBuildProjectName);CFBundleVersion=1.0.0;CFBundleShortVersionString=1.0.0;CFBundlePackageType=APPL;CFBundleSignature=????;CFBundleAllowMixedLocalizations=YES;CFBundleExecutable=$(MSBuildProjectName);NSHighResolutionCapable=true;LSApplicationCategoryType=public.app-category.utilities;NSLocationAlwaysUsageDescription=The reason for accessing the location information of the user;NSLocationWhenInUseUsageDescription=The reason for accessing the location information of the user;NSLocationAlwaysAndWhenInUseUsageDescription=The reason for accessing the location information of the user;NSContactsUsageDescription=The reason for accessing the contacts + Debug + true + + + DBXSqliteDriver;RESTComponents;DataSnapServerMidas;DBXDb2Driver;DBXInterBaseDriver;vclactnband;vclFireDAC;emsclientfiredac;DataSnapFireDAC;svnui;tethering;FireDACADSDriver;DBXMSSQLDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;vcltouch;vcldb;bindcompfmx;svn;Intraweb;DBXOracleDriver;inetdb;VirtualTreesDR;RaizeComponentsVcl;FmxTeeUI;emsedge;RaizeComponentsVclDb;FireDACIBDriver;fmx;fmxdae;vclib;frxTee26;FireDACDBXDriver;dbexpress;IndyCore;vclx;KBStringsDesign;dsnap;DataSnapCommon;emsclient;FireDACCommon;RESTBackendComponents;DataSnapConnectors;VCLRESTComponents;soapserver;vclie;bindengine;DBXMySQLDriver;FireDACOracleDriver;CloudService;FireDACMySQLDriver;DBXFirebirdDriver;frx26;FireDACCommonODBC;FireDACCommonDriver;DataSnapClient;inet;bindcompdbx;IndyIPCommon;vcl;IndyIPServer;DBXSybaseASEDriver;KBImageList;frxDB26;IndySystem;FireDACDb2Driver;dsnapcon;FireDACMSAccDriver;fmxFireDAC;FireDACInfxDriver;vclimg;TeeDB;FireDAC;emshosting;frxe26;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;FireDACASADriver;FireDACTDataDriver;DBXOdbcDriver;FMXTee;soaprtl;DbxCommonDriver;ibxpress;Tee;DataSnapServer;xmlrtl;soapmidas;DataSnapNativeClient;fmxobj;vclwinx;ibxbindings;rtl;emsserverresource;DbxClientDriver;FireDACDSDriver;DBXSybaseASADriver;KBStrings;CustomIPTransport;vcldsnap;SynEditDR;bindcomp;appanalytics;DBXInformixDriver;IndyIPClient;bindcompvcl;TeeUI;RtmRxCtl260;dbxcds;VclSmp;adortl;FireDACODBCDriver;RtmRxDB260;DataSnapIndy10ServerTransport;dsnapxml;DataSnapProviderClient;dbrtl;inetdbxpress;FireDACMongoDBDriver;IndyProtocols;fmxase;$(DCC_UsePackage) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + $(BDS)\bin\default_app.manifest + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + DBXSqliteDriver;RESTComponents;DataSnapServerMidas;DBXDb2Driver;DBXInterBaseDriver;vclactnband;vclFireDAC;emsclientfiredac;DataSnapFireDAC;tethering;FireDACADSDriver;DBXMSSQLDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;vcltouch;vcldb;bindcompfmx;Intraweb;DBXOracleDriver;inetdb;VirtualTreesDR;RaizeComponentsVcl;FmxTeeUI;emsedge;RaizeComponentsVclDb;FireDACIBDriver;fmx;fmxdae;vclib;FireDACDBXDriver;dbexpress;IndyCore;vclx;dsnap;DataSnapCommon;emsclient;FireDACCommon;RESTBackendComponents;DataSnapConnectors;VCLRESTComponents;soapserver;vclie;bindengine;DBXMySQLDriver;FireDACOracleDriver;CloudService;FireDACMySQLDriver;DBXFirebirdDriver;FireDACCommonODBC;FireDACCommonDriver;DataSnapClient;inet;bindcompdbx;IndyIPCommon;vcl;IndyIPServer;DBXSybaseASEDriver;IndySystem;FireDACDb2Driver;dsnapcon;FireDACMSAccDriver;fmxFireDAC;FireDACInfxDriver;vclimg;TeeDB;FireDAC;emshosting;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;FireDACASADriver;FireDACTDataDriver;DBXOdbcDriver;FMXTee;soaprtl;DbxCommonDriver;ibxpress;Tee;DataSnapServer;xmlrtl;soapmidas;DataSnapNativeClient;fmxobj;vclwinx;ibxbindings;rtl;emsserverresource;DbxClientDriver;FireDACDSDriver;DBXSybaseASADriver;CustomIPTransport;vcldsnap;SynEditDR;bindcomp;appanalytics;DBXInformixDriver;IndyIPClient;bindcompvcl;TeeUI;dbxcds;VclSmp;adortl;FireDACODBCDriver;DataSnapIndy10ServerTransport;dsnapxml;DataSnapProviderClient;dbrtl;inetdbxpress;FireDACMongoDBDriver;IndyProtocols;fmxase;$(DCC_UsePackage) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + $(BDS)\bin\default_app.manifest + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + DEBUG;$(DCC_Define) + true + false + true + true + true + + + false + true + PerMonitorV2 + ..\..\..\Source;$(DCC_UnitSearchPath) + true + 1033 + VT_FMX;$(DCC_Define) + + + true + PerMonitorV2 + + + false + RELEASE;$(DCC_Define) + 0 + 0 + + + true + PerMonitorV2 + + + true + PerMonitorV2 + + + + MainSource + + +
MainForm
+ fmx + + + + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + + + + Delphi.Personality.12 + Application + + + + Minimal.dpr + + + DBExpress Enterprise Data Explorer Integration + Microsoft Office 2000 Sample Automation Server Wrapper Components + Microsoft Office XP Sample Automation Server Wrapper Components + + + + + + true + + + + + true + + + + + true + + + + + true + + + + + true + + + + + Minimal.exe + true + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + classes + 1 + + + + + res\xml + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\armeabi + 1 + + + + + library\lib\mips + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + res\drawable + 1 + + + + + res\values + 1 + + + + + res\values-v21 + 1 + + + + + res\drawable + 1 + + + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-ldpi + 1 + + + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + + + res\drawable-small + 1 + + + + + res\drawable-normal + 1 + + + + + res\drawable-large + 1 + + + + + res\drawable-xlarge + 1 + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + Contents\MacOS + 1 + .framework + + + Contents\MacOS + 1 + .framework + + + 0 + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .dll;.bpl + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .bpl + + + + + 0 + + + 0 + + + 0 + + + 0 + + + Contents\Resources\StartUp\ + 0 + + + Contents\Resources\StartUp\ + 0 + + + 0 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + 1 + + + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + + + Contents + 1 + + + Contents + 1 + + + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + + + library\lib\armeabi-v7a + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + 1 + + + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + + + + + + + + + + True + True + True + True + True + True + True + + + 12 + + + + + diff --git a/Source/VirtualTrees.pas b/Source/VirtualTrees.pas index 575492ea3..75f081ad9 100644 --- a/Source/VirtualTrees.pas +++ b/Source/VirtualTrees.pas @@ -34033,14 +34033,17 @@ procedure TBaseVirtualTree.ToggleNode(Node: PVirtualNode); // No animation necessary if the node is below the current client height. if R1.Top < ClientHeight then begin + {$IFDEF VT_FMX} + {$ELSE} PrepareAnimation; try - Animate(Steps, FAnimationDuration, {$IFDEF VT_FMX}nil{$ELSE}ToggleCallback{$ENDIF}, @ToggleData); + Animate(Steps, FAnimationDuration, ToggleCallback, @ToggleData); finally {$IFDEF VT_VCL} ReleaseDC(Window, DC); {$ENDIF} end; + {$ENDIF} end; end; end; @@ -34222,14 +34225,17 @@ procedure TBaseVirtualTree.ToggleNode(Node: PVirtualNode); if ClientHeight >= R1.Top then begin + {$IFDEF VT_FMX} + {$ELSE} PrepareAnimation; try - Animate(Steps, FAnimationDuration, {$IFDEF VT_FMX}nil{$ELSE}ToggleCallback{$ENDIF}, @ToggleData); + Animate(Steps, FAnimationDuration, ToggleCallback, @ToggleData); finally {$IFDEF VT_VCL} ReleaseDC(Window, DC); {$ENDIF} end; + {$ENDIF} end; end; end; From 8edb0aa7007fccb6201f05b1100d210bebb5bc60 Mon Sep 17 00:00:00 2001 From: Karol Bieniaszewski Date: Wed, 24 Apr 2019 09:52:37 +0200 Subject: [PATCH 60/61] Update README.md --- README.md | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/README.md b/README.md index f313b2211..340e13c60 100644 --- a/README.md +++ b/README.md @@ -1,3 +1,7 @@ +Sample view on Android :) + +![VT_Android](ScreenShots/VT_Android_8_0.jpg) + ## About this port to Firemonkey: ### What is working: @@ -41,10 +45,6 @@ Remember to add also to uses clause unit VirtualTrees.FMX. If you install package for FMX you can not use installed package for VCL and vice-versa. I still look for the way to do this. -Sample view on Android :) - -![VT_Android](ScreenShots/VT_Android_8_0.jpg) - # Virtual-TreeView Virtual Treeview is a Delphi treeview control built from ground up. Many years of development made it one of the most flexible and advanced tree controls available today. Virtual Treeview starts off with the claim to improve many aspects of existing solutions and introduces some new technologies and principles which were not available before. From 11e41559c87fb19ad16741a85f6151beb031b298 Mon Sep 17 00:00:00 2001 From: Karol Bieniaszewski Date: Wed, 24 Apr 2019 13:36:13 +0200 Subject: [PATCH 61/61] Update README.md --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 340e13c60..ba5966b30 100644 --- a/README.md +++ b/README.md @@ -37,7 +37,7 @@ Current VT is derived from TRectangle. Will be good to have it as presented control with appropiate TDataModel. This will bring more possibilities like have e.g. 2 tree on the form based on same data. One will be i scale 1 second smaller in scale e.g 0.2 as a preview. - +#### IMPORTANT. To test FMX port of VT - you must add in the e.g. Delphi project->Options->Conditional defines **VT_FMX**. There is only package for Delphi Tokyo (but you can test it from the code). Remember to add also to uses clause unit VirtualTrees.FMX.