我在Windows中实现了一个模拟边界调整行为的控件。把它放在主窗体上,将它与alClient对齐,或使用锚定属性(锚点可能更好),并将主窗体的边框样式更改为bsNone,但不要执行链接到的其他问题中引用的黑客。
unit ResizeBorderControlUnit;
// TResizeBorderControl:
//
// This is a subclass of TShape made to handle the border resize
// logic for a main form with border style bsNone. I wanted to
// make the form resizeable (think of a post-it note app) but I didn't
// want any Windows non-client painting or non-client manipulation logic.
//
// Written by Warren Postma
interface
uses Windows,
Messages,
Controls,
Forms,
ExtCtrls,
Classes,
SysUtils;
const
// if this value is too small, resizing gets too tricky.
MinSideMargin = 4;
MinBottomMargin = 4;
//Perform(wm_SysCommand, sc_DragMove, 0) etc:
sc_DragMove = $f012;
sc_Leftsize = $f001;
sc_Rightsize = $f002;
sc_Upsize = $f003;
sc_UpLeftsize = $f004;
sc_UpRightsize = $f005;
sc_Dnsize = $f006;
sc_DnLeftsize = $f007;
sc_DnRightsize = $f008;
type
TResizeBorderControl = class(TShape)
private
// FParentFormResize:TForm;
FSidesResizeHeight: Integer;
FBottomResizeHeight: Integer;
FBorderResizeFlag:Integer;
FAutoSize: Boolean;
FAutoSizeStartingAtTop: Integer; // currently active state.
procedure SetBottomResizeHeight(const Value: Integer);
procedure SetSidesResizeHeight(const Value: Integer);
procedure SetAutoSize(const Value: Boolean);
procedure SetAutoSizeStartingAtTop(const Value: Integer);
protected
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE; //override;
procedure CheckPosition(X, Y: Integer);
function MainFormMaximized:Boolean;
public
constructor Create(AOwner:TComponent); override;
published
property AutoSize:Boolean read FAutoSize write SetAutoSize;
property AutoSizeStartingAtTop:Integer read FAutoSizeStartingAtTop write SetAutoSizeStartingAtTop;
property BottomResizeHeight:Integer read FBottomResizeHeight write SetBottomResizeHeight;
property SidesResizeHeight:Integer read FSidesResizeHeight write SetSidesResizeHeight;
end;
implementation
// TResizeBorderControl
procedure TResizeBorderControl.CMMouseLeave(var Message: TMessage);
begin
Parent.Perform(CM_MOUSELEAVE, 0, Longint(Self));
if (Message.LParam = 0) then
begin
if Assigned(OnMouseLeave) then
OnMouseLeave(Self);
if ShowHint and not (csDesigning in ComponentState) then
if CustomHint <> nil then
CustomHint.HideHint(Self);
end;
FBorderResizeFlag := 0; // reset any active state bits.
Self.Cursor := crDefault;
end;
constructor TResizeBorderControl.Create(AOwner: TComponent);
begin
inherited;
Brush.Color := $202020;
end;
function TResizeBorderControl.MainFormMaximized: Boolean;
var
fm:TCustomForm;
begin
result := true;
fm := GetParentForm(Self);
if Assigned(fm) then
result := (fm.WindowState=wsMaximized);
end;
procedure TResizeBorderControl.MouseDown(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure DoResize(aType:Integer);
var
pw:TCustomForm;
begin
ReleaseCapture;
pw := Forms.GetParentForm(Self);
if Assigned(pw) then begin
ReleaseCapture;
pw.Perform(WM_syscommand, aType, 0);
end;
end;
begin
inherited;
if csDesigning in ComponentState then exit;
if MainFormMaximized then exit;
if (FBorderResizeFlag=0) then begin
CheckPosition(X, Y);
end;
if FBorderResizeFlag =1 then
DoResize(sc_Leftsize)
else if FBorderResizeFlag =2 then
DoResize(sc_Rightsize)
else if FBorderResizeFlag =4 then
DoResize(sc_Dnsize)
else if FBorderResizeFlag =5 then
DoResize(sc_DnLeftsize)
else if FBorderResizeFlag =6 then
DoResize(sc_DnRightsize)
else if FBorderResizeFlag =8 then
DoResize(sc_Upsize)
else
Self.Cursor := crDefault;
//FBorderResizeFlag := 0; // nope. second time mouse down without a move would glitch us.
end;
procedure TResizeBorderControl.MouseMove(Shift: TShiftState; X,
Y: Integer);
begin
if MainFormMaximized then exit;
CheckPosition(X,Y);
end;
procedure TResizeBorderControl.CheckPosition(X, Y: Integer);
var
SideMargin,BottomMargin:Integer;
begin
if csDesigning in ComponentState then begin
inherited;
exit;
end;
FBorderResizeFlag := 0;
if MainFormMaximized then exit;
BottomMargin := FBottomResizeHeight;
if BottomMargin<MinBottomMargin then
BottomMargin := MinBottomMargin;
SideMargin := FSidesResizeHeight;
if SideMargin < MinSideMargin then
SideMargin := MinSideMargin;
if (X<SideMargin) then
FBorderResizeFlag := FBorderResizeFlag or 1 // left
else if (X>=Self.Width-SideMargin) then
FBorderResizeFlag := FBorderResizeFlag or 2; // right
if (Y>=Self.Height-BottomMargin) then
FBorderResizeFlag := FBorderResizeFlag or 4; // bottom
//
// else if (Y<BottomMargin) then // BottomMargin could also be used for top!
// FBorderResizeFlag := FBorderResizeFlag or 8; // top
if FBorderResizeFlag =1 then
Self.Cursor := crSizeWE
else if FBorderResizeFlag =2 then
Self.Cursor := crSizeWE
else if FBorderResizeFlag =4 then
Self.Cursor := crSizeNS
else if FBorderResizeFlag =5 then
Self.Cursor := crSizeNESW // bottom left
else if FBorderResizeFlag =6 then
Self.Cursor := crSizeNWSE // bottom right
else if FBorderResizeFlag =8 then
Self.Cursor := crSizeNS // up
else begin
Self.Cursor := crDefault;
inherited;
end;
end;
procedure TResizeBorderControl.SetAutoSize(const Value: Boolean);
begin
FAutoSize := Value;
if FAutoSize then begin
Align := alNone;
if Self.Left<>0 then
Self.Left := 0;
if Self.Width<>Parent.Width then
Self.Width := Parent.Width;
if Self.Height<>Parent.Height then
Self.Width := Parent.Width;
Anchors := [akLeft, akTop, akRight, akBottom];
end;
Invalidate;
end;
procedure TResizeBorderControl.SetAutoSizeStartingAtTop(
const Value: Integer);
begin
FAutoSizeStartingAtTop := Value;
end;
procedure TResizeBorderControl.SetBottomResizeHeight(
const Value: Integer);
begin
FBottomResizeHeight := Value;
end;
procedure TResizeBorderControl.SetSidesResizeHeight(
const Value: Integer);
begin
FSidesResizeHeight := Value;
end;
end.
P.S.请注意,这种类型的东西有一些副作用,使它成为“一个整洁的Hack”,但不是我在真实软件中发布的东西。这是一个玩具。
字体缩放会发生什么?您的应用是否认视力不好的人的存在? – 2011-03-01 21:42:44
通常,正确的方法是放大客户区而不是缩小窗口区域。但前者可能会更复杂。 'WM_NCCALCSIZE'是告诉你的客户区域在哪里的消息,但是一旦你改变它,你*真的*必须绘制所有的非客户区域,默认的绘画将不适合任何其他大小。之后,你会有一些更多的经验 - 并发症。虽然不是在Delphi中,[这篇文章]可能会给你一些启示。 – 2011-03-02 02:39:21
我发现所有这些非常复杂,我决定去无边界,只是模拟自己调整大小(请参阅我的答案)。 – 2011-03-02 14:19:45