2336 lines
69 KiB
ObjectPascal
2336 lines
69 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.sourceforge.net
|
|
|
|
Known Issues:
|
|
-----------------------------------------------------------------------------}
|
|
// $Id: JvExControls.pas,v 1.91 2006/01/24 17:31:03 ahuser Exp $
|
|
|
|
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,
|
|
{$IFDEF HAS_UNIT_TYPES}
|
|
Types,
|
|
{$ENDIF HAS_UNIT_TYPES}
|
|
{$IFDEF CLR}
|
|
System.Runtime.InteropServices,
|
|
{$ENDIF CLR}
|
|
SysUtils, Classes, Graphics, Controls, Forms,
|
|
{$IFDEF COMPILER5}
|
|
JvVCL5Utils,
|
|
{$ENDIF COMPILER5}
|
|
{$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;
|
|
|
|
const
|
|
CM_DENYSUBCLASSING = JvThemes.CM_DENYSUBCLASSING;
|
|
{$IFDEF VisualCLX}
|
|
CM_PERFORM = CM_BASE + $500 + 0; // LParam: "Msg: ^TMessage"
|
|
{$ENDIF VisualCLX}
|
|
CM_SETAUTOSIZE = CM_BASE + $500 + 1; // WParam: "Value: Boolean"
|
|
|
|
type
|
|
TJvHotTrackOptions = class;
|
|
|
|
{ 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;
|
|
|
|
|
|
{ IJvHotTrack is Specifies whether Control are highlighted when the mouse passes over them}
|
|
IJvHotTrack = interface
|
|
['{8F1B40FB-D8E3-46FE-A7A3-21CE4B199A8F}']
|
|
|
|
function GetHotTrack:Boolean;
|
|
function GetHotTrackFont:TFont;
|
|
function GetHotTrackFontOptions:TJvTrackFontOptions;
|
|
function GetHotTrackOptions:TJvHotTrackOptions;
|
|
|
|
procedure SetHotTrack(Value: Boolean);
|
|
procedure SetHotTrackFont(Value: TFont);
|
|
procedure SetHotTrackFontOptions(Value: TJvTrackFontOptions);
|
|
procedure SetHotTrackOptions(Value: TJvHotTrackOptions);
|
|
|
|
property HotTrack: Boolean read GetHotTrack write SetHotTrack;
|
|
property HotTrackFont: TFont read GetHotTrackFont write SetHotTrackFont;
|
|
property HotTrackFontOptions: TJvTrackFontOptions read GetHotTrackFontOptions write SetHotTrackFontOptions;
|
|
property HotTrackOptions: TJvHotTrackOptions read GetHotTrackOptions write SetHotTrackOptions;
|
|
end;
|
|
|
|
TJvHotTrackOptions = class(TJvPersistentProperty)
|
|
private
|
|
FEnabled: Boolean;
|
|
FFrameVisible: Boolean;
|
|
FColor: TColor;
|
|
FFrameColor: TColor;
|
|
procedure SetColor(Value: TColor);
|
|
procedure SetEnabled(Value: Boolean);
|
|
procedure SetFrameColor(Value: TColor);
|
|
procedure SetFrameVisible(Value: Boolean);
|
|
public
|
|
constructor Create; virtual;
|
|
procedure Assign(Source: TPersistent); override;
|
|
published
|
|
property Enabled: Boolean read FEnabled write SetEnabled default False;
|
|
property Color: TColor read FColor write SetColor default $00D2BDB6;
|
|
property FrameVisible: Boolean read FFrameVisible write SetFrameVisible default False;
|
|
property FrameColor: TColor read FFrameColor write SetFrameColor default $006A240A;
|
|
end;
|
|
|
|
TStructPtrMessage = class(TObject)
|
|
private
|
|
{$IFDEF CLR}
|
|
FBuf: IntPtr;
|
|
FLParam: &Object;
|
|
{$ENDIF CLR}
|
|
public
|
|
Msg: TMessage;
|
|
constructor Create(Msg: Integer; WParam: Integer; var LParam);
|
|
{$IFDEF CLR}
|
|
destructor Destroy; override;
|
|
{$ENDIF CLR}
|
|
end;
|
|
|
|
procedure SetDotNetFrameColors(FocusedColor, UnfocusedColor: TColor);
|
|
procedure DrawDotNetControl(Control: TWinControl; AColor: TColor; InControl: Boolean);
|
|
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;
|
|
|
|
{$IFDEF COMPILER5}
|
|
procedure TOpenControl_SetAutoSize(AControl: TControl; Value: Boolean);
|
|
{$ENDIF COMPILER5}
|
|
|
|
{$IFDEF VisualCLX}
|
|
function Perform(AControl: TControl; Msg: Integer; WParam, LParam: Integer): Integer;
|
|
{$ENDIF VisualCLX}
|
|
|
|
type
|
|
TJvExControl = class(TControl, IJvExControl)
|
|
private
|
|
FAboutJVCL: TJVCLAboutInfo;
|
|
FHintColor: TColor;
|
|
FMouseOver: Boolean;
|
|
{$IFDEF VCL}
|
|
FOnMouseEnter: TNotifyEvent;
|
|
FOnMouseLeave: TNotifyEvent;
|
|
{$ENDIF VCL}
|
|
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;
|
|
{$IFNDEF CLR}
|
|
procedure FocusChanged(AControl: TWinControl); dynamic;
|
|
{$ENDIF !CLR}
|
|
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;
|
|
{$IFDEF COMPILER5}
|
|
{$IFNDEF HASAUTOSIZE}
|
|
procedure CMSetAutoSize(var Msg: TMessage); message CM_SETAUTOSIZE;
|
|
procedure SetAutoSize(Value: Boolean); virtual;
|
|
{$ENDIF !HASAUTOSIZE}
|
|
{$ENDIF COMPILER5}
|
|
property MouseOver: Boolean read FMouseOver write FMouseOver;
|
|
property HintColor: TColor read FHintColor write FHintColor default clDefault;
|
|
{$IFDEF VCL}
|
|
property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
|
|
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
|
|
{$ENDIF VCL}
|
|
property OnParentColorChange: TNotifyEvent read FOnParentColorChanged write FOnParentColorChanged;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
published
|
|
property AboutJVCL: TJVCLAboutInfo read FAboutJVCL write FAboutJVCL stored False;
|
|
end;
|
|
|
|
TJvExWinControl = class(TWinControl, IJvExControl)
|
|
private
|
|
FAboutJVCL: TJVCLAboutInfo;
|
|
FHintColor: TColor;
|
|
FMouseOver: Boolean;
|
|
{$IFDEF VCL}
|
|
FOnMouseEnter: TNotifyEvent;
|
|
FOnMouseLeave: TNotifyEvent;
|
|
{$ENDIF VCL}
|
|
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;
|
|
{$IFNDEF CLR}
|
|
procedure FocusChanged(AControl: TWinControl); dynamic;
|
|
{$ENDIF !CLR}
|
|
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;
|
|
{$IFDEF COMPILER5}
|
|
{$IFNDEF HASAUTOSIZE}
|
|
procedure CMSetAutoSize(var Msg: TMessage); message CM_SETAUTOSIZE;
|
|
procedure SetAutoSize(Value: Boolean); virtual;
|
|
{$ENDIF !HASAUTOSIZE}
|
|
{$ENDIF COMPILER5}
|
|
property MouseOver: Boolean read FMouseOver write FMouseOver;
|
|
property HintColor: TColor read FHintColor write FHintColor default clDefault;
|
|
{$IFDEF VCL}
|
|
property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
|
|
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
|
|
{$ENDIF VCL}
|
|
property OnParentColorChange: TNotifyEvent read FOnParentColorChanged write FOnParentColorChanged;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
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;
|
|
{$IFNDEF CLR}
|
|
procedure ControlsListChanging(Control: TControl; Inserting: Boolean); reintroduce; dynamic;
|
|
procedure ControlsListChanged(Control: TControl; Inserting: Boolean); reintroduce; dynamic;
|
|
{$ENDIF !CLR}
|
|
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;
|
|
{$IFDEF VCL}
|
|
FOnMouseEnter: TNotifyEvent;
|
|
FOnMouseLeave: TNotifyEvent;
|
|
{$ENDIF VCL}
|
|
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;
|
|
{$IFNDEF CLR}
|
|
procedure FocusChanged(AControl: TWinControl); dynamic;
|
|
{$ENDIF !CLR}
|
|
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;
|
|
{$IFDEF COMPILER5}
|
|
{$IFNDEF HASAUTOSIZE}
|
|
procedure CMSetAutoSize(var Msg: TMessage); message CM_SETAUTOSIZE;
|
|
procedure SetAutoSize(Value: Boolean); virtual;
|
|
{$ENDIF !HASAUTOSIZE}
|
|
{$ENDIF COMPILER5}
|
|
property MouseOver: Boolean read FMouseOver write FMouseOver;
|
|
property HintColor: TColor read FHintColor write FHintColor default clDefault;
|
|
{$IFDEF VCL}
|
|
property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
|
|
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
|
|
{$ENDIF VCL}
|
|
property OnParentColorChange: TNotifyEvent read FOnParentColorChanged write FOnParentColorChanged;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
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;
|
|
{$IFNDEF CLR}
|
|
procedure ControlsListChanging(Control: TControl; Inserting: Boolean); reintroduce; dynamic;
|
|
procedure ControlsListChanged(Control: TControl; Inserting: Boolean); reintroduce; dynamic;
|
|
{$ENDIF !CLR}
|
|
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;
|
|
{$IFDEF VCL}
|
|
FOnMouseEnter: TNotifyEvent;
|
|
FOnMouseLeave: TNotifyEvent;
|
|
{$ENDIF VCL}
|
|
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;
|
|
{$IFNDEF CLR}
|
|
procedure FocusChanged(AControl: TWinControl); dynamic;
|
|
{$ENDIF !CLR}
|
|
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;
|
|
{$IFDEF COMPILER5}
|
|
{$IFNDEF HASAUTOSIZE}
|
|
procedure CMSetAutoSize(var Msg: TMessage); message CM_SETAUTOSIZE;
|
|
procedure SetAutoSize(Value: Boolean); virtual;
|
|
{$ENDIF !HASAUTOSIZE}
|
|
{$ENDIF COMPILER5}
|
|
property MouseOver: Boolean read FMouseOver write FMouseOver;
|
|
property HintColor: TColor read FHintColor write FHintColor default clDefault;
|
|
{$IFDEF VCL}
|
|
property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
|
|
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
|
|
{$ENDIF VCL}
|
|
property OnParentColorChange: TNotifyEvent read FOnParentColorChanged write FOnParentColorChanged;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
published
|
|
property AboutJVCL: TJVCLAboutInfo read FAboutJVCL write FAboutJVCL stored False;
|
|
end;
|
|
|
|
TJvExHintWindow = class(THintWindow, IJvExControl)
|
|
private
|
|
FAboutJVCL: TJVCLAboutInfo;
|
|
FHintColor: TColor;
|
|
FMouseOver: Boolean;
|
|
{$IFDEF VCL}
|
|
FOnMouseEnter: TNotifyEvent;
|
|
FOnMouseLeave: TNotifyEvent;
|
|
{$ENDIF VCL}
|
|
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;
|
|
{$IFNDEF CLR}
|
|
procedure FocusChanged(AControl: TWinControl); dynamic;
|
|
{$ENDIF !CLR}
|
|
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;
|
|
{$IFDEF COMPILER5}
|
|
{$IFNDEF HASAUTOSIZE}
|
|
procedure CMSetAutoSize(var Msg: TMessage); message CM_SETAUTOSIZE;
|
|
procedure SetAutoSize(Value: Boolean); virtual;
|
|
{$ENDIF !HASAUTOSIZE}
|
|
{$ENDIF COMPILER5}
|
|
property MouseOver: Boolean read FMouseOver write FMouseOver;
|
|
property HintColor: TColor read FHintColor write FHintColor default clDefault;
|
|
{$IFDEF VCL}
|
|
property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
|
|
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
|
|
{$ENDIF VCL}
|
|
property OnParentColorChange: TNotifyEvent read FOnParentColorChanged write FOnParentColorChanged;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
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;
|
|
{$IFNDEF CLR}
|
|
procedure ControlsListChanging(Control: TControl; Inserting: Boolean); reintroduce; dynamic;
|
|
procedure ControlsListChanged(Control: TControl; Inserting: Boolean); reintroduce; dynamic;
|
|
{$ENDIF !CLR}
|
|
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: '$RCSfile: JvExControls.pas,v $';
|
|
Revision: '$Revision: 1.91 $';
|
|
Date: '$Date: 2006/01/24 17:31:03 $';
|
|
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;
|
|
Canvas: TCanvas;
|
|
begin
|
|
DC := GetWindowDC(Control.Handle);
|
|
try
|
|
GetWindowRect(Control.Handle, R);
|
|
OffsetRect(R, -R.Left, -R.Top);
|
|
Canvas := TCanvas.Create;
|
|
with Canvas do
|
|
try
|
|
Handle := DC;
|
|
Brush.Color := InternalUnfocusedColor;
|
|
if Control.Focused or InControl then
|
|
Brush.Color := InternalFocusedColor;
|
|
FrameRect(R);
|
|
InflateRect(R, -1, -1);
|
|
if not (Control.Focused or InControl) then
|
|
Brush.Color := AColor;
|
|
FrameRect(R);
|
|
finally
|
|
Free;
|
|
end;
|
|
finally
|
|
ReleaseDC(Control.Handle, DC);
|
|
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
|
|
{$IFNDEF CLR}
|
|
Result.Msg := Msg;
|
|
Result.WParam := WParam;
|
|
Result.LParam := LParam;
|
|
{$ELSE}
|
|
Result := TMessage.Create(Msg, WParam, LParam);
|
|
{$ENDIF CLR}
|
|
Result.Result := 0;
|
|
end;
|
|
|
|
function CreateWMMessage(Msg: Integer; WParam: Integer; LParam: TControl): TMessage;
|
|
begin
|
|
{$IFNDEF CLR}
|
|
Result := CreateWMMessage(Msg, WParam, Integer(LParam));
|
|
{$ELSE}
|
|
Result := CreateWMMessage(Msg, WParam, 0);
|
|
{$ENDIF !CLR}
|
|
end;
|
|
|
|
{ TStructPtrMessage }
|
|
constructor TStructPtrMessage.Create(Msg: Integer; WParam: Integer; var LParam);
|
|
begin
|
|
inherited Create;
|
|
{$IFNDEF CLR}
|
|
Self.Msg.Msg := Msg;
|
|
Self.Msg.WParam := WParam;
|
|
Self.Msg.LParam := Longint(@LParam);
|
|
{$ELSE}
|
|
FBuf := Marshal.AllocHGlobal(Marshal.SizeOf(TObject(LParam)));
|
|
FLParam := &Object(LParam);
|
|
Marshal.StructureToPtr(FLParam, FBuf, False);
|
|
Self.Msg := TMessage.Create(Msg, WParam, Longint(FBuf));
|
|
{$ENDIF !CLR}
|
|
Self.Msg.Result := 0;
|
|
end;
|
|
|
|
{$IFDEF CLR}
|
|
destructor TStructPtrMessage.Destroy;
|
|
begin
|
|
FLParam := Marshal.PtrToStructure(FBuf, TypeOf(FLParam));
|
|
Marshal.DestroyStructure(FBuf, TypeOf(FLParam));
|
|
inherited Destroy;
|
|
end;
|
|
{$ENDIF CLR}
|
|
|
|
function SmallPointToLong(const Pt: TSmallPoint): Longint;
|
|
begin
|
|
{$IFDEF CLR}
|
|
Result := Int32(Pt.X) shl 16 or Pt.Y;
|
|
{$ELSE}
|
|
Result := Longint(Pt);
|
|
{$ENDIF CLR}
|
|
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
|
|
{$IFDEF VCL}
|
|
Result := Form.ActiveControl;
|
|
{$ENDIF VCL}
|
|
{$IFDEF VisualCLX}
|
|
Result := Form.FocusedControl;
|
|
{$ENDIF VisualCLX}
|
|
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;
|
|
{$IFNDEF CLR}
|
|
{$IFDEF VCL}
|
|
AControl.Parent.Perform(CM_HINTSHOW, 0, Integer(@AHintInfo));
|
|
{$ENDIF VCL}
|
|
{$IFDEF VisualCLX}
|
|
Perform(AControl.Parent, CM_HINTSHOW, 0, Integer(@AHintInfo));
|
|
{$ENDIF VisualCLX}
|
|
{$ELSE}
|
|
AControl.Parent.Perform(CM_HINTSHOW, 0, AHintInfo);
|
|
{$ENDIF !CLR}
|
|
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;
|
|
|
|
{$IFDEF VisualCLX}
|
|
function Perform(AControl: TControl; Msg: Integer; WParam, LParam: Integer): Integer;
|
|
var
|
|
PerformMsg, Mesg: TMessage;
|
|
begin
|
|
if AControl.GetInterfaceEntry(IJvExControl) <> nil then
|
|
begin
|
|
Mesg.Msg := Msg;
|
|
Mesg.WParam := WParam;
|
|
Mesg.LParam := LParam;
|
|
Mesg.Result := 0;
|
|
|
|
PerformMsg.Msg := CM_PERFORM;
|
|
PerformMsg.WParam := 0;
|
|
PerformMsg.LParam := @Mesg;
|
|
PerformMsg.Result := 0;
|
|
AControl.Dispatch(PerformMsg);
|
|
end;
|
|
end;
|
|
{$ENDIF VisualCLX}
|
|
|
|
{$IFDEF COMPILER5}
|
|
|
|
{ Delphi 5's SetAutoSize is private and not virtual. This code installs a
|
|
JUMP-Hook into SetAutoSize that jumps to our function. }
|
|
var
|
|
AutoSizeOffset: Cardinal;
|
|
TControl_SetAutoSize: Pointer;
|
|
|
|
type
|
|
PBoolean = ^Boolean;
|
|
TControlAccessProtected = class(TControl)
|
|
published
|
|
property AutoSize;
|
|
end;
|
|
|
|
procedure OrgSetAutoSize(AControl: TControl; Value: Boolean);
|
|
asm
|
|
DD 0, 0, 0, 0 // 16 Bytes
|
|
end;
|
|
|
|
procedure TOpenControl_SetAutoSize(AControl: TControl; Value: Boolean);
|
|
begin
|
|
// same as OrgSetAutoSize(AControl, Value); but secure
|
|
with TControlAccessProtected(AControl) do
|
|
if AutoSize <> Value then
|
|
begin
|
|
PBoolean(Cardinal(AControl) + AutoSizeOffset)^ := Value;
|
|
if Value then
|
|
AdjustSize;
|
|
end;
|
|
end;
|
|
|
|
procedure SetAutoSizeHook(AControl: TControl; Value: Boolean);
|
|
var
|
|
Msg: TMessage;
|
|
begin
|
|
if AControl.GetInterfaceEntry(IJvExControl) <> nil then
|
|
begin
|
|
Msg.Msg := CM_SETAUTOSIZE;
|
|
Msg.WParam := Ord(Value);
|
|
AControl.Dispatch(Msg);
|
|
end
|
|
else
|
|
TOpenControl_SetAutoSize(AControl, Value);
|
|
end;
|
|
|
|
procedure InitHookVars;
|
|
var
|
|
Info: PPropInfo;
|
|
begin
|
|
Info := GetPropInfo(TControlAccessProtected, 'AutoSize');
|
|
AutoSizeOffset := Integer(Info.GetProc) and $00FFFFFF;
|
|
TControl_SetAutoSize := Info.SetProc;
|
|
end;
|
|
|
|
{$ENDIF COMPILER5}
|
|
|
|
//=== { TJvHotTrackOptions } ======================================
|
|
|
|
constructor TJvHotTrackOptions.Create;
|
|
begin
|
|
inherited Create;
|
|
FEnabled := False;
|
|
FFrameVisible := False;
|
|
FColor := $00D2BDB6;
|
|
FFrameColor := $006A240A;
|
|
end;
|
|
|
|
procedure TJvHotTrackOptions.Assign(Source: TPersistent);
|
|
begin
|
|
if Source is TJvHotTrackOptions then
|
|
begin
|
|
BeginUpdate;
|
|
try
|
|
Enabled := TJvHotTrackOptions(Source).Enabled;
|
|
Color := TJvHotTrackOptions(Source).Color;
|
|
FrameVisible := TJvHotTrackOptions(Source).FrameVisible;
|
|
FrameColor := TJvHotTrackOptions(Source).FrameColor;
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
procedure TJvHotTrackOptions.SetColor(Value: TColor);
|
|
begin
|
|
if FColor <> Value then
|
|
begin
|
|
Changing;
|
|
ChangingProperty('Color');
|
|
FColor := Value;
|
|
ChangedProperty('Color');
|
|
Changed;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvHotTrackOptions.SetEnabled(Value: Boolean);
|
|
begin
|
|
if FEnabled <> Value then
|
|
begin
|
|
Changing;
|
|
ChangingProperty('Enabled');
|
|
FEnabled := Value;
|
|
ChangedProperty('Enabled');
|
|
Changed;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvHotTrackOptions.SetFrameVisible(Value: Boolean);
|
|
begin
|
|
if FFrameVisible <> Value then
|
|
begin
|
|
Changing;
|
|
ChangingProperty('FrameVisible');
|
|
FFrameVisible := Value;
|
|
ChangedProperty('FrameVisible');
|
|
Changed;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvHotTrackOptions.SetFrameColor(Value: TColor);
|
|
begin
|
|
if FFrameColor <> Value then
|
|
begin
|
|
Changing;
|
|
ChangingProperty('FrameColor');
|
|
FFrameColor := Value;
|
|
ChangedProperty('FrameColor');
|
|
Changed;
|
|
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);
|
|
Result := BaseWndProcEx(CM_HINTSHOW, 0, HintInfo) <> 0;
|
|
end;
|
|
|
|
procedure TJvExControl.MouseEnter(AControl: TControl);
|
|
begin
|
|
FMouseOver := True;
|
|
{$IFDEF VCL}
|
|
if Assigned(FOnMouseEnter) then
|
|
FOnMouseEnter(Self);
|
|
{$ENDIF VCL}
|
|
BaseWndProc(CM_MOUSEENTER, 0, AControl);
|
|
end;
|
|
|
|
procedure TJvExControl.MouseLeave(AControl: TControl);
|
|
begin
|
|
FMouseOver := False;
|
|
BaseWndProc(CM_MOUSELEAVE, 0, AControl);
|
|
{$IFDEF VCL}
|
|
if Assigned(FOnMouseLeave) then
|
|
FOnMouseLeave(Self);
|
|
{$ENDIF VCL}
|
|
end;
|
|
|
|
{$IFNDEF CLR}
|
|
procedure TJvExControl.FocusChanged(AControl: TWinControl);
|
|
begin
|
|
BaseWndProc(CM_FOCUSCHANGED, 0, AControl);
|
|
end;
|
|
{$ENDIF !CLR}
|
|
|
|
{$IFDEF COMPILER5}
|
|
{$IFNDEF HASAUTOSIZE}
|
|
|
|
procedure TJvExControl.CMSetAutoSize(var Msg: TMessage);
|
|
begin
|
|
SetAutoSize(Msg.WParam <> 0);
|
|
end;
|
|
|
|
procedure TJvExControl.SetAutoSize(Value: Boolean);
|
|
begin
|
|
TOpenControl_SetAutoSize(Self, Value);
|
|
end;
|
|
|
|
{$ENDIF !HASAUTOSIZE}
|
|
{$ENDIF COMPILER5}
|
|
|
|
procedure TJvExControl.WndProc(var Msg: TMessage);
|
|
{$IFDEF CLR}
|
|
var
|
|
AHintInfo: THintInfo;
|
|
{$ENDIF CLR}
|
|
begin
|
|
if not DispatchIsDesignMsg(Self, Msg) then
|
|
case Msg.Msg of
|
|
CM_DENYSUBCLASSING:
|
|
{$IFNDEF CLR}
|
|
Msg.Result := Ord(GetInterfaceEntry(IJvDenySubClassing) <> nil);
|
|
{$ELSE}
|
|
Msg.Result := Integer(Supports(Self, IJvDenySubClassing));
|
|
{$ENDIF !CLR}
|
|
CM_DIALOGCHAR:
|
|
with TCMDialogChar{$IFDEF CLR}.Create{$ENDIF}(Msg) do
|
|
Result := Ord(WantKey(CharCode, KeyDataToShiftState(KeyData), WideChar(CharCode)));
|
|
CM_HINTSHOW:
|
|
{$IFNDEF CLR}
|
|
with TCMHintShow(Msg) do
|
|
Result := Integer(HintShow(HintInfo^));
|
|
{$ELSE}
|
|
with TCMHintShow.Create(Msg) do
|
|
begin
|
|
AHintInfo := HintInfo;
|
|
Result := Integer(HintShow(AHintInfo));
|
|
HintInfo := AHintInfo;
|
|
end;
|
|
{$ENDIF !CLR}
|
|
CM_HITTEST:
|
|
with TCMHitTest{$IFDEF CLR}.Create{$ENDIF}(Msg) do
|
|
Result := Integer(HitTest(XPos, YPos));
|
|
CM_MOUSEENTER:
|
|
MouseEnter({$IFDEF CLR}nil{$ELSE}TControl(Msg.LParam){$ENDIF});
|
|
CM_MOUSELEAVE:
|
|
MouseLeave({$IFDEF CLR}nil{$ELSE}TControl(Msg.LParam){$ENDIF});
|
|
CM_VISIBLECHANGED:
|
|
VisibleChanged;
|
|
CM_ENABLEDCHANGED:
|
|
EnabledChanged;
|
|
CM_TEXTCHANGED:
|
|
TextChanged;
|
|
CM_FONTCHANGED:
|
|
FontChanged;
|
|
CM_COLORCHANGED:
|
|
ColorChanged;
|
|
{$IFNDEF CLR}
|
|
CM_FOCUSCHANGED:
|
|
FocusChanged(TWinControl(Msg.LParam));
|
|
{$ENDIF !CLR}
|
|
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);
|
|
Result := BaseWndProcEx(CM_HINTSHOW, 0, HintInfo) <> 0;
|
|
end;
|
|
|
|
procedure TJvExWinControl.MouseEnter(AControl: TControl);
|
|
begin
|
|
FMouseOver := True;
|
|
{$IFDEF VCL}
|
|
if Assigned(FOnMouseEnter) then
|
|
FOnMouseEnter(Self);
|
|
{$ENDIF VCL}
|
|
BaseWndProc(CM_MOUSEENTER, 0, AControl);
|
|
end;
|
|
|
|
procedure TJvExWinControl.MouseLeave(AControl: TControl);
|
|
begin
|
|
FMouseOver := False;
|
|
BaseWndProc(CM_MOUSELEAVE, 0, AControl);
|
|
{$IFDEF VCL}
|
|
if Assigned(FOnMouseLeave) then
|
|
FOnMouseLeave(Self);
|
|
{$ENDIF VCL}
|
|
end;
|
|
|
|
{$IFNDEF CLR}
|
|
procedure TJvExWinControl.FocusChanged(AControl: TWinControl);
|
|
begin
|
|
BaseWndProc(CM_FOCUSCHANGED, 0, AControl);
|
|
end;
|
|
{$ENDIF !CLR}
|
|
|
|
{$IFDEF COMPILER5}
|
|
{$IFNDEF HASAUTOSIZE}
|
|
|
|
procedure TJvExWinControl.CMSetAutoSize(var Msg: TMessage);
|
|
begin
|
|
SetAutoSize(Msg.WParam <> 0);
|
|
end;
|
|
|
|
procedure TJvExWinControl.SetAutoSize(Value: Boolean);
|
|
begin
|
|
TOpenControl_SetAutoSize(Self, Value);
|
|
end;
|
|
|
|
{$ENDIF !HASAUTOSIZE}
|
|
{$ENDIF COMPILER5}
|
|
|
|
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;
|
|
|
|
{$IFNDEF CLR}
|
|
{ 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;
|
|
{$ENDIF !CLR}
|
|
|
|
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;
|
|
{$IFDEF CLR}
|
|
AHintInfo: THintInfo;
|
|
{$ENDIF CLR}
|
|
begin
|
|
if not DispatchIsDesignMsg(Self, Msg) then
|
|
begin
|
|
case Msg.Msg of
|
|
CM_DENYSUBCLASSING:
|
|
{$IFNDEF CLR}
|
|
Msg.Result := Ord(GetInterfaceEntry(IJvDenySubClassing) <> nil);
|
|
{$ELSE}
|
|
Msg.Result := Integer(Supports(Self, IJvDenySubClassing));
|
|
{$ENDIF !CLR}
|
|
CM_DIALOGCHAR:
|
|
with TCMDialogChar{$IFDEF CLR}.Create{$ENDIF}(Msg) do
|
|
Result := Ord(WantKey(CharCode, KeyDataToShiftState(KeyData), WideChar(CharCode)));
|
|
CM_HINTSHOW:
|
|
{$IFNDEF CLR}
|
|
with TCMHintShow(Msg) do
|
|
Result := Integer(HintShow(HintInfo^));
|
|
{$ELSE}
|
|
with TCMHintShow.Create(Msg) do
|
|
begin
|
|
AHintInfo := HintInfo;
|
|
Result := Integer(HintShow(AHintInfo));
|
|
HintInfo := AHintInfo;
|
|
end;
|
|
{$ENDIF !CLR}
|
|
CM_HITTEST:
|
|
with TCMHitTest{$IFDEF CLR}.Create{$ENDIF}(Msg) do
|
|
Result := Integer(HitTest(XPos, YPos));
|
|
CM_MOUSEENTER:
|
|
MouseEnter({$IFDEF CLR}nil{$ELSE}TControl(Msg.LParam){$ENDIF});
|
|
CM_MOUSELEAVE:
|
|
MouseLeave({$IFDEF CLR}nil{$ELSE}TControl(Msg.LParam){$ENDIF});
|
|
CM_VISIBLECHANGED:
|
|
VisibleChanged;
|
|
CM_ENABLEDCHANGED:
|
|
EnabledChanged;
|
|
CM_TEXTCHANGED:
|
|
TextChanged;
|
|
CM_FONTCHANGED:
|
|
FontChanged;
|
|
CM_COLORCHANGED:
|
|
ColorChanged;
|
|
{$IFNDEF CLR}
|
|
CM_FOCUSCHANGED:
|
|
FocusChanged(TWinControl(Msg.LParam));
|
|
{$ENDIF !CLR}
|
|
CM_PARENTFONTCHANGED:
|
|
ParentFontChanged;
|
|
CM_PARENTCOLORCHANGED:
|
|
ParentColorChanged;
|
|
CM_PARENTSHOWHINTCHANGED:
|
|
ParentShowHintChanged;
|
|
CM_CURSORCHANGED:
|
|
CursorChanged;
|
|
CM_SHOWINGCHANGED:
|
|
ShowingChanged;
|
|
CM_SHOWHINTCHANGED:
|
|
ShowHintChanged;
|
|
{$IFNDEF CLR}
|
|
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);
|
|
{$ENDIF !CLR}
|
|
WM_SETFOCUS:
|
|
FocusSet(THandle(Msg.WParam));
|
|
WM_KILLFOCUS:
|
|
FocusKilled(THandle(Msg.WParam));
|
|
WM_SIZE:
|
|
begin
|
|
inherited WndProc(Msg);
|
|
BoundsChanged;
|
|
end;
|
|
WM_ERASEBKGND:
|
|
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;
|
|
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;
|
|
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;
|
|
if DotNetHighlighting then
|
|
HandleDotNetHighlighting(Self, Msg, MouseOver, Color);
|
|
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);
|
|
Result := BaseWndProcEx(CM_HINTSHOW, 0, HintInfo) <> 0;
|
|
end;
|
|
|
|
procedure TJvExGraphicControl.MouseEnter(AControl: TControl);
|
|
begin
|
|
FMouseOver := True;
|
|
{$IFDEF VCL}
|
|
if Assigned(FOnMouseEnter) then
|
|
FOnMouseEnter(Self);
|
|
{$ENDIF VCL}
|
|
BaseWndProc(CM_MOUSEENTER, 0, AControl);
|
|
end;
|
|
|
|
procedure TJvExGraphicControl.MouseLeave(AControl: TControl);
|
|
begin
|
|
FMouseOver := False;
|
|
BaseWndProc(CM_MOUSELEAVE, 0, AControl);
|
|
{$IFDEF VCL}
|
|
if Assigned(FOnMouseLeave) then
|
|
FOnMouseLeave(Self);
|
|
{$ENDIF VCL}
|
|
end;
|
|
|
|
{$IFNDEF CLR}
|
|
procedure TJvExGraphicControl.FocusChanged(AControl: TWinControl);
|
|
begin
|
|
BaseWndProc(CM_FOCUSCHANGED, 0, AControl);
|
|
end;
|
|
{$ENDIF !CLR}
|
|
|
|
{$IFDEF COMPILER5}
|
|
{$IFNDEF HASAUTOSIZE}
|
|
|
|
procedure TJvExGraphicControl.CMSetAutoSize(var Msg: TMessage);
|
|
begin
|
|
SetAutoSize(Msg.WParam <> 0);
|
|
end;
|
|
|
|
procedure TJvExGraphicControl.SetAutoSize(Value: Boolean);
|
|
begin
|
|
TOpenControl_SetAutoSize(Self, Value);
|
|
end;
|
|
|
|
{$ENDIF !HASAUTOSIZE}
|
|
{$ENDIF COMPILER5}
|
|
|
|
procedure TJvExGraphicControl.WndProc(var Msg: TMessage);
|
|
{$IFDEF CLR}
|
|
var
|
|
AHintInfo: THintInfo;
|
|
{$ENDIF CLR}
|
|
begin
|
|
if not DispatchIsDesignMsg(Self, Msg) then
|
|
case Msg.Msg of
|
|
CM_DENYSUBCLASSING:
|
|
{$IFNDEF CLR}
|
|
Msg.Result := Ord(GetInterfaceEntry(IJvDenySubClassing) <> nil);
|
|
{$ELSE}
|
|
Msg.Result := Integer(Supports(Self, IJvDenySubClassing));
|
|
{$ENDIF !CLR}
|
|
CM_DIALOGCHAR:
|
|
with TCMDialogChar{$IFDEF CLR}.Create{$ENDIF}(Msg) do
|
|
Result := Ord(WantKey(CharCode, KeyDataToShiftState(KeyData), WideChar(CharCode)));
|
|
CM_HINTSHOW:
|
|
{$IFNDEF CLR}
|
|
with TCMHintShow(Msg) do
|
|
Result := Integer(HintShow(HintInfo^));
|
|
{$ELSE}
|
|
with TCMHintShow.Create(Msg) do
|
|
begin
|
|
AHintInfo := HintInfo;
|
|
Result := Integer(HintShow(AHintInfo));
|
|
HintInfo := AHintInfo;
|
|
end;
|
|
{$ENDIF !CLR}
|
|
CM_HITTEST:
|
|
with TCMHitTest{$IFDEF CLR}.Create{$ENDIF}(Msg) do
|
|
Result := Integer(HitTest(XPos, YPos));
|
|
CM_MOUSEENTER:
|
|
MouseEnter({$IFDEF CLR}nil{$ELSE}TControl(Msg.LParam){$ENDIF});
|
|
CM_MOUSELEAVE:
|
|
MouseLeave({$IFDEF CLR}nil{$ELSE}TControl(Msg.LParam){$ENDIF});
|
|
CM_VISIBLECHANGED:
|
|
VisibleChanged;
|
|
CM_ENABLEDCHANGED:
|
|
EnabledChanged;
|
|
CM_TEXTCHANGED:
|
|
TextChanged;
|
|
CM_FONTCHANGED:
|
|
FontChanged;
|
|
CM_COLORCHANGED:
|
|
ColorChanged;
|
|
{$IFNDEF CLR}
|
|
CM_FOCUSCHANGED:
|
|
FocusChanged(TWinControl(Msg.LParam));
|
|
{$ENDIF !CLR}
|
|
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);
|
|
Result := BaseWndProcEx(CM_HINTSHOW, 0, HintInfo) <> 0;
|
|
end;
|
|
|
|
procedure TJvExCustomControl.MouseEnter(AControl: TControl);
|
|
begin
|
|
FMouseOver := True;
|
|
{$IFDEF VCL}
|
|
if Assigned(FOnMouseEnter) then
|
|
FOnMouseEnter(Self);
|
|
{$ENDIF VCL}
|
|
BaseWndProc(CM_MOUSEENTER, 0, AControl);
|
|
end;
|
|
|
|
procedure TJvExCustomControl.MouseLeave(AControl: TControl);
|
|
begin
|
|
FMouseOver := False;
|
|
BaseWndProc(CM_MOUSELEAVE, 0, AControl);
|
|
{$IFDEF VCL}
|
|
if Assigned(FOnMouseLeave) then
|
|
FOnMouseLeave(Self);
|
|
{$ENDIF VCL}
|
|
end;
|
|
|
|
{$IFNDEF CLR}
|
|
procedure TJvExCustomControl.FocusChanged(AControl: TWinControl);
|
|
begin
|
|
BaseWndProc(CM_FOCUSCHANGED, 0, AControl);
|
|
end;
|
|
{$ENDIF !CLR}
|
|
|
|
{$IFDEF COMPILER5}
|
|
{$IFNDEF HASAUTOSIZE}
|
|
|
|
procedure TJvExCustomControl.CMSetAutoSize(var Msg: TMessage);
|
|
begin
|
|
SetAutoSize(Msg.WParam <> 0);
|
|
end;
|
|
|
|
procedure TJvExCustomControl.SetAutoSize(Value: Boolean);
|
|
begin
|
|
TOpenControl_SetAutoSize(Self, Value);
|
|
end;
|
|
|
|
{$ENDIF !HASAUTOSIZE}
|
|
{$ENDIF COMPILER5}
|
|
|
|
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;
|
|
|
|
{$IFNDEF CLR}
|
|
{ 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;
|
|
{$ENDIF !CLR}
|
|
|
|
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;
|
|
{$IFDEF CLR}
|
|
AHintInfo: THintInfo;
|
|
{$ENDIF CLR}
|
|
begin
|
|
if not DispatchIsDesignMsg(Self, Msg) then
|
|
begin
|
|
case Msg.Msg of
|
|
CM_DENYSUBCLASSING:
|
|
{$IFNDEF CLR}
|
|
Msg.Result := Ord(GetInterfaceEntry(IJvDenySubClassing) <> nil);
|
|
{$ELSE}
|
|
Msg.Result := Integer(Supports(Self, IJvDenySubClassing));
|
|
{$ENDIF !CLR}
|
|
CM_DIALOGCHAR:
|
|
with TCMDialogChar{$IFDEF CLR}.Create{$ENDIF}(Msg) do
|
|
Result := Ord(WantKey(CharCode, KeyDataToShiftState(KeyData), WideChar(CharCode)));
|
|
CM_HINTSHOW:
|
|
{$IFNDEF CLR}
|
|
with TCMHintShow(Msg) do
|
|
Result := Integer(HintShow(HintInfo^));
|
|
{$ELSE}
|
|
with TCMHintShow.Create(Msg) do
|
|
begin
|
|
AHintInfo := HintInfo;
|
|
Result := Integer(HintShow(AHintInfo));
|
|
HintInfo := AHintInfo;
|
|
end;
|
|
{$ENDIF !CLR}
|
|
CM_HITTEST:
|
|
with TCMHitTest{$IFDEF CLR}.Create{$ENDIF}(Msg) do
|
|
Result := Integer(HitTest(XPos, YPos));
|
|
CM_MOUSEENTER:
|
|
MouseEnter({$IFDEF CLR}nil{$ELSE}TControl(Msg.LParam){$ENDIF});
|
|
CM_MOUSELEAVE:
|
|
MouseLeave({$IFDEF CLR}nil{$ELSE}TControl(Msg.LParam){$ENDIF});
|
|
CM_VISIBLECHANGED:
|
|
VisibleChanged;
|
|
CM_ENABLEDCHANGED:
|
|
EnabledChanged;
|
|
CM_TEXTCHANGED:
|
|
TextChanged;
|
|
CM_FONTCHANGED:
|
|
FontChanged;
|
|
CM_COLORCHANGED:
|
|
ColorChanged;
|
|
{$IFNDEF CLR}
|
|
CM_FOCUSCHANGED:
|
|
FocusChanged(TWinControl(Msg.LParam));
|
|
{$ENDIF !CLR}
|
|
CM_PARENTFONTCHANGED:
|
|
ParentFontChanged;
|
|
CM_PARENTCOLORCHANGED:
|
|
ParentColorChanged;
|
|
CM_PARENTSHOWHINTCHANGED:
|
|
ParentShowHintChanged;
|
|
CM_CURSORCHANGED:
|
|
CursorChanged;
|
|
CM_SHOWINGCHANGED:
|
|
ShowingChanged;
|
|
CM_SHOWHINTCHANGED:
|
|
ShowHintChanged;
|
|
{$IFNDEF CLR}
|
|
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);
|
|
{$ENDIF !CLR}
|
|
WM_SETFOCUS:
|
|
FocusSet(THandle(Msg.WParam));
|
|
WM_KILLFOCUS:
|
|
FocusKilled(THandle(Msg.WParam));
|
|
WM_SIZE:
|
|
begin
|
|
inherited WndProc(Msg);
|
|
BoundsChanged;
|
|
end;
|
|
WM_ERASEBKGND:
|
|
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;
|
|
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;
|
|
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;
|
|
if DotNetHighlighting then
|
|
HandleDotNetHighlighting(Self, Msg, MouseOver, Color);
|
|
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);
|
|
Result := BaseWndProcEx(CM_HINTSHOW, 0, HintInfo) <> 0;
|
|
end;
|
|
|
|
procedure TJvExHintWindow.MouseEnter(AControl: TControl);
|
|
begin
|
|
FMouseOver := True;
|
|
{$IFDEF VCL}
|
|
if Assigned(FOnMouseEnter) then
|
|
FOnMouseEnter(Self);
|
|
{$ENDIF VCL}
|
|
BaseWndProc(CM_MOUSEENTER, 0, AControl);
|
|
end;
|
|
|
|
procedure TJvExHintWindow.MouseLeave(AControl: TControl);
|
|
begin
|
|
FMouseOver := False;
|
|
BaseWndProc(CM_MOUSELEAVE, 0, AControl);
|
|
{$IFDEF VCL}
|
|
if Assigned(FOnMouseLeave) then
|
|
FOnMouseLeave(Self);
|
|
{$ENDIF VCL}
|
|
end;
|
|
|
|
{$IFNDEF CLR}
|
|
procedure TJvExHintWindow.FocusChanged(AControl: TWinControl);
|
|
begin
|
|
BaseWndProc(CM_FOCUSCHANGED, 0, AControl);
|
|
end;
|
|
{$ENDIF !CLR}
|
|
|
|
{$IFDEF COMPILER5}
|
|
{$IFNDEF HASAUTOSIZE}
|
|
|
|
procedure TJvExHintWindow.CMSetAutoSize(var Msg: TMessage);
|
|
begin
|
|
SetAutoSize(Msg.WParam <> 0);
|
|
end;
|
|
|
|
procedure TJvExHintWindow.SetAutoSize(Value: Boolean);
|
|
begin
|
|
TOpenControl_SetAutoSize(Self, Value);
|
|
end;
|
|
|
|
{$ENDIF !HASAUTOSIZE}
|
|
{$ENDIF COMPILER5}
|
|
|
|
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;
|
|
|
|
{$IFNDEF CLR}
|
|
{ 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;
|
|
{$ENDIF !CLR}
|
|
|
|
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;
|
|
{$IFDEF CLR}
|
|
AHintInfo: THintInfo;
|
|
{$ENDIF CLR}
|
|
begin
|
|
if not DispatchIsDesignMsg(Self, Msg) then
|
|
begin
|
|
case Msg.Msg of
|
|
CM_DENYSUBCLASSING:
|
|
{$IFNDEF CLR}
|
|
Msg.Result := Ord(GetInterfaceEntry(IJvDenySubClassing) <> nil);
|
|
{$ELSE}
|
|
Msg.Result := Integer(Supports(Self, IJvDenySubClassing));
|
|
{$ENDIF !CLR}
|
|
CM_DIALOGCHAR:
|
|
with TCMDialogChar{$IFDEF CLR}.Create{$ENDIF}(Msg) do
|
|
Result := Ord(WantKey(CharCode, KeyDataToShiftState(KeyData), WideChar(CharCode)));
|
|
CM_HINTSHOW:
|
|
{$IFNDEF CLR}
|
|
with TCMHintShow(Msg) do
|
|
Result := Integer(HintShow(HintInfo^));
|
|
{$ELSE}
|
|
with TCMHintShow.Create(Msg) do
|
|
begin
|
|
AHintInfo := HintInfo;
|
|
Result := Integer(HintShow(AHintInfo));
|
|
HintInfo := AHintInfo;
|
|
end;
|
|
{$ENDIF !CLR}
|
|
CM_HITTEST:
|
|
with TCMHitTest{$IFDEF CLR}.Create{$ENDIF}(Msg) do
|
|
Result := Integer(HitTest(XPos, YPos));
|
|
CM_MOUSEENTER:
|
|
MouseEnter({$IFDEF CLR}nil{$ELSE}TControl(Msg.LParam){$ENDIF});
|
|
CM_MOUSELEAVE:
|
|
MouseLeave({$IFDEF CLR}nil{$ELSE}TControl(Msg.LParam){$ENDIF});
|
|
CM_VISIBLECHANGED:
|
|
VisibleChanged;
|
|
CM_ENABLEDCHANGED:
|
|
EnabledChanged;
|
|
CM_TEXTCHANGED:
|
|
TextChanged;
|
|
CM_FONTCHANGED:
|
|
FontChanged;
|
|
CM_COLORCHANGED:
|
|
ColorChanged;
|
|
{$IFNDEF CLR}
|
|
CM_FOCUSCHANGED:
|
|
FocusChanged(TWinControl(Msg.LParam));
|
|
{$ENDIF !CLR}
|
|
CM_PARENTFONTCHANGED:
|
|
ParentFontChanged;
|
|
CM_PARENTCOLORCHANGED:
|
|
ParentColorChanged;
|
|
CM_PARENTSHOWHINTCHANGED:
|
|
ParentShowHintChanged;
|
|
CM_CURSORCHANGED:
|
|
CursorChanged;
|
|
CM_SHOWINGCHANGED:
|
|
ShowingChanged;
|
|
CM_SHOWHINTCHANGED:
|
|
ShowHintChanged;
|
|
{$IFNDEF CLR}
|
|
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);
|
|
{$ENDIF !CLR}
|
|
WM_SETFOCUS:
|
|
FocusSet(THandle(Msg.WParam));
|
|
WM_KILLFOCUS:
|
|
FocusKilled(THandle(Msg.WParam));
|
|
WM_SIZE:
|
|
begin
|
|
inherited WndProc(Msg);
|
|
BoundsChanged;
|
|
end;
|
|
WM_ERASEBKGND:
|
|
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;
|
|
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;
|
|
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;
|
|
if DotNetHighlighting then
|
|
HandleDotNetHighlighting(Self, Msg, MouseOver, Color);
|
|
end;
|
|
end;
|
|
|
|
//============================================================================
|
|
|
|
initialization
|
|
{$IFDEF UNITVERSIONING}
|
|
RegisterUnitVersion(HInstance, UnitVersioning);
|
|
{$ENDIF UNITVERSIONING}
|
|
{$IFDEF COMPILER5}
|
|
InitHookVars;
|
|
InstallProcHook(TControl_SetAutoSize, @SetAutoSizeHook, @OrgSetAutoSize);
|
|
{$ENDIF COMPILER5}
|
|
|
|
finalization
|
|
{$IFDEF COMPILER5}
|
|
UninstallProcHook(@OrgSetAutoSize);
|
|
{$ENDIF COMPILER5}
|
|
{$IFDEF UNITVERSIONING}
|
|
UnregisterUnitVersion(HInstance);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
end.
|
|
|