delphi2.html

来自「对于学习很有帮助」· HTML 代码 · 共 448 行 · 第 1/2 页

<p><font face="楷体_GB2312" size="4">　　某些程序运行启动后并不出现在任务条中，而是缩小为任务条右下角的一个小图标，当鼠标移到这个小图标上时会出现一些提示信息、单击该小图标会执行一些特定的操作。便如任务条右下角的小喇叭图标，单击它会弹出一个简单的音量控制条，双击会启动另一个更大的音量控制程序。<br>
　　在Shell32.DLL动态链接库中包括一个函数Shell_NotifyIconA()可通知Windows在任务条右下角加入一个小图标，可惜该函数的详细说明未收入Delphi的帮助文档中，下面以一个简单的实例来说明如果使用该函数。</font></p>
<div align="center"><center>

<table border="0" cellpadding="2">
  <tr>
    <td><pre><font face="Courier New" color="#000000">unit Unit1;

interface

{ </font><font color="#000000">记住在</font><font face="Courier New" color="#000000">uses</font><font color="#000000">部分中包括 </font><font face="Courier New" color="#000000">ShellAPI}
uses
  Windows, Messages, SysUtils, Classes,
  Graphics, Controls, Forms, Dialogs,
  ShellAPI, StdCtrls;

{</font><font color="#000000">自定义消息，当小图标捕捉到鼠标事件时</font><font face="Courier New" color="#000000">Windows</font><font color="#000000">向回调函数发送此消息</font><font face="Courier New" color="#000000">}
const MY_MESSAGE = WM_USER + 100;

type
  TForm1 = class(TForm)
  procedure FormCreate(Sender: TObject);
  procedure FormClose(Sender: TObject; var Action: TCloseAction);
  procedure FormPaint(Sender: TObject);
  private
    procedure OnIconNotify(var Message: TMessage);
      message MY_MESSAGE;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

{</font><font color="#000000">当小图标捕捉到鼠标事件时进入此过程</font><font face="Courier New" color="#000000">}
procedure TForm1.OnIconNotify(var Message: TMessage);
const
  Busy: Boolean = false;
begin
  if not Busy then begin
    Busy := true;
    if Message.LParam=WM_LBUTTONDOWN then
      if Application.MessageBox('Are you sure',
         'Exit', MB_YESNO)=IDYES then Close;
    Busy := false;
  end;
end;

{</font><font color="#000000">当主</font><font face="Courier New" color="#000000">Form</font><font color="#000000">建立时通知</font><font face="Courier New" color="#000000">Windows</font><font color="#000000">加入小图标</font><font face="Courier New" color="#000000">}
procedure TForm1.FormCreate(Sender: TObject);
var
  nid: TNotifyIconData;
begin
  nid.cbSize := sizeof(nid); // nid</font><font color="#000000">变量的字节数
  </font><font face="Courier New" color="#000000">nid.Wnd := Handle; // </font><font color="#000000">主窗口句柄
  </font><font face="Courier New" color="#000000">nid.uID := -1; // </font><font color="#000000">内部标识，可设为任意数
  </font><font face="Courier New" color="#000000">nid.hIcon := Application.Icon.Handle; // </font><font color="#000000">要加入的图标句柄，可任意指定
  </font><font face="Courier New" color="#000000">nid.szTip := 'This is a test application'; // </font><font color="#000000">提示字符串
  </font><font face="Courier New" color="#000000">nid.uCallbackMessage := MY_MESSAGE; // </font><font color="#000000">回调函数消息
  </font><font face="Courier New" color="#000000">nid.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE; // </font><font color="#000000">指明哪些字段有效
  </font><font face="Courier New" color="#000000">if not Shell_NotifyIcon(NIM_ADD, @nid) then begin
    ShowMessage('Failed!');
    Application.Terminate;
  end;
  {</font><font color="#000000">将程序的窗口样式设为</font><font face="Courier New" color="#000000">TOOL</font><font color="#000000">窗口，可避免在任务条上出现</font><font face="Courier New" color="#000000">}
  SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
end;

{</font><font color="#000000">程序被关闭时通知</font><font face="Courier New" color="#000000">Windows</font><font color="#000000">去掉小图标</font><font face="Courier New" color="#000000">}
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
  nid: TNotifyIconData;
begin
  nid.cbSize := sizeof(nid); // nid</font><font color="#000000">变量的字节数
  </font><font face="Courier New" color="#000000">nid.uID := -1; //</font><font color="#000000">内部标识，与加入小图标时的数一致
  </font><font face="Courier New" color="#000000">nid.Wnd := Handle; //</font><font color="#000000">主窗口句柄
  </font><font face="Courier New" color="#000000">Shell_NotifyIcon(NIM_DELETE, @nid); //</font><font color="#000000">去掉小图标
</font><font face="Courier New" color="#000000">end;

{</font><font color="#000000">主窗口初始化完毕并显示时将激活</font><font face="Courier New" color="#000000">Paint</font><font color="#000000">重画事件，此时将主窗口隐藏</font><font face="Courier New" color="#000000">}
procedure TForm1.FormPaint(Sender: TObject);
begin
  Hide;
end;

end.</font></pre>
    </td>
  </tr>
</table>
</center></div>

<p><font face="楷体_GB2312" size="4">　　上例中将程序的图标放在任务条右下角，然后隐藏自身，当用户移动鼠标至该图标上时会看到提示字符串，如果单击该图标会出现一个对话框，选择Yes退出程序并清除小图标。</font></p>

