绝对有挑战性的问题:如何将Form整到桌面上? ( 积分: 50 )

  • 主题发起人 主题发起人 net_morning
  • 开始时间 开始时间
N

net_morning

Unregistered / Unconfirmed
GUEST, unregistred user!
实现这样的功能:
1、该Form整到桌面,就和主程序没有什么关系了。当然,主程序关闭,这个桌面Form也要关闭,实在无法关闭该桌面Form也没有关系。
2、该Form实现类似于QQ那样的隐藏/显示效果,就是鼠标点上去的时候,就列出来了,移开鼠标,Form就跑到上面去了,节约空间。Form显示时是在最前面的窗口(QQ显示时也在最前面)
3、为什么需要这个Form呢?因为正个主程序,该Form使用的频率最高,这样设计的话,客户用起来就比较方便。
欢迎各位大侠出手!万分感谢!
 
这个很弱智的,能挑战谁,网上大把例子,比这个要求还要复杂都有,而且很旧。
 
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
 
多人接受答案了。
 
后退
顶部