Dephi下有无让控件跟追窗体大小自动变换大小的OCX控件?

[beizhi]

Dephi下有无让控件跟追窗体大小自动变换大小的OCX控件?也就是
当form改变时,窗体内的控件的大小,位置会随之自动改变,我可不
想花太多的代码来给控件定位.

[100percent]

有两个控件，FormResize,FormMinMax,可以实现。
代码如下：
unit FormMinMax;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
TMinMaxOptions = set of (moMinW,moMaxW,moMinH,moMaxH);
TFormMinMax = class(TComponent)
private
OldWndProc : TFarProc;
NewWndProc : Pointer;
FMinW : Integer;
FMinH : Integer;
FMaxW : Integer;
FMaxH : Integer;
FDTProp : TMinMaxOptions;
procedure HookParent;
procedure UnhookParent;
procedure HookWndProc(var Message: TMessage);
protected
{ Protected declarations }
public
constructor Create(AOwner:TComponent); override;
destructor Destroy; override;
published
property MinWidth:Integer Read FMinW Write FMinW;
property MaxWidth:Integer Read FMaxW Write FMaxW;
property MinHeight:Integer Read FMinH Write FMinH;
property MaxHeight:Integer Read FMaxH Write FMaxH;
property DTOptions:TMinMaxOptions read fdtProp write FdtProp;
end;

procedure Register;

implementation

constructor TFormMinMax.Create(AOwner:TComponent);
Begin
Inherited Create(AOwner);
NewWndProc := NIL;
OldWndProc := NIL;
HookParent;
End;

destructor TFormMinMax.Destroy;
begin
UnhookParent;
inherited Destroy;
end;

procedure TFormMinMax.HookParent;
begin
if (Owner As TWinControl) = NIL then exit;
OldWndProc := TFarProc(GetWindowLong((Owner As TWinControl).Handle, GWL_WNDPROC));
NewWndProc := MakeObjectInstance(HookWndProc);
SetWindowLong((Owner As TWinControl).Handle, GWL_WNDPROC, LongInt(NewWndProc));
end;

procedure TFormMinMax.UnhookParent;
begin
if ((Owner As TWinControl)<>NIL) and Assigned(OldWndProc) then
SetWindowLong((Owner As TWinControl).Handle, GWL_WNDPROC, LongInt(OldWndProc));
if assigned(NewWndProc) then
FreeObjectInstance(NewWndProc);
NewWndProc := NIL;
OldWndProc := NIL;
end;

procedure TFormMinMax.HookWndProc(var Message: TMessage);
begin
if (Owner As TWinControl) = NIL then
exit;
With Message Do
Begin
Result := CallWindowProc(OldWndProc, (Owner As TWinControl).Handle, Msg, wParam, lParam);
If (Msg=WM_SIZE) And (ComponentState=[csDesigning]) Then
Begin
If moMinW In FdtProp Then
FMinW := (Owner As TWinControl).Width;
If moMaxW In FdtProp Then
FMaxW := (Owner As TWinControl).Width;
If moMinH In FdtProp Then
FMinH := (Owner As TWinControl).Height;
If moMaxH In FdtProp Then
FMaxH := (Owner As TWinControl).Height;
End;
If ComponentState=[csDesigning] Then
Exit;
If (Msg = WM_GETMinMaxINFO) Then
Begin
With PMinMaxInfo(Message.lParam)^ do
Begin
If (FMinW>0) Then
ptMinTrackSize.X := FMinW;
If (FMaxW>0) Then
ptMaxTrackSize.X := FMaxW;
If (FMinH>0) Then
ptMinTrackSize.Y := FMinH;
If (FMaxH>0) Then
ptMaxTrackSize.Y := FMaxH;
End;
End;
End;
end;

procedure Register;
begin
RegisterComponents('Sample', [TFormMinMax]);
end;

end.



unit FormResize;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, ExtCtrls, StdCtrls, TabNotBk;

type
pControlInfo = ^tControlInfo;
tControlInfo = record
Obj:TControl;
ClassName:String;
lRatio,tRatio,wRatio,hRatio:Real;
Contains:pControlInfo;
Next:pControlInfo;
End;
TFormResize = class(TComponent)
private
ResizerInitialized:Boolean;
Function GetClientControlCount(Sender:TObject):LongInt;
procedure GetNewWidthHeight(Sender:TObject;Var NewW,NewH:LongInt);
Procedure PerformResize(CurCont:pControlInfo;CWidth,CHeight:LongInt);
Function GetClientControlObject(Sender:TObject;Index:LongInt):TControl;
Function Initialize(Sender:TObject;CWidth,CHeight:LongInt):pControlInfo;
Procedure DeleteControlList(CurCont:pControlInfo);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure ReSize(ParentForm:TObject);
procedure NewSnapshot(ParentForm:TObject);
end;

procedure Register;

implementation

Var ControlList:pControlInfo;

constructor TFormResize.Create(AOwner: TComponent);
Begin
inherited Create(AOwner);
ResizerInitialized:=False;
ControlList:=nil;
End;

