unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Math, ExtCtrls;
type
TForm1 = class(TForm)
Panel1: TPanel;
Timer1: TTimer;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Panel2: TPanel;
Panel3: TPanel;
Panel4: TPanel;
Panel6: TPanel;
Panel5: TPanel;
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
FAnchors: TAnchors;
Fheight,Fwidth: integer;
showfrom:boolean;
procedure WMMOVING(var Msg: TMessage); message WM_MOVING;
procedure WMSizing(var Msg: TMessage); message WM_SIZING;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
timer1.Enabled:=true;
timer1.Interval:=30;
Fheight:=height;
Fwidth:=width;
showfrom:=true;
self.FormStyle:=fsStayOnTop;
end;
procedure TForm1.WMMOVING(var Msg: TMessage);
begin
inherited;
with PRect(Msg.LParam)^ do
begin
Left := Min(Max(0, Left), Screen.Width - Width);
Top := Max(0, Top);
Right := Min(Max(Width, Right), Screen.Width);
//上------------------------------------------------------------------------
if showfrom and (top<10) and (left>10) and (Screen.Width-10>Right) and (FAnchors=[]) then
begin
FAnchors:=[aktop];
end;
if showfrom and ((top>10)or(left<10)or(Screen.Width-10<Right)) and (aktop in FAnchors) then
begin
FAnchors:=[];
end;
//左------------------------------------------------------------------------
if showfrom and (left<10) and (FAnchors=[]) then
begin
FAnchors:=[akleft];
end;
if showfrom and (left>10) and (akleft in FAnchors) then
begin
FAnchors:=[];
Bottom:=top+self.FHeight;
end;
//右------------------------------------------------------------------------
if showfrom and (Right>Screen.Width-10) and (FAnchors=[]) then
begin
FAnchors:=[akright];
Right:=Screen.Width;
end;
if showfrom and (Right<Screen.Width-10) and (akright in FAnchors) then
begin
FAnchors:=[];
Bottom:=top+self.FHeight;
end;
//执行过程------------------------------------------------------------------
if aktop in FAnchors then
begin
end;
if akleft in FAnchors then
begin
top:=0;
Bottom:=Screen.Height-29;
end;
if akright in FAnchors then
begin
top:=0;
Bottom:=Screen.Height-29;
end;
SELF.Left:=LEFT;
SELF.Top:=TOP;
SELF.Height:=Bottom-TOP;
SELF.Width:=RIGHT-LEFT;
end;
end;
procedure TForm1.WMSizing(var Msg: TMessage);
begin
inherited;
with PRect(Msg.LParam)^ do
begin
if not((akleft in FAnchors)or(akright in FAnchors)) then
begin
self.Fheight:=Bottom-top;
end;
self.Fwidth:=Right-Left;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
const
showxx=3;
begin
with Mouse.CursorPos do
begin
if (X>=Left) and (X<=left+width) and (Y>=top) and (Y<=top+height) then
begin
if aktop in FAnchors then top:=0;
if akleft in FAnchors then left:=0;
if akright in FAnchors then left:=Screen.Width-width;
showfrom:=true;
end
else
begin
if aktop in FAnchors then top:=showxx-height;
if akleft in FAnchors then left:=showxx-width;
if akright in FAnchors then left:=Screen.Width-showxx;
showfrom:=false;
end;
end;
//显示状态 完全可以删除掉
panel2.Visible:=aktop in FAnchors;
panel3.Visible:=akleft in FAnchors;
panel4.Visible:=akright in FAnchors;
panel5.Visible:=showfrom;
panel6.Visible:=(Mouse.CursorPos.X>=Left) and (Mouse.CursorPos.X<=left+width) and (Mouse.CursorPos.Y>=top) and (Mouse.CursorPos.Y<=top+height);
label1.Caption:=format('x:%d y:%d',[Mouse.CursorPos.x,Mouse.CursorPos.y]);
label2.Caption:=format(' %d',[top]);
label3.Caption:=format('%d %d',[left,left+width]);
label4.Caption:=format(' %d',[top+height]);
end;
end.
如果要Demo加我QQ:53732500