david
78ab77cd4c
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.jvcl@19 7f62d464-2af8-f54e-996c-e91b33f51cbe
1832 lines
57 KiB
ObjectPascal
1832 lines
57 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: JvExControls.pas, released on 2004-01-04
|
|
|
|
The Initial Developer of the Original Code is Andreas Hausladen [Andreas dott Hausladen att gmx dott de]
|
|
Portions created by Andreas Hausladen are Copyright (C) 2004 Andreas Hausladen.
|
|
All Rights Reserved.
|
|
|
|
Contributor(s): -
|
|
dejoy.
|
|
|
|
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
|
|
located at http://jvcl.delphi-jedi.org
|
|
|
|
Known Issues:
|
|
-----------------------------------------------------------------------------}
|
|
// $Id: JvExControls.pas 12579 2009-10-26 19:59:53Z ahuser $
|
|
|
|
unit JvExControls;
|
|
|
|
{$I jvcl.inc}
|
|
|
|
{*****************************************************************************
|
|
* WARNING: Do not edit this file.
|
|
* This file is autogenerated from the source in devtools/JvExVCL/src.
|
|
* If you do it despite this warning your changes will be discarded by the next
|
|
* update of this file. Do your changes in the template files.
|
|
****************************************************************************}
|
|
{$D-} // do not step into this unit
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, Types,
|
|
SysUtils, Classes, Graphics, Controls, Forms,
|
|
{$IFDEF UNITVERSIONING}
|
|
JclUnitVersioning,
|
|
{$ENDIF UNITVERSIONING}
|
|
JvTypes, JvThemes, JVCLVer;
|
|
|
|
type
|
|
TDlgCode =
|
|
(dcWantAllKeys, dcWantArrows, dcWantChars, dcButton, dcHasSetSel, dcWantTab,
|
|
dcNative); // if dcNative is in the set the native allowed keys are used and GetDlgCode is ignored
|
|
TDlgCodes = set of TDlgCode;
|
|
|
|
const
|
|
dcWantMessage = dcWantAllKeys;
|
|
|
|
type
|
|
{ IJvExControl is used for the identification of an JvExXxx control. }
|
|
IJvExControl = interface
|
|
['{8E6579C3-D683-4562-AFAB-D23C8526E386}']
|
|
end;
|
|
|
|
{ Add IJvDenySubClassing to the base class list if the control should not
|
|
be themed by the ThemeManager (http://www.soft-gems.net Mike Lischke).
|
|
This only works with JvExVCL derived classes. }
|
|
IJvDenySubClassing = interface
|
|
['{76942BC0-2A6E-4DC4-BFC9-8E110DB7F601}']
|
|
end;
|
|
|
|
TStructPtrMessage = class(TObject)
|
|
private
|
|
public
|
|
Msg: TMessage;
|
|
constructor Create(Msg: Integer; WParam: Integer; var LParam);
|
|
end;
|
|
|
|
procedure SetDotNetFrameColors(FocusedColor, UnfocusedColor: TColor);
|
|
procedure DrawDotNetControl(Control: TWinControl; AColor: TColor; InControl: Boolean); overload;
|
|
procedure DrawDotNetControl(DC: HDC; R: TRect; AColor: TColor; UseFocusedColor: Boolean); overload;
|
|
procedure HandleDotNetHighlighting(Control: TWinControl; const Msg: TMessage;
|
|
MouseOver: Boolean; Color: TColor);
|
|
|
|
function CreateWMMessage(Msg: Integer; WParam: Integer; LParam: Longint): TMessage; overload; {$IFDEF SUPPORTS_INLINE} inline {$ENDIF}
|
|
function CreateWMMessage(Msg: Integer; WParam: Integer; LParam: TControl): TMessage; overload; {$IFDEF SUPPORTS_INLINE} inline {$ENDIF}
|
|
function SmallPointToLong(const Pt: TSmallPoint): Longint; {$IFDEF SUPPORTS_INLINE} inline {$ENDIF}
|
|
function ShiftStateToKeyData(Shift: TShiftState): Longint;
|
|
function GetFocusedControl(AControl: TControl): TWinControl;
|
|
function DlgcToDlgCodes(Value: Longint): TDlgCodes;
|
|
function DlgCodesToDlgc(Value: TDlgCodes): Longint;
|
|
procedure GetHintColor(var HintInfo: THintInfo; AControl: TControl; HintColor: TColor);
|
|
function DispatchIsDesignMsg(Control: TControl; var Msg: TMessage): Boolean;
|
|
|
|
type
|
|
TJvExControl = class(TControl, IJvExControl)
|
|
private
|
|
FAboutJVCL: TJVCLAboutInfo;
|
|
FHintColor: TColor;
|
|
FMouseOver: Boolean;
|
|
FHintWindowClass: THintWindowClass;
|
|
FOnMouseEnter: TNotifyEvent;
|
|
FOnMouseLeave: TNotifyEvent;
|
|
FOnParentColorChanged: TNotifyEvent;
|
|
function BaseWndProc(Msg: Integer; WParam: Integer = 0; LParam: Longint = 0): Integer; overload;
|
|
function BaseWndProc(Msg: Integer; WParam: Integer; LParam: TControl): Integer; overload;
|
|
function BaseWndProcEx(Msg: Integer; WParam: Integer; var LParam): Integer;
|
|
protected
|
|
procedure WndProc(var Msg: TMessage); override;
|
|
procedure FocusChanged(AControl: TWinControl); dynamic;
|
|
procedure VisibleChanged; reintroduce; dynamic;
|
|
procedure EnabledChanged; reintroduce; dynamic;
|
|
procedure TextChanged; reintroduce; virtual;
|
|
procedure ColorChanged; reintroduce; dynamic;
|
|
procedure FontChanged; reintroduce; dynamic;
|
|
procedure ParentFontChanged; reintroduce; dynamic;
|
|
procedure ParentColorChanged; reintroduce; dynamic;
|
|
procedure ParentShowHintChanged; reintroduce; dynamic;
|
|
function WantKey(Key: Integer; Shift: TShiftState; const KeyText: WideString): Boolean; reintroduce; virtual;
|
|
function HintShow(var HintInfo: THintInfo): Boolean; reintroduce; dynamic;
|
|
function HitTest(X, Y: Integer): Boolean; reintroduce; virtual;
|
|
procedure MouseEnter(AControl: TControl); reintroduce; dynamic;
|
|
procedure MouseLeave(AControl: TControl); reintroduce; dynamic;
|
|
property MouseOver: Boolean read FMouseOver write FMouseOver;
|
|
property HintColor: TColor read FHintColor write FHintColor default clDefault;
|
|
property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
|
|
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
|
|
property OnParentColorChange: TNotifyEvent read FOnParentColorChanged write FOnParentColorChanged;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
property HintWindowClass: THintWindowClass read FHintWindowClass write FHintWindowClass;
|
|
published
|
|
property AboutJVCL: TJVCLAboutInfo read FAboutJVCL write FAboutJVCL stored False;
|
|
end;
|
|
|
|
TJvExWinControl = class(TWinControl, IJvExControl)
|
|
private
|
|
FAboutJVCL: TJVCLAboutInfo;
|
|
FHintColor: TColor;
|
|
FMouseOver: Boolean;
|
|
FHintWindowClass: THintWindowClass;
|
|
FOnMouseEnter: TNotifyEvent;
|
|
FOnMouseLeave: TNotifyEvent;
|
|
FOnParentColorChanged: TNotifyEvent;
|
|
function BaseWndProc(Msg: Integer; WParam: Integer = 0; LParam: Longint = 0): Integer; overload;
|
|
function BaseWndProc(Msg: Integer; WParam: Integer; LParam: TControl): Integer; overload;
|
|
function BaseWndProcEx(Msg: Integer; WParam: Integer; var LParam): Integer;
|
|
protected
|
|
procedure WndProc(var Msg: TMessage); override;
|
|
procedure FocusChanged(AControl: TWinControl); dynamic;
|
|
procedure VisibleChanged; reintroduce; dynamic;
|
|
procedure EnabledChanged; reintroduce; dynamic;
|
|
procedure TextChanged; reintroduce; virtual;
|
|
procedure ColorChanged; reintroduce; dynamic;
|
|
procedure FontChanged; reintroduce; dynamic;
|
|
procedure ParentFontChanged; reintroduce; dynamic;
|
|
procedure ParentColorChanged; reintroduce; dynamic;
|
|
procedure ParentShowHintChanged; reintroduce; dynamic;
|
|
function WantKey(Key: Integer; Shift: TShiftState; const KeyText: WideString): Boolean; reintroduce; virtual;
|
|
function HintShow(var HintInfo: THintInfo): Boolean; reintroduce; dynamic;
|
|
function HitTest(X, Y: Integer): Boolean; reintroduce; virtual;
|
|
procedure MouseEnter(AControl: TControl); reintroduce; dynamic;
|
|
procedure MouseLeave(AControl: TControl); reintroduce; dynamic;
|
|
property MouseOver: Boolean read FMouseOver write FMouseOver;
|
|
property HintColor: TColor read FHintColor write FHintColor default clDefault;
|
|
property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
|
|
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
|
|
property OnParentColorChange: TNotifyEvent read FOnParentColorChanged write FOnParentColorChanged;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
property HintWindowClass: THintWindowClass read FHintWindowClass write FHintWindowClass;
|
|
published
|
|
property AboutJVCL: TJVCLAboutInfo read FAboutJVCL write FAboutJVCL stored False;
|
|
private
|
|
FDotNetHighlighting: Boolean;
|
|
protected
|
|
procedure BoundsChanged; reintroduce; virtual;
|
|
procedure CursorChanged; reintroduce; dynamic;
|
|
procedure ShowingChanged; reintroduce; dynamic;
|
|
procedure ShowHintChanged; reintroduce; dynamic;
|
|
procedure ControlsListChanging(Control: TControl; Inserting: Boolean); reintroduce; dynamic;
|
|
procedure ControlsListChanged(Control: TControl; Inserting: Boolean); reintroduce; dynamic;
|
|
procedure GetDlgCode(var Code: TDlgCodes); virtual;
|
|
procedure FocusSet(PrevWnd: THandle); virtual;
|
|
procedure FocusKilled(NextWnd: THandle); virtual;
|
|
function DoEraseBackground(Canvas: TCanvas; Param: Integer): Boolean; virtual;
|
|
{$IFDEF JVCLThemesEnabledD56}
|
|
private
|
|
function GetParentBackground: Boolean;
|
|
protected
|
|
procedure SetParentBackground(Value: Boolean); virtual;
|
|
property ParentBackground: Boolean read GetParentBackground write SetParentBackground;
|
|
{$ENDIF JVCLThemesEnabledD56}
|
|
published
|
|
property DotNetHighlighting: Boolean read FDotNetHighlighting write FDotNetHighlighting default False;
|
|
end;
|
|
|
|
TJvExCustomControl = class(TCustomControl, IJvExControl)
|
|
private
|
|
FAboutJVCL: TJVCLAboutInfo;
|
|
FHintColor: TColor;
|
|
FMouseOver: Boolean;
|
|
FHintWindowClass: THintWindowClass;
|
|
FOnMouseEnter: TNotifyEvent;
|
|
FOnMouseLeave: TNotifyEvent;
|
|
FOnParentColorChanged: TNotifyEvent;
|
|
function BaseWndProc(Msg: Integer; WParam: Integer = 0; LParam: Longint = 0): Integer; overload;
|
|
function BaseWndProc(Msg: Integer; WParam: Integer; LParam: TControl): Integer; overload;
|
|
function BaseWndProcEx(Msg: Integer; WParam: Integer; var LParam): Integer;
|
|
protected
|
|
procedure WndProc(var Msg: TMessage); override;
|
|
procedure FocusChanged(AControl: TWinControl); dynamic;
|
|
procedure VisibleChanged; reintroduce; dynamic;
|
|
procedure EnabledChanged; reintroduce; dynamic;
|
|
procedure TextChanged; reintroduce; virtual;
|
|
procedure ColorChanged; reintroduce; dynamic;
|
|
procedure FontChanged; reintroduce; dynamic;
|
|
procedure ParentFontChanged; reintroduce; dynamic;
|
|
procedure ParentColorChanged; reintroduce; dynamic;
|
|
procedure ParentShowHintChanged; reintroduce; dynamic;
|
|
function WantKey(Key: Integer; Shift: TShiftState; const KeyText: WideString): Boolean; reintroduce; virtual;
|
|
function HintShow(var HintInfo: THintInfo): Boolean; reintroduce; dynamic;
|
|
function HitTest(X, Y: Integer): Boolean; reintroduce; virtual;
|
|
procedure MouseEnter(AControl: TControl); reintroduce; dynamic;
|
|
procedure MouseLeave(AControl: TControl); reintroduce; dynamic;
|
|
property MouseOver: Boolean read FMouseOver write FMouseOver;
|
|
property HintColor: TColor read FHintColor write FHintColor default clDefault;
|
|
property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
|
|
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
|
|
property OnParentColorChange: TNotifyEvent read FOnParentColorChanged write FOnParentColorChanged;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
property HintWindowClass: THintWindowClass read FHintWindowClass write FHintWindowClass;
|
|
published
|
|
property AboutJVCL: TJVCLAboutInfo read FAboutJVCL write FAboutJVCL stored False;
|
|
private
|
|
FDotNetHighlighting: Boolean;
|
|
protected
|
|
procedure BoundsChanged; reintroduce; virtual;
|
|
procedure CursorChanged; reintroduce; dynamic;
|
|
procedure ShowingChanged; reintroduce; dynamic;
|
|
procedure ShowHintChanged; reintroduce; dynamic;
|
|
procedure ControlsListChanging(Control: TControl; Inserting: Boolean); reintroduce; dynamic;
|
|
procedure ControlsListChanged(Control: TControl; Inserting: Boolean); reintroduce; dynamic;
|
|
procedure GetDlgCode(var Code: TDlgCodes); virtual;
|
|
procedure FocusSet(PrevWnd: THandle); virtual;
|
|
procedure FocusKilled(NextWnd: THandle); virtual;
|
|
function DoEraseBackground(Canvas: TCanvas; Param: Integer): Boolean; virtual;
|
|
{$IFDEF JVCLThemesEnabledD56}
|
|
private
|
|
function GetParentBackground: Boolean;
|
|
protected
|
|
procedure SetParentBackground(Value: Boolean); virtual;
|
|
property ParentBackground: Boolean read GetParentBackground write SetParentBackground;
|
|
{$ENDIF JVCLThemesEnabledD56}
|
|
published
|
|
property DotNetHighlighting: Boolean read FDotNetHighlighting write FDotNetHighlighting default False;
|
|
end;
|
|
|
|
TJvExGraphicControl = class(TGraphicControl, IJvExControl)
|
|
private
|
|
FAboutJVCL: TJVCLAboutInfo;
|
|
FHintColor: TColor;
|
|
FMouseOver: Boolean;
|
|
FHintWindowClass: THintWindowClass;
|
|
FOnMouseEnter: TNotifyEvent;
|
|
FOnMouseLeave: TNotifyEvent;
|
|
FOnParentColorChanged: TNotifyEvent;
|
|
function BaseWndProc(Msg: Integer; WParam: Integer = 0; LParam: Longint = 0): Integer; overload;
|
|
function BaseWndProc(Msg: Integer; WParam: Integer; LParam: TControl): Integer; overload;
|
|
function BaseWndProcEx(Msg: Integer; WParam: Integer; var LParam): Integer;
|
|
protected
|
|
procedure WndProc(var Msg: TMessage); override;
|
|
procedure FocusChanged(AControl: TWinControl); dynamic;
|
|
procedure VisibleChanged; reintroduce; dynamic;
|
|
procedure EnabledChanged; reintroduce; dynamic;
|
|
procedure TextChanged; reintroduce; virtual;
|
|
procedure ColorChanged; reintroduce; dynamic;
|
|
procedure FontChanged; reintroduce; dynamic;
|
|
procedure ParentFontChanged; reintroduce; dynamic;
|
|
procedure ParentColorChanged; reintroduce; dynamic;
|
|
procedure ParentShowHintChanged; reintroduce; dynamic;
|
|
function WantKey(Key: Integer; Shift: TShiftState; const KeyText: WideString): Boolean; reintroduce; virtual;
|
|
function HintShow(var HintInfo: THintInfo): Boolean; reintroduce; dynamic;
|
|
function HitTest(X, Y: Integer): Boolean; reintroduce; virtual;
|
|
procedure MouseEnter(AControl: TControl); reintroduce; dynamic;
|
|
procedure MouseLeave(AControl: TControl); reintroduce; dynamic;
|
|
property MouseOver: Boolean read FMouseOver write FMouseOver;
|
|
property HintColor: TColor read FHintColor write FHintColor default clDefault;
|
|
property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
|
|
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
|
|
property OnParentColorChange: TNotifyEvent read FOnParentColorChanged write FOnParentColorChanged;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
property HintWindowClass: THintWindowClass read FHintWindowClass write FHintWindowClass;
|
|
published
|
|
property AboutJVCL: TJVCLAboutInfo read FAboutJVCL write FAboutJVCL stored False;
|
|
end;
|
|
|
|
TJvExHintWindow = class(THintWindow, IJvExControl)
|
|
private
|
|
FAboutJVCL: TJVCLAboutInfo;
|
|
FHintColor: TColor;
|
|
FMouseOver: Boolean;
|
|
FHintWindowClass: THintWindowClass;
|
|
FOnMouseEnter: TNotifyEvent;
|
|
FOnMouseLeave: TNotifyEvent;
|
|
FOnParentColorChanged: TNotifyEvent;
|
|
function BaseWndProc(Msg: Integer; WParam: Integer = 0; LParam: Longint = 0): Integer; overload;
|
|
function BaseWndProc(Msg: Integer; WParam: Integer; LParam: TControl): Integer; overload;
|
|
function BaseWndProcEx(Msg: Integer; WParam: Integer; var LParam): Integer;
|
|
protected
|
|
procedure WndProc(var Msg: TMessage); override;
|
|
procedure FocusChanged(AControl: TWinControl); dynamic;
|
|
procedure VisibleChanged; reintroduce; dynamic;
|
|
procedure EnabledChanged; reintroduce; dynamic;
|
|
procedure TextChanged; reintroduce; virtual;
|
|
procedure ColorChanged; reintroduce; dynamic;
|
|
procedure FontChanged; reintroduce; dynamic;
|
|
procedure ParentFontChanged; reintroduce; dynamic;
|
|
procedure ParentColorChanged; reintroduce; dynamic;
|
|
procedure ParentShowHintChanged; reintroduce; dynamic;
|
|
function WantKey(Key: Integer; Shift: TShiftState; const KeyText: WideString): Boolean; reintroduce; virtual;
|
|
function HintShow(var HintInfo: THintInfo): Boolean; reintroduce; dynamic;
|
|
function HitTest(X, Y: Integer): Boolean; reintroduce; virtual;
|
|
procedure MouseEnter(AControl: TControl); reintroduce; dynamic;
|
|
procedure MouseLeave(AControl: TControl); reintroduce; dynamic;
|
|
property MouseOver: Boolean read FMouseOver write FMouseOver;
|
|
property HintColor: TColor read FHintColor write FHintColor default clDefault;
|
|
property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
|
|
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
|
|
property OnParentColorChange: TNotifyEvent read FOnParentColorChanged write FOnParentColorChanged;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
property HintWindowClass: THintWindowClass read FHintWindowClass write FHintWindowClass;
|
|
published
|
|
property AboutJVCL: TJVCLAboutInfo read FAboutJVCL write FAboutJVCL stored False;
|
|
private
|
|
FDotNetHighlighting: Boolean;
|
|
protected
|
|
procedure BoundsChanged; reintroduce; virtual;
|
|
procedure CursorChanged; reintroduce; dynamic;
|
|
procedure ShowingChanged; reintroduce; dynamic;
|
|
procedure ShowHintChanged; reintroduce; dynamic;
|
|
procedure ControlsListChanging(Control: TControl; Inserting: Boolean); reintroduce; dynamic;
|
|
procedure ControlsListChanged(Control: TControl; Inserting: Boolean); reintroduce; dynamic;
|
|
procedure GetDlgCode(var Code: TDlgCodes); virtual;
|
|
procedure FocusSet(PrevWnd: THandle); virtual;
|
|
procedure FocusKilled(NextWnd: THandle); virtual;
|
|
function DoEraseBackground(Canvas: TCanvas; Param: Integer): Boolean; virtual;
|
|
{$IFDEF JVCLThemesEnabledD56}
|
|
private
|
|
function GetParentBackground: Boolean;
|
|
protected
|
|
procedure SetParentBackground(Value: Boolean); virtual;
|
|
property ParentBackground: Boolean read GetParentBackground write SetParentBackground;
|
|
{$ENDIF JVCLThemesEnabledD56}
|
|
published
|
|
property DotNetHighlighting: Boolean read FDotNetHighlighting write FDotNetHighlighting default False;
|
|
end;
|
|
|
|
TJvExPubGraphicControl = class(TJvExGraphicControl)
|
|
published
|
|
property BiDiMode;
|
|
property DragCursor;
|
|
property DragKind;
|
|
property DragMode;
|
|
property ParentBiDiMode;
|
|
property OnEndDock;
|
|
property OnStartDock;
|
|
end;
|
|
|
|
{$IFDEF UNITVERSIONING}
|
|
const
|
|
UnitVersioning: TUnitVersionInfo = (
|
|
RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/tags/JVCL3_39/run/JvExControls.pas $';
|
|
Revision: '$Revision: 12579 $';
|
|
Date: '$Date: 2009-10-26 20:59:53 +0100 (lun., 26 oct. 2009) $';
|
|
LogPath: 'JVCL\run'
|
|
);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
implementation
|
|
|
|
uses
|
|
TypInfo;
|
|
|
|
var
|
|
InternalFocusedColor: TColor = TColor($00733800);
|
|
InternalUnfocusedColor: TColor = clGray;
|
|
|
|
procedure SetDotNetFrameColors(FocusedColor, UnfocusedColor: TColor);
|
|
begin
|
|
InternalFocusedColor := FocusedColor;
|
|
InternalUnfocusedColor := UnfocusedColor;
|
|
end;
|
|
|
|
procedure DrawDotNetControl(Control: TWinControl; AColor: TColor; InControl: Boolean);
|
|
var
|
|
DC: HDC;
|
|
R: TRect;
|
|
begin
|
|
GetWindowRect(Control.Handle, R);
|
|
OffsetRect(R, -R.Left, -R.Top);
|
|
|
|
DC := GetWindowDC(Control.Handle);
|
|
try
|
|
DrawDotNetControl(DC, R, AColor, Control.Focused or InControl);
|
|
finally
|
|
ReleaseDC(Control.Handle, DC);
|
|
end;
|
|
end;
|
|
|
|
procedure DrawDotNetControl(DC: HDC; R: TRect; AColor: TColor; UseFocusedColor: Boolean);
|
|
var
|
|
Brush: HBRUSH;
|
|
begin
|
|
Brush := 0;
|
|
try
|
|
if UseFocusedColor then
|
|
Brush := CreateSolidBrush(ColorToRGB(InternalFocusedColor))
|
|
else
|
|
Brush := CreateSolidBrush(ColorToRGB(InternalUnfocusedColor));
|
|
|
|
FrameRect(DC, R, Brush);
|
|
InflateRect(R, -1, -1);
|
|
if not UseFocusedColor then
|
|
begin
|
|
DeleteObject(Brush);
|
|
Brush := CreateSolidBrush(ColorToRGB(AColor));
|
|
end;
|
|
FrameRect(DC, R, Brush);
|
|
finally
|
|
if Brush <> 0 then
|
|
DeleteObject(Brush);
|
|
end;
|
|
end;
|
|
|
|
procedure HandleDotNetHighlighting(Control: TWinControl; const Msg: TMessage;
|
|
MouseOver: Boolean; Color: TColor);
|
|
var
|
|
Rgn, SubRgn: HRGN;
|
|
begin
|
|
if not (csDesigning in Control.ComponentState) then
|
|
case Msg.Msg of
|
|
CM_MOUSEENTER, CM_MOUSELEAVE, WM_KILLFOCUS, WM_SETFOCUS, WM_NCPAINT:
|
|
begin
|
|
DrawDotNetControl(Control, Color, MouseOver);
|
|
if Msg.Msg = CM_MOUSELEAVE then
|
|
begin
|
|
Rgn := CreateRectRgn(0, 0, Control.Width - 1, Control.Height - 1);
|
|
SubRgn := CreateRectRgn(2, 2, Control.Width - 3, Control.Height - 3);
|
|
try
|
|
CombineRgn(Rgn, Rgn, SubRgn, RGN_DIFF);
|
|
InvalidateRgn(Control.Handle, Rgn, False); // redraw 3D border
|
|
finally
|
|
DeleteObject(SubRgn);
|
|
DeleteObject(Rgn);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function CreateWMMessage(Msg: Integer; WParam: Integer; LParam: Longint): TMessage;
|
|
begin
|
|
Result.Msg := Msg;
|
|
Result.WParam := WParam;
|
|
Result.LParam := LParam;
|
|
Result.Result := 0;
|
|
end;
|
|
|
|
function CreateWMMessage(Msg: Integer; WParam: Integer; LParam: TControl): TMessage;
|
|
begin
|
|
Result := CreateWMMessage(Msg, WParam, Integer(LParam));
|
|
end;
|
|
|
|
{ TStructPtrMessage }
|
|
constructor TStructPtrMessage.Create(Msg: Integer; WParam: Integer; var LParam);
|
|
begin
|
|
inherited Create;
|
|
Self.Msg.Msg := Msg;
|
|
Self.Msg.WParam := WParam;
|
|
Self.Msg.LParam := Windows.LPARAM(@LParam);
|
|
Self.Msg.Result := 0;
|
|
end;
|
|
|
|
function SmallPointToLong(const Pt: TSmallPoint): Longint;
|
|
begin
|
|
Result := Longint(Pt);
|
|
end;
|
|
|
|
function ShiftStateToKeyData(Shift: TShiftState): Longint;
|
|
const
|
|
AltMask = $20000000;
|
|
CtrlMask = $10000000;
|
|
ShiftMask = $08000000;
|
|
begin
|
|
Result := 0;
|
|
if ssAlt in Shift then
|
|
Result := Result or AltMask;
|
|
if ssCtrl in Shift then
|
|
Result := Result or CtrlMask;
|
|
if ssShift in Shift then
|
|
Result := Result or ShiftMask;
|
|
end;
|
|
|
|
function GetFocusedControl(AControl: TControl): TWinControl;
|
|
var
|
|
Form: TCustomForm;
|
|
begin
|
|
Result := nil;
|
|
Form := GetParentForm(AControl);
|
|
if Assigned(Form) then
|
|
Result := Form.ActiveControl;
|
|
end;
|
|
|
|
function DlgcToDlgCodes(Value: Longint): TDlgCodes;
|
|
begin
|
|
Result := [];
|
|
if (Value and DLGC_WANTARROWS) <> 0 then
|
|
Include(Result, dcWantArrows);
|
|
if (Value and DLGC_WANTTAB) <> 0 then
|
|
Include(Result, dcWantTab);
|
|
if (Value and DLGC_WANTALLKEYS) <> 0 then
|
|
Include(Result, dcWantAllKeys);
|
|
if (Value and DLGC_WANTCHARS) <> 0 then
|
|
Include(Result, dcWantChars);
|
|
if (Value and DLGC_BUTTON) <> 0 then
|
|
Include(Result, dcButton);
|
|
if (Value and DLGC_HASSETSEL) <> 0 then
|
|
Include(Result, dcHasSetSel);
|
|
end;
|
|
|
|
function DlgCodesToDlgc(Value: TDlgCodes): Longint;
|
|
begin
|
|
Result := 0;
|
|
if dcWantAllKeys in Value then
|
|
Result := Result or DLGC_WANTALLKEYS;
|
|
if dcWantArrows in Value then
|
|
Result := Result or DLGC_WANTARROWS;
|
|
if dcWantTab in Value then
|
|
Result := Result or DLGC_WANTTAB;
|
|
if dcWantChars in Value then
|
|
Result := Result or DLGC_WANTCHARS;
|
|
if dcButton in Value then
|
|
Result := Result or DLGC_BUTTON;
|
|
if dcHasSetSel in Value then
|
|
Result := Result or DLGC_HASSETSEL;
|
|
end;
|
|
|
|
procedure GetHintColor(var HintInfo: THintInfo; AControl: TControl; HintColor: TColor);
|
|
var
|
|
AHintInfo: THintInfo;
|
|
begin
|
|
case HintColor of
|
|
clNone:
|
|
HintInfo.HintColor := Application.HintColor;
|
|
clDefault:
|
|
begin
|
|
if Assigned(AControl) and Assigned(AControl.Parent) then
|
|
begin
|
|
AHintInfo := HintInfo;
|
|
AControl.Parent.Perform(CM_HINTSHOW, 0, LPARAM(@AHintInfo));
|
|
HintInfo.HintColor := AHintInfo.HintColor;
|
|
end;
|
|
end;
|
|
else
|
|
HintInfo.HintColor := HintColor;
|
|
end;
|
|
end;
|
|
|
|
function DispatchIsDesignMsg(Control: TControl; var Msg: TMessage): Boolean;
|
|
var
|
|
Form: TCustomForm;
|
|
begin
|
|
Result := False;
|
|
case Msg.Msg of
|
|
WM_SETFOCUS, WM_KILLFOCUS, WM_NCHITTEST,
|
|
WM_MOUSEFIRST..WM_MOUSELAST,
|
|
WM_KEYFIRST..WM_KEYLAST,
|
|
WM_CANCELMODE:
|
|
Exit; // These messages are handled in TWinControl.WndProc before IsDesignMsg() is called
|
|
end;
|
|
if (Control <> nil) and (csDesigning in Control.ComponentState) then
|
|
begin
|
|
Form := GetParentForm(Control);
|
|
if (Form <> nil) and (Form.Designer <> nil) and
|
|
Form.Designer.IsDesignMsg(Control, Msg) then
|
|
Result := True;
|
|
end;
|
|
end;
|
|
|
|
constructor TJvExControl.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FHintColor := clDefault;
|
|
end;
|
|
|
|
function TJvExControl.BaseWndProc(Msg: Integer; WParam: Integer = 0; LParam: Longint = 0): Integer;
|
|
var
|
|
Mesg: TMessage;
|
|
begin
|
|
Mesg := CreateWMMessage(Msg, WParam, LParam);
|
|
inherited WndProc(Mesg);
|
|
Result := Mesg.Result;
|
|
end;
|
|
|
|
function TJvExControl.BaseWndProc(Msg: Integer; WParam: Integer; LParam: TControl): Integer;
|
|
var
|
|
Mesg: TMessage;
|
|
begin
|
|
Mesg := CreateWMMessage(Msg, WParam, LParam);
|
|
inherited WndProc(Mesg);
|
|
Result := Mesg.Result;
|
|
end;
|
|
|
|
function TJvExControl.BaseWndProcEx(Msg: Integer; WParam: Integer; var LParam): Integer;
|
|
var
|
|
Mesg: TStructPtrMessage;
|
|
begin
|
|
Mesg := TStructPtrMessage.Create(Msg, WParam, LParam);
|
|
try
|
|
inherited WndProc(Mesg.Msg);
|
|
finally
|
|
Result := Mesg.Msg.Result;
|
|
Mesg.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvExControl.VisibleChanged;
|
|
begin
|
|
BaseWndProc(CM_VISIBLECHANGED);
|
|
end;
|
|
|
|
procedure TJvExControl.EnabledChanged;
|
|
begin
|
|
BaseWndProc(CM_ENABLEDCHANGED);
|
|
end;
|
|
|
|
procedure TJvExControl.TextChanged;
|
|
begin
|
|
BaseWndProc(CM_TEXTCHANGED);
|
|
end;
|
|
|
|
procedure TJvExControl.FontChanged;
|
|
begin
|
|
BaseWndProc(CM_FONTCHANGED);
|
|
end;
|
|
|
|
procedure TJvExControl.ColorChanged;
|
|
begin
|
|
BaseWndProc(CM_COLORCHANGED);
|
|
end;
|
|
|
|
procedure TJvExControl.ParentFontChanged;
|
|
begin
|
|
BaseWndProc(CM_PARENTFONTCHANGED);
|
|
end;
|
|
|
|
procedure TJvExControl.ParentColorChanged;
|
|
begin
|
|
BaseWndProc(CM_PARENTCOLORCHANGED);
|
|
if Assigned(OnParentColorChange) then
|
|
OnParentColorChange(Self);
|
|
end;
|
|
|
|
procedure TJvExControl.ParentShowHintChanged;
|
|
begin
|
|
BaseWndProc(CM_PARENTSHOWHINTCHANGED);
|
|
end;
|
|
|
|
function TJvExControl.WantKey(Key: Integer; Shift: TShiftState; const KeyText: WideString): Boolean;
|
|
begin
|
|
Result := BaseWndProc(CM_DIALOGCHAR, Word(Key), ShiftStateToKeyData(Shift)) <> 0;
|
|
end;
|
|
|
|
function TJvExControl.HitTest(X, Y: Integer): Boolean;
|
|
begin
|
|
Result := BaseWndProc(CM_HITTEST, 0, SmallPointToLong(PointToSmallPoint(Point(X, Y)))) <> 0;
|
|
end;
|
|
|
|
function TJvExControl.HintShow(var HintInfo: THintInfo): Boolean;
|
|
begin
|
|
GetHintColor(HintInfo, Self, FHintColor);
|
|
if FHintWindowClass <> nil then
|
|
HintInfo.HintWindowClass := FHintWindowClass;
|
|
Result := BaseWndProcEx(CM_HINTSHOW, 0, HintInfo) <> 0;
|
|
end;
|
|
|
|
procedure TJvExControl.MouseEnter(AControl: TControl);
|
|
begin
|
|
FMouseOver := True;
|
|
if Assigned(FOnMouseEnter) then
|
|
FOnMouseEnter(Self);
|
|
BaseWndProc(CM_MOUSEENTER, 0, AControl);
|
|
end;
|
|
|
|
procedure TJvExControl.MouseLeave(AControl: TControl);
|
|
begin
|
|
FMouseOver := False;
|
|
BaseWndProc(CM_MOUSELEAVE, 0, AControl);
|
|
if Assigned(FOnMouseLeave) then
|
|
FOnMouseLeave(Self);
|
|
end;
|
|
|
|
procedure TJvExControl.FocusChanged(AControl: TWinControl);
|
|
begin
|
|
BaseWndProc(CM_FOCUSCHANGED, 0, AControl);
|
|
end;
|
|
|
|
procedure TJvExControl.WndProc(var Msg: TMessage);
|
|
begin
|
|
if not DispatchIsDesignMsg(Self, Msg) then
|
|
case Msg.Msg of
|
|
CM_DENYSUBCLASSING:
|
|
Msg.Result := Ord(GetInterfaceEntry(IJvDenySubClassing) <> nil);
|
|
CM_DIALOGCHAR:
|
|
with TCMDialogChar{$IFDEF CLR}.Create{$ENDIF}(Msg) do
|
|
Result := Ord(WantKey(CharCode, KeyDataToShiftState(KeyData), WideChar(CharCode)));
|
|
CM_HINTSHOW:
|
|
with TCMHintShow(Msg) do
|
|
Result := Integer(HintShow(HintInfo^));
|
|
CM_HITTEST:
|
|
with TCMHitTest(Msg) do
|
|
Result := Integer(HitTest(XPos, YPos));
|
|
CM_MOUSEENTER:
|
|
MouseEnter(TControl(Msg.LParam));
|
|
CM_MOUSELEAVE:
|
|
MouseLeave(TControl(Msg.LParam));
|
|
CM_VISIBLECHANGED:
|
|
VisibleChanged;
|
|
CM_ENABLEDCHANGED:
|
|
EnabledChanged;
|
|
CM_TEXTCHANGED:
|
|
TextChanged;
|
|
CM_FONTCHANGED:
|
|
FontChanged;
|
|
CM_COLORCHANGED:
|
|
ColorChanged;
|
|
CM_FOCUSCHANGED:
|
|
FocusChanged(TWinControl(Msg.LParam));
|
|
CM_PARENTFONTCHANGED:
|
|
ParentFontChanged;
|
|
CM_PARENTCOLORCHANGED:
|
|
ParentColorChanged;
|
|
CM_PARENTSHOWHINTCHANGED:
|
|
ParentShowHintChanged;
|
|
else
|
|
inherited WndProc(Msg);
|
|
end;
|
|
end;
|
|
|
|
//============================================================================
|
|
|
|
constructor TJvExWinControl.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FHintColor := clDefault;
|
|
end;
|
|
|
|
function TJvExWinControl.BaseWndProc(Msg: Integer; WParam: Integer = 0; LParam: Longint = 0): Integer;
|
|
var
|
|
Mesg: TMessage;
|
|
begin
|
|
Mesg := CreateWMMessage(Msg, WParam, LParam);
|
|
inherited WndProc(Mesg);
|
|
Result := Mesg.Result;
|
|
end;
|
|
|
|
function TJvExWinControl.BaseWndProc(Msg: Integer; WParam: Integer; LParam: TControl): Integer;
|
|
var
|
|
Mesg: TMessage;
|
|
begin
|
|
Mesg := CreateWMMessage(Msg, WParam, LParam);
|
|
inherited WndProc(Mesg);
|
|
Result := Mesg.Result;
|
|
end;
|
|
|
|
function TJvExWinControl.BaseWndProcEx(Msg: Integer; WParam: Integer; var LParam): Integer;
|
|
var
|
|
Mesg: TStructPtrMessage;
|
|
begin
|
|
Mesg := TStructPtrMessage.Create(Msg, WParam, LParam);
|
|
try
|
|
inherited WndProc(Mesg.Msg);
|
|
finally
|
|
Result := Mesg.Msg.Result;
|
|
Mesg.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvExWinControl.VisibleChanged;
|
|
begin
|
|
BaseWndProc(CM_VISIBLECHANGED);
|
|
end;
|
|
|
|
procedure TJvExWinControl.EnabledChanged;
|
|
begin
|
|
BaseWndProc(CM_ENABLEDCHANGED);
|
|
end;
|
|
|
|
procedure TJvExWinControl.TextChanged;
|
|
begin
|
|
BaseWndProc(CM_TEXTCHANGED);
|
|
end;
|
|
|
|
procedure TJvExWinControl.FontChanged;
|
|
begin
|
|
BaseWndProc(CM_FONTCHANGED);
|
|
end;
|
|
|
|
procedure TJvExWinControl.ColorChanged;
|
|
begin
|
|
BaseWndProc(CM_COLORCHANGED);
|
|
end;
|
|
|
|
procedure TJvExWinControl.ParentFontChanged;
|
|
begin
|
|
BaseWndProc(CM_PARENTFONTCHANGED);
|
|
end;
|
|
|
|
procedure TJvExWinControl.ParentColorChanged;
|
|
begin
|
|
BaseWndProc(CM_PARENTCOLORCHANGED);
|
|
if Assigned(OnParentColorChange) then
|
|
OnParentColorChange(Self);
|
|
end;
|
|
|
|
procedure TJvExWinControl.ParentShowHintChanged;
|
|
begin
|
|
BaseWndProc(CM_PARENTSHOWHINTCHANGED);
|
|
end;
|
|
|
|
function TJvExWinControl.WantKey(Key: Integer; Shift: TShiftState; const KeyText: WideString): Boolean;
|
|
begin
|
|
Result := BaseWndProc(CM_DIALOGCHAR, Word(Key), ShiftStateToKeyData(Shift)) <> 0;
|
|
end;
|
|
|
|
function TJvExWinControl.HitTest(X, Y: Integer): Boolean;
|
|
begin
|
|
Result := BaseWndProc(CM_HITTEST, 0, SmallPointToLong(PointToSmallPoint(Point(X, Y)))) <> 0;
|
|
end;
|
|
|
|
function TJvExWinControl.HintShow(var HintInfo: THintInfo): Boolean;
|
|
begin
|
|
GetHintColor(HintInfo, Self, FHintColor);
|
|
if FHintWindowClass <> nil then
|
|
HintInfo.HintWindowClass := FHintWindowClass;
|
|
Result := BaseWndProcEx(CM_HINTSHOW, 0, HintInfo) <> 0;
|
|
end;
|
|
|
|
procedure TJvExWinControl.MouseEnter(AControl: TControl);
|
|
begin
|
|
FMouseOver := True;
|
|
if Assigned(FOnMouseEnter) then
|
|
FOnMouseEnter(Self);
|
|
BaseWndProc(CM_MOUSEENTER, 0, AControl);
|
|
end;
|
|
|
|
procedure TJvExWinControl.MouseLeave(AControl: TControl);
|
|
begin
|
|
FMouseOver := False;
|
|
BaseWndProc(CM_MOUSELEAVE, 0, AControl);
|
|
if Assigned(FOnMouseLeave) then
|
|
FOnMouseLeave(Self);
|
|
end;
|
|
|
|
procedure TJvExWinControl.FocusChanged(AControl: TWinControl);
|
|
begin
|
|
BaseWndProc(CM_FOCUSCHANGED, 0, AControl);
|
|
end;
|
|
|
|
procedure TJvExWinControl.BoundsChanged;
|
|
begin
|
|
end;
|
|
|
|
procedure TJvExWinControl.CursorChanged;
|
|
begin
|
|
BaseWndProc(CM_CURSORCHANGED);
|
|
end;
|
|
|
|
procedure TJvExWinControl.ShowingChanged;
|
|
begin
|
|
BaseWndProc(CM_SHOWINGCHANGED);
|
|
end;
|
|
|
|
procedure TJvExWinControl.ShowHintChanged;
|
|
begin
|
|
BaseWndProc(CM_SHOWHINTCHANGED);
|
|
end;
|
|
|
|
{ VCL sends CM_CONTROLLISTCHANGE and CM_CONTROLCHANGE in a different order than
|
|
the CLX methods are used. So we must correct it by evaluating "Inserting". }
|
|
procedure TJvExWinControl.ControlsListChanging(Control: TControl; Inserting: Boolean);
|
|
begin
|
|
if Inserting then
|
|
BaseWndProc(CM_CONTROLLISTCHANGE, Integer(Control), Integer(Inserting))
|
|
else
|
|
BaseWndProc(CM_CONTROLCHANGE, Integer(Control), Integer(Inserting));
|
|
end;
|
|
|
|
procedure TJvExWinControl.ControlsListChanged(Control: TControl; Inserting: Boolean);
|
|
begin
|
|
if not Inserting then
|
|
BaseWndProc(CM_CONTROLLISTCHANGE, Integer(Control), Integer(Inserting))
|
|
else
|
|
BaseWndProc(CM_CONTROLCHANGE, Integer(Control), Integer(Inserting));
|
|
end;
|
|
|
|
procedure TJvExWinControl.GetDlgCode(var Code: TDlgCodes);
|
|
begin
|
|
end;
|
|
|
|
procedure TJvExWinControl.FocusSet(PrevWnd: THandle);
|
|
begin
|
|
BaseWndProc(WM_SETFOCUS, Integer(PrevWnd), 0);
|
|
end;
|
|
|
|
procedure TJvExWinControl.FocusKilled(NextWnd: THandle);
|
|
begin
|
|
BaseWndProc(WM_KILLFOCUS, Integer(NextWnd), 0);
|
|
end;
|
|
|
|
function TJvExWinControl.DoEraseBackground(Canvas: TCanvas; Param: Integer): Boolean;
|
|
begin
|
|
Result := BaseWndProc(WM_ERASEBKGND, Canvas.Handle, Param) <> 0;
|
|
end;
|
|
|
|
{$IFDEF JVCLThemesEnabledD56}
|
|
function TJvExWinControl.GetParentBackground: Boolean;
|
|
begin
|
|
Result := JvThemes.GetParentBackground(Self);
|
|
end;
|
|
|
|
procedure TJvExWinControl.SetParentBackground(Value: Boolean);
|
|
begin
|
|
JvThemes.SetParentBackground(Self, Value);
|
|
end;
|
|
{$ENDIF JVCLThemesEnabledD56}
|
|
|
|
procedure TJvExWinControl.WndProc(var Msg: TMessage);
|
|
var
|
|
IdSaveDC: Integer;
|
|
DlgCodes: TDlgCodes;
|
|
Canvas: TCanvas;
|
|
begin
|
|
if not DispatchIsDesignMsg(Self, Msg) then
|
|
begin
|
|
case Msg.Msg of
|
|
CM_DENYSUBCLASSING:
|
|
Msg.Result := Ord(GetInterfaceEntry(IJvDenySubClassing) <> nil);
|
|
CM_DIALOGCHAR:
|
|
with TCMDialogChar{$IFDEF CLR}.Create{$ENDIF}(Msg) do
|
|
Result := Ord(WantKey(CharCode, KeyDataToShiftState(KeyData), WideChar(CharCode)));
|
|
CM_HINTSHOW:
|
|
with TCMHintShow(Msg) do
|
|
Result := Integer(HintShow(HintInfo^));
|
|
CM_HITTEST:
|
|
with TCMHitTest(Msg) do
|
|
Result := Integer(HitTest(XPos, YPos));
|
|
CM_MOUSEENTER:
|
|
MouseEnter(TControl(Msg.LParam));
|
|
CM_MOUSELEAVE:
|
|
MouseLeave(TControl(Msg.LParam));
|
|
CM_VISIBLECHANGED:
|
|
VisibleChanged;
|
|
CM_ENABLEDCHANGED:
|
|
EnabledChanged;
|
|
CM_TEXTCHANGED:
|
|
TextChanged;
|
|
CM_FONTCHANGED:
|
|
FontChanged;
|
|
CM_COLORCHANGED:
|
|
ColorChanged;
|
|
CM_FOCUSCHANGED:
|
|
FocusChanged(TWinControl(Msg.LParam));
|
|
CM_PARENTFONTCHANGED:
|
|
ParentFontChanged;
|
|
CM_PARENTCOLORCHANGED:
|
|
ParentColorChanged;
|
|
CM_PARENTSHOWHINTCHANGED:
|
|
ParentShowHintChanged;
|
|
CM_CURSORCHANGED:
|
|
CursorChanged;
|
|
CM_SHOWINGCHANGED:
|
|
ShowingChanged;
|
|
CM_SHOWHINTCHANGED:
|
|
ShowHintChanged;
|
|
CM_CONTROLLISTCHANGE:
|
|
if Msg.LParam <> 0 then
|
|
ControlsListChanging(TControl(Msg.WParam), True)
|
|
else
|
|
ControlsListChanged(TControl(Msg.WParam), False);
|
|
CM_CONTROLCHANGE:
|
|
if Msg.LParam = 0 then
|
|
ControlsListChanging(TControl(Msg.WParam), False)
|
|
else
|
|
ControlsListChanged(TControl(Msg.WParam), True);
|
|
WM_SETFOCUS:
|
|
FocusSet(THandle(Msg.WParam));
|
|
WM_KILLFOCUS:
|
|
FocusKilled(THandle(Msg.WParam));
|
|
WM_SIZE, WM_MOVE:
|
|
begin
|
|
inherited WndProc(Msg);
|
|
BoundsChanged;
|
|
end;
|
|
WM_ERASEBKGND:
|
|
if Msg.WParam <> 0 then
|
|
begin
|
|
IdSaveDC := SaveDC(HDC(Msg.WParam)); // protect DC against Stock-Objects from Canvas
|
|
Canvas := TCanvas.Create;
|
|
try
|
|
Canvas.Handle := HDC(Msg.WParam);
|
|
Msg.Result := Ord(DoEraseBackground(Canvas, Msg.LParam));
|
|
finally
|
|
Canvas.Handle := 0;
|
|
Canvas.Free;
|
|
RestoreDC(HDC(Msg.WParam), IdSaveDC);
|
|
end;
|
|
end
|
|
else
|
|
inherited WndProc(Msg);
|
|
{$IFNDEF DELPHI2007_UP}
|
|
WM_PRINTCLIENT, WM_PRINT: // VCL bug fix
|
|
begin
|
|
IdSaveDC := SaveDC(HDC(Msg.WParam)); // protect DC against changes
|
|
try
|
|
inherited WndProc(Msg);
|
|
finally
|
|
RestoreDC(HDC(Msg.WParam), IdSaveDC);
|
|
end;
|
|
end;
|
|
{$ENDIF ~DELPHI2007_UP}
|
|
WM_GETDLGCODE:
|
|
begin
|
|
inherited WndProc(Msg);
|
|
DlgCodes := [dcNative] + DlgcToDlgCodes(Msg.Result);
|
|
GetDlgCode(DlgCodes);
|
|
if not (dcNative in DlgCodes) then
|
|
Msg.Result := DlgCodesToDlgc(DlgCodes);
|
|
end;
|
|
else
|
|
inherited WndProc(Msg);
|
|
end;
|
|
case Msg.Msg of // precheck message to prevent access violations on released controls
|
|
CM_MOUSEENTER, CM_MOUSELEAVE, WM_KILLFOCUS, WM_SETFOCUS, WM_NCPAINT:
|
|
if DotNetHighlighting then
|
|
HandleDotNetHighlighting(Self, Msg, MouseOver, Color);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
//============================================================================
|
|
|
|
constructor TJvExGraphicControl.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FHintColor := clDefault;
|
|
end;
|
|
|
|
function TJvExGraphicControl.BaseWndProc(Msg: Integer; WParam: Integer = 0; LParam: Longint = 0): Integer;
|
|
var
|
|
Mesg: TMessage;
|
|
begin
|
|
Mesg := CreateWMMessage(Msg, WParam, LParam);
|
|
inherited WndProc(Mesg);
|
|
Result := Mesg.Result;
|
|
end;
|
|
|
|
function TJvExGraphicControl.BaseWndProc(Msg: Integer; WParam: Integer; LParam: TControl): Integer;
|
|
var
|
|
Mesg: TMessage;
|
|
begin
|
|
Mesg := CreateWMMessage(Msg, WParam, LParam);
|
|
inherited WndProc(Mesg);
|
|
Result := Mesg.Result;
|
|
end;
|
|
|
|
function TJvExGraphicControl.BaseWndProcEx(Msg: Integer; WParam: Integer; var LParam): Integer;
|
|
var
|
|
Mesg: TStructPtrMessage;
|
|
begin
|
|
Mesg := TStructPtrMessage.Create(Msg, WParam, LParam);
|
|
try
|
|
inherited WndProc(Mesg.Msg);
|
|
finally
|
|
Result := Mesg.Msg.Result;
|
|
Mesg.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvExGraphicControl.VisibleChanged;
|
|
begin
|
|
BaseWndProc(CM_VISIBLECHANGED);
|
|
end;
|
|
|
|
procedure TJvExGraphicControl.EnabledChanged;
|
|
begin
|
|
BaseWndProc(CM_ENABLEDCHANGED);
|
|
end;
|
|
|
|
procedure TJvExGraphicControl.TextChanged;
|
|
begin
|
|
BaseWndProc(CM_TEXTCHANGED);
|
|
end;
|
|
|
|
procedure TJvExGraphicControl.FontChanged;
|
|
begin
|
|
BaseWndProc(CM_FONTCHANGED);
|
|
end;
|
|
|
|
procedure TJvExGraphicControl.ColorChanged;
|
|
begin
|
|
BaseWndProc(CM_COLORCHANGED);
|
|
end;
|
|
|
|
procedure TJvExGraphicControl.ParentFontChanged;
|
|
begin
|
|
BaseWndProc(CM_PARENTFONTCHANGED);
|
|
end;
|
|
|
|
procedure TJvExGraphicControl.ParentColorChanged;
|
|
begin
|
|
BaseWndProc(CM_PARENTCOLORCHANGED);
|
|
if Assigned(OnParentColorChange) then
|
|
OnParentColorChange(Self);
|
|
end;
|
|
|
|
procedure TJvExGraphicControl.ParentShowHintChanged;
|
|
begin
|
|
BaseWndProc(CM_PARENTSHOWHINTCHANGED);
|
|
end;
|
|
|
|
function TJvExGraphicControl.WantKey(Key: Integer; Shift: TShiftState; const KeyText: WideString): Boolean;
|
|
begin
|
|
Result := BaseWndProc(CM_DIALOGCHAR, Word(Key), ShiftStateToKeyData(Shift)) <> 0;
|
|
end;
|
|
|
|
function TJvExGraphicControl.HitTest(X, Y: Integer): Boolean;
|
|
begin
|
|
Result := BaseWndProc(CM_HITTEST, 0, SmallPointToLong(PointToSmallPoint(Point(X, Y)))) <> 0;
|
|
end;
|
|
|
|
function TJvExGraphicControl.HintShow(var HintInfo: THintInfo): Boolean;
|
|
begin
|
|
GetHintColor(HintInfo, Self, FHintColor);
|
|
if FHintWindowClass <> nil then
|
|
HintInfo.HintWindowClass := FHintWindowClass;
|
|
Result := BaseWndProcEx(CM_HINTSHOW, 0, HintInfo) <> 0;
|
|
end;
|
|
|
|
procedure TJvExGraphicControl.MouseEnter(AControl: TControl);
|
|
begin
|
|
FMouseOver := True;
|
|
if Assigned(FOnMouseEnter) then
|
|
FOnMouseEnter(Self);
|
|
BaseWndProc(CM_MOUSEENTER, 0, AControl);
|
|
end;
|
|
|
|
procedure TJvExGraphicControl.MouseLeave(AControl: TControl);
|
|
begin
|
|
FMouseOver := False;
|
|
BaseWndProc(CM_MOUSELEAVE, 0, AControl);
|
|
if Assigned(FOnMouseLeave) then
|
|
FOnMouseLeave(Self);
|
|
end;
|
|
|
|
procedure TJvExGraphicControl.FocusChanged(AControl: TWinControl);
|
|
begin
|
|
BaseWndProc(CM_FOCUSCHANGED, 0, AControl);
|
|
end;
|
|
|
|
procedure TJvExGraphicControl.WndProc(var Msg: TMessage);
|
|
begin
|
|
if not DispatchIsDesignMsg(Self, Msg) then
|
|
case Msg.Msg of
|
|
CM_DENYSUBCLASSING:
|
|
Msg.Result := Ord(GetInterfaceEntry(IJvDenySubClassing) <> nil);
|
|
CM_DIALOGCHAR:
|
|
with TCMDialogChar{$IFDEF CLR}.Create{$ENDIF}(Msg) do
|
|
Result := Ord(WantKey(CharCode, KeyDataToShiftState(KeyData), WideChar(CharCode)));
|
|
CM_HINTSHOW:
|
|
with TCMHintShow(Msg) do
|
|
Result := Integer(HintShow(HintInfo^));
|
|
CM_HITTEST:
|
|
with TCMHitTest(Msg) do
|
|
Result := Integer(HitTest(XPos, YPos));
|
|
CM_MOUSEENTER:
|
|
MouseEnter(TControl(Msg.LParam));
|
|
CM_MOUSELEAVE:
|
|
MouseLeave(TControl(Msg.LParam));
|
|
CM_VISIBLECHANGED:
|
|
VisibleChanged;
|
|
CM_ENABLEDCHANGED:
|
|
EnabledChanged;
|
|
CM_TEXTCHANGED:
|
|
TextChanged;
|
|
CM_FONTCHANGED:
|
|
FontChanged;
|
|
CM_COLORCHANGED:
|
|
ColorChanged;
|
|
CM_FOCUSCHANGED:
|
|
FocusChanged(TWinControl(Msg.LParam));
|
|
CM_PARENTFONTCHANGED:
|
|
ParentFontChanged;
|
|
CM_PARENTCOLORCHANGED:
|
|
ParentColorChanged;
|
|
CM_PARENTSHOWHINTCHANGED:
|
|
ParentShowHintChanged;
|
|
else
|
|
inherited WndProc(Msg);
|
|
end;
|
|
end;
|
|
|
|
//============================================================================
|
|
|
|
constructor TJvExCustomControl.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FHintColor := clDefault;
|
|
end;
|
|
|
|
function TJvExCustomControl.BaseWndProc(Msg: Integer; WParam: Integer = 0; LParam: Longint = 0): Integer;
|
|
var
|
|
Mesg: TMessage;
|
|
begin
|
|
Mesg := CreateWMMessage(Msg, WParam, LParam);
|
|
inherited WndProc(Mesg);
|
|
Result := Mesg.Result;
|
|
end;
|
|
|
|
function TJvExCustomControl.BaseWndProc(Msg: Integer; WParam: Integer; LParam: TControl): Integer;
|
|
var
|
|
Mesg: TMessage;
|
|
begin
|
|
Mesg := CreateWMMessage(Msg, WParam, LParam);
|
|
inherited WndProc(Mesg);
|
|
Result := Mesg.Result;
|
|
end;
|
|
|
|
function TJvExCustomControl.BaseWndProcEx(Msg: Integer; WParam: Integer; var LParam): Integer;
|
|
var
|
|
Mesg: TStructPtrMessage;
|
|
begin
|
|
Mesg := TStructPtrMessage.Create(Msg, WParam, LParam);
|
|
try
|
|
inherited WndProc(Mesg.Msg);
|
|
finally
|
|
Result := Mesg.Msg.Result;
|
|
Mesg.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvExCustomControl.VisibleChanged;
|
|
begin
|
|
BaseWndProc(CM_VISIBLECHANGED);
|
|
end;
|
|
|
|
procedure TJvExCustomControl.EnabledChanged;
|
|
begin
|
|
BaseWndProc(CM_ENABLEDCHANGED);
|
|
end;
|
|
|
|
procedure TJvExCustomControl.TextChanged;
|
|
begin
|
|
BaseWndProc(CM_TEXTCHANGED);
|
|
end;
|
|
|
|
procedure TJvExCustomControl.FontChanged;
|
|
begin
|
|
BaseWndProc(CM_FONTCHANGED);
|
|
end;
|
|
|
|
procedure TJvExCustomControl.ColorChanged;
|
|
begin
|
|
BaseWndProc(CM_COLORCHANGED);
|
|
end;
|
|
|
|
procedure TJvExCustomControl.ParentFontChanged;
|
|
begin
|
|
BaseWndProc(CM_PARENTFONTCHANGED);
|
|
end;
|
|
|
|
procedure TJvExCustomControl.ParentColorChanged;
|
|
begin
|
|
BaseWndProc(CM_PARENTCOLORCHANGED);
|
|
if Assigned(OnParentColorChange) then
|
|
OnParentColorChange(Self);
|
|
end;
|
|
|
|
procedure TJvExCustomControl.ParentShowHintChanged;
|
|
begin
|
|
BaseWndProc(CM_PARENTSHOWHINTCHANGED);
|
|
end;
|
|
|
|
function TJvExCustomControl.WantKey(Key: Integer; Shift: TShiftState; const KeyText: WideString): Boolean;
|
|
begin
|
|
Result := BaseWndProc(CM_DIALOGCHAR, Word(Key), ShiftStateToKeyData(Shift)) <> 0;
|
|
end;
|
|
|
|
function TJvExCustomControl.HitTest(X, Y: Integer): Boolean;
|
|
begin
|
|
Result := BaseWndProc(CM_HITTEST, 0, SmallPointToLong(PointToSmallPoint(Point(X, Y)))) <> 0;
|
|
end;
|
|
|
|
function TJvExCustomControl.HintShow(var HintInfo: THintInfo): Boolean;
|
|
begin
|
|
GetHintColor(HintInfo, Self, FHintColor);
|
|
if FHintWindowClass <> nil then
|
|
HintInfo.HintWindowClass := FHintWindowClass;
|
|
Result := BaseWndProcEx(CM_HINTSHOW, 0, HintInfo) <> 0;
|
|
end;
|
|
|
|
procedure TJvExCustomControl.MouseEnter(AControl: TControl);
|
|
begin
|
|
FMouseOver := True;
|
|
if Assigned(FOnMouseEnter) then
|
|
FOnMouseEnter(Self);
|
|
BaseWndProc(CM_MOUSEENTER, 0, AControl);
|
|
end;
|
|
|
|
procedure TJvExCustomControl.MouseLeave(AControl: TControl);
|
|
begin
|
|
FMouseOver := False;
|
|
BaseWndProc(CM_MOUSELEAVE, 0, AControl);
|
|
if Assigned(FOnMouseLeave) then
|
|
FOnMouseLeave(Self);
|
|
end;
|
|
|
|
procedure TJvExCustomControl.FocusChanged(AControl: TWinControl);
|
|
begin
|
|
BaseWndProc(CM_FOCUSCHANGED, 0, AControl);
|
|
end;
|
|
|
|
procedure TJvExCustomControl.BoundsChanged;
|
|
begin
|
|
end;
|
|
|
|
procedure TJvExCustomControl.CursorChanged;
|
|
begin
|
|
BaseWndProc(CM_CURSORCHANGED);
|
|
end;
|
|
|
|
procedure TJvExCustomControl.ShowingChanged;
|
|
begin
|
|
BaseWndProc(CM_SHOWINGCHANGED);
|
|
end;
|
|
|
|
procedure TJvExCustomControl.ShowHintChanged;
|
|
begin
|
|
BaseWndProc(CM_SHOWHINTCHANGED);
|
|
end;
|
|
|
|
{ VCL sends CM_CONTROLLISTCHANGE and CM_CONTROLCHANGE in a different order than
|
|
the CLX methods are used. So we must correct it by evaluating "Inserting". }
|
|
procedure TJvExCustomControl.ControlsListChanging(Control: TControl; Inserting: Boolean);
|
|
begin
|
|
if Inserting then
|
|
BaseWndProc(CM_CONTROLLISTCHANGE, Integer(Control), Integer(Inserting))
|
|
else
|
|
BaseWndProc(CM_CONTROLCHANGE, Integer(Control), Integer(Inserting));
|
|
end;
|
|
|
|
procedure TJvExCustomControl.ControlsListChanged(Control: TControl; Inserting: Boolean);
|
|
begin
|
|
if not Inserting then
|
|
BaseWndProc(CM_CONTROLLISTCHANGE, Integer(Control), Integer(Inserting))
|
|
else
|
|
BaseWndProc(CM_CONTROLCHANGE, Integer(Control), Integer(Inserting));
|
|
end;
|
|
|
|
procedure TJvExCustomControl.GetDlgCode(var Code: TDlgCodes);
|
|
begin
|
|
end;
|
|
|
|
procedure TJvExCustomControl.FocusSet(PrevWnd: THandle);
|
|
begin
|
|
BaseWndProc(WM_SETFOCUS, Integer(PrevWnd), 0);
|
|
end;
|
|
|
|
procedure TJvExCustomControl.FocusKilled(NextWnd: THandle);
|
|
begin
|
|
BaseWndProc(WM_KILLFOCUS, Integer(NextWnd), 0);
|
|
end;
|
|
|
|
function TJvExCustomControl.DoEraseBackground(Canvas: TCanvas; Param: Integer): Boolean;
|
|
begin
|
|
Result := BaseWndProc(WM_ERASEBKGND, Canvas.Handle, Param) <> 0;
|
|
end;
|
|
|
|
{$IFDEF JVCLThemesEnabledD56}
|
|
function TJvExCustomControl.GetParentBackground: Boolean;
|
|
begin
|
|
Result := JvThemes.GetParentBackground(Self);
|
|
end;
|
|
|
|
procedure TJvExCustomControl.SetParentBackground(Value: Boolean);
|
|
begin
|
|
JvThemes.SetParentBackground(Self, Value);
|
|
end;
|
|
{$ENDIF JVCLThemesEnabledD56}
|
|
|
|
procedure TJvExCustomControl.WndProc(var Msg: TMessage);
|
|
var
|
|
IdSaveDC: Integer;
|
|
DlgCodes: TDlgCodes;
|
|
Canvas: TCanvas;
|
|
begin
|
|
if not DispatchIsDesignMsg(Self, Msg) then
|
|
begin
|
|
case Msg.Msg of
|
|
CM_DENYSUBCLASSING:
|
|
Msg.Result := Ord(GetInterfaceEntry(IJvDenySubClassing) <> nil);
|
|
CM_DIALOGCHAR:
|
|
with TCMDialogChar{$IFDEF CLR}.Create{$ENDIF}(Msg) do
|
|
Result := Ord(WantKey(CharCode, KeyDataToShiftState(KeyData), WideChar(CharCode)));
|
|
CM_HINTSHOW:
|
|
with TCMHintShow(Msg) do
|
|
Result := Integer(HintShow(HintInfo^));
|
|
CM_HITTEST:
|
|
with TCMHitTest(Msg) do
|
|
Result := Integer(HitTest(XPos, YPos));
|
|
CM_MOUSEENTER:
|
|
MouseEnter(TControl(Msg.LParam));
|
|
CM_MOUSELEAVE:
|
|
MouseLeave(TControl(Msg.LParam));
|
|
CM_VISIBLECHANGED:
|
|
VisibleChanged;
|
|
CM_ENABLEDCHANGED:
|
|
EnabledChanged;
|
|
CM_TEXTCHANGED:
|
|
TextChanged;
|
|
CM_FONTCHANGED:
|
|
FontChanged;
|
|
CM_COLORCHANGED:
|
|
ColorChanged;
|
|
CM_FOCUSCHANGED:
|
|
FocusChanged(TWinControl(Msg.LParam));
|
|
CM_PARENTFONTCHANGED:
|
|
ParentFontChanged;
|
|
CM_PARENTCOLORCHANGED:
|
|
ParentColorChanged;
|
|
CM_PARENTSHOWHINTCHANGED:
|
|
ParentShowHintChanged;
|
|
CM_CURSORCHANGED:
|
|
CursorChanged;
|
|
CM_SHOWINGCHANGED:
|
|
ShowingChanged;
|
|
CM_SHOWHINTCHANGED:
|
|
ShowHintChanged;
|
|
CM_CONTROLLISTCHANGE:
|
|
if Msg.LParam <> 0 then
|
|
ControlsListChanging(TControl(Msg.WParam), True)
|
|
else
|
|
ControlsListChanged(TControl(Msg.WParam), False);
|
|
CM_CONTROLCHANGE:
|
|
if Msg.LParam = 0 then
|
|
ControlsListChanging(TControl(Msg.WParam), False)
|
|
else
|
|
ControlsListChanged(TControl(Msg.WParam), True);
|
|
WM_SETFOCUS:
|
|
FocusSet(THandle(Msg.WParam));
|
|
WM_KILLFOCUS:
|
|
FocusKilled(THandle(Msg.WParam));
|
|
WM_SIZE, WM_MOVE:
|
|
begin
|
|
inherited WndProc(Msg);
|
|
BoundsChanged;
|
|
end;
|
|
WM_ERASEBKGND:
|
|
if Msg.WParam <> 0 then
|
|
begin
|
|
IdSaveDC := SaveDC(HDC(Msg.WParam)); // protect DC against Stock-Objects from Canvas
|
|
Canvas := TCanvas.Create;
|
|
try
|
|
Canvas.Handle := HDC(Msg.WParam);
|
|
Msg.Result := Ord(DoEraseBackground(Canvas, Msg.LParam));
|
|
finally
|
|
Canvas.Handle := 0;
|
|
Canvas.Free;
|
|
RestoreDC(HDC(Msg.WParam), IdSaveDC);
|
|
end;
|
|
end
|
|
else
|
|
inherited WndProc(Msg);
|
|
{$IFNDEF DELPHI2007_UP}
|
|
WM_PRINTCLIENT, WM_PRINT: // VCL bug fix
|
|
begin
|
|
IdSaveDC := SaveDC(HDC(Msg.WParam)); // protect DC against changes
|
|
try
|
|
inherited WndProc(Msg);
|
|
finally
|
|
RestoreDC(HDC(Msg.WParam), IdSaveDC);
|
|
end;
|
|
end;
|
|
{$ENDIF ~DELPHI2007_UP}
|
|
WM_GETDLGCODE:
|
|
begin
|
|
inherited WndProc(Msg);
|
|
DlgCodes := [dcNative] + DlgcToDlgCodes(Msg.Result);
|
|
GetDlgCode(DlgCodes);
|
|
if not (dcNative in DlgCodes) then
|
|
Msg.Result := DlgCodesToDlgc(DlgCodes);
|
|
end;
|
|
else
|
|
inherited WndProc(Msg);
|
|
end;
|
|
case Msg.Msg of // precheck message to prevent access violations on released controls
|
|
CM_MOUSEENTER, CM_MOUSELEAVE, WM_KILLFOCUS, WM_SETFOCUS, WM_NCPAINT:
|
|
if DotNetHighlighting then
|
|
HandleDotNetHighlighting(Self, Msg, MouseOver, Color);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
//============================================================================
|
|
|
|
constructor TJvExHintWindow.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FHintColor := clDefault;
|
|
end;
|
|
|
|
function TJvExHintWindow.BaseWndProc(Msg: Integer; WParam: Integer = 0; LParam: Longint = 0): Integer;
|
|
var
|
|
Mesg: TMessage;
|
|
begin
|
|
Mesg := CreateWMMessage(Msg, WParam, LParam);
|
|
inherited WndProc(Mesg);
|
|
Result := Mesg.Result;
|
|
end;
|
|
|
|
function TJvExHintWindow.BaseWndProc(Msg: Integer; WParam: Integer; LParam: TControl): Integer;
|
|
var
|
|
Mesg: TMessage;
|
|
begin
|
|
Mesg := CreateWMMessage(Msg, WParam, LParam);
|
|
inherited WndProc(Mesg);
|
|
Result := Mesg.Result;
|
|
end;
|
|
|
|
function TJvExHintWindow.BaseWndProcEx(Msg: Integer; WParam: Integer; var LParam): Integer;
|
|
var
|
|
Mesg: TStructPtrMessage;
|
|
begin
|
|
Mesg := TStructPtrMessage.Create(Msg, WParam, LParam);
|
|
try
|
|
inherited WndProc(Mesg.Msg);
|
|
finally
|
|
Result := Mesg.Msg.Result;
|
|
Mesg.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvExHintWindow.VisibleChanged;
|
|
begin
|
|
BaseWndProc(CM_VISIBLECHANGED);
|
|
end;
|
|
|
|
procedure TJvExHintWindow.EnabledChanged;
|
|
begin
|
|
BaseWndProc(CM_ENABLEDCHANGED);
|
|
end;
|
|
|
|
procedure TJvExHintWindow.TextChanged;
|
|
begin
|
|
BaseWndProc(CM_TEXTCHANGED);
|
|
end;
|
|
|
|
procedure TJvExHintWindow.FontChanged;
|
|
begin
|
|
BaseWndProc(CM_FONTCHANGED);
|
|
end;
|
|
|
|
procedure TJvExHintWindow.ColorChanged;
|
|
begin
|
|
BaseWndProc(CM_COLORCHANGED);
|
|
end;
|
|
|
|
procedure TJvExHintWindow.ParentFontChanged;
|
|
begin
|
|
BaseWndProc(CM_PARENTFONTCHANGED);
|
|
end;
|
|
|
|
procedure TJvExHintWindow.ParentColorChanged;
|
|
begin
|
|
BaseWndProc(CM_PARENTCOLORCHANGED);
|
|
if Assigned(OnParentColorChange) then
|
|
OnParentColorChange(Self);
|
|
end;
|
|
|
|
procedure TJvExHintWindow.ParentShowHintChanged;
|
|
begin
|
|
BaseWndProc(CM_PARENTSHOWHINTCHANGED);
|
|
end;
|
|
|
|
function TJvExHintWindow.WantKey(Key: Integer; Shift: TShiftState; const KeyText: WideString): Boolean;
|
|
begin
|
|
Result := BaseWndProc(CM_DIALOGCHAR, Word(Key), ShiftStateToKeyData(Shift)) <> 0;
|
|
end;
|
|
|
|
function TJvExHintWindow.HitTest(X, Y: Integer): Boolean;
|
|
begin
|
|
Result := BaseWndProc(CM_HITTEST, 0, SmallPointToLong(PointToSmallPoint(Point(X, Y)))) <> 0;
|
|
end;
|
|
|
|
function TJvExHintWindow.HintShow(var HintInfo: THintInfo): Boolean;
|
|
begin
|
|
GetHintColor(HintInfo, Self, FHintColor);
|
|
if FHintWindowClass <> nil then
|
|
HintInfo.HintWindowClass := FHintWindowClass;
|
|
Result := BaseWndProcEx(CM_HINTSHOW, 0, HintInfo) <> 0;
|
|
end;
|
|
|
|
procedure TJvExHintWindow.MouseEnter(AControl: TControl);
|
|
begin
|
|
FMouseOver := True;
|
|
if Assigned(FOnMouseEnter) then
|
|
FOnMouseEnter(Self);
|
|
BaseWndProc(CM_MOUSEENTER, 0, AControl);
|
|
end;
|
|
|
|
procedure TJvExHintWindow.MouseLeave(AControl: TControl);
|
|
begin
|
|
FMouseOver := False;
|
|
BaseWndProc(CM_MOUSELEAVE, 0, AControl);
|
|
if Assigned(FOnMouseLeave) then
|
|
FOnMouseLeave(Self);
|
|
end;
|
|
|
|
procedure TJvExHintWindow.FocusChanged(AControl: TWinControl);
|
|
begin
|
|
BaseWndProc(CM_FOCUSCHANGED, 0, AControl);
|
|
end;
|
|
|
|
procedure TJvExHintWindow.BoundsChanged;
|
|
begin
|
|
end;
|
|
|
|
procedure TJvExHintWindow.CursorChanged;
|
|
begin
|
|
BaseWndProc(CM_CURSORCHANGED);
|
|
end;
|
|
|
|
procedure TJvExHintWindow.ShowingChanged;
|
|
begin
|
|
BaseWndProc(CM_SHOWINGCHANGED);
|
|
end;
|
|
|
|
procedure TJvExHintWindow.ShowHintChanged;
|
|
begin
|
|
BaseWndProc(CM_SHOWHINTCHANGED);
|
|
end;
|
|
|
|
{ VCL sends CM_CONTROLLISTCHANGE and CM_CONTROLCHANGE in a different order than
|
|
the CLX methods are used. So we must correct it by evaluating "Inserting". }
|
|
procedure TJvExHintWindow.ControlsListChanging(Control: TControl; Inserting: Boolean);
|
|
begin
|
|
if Inserting then
|
|
BaseWndProc(CM_CONTROLLISTCHANGE, Integer(Control), Integer(Inserting))
|
|
else
|
|
BaseWndProc(CM_CONTROLCHANGE, Integer(Control), Integer(Inserting));
|
|
end;
|
|
|
|
procedure TJvExHintWindow.ControlsListChanged(Control: TControl; Inserting: Boolean);
|
|
begin
|
|
if not Inserting then
|
|
BaseWndProc(CM_CONTROLLISTCHANGE, Integer(Control), Integer(Inserting))
|
|
else
|
|
BaseWndProc(CM_CONTROLCHANGE, Integer(Control), Integer(Inserting));
|
|
end;
|
|
|
|
procedure TJvExHintWindow.GetDlgCode(var Code: TDlgCodes);
|
|
begin
|
|
end;
|
|
|
|
procedure TJvExHintWindow.FocusSet(PrevWnd: THandle);
|
|
begin
|
|
BaseWndProc(WM_SETFOCUS, Integer(PrevWnd), 0);
|
|
end;
|
|
|
|
procedure TJvExHintWindow.FocusKilled(NextWnd: THandle);
|
|
begin
|
|
BaseWndProc(WM_KILLFOCUS, Integer(NextWnd), 0);
|
|
end;
|
|
|
|
function TJvExHintWindow.DoEraseBackground(Canvas: TCanvas; Param: Integer): Boolean;
|
|
begin
|
|
Result := BaseWndProc(WM_ERASEBKGND, Canvas.Handle, Param) <> 0;
|
|
end;
|
|
|
|
{$IFDEF JVCLThemesEnabledD56}
|
|
function TJvExHintWindow.GetParentBackground: Boolean;
|
|
begin
|
|
Result := JvThemes.GetParentBackground(Self);
|
|
end;
|
|
|
|
procedure TJvExHintWindow.SetParentBackground(Value: Boolean);
|
|
begin
|
|
JvThemes.SetParentBackground(Self, Value);
|
|
end;
|
|
{$ENDIF JVCLThemesEnabledD56}
|
|
|
|
procedure TJvExHintWindow.WndProc(var Msg: TMessage);
|
|
var
|
|
IdSaveDC: Integer;
|
|
DlgCodes: TDlgCodes;
|
|
Canvas: TCanvas;
|
|
begin
|
|
if not DispatchIsDesignMsg(Self, Msg) then
|
|
begin
|
|
case Msg.Msg of
|
|
CM_DENYSUBCLASSING:
|
|
Msg.Result := Ord(GetInterfaceEntry(IJvDenySubClassing) <> nil);
|
|
CM_DIALOGCHAR:
|
|
with TCMDialogChar{$IFDEF CLR}.Create{$ENDIF}(Msg) do
|
|
Result := Ord(WantKey(CharCode, KeyDataToShiftState(KeyData), WideChar(CharCode)));
|
|
CM_HINTSHOW:
|
|
with TCMHintShow(Msg) do
|
|
Result := Integer(HintShow(HintInfo^));
|
|
CM_HITTEST:
|
|
with TCMHitTest(Msg) do
|
|
Result := Integer(HitTest(XPos, YPos));
|
|
CM_MOUSEENTER:
|
|
MouseEnter(TControl(Msg.LParam));
|
|
CM_MOUSELEAVE:
|
|
MouseLeave(TControl(Msg.LParam));
|
|
CM_VISIBLECHANGED:
|
|
VisibleChanged;
|
|
CM_ENABLEDCHANGED:
|
|
EnabledChanged;
|
|
CM_TEXTCHANGED:
|
|
TextChanged;
|
|
CM_FONTCHANGED:
|
|
FontChanged;
|
|
CM_COLORCHANGED:
|
|
ColorChanged;
|
|
CM_FOCUSCHANGED:
|
|
FocusChanged(TWinControl(Msg.LParam));
|
|
CM_PARENTFONTCHANGED:
|
|
ParentFontChanged;
|
|
CM_PARENTCOLORCHANGED:
|
|
ParentColorChanged;
|
|
CM_PARENTSHOWHINTCHANGED:
|
|
ParentShowHintChanged;
|
|
CM_CURSORCHANGED:
|
|
CursorChanged;
|
|
CM_SHOWINGCHANGED:
|
|
ShowingChanged;
|
|
CM_SHOWHINTCHANGED:
|
|
ShowHintChanged;
|
|
CM_CONTROLLISTCHANGE:
|
|
if Msg.LParam <> 0 then
|
|
ControlsListChanging(TControl(Msg.WParam), True)
|
|
else
|
|
ControlsListChanged(TControl(Msg.WParam), False);
|
|
CM_CONTROLCHANGE:
|
|
if Msg.LParam = 0 then
|
|
ControlsListChanging(TControl(Msg.WParam), False)
|
|
else
|
|
ControlsListChanged(TControl(Msg.WParam), True);
|
|
WM_SETFOCUS:
|
|
FocusSet(THandle(Msg.WParam));
|
|
WM_KILLFOCUS:
|
|
FocusKilled(THandle(Msg.WParam));
|
|
WM_SIZE, WM_MOVE:
|
|
begin
|
|
inherited WndProc(Msg);
|
|
BoundsChanged;
|
|
end;
|
|
WM_ERASEBKGND:
|
|
if Msg.WParam <> 0 then
|
|
begin
|
|
IdSaveDC := SaveDC(HDC(Msg.WParam)); // protect DC against Stock-Objects from Canvas
|
|
Canvas := TCanvas.Create;
|
|
try
|
|
Canvas.Handle := HDC(Msg.WParam);
|
|
Msg.Result := Ord(DoEraseBackground(Canvas, Msg.LParam));
|
|
finally
|
|
Canvas.Handle := 0;
|
|
Canvas.Free;
|
|
RestoreDC(HDC(Msg.WParam), IdSaveDC);
|
|
end;
|
|
end
|
|
else
|
|
inherited WndProc(Msg);
|
|
{$IFNDEF DELPHI2007_UP}
|
|
WM_PRINTCLIENT, WM_PRINT: // VCL bug fix
|
|
begin
|
|
IdSaveDC := SaveDC(HDC(Msg.WParam)); // protect DC against changes
|
|
try
|
|
inherited WndProc(Msg);
|
|
finally
|
|
RestoreDC(HDC(Msg.WParam), IdSaveDC);
|
|
end;
|
|
end;
|
|
{$ENDIF ~DELPHI2007_UP}
|
|
WM_GETDLGCODE:
|
|
begin
|
|
inherited WndProc(Msg);
|
|
DlgCodes := [dcNative] + DlgcToDlgCodes(Msg.Result);
|
|
GetDlgCode(DlgCodes);
|
|
if not (dcNative in DlgCodes) then
|
|
Msg.Result := DlgCodesToDlgc(DlgCodes);
|
|
end;
|
|
else
|
|
inherited WndProc(Msg);
|
|
end;
|
|
case Msg.Msg of // precheck message to prevent access violations on released controls
|
|
CM_MOUSEENTER, CM_MOUSELEAVE, WM_KILLFOCUS, WM_SETFOCUS, WM_NCPAINT:
|
|
if DotNetHighlighting then
|
|
HandleDotNetHighlighting(Self, Msg, MouseOver, Color);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
//============================================================================
|
|
|
|
initialization
|
|
{$IFDEF UNITVERSIONING}
|
|
RegisterUnitVersion(HInstance, UnitVersioning);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
finalization
|
|
{$IFDEF UNITVERSIONING}
|
|
UnregisterUnitVersion(HInstance);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
end.
|
|
|