destructor TFormResize.Destroy;
Begin
DeleteControlList(ControlList);
ResizerInitialized:=False;
ControlList:=nil;
inherited Destroy;
End;

Procedure TFormResize.DeleteControlList(CurCont:pControlInfo);
Var NextCont:pControlInfo;
Begin
While(CurCont<>nil) Do
Begin
If((CurCont^.Contains)<>nil) Then
DeleteControlList(CurCont^.Contains);
NextCont:=CurCont^.Next;
FreeMem(CurCont,SizeOf(tControlInfo));
CurCont:=NextCont;
End;
End;

procedure TFormResize.GetNewWidthHeight(Sender:TObject;Var NewW,NewH:LongInt);
Begin
If(Sender is TForm) Then
With TForm(Sender) Do
Begin
NewW:=ClientWidth;
NewH:=ClientHeight;
End
Else
If(Sender is TPanel) Then
With TPanel(Sender) Do
Begin
NewW:=Width;
NewH:=Height;
End
Else
If(Sender is TGroupBox) Then
With TGroupBox(Sender) Do
Begin
NewW:=Width;
NewH:=Height;
End
Else
If(Sender is TTabbedNotebook) Then
With TTabbedNotebook(Sender) Do
Begin
NewW:=Width;
NewH:=Height;
End
Else
Begin
NewW:=0;
NewH:=0;
End;
End;

Function TFormResize.GetClientControlCount(Sender:TObject):LongInt;
Begin
If(Sender is TForm) Then
Result:=TForm(Sender).ControlCount
Else
If(Sender is TPanel) Then
Result:=TPanel(Sender).ControlCount
Else
If(Sender is TGroupBox) Then
Result:=TGroupBox(Sender).ControlCount
Else
If(Sender is TTabbedNotebook) Then
Result:=TTabbedNotebook(Sender).ControlCount
Else
Result:=0;
End;

Function TFormResize.GetClientControlObject(Sender:TObject;Index:LongInt):TControl;
Begin
If(Sender is TForm) Then
Result:=TForm(Sender).Controls[Index]
Else
If(Sender is TPanel) Then
Result:=TPanel(Sender).Controls[Index]
Else
If(Sender is TGroupBox) Then
Result:=TGroupBox(Sender).Controls[Index]
Else
If(Sender is TTabbedNotebook) Then
Result:=TTabbedNotebook(Sender).Controls[Index]
Else
Result:=nil;
End;

Function TFormResize.Initialize(Sender:TObject;CWidth,CHeight:LongInt):pControlInfo;
Var Temp:pControlInfo;
Count:Integer;
Begin
Result:=nil;
For Count:=0 to (GetClientControlCount(Sender)-1) Do
Begin
GetMem(Temp,SizeOf(tControlInfo));
Temp^.Obj:=GetClientControlObject(Sender,Count);
With(Temp^) Do
Begin
lRatio:=(Obj.Left) / CWidth;
tRatio:=(Obj.Top) / CHeight;
wRatio:=(Obj.Width) / CWidth;
hRatio:=(Obj.Height) / CHeight;
Contains:=nil;
Next:=Result;
End;
Result:=Temp;
If((Temp^.Obj is TForm) or
(Temp^.Obj is TPanel) or
(Temp^.Obj is TGroupBox) or
(Temp^.Obj is TTabbedNotebook)) Then
With(Temp^) Do
Contains:=Initialize(Obj,Obj.Width,Obj.Height);
End;
End;

Procedure TFormResize.PerformResize(CurCont:pControlInfo;CWidth,CHeight:LongInt);
Begin
While(CurCont<>nil) Do
Begin
With(CurCont^) Do
Begin
With(Obj) Do
SetBounds(Round(lRatio*CWidth),Round(tRatio*CHeight),
Round(wRatio*CWidth),Round(hRatio*CHeight));
If(Contains<>nil) Then
PerformResize(Contains,Obj.Width,Obj.Height);
End;
CurCont:=CurCont^.Next;
End;
End;

procedure TFormResize.NewSnapshot(ParentForm:TObject);
Var NewClientWidth,NewClientHeight:LongInt;
Begin
GetNewWidthHeight(ParentForm,NewClientWidth,NewClientHeight);
DeleteControlList(ControlList);
ControlList:=nil;
ResizerInitialized:=False;
ControlList:=Initialize(ParentForm,NewClientWidth,NewClientHeight);
If(ControlList<>nil) Then
ResizerInitialized:=True;
End;

procedure TFormResize.ReSize(ParentForm:TObject);
Var NewClientWidth,NewClientHeight:LongInt;
Begin
GetNewWidthHeight(ParentForm,NewClientWidth,NewClientHeight);
If(ResizerInitialized) Then
PerformResize(ControlList,NewClientWidth,NewClientHeight)
Else
NewSnapshot(ParentForm);
End;

procedure Register;
begin
RegisterComponents('Sample', [TFormResize]);
end;

end.

[Fred]

把控件的Anchors的属性的Right和Bottom都设成True不就行了吗？