如何允许用户布置界面控件(85分)

  • 主题发起人 主题发起人 cz
  • 开始时间 开始时间
to cz,lizhao:

我已经将控件发出去了,但我们的e-mail服务器经常出问题,
所以如果没收到,请发消息.

BTW to cz:
我前次发给您的控件收到了吗?
 
lhz:
你们的e-mail服务器看来是出了问题,我没收到你4-12 18:52提及的控件,请重发一下.前次发给我的控件已经收到了,谢谢。
 
to lhz:
Can you send me the component you say Also.(with source).
thanks.
deckyou@126.com
 
i have recieved the component .
but somewhere i don't understant.
you can explain the source for me (or for us).
thx.
 
To cz:
我又发了一次.
To DeckYou:
已经发出了.
To lizhao:
哪里不明白,请说明.
都是简单的控件,装上试一试就知道了.
每个文件开头都有说明的.
 
控件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:PropertyInspector.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.

 
Thanks to lhz:
这些源码是你所指控件的吗?现在都十点了我还没收到你发出的邮件(我是收到论坛
的通知邮件后进来的)。
关注我所提的问题的人不少,现在这个办法(直接贴源码)可以开放地给后来者启
示,真不错!
 
我以前提供过一个FormEdit的样例程序(只能在Delphi1.0下运行), YYSUN已经放到本论
坛的某个位置. 模仿Delphi IDE的Form Designer功能, 能够选者多个空件, 改变大小
、位置、对齐、显示网格、对齐到网格...

我正在改成Delphi4.0版的, 现在基本上能够改变空件的位置,只是还有一点小问题(在
不是以FORM为容器的空件的位置有点问题),如果你们着急用就发给你们。

原理:当在FORM EDIT状态下的时候,用一个新的WINDPROC替换掉DELPHI FORM的
WINDPROC,处理FORM的各种消息,编辑结束后,再把FORM原有的WINDPROC交换给FORM。
 
谁有控件,清寄一份给我!
万分感谢!
我正在做的课题,有这样的需求,谢谢帮忙!
 
谁能做类似JAVA的布局管理器?
 
cz:

这个问题已经很长时间没有人参加讨论,为保持版面
整洁,节约网友时间,请提问者采取必要处理措施。
关于图形图象版管理细则,请参见<a href="http://www.gislab.ecnu.edu.cn/delphibbs/DispQ.asp?LID=111927">这个</a>问题。如两天
内提问者没有响应,我将采取强制措施。

如有管理建议,请到<a href="http://www.gislab.ecnu.edu.cn/delphibbs/DispQ.asp?LID=111927">这里</a>提出。谢谢!
 
在Delphi3的目录下有一个toolsapi的子目录,其中给出了一个叫dsginfo的单元,其中有一个
类的名字叫作TFormDesigner,该类给出了对窗口布局的支持,只要对窗口中的事件加以处理
,不但可以进行可视化的布局,还可以做到代码的自动生成,就像Delphi中的那样.
注:TFormDesigner在Delphi4中已变为了接口,使用的时候要注意.
 
其实对于所有的TWinControl继承来的控件都可以通过他的WM_NCHITTEST消息处理
来实现移动、改变大小等操作。只要将控件的矩形分成9个区域判断鼠标在那里即可。
其他的鼠标事件都不需要。

HTTOPLEFT,HTTOP,HTTOPRIGHT
HTLEFT,HTCAPTION,HTRIGHT
HTBOTTOMLEFT,HTBOTTOM,HTBOTTOMRIGHT

举例来说:
1。继承一个TButton
2。给他一个IsSizing状态变量,要改变位置或大小之前设成TRUE
3。加上一个WM_NCHitTest的消息处理器, 根据消息中的鼠标位置返回相应的区域

TMyButton = class(TButton)
protected
procedure WMNCHitTest(var M: TWMNCHitTest); message WM_NCHITTEST;
public
IsSizing: boolean;
end;

implementation

function InBtwn(v,v1,v2: integer): boolean;
begin
if (v>v1) and (v<v2) then result:=true else result:=false;
end;

procedure TMyButton.WMNCHitTest(var M: TWMNCHitTest);
var l,r,t,b: integer; p: TPoint;
begin
inherited;
if IsSizing and (M.Result = htClient) and (Align=alNone) then
begin
l := 2; r := width-2;
t := 2; b := height-2;
p.x := M.XPos; p.y := M.YPos;
p := ScreenToClient(p);
if (p.x<=l) and inBtwn(p.y,t,b) then Msg.result:=htLeft
else if (p.x>r) and inBtwn(p.y,t,b) then Msg.result:=htRight
else if (p.y<=t) and inBtwn(p.x,l,r) then m.result:=htTop
else if (p.y>=b) and inBtwn(p.x,l,r) then m.result:=htBottom
else if (p.x<=l) and (p.y<=t) then m.result:=htTopLeft
else if (p.x>=r) and (p.y<=l) then m.result:=htTopRight
else if (p.x>=r) and (p.y>=b) then m.result:=htBottomRight
else if (p.x<=l) and (p.y>=b) then m.result:=htBottomLeft
else m.result:=htCaption;
end;
end;
 
多人接受答案了。
 

Similar threads

D
回复
0
查看
1K
DelphiTeacher的专栏
D
D
回复
0
查看
875
DelphiTeacher的专栏
D
D
回复
0
查看
1K
DelphiTeacher的专栏
D
S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
后退
顶部