opensource/HeidiSQL
1
0
Fork 0
mirror of https://github.com/HeidiSQL/HeidiSQL.git synced 2025-08-26 03:01:07 +08:00
Code Issues Packages Projects Releases Wiki Activity

Update VirtualTreeView component code to v8.1.2 from May 30, 2025

Browse Source
This commit is contained in:
Ansgar Becker
2025-06-09 16:58:54 +02:00
parent a5e67cf94e
commit 1562d76b6b
37 changed files with 984 additions and 5342 deletions
Download Patch File Download Diff File Expand all files Collapse all files

441
components/virtualtreeview/Source/VirtualTrees.DragImage.pas
View File

@ -15,7 +15,6 @@ uses
type
// Drag image support for the tree.
TVTTransparency = 0 .. 255;
TVTBias = - 128 .. 127;
// Simple move limitation for the drag image.
TVTDragMoveRestriction = (
@ -27,8 +26,7 @@ type
TVTDragImageStates = set of (
disHidden, // Internal drag image is currently hidden (always hidden if drag image helper interfaces are used).
disInDrag, // Drag image class is currently being used.
disPrepared, // Drag image class is prepared.
disSystemSupport // Running on Windows 2000 or higher. System supports drag images natively.
disPrepared // Drag image class is prepared.
);
// Class to manage header and tree drag image during a drag'n drop operation.
@ -38,38 +36,16 @@ type
FBackImage, // backup of overwritten screen area
FAlphaImage, // target for alpha blending
FDragImage : TBitmap; // the actual drag image to blend to screen
FImagePosition, // position of image (upper left corner) in screen coordinates
FLastPosition : TPoint; // last mouse position in screen coordinates
FTransparency : TVTTransparency; // alpha value of the drag image (0 - fully transparent, 255 - fully opaque)
FPreBlendBias, // value to darken or lighten the drag image before it is blended
FPostBlendBias : TVTBias; // value to darken or lighten the alpha blend result
FFade : Boolean; // determines whether to fade the drag image from center to borders or not
FRestriction : TVTDragMoveRestriction; // determines in which directions the drag image can be moved
FColorKey : TColor; // color to make fully transparent regardless of any other setting
FStates : TVTDragImageStates; // Determines the states of the drag image class.
function GetVisible : Boolean; // True if the drag image is currently hidden (used only when dragging)
procedure InternalShowDragImage(ScreenDC : HDC);
procedure MakeAlphaChannel(Source, Target : TBitmap);
public
constructor Create(AOwner : TCustomControl);
destructor Destroy; override;
function DragTo(P : TPoint; ForceRepaint : Boolean) : Boolean;
procedure EndDrag;
function GetDragImageRect : TRect;
procedure HideDragImage;
procedure PrepareDrag(DragImage : TBitmap; ImagePosition, HotSpot : TPoint; const DataObject : IDataObject);
procedure RecaptureBackground(Tree : TCustomControl; R : TRect; VisibleRegion : HRGN; CaptureNCArea, ReshowDragImage : Boolean);
procedure ShowDragImage;
function WillMove(P : TPoint) : Boolean;
property ColorKey : TColor read FColorKey write FColorKey default clWindow;
property Fade : Boolean read FFade write FFade default False;
property ImagePosition : TPoint read FImagePosition;
property LastPosition : TPoint read FLastPosition;
procedure PrepareDrag(DragImage : TBitmap; HotSpot : TPoint; const DataObject: IDataObject; pColorKey: TColor = clWindow);
property MoveRestriction : TVTDragMoveRestriction read FRestriction write FRestriction default dmrNone;
property PreBlendBias : TVTBias read FPreBlendBias write FPreBlendBias default 0;
property Transparency : TVTTransparency read FTransparency write FTransparency default 128;
property Visible : Boolean read GetVisible;
end;
implementation
@ -89,10 +65,6 @@ uses
constructor TVTDragImage.Create(AOwner : TCustomControl);
begin
FOwner := AOwner;
FTransparency := 128;
FPreBlendBias := 0;
FPostBlendBias := 0;
FFade := False;
FRestriction := dmrNone;
FColorKey := clNone;
end;
@ -108,218 +80,9 @@ end;
//----------------------------------------------------------------------------------------------------------------------
function TVTDragImage.GetVisible : Boolean;
// Returns True if the internal drag image is used (i.e. the system does not natively support drag images) and
// the internal image is currently visible on screen.
begin
Result := FStates * [disHidden, disInDrag, disPrepared, disSystemSupport] = [disInDrag, disPrepared];
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TVTDragImage.InternalShowDragImage(ScreenDC : HDC);
// Frequently called helper routine to actually do the blend and put it onto the screen.
// Only used if the system does not support drag images.
var
BlendMode : TBlendMode;
begin
with FAlphaImage do
BitBlt(Canvas.Handle, 0, 0, Width, Height, FBackImage.Canvas.Handle, 0, 0, SRCCOPY);
if not FFade and (FColorKey = clNone) then
BlendMode := bmConstantAlpha
else
BlendMode := bmMasterAlpha;
with FDragImage do
AlphaBlend(Canvas.Handle, FAlphaImage.Canvas.Handle, Rect(0, 0, Width, Height), Point(0, 0), BlendMode, FTransparency, FPostBlendBias);
with FAlphaImage do
BitBlt(ScreenDC, FImagePosition.X, FImagePosition.Y, Width, Height, Canvas.Handle, 0, 0, SRCCOPY);
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TVTDragImage.MakeAlphaChannel(Source, Target : TBitmap);
// Helper method to create a proper alpha channel in Target (which must be in 32 bit pixel format), depending
// on the settings for the drag image and the color values in Source.
// Only used if the system does not support drag images.
type
PBGRA = ^TBGRA;
TBGRA = packed record
case Boolean of
False :
(Color : Cardinal);
True :
(BGR : array [0 .. 2] of Byte;
Alpha : Byte);
end;
var
Color, ColorKeyRef : COLORREF;
UseColorKey : Boolean;
SourceRun, TargetRun : PBGRA;
X, Y, MaxDimension, HalfWidth, HalfHeight : Integer;
T : Extended;
begin
UseColorKey := ColorKey <> clNone;
ColorKeyRef := ColorToRGB(ColorKey) and $FFFFFF;
// Color values are in the form BGR (red on LSB) while bitmap colors are in the form ARGB (blue on LSB)
// hence we have to swap red and blue in the color key.
with TBGRA(ColorKeyRef) do
begin
X := BGR[0];
BGR[0] := BGR[2];
BGR[2] := X;
end;
with Target do
begin
MaxDimension := Max(Width, Height);
HalfWidth := Width div 2;
HalfHeight := Height div 2;
for Y := 0 to Height - 1 do
begin
TargetRun := Scanline[Y];
SourceRun := Source.Scanline[Y];
for X := 0 to Width - 1 do
begin
Color := SourceRun.Color and $FFFFFF;
if UseColorKey and (Color = ColorKeyRef) then
TargetRun.Alpha := 0
else
begin
// If the color is not the given color key (or none is used) then do full calculation of a bell curve.
T := Exp( - 8 * Sqrt(Sqr((X - HalfWidth) / MaxDimension) + Sqr((Y - HalfHeight) / MaxDimension)));
TargetRun.Alpha := Round(255 * T);
end;
Inc(SourceRun);
Inc(TargetRun);
end;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
function TVTDragImage.DragTo(P : TPoint; ForceRepaint : Boolean) : Boolean;
// Moves the drag image to a new position, which is determined from the passed point P and the previous
// mouse position.
// ForceRepaint is True if something on the screen changed and the back image must be refreshed.
var
ScreenDC : HDC;
DeltaX, DeltaY : Integer;
// optimized drag image move support
RSamp1, RSamp2, // newly added parts from screen which will be overwritten
RDraw1, RDraw2, // parts to be restored to screen
RScroll, RClip : TRect; // ScrollDC of the existent background
begin
// Determine distances to move the drag image. Take care for restrictions.
case FRestriction of
dmrHorizontalOnly :
begin
DeltaX := FLastPosition.X - P.X;
DeltaY := 0;
end;
dmrVerticalOnly :
begin
DeltaX := 0;
DeltaY := FLastPosition.Y - P.Y;
end;
else // dmrNone
DeltaX := FLastPosition.X - P.X;
DeltaY := FLastPosition.Y - P.Y;
end;
Result := (DeltaX <> 0) or (DeltaY <> 0) or ForceRepaint;
if Result then
begin
if Visible then
begin
// All this stuff is only called if we have to handle the drag image ourselves. If the system supports
// drag image then this is all never executed.
ScreenDC := GetDC(0);
try
if (Abs(DeltaX) >= FDragImage.Width) or (Abs(DeltaY) >= FDragImage.Height) or ForceRepaint then
begin
// If moved more than image size then just restore old screen and blit image to new position.
BitBlt(ScreenDC, FImagePosition.X, FImagePosition.Y, FBackImage.Width, FBackImage.Height, FBackImage.Canvas.Handle, 0, 0, SRCCOPY);
GetPixel(ScreenDC, FImagePosition.X, FImagePosition.Y);
if ForceRepaint then
UpdateWindow(FOwner.Handle);
Inc(FImagePosition.X, - DeltaX);
Inc(FImagePosition.Y, - DeltaY);
BitBlt(FBackImage.Canvas.Handle, 0, 0, FBackImage.Width, FBackImage.Height, ScreenDC, FImagePosition.X, FImagePosition.Y, SRCCOPY);
end
else
begin
// overlapping copy
FillDragRectangles(FDragImage.Width, FDragImage.Height, DeltaX, DeltaY, RClip, RScroll, RSamp1, RSamp2, RDraw1, RDraw2);
with FBackImage.Canvas do
begin
// restore uncovered areas of the screen
if DeltaX = 0 then
begin
BitBlt(ScreenDC, FImagePosition.X + RDraw2.Left, FImagePosition.Y + RDraw2.Top, RDraw2.Right, RDraw2.Bottom, Handle, RDraw2.Left, RDraw2.Top, SRCCOPY);
end
else
begin
if DeltaY = 0 then
begin
BitBlt(ScreenDC, FImagePosition.X + RDraw1.Left, FImagePosition.Y + RDraw1.Top, RDraw1.Right, RDraw1.Bottom, Handle, RDraw1.Left, RDraw1.Top, SRCCOPY);
end
else
begin
BitBlt(ScreenDC, FImagePosition.X + RDraw1.Left, FImagePosition.Y + RDraw1.Top, RDraw1.Right, RDraw1.Bottom, Handle, RDraw1.Left, RDraw1.Top, SRCCOPY);
BitBlt(ScreenDC, FImagePosition.X + RDraw1.Left, FImagePosition.Y + RDraw1.Top, RDraw1.Right, RDraw1.Bottom, Handle, RDraw1.Left, RDraw1.Top, SRCCOPY);
end;
end;
// move existent background
ScrollDC(Handle, DeltaX, DeltaY, RScroll, RClip, 0, nil);
Inc(FImagePosition.X, - DeltaX);
Inc(FImagePosition.Y, - DeltaY);
// Get first and second additional rectangle from screen.
if DeltaX = 0 then
begin
BitBlt(Handle, RSamp2.Left, RSamp2.Top, RSamp2.Right, RSamp2.Bottom, ScreenDC, FImagePosition.X + RSamp2.Left, FImagePosition.Y + RSamp2.Top, SRCCOPY);
end
else if DeltaY = 0 then
begin
BitBlt(Handle, RSamp1.Left, RSamp1.Top, RSamp1.Right, RSamp1.Bottom, ScreenDC, FImagePosition.X + RSamp1.Left, FImagePosition.Y + RSamp1.Top, SRCCOPY);
end
else
begin
BitBlt(Handle, RSamp1.Left, RSamp1.Top, RSamp1.Right, RSamp1.Bottom, ScreenDC, FImagePosition.X + RSamp1.Left, FImagePosition.Y + RSamp1.Top, SRCCOPY);
BitBlt(Handle, RSamp2.Left, RSamp2.Top, RSamp2.Right, RSamp2.Bottom, ScreenDC, FImagePosition.X + RSamp2.Left, FImagePosition.Y + RSamp2.Top, SRCCOPY);
end;
end;
end;
InternalShowDragImage(ScreenDC);
finally
ReleaseDC(0, ScreenDC);
end;
end;
FLastPosition.X := P.X;
FLastPosition.Y := P.Y;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TVTDragImage.EndDrag;
begin
HideDragImage;
FStates := FStates - [disInDrag, disPrepared];
FBackImage.Free;
FBackImage := nil;
FDragImage.Free;
@ -330,41 +93,7 @@ end;
//----------------------------------------------------------------------------------------------------------------------
function TVTDragImage.GetDragImageRect : TRect;
// Returns the current size and position of the drag image (screen coordinates).
begin
if Visible then
begin
with FBackImage do
Result := Rect(FImagePosition.X, FImagePosition.Y, FImagePosition.X + Width, FImagePosition.Y + Height);
end
else
Result := Rect(0, 0, 0, 0);
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TVTDragImage.HideDragImage;
var
ScreenDC : HDC;
begin
if Visible then
begin
Include(FStates, disHidden);
ScreenDC := GetDC(0);
try
// restore screen
with FBackImage do
BitBlt(ScreenDC, FImagePosition.X, FImagePosition.Y, Width, Height, Canvas.Handle, 0, 0, SRCCOPY);
finally
ReleaseDC(0, ScreenDC);
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TVTDragImage.PrepareDrag(DragImage : TBitmap; ImagePosition, HotSpot : TPoint; const DataObject : IDataObject);
procedure TVTDragImage.PrepareDrag(DragImage : TBitmap; HotSpot : TPoint; const DataObject : IDataObject; pColorKey: TColor = clWindow);
// Creates all necessary structures to do alpha blended dragging using the given image.
// ImagePostion and HotSpot are given in screen coordinates. The first determines where to place the drag image while
// the second is the initial mouse position.
@ -380,11 +109,11 @@ var
begin
Width := DragImage.Width;
Height := DragImage.Height;
FColorKey := pColorKey;
// Determine whether the system supports the drag helper interfaces.
if Assigned(DataObject) and Succeeded(CoCreateInstance(CLSID_DragDropHelper, nil, CLSCTX_INPROC_SERVER, IDragSourceHelper, DragSourceHelper)) then
begin
Include(FStates, disSystemSupport);
lNullPoint := Point(0, 0);
if Supports(DragSourceHelper, IDragSourceHelper2, lDragSourceHelper2) then
lDragSourceHelper2.SetFlags(DSH_ALLOWDROPDESCRIPTIONTEXT); // Show description texts
@ -395,176 +124,16 @@ begin
// Supply the drag source helper with our drag image.
DragInfo.sizeDragImage.cx := Width;
DragInfo.sizeDragImage.cy := Height;
DragInfo.ptOffset.X := Width div 2;
DragInfo.ptOffset.Y := Height div 2;
DragInfo.ptOffset := HotSpot;
DragInfo.hbmpDragImage := CopyImage(DragImage.Handle, IMAGE_BITMAP, Width, Height, LR_COPYRETURNORG);
DragInfo.crColorKey := ColorToRGB(FColorKey);
if not Succeeded(DragSourceHelper.InitializeFromBitmap(@DragInfo, DataObject)) then
begin
DeleteObject(DragInfo.hbmpDragImage);
Exclude(FStates, disSystemSupport);
end;
end;
end
else
Exclude(FStates, disSystemSupport);
if not (disSystemSupport in FStates) then
begin
FLastPosition := HotSpot;
FDragImage := TBitmap.Create;
FDragImage.PixelFormat := pf32Bit;
FDragImage.SetSize(Width, Height);
FAlphaImage := TBitmap.Create;
FAlphaImage.PixelFormat := pf32Bit;
FAlphaImage.SetSize(Width, Height);
FBackImage := TBitmap.Create;
FBackImage.PixelFormat := pf32Bit;
FBackImage.SetSize(Width, Height);
// Copy the given drag image and apply pre blend bias if required.
if FPreBlendBias = 0 then
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), bmConstantAlpha, 255, FPreBlendBias);
// Create a proper alpha channel also if no fading is required (transparent parts).
MakeAlphaChannel(DragImage, FDragImage);
FImagePosition := ImagePosition;
// Initially the drag image is hidden and will be shown during the immediately following DragEnter event.
FStates := FStates + [disInDrag, disHidden, disPrepared];
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TVTDragImage.RecaptureBackground(Tree : TCustomControl; R : TRect; VisibleRegion : HRGN; CaptureNCArea, ReshowDragImage : Boolean);
// Notification by the drop target tree to update the background image because something in the tree has changed.
// Note: The passed rectangle is given in client coordinates of the current drop target tree (given in Tree).
// The caller does not check if the given rectangle is actually within the drag image. Hence this method must do
// all the checks.
// This method does nothing if the system manages the drag image.
var
DragRect, ClipRect : TRect;
PaintTarget : TPoint;
PaintOptions : TVTInternalPaintOptions;
ScreenDC : HDC;
begin
// Recapturing means we want the tree to paint the new part into our back bitmap instead to the screen.
if Visible then
begin
// Create the minimum rectangle to be recaptured.
MapWindowPoints(Tree.Handle, 0, R, 2);
DragRect := GetDragImageRect;
IntersectRect(R, R, DragRect);
OffsetRgn(VisibleRegion, - DragRect.Left, - DragRect.Top);
// The target position for painting in the drag image is relative and can be determined from screen coordinates too.
PaintTarget.X := R.Left - DragRect.Left;
PaintTarget.Y := R.Top - DragRect.Top;
// The source rectangle is determined by the offsets in the tree.
MapWindowPoints(0, Tree.Handle, R, 2);
OffsetRect(R, - TBaseVirtualTree(Tree).OffsetX, - TBaseVirtualTree(Tree).OffsetY);
// Finally let the tree paint the relevant part and upate the drag image on screen.
PaintOptions := [poBackground, poColumnColor, poDrawFocusRect, poDrawDropMark, poDrawSelection, poGridLines];
with FBackImage do
begin
ClipRect.TopLeft := PaintTarget;
ClipRect.Right := ClipRect.Left + R.Right - R.Left;
ClipRect.Bottom := ClipRect.Top + R.Bottom - R.Top;
// TODO: somehow with clipping, the background image is not drawn on the
// backup image. Need to be diagnosed and fixed. For now, we have coded
// a work around in DragTo where this is used by using the condition
// IsInHeader. (found when solving issue 248)
ClipCanvas(Canvas, ClipRect, VisibleRegion);
TBaseVirtualTree(Tree).PaintTree(Canvas, R, PaintTarget, PaintOptions);
if CaptureNCArea then
begin
// Header is painted in this part only so when you use this routine and want
// to capture the header in backup image, this flag should be ON.
// For the non-client area we only need the visible region of the window as limit for painting.
SelectClipRgn(Canvas.Handle, VisibleRegion);
// Since WM_PRINT cannot be given a position where to draw we simply move the window origin and
// get the same effect.
GetWindowRect(Tree.Handle, ClipRect);
SetCanvasOrigin(Canvas, DragRect.Left - ClipRect.Left, DragRect.Top - ClipRect.Top);
Tree.Perform(WM_PRINT, WPARAM(Canvas.Handle), PRF_NONCLIENT);
SetCanvasOrigin(Canvas, 0, 0);
end;
SelectClipRgn(Canvas.Handle, 0);
if ReshowDragImage then
begin
GDIFlush;
ScreenDC := GetDC(0);
try
InternalShowDragImage(ScreenDC);
finally
ReleaseDC(0, ScreenDC);
end;
end;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TVTDragImage.ShowDragImage;
// Shows the drag image after it has been hidden by HideDragImage.
// Note: there might be a new background now.
// Also this method does nothing if the system manages the drag image.
var
ScreenDC : HDC;
begin
if FStates * [disInDrag, disHidden, disPrepared, disSystemSupport] = [disInDrag, disHidden, disPrepared] then
begin
Exclude(FStates, disHidden);
GDIFlush;
ScreenDC := GetDC(0);
try
BitBlt(FBackImage.Canvas.Handle, 0, 0, FBackImage.Width, FBackImage.Height, ScreenDC, FImagePosition.X, FImagePosition.Y, SRCCOPY);
InternalShowDragImage(ScreenDC);
finally
ReleaseDC(0, ScreenDC);
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
function TVTDragImage.WillMove(P : TPoint) : Boolean;
// This method determines whether the drag image would "physically" move when DragTo would be called with the same
// target point.
// Always returns False if the system drag image support is available.
begin
Result := Visible;
if Result then
begin
// Determine distances to move the drag image. Take care for restrictions.
case FRestriction of
dmrHorizontalOnly :
Result := FLastPosition.X <> P.X;
dmrVerticalOnly :
Result := FLastPosition.Y <> P.Y;
else // dmrNone
Result := (FLastPosition.X <> P.X) or (FLastPosition.Y <> P.Y);
end;
end;
end;
end.