左下角弹出窗体

左下角弹出窗体

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Timer1: TTimer;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  PopForm:TForm;
implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
   PopForm:=TForm.Create(self);
   PopForm.Width:=200;
   PopForm.Height:=150;
   PopForm.Name:='PopForm1';
   PopForm.Left:=screen.Width-PopForm.Width;
   PopForm.Top:=screen.Height;
   PopForm.Show;
   Timer1.Interval:=200;
   Timer1.Enabled:=True;

end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 PopForm.Top:=PopForm.Top-10;
   if PopForm.Top<screen.Height-PopForm.Height then
     begin
       Timer1.Enabled:=False;
       PopForm.Free;
     end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var i,Tops:Integer;  //定義幾個變量

begin
PopForm:=TForm.Create(self);
  PopForm.Width:=200;
  PopForm.Height:=150;
  PopForm.Show;   //顯示消息窗體
  PopForm.Left:=Screen.WorkAreaWidth;  //定位到桌面可用區域的最右邊
  PopForm.Top:=Screen.WorkAreaHeight; //定位到桌面可用區域的最下面
  Tops:= Screen.WorkAreaHeight - PopForm.Height;  //得出消息窗體最高度


  for i := 0 to PopForm.Width do begin  //循環以消息窗體的寬度為准
    PopForm.Left:=PopForm.Left-1;
    if PopForm.Top >= Tops then         //如果小于消息窗體高度繼續循環
    PopForm.Top:=PopForm.Top-1;
    Sleep(1);
    Application.ProcessMessages;
  end;

end;

end.

制作从屏幕右下角逐渐弹出的消息提示框

微软的每一个产品，无论功能还是界面设计都会带给我们一定的惊喜，比如OfficeXP、Office2003、Messenger的界面设计，早已成为众多软件竞相模仿的对象，就拿Messenger来说，我就见过好几套网络视频会议的软件都借鉴了它的界面风格。
　　前段时间因为要在原来的软件上增加一个快捷键提示窗体，这个提示窗要求在显示的时候比较醒目美观能引起用户注意，显示后不影响用户操作，能够关掉。很自然的就想到了Messenger那个从屏幕右下角逐渐弹出的消息提示窗体，不过相对Messenger我更喜欢QQ2004奥运版的配色风格，反正都是偷就多偷点吧，下面快捷键提示窗的最终效果：
　　　　


　　这个窗体有以下几个特点：
　　1、显示的时候是从屏幕右下角逐渐弹出的；
　　2、它是个无标题窗体，但它必须允许用户移动和改变大小，因此要用到无标题窗体拖动、改变大小的技术；
　　3、它是个不规则的窗体，主要是左上角和右上角是圆形导角，因此要为窗体创建外形，且窗体改变大小时必须重建；
　　4、它标题和内容显示区都有渐层色，标题还有几个小点点，在实现时使用取巧的方法，直接利用截图进行填充。

　　当然界面可以偷，代码就得老老实实的写的了，下面是界面设计图和实现代码：
　　　　



文章整理：西部数码--专业提供域名注册、虚拟主机服务
http://www.west263.com
以上信息与文章正文是不可分割的一部分,如果您要转载本文章,请保留以上信息，谢谢! 

只看的到控件

procedure TForm1.FormCreate(Sender: TObject);
begin
  BorderStyle := bsNone;
  Brush.Style := bsClear;
end;



unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, uMlStdCtrl, uMlSkinForm, uMlFormBorder, GR32_Image_ml, uMlSkinCtrls,
  uMlCustomButton, uMlSkinButton, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    { Private declarations }
     procedure DoVisible;
    procedure DoInvisible;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
   FullRgn, ClientRgn, CtlRgn : THandle;
implementation

{$R *.dfm}
procedure TForm1.DoInvisible;
var
  AControl : TControl;
  A, Margin, X, Y, CtlX, CtlY : Integer;
begin
  Margin := ( Width - ClientWidth ) div 2;
  //First, get form region
  FullRgn := CreateRectRgn(0, 0, Width, Height);
  //Find client area region
  X := Margin;
  Y := Height - ClientHeight - Margin;
  ClientRgn := CreateRectRgn( X, Y, X + ClientWidth, Y + ClientHeight );
  //'Mask' out all but non-client areas
  CombineRgn( FullRgn, FullRgn, ClientRgn, RGN_DIFF );

  //Now, walk through all the controls on the form and 'OR' them
  // into the existing Full region.
  for A := 0 to ControlCount - 1 do begin
    AControl := Controls[A];
    if ( AControl is TWinControl ) or ( AControl is TGraphicControl )
        then with AControl do begin
      if Visible then begin
        CtlX := X + Left;
        CtlY := Y + Top;
        CtlRgn := CreateRectRgn( CtlX, CtlY, CtlX + Width, CtlY + Height );
        CombineRgn( FullRgn, FullRgn, CtlRgn, RGN_OR );
      end;
    end;
  end;
  //When the region is all ready, put it into effect:
  SetWindowRgn(Handle, FullRgn, TRUE);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
//This button just toggles between transparent and not trans..
  if Button1.Caption = 'Show Form' then begin
    DoVisible;
    Button1.Caption := 'Hide Form';
  end
  else begin
    DoInvisible;
    Button1.Caption := 'Show Form';
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Application.Terminate;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 DoInvisible;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  //Clean up the regions we created
  DeleteObject(ClientRgn);
  DeleteObject(FullRgn);
  DeleteObject(CtlRgn);
end;
procedure TForm1.FormResize(Sender: TObject);
begin
if Button1.Caption = 'Show Form' then
    DoInvisible
  else
    DoVisible;
end;

procedure TForm1.DoVisible;
begin
  //To restore complete visibility:
  FullRgn := CreateRectRgn(0, 0, Width, Height);
  CombineRgn(FullRgn, FullRgn, FullRgn, RGN_COPY);
  SetWindowRgn(Handle, FullRgn, TRUE);
end;

end.