diff --git a/Source/VirtualTrees.pas b/Source/VirtualTrees.pas index dea4fe3d2..57e325e61 100644 --- a/Source/VirtualTrees.pas +++ b/Source/VirtualTrees.pas @@ -855,46 +855,28 @@ TVTHintData = record LineBreakStyle: TVTToolTipLineBreakStyle; end; - // Determines the kind of animation when a hint is activated. - // Note: If toHotTrack is present, animation defaults to hatNone to avoid - // delays in hot tracking - THintAnimationType = ( - hatNone, // no animation at all, just display hint/tooltip - hatFade, // fade in the hint/tooltip, like in Windows 2000 - hatSlide // slide in the hint/tooltip, like in Windows 98 - ); - // The trees need an own hint window class because of Unicode output and adjusted font. TVirtualTreeHintWindow = class(THintWindow) strict private FHintData: TVTHintData; - FBackground, - FDrawBuffer, - FTarget: TBitmap; + FDrawBuffer: TBitmap; FTextHeight: Integer; - function DoGetAnimationType: THintAnimationType; virtual; - function AnimationCallback(Step, StepSize: Integer; Data: Pointer): Boolean; procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED; function GetHintWindowDestroyed: Boolean; procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND; procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT; procedure WMShowWindow(var Message: TWMShowWindow); message WM_SHOWWINDOW; - procedure InternalPaint(Step, StepSize: Integer); strict protected procedure CreateParams(var Params: TCreateParams); override; procedure Paint; override; - property Background: TBitmap read FBackground; property DrawBuffer: TBitmap read FDrawBuffer; property HintData: TVTHintData read FHintData; property HintWindowDestroyed: Boolean read GetHintWindowDestroyed; - property Target: TBitmap read FTarget; property TextHeight: Integer read FTextHeight; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; - - procedure ActivateHint(Rect: TRect; const AHint: string); override; function CalcHintRect(MaxWidth: Integer; const AHint: string; AData: Pointer): TRect; override; function IsHintMsg(var Msg: TMsg): Boolean; override; end; @@ -1499,7 +1481,6 @@ THeaderPaintInfo = record // Various events must be handled at different places than they were initiated or need // a persistent storage until they are reset. TVirtualTreeStates = set of ( - tsCancelHintAnimation, // Set when a new hint is about to show but an old hint is still being animated. tsChangePending, // A selection change is pending. tsCheckPropagation, // Set during automatic check state propagation. tsCollapsing, // A full collapse operation is in progress. @@ -5590,45 +5571,15 @@ function TVTDragManager.QueryContinueDrag(EscapePressed: BOOL; KeyState: Integer //---------------------------------------------------------------------------------------------------------------------- -function TVirtualTreeHintWindow.DoGetAnimationType: THintAnimationType; - -// Determines (depending on the properties settings and the system) which hint -// animation type is to be used. - -var - Animation: BOOL; - -begin - SystemParametersInfo(SPI_GETTOOLTIPANIMATION, 0, @Animation, 0); - if not Animation then - Result := hatNone - else - begin - SystemParametersInfo(SPI_GETTOOLTIPFADE, 0, @Animation, 0); - if Animation then - Result := hatFade - else - Result := hatSlide; - end; - - //Disable animation if hot tracking is ON as it causes problems - if (toHotTrack in FHintData.Tree.TreeOptions.PaintOptions) then - Result := hatNone; -end; constructor TVirtualTreeHintWindow.Create(AOwner: TComponent); begin inherited; - FBackground := TBitmap.Create; - FBackground.PixelFormat := pf32Bit; FDrawBuffer := TBitmap.Create; FDrawBuffer.PixelFormat := pf32Bit; - FTarget := TBitmap.Create; - FTarget.PixelFormat := pf32Bit; - - DoubleBuffered := False; // we do our own buffering + //DoubleBuffered := False; // we do our own buffering FHintWindowDestroyed := False; end; @@ -5638,33 +5589,12 @@ destructor TVirtualTreeHintWindow.Destroy; begin FHintWindowDestroyed := True; - - FTarget.Free; FDrawBuffer.Free; - FBackground.Free; inherited; end; //---------------------------------------------------------------------------------------------------------------------- -function TVirtualTreeHintWindow.AnimationCallback(Step, StepSize: Integer; Data: Pointer): Boolean; - -begin - Result := not FHintWindowDestroyed and HandleAllocated and IsWindowVisible(Handle) and - Assigned(FHintData.Tree) and not (tsCancelHintAnimation in FHintData.Tree.FStates); - if Result then - begin - InternalPaint(Step, StepSize); - // We have to allow certain messages to be processed normally for various reasons. - // This introduces another problem however if this hint window is destroyed - // while it is still in the animation loop. A global variable keeps track of - // that case. This is reliable because we can only have one (internal) hint window. - Application.ProcessMessages; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - procedure TVirtualTreeHintWindow.CMTextChanged(var Message: TMessage); begin @@ -5737,64 +5667,7 @@ procedure TVirtualTreeHintWindow.CreateParams(var Params: TCreateParams); //---------------------------------------------------------------------------------------------------------------------- -procedure TVirtualTreeHintWindow.InternalPaint(Step, StepSize: Integer); - - //--------------- local functions ------------------------------------------- - - procedure DoShadowBlend(DC: HDC; R: TRect; Alpha: Integer); - - // Helper routine for shadow blending to shorten the parameter list in frequent calls. - - begin - AlphaBlend(0, DC, R, Point(0, 0), bmConstantAlphaAndColor, Alpha, clBlack); - end; - - //--------------------------------------------------------------------------- - - procedure DrawHintShadow(Canvas: TCanvas; ShadowSize: Integer); - - var - R: TRect; - - begin - // Bottom shadow. - R := Rect(ShadowSize, Height - ShadowSize, Width, Height); - DoShadowBlend(Canvas.Handle, R, 5); - Inc(R.Left); - Dec(R.Right); - Dec(R.Bottom); - DoShadowBlend(Canvas.Handle, R, 10); - Inc(R.Left); - Dec(R.Right); - Dec(R.Bottom); - DoShadowBlend(Canvas.Handle, R, 20); - Inc(R.Left); - Dec(R.Right); - Dec(R.Bottom); - DoShadowBlend(Canvas.Handle, R, 35); - Inc(R.Left); - Dec(R.Right); - Dec(R.Bottom); - DoShadowBlend(Canvas.Handle, R, 50); - // Right shadow. - R := Rect(Width - ShadowSize, ShadowSize, Width, Height - ShadowSize); - DoShadowBlend(Canvas.Handle, R, 5); - Inc(R.Top); - Dec(R.Right); - DoShadowBlend(Canvas.Handle, R, 10); - Inc(R.Top); - Dec(R.Right); - DoShadowBlend(Canvas.Handle, R, 20); - Inc(R.Top); - Dec(R.Right); - DoShadowBlend(Canvas.Handle, R, 35); - Inc(R.Top); - Dec(R.Right); - DoShadowBlend(Canvas.Handle, R, 50); - end; - - //--------------- end local functions --------------------------------------- - +procedure TVirtualTreeHintWindow.Paint(); var R: TRect; Y: Integer; @@ -5811,225 +5684,95 @@ procedure TVirtualTreeHintWindow.InternalPaint(Step, StepSize: Integer); begin Shadow := 0; // TODO: This value is never changed + FDrawBuffer.SetSize(Width, Height); with FHintData, FDrawBuffer do begin // Do actual painting only in the very first run. - if Step = 0 then + // If the given node is nil then we have to display a header hint. + if (Node = nil) or (Tree.FHintMode <> hmToolTip) then begin - // If the given node is nil then we have to display a header hint. - if (Node = nil) or (Tree.FHintMode <> hmToolTip) then - begin - Canvas.Font := Screen.HintFont; - Y := 2; - end + Canvas.Font := Screen.HintFont; + Y := 2; + end + else + begin + Tree.GetTextInfo(Node, Column, Canvas.Font, R, S); + if LineBreakStyle = hlbForceMultiLine then + Y := 1 else - begin - Tree.GetTextInfo(Node, Column, Canvas.Font, R{>>>}, False{<<<}, S); - if LineBreakStyle = hlbForceMultiLine then - Y := 1 - else - Y := (R.Top - R.Bottom - Shadow + Self.Height) div 2; - end; + Y := (R.Top - R.Bottom - Shadow + Self.Height) div 2; + end; - R := Rect(0, 0, Width - Shadow, Height - Shadow); + R := Rect(0, 0, Width - Shadow, Height - Shadow); - HintKind := vhkText; - if Assigned(Node) then - Tree.DoGetHintKind(Node, Column, HintKind); + HintKind := vhkText; + if Assigned(Node) then + Tree.DoGetHintKind(Node, Column, HintKind); - if HintKind = vhkOwnerDraw then + if HintKind = vhkOwnerDraw then + begin + Tree.DoDrawHint(Canvas, Node, R, Column); + end + else + with Canvas do begin - Tree.DoDrawHint(Canvas, Node, R, Column); - end - else - with Canvas do + if Tree.VclStyleEnabled then begin - if Tree.VclStyleEnabled then - begin - LDetails := StyleServices.GetElementDetails(thHintNormal); - if StyleServices.GetElementColor(LDetails, ecGradientColor1, LColor) and (LColor <> clNone) then - LGradientStart := LColor - else - LGradientStart := clInfoBk; - if StyleServices.GetElementColor(LDetails, ecGradientColor2, LColor) and (LColor <> clNone) then - LGradientEnd := LColor - else - LGradientEnd := clInfoBk; - if StyleServices.GetElementColor(LDetails, ecTextColor, LColor) and (LColor <> clNone) then - Font.Color := LColor - else - Font.Color := Screen.HintFont.Color; - GradientFillCanvas(Canvas, LGradientStart, LGradientEnd, R, gdVertical); - end + LDetails := StyleServices.GetElementDetails(thHintNormal); + if StyleServices.GetElementColor(LDetails, ecGradientColor1, LColor) and (LColor <> clNone) then + LGradientStart := LColor else - begin - // Still force tooltip back and text color. - Font.Color := clInfoText; - Pen.Color := clBlack; - Brush.Color := clInfoBk; - if IsWinVistaOrAbove and StyleServices.Enabled and ((toThemeAware in Tree.TreeOptions.PaintOptions) or - (toUseExplorerTheme in Tree.TreeOptions.PaintOptions)) then - begin - if toUseExplorerTheme in Tree.TreeOptions.PaintOptions then // ToolTip style - StyleServices.DrawElement(Canvas.Handle, StyleServices.GetElementDetails(tttStandardNormal), R) - else - begin // Hint style - LClipRect := R; - InflateRect(R, 4, 4); - StyleServices.DrawElement(Handle, StyleServices.GetElementDetails(tttStandardNormal), R, @LClipRect); - R := LClipRect; - StyleServices.DrawEdge(Handle, StyleServices.GetElementDetails(twWindowRoot), R, [eeRaisedOuter], [efRect]); - end; - end - else - if Tree.VclStyleEnabled then - StyleServices.DrawElement(Canvas.Handle, StyleServices.GetElementDetails(tttStandardNormal), R) - else - Rectangle(R); - end; - // Determine text position and don't forget the border. - InflateRect(R, -1, -1); - DrawFormat := DT_TOP or DT_NOPREFIX; - SetBkMode(Handle, Winapi.Windows.TRANSPARENT); - R.Top := Y; - R.Left := R.Left + 3; // Make the text more centered - if Assigned(Node) and (LineBreakStyle = hlbForceMultiLine) then - DrawFormat := DrawFormat or DT_WORDBREAK; - Winapi.Windows.DrawTextW(Handle, PWideChar(HintText), Length(HintText), R, DrawFormat); - end; - end; - end; - - - if StepSize > 0 then - begin - if DoGetAnimationType = hatFade then - begin - with FTarget do - BitBlt(Canvas.Handle, 0, 0, Width, Height, FBackground.Canvas.Handle, 0, 0, SRCCOPY); - // Main image. - AlphaBlend(FDrawBuffer.Canvas.Handle, FTarget.Canvas.Handle, Rect(0, 0, Width - Shadow, Height - Shadow), - Point(0, 0), bmConstantAlpha, MulDiv(Step, 256, FadeAnimationStepCount), 0); - - if Shadow > 0 then - DrawHintShadow(FTarget.Canvas, Shadow); - BitBlt(Canvas.Handle, 0, 0, Width, Height, FTarget.Canvas.Handle, 0, 0, SRCCOPY); + LGradientStart := clInfoBk; + if StyleServices.GetElementColor(LDetails, ecGradientColor2, LColor) and (LColor <> clNone) then + LGradientEnd := LColor + else + LGradientEnd := clInfoBk; + if StyleServices.GetElementColor(LDetails, ecTextColor, LColor) and (LColor <> clNone) then + Font.Color := LColor + else + Font.Color := Screen.HintFont.Color; + GradientFillCanvas(Canvas, LGradientStart, LGradientEnd, R, gdVertical); end else begin - // Slide is done by blitting "step" lines of the lower part of the hint window - // and fill the rest with the screen background. - - // 1) blit hint bitmap to the hint canvas - BitBlt(Canvas.Handle, 0, 0, Width - Shadow, Step, FDrawBuffer.Canvas.Handle, 0, Height - Step, SRCCOPY); - // 2) blit background rest to hint canvas - if Step <= Shadow then - Step := 0 - else - Dec(Step, Shadow); - BitBlt(Canvas.Handle, 0, Step, Width, Height - Step, FBackground.Canvas.Handle, 0, Step, SRCCOPY); - end; - end - else - // Last step during slide or the only step without animation. - if DoGetAnimationType <> hatFade then - begin - if Shadow > 0 then + // Still force tooltip back and text color. + Font.Color := clInfoText; + Pen.Color := clBlack; + Brush.Color := clInfoBk; + if IsWinVistaOrAbove and StyleServices.Enabled and ((toThemeAware in Tree.TreeOptions.PaintOptions) or + (toUseExplorerTheme in Tree.TreeOptions.PaintOptions)) then begin - with FBackground do - BitBlt(Canvas.Handle, 0, 0, Width - Shadow, Height - Shadow, FDrawBuffer.Canvas.Handle, 0, 0, SRCCOPY); - - DrawHintShadow(FBackground.Canvas, Shadow); - BitBlt(Canvas.Handle, 0, 0, Width, Height, FBackground.Canvas.Handle, 0, 0, SRCCOPY); + if toUseExplorerTheme in Tree.TreeOptions.PaintOptions then // ToolTip style + StyleServices.DrawElement(Canvas.Handle, StyleServices.GetElementDetails(tttStandardNormal), R) + else + begin // Hint style + LClipRect := R; + InflateRect(R, 4, 4); + StyleServices.DrawElement(Handle, StyleServices.GetElementDetails(tttStandardNormal), R, @LClipRect); + R := LClipRect; + StyleServices.DrawEdge(Handle, StyleServices.GetElementDetails(twWindowRoot), R, [eeRaisedOuter], [efRect]); + end; end else - BitBlt(Canvas.Handle, 0, 0, Width, Height, FDrawBuffer.Canvas.Handle, 0, 0, SRCCOPY); + if Tree.VclStyleEnabled then + StyleServices.DrawElement(Canvas.Handle, StyleServices.GetElementDetails(tttStandardNormal), R) + else + Rectangle(R); end; - -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeHintWindow.Paint; - -begin - InternalPaint(0, 0); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeHintWindow.ActivateHint(Rect: TRect; const AHint: string); - -var - DC: HDC; - StopLastAnimation: Boolean; - lCursorPos: TPoint; -begin - if IsRectEmpty(Rect) or not Assigned(FHintData.Tree) or - not GetCursorPos(lCursorPos) or not PtInRect(FHintData.Tree.FLastHintRect, FHintData.Tree.ScreenToClient(lCursorPos)) - then - Application.CancelHint - else - begin - // There is already an animation. Start a new one but do not continue the old one once we are finished here. - StopLastAnimation := (tsInAnimation in FHintData.Tree.FStates); - if StopLastAnimation then - FHintData.Tree.DoStateChange([], [tsInAnimation]); - - SetWindowPos(Handle, 0, Rect.Left, Rect.Top, Width, Height, SWP_HIDEWINDOW or SWP_NOACTIVATE or SWP_NOZORDER); - UpdateBoundsRect(Rect); - - // Make sure the whole hint is visible on the monitor. Don't forget multi-monitor systems with the - // primary monitor not being at the top-left corner. - if Rect.Top - Screen.DesktopTop + Height > Screen.DesktopHeight then - Rect.Top := Screen.DesktopHeight - Height + Screen.DesktopTop; - if Rect.Left - Screen.DesktopLeft + Width > Screen.DesktopWidth then - Rect.Left := Screen.DesktopWidth - Width + Screen.DesktopLeft; - if Rect.Bottom - Screen.DesktopTop < Screen.DesktopTop then - Rect.Bottom := Screen.DesktopTop + Screen.DesktopTop; - if Rect.Left - Screen.DesktopLeft < Screen.DesktopLeft then - Rect.Left := Screen.DesktopLeft + Screen.DesktopLeft; - - // adjust sizes of bitmaps - FDrawBuffer.SetSize(Width, Height); - FBackground.SetSize(Width, Height); - FTarget.SetSize(Width, Height); - - FHintData.Tree.Update; - - // capture screen - DC := GetDC(0); - try - with TWithSafeRect(Rect) do - BitBlt(FBackground.Canvas.Handle, 0, 0, Width, Height, DC, Left, Top, SRCCOPY); - finally - ReleaseDC(0, DC); - end; - - SetWindowPos(Handle, HWND_TOPMOST, Rect.Left, Rect.Top, Width, Height, SWP_SHOWWINDOW or SWP_NOACTIVATE); - with FHintData.Tree do - case DoGetAnimationType of - hatNone: - InvalidateRect(Self.Handle, nil, False); - hatFade: - begin - // Make sure the window is not drawn unanimated. - ValidateRect(Self.Handle, nil); - // Empirically determined animation duration shows that fading needs about twice as much time as - // sliding to show a comparable visual effect. - Animate(FadeAnimationStepCount, 2 * FAnimationDuration, AnimationCallback, nil); - end; - hatSlide: - begin - // Make sure the window is not drawn unanimated. - ValidateRect(Self.Handle, nil); - Animate(Self.Height, FAnimationDuration, AnimationCallback, nil); - end; + // Determine text position and don't forget the border. + InflateRect(R, -1, -1); + DrawFormat := DT_TOP or DT_NOPREFIX; + SetBkMode(Handle, Winapi.Windows.TRANSPARENT); + R.Top := Y; + R.Left := R.Left + 3; // Make the text more centered + if Assigned(Node) and (LineBreakStyle = hlbForceMultiLine) then + DrawFormat := DrawFormat or DT_WORDBREAK; + Winapi.Windows.DrawTextW(Handle, PWideChar(HintText), Length(HintText), R, DrawFormat); end; - if not FHintWindowDestroyed and StopLastAnimation and Assigned(FHintData.Tree) then - FHintData.Tree.DoStateChange([tsCancelHintAnimation]); end; + //TODO: Can we paint on the canvas directly? + BitBlt(Canvas.Handle, 0, 0, Width, Height, FDrawBuffer.Canvas.Handle, 0, 0, SRCCOPY); end; //---------------------------------------------------------------------------------------------------------------------- @@ -18856,7 +18599,7 @@ procedure TBaseVirtualTree.Animate(Steps, Duration: Cardinal; Callback: TVTAnima if not Application.Terminated then Callback(0, 0, Data); finally - DoStateChange([], [tsCancelHintAnimation, tsInAnimation]); + DoStateChange([], [tsInAnimation]); end; end; end; @@ -22434,7 +22177,7 @@ function TBaseVirtualTree.GetHeaderClass: TVTHeaderClass; function TBaseVirtualTree.GetHintWindowClass: THintWindowClass; -// Returns the default hint window class used for the tree. Descendants can override it to use their own System.Classes. +// Returns the default hint window class used for the tree. Descendants can override it to use their own classes. begin Result := TVirtualTreeHintWindow;