delphi1.html

对于学习很有帮助

  </tr>
</table>
</center></div>

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

<hr width="80%">

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

<table border="1" cellpadding="0" cellspacing="0">
  <tr>
    <td><strong><em><font face="楷体_GB2312" size="5">在程序执行期间让其他控件能响应消息</font></em></strong></td>
  </tr>
</table>
</center></div>

<p><font face="楷体_GB2312" size="4">　　当一段程序代码在执行一个很费时的操作（例如对软盘进行读写操作）时，其他控件将无法得到Windows的消息，换句话说，将一个过程被执行时，在该过程结束之前，应用程序的回调函数不会被Windows调用，也就无法响应系统消息。<br>
　　举例来说，如果在一个过程中改变了一个TLabel控件的Caption属性值，仅当该过程结束后用户才会在屏幕上看到TLabel控件被重画，如果你设计了一个拷贝文件的过程，并想在拷贝过程中不断地显示已拷贝的字节数，如果直接在拷贝操作的循环中改变要显示的字节数是不行的，用户实际上看不到这个不断变化的数字，因为当拷贝操作的过程未结束之前，其它控件根本未接收到重画消息。<br>
　　另一个极端的例子，如果你的程序要进行一个死循环，退出该死循环的条件是用户单击按钮Button2，那么你会发现在死循环执行期间，所有的控件都失效了，你的程序也就变成了一个大BUG。下面的代码示例显示了如何避免这一问题，该段程序的含义是当用户单击按钮Button1时开始执行死循环，单击Button2时退出这个死循环。</font></p>
<div align="center"><center>

<table border="0" cellpadding="2">
  <tr>
    <td><pre><font face="Courier New" color="#000000">var
  ExitFlag: Boolean = false;

procedure TForm1.Button1Click(Sender: TObject);
const
  Busy: Boolean=false;
begin
  if Busy then Exit; // </font><font color="#000000">若已进入本过程则退出
  </font><font face="Courier New" color="#000000">Busy := true; //</font><font color="#000000">设立已进入本过程标志，这一句很重要
  </font><font face="Courier New" color="#000000">while true do begin
    Application.ProcessMessages; // </font><font color="#000000">让其他控件能获取消息
    </font><font face="Courier New" color="#000000">if ExitFlag then Break; // </font><font color="#000000">若标志为真退出死循环
  </font><font face="Courier New" color="#000000">end;
  Busy := false; // </font><font color="#000000">清除已进入本过程标志
</font><font face="Courier New" color="#000000">end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  ExitFlag := true;
end;</font></pre>
    </td>
  </tr>
</table>
</center></div>

<p><font face="楷体_GB2312" size="4">　　上例中有两点很重要，其一是死循环中的Application.ProcessMessage，这句代码使程序的其他控件也能获取消息，如果没有这一句则程序会陷入死循环中；另一个重要的代码是在Button1Click过程开始处判断是否正在执行死循环，若是则直接退出，如果没有这个判断，则当用户重复单击Button1时可能导致代码重入，因为在过程中调用了ProcessMessage方法。</font></p>

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

<hr width="80%">

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

<table border="1" cellpadding="0" cellspacing="0">
  <tr>
    <td><strong><em><font face="楷体_GB2312" size="5">获取程序自身所在路径和文件名</font></em></strong></td>
  </tr>
</table>
</center></div>

<p><font face="楷体_GB2312" size="4">　　Delphi在启动应用程序时与C语言一样会传递命令行参数给应用程序，第一个参数（索引号为零）表示应用程序本身的文件名（包括完整的路径），这个String参数由函数</font><font size="4" face="Arial" color="#000000">ParamStr(0)</font><font face="楷体_GB2312" size="4">返回。<br>
　　顺便说一句，Delphi提供了分析文件名的多个函数，如果你需要从文件名中得到路径名，可用下面的两个函数，这两个函数有一点点微小的差别： 
</font>

<ul type="square">
  <li><font size="4" face="Arial" color="#000000">ExtractFilePath(FileName:String)<br>
    </font><font face="楷体_GB2312" size="4">该函数返回路径名，其结尾字符总是“\”</font></li>
  <li><font size="4" face="Arial" color="#000000">ExtractFileDir(FileName:String)<br>
    </font><font face="楷体_GB2312" size="4">该函数同样返回路径名，但不包括结尾的字符“\”，除非返回的路径是根目录。</font></li>
</ul>

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

<hr width="80%">

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

<table border="1" cellpadding="0" cellspacing="0">
  <tr>
    <td><strong><em><font face="楷体_GB2312" size="5">怎样制作自己的构件</font></em></strong></td>
  </tr>
</table>
</center></div>

<p><font face="楷体_GB2312" size="4">　　制作构件并不是三言两语就能说清楚的，下面用一个简单的实例来说明。这个新控件从TLabel派生而来，是一个增强型的TLabel控件，当用户单击这个控件时，就会执行一个特殊的操作。该控件增加了一个属性URLString，其值表示要执行的操作。例如，当该属性值为“http://seawave.yeah.net”这个字符串时，如果用户单击该字符串，则会调用系统默认的浏览器来访问我的个人主页。 
</font>

<ul type="square">
  <li><font face="楷体_GB2312" size="4">首先，为这个构件取一个名字，这里我用SWURLLabel（个人喜好，SW表示SeaWave）。</font></li>
  <li><font face="楷体_GB2312" size="4">由于这个控件本质上是一个TLabel，所以它从TLabel类派生而来，继承所有TLabel的属性、方法和事件句柄。</font></li>
  <li><font face="楷体_GB2312" size="4">该构件准备放在Delphi的一个新面板上，名为“SeaWave”，因此在Register过程中指明了SeaWave字符串型的参数。</font></li>
  <li><font face="楷体_GB2312" size="4">要为新控件增加一个字符串型的属性，名为URL，其值表示要执行的操作。</font></li>
  <li><font face="楷体_GB2312" size="4">为新控件增加一个事件句柄OnBeforeExecuteURL，指向当执行URL之前要调用的过程。</font></li>
