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

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

本文简介:选择自 nhconch 的 blog

    with canvas do begin 
        //利用imgtitlebarbg绘制标题背景
        for i:=0 to clientwidth div imgtitlebarbg.width do
            draw(i*imgtitlebarbg.width, 0, imgtitlebarbg.picture.bitmap);
        if tag<>0 then exit;  //如果窗体正在弹出状态,不绘制内容面板背景
        //绘制内容面板背景
        setrect(r, 5, 15, width-5, height-5);
        stretchdraw(r, imgshapebg.picture.bitmap);
        pen.color := $c97f55;
        brush.style := bsclear;
        roundrect(r.left, r.top, r.right, r.bottom, 6, 6); 
        //绘制窗体边框
        rgn := createrectrgn(0,0,0,0);
        getwindowrgn(self.handle, rgn);
        brush.color := $be796b;
        windows.framergn(handle, rgn, brush.handle, 2, 2);
        deleteobject(rgn);
    end;
end;

procedure tfrmpshotkey.imgtitlebarmousedown(sender: tobject;
  button: tmousebutton; shift: tshiftstate; x, y: integer);
begin 
    //在标题按下鼠标键时,允许移动窗体或改变窗体大小
    releasecapture;
    if x < 5 then perform(wm_syscommand, $f004, 0)
    else if x > width - 5 then perform(wm_syscommand, $f005, 0)
    else if y < 3 then perform(wm_syscommand, $f003, 0)
    else perform(wm_syscommand, $f012, 0);
end;

procedure tfrmpshotkey.formresize(sender: tobject);
var
    rgn, rgn2: hrgn;
begin
    if tag<>0 then exit; 
    //窗体改变大小时重建rgn
    rgn := createroundrectrgn(0, 0, width+1, height, 4, 4);
    rgn2 := createrectrgn(0, 11, width, height);
    combinergn(rgn, rgn, rgn2, rgn_or);
    setwindowrgn(handle, rgn, true);
    deleteobject(rgn);
    deleteobject(rgn2);
    invalidate;
end;

procedure tfrmpshotkey.speedbutton1click(sender: tobject);
begin
    close;
end;

//以下几个label用来改变窗体大小
procedure tfrmpshotkey.label11mousedown(sender: tobject;
  button: tmousebutton; shift: tshiftstate; x, y: integer);
begin
    releasecapture;
    if x < 5 then perform(wm_syscommand, $f007, 0)
    else if x > width - 5 then perform(wm_syscommand, $f008, 0)
    else perform(wm_syscommand, $f006, 0);
end;

procedure tfrmpshotkey.label12mousedown(sender: tobject;
  button: tmousebutton; shift: tshiftstate; x, y: integer);
begin
    releasecapture;
    perform(wm_syscommand, $f001, 0);
end;

procedure tfrmpshotkey.label13mousedown(sender: tobject;
  button: tmousebutton; shift: tshiftstate; x, y: integer);
begin

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

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

go top