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

[入库:2005年8月18日] [更新:2007年3月24日]

本文简介:选择自 nhconch 的 blog

  email:       kacarton@sohu.com

  文章为作者原创,转载前请先与本人联系,转载请注明文章出处、保留作者信息,谢谢支持!
=========================================================================}

type
  tfrmpshotkey = class(tform)
    imgtitlebar: timage;
    imgtitlebarbg: timage;
    imgshapebg: timage;
    speedbutton1: tspeedbutton;
    label1: tlabel;
    label2: tlabel;
    label3: tlabel;
    label4: tlabel;
    label5: tlabel;
    label6: tlabel;
    label7: tlabel;
    label8: tlabel;
    label9: tlabel;
    label10: tlabel;
    label11: tlabel;
    label12: tlabel;
    label13: tlabel;
    procedure formpaint(sender: tobject);
    procedure imgtitlebarmousedown(sender: tobject; button: tmousebutton;
      shift: tshiftstate; x, y: integer);
    procedure formcreate(sender: tobject);
    procedure speedbutton1click(sender: tobject);
    procedure label11mousedown(sender: tobject; button: tmousebutton;
      shift: tshiftstate; x, y: integer);
    procedure formresize(sender: tobject);
    procedure label12mousedown(sender: tobject; button: tmousebutton;
      shift: tshiftstate; x, y: integer);
    procedure label13mousedown(sender: tobject; button: tmousebutton;
      shift: tshiftstate; x, y: integer);
    procedure imgtitlebarmousemove(sender: tobject; shift: tshiftstate; x,
      y: integer);
    procedure label11mousemove(sender: tobject; shift: tshiftstate; x,
      y: integer);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  frmpshotkey: tfrmpshotkey;

implementation

{$r *.dfm}

procedure tfrmpshotkey.formcreate(sender: tobject);
begin
    tag := height;
    height := 16; 
    //定位到屏幕右下角
    top := screen.height - 40;
    left := screen.width - width - 2;
    show; 
    //从屏幕右下角逐渐弹出
    while height<tag do begin
        height := height + 5;
        top := top - 5;
        update;
        application.processmessages;
        sleep(10);
    end;
    height := tag;
    tag := 0;
    color := $f4ba9d;
    formresize(sender);
end;

procedure tfrmpshotkey.formpaint(sender: tobject);
var
    i: integer;
    rgn: hrgn;
    r: trect;
begin

本文关键:制作从屏幕右下角逐渐弹出的消息提示框
  相关方案
Google
 

本站最佳浏览方式为 分辨率 1024x768 IE 6.0(或更高版本的 IE浏览器)

go top