【delphi开源代码栏目提醒】:网学会员--在 delphi开源代码编辑为广大网友搜集整理了:EXTVCL.PAS绩等信息,祝愿广大网友取得需要的信息,参考学习。
{*******************************************************}
{ }
{
Delphi Visual Component Library Extension }
{ }
{ Copyright (c) 1996 Louis L.J.Wang }
{ }
{*******************************************************}
unit ExtVCL;
{$R-}
interface
uses
SysUtils, Windows, Messages, Classes, Controls, Forms;
const
{ TResizeControl control messages }
RSM_BASE = $AF80;
{ RSM_GETSETLIMITS, controls can send this message to a TResizeControl
to set new limits or get the current limits. Since TResizeControl is
NOT a windowed control but a spy of its HOST control, you should pass
this message to its associated control, TResizeControl will intercept
this message.
The 'Get' request is processed BEFORE the 'Set' request, so the result
value will be the original settings if you specify 'Set' and 'Get' at
the same time.
For the 'Get' request, the minimum limit is returned in the lower order
word of the result, while the maximum limit is returned in the higher
order
word, and the LIMIT_GETWIDTHLIMITS flag has higher priority than
the LIMIT_GETHEIGHTLIMITS, therefore the result will be WIDTH LIMITS if
you set them all together. }
RSM_GETSETLIMITS = RSM_BASE + 0;
{ TResizeControl notification messages }
RSN_BASE = $AF90;
{ RSN_SIZE, TResizeControl broadcast this notification message to all
windowed controls of its host control if WM_SIZE message is received,
along with the original and the new Width/Height of the host control. }
RSN_SIZE = RSN_BASE + 0;
{ bitfield constants for Flags field of GetSetFlags }
LIMIT_GETWIDTHLIMITS = $00000001;
LIMIT_GETHEIGHTLIMITS = $00000002;
LIMIT_SETWIDTHMIN = $00000004;
LIMIT_SETWIDTHMAX = $00000008;
LIMIT_SETHEIGHTMIN = $00000010;
LIMIT_SETHEIGHTMAX = $00000020;
{ Message structures }
type
TResizeLimit = -1..MaxInt;
{ structure for fpSetLimits }
PSetLimitsParams = ^TSetLimitsParams;
TSetLimitsParams = record
dwWidthMin: TResizeLimit;
dwWidthMax: TResizeLimit;
dwHeightMin: TResizeLimit;
dwHeightMax: TResizeLimit;
end;
{ structure for fpResizingInfo }
PSizeInfo = ^TSizeInfo;
TSizeInfo = record
OriginWidth: Integer;
OriginHeight: Integer;
NewWidth: Integer;
NewHeight: Integer;
end;
{ message for RSM_GETSETLIMITS }
TRSMGetSetLimits = record
Msg: Cardinal;
GetSetFlags: Integer;
fpSetLimits: PSetLimitsParams;
Result: Longint;
end;
TRSNSize = record
Msg: Cardinal;
SizeType: Longint; { same as TWMSize }
fpSizeInfo: PSizeInfo;
Result: Longint;
end;
{ Event types not defined in VCL }
TMsgSource = (msBroadcast, msWindow);
TMsgEvent = procedure(Control: TWinControl; var Message: TMessage;
Source: TMsgSource; var Handled: Boolean) of object;
{ TCustomSpy }
TCustomSpy = class(TComponent)
private
FObjectInstance: Pointer;
FHostWndProc: Pointer;
FHostDefWndProc: Pointer;
FHostWndMethod: TWndMethod;
FControl: TWinControl;
FIsWindowMessage: Boolean;
FOnMessage: TMsgEvent;
function GetControl: TWinControl;
procedure SetControl(AControl: TWinControl);
protected
procedure Loaded; override;
procedure Invalidate; virtual;
procedure MainWndProc(var Message: TMessage);
procedure WndProc(var Message: TMessage); virtual;
procedure DefaultHandler(var Message: TMessage); virtual;
procedure WMNCDestroy(var Message: TWMNCDestroy); message WM_NCDESTROY;
property Control: TWinControl read GetControl write SetControl;
property OnMessage: TMsgEvent read FOnMessage write FOnMessage;
public
procedure HookHost;
procedure UnhookHost;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
{ TWinControlSpy }
TWinControlSpy = class(TCustomSpy)
published
property Control;
property OnMessage;
end;
{ TResizeControl }
const
rcFixed = -1;
rcFree = 0;
rcRange = 1;
type
TResizeStyle = set of (rsFixed, rsLimitMin, rsLimitMax);
TResizeControl = class(TCustomSpy)
private
FLimits: array[0..3] of TResizeLimit;
FOriginWidth: Integer;
FOriginHeight: Integer;
function GetLimit(Index: Integer): TResizeLimit;
procedure SetLimit(Index: Integer; Value: TResizeLimit);
function GetWidthStyle: TResizeStyle;
function GetHeightStyle: TResizeStyle;
procedure WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo); message WM_GETMINMAXINFO;
procedure WMSize(var Message: TWMSize); message WM_SIZE;
procedure RSMGetSetLimits(var Message: TRSMGetSetLimits); message RSM_GETSETLIMITS;
protected
procedure Invalidate; override;
pu