Class TPGSubclass (unit PGSubCls)

Inherits from

TComponent

Constructors



Functions

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.

Properties

property TargetControl : TWinControl


property Active : Boolean


Events

Variables

BottomSubclass : TPGSubclass;


CurrentTargetControlHandle : THandle;


FActive : Boolean;


FOldWndProc : TFarProc;


FTargetControl : TWinControl;


RestoreSubclassTimer : TTimer;


SubclassInstance : TFarProc;



Constructors


Functions


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".


Properties


property TargetControl : TWinControl


property Active : Boolean


Events


Variables


BottomSubclass : TPGSubclass;


CurrentTargetControlHandle : THandle;


FActive : Boolean;


FOldWndProc : TFarProc;


FTargetControl : TWinControl;


RestoreSubclassTimer : TTimer;


SubclassInstance : TFarProc;