Update VirtualTrees component code to release v7.6.6 from Jan 12 2024

This commit is contained in:
Ansgar Becker
2024-01-29 15:00:26 +01:00
parent ad3709529c
commit f3ce46af4d
47 changed files with 37909 additions and 33934 deletions

View File

@ -34,11 +34,14 @@ uses
System.Types,
Vcl.Graphics,
Vcl.ImgList,
Vcl.Controls;
Vcl.Controls,
VirtualTrees.Types;
type
// Describes the mode how to blend pixels.
/// <summary>
/// Describes the mode how to blend pixels.
/// </summary>
TBlendMode = (
bmConstantAlpha, // apply given constant alpha
bmPerPixelAlpha, // use alpha value of the source pixel
@ -55,45 +58,89 @@ procedure SetBrushOrigin(Canvas: TCanvas; X, Y: Integer); inline;
procedure SetCanvasOrigin(Canvas: TCanvas; X, Y: Integer); inline;
// Clip a given canvas to ClipRect while transforming the given rect to device coordinates.
/// <summary>
/// Clip a given canvas to ClipRect while transforming the given rect to device coordinates.
/// </summary>
procedure ClipCanvas(Canvas: TCanvas; ClipRect: TRect; VisibleRegion: HRGN = 0);
procedure DrawImage(ImageList: TCustomImageList; Index: Integer; Canvas: TCanvas; X, Y: Integer; Style: Cardinal; Enabled: Boolean);
/// <summary>
/// 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.
/// </summary>
function ShortenString(DC: HDC; const S: string; Width: TDimension; EllipsisWidth: TDimension = 0): string; overload;
// 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;
//--------------------------
// ShortenString similar to VTV's version, except:
// -- Does not assume using three dots or any particular character for ellipsis
// -- Does not add ellipsis to string, so could be added anywhere
// -- Requires EllipsisWidth, and zero does nothing special
// Returns:
// ShortenedString as var param
// True if shortened (ie: add ellipsis somewhere), otherwise false
function ShortenString(TargetCanvasDC: HDC; const StrIn: string; const AllowedWidth_px: Integer; const EllipsisWidth_px: Integer; var ShortenedString: string): boolean; overload;
// Wrap the given string S so that it fits into a space of given width.
// RTL determines if right-to-left reading is active.
/// <summary>
/// Wrap the given string S so that it fits into a space of given width.
/// RTL determines if right-to-left reading is active.
/// </summary>
function WrapString(DC: HDC; const S: string; const Bounds: TRect; RTL: Boolean; DrawFormat: Cardinal): string;
// Calculates bounds of a drawing rectangle for the given string
/// <summary>
/// Calculates bounds of a drawing rectangle for the given string
/// </summary>
procedure GetStringDrawRect(DC: HDC; const S: string; var Bounds: TRect; DrawFormat: Cardinal);
// Converts the incoming rectangle so that left and top are always less than or equal to right and bottom.
/// <summary>
/// Converts the incoming rectangle so that left and top are always less than or equal to right and bottom.
/// </summary>
function OrderRect(const R: TRect): TRect;
// 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).
/// <summary>
/// Fills the given rectangles with values which can be used while dragging around an image
/// </summary>
/// <remarks>
/// (used in DragMove of the drag manager and DragTo of the header columns).
/// </remarks>
procedure FillDragRectangles(DragWidth, DragHeight, DeltaX, DeltaY: Integer; var RClip, RScroll, RSamp1, RSamp2, RDraw1, RDraw2: TRect);
// Attaches a bitmap as drag image to an IDataObject, see issue #405
// Usage: Set property DragImageKind to diNoImage, in your event handler OnCreateDataObject
// call VirtualTrees.Utils.ApplyDragImage() with your `IDataObject` and your bitmap.
/// <summary>
/// Attaches a bitmap as drag image to an IDataObject, see issue #405
/// <code>
/// Usage: Set property DragImageKind to diNoImage, in your event handler OnCreateDataObject
/// <para> call VirtualTrees.Utils.ApplyDragImage() with your `IDataObject` and your bitmap.</para>
/// </code>
/// </summary>
procedure ApplyDragImage(const pDataObject: IDataObject; pBitmap: TBitmap);
/// <summary>
/// Returns True if the mouse cursor is currently visible and False in case it is suppressed.
/// Useful when doing hot-tracking on touchscreens, see issue #766
/// </summary>
function IsMouseCursorVisible(): Boolean;
procedure ScaleImageList(const ImgList: TImageList; M, D: Integer);
/// <summary>
/// Returns True if the high contrast theme is anabled in the system settings, False otherwise.
/// </summary>
function IsHighContrastEnabled(): Boolean;
/// <summary>
/// Divide depend of parameter type uses different division operator:
/// <code>Integer uses div</code>
/// <code>Single uses /</code>
/// </summary>
function Divide(const Dimension: Integer; const DivideBy: Integer): Integer; overload; inline;
/// <summary>
/// Divide depend of parameter type uses different division operator:
/// <code>Integer uses div</code>
/// <code>Single uses /</code>
/// </summary>
function Divide(const Dimension: Single; const DivideBy: Integer): Single; overload; inline;
implementation
@ -233,13 +280,14 @@ end;
//----------------------------------------------------------------------------------------------------------------------
function ShortenString(DC: HDC; const S: string; Width: Integer; EllipsisWidth: Integer = 0): string;
function ShortenString(DC: HDC; const S: string; Width: TDimension; EllipsisWidth: TDimension = 0): string;
var
Size: TSize;
Len: Integer;
L, H, N, W: Integer;
L, H, N: Integer;
W: TDimension;
begin
Len := Length(S);
if (Len = 0) or (Width <= 0) then
@ -281,8 +329,75 @@ begin
end;
end;
//--------------------------
function ShortenString(TargetCanvasDC: HDC; const StrIn: string; const AllowedWidth_px: Integer; const EllipsisWidth_px: Integer; var ShortenedString: string): boolean;
//--------------------------
var
Size_px_x_px: TSize; // cx, cy
StrInLen: Integer;
LoLen, HiLen, TestLen, TestWidth_px: Integer;
begin
StrInLen := Length(StrIn);
if (StrInLen = 0) then
Begin
ShortenedString := '';
Result := False; // No ellipsis needed since original was empty
End else
if (AllowedWidth_px <= 0) then
Begin
ShortenedString := '';
Result := True; // Ellipsis needed, since non-empty string replaced.
// But likely will get clipped if AllowedWidth is really zero
End else
begin
// Do a binary search for the optimal string length which fits into the given width.
LoLen := 0;
TestLen := 0;
TestWidth_px := AllowedWidth_px;
HiLen := StrInLen;
while LoLen < HiLen do
begin
TestLen := (LoLen + HiLen + 1) shr 1; // Test average of Lo and Hi
GetTextExtentPoint32W(TargetCanvasDC, PWideChar(StrIn), TestLen, Size_px_x_px);
TestWidth_px := Size_px_x_px.cx + EllipsisWidth_px;
if TestWidth_px <= AllowedWidth_px then
Begin
LoLen := TestLen // Low bound must be at least as much as TestLen
End else
Begin
HiLen := TestLen - 1; // Continue until Hi bound string produces width below AllowedWidth_px
End;
end;
if TestWidth_px <= AllowedWidth_px then
Begin
LoLen := TestLen;
End;
if LoLen >= StrInLen then
Begin
ShortenedString := StrIn;
Result := False;
End else if AllowedWidth_px <= EllipsisWidth_px then
Begin
ShortenedString := '';
Result := True; // Even though Ellipsis won't fit in AllowedWidth,
// let clipping decide how much of ellipsis to show
End else
Begin
ShortenedString := Copy(StrIn, 1, LoLen);
Result := True;
End;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
function WrapString(DC: HDC; const S: string; const Bounds: TRect; RTL: Boolean; DrawFormat: Cardinal): string;
var
@ -1264,27 +1379,8 @@ type
TCustomImageListCast = class(TCustomImageList);
procedure DrawImage(ImageList: TCustomImageList; Index: Integer; Canvas: TCanvas; X, Y: Integer; Style: Cardinal; Enabled: Boolean);
procedure DrawDisabledImage(ImageList: TCustomImageList; Canvas: TCanvas; X, Y, Index: Integer);
var
Params: TImageListDrawParams;
begin
FillChar(Params, SizeOf(Params), 0);
Params.cbSize := SizeOf(Params);
Params.himl := ImageList.Handle;
Params.i := Index;
Params.hdcDst := Canvas.Handle;
Params.x := X;
Params.y := Y;
Params.fState := ILS_SATURATE;
ImageList_DrawIndirect(@Params);
end;
begin
if Enabled then
TCustomImageListCast(ImageList).DoDraw(Index, Canvas, X, Y, Style, Enabled)
else
DrawDisabledImage(ImageList, Canvas, X, Y, Index);
TCustomImageListCast(ImageList).DoDraw(Index, Canvas, X, Y, Style, Enabled)
end;
//----------------------------------------------------------------------------------------------------------------------
@ -1367,6 +1463,8 @@ begin
end;
end;
//----------------------------------------------------------------------------------------------------------------------
function IsHighContrastEnabled(): Boolean;
var
l: HIGHCONTRAST;
@ -1375,5 +1473,17 @@ begin
Result := SystemParametersInfo(SPI_GETHIGHCONTRAST, 0, @l, 0) and ((l.dwFlags and HCF_HIGHCONTRASTON) <> 0);
end;
//----------------------------------------------------------------------------------------------------------------------
function Divide(const Dimension: Single; const DivideBy: Integer): Single;
begin
Result:= Dimension / DivideBy;
end;
//----------------------------------------------------------------------------------------------------------------------
function Divide(const Dimension: Integer; const DivideBy: Integer): Integer;
begin
Result:= Dimension div DivideBy;
end;
end.