diff --git a/Tests/VTCellSelectionTests.pas b/Tests/VTCellSelectionTests.pas index 9bad74d0..22221f85 100644 --- a/Tests/VTCellSelectionTests.pas +++ b/Tests/VTCellSelectionTests.pas @@ -51,6 +51,7 @@ TCellSelectionTests = class(TObject) Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); procedure EnableMultiCellSelection(const ATree: TBaseVirtualTree = nil); + function BuildExpectedCellHTML(const ANodes: array of PVirtualNode): string; public [Setup] procedure Setup; @@ -304,6 +305,63 @@ procedure TCellSelectionTests.EnableMultiCellSelection(const ATree: TBaseVirtual [toExtendedFocus, toMultiSelect, toMultiCellSelect] - [toFullRowSelect]; end; +function TCellSelectionTests.BuildExpectedCellHTML(const ANodes: array of PVirtualNode): string; + +// Builds the expected CF_HTML clipboard content for a rectangular col1..col3 cell selection +// from the tree's ACTUAL metrics (font, header height, node heights, column widths). The +// former hardcoded strings were generated on a 216 dpi machine (see PixelsPerInch in the +// fixture's dfm) and failed on any other dpi because the exported pixel heights differ. + +const + CRLF = #13#10; + DocType = ''; + HTMLIntro = '' + + ''; + HTMLExtro = ''; + // Fixed-width offset header, mirroring MakeFragment in VirtualTrees.Export.pas. + DescriptionLength = Length('Version:1.0'#13#10) + Length('StartHTML:') + Length('EndHTML:') + + Length('StartFragment:') + Length('EndFragment:') + 4 * 10 {NumberLengthAndCR}; +var + LFragment, LFont: string; + LStartFragment, LEndFragment: Integer; + I, C: Integer; +begin + LFont := Format('font-family: ''%s''; font-size: %dpt; font-style: normal; font-weight: normal; ' + + 'text-decoration: none; color: #000000;', [FTree.Font.Name, FTree.Font.Size]); + LFragment := + '' + + '' + CRLF + + '' + CRLF + + '' + CRLF; + for C := col1 to col3 do + LFragment := LFragment + Format('', + [FTree.Header.Height, FTree.Header.Columns[C].Width, FTree.Header.Columns[C].Text]); + LFragment := LFragment + '' + CRLF; + for I := 0 to High(ANodes) do + begin + LFragment := LFragment + ' ' + CRLF; + for C := col1 to col3 do + LFragment := LFragment + Format(' ', + [FTree.NodeHeight[ANodes[I]], FTree.Text[ANodes[I], C]]); + LFragment := LFragment + ' ' + CRLF; + end; + LFragment := LFragment + '
%s
%s
'; + + LStartFragment := DescriptionLength + Length(DocType) + Length(HTMLIntro); + LEndFragment := LStartFragment + Length(LFragment); + Result := 'Version:1.0' + CRLF + + Format('StartHTML:%.8d', [DescriptionLength]) + CRLF + + Format('EndHTML:%.8d', [LEndFragment + Length(HTMLExtro)]) + CRLF + + Format('StartFragment:%.8d', [LStartFragment]) + CRLF + + Format('EndFragment:%.8d', [LEndFragment]) + CRLF + + DocType + HTMLIntro + LFragment + HTMLExtro; +end; + procedure TCellSelectionTests.DoChangeCellEvent(Sender: TBaseVirtualTree; const Cells: TVTCellArray); begin if Assigned(FChangeCellEventProc) then @@ -545,7 +603,6 @@ procedure TCellSelectionTests.TestCopyHTML1; n3, n4: PVirtualNode; LText, LExpected: string; LTries: Integer; - LCompareSuccessful: LongBool; begin LTree := FTree; LTree.Font.Name := 'Tahoma'; @@ -584,17 +641,8 @@ procedure TCellSelectionTests.TestCopyHTML1; end; // End unnecessary stuff until (LText <> '') or (LTries > MaxTries); - LExpected := 'Version:1.0'#$D#$A'StartHTML:00000097'#$D#$A'EndHTML:00001737'#$D#$A'StartFragment:00000269'#$D#$A'EndFragment:00001705'#$D#$A + - ''+ - ''#$D#$A + - ''#$D#$A''#$D#$A + - ''#$D#$A+ - ' '#$D#$A' '#$D#$A+ - ' '#$D#$A' '#$D#$A'
col2col3col4
3b 3c 3d
4b 4c 4d
'; - LCompareSuccessful := LText = LExpected; - Assert.IsTrue(LCompareSuccessful, 'Clipboard text is unexpected!'); + LExpected := BuildExpectedCellHTML([n3, n4]); + Assert.AreEqual(LExpected, LText, 'Clipboard HTML does not match the export template!'); end; procedure TCellSelectionTests.TestCopyHTML2; @@ -603,7 +651,6 @@ procedure TCellSelectionTests.TestCopyHTML2; n3, n5: PVirtualNode; LText, LExpected: string; LTries: Integer; - LCompareSuccessful: LongBool; begin LTree := FTree; LTree.Font.Name := 'Tahoma'; @@ -642,18 +689,8 @@ procedure TCellSelectionTests.TestCopyHTML2; end; // End unnecessary stuff until (LText <> '') or (LTries > MaxTries); - LExpected := 'Version:1.0'#$D#$A'StartHTML:00000097'#$D#$A'EndHTML:00001947'#$D#$A'StartFragment:00000269'#$D#$A'EndFragment:00001915'#$D#$A''+ - ''#$D#$A + - ''#$D#$A''#$D#$A+ - ''#$D#$A+ - ' '#$D#$A' '#$D#$A+ - ' '#$D#$A' '#$D#$A' '#$D#$A + - ' '#$D#$A'
col2col3col4
3b 3c 3d
4b 4c 4d
5b 5c 5d
'; - LCompareSuccessful := LText = LExpected; - Assert.IsTrue(LCompareSuccessful, 'Clipboard text is unexpected!'); + LExpected := BuildExpectedCellHTML([n3, FNode4, n5]); + Assert.AreEqual(LExpected, LText, 'Clipboard HTML does not match the export template!'); end; procedure TCellSelectionTests.TestCopyPlainText1;