david
78ab77cd4c
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.jvcl@19 7f62d464-2af8-f54e-996c-e91b33f51cbe
3069 lines
96 KiB
ObjectPascal
3069 lines
96 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: JvExForms.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): -
|
|
|
|
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: JvExForms.pas 12553 2009-10-05 13:22:42Z obones $
|
|
|
|
unit JvExForms;
|
|
|
|
{$I jvcl.inc}
|
|
{MACROINCLUDE JvExControls.macros}
|
|
|
|
{*****************************************************************************
|
|
* 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, Graphics, Controls, Forms, ToolWin, Types,
|
|
Classes, SysUtils,
|
|
{$IFDEF UNITVERSIONING}
|
|
JclUnitVersioning,
|
|
{$ENDIF UNITVERSIONING}
|
|
JvConsts, JvTypes, JvThemes, JVCLVer, JvExControls;
|
|
|
|
type
|
|
TJvExScrollingWinControl = class(TScrollingWinControl, 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;
|
|
|
|
TJvExScrollBox = class(TScrollBox, 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;
|
|
|
|
TJvExCustomFrame = class(TCustomFrame, 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;
|
|
|
|
TJvExFrame = class(TFrame, 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;
|
|
|
|
TJvExToolWindow = class(TToolWindow, 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;
|
|
|
|
TJvExCustomForm = class(TCustomForm, 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;
|
|
protected
|
|
procedure CMShowingChanged(var Msg: TMessage); message CM_SHOWINGCHANGED;
|
|
procedure CMDialogKey(var Msg: TCMDialogKey); message CM_DIALOGKEY;
|
|
public
|
|
constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); override;
|
|
end;
|
|
|
|
TJvExForm = class(TForm, 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;
|
|
protected
|
|
procedure CMShowingChanged(var Msg: TMessage); message CM_SHOWINGCHANGED;
|
|
procedure CMDialogKey(var Msg: TCMDialogKey); message CM_DIALOGKEY;
|
|
public
|
|
constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); override;
|
|
end;
|
|
|
|
TJvExCustomDockForm = class(TCustomDockForm, 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;
|
|
protected
|
|
procedure CMShowingChanged(var Msg: TMessage); message CM_SHOWINGCHANGED;
|
|
procedure CMDialogKey(var Msg: TCMDialogKey); message CM_DIALOGKEY;
|
|
public
|
|
constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); override;
|
|
end;
|
|
|
|
|
|
{$IFDEF UNITVERSIONING}
|
|
const
|
|
UnitVersioning: TUnitVersionInfo = (
|
|
RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/tags/JVCL3_39/run/JvExForms.pas $';
|
|
Revision: '$Revision: 12553 $';
|
|
Date: '$Date: 2009-10-05 15:22:42 +0200 (lun., 05 oct. 2009) $';
|
|
LogPath: 'JVCL\run'
|
|
);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
implementation
|
|
|
|
const
|
|
UISF_HIDEFOCUS = 1;
|
|
UISF_HIDEACCEL = 2;
|
|
UIS_SET = 1;
|
|
UIS_CLEAR = 2;
|
|
UIS_INITIALIZE = 3;
|
|
|
|
constructor TJvExScrollingWinControl.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FHintColor := clDefault;
|
|
end;
|
|
|
|
function TJvExScrollingWinControl.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 TJvExScrollingWinControl.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 TJvExScrollingWinControl.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 TJvExScrollingWinControl.VisibleChanged;
|
|
begin
|
|
BaseWndProc(CM_VISIBLECHANGED);
|
|
end;
|
|
|
|
procedure TJvExScrollingWinControl.EnabledChanged;
|
|
begin
|
|
BaseWndProc(CM_ENABLEDCHANGED);
|
|
end;
|
|
|
|
procedure TJvExScrollingWinControl.TextChanged;
|
|
begin
|
|
BaseWndProc(CM_TEXTCHANGED);
|
|
end;
|
|
|
|
procedure TJvExScrollingWinControl.FontChanged;
|
|
begin
|
|
BaseWndProc(CM_FONTCHANGED);
|
|
end;
|
|
|
|
procedure TJvExScrollingWinControl.ColorChanged;
|
|
begin
|
|
BaseWndProc(CM_COLORCHANGED);
|
|
end;
|
|
|
|
procedure TJvExScrollingWinControl.ParentFontChanged;
|
|
begin
|
|
BaseWndProc(CM_PARENTFONTCHANGED);
|
|
end;
|
|
|
|
procedure TJvExScrollingWinControl.ParentColorChanged;
|
|
begin
|
|
BaseWndProc(CM_PARENTCOLORCHANGED);
|
|
if Assigned(OnParentColorChange) then
|
|
OnParentColorChange(Self);
|
|
end;
|
|
|
|
procedure TJvExScrollingWinControl.ParentShowHintChanged;
|
|
begin
|
|
BaseWndProc(CM_PARENTSHOWHINTCHANGED);
|
|
end;
|
|
|
|
function TJvExScrollingWinControl.WantKey(Key: Integer; Shift: TShiftState; const KeyText: WideString): Boolean;
|
|
begin
|
|
Result := BaseWndProc(CM_DIALOGCHAR, Word(Key), ShiftStateToKeyData(Shift)) <> 0;
|
|
end;
|
|
|
|
function TJvExScrollingWinControl.HitTest(X, Y: Integer): Boolean;
|
|
begin
|
|
Result := BaseWndProc(CM_HITTEST, 0, SmallPointToLong(PointToSmallPoint(Point(X, Y)))) <> 0;
|
|
end;
|
|
|
|
function TJvExScrollingWinControl.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 TJvExScrollingWinControl.MouseEnter(AControl: TControl);
|
|
begin
|
|
FMouseOver := True;
|
|
if Assigned(FOnMouseEnter) then
|
|
FOnMouseEnter(Self);
|
|
BaseWndProc(CM_MOUSEENTER, 0, AControl);
|
|
end;
|
|
|
|
procedure TJvExScrollingWinControl.MouseLeave(AControl: TControl);
|
|
begin
|
|
FMouseOver := False;
|
|
BaseWndProc(CM_MOUSELEAVE, 0, AControl);
|
|
if Assigned(FOnMouseLeave) then
|
|
FOnMouseLeave(Self);
|
|
end;
|
|
|
|
procedure TJvExScrollingWinControl.FocusChanged(AControl: TWinControl);
|
|
begin
|
|
BaseWndProc(CM_FOCUSCHANGED, 0, AControl);
|
|
end;
|
|
|
|
procedure TJvExScrollingWinControl.BoundsChanged;
|
|
begin
|
|
end;
|
|
|
|
procedure TJvExScrollingWinControl.CursorChanged;
|
|
begin
|
|
BaseWndProc(CM_CURSORCHANGED);
|
|
end;
|
|
|
|
procedure TJvExScrollingWinControl.ShowingChanged;
|
|
begin
|
|
BaseWndProc(CM_SHOWINGCHANGED);
|
|
end;
|
|
|
|
procedure TJvExScrollingWinControl.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 TJvExScrollingWinControl.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 TJvExScrollingWinControl.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 TJvExScrollingWinControl.GetDlgCode(var Code: TDlgCodes);
|
|
begin
|
|
end;
|
|
|
|
procedure TJvExScrollingWinControl.FocusSet(PrevWnd: THandle);
|
|
begin
|
|
BaseWndProc(WM_SETFOCUS, Integer(PrevWnd), 0);
|
|
end;
|
|
|
|
procedure TJvExScrollingWinControl.FocusKilled(NextWnd: THandle);
|
|
begin
|
|
BaseWndProc(WM_KILLFOCUS, Integer(NextWnd), 0);
|
|
end;
|
|
|
|
function TJvExScrollingWinControl.DoEraseBackground(Canvas: TCanvas; Param: Integer): Boolean;
|
|
begin
|
|
Result := BaseWndProc(WM_ERASEBKGND, Canvas.Handle, Param) <> 0;
|
|
end;
|
|
|
|
{$IFDEF JVCLThemesEnabledD56}
|
|
function TJvExScrollingWinControl.GetParentBackground: Boolean;
|
|
begin
|
|
Result := JvThemes.GetParentBackground(Self);
|
|
end;
|
|
|
|
procedure TJvExScrollingWinControl.SetParentBackground(Value: Boolean);
|
|
begin
|
|
JvThemes.SetParentBackground(Self, Value);
|
|
end;
|
|
{$ENDIF JVCLThemesEnabledD56}
|
|
|
|
procedure TJvExScrollingWinControl.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 TJvExScrollBox.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FHintColor := clDefault;
|
|
end;
|
|
|
|
function TJvExScrollBox.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 TJvExScrollBox.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 TJvExScrollBox.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 TJvExScrollBox.VisibleChanged;
|
|
begin
|
|
BaseWndProc(CM_VISIBLECHANGED);
|
|
end;
|
|
|
|
procedure TJvExScrollBox.EnabledChanged;
|
|
begin
|
|
BaseWndProc(CM_ENABLEDCHANGED);
|
|
end;
|
|
|
|
procedure TJvExScrollBox.TextChanged;
|
|
begin
|
|
BaseWndProc(CM_TEXTCHANGED);
|
|
end;
|
|
|
|
procedure TJvExScrollBox.FontChanged;
|
|
begin
|
|
BaseWndProc(CM_FONTCHANGED);
|
|
end;
|
|
|
|
procedure TJvExScrollBox.ColorChanged;
|
|
begin
|
|
BaseWndProc(CM_COLORCHANGED);
|
|
end;
|
|
|
|
procedure TJvExScrollBox.ParentFontChanged;
|
|
begin
|
|
BaseWndProc(CM_PARENTFONTCHANGED);
|
|
end;
|
|
|
|
procedure TJvExScrollBox.ParentColorChanged;
|
|
begin
|
|
BaseWndProc(CM_PARENTCOLORCHANGED);
|
|
if Assigned(OnParentColorChange) then
|
|
OnParentColorChange(Self);
|
|
end;
|
|
|
|
procedure TJvExScrollBox.ParentShowHintChanged;
|
|
begin
|
|
BaseWndProc(CM_PARENTSHOWHINTCHANGED);
|
|
end;
|
|
|
|
function TJvExScrollBox.WantKey(Key: Integer; Shift: TShiftState; const KeyText: WideString): Boolean;
|
|
begin
|
|
Result := BaseWndProc(CM_DIALOGCHAR, Word(Key), ShiftStateToKeyData(Shift)) <> 0;
|
|
end;
|
|
|
|
function TJvExScrollBox.HitTest(X, Y: Integer): Boolean;
|
|
begin
|
|
Result := BaseWndProc(CM_HITTEST, 0, SmallPointToLong(PointToSmallPoint(Point(X, Y)))) <> 0;
|
|
end;
|
|
|
|
function TJvExScrollBox.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 TJvExScrollBox.MouseEnter(AControl: TControl);
|
|
begin
|
|
FMouseOver := True;
|
|
if Assigned(FOnMouseEnter) then
|
|
FOnMouseEnter(Self);
|
|
BaseWndProc(CM_MOUSEENTER, 0, AControl);
|
|
end;
|
|
|
|
procedure TJvExScrollBox.MouseLeave(AControl: TControl);
|
|
begin
|
|
FMouseOver := False;
|
|
BaseWndProc(CM_MOUSELEAVE, 0, AControl);
|
|
if Assigned(FOnMouseLeave) then
|
|
FOnMouseLeave(Self);
|
|
end;
|
|
|
|
procedure TJvExScrollBox.FocusChanged(AControl: TWinControl);
|
|
begin
|
|
BaseWndProc(CM_FOCUSCHANGED, 0, AControl);
|
|
end;
|
|
|
|
procedure TJvExScrollBox.BoundsChanged;
|
|
begin
|
|
end;
|
|
|
|
procedure TJvExScrollBox.CursorChanged;
|
|
begin
|
|
BaseWndProc(CM_CURSORCHANGED);
|
|
end;
|
|
|
|
procedure TJvExScrollBox.ShowingChanged;
|
|
begin
|
|
BaseWndProc(CM_SHOWINGCHANGED);
|
|
end;
|
|
|
|
procedure TJvExScrollBox.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 TJvExScrollBox.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 TJvExScrollBox.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 TJvExScrollBox.GetDlgCode(var Code: TDlgCodes);
|
|
begin
|
|
end;
|
|
|
|
procedure TJvExScrollBox.FocusSet(PrevWnd: THandle);
|
|
begin
|
|
BaseWndProc(WM_SETFOCUS, Integer(PrevWnd), 0);
|
|
end;
|
|
|
|
procedure TJvExScrollBox.FocusKilled(NextWnd: THandle);
|
|
begin
|
|
BaseWndProc(WM_KILLFOCUS, Integer(NextWnd), 0);
|
|
end;
|
|
|
|
function TJvExScrollBox.DoEraseBackground(Canvas: TCanvas; Param: Integer): Boolean;
|
|
begin
|
|
Result := BaseWndProc(WM_ERASEBKGND, Canvas.Handle, Param) <> 0;
|
|
end;
|
|
|
|
{$IFDEF JVCLThemesEnabledD56}
|
|
function TJvExScrollBox.GetParentBackground: Boolean;
|
|
begin
|
|
Result := JvThemes.GetParentBackground(Self);
|
|
end;
|
|
|
|
procedure TJvExScrollBox.SetParentBackground(Value: Boolean);
|
|
begin
|
|
JvThemes.SetParentBackground(Self, Value);
|
|
end;
|
|
{$ENDIF JVCLThemesEnabledD56}
|
|
|
|
procedure TJvExScrollBox.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 TJvExCustomFrame.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FHintColor := clDefault;
|
|
end;
|
|
|
|
function TJvExCustomFrame.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 TJvExCustomFrame.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 TJvExCustomFrame.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 TJvExCustomFrame.VisibleChanged;
|
|
begin
|
|
BaseWndProc(CM_VISIBLECHANGED);
|
|
end;
|
|
|
|
procedure TJvExCustomFrame.EnabledChanged;
|
|
begin
|
|
BaseWndProc(CM_ENABLEDCHANGED);
|
|
end;
|
|
|
|
procedure TJvExCustomFrame.TextChanged;
|
|
begin
|
|
BaseWndProc(CM_TEXTCHANGED);
|
|
end;
|
|
|
|
procedure TJvExCustomFrame.FontChanged;
|
|
begin
|
|
BaseWndProc(CM_FONTCHANGED);
|
|
end;
|
|
|
|
procedure TJvExCustomFrame.ColorChanged;
|
|
begin
|
|
BaseWndProc(CM_COLORCHANGED);
|
|
end;
|
|
|
|
procedure TJvExCustomFrame.ParentFontChanged;
|
|
begin
|
|
BaseWndProc(CM_PARENTFONTCHANGED);
|
|
end;
|
|
|
|
procedure TJvExCustomFrame.ParentColorChanged;
|
|
begin
|
|
BaseWndProc(CM_PARENTCOLORCHANGED);
|
|
if Assigned(OnParentColorChange) then
|
|
OnParentColorChange(Self);
|
|
end;
|
|
|
|
procedure TJvExCustomFrame.ParentShowHintChanged;
|
|
begin
|
|
BaseWndProc(CM_PARENTSHOWHINTCHANGED);
|
|
end;
|
|
|
|
function TJvExCustomFrame.WantKey(Key: Integer; Shift: TShiftState; const KeyText: WideString): Boolean;
|
|
begin
|
|
Result := BaseWndProc(CM_DIALOGCHAR, Word(Key), ShiftStateToKeyData(Shift)) <> 0;
|
|
end;
|
|
|
|
function TJvExCustomFrame.HitTest(X, Y: Integer): Boolean;
|
|
begin
|
|
Result := BaseWndProc(CM_HITTEST, 0, SmallPointToLong(PointToSmallPoint(Point(X, Y)))) <> 0;
|
|
end;
|
|
|
|
function TJvExCustomFrame.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 TJvExCustomFrame.MouseEnter(AControl: TControl);
|
|
begin
|
|
FMouseOver := True;
|
|
if Assigned(FOnMouseEnter) then
|
|
FOnMouseEnter(Self);
|
|
BaseWndProc(CM_MOUSEENTER, 0, AControl);
|
|
end;
|
|
|
|
procedure TJvExCustomFrame.MouseLeave(AControl: TControl);
|
|
begin
|
|
FMouseOver := False;
|
|
BaseWndProc(CM_MOUSELEAVE, 0, AControl);
|
|
if Assigned(FOnMouseLeave) then
|
|
FOnMouseLeave(Self);
|
|
end;
|
|
|
|
procedure TJvExCustomFrame.FocusChanged(AControl: TWinControl);
|
|
begin
|
|
BaseWndProc(CM_FOCUSCHANGED, 0, AControl);
|
|
end;
|
|
|
|
procedure TJvExCustomFrame.BoundsChanged;
|
|
begin
|
|
end;
|
|
|
|
procedure TJvExCustomFrame.CursorChanged;
|
|
begin
|
|
BaseWndProc(CM_CURSORCHANGED);
|
|
end;
|
|
|
|
procedure TJvExCustomFrame.ShowingChanged;
|
|
begin
|
|
BaseWndProc(CM_SHOWINGCHANGED);
|
|
end;
|
|
|
|
procedure TJvExCustomFrame.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 TJvExCustomFrame.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 TJvExCustomFrame.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 TJvExCustomFrame.GetDlgCode(var Code: TDlgCodes);
|
|
begin
|
|
end;
|
|
|
|
procedure TJvExCustomFrame.FocusSet(PrevWnd: THandle);
|
|
begin
|
|
BaseWndProc(WM_SETFOCUS, Integer(PrevWnd), 0);
|
|
end;
|
|
|
|
procedure TJvExCustomFrame.FocusKilled(NextWnd: THandle);
|
|
begin
|
|
BaseWndProc(WM_KILLFOCUS, Integer(NextWnd), 0);
|
|
end;
|
|
|
|
function TJvExCustomFrame.DoEraseBackground(Canvas: TCanvas; Param: Integer): Boolean;
|
|
begin
|
|
Result := BaseWndProc(WM_ERASEBKGND, Canvas.Handle, Param) <> 0;
|
|
end;
|
|
|
|
{$IFDEF JVCLThemesEnabledD56}
|
|
function TJvExCustomFrame.GetParentBackground: Boolean;
|
|
begin
|
|
Result := JvThemes.GetParentBackground(Self);
|
|
end;
|
|
|
|
procedure TJvExCustomFrame.SetParentBackground(Value: Boolean);
|
|
begin
|
|
JvThemes.SetParentBackground(Self, Value);
|
|
end;
|
|
{$ENDIF JVCLThemesEnabledD56}
|
|
|
|
procedure TJvExCustomFrame.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 TJvExFrame.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FHintColor := clDefault;
|
|
end;
|
|
|
|
function TJvExFrame.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 TJvExFrame.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 TJvExFrame.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 TJvExFrame.VisibleChanged;
|
|
begin
|
|
BaseWndProc(CM_VISIBLECHANGED);
|
|
end;
|
|
|
|
procedure TJvExFrame.EnabledChanged;
|
|
begin
|
|
BaseWndProc(CM_ENABLEDCHANGED);
|
|
end;
|
|
|
|
procedure TJvExFrame.TextChanged;
|
|
begin
|
|
BaseWndProc(CM_TEXTCHANGED);
|
|
end;
|
|
|
|
procedure TJvExFrame.FontChanged;
|
|
begin
|
|
BaseWndProc(CM_FONTCHANGED);
|
|
end;
|
|
|
|
procedure TJvExFrame.ColorChanged;
|
|
begin
|
|
BaseWndProc(CM_COLORCHANGED);
|
|
end;
|
|
|
|
procedure TJvExFrame.ParentFontChanged;
|
|
begin
|
|
BaseWndProc(CM_PARENTFONTCHANGED);
|
|
end;
|
|
|
|
procedure TJvExFrame.ParentColorChanged;
|
|
begin
|
|
BaseWndProc(CM_PARENTCOLORCHANGED);
|
|
if Assigned(OnParentColorChange) then
|
|
OnParentColorChange(Self);
|
|
end;
|
|
|
|
procedure TJvExFrame.ParentShowHintChanged;
|
|
begin
|
|
BaseWndProc(CM_PARENTSHOWHINTCHANGED);
|
|
end;
|
|
|
|
function TJvExFrame.WantKey(Key: Integer; Shift: TShiftState; const KeyText: WideString): Boolean;
|
|
begin
|
|
Result := BaseWndProc(CM_DIALOGCHAR, Word(Key), ShiftStateToKeyData(Shift)) <> 0;
|
|
end;
|
|
|
|
function TJvExFrame.HitTest(X, Y: Integer): Boolean;
|
|
begin
|
|
Result := BaseWndProc(CM_HITTEST, 0, SmallPointToLong(PointToSmallPoint(Point(X, Y)))) <> 0;
|
|
end;
|
|
|
|
function TJvExFrame.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 TJvExFrame.MouseEnter(AControl: TControl);
|
|
begin
|
|
FMouseOver := True;
|
|
if Assigned(FOnMouseEnter) then
|
|
FOnMouseEnter(Self);
|
|
BaseWndProc(CM_MOUSEENTER, 0, AControl);
|
|
end;
|
|
|
|
procedure TJvExFrame.MouseLeave(AControl: TControl);
|
|
begin
|
|
FMouseOver := False;
|
|
BaseWndProc(CM_MOUSELEAVE, 0, AControl);
|
|
if Assigned(FOnMouseLeave) then
|
|
FOnMouseLeave(Self);
|
|
end;
|
|
|
|
procedure TJvExFrame.FocusChanged(AControl: TWinControl);
|
|
begin
|
|
BaseWndProc(CM_FOCUSCHANGED, 0, AControl);
|
|
end;
|
|
|
|
procedure TJvExFrame.BoundsChanged;
|
|
begin
|
|
end;
|
|
|
|
procedure TJvExFrame.CursorChanged;
|
|
begin
|
|
BaseWndProc(CM_CURSORCHANGED);
|
|
end;
|
|
|
|
procedure TJvExFrame.ShowingChanged;
|
|
begin
|
|
BaseWndProc(CM_SHOWINGCHANGED);
|
|
end;
|
|
|
|
procedure TJvExFrame.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 TJvExFrame.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 TJvExFrame.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 TJvExFrame.GetDlgCode(var Code: TDlgCodes);
|
|
begin
|
|
end;
|
|
|
|
procedure TJvExFrame.FocusSet(PrevWnd: THandle);
|
|
begin
|
|
BaseWndProc(WM_SETFOCUS, Integer(PrevWnd), 0);
|
|
end;
|
|
|
|
procedure TJvExFrame.FocusKilled(NextWnd: THandle);
|
|
begin
|
|
BaseWndProc(WM_KILLFOCUS, Integer(NextWnd), 0);
|
|
end;
|
|
|
|
function TJvExFrame.DoEraseBackground(Canvas: TCanvas; Param: Integer): Boolean;
|
|
begin
|
|
Result := BaseWndProc(WM_ERASEBKGND, Canvas.Handle, Param) <> 0;
|
|
end;
|
|
|
|
{$IFDEF JVCLThemesEnabledD56}
|
|
function TJvExFrame.GetParentBackground: Boolean;
|
|
begin
|
|
Result := JvThemes.GetParentBackground(Self);
|
|
end;
|
|
|
|
procedure TJvExFrame.SetParentBackground(Value: Boolean);
|
|
begin
|
|
JvThemes.SetParentBackground(Self, Value);
|
|
end;
|
|
{$ENDIF JVCLThemesEnabledD56}
|
|
|
|
procedure TJvExFrame.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 TJvExToolWindow.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FHintColor := clDefault;
|
|
end;
|
|
|
|
function TJvExToolWindow.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 TJvExToolWindow.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 TJvExToolWindow.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 TJvExToolWindow.VisibleChanged;
|
|
begin
|
|
BaseWndProc(CM_VISIBLECHANGED);
|
|
end;
|
|
|
|
procedure TJvExToolWindow.EnabledChanged;
|
|
begin
|
|
BaseWndProc(CM_ENABLEDCHANGED);
|
|
end;
|
|
|
|
procedure TJvExToolWindow.TextChanged;
|
|
begin
|
|
BaseWndProc(CM_TEXTCHANGED);
|
|
end;
|
|
|
|
procedure TJvExToolWindow.FontChanged;
|
|
begin
|
|
BaseWndProc(CM_FONTCHANGED);
|
|
end;
|
|
|
|
procedure TJvExToolWindow.ColorChanged;
|
|
begin
|
|
BaseWndProc(CM_COLORCHANGED);
|
|
end;
|
|
|
|
procedure TJvExToolWindow.ParentFontChanged;
|
|
begin
|
|
BaseWndProc(CM_PARENTFONTCHANGED);
|
|
end;
|
|
|
|
procedure TJvExToolWindow.ParentColorChanged;
|
|
begin
|
|
BaseWndProc(CM_PARENTCOLORCHANGED);
|
|
if Assigned(OnParentColorChange) then
|
|
OnParentColorChange(Self);
|
|
end;
|
|
|
|
procedure TJvExToolWindow.ParentShowHintChanged;
|
|
begin
|
|
BaseWndProc(CM_PARENTSHOWHINTCHANGED);
|
|
end;
|
|
|
|
function TJvExToolWindow.WantKey(Key: Integer; Shift: TShiftState; const KeyText: WideString): Boolean;
|
|
begin
|
|
Result := BaseWndProc(CM_DIALOGCHAR, Word(Key), ShiftStateToKeyData(Shift)) <> 0;
|
|
end;
|
|
|
|
function TJvExToolWindow.HitTest(X, Y: Integer): Boolean;
|
|
begin
|
|
Result := BaseWndProc(CM_HITTEST, 0, SmallPointToLong(PointToSmallPoint(Point(X, Y)))) <> 0;
|
|
end;
|
|
|
|
function TJvExToolWindow.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 TJvExToolWindow.MouseEnter(AControl: TControl);
|
|
begin
|
|
FMouseOver := True;
|
|
if Assigned(FOnMouseEnter) then
|
|
FOnMouseEnter(Self);
|
|
BaseWndProc(CM_MOUSEENTER, 0, AControl);
|
|
end;
|
|
|
|
procedure TJvExToolWindow.MouseLeave(AControl: TControl);
|
|
begin
|
|
FMouseOver := False;
|
|
BaseWndProc(CM_MOUSELEAVE, 0, AControl);
|
|
if Assigned(FOnMouseLeave) then
|
|
FOnMouseLeave(Self);
|
|
end;
|
|
|
|
procedure TJvExToolWindow.FocusChanged(AControl: TWinControl);
|
|
begin
|
|
BaseWndProc(CM_FOCUSCHANGED, 0, AControl);
|
|
end;
|
|
|
|
procedure TJvExToolWindow.BoundsChanged;
|
|
begin
|
|
end;
|
|
|
|
procedure TJvExToolWindow.CursorChanged;
|
|
begin
|
|
BaseWndProc(CM_CURSORCHANGED);
|
|
end;
|
|
|
|
procedure TJvExToolWindow.ShowingChanged;
|
|
begin
|
|
BaseWndProc(CM_SHOWINGCHANGED);
|
|
end;
|
|
|
|
procedure TJvExToolWindow.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 TJvExToolWindow.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 TJvExToolWindow.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 TJvExToolWindow.GetDlgCode(var Code: TDlgCodes);
|
|
begin
|
|
end;
|
|
|
|
procedure TJvExToolWindow.FocusSet(PrevWnd: THandle);
|
|
begin
|
|
BaseWndProc(WM_SETFOCUS, Integer(PrevWnd), 0);
|
|
end;
|
|
|
|
procedure TJvExToolWindow.FocusKilled(NextWnd: THandle);
|
|
begin
|
|
BaseWndProc(WM_KILLFOCUS, Integer(NextWnd), 0);
|
|
end;
|
|
|
|
function TJvExToolWindow.DoEraseBackground(Canvas: TCanvas; Param: Integer): Boolean;
|
|
begin
|
|
Result := BaseWndProc(WM_ERASEBKGND, Canvas.Handle, Param) <> 0;
|
|
end;
|
|
|
|
{$IFDEF JVCLThemesEnabledD56}
|
|
function TJvExToolWindow.GetParentBackground: Boolean;
|
|
begin
|
|
Result := JvThemes.GetParentBackground(Self);
|
|
end;
|
|
|
|
procedure TJvExToolWindow.SetParentBackground(Value: Boolean);
|
|
begin
|
|
JvThemes.SetParentBackground(Self, Value);
|
|
end;
|
|
{$ENDIF JVCLThemesEnabledD56}
|
|
|
|
procedure TJvExToolWindow.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 TJvExCustomForm.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FHintColor := clDefault;
|
|
end;
|
|
|
|
function TJvExCustomForm.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 TJvExCustomForm.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 TJvExCustomForm.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 TJvExCustomForm.VisibleChanged;
|
|
begin
|
|
BaseWndProc(CM_VISIBLECHANGED);
|
|
end;
|
|
|
|
procedure TJvExCustomForm.EnabledChanged;
|
|
begin
|
|
BaseWndProc(CM_ENABLEDCHANGED);
|
|
end;
|
|
|
|
procedure TJvExCustomForm.TextChanged;
|
|
begin
|
|
BaseWndProc(CM_TEXTCHANGED);
|
|
end;
|
|
|
|
procedure TJvExCustomForm.FontChanged;
|
|
begin
|
|
BaseWndProc(CM_FONTCHANGED);
|
|
end;
|
|
|
|
procedure TJvExCustomForm.ColorChanged;
|
|
begin
|
|
BaseWndProc(CM_COLORCHANGED);
|
|
end;
|
|
|
|
procedure TJvExCustomForm.ParentFontChanged;
|
|
begin
|
|
BaseWndProc(CM_PARENTFONTCHANGED);
|
|
end;
|
|
|
|
procedure TJvExCustomForm.ParentColorChanged;
|
|
begin
|
|
BaseWndProc(CM_PARENTCOLORCHANGED);
|
|
if Assigned(OnParentColorChange) then
|
|
OnParentColorChange(Self);
|
|
end;
|
|
|
|
procedure TJvExCustomForm.ParentShowHintChanged;
|
|
begin
|
|
BaseWndProc(CM_PARENTSHOWHINTCHANGED);
|
|
end;
|
|
|
|
function TJvExCustomForm.WantKey(Key: Integer; Shift: TShiftState; const KeyText: WideString): Boolean;
|
|
begin
|
|
Result := BaseWndProc(CM_DIALOGCHAR, Word(Key), ShiftStateToKeyData(Shift)) <> 0;
|
|
end;
|
|
|
|
function TJvExCustomForm.HitTest(X, Y: Integer): Boolean;
|
|
begin
|
|
Result := BaseWndProc(CM_HITTEST, 0, SmallPointToLong(PointToSmallPoint(Point(X, Y)))) <> 0;
|
|
end;
|
|
|
|
function TJvExCustomForm.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 TJvExCustomForm.MouseEnter(AControl: TControl);
|
|
begin
|
|
FMouseOver := True;
|
|
if Assigned(FOnMouseEnter) then
|
|
FOnMouseEnter(Self);
|
|
BaseWndProc(CM_MOUSEENTER, 0, AControl);
|
|
end;
|
|
|
|
procedure TJvExCustomForm.MouseLeave(AControl: TControl);
|
|
begin
|
|
FMouseOver := False;
|
|
BaseWndProc(CM_MOUSELEAVE, 0, AControl);
|
|
if Assigned(FOnMouseLeave) then
|
|
FOnMouseLeave(Self);
|
|
end;
|
|
|
|
procedure TJvExCustomForm.FocusChanged(AControl: TWinControl);
|
|
begin
|
|
BaseWndProc(CM_FOCUSCHANGED, 0, AControl);
|
|
end;
|
|
|
|
procedure TJvExCustomForm.BoundsChanged;
|
|
begin
|
|
end;
|
|
|
|
procedure TJvExCustomForm.CursorChanged;
|
|
begin
|
|
BaseWndProc(CM_CURSORCHANGED);
|
|
end;
|
|
|
|
procedure TJvExCustomForm.ShowingChanged;
|
|
begin
|
|
BaseWndProc(CM_SHOWINGCHANGED);
|
|
end;
|
|
|
|
procedure TJvExCustomForm.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 TJvExCustomForm.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 TJvExCustomForm.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 TJvExCustomForm.GetDlgCode(var Code: TDlgCodes);
|
|
begin
|
|
end;
|
|
|
|
procedure TJvExCustomForm.FocusSet(PrevWnd: THandle);
|
|
begin
|
|
BaseWndProc(WM_SETFOCUS, Integer(PrevWnd), 0);
|
|
end;
|
|
|
|
procedure TJvExCustomForm.FocusKilled(NextWnd: THandle);
|
|
begin
|
|
BaseWndProc(WM_KILLFOCUS, Integer(NextWnd), 0);
|
|
end;
|
|
|
|
function TJvExCustomForm.DoEraseBackground(Canvas: TCanvas; Param: Integer): Boolean;
|
|
begin
|
|
Result := BaseWndProc(WM_ERASEBKGND, Canvas.Handle, Param) <> 0;
|
|
end;
|
|
|
|
{$IFDEF JVCLThemesEnabledD56}
|
|
function TJvExCustomForm.GetParentBackground: Boolean;
|
|
begin
|
|
Result := JvThemes.GetParentBackground(Self);
|
|
end;
|
|
|
|
procedure TJvExCustomForm.SetParentBackground(Value: Boolean);
|
|
begin
|
|
JvThemes.SetParentBackground(Self, Value);
|
|
end;
|
|
{$ENDIF JVCLThemesEnabledD56}
|
|
|
|
procedure TJvExCustomForm.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 TJvExCustomForm.CreateNew(AOwner: TComponent; Dummy: Integer);
|
|
begin
|
|
inherited CreateNew(AOwner, Dummy);
|
|
FHintColor := clDefault;
|
|
end;
|
|
|
|
procedure TJvExCustomForm.CMShowingChanged(var Msg: TMessage);
|
|
begin
|
|
if Showing then
|
|
SendMessage(Handle, WM_CHANGEUISTATE, UIS_INITIALIZE, 0);
|
|
inherited;
|
|
end;
|
|
|
|
procedure TJvExCustomForm.CMDialogKey(var Msg: TCMDialogKey);
|
|
begin
|
|
case Msg.CharCode of
|
|
VK_LEFT..VK_DOWN, VK_TAB:
|
|
SendMessage(Handle, WM_CHANGEUISTATE, MakeLong(UIS_CLEAR, UISF_HIDEFOCUS), 0);
|
|
VK_MENU:
|
|
SendMessage(Handle, WM_CHANGEUISTATE, MakeLong(UIS_CLEAR, UISF_HIDEFOCUS or UISF_HIDEACCEL), 0);
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
constructor TJvExForm.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FHintColor := clDefault;
|
|
end;
|
|
|
|
function TJvExForm.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 TJvExForm.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 TJvExForm.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 TJvExForm.VisibleChanged;
|
|
begin
|
|
BaseWndProc(CM_VISIBLECHANGED);
|
|
end;
|
|
|
|
procedure TJvExForm.EnabledChanged;
|
|
begin
|
|
BaseWndProc(CM_ENABLEDCHANGED);
|
|
end;
|
|
|
|
procedure TJvExForm.TextChanged;
|
|
begin
|
|
BaseWndProc(CM_TEXTCHANGED);
|
|
end;
|
|
|
|
procedure TJvExForm.FontChanged;
|
|
begin
|
|
BaseWndProc(CM_FONTCHANGED);
|
|
end;
|
|
|
|
procedure TJvExForm.ColorChanged;
|
|
begin
|
|
BaseWndProc(CM_COLORCHANGED);
|
|
end;
|
|
|
|
procedure TJvExForm.ParentFontChanged;
|
|
begin
|
|
BaseWndProc(CM_PARENTFONTCHANGED);
|
|
end;
|
|
|
|
procedure TJvExForm.ParentColorChanged;
|
|
begin
|
|
BaseWndProc(CM_PARENTCOLORCHANGED);
|
|
if Assigned(OnParentColorChange) then
|
|
OnParentColorChange(Self);
|
|
end;
|
|
|
|
procedure TJvExForm.ParentShowHintChanged;
|
|
begin
|
|
BaseWndProc(CM_PARENTSHOWHINTCHANGED);
|
|
end;
|
|
|
|
function TJvExForm.WantKey(Key: Integer; Shift: TShiftState; const KeyText: WideString): Boolean;
|
|
begin
|
|
Result := BaseWndProc(CM_DIALOGCHAR, Word(Key), ShiftStateToKeyData(Shift)) <> 0;
|
|
end;
|
|
|
|
function TJvExForm.HitTest(X, Y: Integer): Boolean;
|
|
begin
|
|
Result := BaseWndProc(CM_HITTEST, 0, SmallPointToLong(PointToSmallPoint(Point(X, Y)))) <> 0;
|
|
end;
|
|
|
|
function TJvExForm.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 TJvExForm.MouseEnter(AControl: TControl);
|
|
begin
|
|
FMouseOver := True;
|
|
if Assigned(FOnMouseEnter) then
|
|
FOnMouseEnter(Self);
|
|
BaseWndProc(CM_MOUSEENTER, 0, AControl);
|
|
end;
|
|
|
|
procedure TJvExForm.MouseLeave(AControl: TControl);
|
|
begin
|
|
FMouseOver := False;
|
|
BaseWndProc(CM_MOUSELEAVE, 0, AControl);
|
|
if Assigned(FOnMouseLeave) then
|
|
FOnMouseLeave(Self);
|
|
end;
|
|
|
|
procedure TJvExForm.FocusChanged(AControl: TWinControl);
|
|
begin
|
|
BaseWndProc(CM_FOCUSCHANGED, 0, AControl);
|
|
end;
|
|
|
|
procedure TJvExForm.BoundsChanged;
|
|
begin
|
|
end;
|
|
|
|
procedure TJvExForm.CursorChanged;
|
|
begin
|
|
BaseWndProc(CM_CURSORCHANGED);
|
|
end;
|
|
|
|
procedure TJvExForm.ShowingChanged;
|
|
begin
|
|
BaseWndProc(CM_SHOWINGCHANGED);
|
|
end;
|
|
|
|
procedure TJvExForm.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 TJvExForm.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 TJvExForm.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 TJvExForm.GetDlgCode(var Code: TDlgCodes);
|
|
begin
|
|
end;
|
|
|
|
procedure TJvExForm.FocusSet(PrevWnd: THandle);
|
|
begin
|
|
BaseWndProc(WM_SETFOCUS, Integer(PrevWnd), 0);
|
|
end;
|
|
|
|
procedure TJvExForm.FocusKilled(NextWnd: THandle);
|
|
begin
|
|
BaseWndProc(WM_KILLFOCUS, Integer(NextWnd), 0);
|
|
end;
|
|
|
|
function TJvExForm.DoEraseBackground(Canvas: TCanvas; Param: Integer): Boolean;
|
|
begin
|
|
Result := BaseWndProc(WM_ERASEBKGND, Canvas.Handle, Param) <> 0;
|
|
end;
|
|
|
|
{$IFDEF JVCLThemesEnabledD56}
|
|
function TJvExForm.GetParentBackground: Boolean;
|
|
begin
|
|
Result := JvThemes.GetParentBackground(Self);
|
|
end;
|
|
|
|
procedure TJvExForm.SetParentBackground(Value: Boolean);
|
|
begin
|
|
JvThemes.SetParentBackground(Self, Value);
|
|
end;
|
|
{$ENDIF JVCLThemesEnabledD56}
|
|
|
|
procedure TJvExForm.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 TJvExForm.CreateNew(AOwner: TComponent; Dummy: Integer);
|
|
begin
|
|
inherited CreateNew(AOwner, Dummy);
|
|
FHintColor := clDefault;
|
|
end;
|
|
|
|
procedure TJvExForm.CMShowingChanged(var Msg: TMessage);
|
|
begin
|
|
if Showing then
|
|
SendMessage(Handle, WM_CHANGEUISTATE, UIS_INITIALIZE, 0);
|
|
inherited;
|
|
end;
|
|
|
|
procedure TJvExForm.CMDialogKey(var Msg: TCMDialogKey);
|
|
begin
|
|
case Msg.CharCode of
|
|
VK_LEFT..VK_DOWN, VK_TAB:
|
|
SendMessage(Handle, WM_CHANGEUISTATE, MakeLong(UIS_CLEAR, UISF_HIDEFOCUS), 0);
|
|
VK_MENU:
|
|
SendMessage(Handle, WM_CHANGEUISTATE, MakeLong(UIS_CLEAR, UISF_HIDEFOCUS or UISF_HIDEACCEL), 0);
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
constructor TJvExCustomDockForm.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FHintColor := clDefault;
|
|
end;
|
|
|
|
function TJvExCustomDockForm.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 TJvExCustomDockForm.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 TJvExCustomDockForm.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 TJvExCustomDockForm.VisibleChanged;
|
|
begin
|
|
BaseWndProc(CM_VISIBLECHANGED);
|
|
end;
|
|
|
|
procedure TJvExCustomDockForm.EnabledChanged;
|
|
begin
|
|
BaseWndProc(CM_ENABLEDCHANGED);
|
|
end;
|
|
|
|
procedure TJvExCustomDockForm.TextChanged;
|
|
begin
|
|
BaseWndProc(CM_TEXTCHANGED);
|
|
end;
|
|
|
|
procedure TJvExCustomDockForm.FontChanged;
|
|
begin
|
|
BaseWndProc(CM_FONTCHANGED);
|
|
end;
|
|
|
|
procedure TJvExCustomDockForm.ColorChanged;
|
|
begin
|
|
BaseWndProc(CM_COLORCHANGED);
|
|
end;
|
|
|
|
procedure TJvExCustomDockForm.ParentFontChanged;
|
|
begin
|
|
BaseWndProc(CM_PARENTFONTCHANGED);
|
|
end;
|
|
|
|
procedure TJvExCustomDockForm.ParentColorChanged;
|
|
begin
|
|
BaseWndProc(CM_PARENTCOLORCHANGED);
|
|
if Assigned(OnParentColorChange) then
|
|
OnParentColorChange(Self);
|
|
end;
|
|
|
|
procedure TJvExCustomDockForm.ParentShowHintChanged;
|
|
begin
|
|
BaseWndProc(CM_PARENTSHOWHINTCHANGED);
|
|
end;
|
|
|
|
function TJvExCustomDockForm.WantKey(Key: Integer; Shift: TShiftState; const KeyText: WideString): Boolean;
|
|
begin
|
|
Result := BaseWndProc(CM_DIALOGCHAR, Word(Key), ShiftStateToKeyData(Shift)) <> 0;
|
|
end;
|
|
|
|
function TJvExCustomDockForm.HitTest(X, Y: Integer): Boolean;
|
|
begin
|
|
Result := BaseWndProc(CM_HITTEST, 0, SmallPointToLong(PointToSmallPoint(Point(X, Y)))) <> 0;
|
|
end;
|
|
|
|
function TJvExCustomDockForm.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 TJvExCustomDockForm.MouseEnter(AControl: TControl);
|
|
begin
|
|
FMouseOver := True;
|
|
if Assigned(FOnMouseEnter) then
|
|
FOnMouseEnter(Self);
|
|
BaseWndProc(CM_MOUSEENTER, 0, AControl);
|
|
end;
|
|
|
|
procedure TJvExCustomDockForm.MouseLeave(AControl: TControl);
|
|
begin
|
|
FMouseOver := False;
|
|
BaseWndProc(CM_MOUSELEAVE, 0, AControl);
|
|
if Assigned(FOnMouseLeave) then
|
|
FOnMouseLeave(Self);
|
|
end;
|
|
|
|
procedure TJvExCustomDockForm.FocusChanged(AControl: TWinControl);
|
|
begin
|
|
BaseWndProc(CM_FOCUSCHANGED, 0, AControl);
|
|
end;
|
|
|
|
procedure TJvExCustomDockForm.BoundsChanged;
|
|
begin
|
|
end;
|
|
|
|
procedure TJvExCustomDockForm.CursorChanged;
|
|
begin
|
|
BaseWndProc(CM_CURSORCHANGED);
|
|
end;
|
|
|
|
procedure TJvExCustomDockForm.ShowingChanged;
|
|
begin
|
|
BaseWndProc(CM_SHOWINGCHANGED);
|
|
end;
|
|
|
|
procedure TJvExCustomDockForm.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 TJvExCustomDockForm.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 TJvExCustomDockForm.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 TJvExCustomDockForm.GetDlgCode(var Code: TDlgCodes);
|
|
begin
|
|
end;
|
|
|
|
procedure TJvExCustomDockForm.FocusSet(PrevWnd: THandle);
|
|
begin
|
|
BaseWndProc(WM_SETFOCUS, Integer(PrevWnd), 0);
|
|
end;
|
|
|
|
procedure TJvExCustomDockForm.FocusKilled(NextWnd: THandle);
|
|
begin
|
|
BaseWndProc(WM_KILLFOCUS, Integer(NextWnd), 0);
|
|
end;
|
|
|
|
function TJvExCustomDockForm.DoEraseBackground(Canvas: TCanvas; Param: Integer): Boolean;
|
|
begin
|
|
Result := BaseWndProc(WM_ERASEBKGND, Canvas.Handle, Param) <> 0;
|
|
end;
|
|
|
|
{$IFDEF JVCLThemesEnabledD56}
|
|
function TJvExCustomDockForm.GetParentBackground: Boolean;
|
|
begin
|
|
Result := JvThemes.GetParentBackground(Self);
|
|
end;
|
|
|
|
procedure TJvExCustomDockForm.SetParentBackground(Value: Boolean);
|
|
begin
|
|
JvThemes.SetParentBackground(Self, Value);
|
|
end;
|
|
{$ENDIF JVCLThemesEnabledD56}
|
|
|
|
procedure TJvExCustomDockForm.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 TJvExCustomDockForm.CreateNew(AOwner: TComponent; Dummy: Integer);
|
|
begin
|
|
inherited CreateNew(AOwner, Dummy);
|
|
FHintColor := clDefault;
|
|
end;
|
|
|
|
procedure TJvExCustomDockForm.CMShowingChanged(var Msg: TMessage);
|
|
begin
|
|
if Showing then
|
|
SendMessage(Handle, WM_CHANGEUISTATE, UIS_INITIALIZE, 0);
|
|
inherited;
|
|
end;
|
|
|
|
procedure TJvExCustomDockForm.CMDialogKey(var Msg: TCMDialogKey);
|
|
begin
|
|
case Msg.CharCode of
|
|
VK_LEFT..VK_DOWN, VK_TAB:
|
|
SendMessage(Handle, WM_CHANGEUISTATE, MakeLong(UIS_CLEAR, UISF_HIDEFOCUS), 0);
|
|
VK_MENU:
|
|
SendMessage(Handle, WM_CHANGEUISTATE, MakeLong(UIS_CLEAR, UISF_HIDEFOCUS or UISF_HIDEACCEL), 0);
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
{$IFDEF UNITVERSIONING}
|
|
initialization
|
|
RegisterUnitVersion(HInstance, UnitVersioning);
|
|
|
|
finalization
|
|
UnregisterUnitVersion(HInstance);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
end. |