<p align="center"><a href="#topofpage">回到页首</a></p>

<hr width="80%">

<p><a name="OnlyOne"></a></p>
<div align="center"><center>

<table border="1" cellpadding="0" cellspacing="0">
  <tr>
    <td width="100%"><strong><em><font face="楷体_GB2312" size="5">防止程序被重复执行</font></em></strong></td>
  </tr>
</table>
</center></div>

<p><font face="楷体_GB2312" size="4">　　Windows95的程序一般都可以重复执行，例如你按下WIN+E组合键即启动资源管理器，如果再按WIN+E组合键又会出现一个资源管理器，这两个程序互不干扰。有时候你可以需要制作这样一个程序：当该程序已经执行时，若用户企图再次执行该程序则只会激活那个已执行的程序，而不是又出现一个副本。<br>
　　完成这个目的的核心就是要在程序启动时查找该程序是否已经运行，我曾试过很多种方法，包括向“全局元素表”(Global 
ATOM Table)写特定字符串等等，但最简单的方法还是下面这个：</font> 

<ul type="square">
  <li><font face="楷体_GB2312" size="4">在程序启动时将Application的Title特性字段的值暂时改变。</font></li>
  <li><font face="楷体_GB2312" size="4">利用Windows API函数FindWindows()查找窗口</font></li>
  <li><font face="楷体_GB2312" size="4">恢复Application的Title值</font></li>
</ul>

<p><font face="楷体_GB2312" size="4">　　上述步骤一般在主Form的OnCreate事件中实现，示例如下：</font></p>
<div align="center"><center>

<table border="0" cellpadding="0" cellspacing="0">
  <tr>
    <td width="100%"><pre><font face="Courier New" color="#000000">procedure TForm1.FormCreate(Sender: TObject);
var
  ZAppName: array[0..127] of char;
  Hold: String;
  Found: HWND;
begin
  Hold := Application.Title;
  Application.Title := 'OnlyOne'
     + IntToStr(HInstance); // </font><font color="#000000">暂时修改窗口标题
  </font><font face="Courier New" color="#000000">StrPCopy(ZAppName, Hold); // </font><font color="#000000">原窗口标题
  </font><font face="Courier New" color="#000000">Found := FindWindow(nil, ZAppName); // </font><font color="#000000">查找窗口
  </font><font face="Courier New" color="#000000">Application.Title := Hold; // </font><font color="#000000">恢复窗口标题
  </font><font face="Courier New" color="#000000">if Found&lt;&gt;0 then begin
    // </font><font color="#000000">若找到则激活已运行的程序并结束自身
    </font><font face="Courier New" color="#000000">ShowWindow(Found, SW_RESTORE);
    Application.Terminate;
  end;
end;</font></pre>
    </td>
  </tr>
</table>
</center></div>

<p><font face="楷体_GB2312" size="4">　　用该算法制作的构件请到“Delphi构件”页下载。</font></p>

<p align="center"><a href="#topofpage">回到页首</a></p>

<hr width="80%">

<p><a name="HowMany"></a></p>
<div align="center"><center>

<table border="1" cellpadding="0" cellspacing="0">
  <tr>
    <td width="100%"><strong><em><font face="楷体_GB2312" size="5">限制设计者加入某类构件的数目</font></em></strong></td>
  </tr>
</table>
</center></div>

<p><font face="楷体_GB2312" size="4">　　一般情况下，程序设计者可以在Form中加入不限数量的构件，但某些构件只需要或只能加入一个，例如前例“防止重复执行”的构件就属于这种情况，此时可以在构件的源代码中加入一个静态变量来记录已建立的个数，这个变量在构件的Create方法中被递增，而在构件的Destroy方法中被递减，而在Create方法中若发现数量已超过限制即可提出一个异常来中止构件的构造（在类的构造函数中出现异常将自动调用该类的析构函数）。<br>
　　下例代码段示例如果只允许设计者在Project中加入一个某类构件：</font></p>
<div align="center"><center>

<table border="0" cellpadding="0" cellspacing="0">
  <tr>
    <td width="100%"><pre><font face="Courier New" color="#000000">unit MyTest

interface

uses
  Windows, Classes, SysUtils, Forms;

type
  TMyTest = class(TComponent)
  public
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
  end;

procedure Register;

implementation

var
  SelfCounts: Integer = 0; // </font><font color="#000000">记录建立个数的静态变量

</font><font face="Courier New" color="#000000">procedure Register;
begin
  RegisterComponents('Test', [TMyTest]);
end;

constructor TMyTest.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  Inc(SelfCounts); // </font><font color="#000000">计数器递增
  </font><font face="Courier New" color="#000000">if SelfCounts&gt;1 then begin
    // </font><font color="#000000">当超过限制时提出一个异常
    </font><font face="Courier New" color="#000000">raise Exception.Create('</font><font color="#000000">最多只能建立一个这样的构件！</font><font face="Courier New" color="#000000">');
  end;
end;

destructor TSWOnlyOne.Destroy;
begin
  Dec(SelfCounts); // </font><font color="#000000">计数器递减
  </font><font face="Courier New" color="#000000">inherited Destroy;
end;

end.</font></pre>
    </td>
  </tr>
</table>
</center></div>

<p align="center"><a href="#topofpage">回到页首</a></p>
</body>
</html>