unit ufrmSysPubMessage;

interface

uses
  Windows, Forms, Messages, Classes, ExtCtrls, Controls, StdCtrls;

type
  TfrmSysPubMessage = class(TForm)
    Image1: TImage;
    lblMessage: TLabel;
    procedure FormCreate(Sender: TObject);
  protected
    IconID: PChar;
  public
    procedure WndProc(var Msg: TMessage); override;
    procedure ShowMessage(AMsg: string);
  end;

implementation

{$R *.DFM}

{ TfrmMessageForm }
procedure TfrmSysPubMessage.ShowMessage(AMsg: string);
var
  TempWidth : Integer;
begin
  lblMessage.Caption := AMsg;
  Application.ProcessMessages;
  //调整窗体宽度
  TempWidth := lblMessage.Width + lblMessage.Left + Image1.Left;
  if TempWidth < 310 then
    TempWidth := 310;
  Width := TempWidth;
  if not Visible then
    Show;
  Application.ProcessMessages;
  FormStyle := fsStayOnTop;
end;

procedure TfrmSysPubMessage.FormCreate(Sender: TObject);
begin
  inherited;
  IconID := IDI_ASTERISK;
  Image1.Picture.Icon.Handle := LoadIcon(0, IconID);
  //使本窗体始终处于最上面,以免其它窗体挡住它
  SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE);
end;

procedure TfrmSysPubMessage.WndProc(var Msg: TMessage);
begin
  //屏蔽Alt+F4
  if Msg.wParam <> SC_CLOSE then
    inherited;
end;

end.

Delphi 窗体失踪在最上面的代码的更多相关文章

  1. 抓取oschina上面的代码分享python块区下的 标题和对应URL

    # -*- coding=utf-8 -*- import requests,re from lxml import etree import sys reload(sys) sys.setdefau ...

  2. 重新实践c++primer上面的代码

    又重新敲了敲c++primer上面的代码,觉得很有意思,讲的很细,c++真牛逼啊 #include <iostream> #include <string> #include ...

  3. Git同步更新操作GitHub和码云仓库上面的代码

    一.前言 问题: 小编在生活中,一般都是将代码保存到github上,但由于国内的码云仓库确实速度比github快很多,用起来也很方便,于是后来就慢慢转码云了,当然小编在github上的代码也不想放弃更 ...

  4. VS2012如何更新下载TFS上面的代码到本地

    现在的代码基本上全都放在TFS上面,如何同步TFS上面的code呢? 1. Open "Team Explorer - Home" 2. Click "Source Co ...

  5. ajax同步导致ajax上面的代码不执行?

    js代码:环境:IE11要求:点击一个按钮后,页面xxx的地方立即显示"开始处理...",直到ajax处理结束后,xxx内容才更新为新的处理结果:点击事件执行代码如下:xxx.in ...

  6. 将GitLab上面的代码克隆到本地

    1.安装GitLab客户端 2.去GitLab服务端找项目路径 3.去GitLab客户端去克隆代码 右键-->git Clone 4.最后结果

  7. 10个造型奇特的css3进度条(有的html被编辑器转义了,上面的代码还是OK的)。。。转载

    <div id="caseVerte"> <div id="case1"></div> <div id="c ...

  8. git clone 拉取github上面的代码报错:fatal: Authentication failed for xxx解决

    1.打开git bash,输入密码:git config --system --unset credential.helper2.结果报错:error: could not lock config f ...

  9. [SDK2.2]Windows Azure Storage (16) 使用WCF服务,将本地图片上传至Azure Storage (上) 客户端代码

    <Windows Azure Platform 系列文章目录> 前一章我们完成了服务器端的代码,并且已经发布到了Windows Azure云端. 本章我们将实现客户端的代码,客户端这里我们 ...

随机推荐

  1. 【转载】字符串最小表示法-O(n)算法

    原博客链接:http://blog.csdn.net/zy691357966/article/details/39854359 未授权,侵权删. 因为这篇博客写得真好..转载了.. 红色的字是原博主写 ...

  2. [bzoj3226][Sdoi2008]校门外的区间——线段树

    题目 略 题解 直接套黄学长模板. Orz 代码 #include <bits/stdc++.h> using namespace std; #define ll long long #d ...

  3. java中 快捷键输入System.out.println();

    syso 然后:alt+ /(就是问号键)

  4. tmux下vim颜色不正常问题

    在解决了tmux下,make menuconfig颜色不正常问题https://www.cnblogs.com/zqb-all/p/9702582.html后,引入了新的问题,vim颜色错乱. 尝试了 ...

  5. Linux虚拟地址空间布局以及进程栈和线程栈总结【转】

    转自:http://www.cnblogs.com/xzzzh/p/6596982.html 原文链接:http://blog.csdn.net/freeelinux/article/details/ ...

  6. git 提示 Please move or remove them before you can merge 解决办法

    解决Git冲突造成的Please move or remove them before you can merge git clean -d -fx其中x -----删除忽略文件已经对git来说不识别 ...

  7. 【bzoj1013】球形空间产生器

    高斯消元…… 看完线代那一节之后感觉真的是……naive! 线代大法好. #include<bits/stdc++.h> using namespace std; ; int n; ][] ...

  8. JSOI2016酱油记

    高一,第一次参加NOIP. 后悔初中没有报过名...唉,后悔也来不及了. 不知道自己一个暑假干了什么...算法没学多少,脑子倒是越来越不好使了. 过了初赛,数周后一脸茫(meng)然(bi)地去考场. ...

  9. mac废纸篓清空的心得、mac设置不睡眠不待机不锁屏、如何快速锁屏待机睡眠、mac重启、mac学习的必备软件-城

    mac废纸篓清空: 1.使用废纸篓的清空废纸篓,清空所有包括被锁定的文件: 2.使用“磁盘工具”的“修复磁盘权限”,修复完成再操作清空废纸篓: 3.使用cleanmymac软件“垃圾清理”和“擦除器” ...

  10. [ 总结 ] Linux系统测试硬盘I/O

    检测硬盘I/O相对来说还是一个比较抽象的概念,但是对系统性能的影响还是至关重要的. (1)使用hdparm命令检测读取速度:    hdparm命令提供了一个命令行的接口用于读取和设置IDE和SCSI ...