控件1:CompCtrl.pas
这个控件的操作方式比较有趣.
用法:在Form上放一个该控件,然后响应其OnChange事件,其Ctrl表示
当前鼠标所在控件.如果允许控件改变大小/改变位置/提到最前面,
就将相应属性(EnableMove,EnableSize,EnableFront)设为true.
运行时,将鼠标放在要改变的控件上:
按住Shift不放,移动鼠标,控件就会跟着鼠标移动;
按住Ctel不放,移动鼠标,控件就会跟着鼠标的移动改变大小;
按F12,控件就提到最前面.
{ Component "CompCtrl V2.0" is a non-visual component witch enables moving and
resizing visible and enabled controls on all application-forms at runtime.
OnControlChange signals the component under mousecursor.
Udo Juerss
57078 Siegen, Germany
April 1999
e-mail: ujhs@aol.com
Only four properties:
EnableMove: boolean; enables moving the control (under mousecursor) by pressing
shift-key and moving the mouse.
EnableSize: boolean; enables sizing the control (under mousecursor) by pressing
ctrl-key and moving the mouse.
EnableFront: boolean; enables bringing to front the control (under mousecursor)
by pressing F12.
OnChange: TControlChange; enables to retrieve the component on witch the
mouse moves. If none, it returns the Form.
(Nice option to feed an own debugger window with
component data at runtime)
Hint: You can disable handling of a single control by setting its property
"Tag" to a nonzero value.
It磗 easy to change control-keys for moving, sizing or fronting by
assigning other VK_xxx codes to VK_MOVE, VK_SIZE and VK_FRONT.
}
unit
CompCtrl;
interface
{------------------------------------------------------------------------------}
uses
Windows,Messages,Classes,Forms,Dialogs,Controls,StdCtrls;
{------------------------------------------------------------------------------}
type
TControlChange = procedure(Sender: TObject; Ctrl: TControl) of object;
TCompCtrl = class(TComponent)
private
FEnableMove: boolean;
FEnableSize: boolean;
FEnableFront: boolean;
FOnChange: TControlChange;
protected
procedure SetBool(Index: Integer; Value: boolean);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property EnableMove: boolean index 0 read FEnableMove write SetBool;
property EnableSize: boolean index 1 read FEnableSize write SetBool;
property EnableFront: boolean index 2 read FEnableFront write SetBool;
property OnChange: TControlChange read FOnChange write FOnChange;
end;
{------------------------------------------------------------------------------}
implementation
{------------------------------------------------------------------------------}
const
VK_MOVE = VK_SHIFT;
VK_SIZE = VK_CONTROL;
VK_FRONT = VK_F12;
{------------------------------------------------------------------------------}
var
ParentForm: TCustomForm;
MouseHandle: HHook;
KeyHandle: HHook;
MoveEnable: boolean;
SizeEnable: boolean;
FrontEnable: boolean;
Moving: boolean;
Sizing: boolean;
Fronting: boolean;
FindBusy: boolean;
Cursor: TCursor;
ActPt: TPoint;
LastPt: TPoint;
FControl: TControl;
VControl: TControl;
ChildVControl: TControl;
CCtrl: TCompCtrl;
{------------------------------------------------------------------------------}
function MouseHookCallBack(Code: Integer; Msg: WPARAM; Mouse: LPARAM): LRESULT; stdcall;
begin
if Code >= 0 then
begin
ParentForm:=Screen.ActiveCustomForm;
if Assigned(ParentForm) then
begin
if not FindBusy and not (Moving or Sizing or Fronting) then
begin
FindBusy:=True;
if (Msg = WM_MOUSEMOVE) or (Msg = WM_NCMOUSEMOVE) then
begin
ActPt:=PMouseHookStruct(Mouse)^.Pt;
ActPt:=ParentForm.ScreenToClient(ActPt);
end
else
begin
GetCursorPos(ActPt);
ActPt:=ParentForm.ScreenToClient(ActPt);
end;
VControl:=ParentForm.ControlAtPos(ActPt,False);
if (VControl = nil) then
begin
ActPt:=ParentForm.ClientToScreen(ActPt);
VControl:=FindVCLWindow(ActPt);
if (VControl <> nil) and (VControl <> ParentForm) then
begin
ActPt:=VControl.ScreenToClient(ActPt);
ChildVControl:=TWinControl(VControl).ControlAtPos(ActPt,False);
if (ChildVControl <> nil) then VControl:=ChildVControl;
end;
end;
if (FControl <> VControl) then
begin
if Assigned(TCompCtrl(CCtrl).FOnChange) then
TCompCtrl(CCtrl).FOnChange(nil,VControl);
FControl:=VControl;
end;
FindBusy:=False;
end;
end;
if Assigned(FControl) and (FControl.Tag = 0) and
(Msg = WM_MOUSEMOVE) and (Moving or Sizing) then
begin
ActPt:=PMouseHookStruct(Mouse)^.Pt;
if Moving then
begin
FControl.Left:=FControl.Left + ActPt.X - LastPt.X;
FControl.Top:=FControl.Top + ActPt.Y - LastPt.Y;
end
else if Sizing then
begin
FControl.Width:=FControl.Width + ActPt.X - LastPt.X;
FControl.Height:=FControl.Height + ActPt.Y - LastPt.Y;
end;
LastPt:=ActPt;
end;
end;
Result:=CallNextHookEx(MouseHandle,Code,Msg,Mouse);
end;
{------------------------------------------------------------------------------}
function KeyHookCallBack(Code: Integer; VK: WPARAM; Key: LPARAM): LRESULT; stdcall;
begin
if (Code >= 0) and Assigned(ParentForm) then
begin
if VK = VK_MOVE then
begin
if (HiWord(Key) and KF_UP = 0) and MoveEnable and not (Moving or Sizing) then
begin
Moving:=True;
Cursor:=Screen.Cursor;
Screen.Cursor:=crSizeAll;
GetCursorPos(LastPt);
end;
if (HiWord(Key) and KF_UP = KF_UP) and Moving then
begin
Moving:=False;
Screen.Cursor:=Cursor;
end;
end;
if VK = VK_SIZE then
begin
if (HiWord(Key) and KF_UP = 0) and SizeEnable and not (Moving or Sizing) then
begin
Sizing:=True;
Cursor:=Screen.Cursor;
Screen.Cursor:=crSizeAll;
GetCursorPos(LastPt);
end;
if (HiWord(Key) and KF_UP = KF_UP) and Sizing then
begin
Sizing:=False;
Screen.Cursor:=Cursor;
end;
end;
if VK = VK_FRONT then
begin
if (HiWord(Key) and KF_UP = 0) and FrontEnable then
FControl.BringToFront;
end;
end;
Result:=CallNextHookEx(KeyHandle,Code,VK,Key);
end;
{------------------------------------------------------------------------------}
constructor TCompCtrl.Create(AOwner: TComponent);
var
AppName: array[0..127] of Char;
HModule: THandle;
begin
inherited;
FEnableMove:=True;
FEnableSize:=True;
FEnableFront:=True;
MoveEnable:=True;
SizeEnable:=True;
FrontEnable:=True;
CCtrl:=Self;
MouseHandle:=0;
KeyHandle:=0;
if not (csDesigning in ComponentState) then
begin
if GetModuleFileName(HInstance,AppName,Pred(SizeOf(AppName))) > 0 then
begin
HModule:=GetModuleHandle(AppName);
if HModule > 0 then
begin
MouseHandle:=SetWindowsHookEx(WH_MOUSE,MouseHookCallBack,HModule,GetCurrentThreadID);
KeyHandle:=SetWindowsHookEx(WH_KEYBOARD,KeyHookCallBack,HModule,GetCurrentThreadID);
end;
end;
if (MouseHandle = 0) or (KeyHandle = 0) then ShowMessage('Threadhook failed!');
end;
end;
{------------------------------------------------------------------------------}
destructor TCompCtrl.Destroy;
begin
if MouseHandle <> 0 then UnhookWindowsHookEx(MouseHandle);
if KeyHandle <> 0 then UnhookWindowsHookEx(KeyHandle);
inherited;
end;
{------------------------------------------------------------------------------}
procedure TCompCtrl.SetBool(Index: Integer; Value: boolean);
begin
case Index of
0: begin
FEnableMove:=Value;
MoveEnable:=Value;
end;
1: begin
FEnableSize:=Value;
SizeEnable:=Value;
end;
2: begin
FEnableFront:=Value;
FrontEnable:=Value;
end;
end;
end;
{------------------------------------------------------------------------------}
end.
控件2
ropertyInspector.pas
这个控件好象只能显示各控件的属性,我没用过.
{ Component "PropertyInspector V1.0" is a non-visual component for viewing
properties of every TControl at runtime. Works on all application forms.
Can be controlled by mouse/keyboard or program.
Udo Juerss
57078 Siegen, Germany
April 1999
e-mail: ujhs@aol.com
Only three properties:
StayOnTop: Bool; Formstyle for the property form.
UpdateInterval: Cardinal; Interval of property updates.
OnChange: TControlChange; enables to retrieve the component on witch the
mouse moves. (only in unlocked state)
How to do: 1. Put a component "PropertyInspector" on your form.
2. Set "UpdateInterval" and "StayOnTop" for your needs.
3. Start application.
4. Move the mouse over the control you want to retrieve.
5. Press "F12" to lock the control.
Now the properties of the selected control are updated at the
"UpdateInterval" rate.
Press "F11" to toggle show/hide the PropertyForm.
Press "F12" to toggle lock/unlock the controlselect.
If you wnat to view a property like "Width" witch is located at
the end of the listbox, then you can select an item above "Width".
This item gets the TopIndex for all next updates - so you must not
scroll every time.
Hints: "PropertyInspector" can be controlled by program with public methods:
procedure Lock(State: Bool);
procedure SetControl(AControl: TControl);
procedure Update(Sender: TObject);
Example:
Call once at program startup: PropertyInspector1.Lock(True)
(this disables mouseselect ["F12" selects again])
Select the control to inspect: PropertyInspector1.SetControl(Button1);
Whereever you want: PropertyInspector1.Update(nil); or
PropertyInspector1.Update(Self);
If you call Update(Self) then program stops after property update and
waits until "VK_WAIT" key is pressed. While in waitstate the cursor
is set to hourglass to signal this state.
Update(nil) does not wait after property update.
It磗 easy to change control-keys for locking, showing and waiting by
assigning other VK_xxx codes to VK_LOCK, VK_SHOW and VK_WAIT.
Limits in this version: no subclassing and no methodretrieve.
}
unit
PropertyInspector;
interface
{------------------------------------------------------------------------------}
uses
Windows,Messages,Classes,Forms,Dialogs,Controls,StdCtrls,ExtCtrls;
{------------------------------------------------------------------------------}
const
VK_LOCK = VK_F12;
VK_SHOW = VK_F11;
VK_WAIT = VK_SPACE;
{------------------------------------------------------------------------------}
type
TPropertyForm = class(TForm)
public
ListBox: TListBox;
constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); override;
destructor Destroy; override;
procedure OnListBoxClick(Sender: TObject);
end;
TControlChange = procedure(Sender: TObject; Ctrl: TControl) of object;
TPropertyInspector = class(TComponent)
private
FPropForm: TPropertyForm;
FTimer: TTimer;
FStayOnTop: Bool;
FUpdateInterval: Cardinal;
FOnChange: TControlChange;
protected
procedure SetStayOnTop(Value: Bool);
procedure SetUpdateInterval(Value: Cardinal);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Lock(State: Bool);
procedure SetControl(AControl: TControl);
procedure Update(Sender: TObject);
published
property StayOnTop: Bool read FStayOnTop write SetStayOnTop;
property UpdateInterval: Cardinal read FUpdateInterval write SetUpdateInterval;
property OnChange: TControlChange read FOnChange write FOnChange;
end;
{------------------------------------------------------------------------------}
procedure GetProperties(Comp: TComponent; List: TStrings);
{------------------------------------------------------------------------------}
implementation
{------------------------------------------------------------------------------}
uses
SysUtils,Graphics,TypInfo;
{------------------------------------------------------------------------------}
const
tkProps = [tkUnknown,tkInteger,tkChar,tkEnumeration,tkFloat,tkString,tkSet,
tkClass,tkMethod,tkWChar,tkLString,tkWString,tkVariant];
{------------------------------------------------------------------------------}
var
ParentForm: TCustomForm;
PropForm: TPropertyForm;
MouseHandle: HHook;
KeyHandle: HHook;
Locked: Bool;
FindBusy: Bool;
TopItem: Integer;
MousePt: TPoint;
FControl: TControl;
VControl: TControl;
ChildVControl: TControl;
PropInspector: TPropertyInspector;
{------------------------------------------------------------------------------}
function MouseHookCallBack(Code: Integer; Msg: WPARAM; Mouse: LPARAM): LRESULT; stdcall;
begin
if (Code >= 0) and not Locked then
begin
ParentForm:=Screen.ActiveCustomForm;
if Assigned(ParentForm) then
begin
if not FindBusy then
begin
FindBusy:=True;
if (Msg = WM_MOUSEMOVE) or (Msg = WM_NCMOUSEMOVE) then
begin
MousePt:=PMouseHookStruct(Mouse)^.Pt;
MousePt:=ParentForm.ScreenToClient(MousePt);
end
else
begin
GetCursorPos(MousePt);
MousePt:=ParentForm.ScreenToClient(MousePt);
end;
VControl:=ParentForm.ControlAtPos(MousePt,False);
if (VControl = nil) then
begin
MousePt:=ParentForm.ClientToScreen(MousePt);
VControl:=FindVCLWindow(MousePt);
if (VControl <> nil) and (VControl <> ParentForm) then
begin
MousePt:=VControl.ScreenToClient(MousePt);
ChildVControl:=TWinControl(VControl).ControlAtPos(MousePt,False);
if (ChildVControl <> nil) then VControl:=ChildVControl;
end;
end;
if (FControl <> VControl) and (VControl <> PropInspector.FPropForm)
and (VControl <> PropInspector.FPropForm.ListBox) then
begin
if Assigned(PropInspector) then PropInspector.Update(nil);
if Assigned(PropInspector.FOnChange) then PropInspector.FOnChange(nil,VControl);
FControl:=VControl;
end;
FindBusy:=False;
end;
end;
end;
Result:=CallNextHookEx(MouseHandle,Code,Msg,Mouse);
end;
{------------------------------------------------------------------------------}
function KeyHookCallBack(Code: Integer; VK: WPARAM; Key: LPARAM): LRESULT; stdcall;
begin
if Code >= 0 then
begin
if Assigned(PropInspector) and (VK = VK_LOCK) and (HiWord(Key) and KF_UP = 0) then
begin
Locked:=not Locked;
if Locked then PropInspector.FTimer.Enabled:=True
else PropInspector.FTimer.Enabled:=False;
end;
if (VK = VK_SHOW) and (HiWord(Key) and KF_UP = 0) and Assigned(PropForm) then
PropForm.Visible:=not PropForm.Visible;
end;
Result:=CallNextHookEx(KeyHandle,Code,VK,Key);
end;
{------------------------------------------------------------------------------}
constructor TPropertyInspector.Create(AOwner: TComponent);
var
AppName: array[0..127] of Char;
HModule: THandle;
begin
inherited;
FPropForm:=TPropertyForm.CreateNew(nil);
PropForm:=FPropForm;
FTimer:=TTimer.Create(nil);
FTimer.Enabled:=False;
FTimer.OnTimer:=Update;
FTimer.Interval:=50;
FUpdateInterval:=50;
StayOnTop:=True;
PropInspector:=Self;
MouseHandle:=0;
KeyHandle:=0;
Locked:=False;
if not (csDesigning in ComponentState) then
begin
if GetModuleFileName(HInstance,AppName,Pred(SizeOf(AppName))) > 0 then
begin
HModule:=GetModuleHandle(AppName);
if HModule > 0 then
begin
MouseHandle:=SetWindowsHookEx(WH_MOUSE,MouseHookCallBack,HModule,GetCurrentThreadID);
KeyHandle:=SetWindowsHookEx(WH_KEYBOARD,KeyHookCallBack,HModule,GetCurrentThreadID);
FPropForm.Show;
end;
end;
if (MouseHandle = 0) or (KeyHandle = 0) then ShowMessage('Threadhook failed!');
end;
end;
{------------------------------------------------------------------------------}
destructor TPropertyInspector.Destroy;
begin
FPropForm.Free;
FTimer.Free;
if MouseHandle <> 0 then UnhookWindowsHookEx(MouseHandle);
if KeyHandle <> 0 then UnhookWindowsHookEx(KeyHandle);
ParentForm:=nil;
PropForm:=nil;
inherited;
end;
{------------------------------------------------------------------------------}
procedure TPropertyInspector.SetStayOnTop(Value: Bool);
begin
if Value <> FStayOnTop then
begin
FStayOnTop:=Value;
if Assigned(FPropForm) then if Value then FPropForm.FormStyle:=fsStayOnTop
else FPropForm.FormStyle:=fsNormal;
end;
end;
{------------------------------------------------------------------------------}
procedure TPropertyInspector.SetUpdateInterval(Value: Cardinal);
begin
if Value > 9 then
begin
FUpdateInterval:=Value;
FTimer.Interval:=Value;
end;
end;
{------------------------------------------------------------------------------}
procedure TPropertyInspector.Update(Sender: TObject);
var
Cursor: TCursor;
begin
if Assigned(PropForm) then
begin
FPropForm.ListBox.Items.BeginUpdate;
GetProperties(VControl,PropInspector.FPropForm.ListBox.Items);
FPropForm.ListBox.TopIndex:=TopItem;
FPropForm.ListBox.Items.EndUpdate;
end;
if Assigned(Sender) and not (TObject(Sender) is TTimer) then
begin
Cursor:=Screen.Cursor;
Screen.Cursor:=crHourGlass;
repeat until GetAsyncKeyState(VK_WAIT) and KF_UP = KF_UP;
Screen.Cursor:=Cursor;
end;
end;
{------------------------------------------------------------------------------}
procedure TPropertyInspector.Lock(State: Bool);
begin
Locked:=State;
end;
{------------------------------------------------------------------------------}
procedure TPropertyInspector.SetControl(AControl: TControl);
begin
if Assigned(AControl) then VControl:=AControl;
end;
{------------------------------------------------------------------------------}
function EnumName(Value: LongInt; Info: PTypeInfo): string;
var
Data: PTypeData;
begin
Data:=GetTypeData(Info);
if (Value < Data^.MinValue) or (Value > Data^.MaxValue) then Value:=Data^.MinValue;
Result:=GetEnumName(Info,Value);
end;
{------------------------------------------------------------------------------}
function SetToString(const SetValue; Info: PTypeInfo): string;
var
MaskValue,I: LongInt;
Data,CompData: PTypeData;
CompInfo: PTypeInfo;
begin
Data:=GetTypeData(Info);
CompInfo:=Data^.CompType^;
CompData:=GetTypeData(CompInfo);
MaskValue:=LongInt(SetValue);
Result:='[';
for I:=CompData^.MinValue to CompData^.MaxValue do
begin
if (MaskValue and 1) <> 0 then Result:=Result + EnumName(I,CompInfo) + ',';
MaskValue:=MaskValue shr 1;
end;
if Result[Length(Result)] = ',' then Delete(Result,Length(Result),1);
Result:=Result + ']';
end;
{------------------------------------------------------------------------------}
function GetPropAsString(Obj: TObject; Info: PPropInfo): string;
var
Count,I: Integer;
IntVal: LongInt;
PropList: PPropList;
begin
Result:='';
Count:=GetPropList(Obj.ClassInfo,tkProps,nil);
if Count < 1 then Exit;
GetMem(PropList,Count * SizeOf(PPropInfo));
try
GetPropList(Obj.ClassInfo,tkProps,PropList);
for I:=0 to Pred(Count) do with PropList^
^ do
if (Info = nil) or (UpperCase(Name) = UpperCase(Info^.Name)) then
begin
case PropType^.Kind of
tkUnknown : Result:='';
tkInteger : begin
IntVal:=LongInt(GetOrdProp(Obj,PropList^));
if (PropType^.Name = 'TColor') and
ColorToIdent(IntVal,Result) then
else
if (PropType^.Name = 'TCursor') and
CursorToIdent(IntVal,Result) then
else Result:=IntToStr(IntVal);
end;
tkChar : Result:=Chr(GetOrdProp(Obj,PropList^));
tkEnumeration : begin
IntVal:=LongInt(GetOrdProp(Obj,PropList^));
if (PropType^.Name = 'Boolean') then
if IntVal = 1 then Result:='True' else Result:='False'
else
Result:=EnumName(IntVal,PropList^^.PropType^);
end;
tkFloat : Result:=FloatToStr(GetFloatProp(Obj,PropList^));
tkString : Result:=GetStrProp(Obj,PropList^);
tkSet : begin
IntVal:=LongInt(GetOrdProp(Obj,PropList^));
Result:=SetToString(IntVal,PropList^^.PropType^);
end;
tkLString : Result:=GetStrProp(Obj,PropList^);
end;
end;
finally
FreeMem(PropList,Count * SizeOf(PPropInfo));
end;
end;
{------------------------------------------------------------------------------}
procedure GetProperties(Comp: TComponent; List: TStrings);
var
I,PropItems: Integer;
PropList: PPropList;
PropInfo: PPropInfo;
begin
if not Assigned(Comp) or not Assigned(List) then Exit;
List.Clear;
List.Add(Comp.Name + ': ' + Comp.ClassName);
try
PropItems:=GetPropList(Comp.ClassInfo,tkProperties,nil);
for I:=1 to PropItems do List.Add(' ');
if PropItems = 0 then Exit;
GetMem(PropList,PropItems * SizeOf(PPropInfo));
try
GetPropList(Comp.ClassInfo,tkProperties,PropList);
for I:=0 to Pred(PropItems) do
begin
PropInfo:=GetPropInfo(Comp.ClassInfo,PropList^^.Name);
if I < Pred(List.Count) then
List[Succ(I)]:=PropList^^.Name + ': ' + GetPropAsString(Comp,PropInfo);
end;
finally
FreeMem(PropList,PropItems * SizeOf(PPropInfo));
end;
finally
end;
end;
{------------------------------------------------------------------------------}
procedure Register;
begin
RegisterComponents('Udo',[TPropertyInspector]);
end;
{------------------------------------------------------------------------------}
constructor TPropertyForm.CreateNew(AOwner: TComponent; Dummy: Integer = 0);
begin
inherited;
SetBounds(0,0,150,400);
BorderStyle:=bsSizeToolWin;
ListBox:=TListBox.Create(Self);
ListBox.Parent:=Self;
ListBox.Align:=alClient;
ListBox.OnClick:=OnListBoxClick;
Caption:='PropertyInspector';
end;
{------------------------------------------------------------------------------}
destructor TPropertyForm.Destroy;
begin
ListBox.Free;
inherited;
end;
{------------------------------------------------------------------------------}
procedure TPropertyForm.OnListBoxClick(Sender: TObject);
begin
TopItem:=ListBox.ItemIndex;
end;
{------------------------------------------------------------------------------}
initialization
end.