david
7ebea5ffa7
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.jvcl@12 7f62d464-2af8-f54e-996c-e91b33f51cbe
2400 lines
72 KiB
ObjectPascal
2400 lines
72 KiB
ObjectPascal
{-----------------------------------------------------------------------------
|
|
The contents of this file are subject to the Mozilla Public License
|
|
Version 1.1 (the "License"); you may not use this file except in compliance
|
|
with the License. You may obtain a copy of the License at
|
|
http://www.mozilla.org/MPL/MPL-1.1.html
|
|
|
|
Software distributed under the License is distributed on an "AS IS" basis,
|
|
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
|
|
the specific language governing rights and limitations under the License.
|
|
|
|
The Original Code is: JvBalloonHint.PAS, released on 2001-02-28.
|
|
|
|
The Initial Developer of the Original Code is Remko Bonte <remkobonte att myrealbox dott com>
|
|
Portions created by Remko Bonte are Copyright (C) 2002 Remko Bonte.
|
|
All Rights Reserved.
|
|
|
|
Contributor(s):
|
|
|
|
2006-01-17 - J. Vignoles - Added support for Unicode hint and header
|
|
|
|
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
|
|
located at http://jvcl.sourceforge.net
|
|
|
|
Known Issues:
|
|
* Only dropdown shadow for windows xp systems.
|
|
* Only custom animation for windows xp systems, because of use of window region.
|
|
-----------------------------------------------------------------------------}
|
|
// $Id: JvBalloonHint.pas 11893 2008-09-09 20:45:14Z obones $
|
|
|
|
unit JvBalloonHint;
|
|
|
|
{$I jvcl.inc}
|
|
{$I windowsonly.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFDEF UNITVERSIONING}
|
|
JclUnitVersioning,
|
|
{$ENDIF UNITVERSIONING}
|
|
Windows, Messages, Classes, Controls, Graphics, Forms, ImgList,
|
|
JvComponentBase;
|
|
|
|
const
|
|
cJvBallonHintVisibleTimeDefault = 5000;
|
|
|
|
type
|
|
TJvStemSize = (ssExtraSmall, ssSmall, ssNormal, ssLarge);
|
|
TJvIconKind = (ikCustom, ikNone, ikApplication, ikError, ikInformation, ikQuestion, ikWarning);
|
|
TJvBalloonOption = (boUseDefaultHeader, boUseDefaultIcon, boUseDefaultImageIndex,
|
|
boShowCloseBtn, boCustomAnimation, boPlaySound);
|
|
TJvBalloonOptions = set of TJvBalloonOption;
|
|
TJvApplicationHintOption = (ahShowHeaderInHint, ahShowIconInHint, ahPlaySound);
|
|
TJvApplicationHintOptions = set of TJvApplicationHintOption;
|
|
TJvBalloonPosition = (bpAuto, bpLeftDown, bpRightDown, bpLeftUp, bpRightUp);
|
|
TJvAnimationStyle = (atNone, atSlide, atRoll, atRollHorNeg, atRollHorPos, atRollVerNeg,
|
|
atRollVerPos, atSlideHorNeg, atSlideHorPos, atSlideVerNeg, atSlideVerPos, atCenter, atBlend);
|
|
|
|
TJvBalloonHint = class;
|
|
|
|
PHintData = ^THintData;
|
|
THintData = record
|
|
RAnchorWindow: TCustomForm;
|
|
{ Position of the top-left edge of the window balloon inside the client
|
|
rect of the anchor window (Used to move the balloon window if the
|
|
anchor window moves): }
|
|
RAnchorPosition: TPoint;
|
|
{ Position of the stem point inside the client rect of the balloon window
|
|
(Used the check on resize of the anchor window whether the stem point is
|
|
still inside the balloon window): }
|
|
RStemPointPosition: TPoint;
|
|
RUTF8Header: {$IFDEF RTL200_UP}UTF8String{$ELSE}string{$ENDIF RTL200_UP};
|
|
RUTF8Hint: {$IFDEF RTL200_UP}UTF8String{$ELSE}string{$ENDIF RTL200_UP};
|
|
RIconKind: TJvIconKind;
|
|
RImageIndex: TImageIndex;
|
|
RVisibleTime: Integer;
|
|
RShowCloseBtn: Boolean;
|
|
RAnimationStyle: TJvAnimationStyle;
|
|
RAnimationTime: Cardinal;
|
|
{ If the position of the balloon needs to be changed - for example if
|
|
DefaultBalloonPosition = bpAuto - RSwitchHeight indicates how much we
|
|
change the vertical position; if the balloon is an application hint,
|
|
RSwitchHeight is the height of the cursor; if the balloon is attached to
|
|
a control, RSwitchHeight is the height of that control }
|
|
RSwitchHeight: Integer;
|
|
end;
|
|
|
|
TJvBalloonWindow = class(THintWindow)
|
|
private
|
|
FCurrentPosition: TJvBalloonPosition;
|
|
FSwitchHeight: Integer;
|
|
FShowIcon: Boolean;
|
|
FShowHeader: Boolean;
|
|
FMsg: WideString;
|
|
FHeader: WideString;
|
|
FTipHeight: Integer;
|
|
FTipWidth: Integer;
|
|
FTipDelta: Integer;
|
|
FImageSize: TSize;
|
|
|
|
FIconPos: TPoint;
|
|
FRoundRect: TRect;
|
|
FStemRect: TRect;
|
|
FMsgRect: TRect;
|
|
FHeaderRect: TRect;
|
|
FCloseBtnRect: TRect;
|
|
FShowCloseBtn: Boolean;
|
|
FIsMultiLineMsg: Boolean;
|
|
FUseRegion: Boolean;
|
|
|
|
function GetStemPointPosition: TPoint;
|
|
function GetStemPointPositionInRect(const ARect: TRect): TPoint;
|
|
function MultiLineWidth(const Value: string): Integer;
|
|
protected
|
|
procedure CMTextChanged(var Msg: TMessage); message CM_TEXTCHANGED;
|
|
procedure CMShowingChanged(var Msg: TMessage); message CM_SHOWINGCHANGED;
|
|
procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
|
|
procedure CreateParams(var Params: TCreateParams); override;
|
|
{$IFDEF COMPILER6_UP}
|
|
procedure NCPaint(DC: HDC); override;
|
|
{$ELSE}
|
|
procedure WMNCPaint(var Msg: TMessage); message WM_NCPAINT;
|
|
{$ENDIF COMPILER6_UP}
|
|
procedure Paint; override;
|
|
|
|
{$IFDEF JVCLThemesEnabled}
|
|
function CreateThemedRegion: HRGN;
|
|
{$ENDIF JVCLThemesEnabled}
|
|
function CreateRegion: HRGN;
|
|
procedure UpdateRegion;
|
|
procedure CalcAutoPosition(var ARect: TRect);
|
|
procedure CheckPosition(var ARect: TRect);
|
|
|
|
function CalcOffset(const ARect: TRect): TPoint;
|
|
procedure MeasureHeader(const MaxWidth: Integer; var AWidth, AHeight: Integer); virtual;
|
|
procedure MeasureMsg(const MaxWidth: Integer; var AWidth, AHeight: Integer); virtual;
|
|
procedure Init(AData: Pointer); virtual;
|
|
procedure CreateWnd; override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
procedure ActivateHint(Rect: TRect; const AHint: string); override;
|
|
function CalcHintRect(MaxWidth: Integer; const AHint: string;
|
|
AData: Pointer): TRect; override;
|
|
function CalcHintRectUTF8(MaxWidth: Integer; const AUTF8Hint: {$IFDEF RTL200_UP}UTF8String{$ELSE}string{$ENDIF RTL200_UP};
|
|
AData: Pointer): TRect; virtual;
|
|
function CalcHintRectW(MaxWidth: Integer; const AHint: WideString;
|
|
AData: Pointer): TRect; virtual;
|
|
property StemPointPosition: TPoint read GetStemPointPosition;
|
|
end;
|
|
|
|
TJvBalloonWindowEx = class(TJvBalloonWindow)
|
|
private
|
|
FCtrl: TJvBalloonHint;
|
|
FCloseState: Cardinal;
|
|
FImageIndex: TImageIndex;
|
|
FIconKind: TJvIconKind;
|
|
FAnimationTime: Cardinal;
|
|
FAnimationStyle: TJvAnimationStyle;
|
|
FIsAnchored: Boolean;
|
|
protected
|
|
procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
|
|
procedure WMMouseMove(var Msg: TWMMouseMove); message WM_MOUSEMOVE;
|
|
procedure WMLButtonDown(var Msg: TWMLButtonDown); message WM_LBUTTONDOWN;
|
|
procedure WMLButtonUp(var Msg: TWMLButtonUp); message WM_LBUTTONUP;
|
|
procedure WMActivateApp(var Msg: TWMActivateApp); message WM_ACTIVATEAPP;
|
|
|
|
procedure Paint; override;
|
|
|
|
{ Either calls NormalizeTopMost or RestoreTopMost depending on whether the
|
|
anchor window has focus }
|
|
procedure EnsureTopMost;
|
|
{ Sets the balloon on top of anchor window; but below other windows }
|
|
procedure NormalizeTopMost;
|
|
{ Sets the balloon top most }
|
|
procedure RestoreTopMost;
|
|
|
|
procedure InternalActivateHint(var Rect: TRect; const AHint: string);
|
|
procedure MoveWindow(NewPos: TPoint);
|
|
procedure ChangeCloseState(const AState: Cardinal);
|
|
|
|
procedure Init(AData: Pointer); override;
|
|
end;
|
|
|
|
TJvBalloonHint = class(TJvComponent)
|
|
private
|
|
FHint: TJvBalloonWindowEx;
|
|
FActive: Boolean;
|
|
FOptions: TJvBalloonOptions;
|
|
FImages: TCustomImageList;
|
|
FDefaultHeader: WideString;
|
|
FDefaultIcon: TJvIconKind;
|
|
FDefaultImageIndex: TImageIndex;
|
|
FData: THintData;
|
|
FApplicationHintOptions: TJvApplicationHintOptions;
|
|
FDefaultBalloonPosition: TJvBalloonPosition;
|
|
FCustomAnimationTime: Cardinal;
|
|
FCustomAnimationStyle: TJvAnimationStyle;
|
|
|
|
FOnBalloonClick: TNotifyEvent;
|
|
FOnClose: TNotifyEvent;
|
|
FOnCloseBtnClick: TCloseQueryEvent;
|
|
FOnDblClick: TNotifyEvent;
|
|
FOnMouseDown: TMouseEvent;
|
|
FOnMouseMove: TMouseMoveEvent;
|
|
FOnMouseUp: TMouseEvent;
|
|
|
|
FHandle: THandle;
|
|
FTimerActive: Boolean;
|
|
FMaxWidth: Integer;
|
|
|
|
function GetHandle: THandle;
|
|
function GetUseBalloonAsApplicationHint: Boolean;
|
|
procedure SetImages(const Value: TCustomImageList);
|
|
procedure SetOptions(const Value: TJvBalloonOptions);
|
|
procedure SetUseBalloonAsApplicationHint(const Value: Boolean);
|
|
protected
|
|
function HookProc(var Msg: TMessage): Boolean;
|
|
procedure Hook;
|
|
procedure UnHook;
|
|
|
|
procedure HandleMouseDown(Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
procedure HandleMouseUp(Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
procedure HandleMouseMove(Sender: TObject; Shift: TShiftState;
|
|
X, Y: Integer);
|
|
procedure HandleClick(Sender: TObject);
|
|
procedure HandleDblClick(Sender: TObject);
|
|
function HandleCloseBtnClick: Boolean;
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
|
|
procedure StartHintTimer(Value: Integer);
|
|
procedure StopHintTimer;
|
|
|
|
procedure InternalActivateHintPos;
|
|
procedure InternalActivateHint(ACtrl: TControl);
|
|
|
|
procedure WndProc(var Msg: TMessage);
|
|
|
|
property Handle: THandle read GetHandle;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
procedure ActivateHint(ACtrl: TControl; const AHint: WideString; const AHeader: WideString = '';
|
|
const VisibleTime: Integer = cJvBallonHintVisibleTimeDefault); overload;
|
|
procedure ActivateHint(ACtrl: TControl; const AHint: WideString; const AImageIndex: TImageIndex;
|
|
const AHeader: WideString = ''; const VisibleTime: Integer = cJvBallonHintVisibleTimeDefault); overload;
|
|
procedure ActivateHint(ACtrl: TControl; const AHint: WideString; const AIconKind: TJvIconKind;
|
|
const AHeader: WideString = ''; const VisibleTime: Integer = cJvBallonHintVisibleTimeDefault); overload;
|
|
procedure ActivateHintPos(AAnchorWindow: TCustomForm; AAnchorPosition: TPoint;
|
|
const AHeader, AHint: WideString; const VisibleTime: Integer = cJvBallonHintVisibleTimeDefault;
|
|
const AIconKind: TJvIconKind = ikInformation; const AImageIndex: TImageIndex = -1);
|
|
procedure ActivateHintRect(ARect: TRect; const AHeader, AHint: WideString;
|
|
const VisibleTime: Integer = cJvBallonHintVisibleTimeDefault; const AIconKind: TJvIconKind = ikInformation;
|
|
const AImageIndex: TImageIndex = -1);
|
|
procedure CancelHint;
|
|
|
|
property Active: Boolean read FActive;
|
|
published
|
|
property CustomAnimationStyle: TJvAnimationStyle read FCustomAnimationStyle write
|
|
FCustomAnimationStyle default atBlend;
|
|
property CustomAnimationTime: Cardinal read FCustomAnimationTime write FCustomAnimationTime
|
|
default 100;
|
|
property DefaultBalloonPosition: TJvBalloonPosition read FDefaultBalloonPosition write
|
|
FDefaultBalloonPosition default bpAuto;
|
|
property DefaultImageIndex: TImageIndex read FDefaultImageIndex write FDefaultImageIndex
|
|
default -1;
|
|
property DefaultHeader: WideString read FDefaultHeader write FDefaultHeader;
|
|
property DefaultIcon: TJvIconKind read FDefaultIcon write FDefaultIcon default ikInformation;
|
|
property Images: TCustomImageList read FImages write SetImages;
|
|
property Options: TJvBalloonOptions read FOptions write SetOptions default [boShowCloseBtn];
|
|
property ApplicationHintOptions: TJvApplicationHintOptions read FApplicationHintOptions write
|
|
FApplicationHintOptions default [ahShowHeaderInHint, ahShowIconInHint];
|
|
property UseBalloonAsApplicationHint: Boolean read GetUseBalloonAsApplicationHint write
|
|
SetUseBalloonAsApplicationHint default False;
|
|
|
|
property MaxWidth: Integer read FMaxWidth write FMaxWidth default 0;
|
|
|
|
property OnBalloonClick: TNotifyEvent read FOnBalloonClick write FOnBalloonClick;
|
|
property OnCloseBtnClick: TCloseQueryEvent read FOnCloseBtnClick write FOnCloseBtnClick;
|
|
property OnClose: TNotifyEvent read FOnClose write FOnClose;
|
|
property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
|
|
property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
|
|
property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
|
|
property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
|
|
end;
|
|
|
|
{$IFDEF UNITVERSIONING}
|
|
const
|
|
UnitVersioning: TUnitVersionInfo = (
|
|
RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/branches/JVCL3_36_PREPARATION/run/JvBalloonHint.pas $';
|
|
Revision: '$Revision: 11893 $';
|
|
Date: '$Date: 2008-09-09 22:45:14 +0200 (mar., 09 sept. 2008) $';
|
|
LogPath: 'JVCL\run'
|
|
);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
implementation
|
|
|
|
uses
|
|
SysUtils, Math,
|
|
Registry, CommCtrl, MMSystem,
|
|
{$IFDEF JVCLThemesEnabled}
|
|
UxTheme,
|
|
{$IFNDEF COMPILER7_UP}
|
|
TmSchema,
|
|
{$ENDIF !COMPILER7_UP}
|
|
{$ENDIF JVCLThemesEnabled}
|
|
{$IFDEF SUPPORTS_INLINE}
|
|
Types,
|
|
{$ENDIF SUPPORTS_INLINE}
|
|
ComCtrls, // needed for GetComCtlVersion
|
|
{$IFNDEF COMPILER12_UP}
|
|
JvJCLUtils,
|
|
{$ENDIF ~COMPILER12_UP}
|
|
JvJVCLUtils, JvThemes, JvWndProcHook, JvResources, JvWin32,
|
|
JclStringConversions, JclUnicode, JvVCL5Utils;
|
|
|
|
const
|
|
{ TJvStemSize = (ssSmall, ssNormal, ssLarge);
|
|
ssLarge isn't used (yet)
|
|
}
|
|
cTipHeight: array [TJvStemSize] of Integer = (12, 19, 21, 24);
|
|
cTipWidth: array [TJvStemSize] of Integer = (12, 19, 21, 24);
|
|
cTipDelta: array [TJvStemSize] of Integer = (16, 16, 16, 17);
|
|
DefaultTextFlags: Longint = DT_LEFT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX;
|
|
|
|
{$IFDEF JVCLThemesEnabled}
|
|
const
|
|
{$IFNDEF DELPHI11_UP}
|
|
TTBSS_POINTINGUPLEFTWALL = 1;
|
|
TTBSS_POINTINGUPCENTERED = 2;
|
|
TTBSS_POINTINGUPRIGHTWALL = 3;
|
|
TTBSS_POINTINGDOWNRIGHTWALL = 4;
|
|
TTBSS_POINTINGDOWNCENTERED = 5;
|
|
TTBSS_POINTINGDOWNLEFTWALL = 6;
|
|
|
|
TTP_BALLOONSTEM = 6;
|
|
{$ENDIF !DELPHI11_UP}
|
|
|
|
cBalloonStemState: array [TJvBalloonPosition] of Integer = (
|
|
TTBSS_POINTINGUPRIGHTWALL, // bpAuto
|
|
TTBSS_POINTINGUPRIGHTWALL, // bpLeftDown
|
|
TTBSS_POINTINGUPLEFTWALL, // bpRightDown
|
|
TTBSS_POINTINGDOWNRIGHTWALL, // bpLeftUp
|
|
TTBSS_POINTINGDOWNLEFTWALL // bpRightUp
|
|
);
|
|
{$ENDIF JVCLThemesEnabled}
|
|
|
|
// Unicode wrapping around DrawTextW so that if ran under Win98/Me, it
|
|
// continues to work.
|
|
type
|
|
TDrawTextW = function(hDC: HDC; lpString: PWideChar; nCount: Integer;
|
|
var lpRect: TRect; uFormat: UINT): Integer; stdcall;
|
|
|
|
var
|
|
_DrawTextW: TDrawTextW = nil;
|
|
|
|
procedure InitUnicodeWrap;
|
|
var
|
|
UserHandle: HMODULE;
|
|
begin
|
|
{ The system DLLs for Windows 98 have export symbols for wide character
|
|
functions as well, but they all return FALSE, and GetLastError would return
|
|
ERROR_CALL_NOT_IMPLEMENTED (120), so don't try to load DrawTextW for
|
|
Windows 98 }
|
|
|
|
if Win32Platform = VER_PLATFORM_WIN32_NT then
|
|
begin
|
|
{ All Windows programs already load user32.dll so we can use GetModuleHandle }
|
|
UserHandle := GetModuleHandle('USER32');
|
|
if UserHandle <> 0 then
|
|
@_DrawTextW := GetProcAddress(UserHandle, 'DrawTextW');
|
|
end;
|
|
end;
|
|
|
|
function DrawTextW(hDC: HDC; const WS: WideString; var lpRect: TRect; uFormat: UINT): Integer;
|
|
var
|
|
S: string;
|
|
begin
|
|
if Assigned(_DrawTextW) then
|
|
Result := _DrawTextW(hDC, PWideChar(WS), Length(WS), lpRect, uFormat)
|
|
else
|
|
begin
|
|
{ The Microsoft Layer for Unicode dll UNICOWS.DLL does probably the same as
|
|
the following: }
|
|
S := WideCharLenToString(PWideChar(WS), Length(WS));
|
|
Result := DrawTextA(hDC, PAnsiChar(AnsiString(S)), Length(S), lpRect, uFormat);
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF COMPILER5}
|
|
|
|
type
|
|
TAnimateWindowProc = function(hWnd: HWND; dwTime: DWORD; dwFlags: DWORD): BOOL; stdcall;
|
|
|
|
var
|
|
AnimateWindowProc: TAnimateWindowProc = nil;
|
|
|
|
procedure InitD5Controls;
|
|
var
|
|
UserHandle: HMODULE;
|
|
begin
|
|
if not Assigned(AnimateWindowProc) then
|
|
begin
|
|
UserHandle := GetModuleHandle('USER32');
|
|
if UserHandle <> 0 then
|
|
@AnimateWindowProc := GetProcAddress(UserHandle, 'AnimateWindow');
|
|
end;
|
|
end;
|
|
|
|
{$ENDIF COMPILER5}
|
|
|
|
function WorkAreaRect: TRect;
|
|
begin
|
|
SystemParametersInfo(SPI_GETWORKAREA, 0, @Result, 0);
|
|
end;
|
|
|
|
function DesktopRect: TRect;
|
|
begin
|
|
Result := Rect(GetSystemMetrics(SM_XVIRTUALSCREEN),
|
|
GetSystemMetrics(SM_YVIRTUALSCREEN),
|
|
GetSystemMetrics(SM_CXVIRTUALSCREEN),
|
|
GetSystemMetrics(SM_CYVIRTUALSCREEN));
|
|
end;
|
|
|
|
function IsWinXP_UP: Boolean;
|
|
begin
|
|
Result := (Win32Platform = VER_PLATFORM_WIN32_NT) and
|
|
((Win32MajorVersion > 5) or
|
|
(Win32MajorVersion = 5) and (Win32MinorVersion >= 1));
|
|
end;
|
|
|
|
function IsWinVista_UP: Boolean;
|
|
begin
|
|
Result := (Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion >= 6);
|
|
end;
|
|
|
|
{$IFDEF COMPILER6_UP}
|
|
function InternalClientToParent(AControl: TControl; const Point: TPoint;
|
|
AParent: TWinControl): TPoint;
|
|
begin
|
|
Result := AControl.ClientToParent(Point, AParent);
|
|
end;
|
|
{$ELSE}
|
|
function InternalClientToParent(AControl: TControl; const Point: TPoint;
|
|
AParent: TWinControl): TPoint;
|
|
var
|
|
LParent: TWinControl;
|
|
begin
|
|
if AParent = nil then
|
|
AParent := AControl.Parent;
|
|
if AParent = nil then
|
|
raise EInvalidOperation.CreateResFmt(@RsEParentRequired, [AControl.Name]);
|
|
Result := Point;
|
|
Inc(Result.X, AControl.Left);
|
|
Inc(Result.Y, AControl.Top);
|
|
LParent := AControl.Parent;
|
|
while LParent <> nil do
|
|
begin
|
|
if LParent.Parent <> nil then
|
|
begin
|
|
Inc(Result.X, LParent.Left);
|
|
Inc(Result.Y, LParent.Top);
|
|
end;
|
|
if LParent = AParent then
|
|
Break
|
|
else
|
|
LParent := LParent.Parent;
|
|
end;
|
|
if LParent = nil then
|
|
raise EInvalidOperation.CreateResFmt(@RsEParentGivenNotAParent, [AControl.Name]);
|
|
end;
|
|
{$ENDIF COMPILER6_UP}
|
|
|
|
procedure GetHintMessageFont(AFont: TFont);
|
|
begin
|
|
AFont.Assign(Screen.HintFont);
|
|
AFont.Style := AFont.Style - [fsBold];
|
|
end;
|
|
|
|
procedure GetHintTitleFont(AFont: TFont);
|
|
{$IFDEF JVCLThemesEnabled}
|
|
var
|
|
AThemedTextColor: Integer;
|
|
Result: Boolean;
|
|
LogFontW: TLogFontW;
|
|
{$ENDIF JVCLThemesEnabled}
|
|
begin
|
|
{$IFDEF JVCLThemesEnabled}
|
|
if IsWinVista_UP and ThemeServices.ThemesEnabled then
|
|
begin
|
|
Result := GetThemeEnumValue(ThemeServices.Theme[teToolTip], TTP_BALLOONTITLE, 0,
|
|
TMT_TEXTCOLOR, AThemedTextColor) = S_OK;
|
|
if Result then
|
|
begin
|
|
// GetThemeFont is defined wrong; so cast it
|
|
Result := GetThemeFont(ThemeServices.Theme[teToolTip], 0, TTP_BALLOONTITLE, 0,
|
|
TMT_FONT, {$IFDEF COMPILER12_UP}PLogFontW{$ELSE}PLogFontA{$ENDIF COMPILER12_UP}(@LogFontW)^) = S_OK;
|
|
|
|
if Result then
|
|
begin
|
|
AFont.Color := AThemedTextColor;
|
|
AFont.Handle := CreateFontIndirectW(LogFontW);
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
{$ENDIF JVCLThemesEnabled}
|
|
AFont.Assign(Screen.HintFont);
|
|
AFont.Style := AFont.Style + [fsBold];
|
|
end;
|
|
|
|
function IsMultiLineStr(const Value: WideString): Boolean;
|
|
var
|
|
Head, Tail: PWideChar;
|
|
LineCount: Integer;
|
|
begin
|
|
// stripped copy of TWideStrings.SetText
|
|
LineCount := 0;
|
|
Head := PWideChar(Value);
|
|
while (Head^ <> WideNull) and (LineCount < 2) do
|
|
begin
|
|
Tail := Head;
|
|
{$IFDEF COMPILER12_UP}
|
|
while not CharInSet(Tail^, [WideNull, WideLineFeed, WideCarriageReturn, WideVerticalTab, WideFormFeed]) and
|
|
{$ELSE}
|
|
while not (Tail^ in [WideNull, WideLineFeed, WideCarriageReturn, WideVerticalTab, WideFormFeed]) and
|
|
{$ENDIF COMPILER12_UP}
|
|
(Tail^ <> WideLineSeparator) and (Tail^ <> WideParagraphSeparator) do
|
|
Inc(Tail);
|
|
Inc(LineCount);
|
|
Head := Tail;
|
|
if Head^ <> WideNull then
|
|
begin
|
|
Inc(Head);
|
|
if (Tail^ = WideCarriageReturn) and (Head^ = WideLineFeed) then
|
|
Inc(Head);
|
|
end;
|
|
end;
|
|
Result := LineCount >= 2;
|
|
end;
|
|
|
|
type
|
|
TGlobalCtrl = class(TComponent)
|
|
private
|
|
FBkColor: TColor;
|
|
FCtrls: TList;
|
|
FDefaultImages: TImageList;
|
|
FNeedUpdateBkColor: Boolean;
|
|
FOldHintWindowClass: THintWindowClass;
|
|
FSounds: array [TJvIconKind] of string;
|
|
FUseBalloonAsApplicationHint: Boolean;
|
|
FDesigning: Boolean;
|
|
function GetMainCtrl: TJvBalloonHint;
|
|
procedure GetDefaultImages;
|
|
procedure GetDefaultSounds;
|
|
procedure SetBkColor(const Value: TColor);
|
|
procedure SetUseBalloonAsApplicationHint(const Value: Boolean);
|
|
protected
|
|
procedure Add(ABalloonHint: TJvBalloonHint);
|
|
procedure Remove(ABalloonHint: TJvBalloonHint);
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
function HintImageSize: TSize; overload;
|
|
function HintImageSize(const AIconKind: TJvIconKind;
|
|
const AImageIndex: TImageIndex): TSize; overload;
|
|
procedure DrawHintImage(Canvas: TCanvas; X, Y: Integer; const ABkColor: TColor); overload;
|
|
procedure DrawHintImage(Canvas: TCanvas; X, Y: Integer; const AIconKind: TJvIconKind;
|
|
const AImageIndex: TImageIndex; const ABkColor: TColor); overload;
|
|
procedure PlaySound(const AIconKind: TJvIconKind);
|
|
|
|
property BkColor: TColor read FBkColor write SetBkColor;
|
|
property MainCtrl: TJvBalloonHint read GetMainCtrl;
|
|
property UseBalloonAsApplicationHint: Boolean read FUseBalloonAsApplicationHint
|
|
write SetUseBalloonAsApplicationHint;
|
|
end;
|
|
|
|
var
|
|
GGlobalCtrl: TGlobalCtrl = nil;
|
|
{ A TJvBalloonHint may be needed, while there isn't an instance of it around.
|
|
For example, if the user sets HintWindowClass to TJvBalloonWindow.
|
|
}
|
|
GMainCtrl: TJvBalloonHint = nil;
|
|
|
|
function GlobalCtrl: TGlobalCtrl;
|
|
begin
|
|
if not Assigned(GGlobalCtrl) then
|
|
GGlobalCtrl := TGlobalCtrl.Create(nil);
|
|
Result := GGlobalCtrl;
|
|
end;
|
|
|
|
//=== { TJvBalloonWindow } ===================================================
|
|
|
|
constructor TJvBalloonWindow.Create(AOwner: TComponent);
|
|
begin
|
|
{$IFDEF COMPILER5}
|
|
InitD5Controls;
|
|
{$ENDIF COMPILER5}
|
|
inherited Create(AOwner);
|
|
ControlStyle := [csCaptureMouse, csClickEvents, csDoubleClicks];
|
|
end;
|
|
|
|
var
|
|
OldAnimateWindowProc: TAnimateWindowProc;
|
|
|
|
function JvAnimateWindowProc(hWnd: HWND; dwTime: DWORD; dwFlags: DWORD): BOOL; stdcall;
|
|
begin
|
|
SendMessage(hWnd, CM_RECREATEWND, 0, 0);
|
|
Result := OldAnimateWindowProc(hWnd, dwTime, dwFlags);
|
|
end;
|
|
|
|
{$IFNDEF COMPILER7_UP}
|
|
const
|
|
ComCtlVersionIE6 = $00060000;
|
|
{$ENDIF !COMPILER7_UP}
|
|
|
|
procedure TJvBalloonWindow.ActivateHint(Rect: TRect; const AHint: string);
|
|
var
|
|
Delta: Integer;
|
|
begin
|
|
ParentWindow := Application.Handle;
|
|
if IsWinVista_UP and (GetComCtlVersion >= ComCtlVersionIE6) then
|
|
RecreateWnd;
|
|
if HandleAllocated and IsWindowVisible(Handle) then
|
|
ShowWindow(Handle, SW_HIDE);
|
|
|
|
if UseRightToLeftAlignment then
|
|
begin
|
|
// Remove the offset set by TApplication.ActivateHint
|
|
Delta := MultiLineWidth(AHint) + 5;
|
|
Inc(Rect.Left, Delta);
|
|
Inc(Rect.Right, Delta);
|
|
end;
|
|
CheckPosition(Rect);
|
|
UpdateRegion;
|
|
|
|
Inc(Rect.Bottom, 4);
|
|
UpdateBoundsRect(Rect);
|
|
Dec(Rect.Bottom, 4);
|
|
|
|
with GlobalCtrl do
|
|
if ahPlaySound in MainCtrl.ApplicationHintOptions then
|
|
PlaySound(MainCtrl.DefaultIcon);
|
|
if IsWinVista_UP and (GetComCtlVersion < ComCtlVersionIE6) then
|
|
begin
|
|
OldAnimateWindowProc := AnimateWindowProc;
|
|
AnimateWindowProc := JvAnimateWindowProc;
|
|
try
|
|
inherited ActivateHint(Rect, AHint);
|
|
finally
|
|
AnimateWindowProc := OldAnimateWindowProc;
|
|
end;
|
|
end
|
|
else
|
|
inherited ActivateHint(Rect, AHint);
|
|
end;
|
|
|
|
procedure TJvBalloonWindow.CalcAutoPosition(var ARect: TRect);
|
|
var
|
|
NewPosition: TJvBalloonPosition;
|
|
ScreenRect: TRect;
|
|
LStemPointPosition: TPoint;
|
|
begin
|
|
{ bpAuto returns the same value as bpLeftDown; bpLeftDown is choosen
|
|
arbitrary }
|
|
FCurrentPosition := bpLeftDown;
|
|
ScreenRect := WorkAreaRect;
|
|
|
|
{ Note: 2*(Left + Width div 2) = 2*(Left + (Right-Left) div 2) ~=
|
|
2*Left + (Right-Left) = Left + Right;
|
|
|
|
Thus multiply everything with 2
|
|
|
|
Monitor:
|
|
|---------------|
|
|
| | |
|
|
| 1 | 2 |
|
|
| | |
|
|
|---------------|
|
|
| | |
|
|
| 3 | 4 |
|
|
| | |
|
|
|---------------|
|
|
|
|
}
|
|
with GetStemPointPositionInRect(ARect) do
|
|
LStemPointPosition := Point(X * 2, Y * 2);
|
|
|
|
if LStemPointPosition.Y < ScreenRect.Top + ScreenRect.Bottom then
|
|
begin
|
|
if LStemPointPosition.X < ScreenRect.Left + ScreenRect.Right then
|
|
{ 1 }
|
|
NewPosition := bpLeftUp
|
|
else
|
|
{ 2 }
|
|
NewPosition := bpRightUp;
|
|
end
|
|
else
|
|
begin
|
|
if LStemPointPosition.X < ScreenRect.Left + ScreenRect.Right then
|
|
{ 3 }
|
|
NewPosition := bpLeftDown
|
|
else
|
|
{ 4 }
|
|
NewPosition := bpRightDown;
|
|
end;
|
|
|
|
if NewPosition <> FCurrentPosition then
|
|
begin
|
|
{ Reset the offset.. }
|
|
with CalcOffset(ARect) do
|
|
OffsetRect(ARect, -X, -Y);
|
|
|
|
FCurrentPosition := NewPosition;
|
|
|
|
{ ..and set the offset }
|
|
with CalcOffset(ARect) do
|
|
OffsetRect(ARect, X, Y);
|
|
end;
|
|
end;
|
|
|
|
function TJvBalloonWindow.CalcHintRect(MaxWidth: Integer; const AHint: string;
|
|
AData: Pointer): TRect;
|
|
begin
|
|
// Mantis 3855: CalcHintRect is called by the VCL code and gives a non
|
|
// UTF-8 string. However, this string may contain characters above 127 which
|
|
// would then be interpreted as UTF-8 markers. So when you are sure the
|
|
// string for the hint is UTF-8, use CalcHintRectUTF8 below. This is what is
|
|
// done by the TJvBalloonHint.InternalActivateHintPos code.
|
|
// In any case the CalcHintRectW function is called in the end.
|
|
Result := CalcHintRectW(MaxWidth, WideString(AHint), AData);
|
|
end;
|
|
|
|
function TJvBalloonWindow.CalcHintRectUTF8(MaxWidth: Integer;
|
|
const AUTF8Hint: {$IFDEF RTL200_UP}UTF8String{$ELSE}string{$ENDIF RTL200_UP}; AData: Pointer): TRect;
|
|
begin
|
|
Result := CalcHintRectW(MaxWidth, {$IFDEF RTL200_UP}System.{$ENDIF RTL200_UP}UTF8ToWideString(AUTF8Hint), AData);
|
|
end;
|
|
|
|
function TJvBalloonWindow.CalcHintRectW(MaxWidth: Integer;
|
|
const AHint: WideString; AData: Pointer): TRect;
|
|
var
|
|
ASize: TSize;
|
|
StemSize: TJvStemSize;
|
|
begin
|
|
FUseRegion := False;
|
|
Init(AData);
|
|
|
|
FMsg := AHint;
|
|
FIsMultiLineMsg := IsMultiLineStr(FMsg);
|
|
|
|
if FShowIcon then
|
|
begin
|
|
if IsWinVista_UP and (GetComCtlVersion >= ComCtlVersionIE6) then
|
|
FIconPos := Point(12, 12)
|
|
else
|
|
FIconPos := Point(12, 9);
|
|
end;
|
|
|
|
SetRectEmpty(FHeaderRect);
|
|
MeasureHeader(MaxWidth, FHeaderRect.Right, FHeaderRect.Bottom);
|
|
if not IsRectEmpty(FHeaderRect) then
|
|
begin
|
|
if IsWinVista_UP and (GetComCtlVersion >= ComCtlVersionIE6) then
|
|
OffsetRect(FHeaderRect, 12, 9)
|
|
else
|
|
OffsetRect(FHeaderRect, 12, 10)
|
|
end;
|
|
|
|
SetRectEmpty(FMsgRect);
|
|
MeasureMsg(MaxWidth, FMsgRect.Right, FMsgRect.Bottom);
|
|
if not IsRectEmpty(FMsgRect) then
|
|
begin
|
|
if IsWinVista_UP then
|
|
begin
|
|
{$IFDEF JVCLThemesEnabled}
|
|
if ThemeServices.ThemesEnabled then
|
|
OffsetRect(FMsgRect, 12, Max(9, FHeaderRect.Bottom))
|
|
else
|
|
{$ENDIF JVCLThemesEnabled}
|
|
if GetComCtlVersion >= ComCtlVersionIE6 then
|
|
OffsetRect(FMsgRect, 12, FHeaderRect.Bottom + 3)
|
|
else
|
|
begin
|
|
if FShowIcon then
|
|
OffsetRect(FMsgRect, 12, Max(FIconPos.Y + FImageSize.cy + 6, FHeaderRect.Bottom + 5))
|
|
else
|
|
OffsetRect(FMsgRect, 12, Max(9, FHeaderRect.Bottom + 5));
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if FShowIcon then
|
|
OffsetRect(FMsgRect, 12, Max(FIconPos.Y + FImageSize.cy + 5, FHeaderRect.Bottom + 4))
|
|
else
|
|
OffsetRect(FMsgRect, 12, Max(9, FHeaderRect.Bottom + 4));
|
|
end;
|
|
end;
|
|
|
|
if FShowIcon then
|
|
begin
|
|
// move the right position of the header
|
|
if IsWinVista_UP and (GetComCtlVersion >= ComCtlVersionIE6) then
|
|
OffsetRect(FHeaderRect, FImageSize.cx + 5, 0)
|
|
else
|
|
OffsetRect(FHeaderRect, FImageSize.cx + 8, 0);
|
|
|
|
// move the right position of the msg; only for vista
|
|
if IsWinVista_UP and (GetComCtlVersion >= ComCtlVersionIE6) then
|
|
OffsetRect(FMsgRect, FImageSize.cx + 5, 0);
|
|
end;
|
|
|
|
{$IFDEF JVCLThemesEnabled}
|
|
if IsWinVista_UP and ThemeServices.ThemesEnabled and FIsMultiLineMsg then
|
|
begin
|
|
GetThemePartSize(ThemeServices.Theme[teToolTip], 0, TTP_BALLOONSTEM, cBalloonStemState[FCurrentPosition],
|
|
nil, TS_TRUE, ASize);
|
|
FStemRect := Rect(0, 0, ASize.cx, ASize.cy);
|
|
FTipHeight := ASize.cy;
|
|
FTipWidth := ASize.cx;
|
|
FTipDelta := $10;
|
|
end
|
|
else
|
|
{$ENDIF JVCLThemesEnabled}
|
|
begin
|
|
if IsRectEmpty(FHeaderRect) then
|
|
StemSize := ssExtraSmall
|
|
else
|
|
if not FIsMultiLineMsg then
|
|
StemSize := ssSmall
|
|
else
|
|
StemSize := ssNormal;
|
|
|
|
FTipHeight := cTipHeight[StemSize];
|
|
FTipWidth := cTipWidth[StemSize];
|
|
FStemRect := Rect(0, 0, FTipWidth, FTipHeight);
|
|
FTipDelta := cTipDelta[StemSize];
|
|
end;
|
|
|
|
if FShowCloseBtn then
|
|
begin
|
|
{$IFDEF JVCLThemesEnabled}
|
|
if IsWinXP_UP and ThemeServices.ThemesEnabled then
|
|
GetThemePartSize(ThemeServices.Theme[teToolTip], 0, TTP_CLOSE, TTCS_NORMAL,
|
|
nil, TS_DRAW, ASize)
|
|
else
|
|
{$ENDIF JVCLThemesEnabled}
|
|
begin
|
|
ASize.cx := GetSystemMetrics(SM_CXSMICON);
|
|
ASize.cy := GetSystemMetrics(SM_CYSMICON);
|
|
end;
|
|
FCloseBtnRect := Rect(0, 0, ASize.cx, ASize.cy);
|
|
|
|
Inc(FHeaderRect.Right, ASize.cx);
|
|
end;
|
|
|
|
if IsWinVista_UP and (GetComCtlVersion >= ComCtlVersionIE6) then
|
|
begin
|
|
FRoundRect := Rect(0, 0, Max(13 + FMsgRect.Right, 13 + FHeaderRect.Right),
|
|
Max(FMsgRect.Bottom + 10, FHeaderRect.Bottom + 10));
|
|
OffsetRect(FStemRect, FTipDelta, FRoundRect.Bottom - 1);
|
|
end
|
|
else
|
|
begin
|
|
FRoundRect := Rect(0, 0, Max(14 + FMsgRect.Right, 14 + FHeaderRect.Right),
|
|
Max(FMsgRect.Bottom + 11, FHeaderRect.Bottom + 11));
|
|
OffsetRect(FStemRect, FTipDelta, FRoundRect.Bottom - 1);
|
|
end;
|
|
|
|
UnionRect(Result, FRoundRect, FStemRect);
|
|
with CalcOffset(Result) do
|
|
OffsetRect(Result, X, Y);
|
|
|
|
OffsetRect(FCloseBtnRect, FRoundRect.Right - (FCloseBtnRect.Right - FCloseBtnRect.Left) - 6, 6);
|
|
FUseRegion := True;
|
|
end;
|
|
|
|
function TJvBalloonWindow.CalcOffset(const ARect: TRect): TPoint;
|
|
begin
|
|
with ARect do
|
|
case FCurrentPosition of
|
|
{ bpAuto returns the same value as bpLeftDown; bpLeftDown is choosen
|
|
arbitrary }
|
|
bpAuto, bpLeftDown:
|
|
Result := Point(Left - Right + FTipDelta, 0);
|
|
bpRightDown:
|
|
Result := Point(-FTipDelta, 0);
|
|
bpLeftUp:
|
|
Result := Point(Left - Right + FTipDelta, Top - Bottom - FSwitchHeight);
|
|
bpRightUp:
|
|
Result := Point(-FTipDelta, Top - Bottom - FSwitchHeight);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvBalloonWindow.CheckPosition(var ARect: TRect);
|
|
var
|
|
NewPosition: TJvBalloonPosition;
|
|
ScreenRect: TRect;
|
|
begin
|
|
if FCurrentPosition = bpAuto then
|
|
CalcAutoPosition(ARect);
|
|
|
|
NewPosition := FCurrentPosition;
|
|
ScreenRect := WorkAreaRect;
|
|
|
|
if ARect.Bottom > ScreenRect.Bottom - ScreenRect.Top then
|
|
begin
|
|
if NewPosition = bpLeftDown then
|
|
NewPosition := bpLeftUp
|
|
else
|
|
if NewPosition = bpRightDown then
|
|
NewPosition := bpRightUp;
|
|
end;
|
|
if ARect.Right > ScreenRect.Right - ScreenRect.Left then
|
|
begin
|
|
if NewPosition = bpRightDown then
|
|
NewPosition := bpLeftDown
|
|
else
|
|
if NewPosition = bpRightUp then
|
|
NewPosition := bpLeftUp;
|
|
end;
|
|
if ARect.Left < ScreenRect.Left then
|
|
begin
|
|
if NewPosition = bpLeftDown then
|
|
NewPosition := bpRightDown
|
|
else
|
|
if NewPosition = bpLeftUp then
|
|
NewPosition := bpRightUp;
|
|
end;
|
|
if ARect.Top < ScreenRect.Top then
|
|
begin
|
|
if NewPosition = bpLeftUp then
|
|
NewPosition := bpLeftDown
|
|
else
|
|
if NewPosition = bpRightUp then
|
|
NewPosition := bpRightDown;
|
|
end;
|
|
|
|
if NewPosition <> FCurrentPosition then
|
|
begin
|
|
{ Reset the offset.. }
|
|
with CalcOffset(ARect) do
|
|
OffsetRect(ARect, -X, -Y);
|
|
FCurrentPosition := NewPosition;
|
|
|
|
{ ..and set the offset }
|
|
with CalcOffset(ARect) do
|
|
OffsetRect(ARect, X, Y);
|
|
end;
|
|
{ final adjustment - just make sure no part is disappearing outside the top/left edge }
|
|
if ARect.Left < ScreenRect.Left then
|
|
begin
|
|
with CalcOffset(ARect) do
|
|
OffsetRect(ARect, -X, -Y);
|
|
if FCurrentPosition = bpLeftUp then
|
|
FCurrentPosition := bpRightUp
|
|
else
|
|
if FCurrentPosition = bpLeftDown then
|
|
FCurrentPosition := bpRightDown;
|
|
with CalcOffset(ARect) do
|
|
OffsetRect(ARect, X, Y);
|
|
end;
|
|
|
|
if ARect.Top < ScreenRect.Top then
|
|
begin
|
|
with CalcOffset(ARect) do
|
|
OffsetRect(ARect, -X, -Y);
|
|
if FCurrentPosition = bpLeftUp then
|
|
FCurrentPosition := bpLeftDown
|
|
else
|
|
if FCurrentPosition = bpRightUp then
|
|
FCurrentPosition := bpRightDown;
|
|
with CalcOffset(ARect) do
|
|
OffsetRect(ARect, X, Y);
|
|
end;
|
|
|
|
case FCurrentPosition of
|
|
bpLeftDown, bpRightDown:
|
|
begin
|
|
OffsetRect(FRoundRect, 0, FTipHeight - 1);
|
|
OffsetRect(FStemRect, 0, -FStemRect.Top);
|
|
OffsetRect(FMsgRect, 0, FTipHeight - 1);
|
|
OffsetRect(FHeaderRect, 0, FTipHeight - 1);
|
|
Inc(FIconPos.y, FTipHeight);
|
|
OffsetRect(FCloseBtnRect, 0, FTipHeight);
|
|
|
|
if FCurrentPosition = bpLeftDown then
|
|
OffsetRect(FStemRect, -2 * FTipDelta + (FRoundRect.Right - FRoundRect.Left) - (FStemRect.Right - FStemRect.Left), 0);
|
|
end;
|
|
bpLeftUp, bpRightUp:
|
|
begin
|
|
if FCurrentPosition = bpLeftUp then
|
|
OffsetRect(FStemRect, -2 * FTipDelta + (FRoundRect.Right - FRoundRect.Left) - (FStemRect.Right - FStemRect.Left), 0);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvBalloonWindow.CMShowingChanged(var Msg: TMessage);
|
|
begin
|
|
{ In response of RecreateWnd, SetParentWindow calls, only respond when visible }
|
|
{ Actually only necessairy for TJvBalloonWindow not for TJvBalloonWindowEx }
|
|
if Showing then
|
|
UpdateRegion;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TJvBalloonWindow.CMTextChanged(var Msg: TMessage);
|
|
begin
|
|
{inherited;}
|
|
end;
|
|
|
|
procedure TJvBalloonWindow.CreateParams(var Params: TCreateParams);
|
|
begin
|
|
inherited CreateParams(Params);
|
|
{ Drop shadow in combination with custom animation may cause blurry effect,
|
|
no solution.
|
|
}
|
|
with Params do
|
|
begin
|
|
Style := Style and not WS_BORDER;
|
|
if IsWinXP_UP and (GetComCtlVersion >= ComCtlVersionIE6) then
|
|
begin
|
|
WindowClass.Style := WindowClass.Style or CS_DROPSHADOW;
|
|
{$IFDEF JVCLThemesEnabled}
|
|
if IsWinVista_UP and ThemeServices.ThemesEnabled then
|
|
ExStyle := ExStyle or WS_EX_LAYERED;
|
|
{$ENDIF JVCLThemesEnabled}
|
|
end
|
|
else
|
|
WindowClass.Style := WindowClass.Style and not CS_DROPSHADOW;
|
|
end;
|
|
end;
|
|
|
|
function TJvBalloonWindow.CreateRegion: HRGN;
|
|
var
|
|
RegionRound, RegionTip: HRGN;
|
|
PtTail: array [0..2] of TPoint;
|
|
begin
|
|
case FCurrentPosition of
|
|
bpLeftDown:
|
|
begin
|
|
{ 0
|
|
/ |
|
|
/ |
|
|
/ |
|
|
2----1
|
|
}
|
|
|
|
PtTail[0] := Point(FStemRect.Right, FStemRect.Top);
|
|
PtTail[1] := Point(FStemRect.Right, FStemRect.Bottom);
|
|
PtTail[2] := Point(FStemRect.Left, FStemRect.Bottom);
|
|
end;
|
|
bpRightDown:
|
|
begin
|
|
{ 0
|
|
| \
|
|
| \
|
|
| \
|
|
1----2
|
|
}
|
|
|
|
PtTail[0] := Point(FStemRect.Left, FStemRect.Top);
|
|
PtTail[1] := Point(FStemRect.Left, FStemRect.Bottom);
|
|
PtTail[2] := Point(FStemRect.Right, FStemRect.Bottom);
|
|
end;
|
|
bpLeftUp:
|
|
begin
|
|
{ 2----1
|
|
\ |
|
|
\ |
|
|
\ |
|
|
0
|
|
}
|
|
|
|
PtTail[0] := Point(FStemRect.Right, FStemRect.Bottom);
|
|
PtTail[1] := Point(FStemRect.Right, FStemRect.Top);
|
|
PtTail[2] := Point(FStemRect.Left, FStemRect.Top);
|
|
end;
|
|
bpRightUp:
|
|
begin
|
|
{ 1----2
|
|
| /
|
|
| /
|
|
| /
|
|
0
|
|
}
|
|
|
|
PtTail[0] := Point(FStemRect.Left, FStemRect.Bottom);
|
|
PtTail[1] := Point(FStemRect.Left, FStemRect.Top);
|
|
PtTail[2] := Point(FStemRect.Right, FStemRect.Top);
|
|
end;
|
|
end;
|
|
|
|
RegionTip := CreatePolygonRgn(PtTail, 3, WINDING);
|
|
RegionRound := CreateRoundRectRgn(FRoundRect.Left, FRoundRect.Top, FRoundRect.Right, FRoundRect.Bottom, 11, 11);
|
|
Result := CreateRectRgn(0, 0, 1, 1);
|
|
|
|
CombineRgn(Result, RegionTip, RegionRound, RGN_OR);
|
|
DeleteObject(RegionTip);
|
|
DeleteObject(RegionRound);
|
|
end;
|
|
|
|
{$IFDEF JVCLThemesEnabled}
|
|
function TJvBalloonWindow.CreateThemedRegion: HRGN;
|
|
var
|
|
RegionRound, RegionTip: HRGN;
|
|
begin
|
|
Result := CreateRectRgn(0, 0, 1, 1);
|
|
if GetThemeBackgroundRegion(ThemeServices.Theme[teToolTip], 0,
|
|
TTP_BALLOON, 0, FRoundRect, RegionRound) = S_OK then
|
|
begin
|
|
if GetThemeBackgroundRegion(ThemeServices.Theme[teToolTip], 0,
|
|
TTP_BALLOONSTEM, cBalloonStemState[FCurrentPosition], FStemRect, RegionTip) = S_OK then
|
|
begin
|
|
CombineRgn(Result, RegionTip, RegionRound, RGN_OR);
|
|
DeleteObject(RegionTip);
|
|
end;
|
|
DeleteObject(RegionRound);
|
|
end;
|
|
end;
|
|
{$ENDIF JVCLThemesEnabled}
|
|
|
|
function TJvBalloonWindow.GetStemPointPosition: TPoint;
|
|
begin
|
|
Result := GetStemPointPositionInRect(BoundsRect);
|
|
end;
|
|
|
|
function TJvBalloonWindow.GetStemPointPositionInRect(const ARect: TRect): TPoint;
|
|
begin
|
|
{ bpAuto returns the same value as bpLeftDown; bpLeftDown is choosen
|
|
arbitrary }
|
|
with ARect do
|
|
case FCurrentPosition of
|
|
bpAuto, bpLeftDown:
|
|
Result := Point(Right - FTipDelta, Top);
|
|
bpRightDown:
|
|
Result := Point(Left + FTipDelta, Top);
|
|
bpLeftUp:
|
|
Result := Point(Right - FTipDelta, Bottom);
|
|
bpRightUp:
|
|
Result := Point(Left + FTipDelta, Bottom);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvBalloonWindow.Init(AData: Pointer);
|
|
begin
|
|
with GlobalCtrl.MainCtrl do
|
|
begin
|
|
FShowIcon := (ahShowIconInHint in ApplicationHintOptions) and
|
|
(DefaultIcon <> ikNone) and
|
|
((DefaultIcon <> ikCustom) or (DefaultImageIndex > -1));
|
|
FShowHeader := (ahShowHeaderInHint in ApplicationHintOptions) and (DefaultHeader <> '');
|
|
FHeader := DefaultHeader;
|
|
FCurrentPosition := DefaultBalloonPosition;
|
|
end;
|
|
|
|
FImageSize := GlobalCtrl.HintImageSize;
|
|
FSwitchHeight := GetSystemMetrics(SM_CYCURSOR);
|
|
end;
|
|
|
|
procedure TJvBalloonWindow.MeasureHeader(const MaxWidth: Integer;
|
|
var AWidth, AHeight: Integer);
|
|
var
|
|
R: TRect;
|
|
begin
|
|
if FShowHeader then
|
|
begin
|
|
R := Rect(0, 0, MaxWidth, 0);
|
|
GetHintTitleFont(Canvas.Font);
|
|
DrawTextW(Canvas.Handle, FHeader, R,
|
|
DT_CALCRECT or DefaultTextFlags or DrawTextBiDiModeFlagsReadingOnly);
|
|
AWidth := R.Right - R.Left;
|
|
AHeight := R.Bottom - R.Top;
|
|
end
|
|
else
|
|
begin
|
|
AWidth := 0;
|
|
AHeight := 0;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvBalloonWindow.MeasureMsg(const MaxWidth: Integer;
|
|
var AWidth, AHeight: Integer);
|
|
var
|
|
R: TRect;
|
|
begin
|
|
if FMsg > '' then
|
|
begin
|
|
R := Rect(0, 0, MaxWidth, 0);
|
|
GetHintMessageFont(Canvas.Font);
|
|
DrawTextW(Canvas.Handle, FMsg, R,
|
|
DT_CALCRECT or DefaultTextFlags or DrawTextBiDiModeFlagsReadingOnly);
|
|
AWidth := R.Right - R.Left;
|
|
AHeight := R.Bottom - R.Top;
|
|
end
|
|
else
|
|
begin
|
|
AWidth := 0;
|
|
AHeight := 0;
|
|
end;
|
|
end;
|
|
|
|
function TJvBalloonWindow.MultiLineWidth(const Value: string): Integer;
|
|
var
|
|
W: Integer;
|
|
P, Start: PChar;
|
|
S: string;
|
|
begin
|
|
Result := 0;
|
|
P := Pointer(Value);
|
|
if P <> nil then
|
|
while P^ <> #0 do
|
|
begin
|
|
Start := P;
|
|
while not CharInSet(P^, [#0, #10, #13]) do
|
|
P := StrNextChar(P);
|
|
SetString(S, Start, P - Start);
|
|
W := Self.Canvas.TextWidth(S);
|
|
if W > Result then
|
|
Result := W;
|
|
if P^ = #13 then Inc(P);
|
|
if P^ = #10 then Inc(P);
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF COMPILER6_UP}
|
|
procedure TJvBalloonWindow.NCPaint(DC: HDC);
|
|
begin
|
|
{ Do nothing, thus prevent TJvHintWindow from drawing }
|
|
end;
|
|
{$ELSE}
|
|
procedure TJvBalloonWindow.WMNCPaint(var Msg: TMessage);
|
|
begin
|
|
{ Do nothing, thus prevent TJvHintWindow from drawing }
|
|
end;
|
|
{$ENDIF COMPILER6_UP}
|
|
|
|
procedure TJvBalloonWindow.Paint;
|
|
begin
|
|
if FShowIcon then
|
|
with FIconPos do
|
|
GlobalCtrl.DrawHintImage(Canvas, X, Y, Color);
|
|
|
|
if FMsg > '' then
|
|
begin
|
|
GetHintMessageFont(Canvas.Font);
|
|
DrawTextW(Canvas.Handle, FMsg, FMsgRect,
|
|
DefaultTextFlags or DrawTextBiDiModeFlagsReadingOnly);
|
|
end;
|
|
|
|
if FShowHeader then
|
|
begin
|
|
GetHintTitleFont(Canvas.Font);
|
|
DrawTextW(Canvas.Handle, FHeader, FHeaderRect,
|
|
DefaultTextFlags or DrawTextBiDiModeFlagsReadingOnly);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvBalloonWindow.UpdateRegion;
|
|
var
|
|
Region: HRGN;
|
|
IsVisible: Boolean;
|
|
begin
|
|
if not HandleAllocated or not FUseRegion or (FCurrentPosition = bpAuto) then
|
|
Exit;
|
|
|
|
{$IFDEF JVCLThemesEnabled}
|
|
if IsWinVista_UP and ThemeServices.ThemesEnabled and FIsMultiLineMsg then
|
|
Region := CreateThemedRegion
|
|
else
|
|
{$ENDIF JVCLThemesEnabled}
|
|
Region := CreateRegion;
|
|
IsVisible := IsWindowVisible(Handle);
|
|
if SetWindowRgn(Handle, Region, IsVisible) = 0 then
|
|
DeleteObject(Region);
|
|
{ MSDN: After a successful call to SetWindowRgn, the system owns the region
|
|
specified by the region handle hRgn. The system does not make a copy of
|
|
the region. Thus, you should not make any further function calls with
|
|
this region handle. In particular, do not delete this region handle. The
|
|
system deletes the region handle when it no longer needed. }
|
|
end;
|
|
|
|
procedure TJvBalloonWindow.WMEraseBkgnd(var Msg: TWMEraseBkgnd);
|
|
var
|
|
Brush, BrushBlack: HBRUSH;
|
|
Region: HRGN;
|
|
RegionType: Integer;
|
|
{$IFDEF JVCLThemesEnabled}
|
|
R: TRect;
|
|
{$ENDIF JVCLThemesEnabled}
|
|
begin
|
|
{$IFDEF JVCLThemesEnabled}
|
|
if IsWinVista_UP and ThemeServices.ThemesEnabled then
|
|
begin
|
|
if FIsMultiLineMsg then
|
|
begin
|
|
DrawThemeBackground(ThemeServices.Theme[teToolTip], Msg.DC,
|
|
TTP_BALLOON, 0, FRoundRect, @FRoundRect);
|
|
DrawThemeBackground(ThemeServices.Theme[teToolTip], Msg.DC,
|
|
TTP_BALLOONSTEM, cBalloonStemState[FCurrentPosition], FStemRect, @FStemRect);
|
|
end
|
|
else
|
|
begin
|
|
R := ClientRect;
|
|
DrawThemeBackground(ThemeServices.Theme[teToolTip], Msg.DC,
|
|
TTP_BALLOON, 0, R, @R);
|
|
// draw black border
|
|
BrushBlack := CreateSolidBrush(0);
|
|
try
|
|
Region := CreateRectRgn(0, 0, 0, 0);
|
|
RegionType := GetWindowRgn(Handle, Region);
|
|
if RegionType <> Windows.ERROR then
|
|
FrameRgn(Msg.DC, Region, BrushBlack, 1, 1);
|
|
DeleteObject(Region);
|
|
finally
|
|
DeleteObject(BrushBlack);
|
|
end;
|
|
end;
|
|
|
|
Msg.Result := 1;
|
|
Exit;
|
|
end;
|
|
{$ENDIF JVCLThemesEnabled}
|
|
Brush := CreateSolidBrush(ColorToRGB(Color));
|
|
BrushBlack := CreateSolidBrush(0);
|
|
try
|
|
Region := CreateRectRgn(0, 0, 0, 0);
|
|
RegionType := GetWindowRgn(Handle, Region);
|
|
if RegionType <> Windows.ERROR then
|
|
begin
|
|
FillRgn(Msg.DC, Region, Brush);
|
|
// draw black border
|
|
FrameRgn(Msg.DC, Region, BrushBlack, 1, 1);
|
|
end;
|
|
DeleteObject(Region);
|
|
finally
|
|
DeleteObject(Brush);
|
|
DeleteObject(BrushBlack);
|
|
end;
|
|
Msg.Result := 1;
|
|
end;
|
|
|
|
//=== { TJvBalloonHint } =====================================================
|
|
|
|
constructor TJvBalloonHint.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FActive := False;
|
|
FHint := TJvBalloonWindowEx.Create(Self);
|
|
FHint.FCtrl := Self;
|
|
FHint.Visible := False;
|
|
FHint.OnMouseDown := HandleMouseDown;
|
|
FHint.OnMouseUp := HandleMouseUp;
|
|
FHint.OnMouseMove := HandleMouseMove;
|
|
FHint.OnClick := HandleClick;
|
|
FHint.OnDblClick := HandleDblClick;
|
|
FOptions := [boShowCloseBtn];
|
|
FApplicationHintOptions := [ahShowHeaderInHint, ahShowIconInHint];
|
|
FDefaultIcon := ikInformation;
|
|
FDefaultBalloonPosition := bpAuto;
|
|
FDefaultImageIndex := -1;
|
|
FCustomAnimationTime := 100;
|
|
FCustomAnimationStyle := atBlend;
|
|
FMaxWidth := 0;
|
|
|
|
GlobalCtrl.Add(Self);
|
|
end;
|
|
|
|
destructor TJvBalloonHint.Destroy;
|
|
begin
|
|
CancelHint;
|
|
StopHintTimer;
|
|
|
|
if FHandle <> 0 then
|
|
DeallocateHWndEx(FHandle);
|
|
|
|
GlobalCtrl.Remove(Self);
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TJvBalloonHint.ActivateHint(ACtrl: TControl; const AHint: WideString;
|
|
const AImageIndex: TImageIndex; const AHeader: WideString;
|
|
const VisibleTime: Integer);
|
|
begin
|
|
if not Assigned(ACtrl) then
|
|
Exit;
|
|
|
|
CancelHint;
|
|
|
|
with FData do
|
|
begin
|
|
RUTF8Hint := {$IFDEF RTL200_UP}UTF8Encode{$ELSE}WideStringToUTF8{$ENDIF RTL200_UP}(AHint);
|
|
RIconKind := ikCustom;
|
|
RImageIndex := AImageIndex;
|
|
RUTF8Header := {$IFDEF RTL200_UP}UTF8Encode{$ELSE}WideStringToUTF8{$ENDIF RTL200_UP}(AHeader);
|
|
RVisibleTime := VisibleTime;
|
|
end;
|
|
|
|
InternalActivateHint(ACtrl);
|
|
end;
|
|
|
|
procedure TJvBalloonHint.ActivateHint(ACtrl: TControl;
|
|
const AHint, AHeader: WideString; const VisibleTime: Integer);
|
|
begin
|
|
if not Assigned(ACtrl) then
|
|
Exit;
|
|
|
|
CancelHint;
|
|
|
|
with FData do
|
|
begin
|
|
RUTF8Hint := {$IFDEF RTL200_UP}UTF8Encode{$ELSE}WideStringToUTF8{$ENDIF RTL200_UP}(AHint);
|
|
RUTF8Header := {$IFDEF RTL200_UP}UTF8Encode{$ELSE}WideStringToUTF8{$ENDIF RTL200_UP}(AHeader);
|
|
RVisibleTime := VisibleTime;
|
|
RIconKind := ikNone;
|
|
end;
|
|
|
|
InternalActivateHint(ACtrl);
|
|
end;
|
|
|
|
procedure TJvBalloonHint.ActivateHint(ACtrl: TControl; const AHint: WideString;
|
|
const AIconKind: TJvIconKind; const AHeader: WideString; const VisibleTime: Integer);
|
|
begin
|
|
if not Assigned(ACtrl) then
|
|
Exit;
|
|
|
|
CancelHint;
|
|
|
|
with FData do
|
|
begin
|
|
RUTF8Hint := {$IFDEF RTL200_UP}UTF8Encode{$ELSE}WideStringToUTF8{$ENDIF RTL200_UP}(AHint);
|
|
RIconKind := AIconKind;
|
|
RImageIndex := -1;
|
|
RUTF8Header := {$IFDEF RTL200_UP}UTF8Encode{$ELSE}WideStringToUTF8{$ENDIF RTL200_UP}(AHeader);
|
|
RVisibleTime := VisibleTime;
|
|
end;
|
|
|
|
InternalActivateHint(ACtrl);
|
|
end;
|
|
|
|
procedure TJvBalloonHint.ActivateHintPos(AAnchorWindow: TCustomForm;
|
|
AAnchorPosition: TPoint; const AHeader, AHint: WideString;
|
|
const VisibleTime: Integer; const AIconKind: TJvIconKind;
|
|
const AImageIndex: TImageIndex);
|
|
begin
|
|
CancelHint;
|
|
|
|
with FData do
|
|
begin
|
|
RAnchorWindow := AAnchorWindow;
|
|
RAnchorPosition := AAnchorPosition;
|
|
RUTF8Header := {$IFDEF RTL200_UP}UTF8Encode{$ELSE}WideStringToUTF8{$ENDIF RTL200_UP}(AHeader);
|
|
RUTF8Hint := {$IFDEF RTL200_UP}UTF8Encode{$ELSE}WideStringToUTF8{$ENDIF RTL200_UP}(AHint);
|
|
RVisibleTime := VisibleTime;
|
|
RIconKind := AIconKind;
|
|
RImageIndex := AImageIndex;
|
|
RSwitchHeight := 0;
|
|
end;
|
|
|
|
InternalActivateHintPos;
|
|
end;
|
|
|
|
procedure TJvBalloonHint.ActivateHintRect(ARect: TRect; const AHeader,
|
|
AHint: WideString; const VisibleTime: Integer; const AIconKind: TJvIconKind;
|
|
const AImageIndex: TImageIndex);
|
|
begin
|
|
CancelHint;
|
|
|
|
with FData do
|
|
begin
|
|
RAnchorWindow := nil;
|
|
RAnchorPosition := Point((ARect.Left + ARect.Right) div 2, ARect.Bottom);
|
|
RUTF8Header := {$IFDEF RTL200_UP}UTF8Encode{$ELSE}WideStringToUTF8{$ENDIF RTL200_UP}(AHeader);
|
|
RUTF8Hint := {$IFDEF RTL200_UP}UTF8Encode{$ELSE}WideStringToUTF8{$ENDIF RTL200_UP}(AHint);
|
|
RVisibleTime := VisibleTime;
|
|
RIconKind := AIconKind;
|
|
RImageIndex := AImageIndex;
|
|
RSwitchHeight := ARect.Bottom - ARect.Top;
|
|
end;
|
|
|
|
InternalActivateHintPos;
|
|
end;
|
|
|
|
procedure TJvBalloonHint.CancelHint;
|
|
begin
|
|
if not FActive then
|
|
Exit;
|
|
|
|
FActive := False;
|
|
StopHintTimer;
|
|
UnHook;
|
|
|
|
if GetCapture = FHint.Handle then
|
|
ReleaseCapture;
|
|
{ Ensure property Visible is set to False: }
|
|
FHint.Hide;
|
|
{ If ParentWindow = 0, calling Hide won't trigger the CM_SHOWINGCHANGED message
|
|
thus ShowWindow/SetWindowPos isn't called. We do it ourselfs: }
|
|
if FHint.ParentWindow = 0 then
|
|
ShowWindow(FHint.Handle, SW_HIDE);
|
|
|
|
FHint.ParentWindow := 0;
|
|
|
|
if Assigned(FOnClose) then
|
|
FOnClose(Self);
|
|
end;
|
|
|
|
procedure TJvBalloonWindow.CreateWnd;
|
|
begin
|
|
inherited CreateWnd;
|
|
UpdateRegion;
|
|
end;
|
|
|
|
function TJvBalloonHint.GetHandle: THandle;
|
|
begin
|
|
if FHandle = 0 then
|
|
FHandle := AllocateHWndEx(WndProc);
|
|
Result := FHandle;
|
|
end;
|
|
|
|
function TJvBalloonHint.GetUseBalloonAsApplicationHint: Boolean;
|
|
begin
|
|
Result := GlobalCtrl.UseBalloonAsApplicationHint;
|
|
end;
|
|
|
|
procedure TJvBalloonHint.HandleClick(Sender: TObject);
|
|
begin
|
|
if Assigned(FOnBalloonClick) then
|
|
FOnBalloonClick(Self);
|
|
end;
|
|
|
|
function TJvBalloonHint.HandleCloseBtnClick: Boolean;
|
|
begin
|
|
Result := True;
|
|
if Assigned(FOnCloseBtnClick) then
|
|
FOnCloseBtnClick(Self, Result);
|
|
end;
|
|
|
|
procedure TJvBalloonHint.HandleDblClick(Sender: TObject);
|
|
begin
|
|
if Assigned(FOnDblClick) then
|
|
FOnDblClick(Self);
|
|
end;
|
|
|
|
procedure TJvBalloonHint.HandleMouseDown(Sender: TObject;
|
|
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
if Assigned(FOnMouseDown) then
|
|
FOnMouseDown(Self, Button, Shift, X, Y);
|
|
end;
|
|
|
|
procedure TJvBalloonHint.HandleMouseMove(Sender: TObject;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
if Assigned(FOnMouseMove) then
|
|
FOnMouseMove(Self, Shift, X, Y);
|
|
end;
|
|
|
|
procedure TJvBalloonHint.HandleMouseUp(Sender: TObject;
|
|
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
if Assigned(FOnMouseUp) then
|
|
FOnMouseUp(Self, Button, Shift, X, Y);
|
|
end;
|
|
|
|
procedure TJvBalloonHint.Hook;
|
|
begin
|
|
if Assigned(FData.RAnchorWindow) then
|
|
RegisterWndProcHook(FData.RAnchorWindow, HookProc, hoBeforeMsg);
|
|
end;
|
|
|
|
function TJvBalloonHint.HookProc(var Msg: TMessage): Boolean;
|
|
begin
|
|
Result := False;
|
|
case Msg.Msg of
|
|
WM_MOVE:
|
|
with FData do
|
|
FHint.MoveWindow(RAnchorWindow.ClientToScreen(RAnchorPosition));
|
|
WM_SIZE:
|
|
with FData do
|
|
{ (rb) This goes wrong if the balloon is anchored to the window itself }
|
|
if not PtInRect(RAnchorWindow.ClientRect, RStemPointPosition) then
|
|
CancelHint;
|
|
WM_SHOWWINDOW:
|
|
;
|
|
WM_WINDOWPOSCHANGED:
|
|
{ Hide/Restore the balloon if the window is minimized }
|
|
FHint.Visible :=
|
|
not IsIconic(FData.RAnchorWindow.Handle) and
|
|
not IsIconic(Application.Handle);
|
|
WM_ACTIVATE:
|
|
if Msg.WParam = WA_INACTIVE then
|
|
{ Remove HWND_TOPMOST flag }
|
|
FHint.NormalizeTopMost
|
|
else
|
|
{ Restore HWND_TOPMOST flag }
|
|
FHint.RestoreTopMost;
|
|
WM_CLOSE:
|
|
CancelHint;
|
|
WM_NCACTIVATE, WM_EXITSIZEMOVE:
|
|
{ (rb) Weird behaviour of windows ? }
|
|
FHint.RestoreTopMost;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvBalloonHint.InternalActivateHint(ACtrl: TControl);
|
|
var
|
|
LParentForm: TCustomForm;
|
|
begin
|
|
if not Assigned(ACtrl) then
|
|
Exit;
|
|
|
|
LParentForm := GetParentForm(ACtrl);
|
|
with ACtrl, FData do
|
|
begin
|
|
RAnchorWindow := LParentForm;
|
|
if LParentForm = ACtrl then
|
|
RAnchorPosition := Point(Width div 2, ClientHeight)
|
|
else
|
|
RAnchorPosition := InternalClientToParent(ACtrl, Point(Width div 2, Height), LParentForm);
|
|
|
|
RSwitchHeight := ACtrl.Height;
|
|
end;
|
|
|
|
InternalActivateHintPos;
|
|
end;
|
|
|
|
procedure TJvBalloonHint.InternalActivateHintPos;
|
|
var
|
|
Rect: TRect;
|
|
Animate: BOOL;
|
|
TmpMaxWidth: Integer;
|
|
begin
|
|
with FData do
|
|
begin
|
|
{ Use defaults if necessairy: }
|
|
if boUseDefaultHeader in Options then
|
|
RUTF8Header := {$IFDEF RTL200_UP}UTF8Encode{$ELSE}WideStringToUTF8{$ENDIF RTL200_UP}(DefaultHeader);
|
|
if boUseDefaultIcon in Options then
|
|
RIconKind := DefaultIcon;
|
|
if boUseDefaultImageIndex in Options then
|
|
RImageIndex := DefaultImageIndex;
|
|
RShowCloseBtn := boShowCloseBtn in Options;
|
|
|
|
{ Determine animation style }
|
|
if not IsWinXP_UP then
|
|
RAnimationStyle := atNone
|
|
else
|
|
if boCustomAnimation in Options then
|
|
begin
|
|
RAnimationStyle := FCustomAnimationStyle;
|
|
RAnimationTime := FCustomAnimationTime;
|
|
end
|
|
else
|
|
begin
|
|
SystemParametersInfo(SPI_GETTOOLTIPANIMATION, 0, @Animate, 0);
|
|
if Animate then
|
|
begin
|
|
SystemParametersInfo(SPI_GETTOOLTIPFADE, 0, @Animate, 0);
|
|
if Animate then
|
|
RAnimationStyle := atBlend
|
|
else
|
|
RAnimationStyle := atSlide;
|
|
end
|
|
else
|
|
RAnimationStyle := atNone;
|
|
RAnimationTime := 100;
|
|
end;
|
|
|
|
{ Hook the anchor window }
|
|
FActive := True;
|
|
Hook;
|
|
|
|
{ Determine the size of the balloon rect, the stem point will be on
|
|
position (0, 0) }
|
|
if MaxWidth = 0 then
|
|
TmpMaxWidth := Screen.Width
|
|
else
|
|
TmpMaxWidth := MaxWidth;
|
|
Rect := FHint.CalcHintRectUTF8(TmpMaxWidth, RUTF8Hint, @FData);
|
|
|
|
{ Offset the rectangle to the anchor position }
|
|
if Assigned(RAnchorWindow) then
|
|
with RAnchorWindow.ClientToScreen(RAnchorPosition) do
|
|
OffsetRect(Rect, X, Y)
|
|
else
|
|
with RAnchorPosition do
|
|
OffsetRect(Rect, X, Y);
|
|
|
|
if boPlaySound in Options then
|
|
GlobalCtrl.PlaySound(RIconKind);
|
|
|
|
FHint.InternalActivateHint(Rect, {$IFDEF RTL200_UP}System.UTF8ToString{$ENDIF RTL200_UP}(RUTF8Hint));
|
|
|
|
{ Now we can determine the actual anchor & stempoint position: }
|
|
if Assigned(RAnchorWindow) then
|
|
begin
|
|
RAnchorPosition := RAnchorWindow.ScreenToClient(Rect.TopLeft);
|
|
RStemPointPosition := RAnchorWindow.ScreenToClient(FHint.StemPointPosition);
|
|
end
|
|
else
|
|
begin
|
|
RAnchorPosition := Rect.TopLeft;
|
|
RStemPointPosition := FHint.StemPointPosition;
|
|
end;
|
|
|
|
{ Last call because of possible CancelHint call in StartHintTimer }
|
|
if RVisibleTime > 0 then
|
|
StartHintTimer(RVisibleTime);
|
|
{if GetCapture = 0 then
|
|
SetCapture(FHint.Handle);
|
|
ReleaseCapture;}
|
|
end;
|
|
end;
|
|
|
|
procedure TJvBalloonHint.Notification(AComponent: TComponent;
|
|
Operation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
if (Operation = opRemove) and (AComponent = Images) then
|
|
Images := nil;
|
|
end;
|
|
|
|
procedure TJvBalloonHint.SetImages(const Value: TCustomImageList);
|
|
begin
|
|
FImages := Value;
|
|
if Images <> nil then
|
|
Images.FreeNotification(Self);
|
|
end;
|
|
|
|
procedure TJvBalloonHint.SetOptions(const Value: TJvBalloonOptions);
|
|
begin
|
|
if Value <> FOptions then
|
|
FOptions := Value;
|
|
end;
|
|
|
|
procedure TJvBalloonHint.SetUseBalloonAsApplicationHint(
|
|
const Value: Boolean);
|
|
begin
|
|
GlobalCtrl.UseBalloonAsApplicationHint := Value;
|
|
end;
|
|
|
|
procedure TJvBalloonHint.StartHintTimer(Value: Integer);
|
|
begin
|
|
StopHintTimer;
|
|
if SetTimer(Handle, 1, Value, nil) = 0 then
|
|
CancelHint
|
|
else
|
|
FTimerActive := True;
|
|
end;
|
|
|
|
procedure TJvBalloonHint.StopHintTimer;
|
|
begin
|
|
if FTimerActive then
|
|
begin
|
|
KillTimer(Handle, 1);
|
|
FTimerActive := True;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvBalloonHint.UnHook;
|
|
begin
|
|
if Assigned(FData.RAnchorWindow) then
|
|
UnRegisterWndProcHook(FData.RAnchorWindow, HookProc, hoBeforeMsg);
|
|
end;
|
|
|
|
procedure TJvBalloonHint.WndProc(var Msg: TMessage);
|
|
begin
|
|
with Msg do
|
|
if Msg = WM_TIMER then
|
|
try
|
|
CancelHint;
|
|
except
|
|
{$IFDEF COMPILER6_UP}
|
|
if Assigned(ApplicationHandleException) then
|
|
ApplicationHandleException(Self);
|
|
{$ELSE}
|
|
Application.HandleException(Self);
|
|
{$ENDIF COMPILER6_UP}
|
|
end
|
|
else
|
|
Result := DefWindowProc(Handle, Msg, WParam, LParam);
|
|
end;
|
|
|
|
//=== { TGlobalCtrl } ========================================================
|
|
|
|
constructor TGlobalCtrl.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
|
|
FCtrls := TList.Create;
|
|
|
|
if IsWinXP_UP then
|
|
begin
|
|
FDefaultImages := TImageList.Create(nil);
|
|
{ According to MSDN flag ILC_COLOR32 needs to be included (?) }
|
|
FDefaultImages.Handle := ImageList_Create(16, 16, ILC_COLOR32 or ILC_MASK, 4, 4);
|
|
end
|
|
else
|
|
FDefaultImages := TImageList.CreateSize(16, 16);
|
|
|
|
{ Only need to update the background color in XP when using pre v6.0 ComCtl32.dll
|
|
image lists }
|
|
FNeedUpdateBkColor := IsWinXP_UP and (GetComCtlVersion < $00060000);
|
|
|
|
if FNeedUpdateBkColor then
|
|
FDefaultImages.BkColor := Application.HintColor
|
|
else
|
|
FDefaultImages.BkColor := clNone;
|
|
|
|
FBkColor := Application.HintColor;
|
|
FUseBalloonAsApplicationHint := False;
|
|
|
|
GetDefaultImages;
|
|
GetDefaultSounds;
|
|
end;
|
|
|
|
destructor TGlobalCtrl.Destroy;
|
|
begin
|
|
FDefaultImages.Free;
|
|
FCtrls.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TGlobalCtrl.Add(ABalloonHint: TJvBalloonHint);
|
|
begin
|
|
FCtrls.Add(ABalloonHint);
|
|
{ Determine whether we are designing }
|
|
if Assigned(ABalloonHint) then
|
|
FDesigning := csDesigning in ABalloonHint.ComponentState;
|
|
end;
|
|
|
|
procedure TGlobalCtrl.DrawHintImage(Canvas: TCanvas; X, Y: Integer; const ABkColor: TColor);
|
|
begin
|
|
DrawHintImage(Canvas, X, Y, MainCtrl.DefaultIcon, MainCtrl.DefaultImageIndex, ABkColor);
|
|
end;
|
|
|
|
procedure TGlobalCtrl.DrawHintImage(Canvas: TCanvas; X, Y: Integer;
|
|
const AIconKind: TJvIconKind; const AImageIndex: TImageIndex; const ABkColor: TColor);
|
|
const
|
|
cDefaultImages: array [TJvIconKind] of Integer = (-1, -1, 0, 1, 2, 3, 4);
|
|
begin
|
|
case AIconKind of
|
|
ikCustom:
|
|
with MainCtrl do
|
|
if not Assigned(Images) or (AImageIndex < 0) or (AImageIndex >= Images.Count) then
|
|
begin
|
|
BkColor := ABkColor;
|
|
FDefaultImages.Draw(Canvas, X, Y, cDefaultImages[ikInformation]);
|
|
end
|
|
else
|
|
Images.Draw(Canvas, X, Y, AImageIndex);
|
|
ikNone:
|
|
;
|
|
else
|
|
BkColor := ABkColor;
|
|
FDefaultImages.Draw(Canvas, X, Y, cDefaultImages[AIconKind]);
|
|
end;
|
|
end;
|
|
|
|
procedure TGlobalCtrl.GetDefaultImages;
|
|
type
|
|
TPictureType = (ptXP, ptNormal, ptSimple);
|
|
const
|
|
{ Get the images:
|
|
|
|
For From ID TJvIconKind Spec
|
|
---------------------------------------------------------------------------
|
|
Windows XP User32.dll 100 ikApplication 16x16 32x32 48x48 1,4,8,32 bpp
|
|
101 ikWarning
|
|
102 ikQuestion
|
|
103 ikError
|
|
104 ikInformation
|
|
105 ikApplication
|
|
All (?) comctl32.dll 20480 ikError 16x16 32x32 4 bpp
|
|
20481 ikInformation
|
|
20482 ikWarning
|
|
}
|
|
|
|
{ ikApplication, ikError, ikInformation, ikQuestion, ikWarning }
|
|
cIcons: array [TPictureType, ikApplication..ikWarning] of Integer =
|
|
(
|
|
(100, 103, 104, 102, 101), // XP
|
|
(OIC_SAMPLE, 20480, 20481, OIC_QUES, 20482), // Normal
|
|
(OIC_SAMPLE, OIC_HAND, OIC_NOTE, OIC_QUES, OIC_BANG) // Paranoid
|
|
);
|
|
cFlags: array [Boolean] of UINT = (0, LR_SHARED);
|
|
var
|
|
IconKind: TJvIconKind;
|
|
PictureType: TPictureType;
|
|
IconHandle: THandle;
|
|
Shared: Boolean;
|
|
Modules: array [Boolean] of HMODULE;
|
|
begin
|
|
PictureType := ptNormal;
|
|
Modules[True] := 0;
|
|
|
|
if IsWinXP_UP and (GetComCtlVersion >= ComCtlVersionIE6) then
|
|
begin
|
|
Modules[False] := GetModuleHandle('user32.dll');
|
|
if Modules[False] <> 0 then
|
|
PictureType := ptXP
|
|
end;
|
|
|
|
if PictureType = ptNormal then
|
|
begin
|
|
Modules[False] := GetModuleHandle('comctl32.dll');
|
|
if Modules[False] = 0 then
|
|
PictureType := ptSimple;
|
|
end;
|
|
|
|
{ Now PictureType = ptXP -> Modules = (user32.dll handle, 0)
|
|
PictureType = ptNormal -> Modules = (comctl32.dll handle, 0)
|
|
PictureType = ptSimple -> Modules = (0, 0)
|
|
}
|
|
|
|
for IconKind := Low(cIcons[PictureType]) to High(cIcons[PictureType]) do
|
|
begin
|
|
Shared := (PictureType = ptSimple) or
|
|
((PictureType = ptNormal) and (IconKind in [ikApplication, ikQuestion]));
|
|
IconHandle :=
|
|
LoadImage(Modules[Shared], MakeIntResource(cIcons[PictureType, IconKind]),
|
|
IMAGE_ICON, 16, 16, cFlags[Shared]);
|
|
ImageList_AddIcon(FDefaultImages.Handle, IconHandle);
|
|
{ MSDN: Do not use DestroyIcon to destroy a shared icon. A shared icon is
|
|
valid as long as the module from which it was loaded remains in memory }
|
|
if not Shared then
|
|
DestroyIcon(IconHandle);
|
|
end;
|
|
end;
|
|
|
|
procedure TGlobalCtrl.GetDefaultSounds;
|
|
{ Taken from ActnMenus.pas }
|
|
var
|
|
Registry: TRegistry;
|
|
|
|
function ReadSoundSetting(KeyStr: string): string;
|
|
var
|
|
S: string;
|
|
begin
|
|
Registry.RootKey := HKEY_CURRENT_USER;
|
|
Result := '';
|
|
if Registry.OpenKeyReadOnly('\AppEvents\Schemes\Apps\.Default\' + KeyStr) then
|
|
try
|
|
S := Registry.ReadString('');
|
|
SetLength(Result, 4096);
|
|
SetLength(Result, ExpandEnvironmentStrings(PChar(S), PChar(Result), 4096) - 1);
|
|
finally
|
|
Registry.CloseKey;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
Registry := TRegistry.Create;
|
|
try
|
|
FSounds[ikCustom] := ReadSoundSetting('SystemNotification\.Current');
|
|
FSounds[ikNone] := FSounds[ikCustom];
|
|
FSounds[ikApplication] := FSounds[ikCustom];
|
|
FSounds[ikError] := ReadSoundSetting('SystemHand\.Current');
|
|
FSounds[ikInformation] := ReadSoundSetting('SystemAsterisk\.Current');
|
|
FSounds[ikQuestion] := ReadSoundSetting('SystemQuestion\.Current');
|
|
FSounds[ikWarning] := ReadSoundSetting('SystemExclamation\.Current');
|
|
finally
|
|
Registry.Free;
|
|
end;
|
|
end;
|
|
|
|
function TGlobalCtrl.GetMainCtrl: TJvBalloonHint;
|
|
begin
|
|
if FCtrls.Count = 0 then
|
|
begin
|
|
if GMainCtrl = nil then
|
|
GMainCtrl := TJvBalloonHint.Create(Self);
|
|
Result := GMainCtrl;
|
|
end
|
|
else
|
|
Result := TJvBalloonHint(FCtrls[0]);
|
|
end;
|
|
|
|
function TGlobalCtrl.HintImageSize: TSize;
|
|
begin
|
|
Result := HintImageSize(MainCtrl.DefaultIcon, MainCtrl.DefaultImageIndex);
|
|
end;
|
|
|
|
function TGlobalCtrl.HintImageSize(const AIconKind: TJvIconKind;
|
|
const AImageIndex: TImageIndex): TSize;
|
|
begin
|
|
case AIconKind of
|
|
ikCustom:
|
|
with MainCtrl do
|
|
if not Assigned(Images) or (AImageIndex < 0) or (AImageIndex >= Images.Count) then
|
|
begin
|
|
Result.cx := 16;
|
|
Result.cy := 16;
|
|
end
|
|
else
|
|
begin
|
|
Result.cx := Images.Width;
|
|
Result.cy := Images.Height;
|
|
end;
|
|
ikNone:
|
|
begin
|
|
Result.cx := 0;
|
|
Result.cy := 0;
|
|
end;
|
|
else
|
|
begin
|
|
Result.cx := 16;
|
|
Result.cy := 16;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TGlobalCtrl.PlaySound(const AIconKind: TJvIconKind);
|
|
begin
|
|
if Length(FSounds[AIconKind]) > 0 then
|
|
sndPlaySound(PChar(FSounds[AIconKind]), SND_NOSTOP or SND_ASYNC);
|
|
end;
|
|
|
|
procedure TGlobalCtrl.Remove(ABalloonHint: TJvBalloonHint);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
I := FCtrls.IndexOf(ABalloonHint);
|
|
if I >= 0 then
|
|
begin
|
|
FCtrls.Delete(I);
|
|
|
|
if FCtrls.Count = 0 then
|
|
UseBalloonAsApplicationHint := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TGlobalCtrl.SetBkColor(const Value: TColor);
|
|
begin
|
|
if FNeedUpdateBkColor and (FBkColor <> Value) then
|
|
begin
|
|
{ Icons in windows XP use an alpha channel to 'blend' with the background.
|
|
If the background color changes, then the images must be redrawn,
|
|
when using pre v6.0 ComCtl32.dll image lists
|
|
}
|
|
FBkColor := Value;
|
|
FDefaultImages.Clear;
|
|
FDefaultImages.BkColor := FBkColor;
|
|
GetDefaultImages;
|
|
end;
|
|
end;
|
|
|
|
procedure TGlobalCtrl.SetUseBalloonAsApplicationHint(const Value: Boolean);
|
|
begin
|
|
if FDesigning then
|
|
FUseBalloonAsApplicationHint := Value
|
|
else
|
|
if Value <> FUseBalloonAsApplicationHint then
|
|
begin
|
|
FUseBalloonAsApplicationHint := Value;
|
|
|
|
Application.CancelHint;
|
|
|
|
if FUseBalloonAsApplicationHint then
|
|
begin
|
|
FOldHintWindowClass := HintWindowClass;
|
|
HintWindowClass := TJvBalloonWindow;
|
|
end
|
|
else
|
|
HintWindowClass := FOldHintWindowClass;
|
|
end;
|
|
end;
|
|
|
|
//=== { TJvBalloonWindowEx } =================================================
|
|
|
|
procedure TJvBalloonWindowEx.ChangeCloseState(const AState: Cardinal);
|
|
begin
|
|
if AState <> FCloseState then
|
|
begin
|
|
FCloseState := AState;
|
|
InvalidateRect(Self.Handle, @FCloseBtnRect, True);
|
|
end;
|
|
end;
|
|
|
|
function FormHasFocus(FormHandle: HWND): Boolean;
|
|
var
|
|
H: HWND;
|
|
begin
|
|
H := GetFocus;
|
|
while IsWindow(H) and (H <> FormHandle) do
|
|
H := GetParent(H);
|
|
Result := H = FormHandle;
|
|
end;
|
|
|
|
procedure TJvBalloonWindowEx.EnsureTopMost;
|
|
begin
|
|
if not Assigned(FCtrl.FData.RAnchorWindow) then
|
|
Exit;
|
|
|
|
if not FormHasFocus(FCtrl.FData.RAnchorWindow.Handle) then
|
|
{ Current window is not focused, thus place the balloon behind the
|
|
window that has focus }
|
|
NormalizeTopMost
|
|
else
|
|
RestoreTopMost;
|
|
end;
|
|
|
|
procedure TJvBalloonWindowEx.Init(AData: Pointer);
|
|
begin
|
|
Canvas.Font := Screen.HintFont;
|
|
Color := Application.HintColor;
|
|
|
|
with PHintData(AData)^ do
|
|
begin
|
|
FImageIndex := RImageIndex;
|
|
FIconKind := RIconKind;
|
|
FHeader := {$IFDEF RTL200_UP}System.{$ENDIF RTL200_UP}UTF8ToWideString(RUTF8Header);
|
|
if FHeader = '' then
|
|
FHeader := WideString(RUTF8Header);
|
|
|
|
FShowHeader := FHeader > '';
|
|
FShowIcon := (FIconKind <> ikNone) and
|
|
((FIconKind <> ikCustom) or (FImageIndex <> -1));
|
|
FShowCloseBtn := RShowCloseBtn;
|
|
|
|
FAnimationTime := RAnimationTime;
|
|
FAnimationStyle := RAnimationStyle;
|
|
|
|
FSwitchHeight := RSwitchHeight;
|
|
FIsAnchored := Assigned(RAnchorWindow);
|
|
end;
|
|
|
|
FImageSize := GlobalCtrl.HintImageSize(FIconKind, FImageIndex);
|
|
FCurrentPosition := FCtrl.DefaultBalloonPosition;
|
|
end;
|
|
|
|
procedure BoundRect(var ARect: TRect; const BoundingRect: TRect);
|
|
begin
|
|
if BoundingRect.Left > ARect.Left then
|
|
begin
|
|
ARect.Right := ARect.Right + (BoundingRect.Left - ARect.Left);
|
|
ARect.Left := BoundingRect.Left;
|
|
end;
|
|
if BoundingRect.Top > ARect.Top then
|
|
begin
|
|
ARect.Bottom := ARect.Bottom + (BoundingRect.Top - ARect.Top);
|
|
ARect.Top := BoundingRect.Top;
|
|
end;
|
|
if BoundingRect.Right < ARect.Right then
|
|
begin
|
|
ARect.Left := ARect.Left - (ARect.Right - BoundingRect.Right);
|
|
ARect.Right := BoundingRect.Right;
|
|
end;
|
|
if BoundingRect.Bottom < ARect.Bottom then
|
|
begin
|
|
ARect.Top := ARect.Top - (ARect.Bottom - BoundingRect.Bottom);
|
|
ARect.Bottom := BoundingRect.Bottom;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvBalloonWindowEx.InternalActivateHint(var Rect: TRect;
|
|
const AHint: string);
|
|
const
|
|
{TJvAnimationStyle = (atNone, atSlide, atRoll, atRollHorNeg, atRollHorPos, atRollVerNeg,
|
|
atRollVerPos, atSlideHorNeg, atSlideHorPos, atSlideVerNeg, atSlideVerPos, atCenter, atBlend);}
|
|
cAnimationStyle: array [TJvAnimationStyle] of Integer =
|
|
(0, AW_SLIDE, 0, AW_HOR_NEGATIVE,
|
|
AW_HOR_POSITIVE, AW_VER_NEGATIVE, AW_VER_POSITIVE, AW_HOR_NEGATIVE or AW_SLIDE,
|
|
AW_HOR_POSITIVE or AW_SLIDE, AW_VER_NEGATIVE or AW_SLIDE, AW_VER_POSITIVE or AW_SLIDE,
|
|
AW_CENTER, AW_BLEND);
|
|
var
|
|
AutoValue: Integer;
|
|
begin
|
|
FCloseState := DFCS_FLAT;
|
|
CheckPosition(Rect);
|
|
|
|
if HandleAllocated and IsWindowVisible(Handle) then
|
|
begin
|
|
Hide;
|
|
if ParentWindow = 0 then
|
|
ShowWindow(Handle, SW_HIDE);
|
|
end;
|
|
|
|
{ This will prevent focusing/unfocusing of the application button on the
|
|
taskbar when clicking on the balloon window }
|
|
if FIsAnchored then
|
|
{ Application Handle, so we automatically get minimized/restored when the
|
|
application minimizes/restores }
|
|
ParentWindow := Application.Handle
|
|
else
|
|
ParentWindow := 0;
|
|
|
|
BoundRect(Rect, DesktopRect);
|
|
|
|
with Rect do
|
|
SetBounds(Left, Top, Right - Left, Bottom - Top);
|
|
UpdateRegion;
|
|
|
|
{ Set the Z order of the balloon }
|
|
if Assigned(FCtrl.FData.RAnchorWindow) then
|
|
begin
|
|
if not IsWindowVisible(FCtrl.FData.RAnchorWindow.Handle) or
|
|
IsIconic(FCtrl.FData.RAnchorWindow.Handle) then
|
|
{ Current window is minimized, thus do not show the balloon }
|
|
Exit
|
|
else
|
|
EnsureTopMost;
|
|
end
|
|
else
|
|
RestoreTopMost;
|
|
|
|
// can only blend on Vista
|
|
if IsWinVista_UP and (GetComCtlVersion >= ComCtlVersionIE6) then
|
|
if FAnimationStyle <> atNone then
|
|
FAnimationStyle := atBlend;
|
|
|
|
if (FAnimationStyle <> atNone) and IsWinXP_UP and (GetComCtlVersion >= ComCtlVersionIE6) and Assigned(AnimateWindowProc) then
|
|
begin
|
|
if FAnimationStyle in [atSlide, atRoll] then
|
|
case FCurrentPosition of
|
|
bpLeftDown, bpRightDown:
|
|
AutoValue := AW_VER_POSITIVE;
|
|
else {bpLeftUp, bpRightUp:}
|
|
AutoValue := AW_VER_NEGATIVE;
|
|
end
|
|
else
|
|
AutoValue := 0;
|
|
{ This function will fail on systems other than Windows XP,
|
|
because of use of the window region: }
|
|
AnimateWindowProc(Handle, FAnimationTime, cAnimationStyle[FAnimationStyle] or AutoValue);
|
|
end;
|
|
|
|
{ Ensure property Visible is set to True: }
|
|
Show;
|
|
{ If ParentWindow = 0, calling Show won't trigger the CM_SHOWINGCHANGED message
|
|
thus ShowWindow/SetWindowPos isn't called. We do it ourselfs: }
|
|
if ParentWindow = 0 then
|
|
ShowWindow(Handle, SW_SHOWNOACTIVATE);
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TJvBalloonWindowEx.MoveWindow(NewPos: TPoint);
|
|
begin
|
|
BoundsRect := Rect(NewPos.X, NewPos.Y, NewPos.X + Width, NewPos.Y + Height);
|
|
end;
|
|
|
|
procedure TJvBalloonWindowEx.NormalizeTopMost;
|
|
var
|
|
TopWindow: HWND;
|
|
begin
|
|
if not Assigned(FCtrl.FData.RAnchorWindow) then
|
|
Exit;
|
|
|
|
{ Retrieve the window below the anchor window in the Z order. }
|
|
TopWindow := GetWindow(FCtrl.FData.RAnchorWindow.Handle, GW_HWNDPREV);
|
|
if GetWindowLong(TopWindow, GWL_EXSTYLE) and WS_EX_TOPMOST <> 0 then
|
|
TopWindow := HWND_NOTOPMOST;
|
|
|
|
SetWindowPos(Handle, TopWindow, 0, 0, 0, 0,
|
|
SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_NOOWNERZORDER);
|
|
end;
|
|
|
|
procedure TJvBalloonWindowEx.Paint;
|
|
{$IFDEF JVCLThemesEnabled}
|
|
var
|
|
Details: TThemedElementDetails;
|
|
Button: TThemedToolTip;
|
|
{$ENDIF JVCLThemesEnabled}
|
|
begin
|
|
if FShowIcon then
|
|
with FIconPos do
|
|
GlobalCtrl.DrawHintImage(Canvas, X, Y, FIconKind, FImageIndex, Color);
|
|
|
|
if FShowCloseBtn then
|
|
begin
|
|
{$IFDEF JVCLThemesEnabled}
|
|
if ThemeServices.ThemesEnabled then
|
|
begin
|
|
if (FCloseState and DFCS_PUSHED > 0) and (FCloseState and DFCS_HOT = 0) then
|
|
Button := tttCloseNormal
|
|
else
|
|
if FCloseState and DFCS_PUSHED > 0 then
|
|
Button := tttClosePressed
|
|
else
|
|
if (FCloseState and DFCS_HOT > 0) and not (csDesigning in ComponentState) then
|
|
Button := tttCloseHot
|
|
else
|
|
Button := tttCloseNormal;
|
|
|
|
Details := ThemeServices.GetElementDetails(Button);
|
|
ThemeServices.DrawElement(Canvas.Handle, Details, FCloseBtnRect);
|
|
end
|
|
else
|
|
{$ENDIF JVCLThemesEnabled}
|
|
DrawFrameControl(Canvas.Handle, FCloseBtnRect, DFC_CAPTION, DFCS_TRANSPARENT or
|
|
DFCS_CAPTIONCLOSE or FCloseState);
|
|
end;
|
|
|
|
if FMsg > '' then
|
|
begin
|
|
GetHintMessageFont(Canvas.Font);
|
|
DrawTextW(Canvas.Handle, FMsg, FMsgRect,
|
|
DefaultTextFlags or DrawTextBiDiModeFlagsReadingOnly);
|
|
end;
|
|
|
|
if FShowHeader then
|
|
begin
|
|
GetHintTitleFont(Canvas.Font);
|
|
DrawTextW(Canvas.Handle, FHeader, FHeaderRect,
|
|
DefaultTextFlags or DrawTextBiDiModeFlagsReadingOnly);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvBalloonWindowEx.RestoreTopMost;
|
|
begin
|
|
SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0,
|
|
SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_NOOWNERZORDER);
|
|
end;
|
|
|
|
procedure TJvBalloonWindowEx.WMActivateApp(var Msg: TWMActivateApp);
|
|
begin
|
|
inherited;
|
|
if Msg.Active then
|
|
EnsureTopMost;
|
|
end;
|
|
|
|
procedure TJvBalloonWindowEx.WMLButtonDown(var Msg: TWMLButtonDown);
|
|
begin
|
|
inherited;
|
|
if FShowCloseBtn then
|
|
begin
|
|
if PtInRect(FCloseBtnRect, SmallPointToPoint(Msg.Pos)) then
|
|
begin
|
|
{SetCapture(Handle);}// handled in inherited
|
|
ChangeCloseState(FCloseState or DFCS_PUSHED);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvBalloonWindowEx.WMLButtonUp(var Msg: TWMLButtonUp);
|
|
begin
|
|
if FShowCloseBtn then
|
|
begin
|
|
if FCloseState and DFCS_PUSHED > 0 then
|
|
begin
|
|
{ReleaseCapture;}// handled in inherited
|
|
ChangeCloseState(FCloseState and not DFCS_PUSHED);
|
|
if PtInRect(FCloseBtnRect, SmallPointToPoint(Msg.Pos)) then
|
|
begin
|
|
{ Prevent firing of OnClick event in inherited call }
|
|
ControlState := ControlState - [csClicked];
|
|
if FCtrl.HandleCloseBtnClick then
|
|
FCtrl.CancelHint;
|
|
end;
|
|
end;
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TJvBalloonWindowEx.WMMouseMove(var Msg: TWMMouseMove);
|
|
var
|
|
State: Cardinal;
|
|
begin
|
|
inherited;
|
|
if FShowCloseBtn then
|
|
begin
|
|
State := DFCS_FLAT;
|
|
|
|
if PtInRect(FCloseBtnRect, SmallPointToPoint(Msg.Pos)) and
|
|
not (csDesigning in ComponentState) then
|
|
begin
|
|
{ Note: DFCS_HOT is not supported in windows 95 systems }
|
|
State := State or DFCS_HOT;
|
|
if FCloseState and DFCS_PUSHED > 0 then
|
|
State := State or DFCS_PUSHED;
|
|
end;
|
|
ChangeCloseState(State);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvBalloonWindowEx.WMNCHitTest(var Msg: TWMNCHitTest);
|
|
begin
|
|
Msg.Result := HTCLIENT;
|
|
end;
|
|
|
|
initialization
|
|
{$IFDEF UNITVERSIONING}
|
|
RegisterUnitVersion(HInstance, UnitVersioning);
|
|
{$ENDIF UNITVERSIONING}
|
|
InitUnicodeWrap;
|
|
|
|
finalization
|
|
FreeAndNil(GGlobalCtrl);
|
|
{$IFDEF UNITVERSIONING}
|
|
UnregisterUnitVersion(HInstance);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
end.
|
|
|