Class TPGSubclass (unit PGSubCls) |
Inherits from
TComponent
function SubclassCount: Integer;
Counts the number of TPGSubclass controls that are subclassing the current } { target control.
function TopSubclass: TPGSubclass;
procedure DefaultHandler(var Message);
This routine is called whenever a component is sent a message that } { it has not defined a method for.
destructor Destroy;
function FindComponentByClass(Source: TComponent; AClassType: TComponentClass): Boolean;
procedure OldWndProc(var Message: TMessage);
Provides a safe way to call the old windows procedure.
function Perform(Msg, WParam: Word; LParam: Longint): Longint;
procedure RestoreSubclass(Sender: TObject);
Event called by a timer to restore subclassing that was } { stopped when the window was recreated.
procedure SetActive(AnActive:Boolean);
procedure SetControl(AControl:TWinControl);
PGAssert(FActive <> AnActive, 'Assert: Subclassing already Active !!!');
procedure Start;
procedure Stop;
Install the new window function.
procedure UpdateWndProcs(ASubclass: TPGSubclass);
Send the update message to the target control.
procedure WndProc(var Message:TMessage);
Since this control is used to subclass windowed controls, we have to } { simulate a windows procedure for this control to receive the messages } { intended for the target control.
property TargetControl : TWinControl
property Active : Boolean
BottomSubclass : TPGSubclass;
CurrentTargetControlHandle : THandle;
FActive : Boolean;
FOldWndProc : TFarProc;
FTargetControl : TWinControl;
RestoreSubclassTimer : TTimer;
SubclassInstance : TFarProc;
function SubclassCount: Integer;
Counts the number of TPGSubclass controls that are subclassing the current } { target control.
function TopSubclass: TPGSubclass;
procedure DefaultHandler(var Message);
This routine is called whenever a component is sent a message that } { it has not defined a method for. In our case, if we haven't defined } { anything for our component to do specifically, then we should call the } { original controls window procedure to let it do any special processing } { that it may have defined. If it didn't define a method for this message } { either, then the message will get passed onto the DefaultHandler of } { TObject, which usually does nothing.
destructor Destroy;
function FindComponentByClass(Source: TComponent; AClassType: TComponentClass): Boolean;
procedure OldWndProc(var Message: TMessage);
Provides a safe way to call the old windows procedure.
function Perform(Msg, WParam: Word; LParam: Longint): Longint;
procedure RestoreSubclass(Sender: TObject);
Event called by a timer to restore subclassing that was } { stopped when the window was recreated.
procedure SetActive(AnActive:Boolean);
procedure SetControl(AControl:TWinControl);
PGAssert(FActive <> AnActive, 'Assert: Subclassing already Active !!!');
procedure Start;
procedure Stop;
Install the new window function.
procedure UpdateWndProcs(ASubclass: TPGSubclass);
Send the update message to the target control. This will accomplish: } { 1. Any Subclass controls that have their old windows procedure pointing } { at this controls new windows procedure will have this member updated } { to point to the next windows procedure in the list.
procedure WndProc(var Message:TMessage);
Since this control is used to subclass windowed controls, we have to } { simulate a windows procedure for this control to receive the messages } { intended for the target control. Note that the "Dispatch" method takes } { care of figuring out whether or not a method has been assigned for any } { received messages, and whether or not it should pass the message onto } { the default message handler, "DefaultHandler".
property TargetControl : TWinControl
property Active : Boolean
BottomSubclass : TPGSubclass;
CurrentTargetControlHandle : THandle;
FActive : Boolean;
FOldWndProc : TFarProc;
FTargetControl : TWinControl;
RestoreSubclassTimer : TTimer;
SubclassInstance : TFarProc;