DELPHI7 伸缩窗体问题~！
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ShellAPI, ExtCtrls, StdCtrls, RzPanel, RzSplit;
// <-窗体隐藏 Begin->
type
TAnchorKind = (akTop, akLeft, akRight, akBottom);
TAnchors = set of TAnchorKind;
// <-窗体隐藏 End->
type
TForm1 = class(TForm)
LabeledEdit1: TLabeledEdit;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Timer1: TTimer;
Memo1: TMemo;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
TabSheet4: TTabSheet;
TabSheet5: TTabSheet;
RzSplitter1: TRzSplitter;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
// <-窗体隐藏 Begin->
FAnchors: TAnchors;
procedure WMMOVING(var Msg: TMessage);message WM_MOVING;
// <-窗体隐藏 End->
// <-无标题窗体缩放 BEGIN->
procedure WmNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
// <-无标题窗体缩放 END->
public
{ Public declarations }
end;
var
Form1: TForm1;
const
sc_DragMove:longint=$F012;
implementation
{$R *.dfm}
// <-窗体隐藏 Begin->
uses Math;
procedure TForm1.WMMOVING(var Msg: TMessage);
begin
inherited;
with PRect(Msg.LParam)^ do
begin
Left := Min(Max(0, Left), Screen.Width - Width);
Top := Min(Max(0, Top), Screen.Height - Height);
Right := Min(Max(Width, Right), Screen.Width);
Bottom := Min(Max(Height, Bottom), Screen.Height);
FAnchors := [];
if Left = 0 then Include(FAnchors, akLeft);
if Right = Screen.Width then Include(FAnchors, akRight);
if Top = 0 then Include(FAnchors, akTop);
if Bottom = Screen.Height then Include(FAnchors, akBottom);
Timer1.Enabled := FAnchors <> [];
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
const
cOffset = 2;
var
//i : integer;
isshow :boolean;
tpponit : tpoint;
begin
tpponit := ScreenToClient(Mouse.CursorPos);
self.Memo1.Lines.Add('left='+inttostr(self.Left));
self.Memo1.Lines.Add('x='+inttostr(tpponit.x));
if (self.Left = 0) and (tpponit.x > self.Width-5 ) then
isshow := false //靠左-5右边框
else
if (self.Left < 0) and (tpponit.x < self.Width ) then
isshow := true
else
if (self.Left = 0) and ((tpponit.Y < -10) or (tpponit.Y > self.height)) then
isshow := false //靠左-10上边框 下边框
else
if (self.top = 0) and (tpponit.y > self.height ) then
isshow := false //靠上下边框
else
if (self.top < 0) and (tpponit.y < self.height ) then
isshow := true
else
if (self.top = 0) and ((tpponit.x < -5) or (tpponit.X >self.Width-5)) then
isshow := false //靠上-5左边框 -5右边框
else
if (Screen.Width - self.left = self.Width ) and (tpponit.x < -4 ) then
isshow := false
else
if (Screen.Width - self.left = cOffset ) and (tpponit.x >= -4 ) then
isshow := true
else
if (Screen.Width - self.left = self.Width ) and ((tpponit.Y < -10) or (tpponit.Y > self.height)) then
isshow := false //靠右-10上边框 下边框
else
exit;
if isshow then
begin
if akLeft in FAnchors then Left := 0;
if akTop in FAnchors then Top := 0;
if akRight in FAnchors then Left := Screen.Width - Width;
if akBottom in FAnchors then Top := Screen.Height - Height;
end else
begin
if akLeft in FAnchors then Left := -Width + cOffset;
if akTop in FAnchors then Top := -Height + cOffset;
if akRight in FAnchors then Left := Screen.Width - cOffset;
if akBottom in FAnchors then Top := Screen.Height - cOffset;
end;
end;
// <-窗体隐藏 END->
// <-无标题窗体拖动 BEGIN->
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
//if ssCtrl in Shift then
//判断“Ctrl”键是否按下
//Begin
ReleaseCapture;
//释放鼠标事件的对象
(Sender as TWinControl).PerForm(wm_SysCommand,sc_DragMove,0);
//发送消息
//end;
end;
// <-无标题窗体拖动 END->
// <-无标题窗体缩放 BEGIN->
procedure TForm1.WmNCHitTest(var Msg: TWMNCHitTest);
const v = 10; //border width
var p: TPoint;
begin
p := Point(Msg.XPos, Msg.YPos);
p := ScreenToClient(p);
if PtInRect(Rect(0, 0, v, v), p) then
Msg.Result := HTTOPLEFT
else if PtInRect(Rect(Width - v, Height - v, Width, Height), p) then
Msg.Result := HTBOTTOMRIGHT
else if PtInRect(Rect(Width - v, 0, Width, v), p) then
Msg.Result := HTTOPRIGHT
else if PtInRect(Rect(0, Height - v, v, Height), p) then
Msg.Result := HTBOTTOMLEFT
else if PtInRect(Rect(v, 0, Width - v, v), p) then
Msg.Result := HTTOP
else if PtInRect(Rect(0, v, v, Height - v), p) then
Msg.Result := HTLEFT
else if PtInRect(Rect(Width - v, v, Width, Height - v), p) then
Msg.Result := HTRIGHT
else if PtInRect(Rect(v, Height - v, Width - v, Height), p) then
Msg.Result := HTBOTTOM;
inherited;
end;
// <-无标题窗体缩放 END->
procedure TForm1.FormCreate(Sender: TObject);
begin
//LabeledEdit1.Text:=DateTimeToStr(now);
Timer1.Enabled := False; //时间关闭
Timer1.Interval := 200; //时间毫秒
FormStyle := fsStayOnTop; //窗体在最前
// <-无标题窗体缩放 BEGIN->
SetWindowLong(Form1.Handle,
GWL_STYLE,
GetWindowLong(Handle, GWL_STYLE) and not WS_CAPTION);
Height := ClientHeight;
// <-无标题窗体缩放 END->
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
LabeledEdit1.Text:=LabeledEdit1.Text + TButton(Sender).Caption;
PageControl1.ActivePageIndex:=TComponent(Sender).Tag;
end;
end.