</ul>

<p><font face="楷体_GB2312" size="4">　　下面是SWURLLabel.PAS源程序清单。</font></p>
<div align="center"><center>

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

interface

uses
  Windows, Classes, Controls, StdCtrls, SysUtils, Forms,
  Graphics, ShellAPI;

type
  TSWURLLabel = class(TLabel) // </font><font color="#000000">从</font><font face="Courier New" color="#000000">TLabel</font><font color="#000000">类派生
  </font><font face="Courier New" color="#000000">private
    FOnBeforeExecuteURL: TNotifyEvent; // </font><font color="#000000">指向执行</font><font face="Courier New" color="#000000">URL</font><font color="#000000">之前要调用的过程
    </font><font face="Courier New" color="#000000">FURL: String;                      // URL</font><font color="#000000">字符串
    </font><font face="Courier New" color="#000000">procedure SetURL(Value:String);
  protected
    procedure Click; override;         // </font><font color="#000000">重载</font><font face="Courier New" color="#000000">TLabel</font><font color="#000000">的</font><font face="Courier New" color="#000000">Click</font><font color="#000000">方法
  </font><font face="Courier New" color="#000000">public
    constructor Create(AOwner:TComponent); override; // </font><font color="#000000">构造函数
    </font><font face="Courier New" color="#000000">function ExecuteURL: Boolean; // </font><font color="#000000">方法，执行</font><font face="Courier New" color="#000000">URL
  published
    property OnBeforeExecuteURL: TNotifyEvent
      read FOnBeforeExecuteURL
      write FOnBeforeExecuteURL default nil;
    property OnExecuteURL: TNotifyEvent
      read FOnExecuteURL
      write FOnExecuteURL default nil;
    property URL:String read FURL write SetURL;
  end;

procedure Register;

implementation

const DefaultURL:String = 'http://seawave.yeah.net';

{ </font><font color="#000000">重载</font><font face="Courier New" color="#000000">TLabel</font><font color="#000000">的</font><font face="Courier New" color="#000000">Click</font><font color="#000000">方法 </font><font face="Courier New" color="#000000">}
procedure TSWURLLabel.Click;
begin
  inherited Click; // </font><font color="#000000">执行</font><font face="Courier New" color="#000000">TLabel</font><font color="#000000">的</font><font face="Courier New" color="#000000">Click</font><font color="#000000">过程
  </font><font face="Courier New" color="#000000">ExecuteURL;      // </font><font color="#000000">调用</font><font face="Courier New" color="#000000">ExecuteURL</font><font color="#000000">过程来执行</font><font face="Courier New" color="#000000">URL
end;

{ </font><font color="#000000">构造函数，初始化属性 </font><font face="Courier New" color="#000000">}
constructor TSWURLLabel.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);  // </font><font color="#000000">首先调用父类的构造函数
  </font><font face="Courier New" color="#000000">FURL := DefaultURL;        // URL</font><font color="#000000">属性值初始化为默认值
  </font><font face="Courier New" color="#000000">Caption := DefaultURL;     // Caption
  Font.Color := clBlue;      // </font><font color="#000000">颜色默认为蓝色
  </font><font face="Courier New" color="#000000">Font.Style := [fsUnderline]; // </font><font color="#000000">字体默认为带下划线
  </font><font face="Courier New" color="#000000">Cursor := crHandPoint;     // </font><font color="#000000">光标形状默认为手掌形
</font><font face="Courier New" color="#000000">end;

{ </font><font color="#000000">方法，调用</font><font face="Courier New" color="#000000">Windows API</font><font color="#000000">执行</font><font face="Courier New" color="#000000">URL }
function TSWURLLabel.ExecuteURL;
var
  ZFileName:array[0..255] of char;
begin
  if Assigned(FOnBeforeExecuteURL) then
    FOnBeforeExecuteURL(Self);  // </font><font color="#000000">若指定了事件处理过程则调用它
  </font><font face="Courier New" color="#000000">if Length(FURL)&gt;0 then begin
    // </font><font color="#000000">当</font><font face="Courier New" color="#000000">URL</font><font color="#000000">不为空时执行
    </font><font face="Courier New" color="#000000">StrPCopy(ZFileName, FURL);
    ShellExecute(Application.Handle, nil,
                 ZFileName, nil, nil, SW_SHOWNORMAL);
  end;
end;

{ </font><font color="#000000">登记新构件的过程 </font><font face="Courier New" color="#000000">}
procedure Register;
begin
  // </font><font color="#000000">第一个参数是面板页的名字，第二个参数是新构件的类名
  </font><font face="Courier New" color="#000000">RegisterComponents('SeaWave', [TSWURLLabel]);
end;

{ </font><font color="#000000">私有方法，设置</font><font face="Courier New" color="#000000">URL</font><font color="#000000">属性值 </font><font face="Courier New" color="#000000">}
procedure TSWURLLabel.SetURL(Value:String);
begin
  FURL := Value;
  if csDesigning in ComponentState then
    Caption := Value;
end;

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

<p><font face="楷体_GB2312" size="4">　　如果要为你的新控件加一个放在Delphi面板上的图标，请用Delphi的映象编辑器建立一个与构件源程序同名的、后缀名为DCR的资源文件，该资源文件包含一个24乘24的16色位图（即新构件的图标），将此DCR文件与源程序文件放在同一目录下，安装新构件完毕后就会发现新构件的图标了（否则Delphi为新构件建立一个省缺的图标）。</font></p>

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