csg6fqaset4的部落格

資料來源:http://www.docin.com/p-1620529.html

DELPHI教學

遮罩系統功能鍵
Win95適用
   當你不需要讓用戶按Alt+Enter、Ctrl+Alt+Del、Ctrl+Esc等功能鍵的時候加入以下代碼：
Var
temp:integer;
begin
SystemParametersInfo(Spi_screensaverrunning,1,@temp,0);
end;
　　當你要恢復功能鍵時用以下代碼：
Var
Temp:integer;
begin
SystemParametersInfo(spi_screensaverrunning,0,@temp,0);
end;

分行提示

   無論你什麼時候要分行顯示的時候，只需要在字串中間加入“#13”就可以了，但在屬性框裏卻不能這麼幹，以下就幾種控制項加以說明：
begin
Label1.caption :='垂'+#13+'直'+#13+'顯'+#13+'示';
Edit1.Hint :='輸入框說明：'+#13+'文本的輸入';
end;

任意列印

　　有時我們要列印任意排列的表或往已經印好的登記表上對號入座寫上資料時，可以新建一個表單（假設為Form1），再把Form1的BorderStyle設為bsNone、AutoScroll設為True，接下來再創建一個新表單（假設為Form2），再建個按鈕Button1，編寫代碼：
procedure TForm2.Button1Click(Sender: TObject);
begin
Form1.Width :=900;
Form1.Height :=800;
Form1.Print;
end;
　　接下來你在Form1上對應的位置寫上資料，運行後按Button1就會一五一十的列印下來了。

運行時生成控制項

   一、運行時生成可視控制項：以下以TEdit 控制項為例
1.在Form的Public中定義TEdit控制項
　　Edit1:TEdit;
2.在需要生成的地方加入以下代碼：
　　Edit1:=TEdit.Create(Self);
　　Edit1.Parent:=Form1;
　　Edit1.Left ?:=20;
　　Edit1.Top :=20;
　　Edit1.Text :='Edit1 Text';
3.使用完畢後，釋放分配的資源
　　if? Assigned(Edit1) then Edit1.Free; ?
　　二、運行時生成非可視控制項：以下以 TTimer控制項為例
1.在Form的Public中定義TTimert控制項
　　Timer1:TTimber;
2.在需要生成的地方加入以下代碼：
　　Timer1:=TTimer.Create(Self);
　　Timer1.OnTimer:=YourAction;
YourAction是自己定義的OnTimer事件，使用procedure TForm1.YourAction(Sender:TObject); 完成
3.使用完畢後，釋放分配的資源
　　if? Assigned(Timer1) then Timer1.Free; ?

獲得命令行參數

1. 取得命令列參數的個數: ParamCount 函數
2. 呼叫 ParamStr(0), 傳回執行檔的檔名(含路徑)
3. 呼叫 ParamStr(n), 傳回第ｎ個參數的內容
例子：
procedure TForm1.FormCreate(Sender: TObject);
var
　ix: integer;
begin
　Memo1.Lines.Clear;
　if ParamCount = 0 then
　　Memo1.Lines.Add('??統??.')
　else
　begin
　　Memo1.Lines.Add('檔名:' + ParamStr(0));
　　for ix := 1 to ParamCount do
　　Memo1.Lines.Add(ParamStr(ix));
　end;
end;

查閱可視窗口標題

下面只是舉出一個例子提供參考:
運用API函數GetWindow()配合GetWindowText()逐一查出各視窗的標題
1. File | New Project 開始一個新的工程
2. 在 Form1 中安排 Button 與 Memo 各一
3. 在 Button1 的 OnClick 事件中撰寫程式如下:
procedure TForm1.Button1Click(Sender: TObject);
var
pos　hCurrentWindow: HWnd;
　szText: array[0..254] of char;
begin
　hCurrentWindow := GetWindow(Handle, GW_HWNDFIRST);
　while hCurrentWindow <> 0 do
　begin
　if GetWindowText(hCurrentWindow, @szText, 255)>0 then
　Memo1.Lines.Add(StrPas(@szText));
　hCurrentWindow:=GetWindow(hCurrentWindow, GW_HWNDNEXT);
　end;
end;
DELPHI教學－02

關閉外部應用程式

   如何在 Delphi 應用程式中, 去關閉外部已開啟的應用程式？
下面給出一段在 Delphi 中關閉“計算器”程式為例：
var
HWndCalculator : HWnd;
begin
// find the exist calculator window
HWndCalculator := Winprocs.FindWindow(nil, '計算器'); // close the exist Calculator
if HWndCalculator <> 0 then
SendMessage(HWndCalculator, WM_CLOSE, 0, 0);
end;

程式中使用自定義的滑鼠

   一.建立工程與一個資源檔
用Image Editor編輯一個鼠游標（Fild | New | Resource File）
新建一個 CURSOR_1 的 CURSOR, 設定好它的 Hot Spot（Cursor | Set Hot Spot）
存檔時注意要和建立的Project存在同一個目錄在本例我們先假定為 MyCursor.res
二. 程式部分
定義一個常數crMyCursor, 這個常數您必須設成大於零的任何整數， 以 LoadCursor() 函數將自訂的滑鼠資源load 進來， 以下為源代碼：
// unit.pas
unit Unit1;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes,
Graphics, Controls, Forms, Dialogs;
const
crMyCursor = 1; (* 宣告一個常數 *)
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
{$R mycursor.res}//這行$R不可少, 否則自訂的鼠游標就出不來了
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
//將滑鼠資源 load 進來
Screen.Cursors[crMyCursor] := LoadCursor (hInstance,'CURSOR_1');
Cursor := crMyCursor;//指定 form1 的 cursor 為自訂滑鼠
Button1.Cursor := crMyCursor;//指定Button1的cursor為自訂滑鼠
end;
end.

得到Windows用戶名和序列號

   如何得到Windows的用戶名稱和產品序列號呢？
1. 可以用 WNetGetUser() 這個函數來得到 user name;
2. Windows 95 的產品序號可以用 TRegistry 到 Registry Database 中找出來;
// 取得用戶名稱
function GetUserName: AnsiString;
var
lpName: PAnsiChar;
lpUserName: PAnsiChar;
lpnLength: DWORD;
begin
Result := '';
lpnLength := 0;
WNetGetUser(nil, nil, lpnLength); // 取得字串長度
if lpnLength > 0 then
begin
GetMem(lpUserName, lpnLength);
if WNetGetUser(lpName, lpUserName, lpnLength) = NO_ERROR then
Result := lpUserName;
FreeMem(lpUserName, lpnLength);
end;
end; { GetUserName }

// 取得 Windows 產品序號
function GetWindowsProductID: string;
var
reg: TRegistry;
begin
Result := '';
reg := TRegistry.Create;
with reg do
begin
RootKey := HKEY_LOCAL_MACHINE;
OpenKey('Software\Microsoft\Windows\CurrentVersion', False);
Result := ReadString('ProductID');
end;
reg.Free;
end;

實現打開檔

   打開Windows已經註冊的檔其實很簡單，根據以下代碼定義一個過程：
procedure URLink(URL:PChar);
begin
ShellExecute(0, nil, URL, nil, nil, SW_NORMAL);
end;
在要調用的地方使用
URLink('Readme.txt');
如果是鏈結主頁的話，那麼改用
URLink('http://gui.yeah.net');

得到執行程式的目錄

   SysUtils 單元中有 ExtractFileDir 與 ExtractFilePath兩個類似的函數, 用哪一個?沒有太大的關係。
　　不過有以下的差別: ExtractFilePath 傳回值的最後一個字元是反斜杠“／”。
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(ExtractFileDir(Application.Exename));
// ie: c:\temp
ShowMessage(ExtractFilePath(Application.Exename));
// ie: c:\temp\
end;
相同點： 如果執行檔在根目錄下(如：C:\SAMPLE.EXE)的話, 兩者的傳回值相同， 且最後一個字元都是“／”。

將滑鼠鎖定在一定範圍

   如何將滑鼠鎖定在一定的範圍內呢？
請在Form中放置二個 Button, 然後分別為這兩個按鈕定義OnClick回應事件如下:
// 限制
procedure TForm1.Button1Click(Sender: TObject);
var
rtButton2: TRect;
begin
rtButton2 := Button2.BoundsRect;
MapWindowPoints(handle, 0, rtButton2, 2); // 座標換算
ClipCursor(@rtButton2); // 限制滑鼠移動區域
end;

// 還原
procedure TForm1.Button2Click(Sender: TObject);
var
rtScreen: TRect;
begin
rtScreen := Rect(0, 0, Screen.Width, Screen.Height);
ClipCursor(@rtScreen);
end;
DELPHI教學－03

控制表單

   如何在 Delphi 中把 Form 控制成不能放大/縮小/移動/關閉？1、把 Form 的 BorderIcons 下的幾個子屬性值全改為 False;2、修改 Form 的 BorderStyle 的值為bsSingle ;3、為了讓視窗不能移動,可以自已攔下 WM_NCHITTEST 消息, 對該消息的處理為：一概回應滑鼠點在視窗的 Client 區域, 相信這個視窗就呆呆的不會動了。
詳情可以查一下 Win32API Help 的 CreateWindow() 與 WM_NCHITTEST 的說明。
下面是一個例子, 請參考看看：
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,Forms, Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
procedure WMNCHitTest(var Msg: TMessage); message WM_NCHITTEST;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
begin
Close; // 不可少, 因為已經沒有其他方法能關閉此視窗了
end;

procedure TForm1.WMNCHitTest(var Msg: TMessage);
begin
inherited; // 這樣,移動就不可能了...
Msg.Result := HTCLIENT;
end;
end.

限制FORM的大小

   使用過DELPHI的朋友都會注意到DELPHI本身最上面的視窗，當它極大時只占螢幕的一小部分，它是如何實現的呢，請看下面的說明：
1)在FORM私有聲明部分加上如下一行：
procedure WMGetMinMaxInfo( var Message:TWMGetMinMaxInfo ); message WM_GETMINMAXINFO;
2)在聲明部分加上如下幾行:
procedure TForm1.WMGetMinMaxInfo( var Message :TWMGetMinMaxInfo );
begin
with Message.MinMaxInfo^ do
begin
ptMaxSize.X := 200; {最大化時寬度}
ptMaxSize.Y := 200; {最大化時高度}
ptMaxposition.X := 99; {最大化時左上角橫坐標}
ptMaxposition.Y := 99; {最大化時左上角縱坐標}
end;
Message.Result := 0; {告訴Windows你改變了 minmaxinfo}
inherited;
end;

動態修改顯示器解析度

   Windows提供給我們兩個API函數，可以動態調整顯示器的解析度，他們是EnumDisplaySettings() 和ChangeDisplaySettings()，下面這個例子就是了

function DynamicResolution(X, Y: word): BOOL;
var
lpDevMode: TDeviceMode;
begin
Result := EnumDisplaySettings(nil, 0, lpDevMode);
if Result then
begin
lpDevMode.dmFields := DM_PELSWIDTH Or DM_PELSHEIGHT;
lpDevMode.dmPelsWidth := X;
lpDevMode.dmPelsHeight := Y;
Result := ChangeDisplaySettings(lpDevMode, 0) = DISP_CHANGE_SUCCESSFUL;
end
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if DynamicResolution(640, 480) then
ShowMessage('Now is 640*480');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
if DynamicResolution(800, 600) then
ShowMessage('Now is 800*600');
end;

回車替Tab下移控制項

需要用回車鍵代替TAB鍵下移一個控制項時，把KeyPress設為True，加入下列代碼攔截擊鍵：
Procedure TForm1.FormKeyPress(Sender:Tobject;Var Key:Char);
Begin
　if key=#13 then { 判斷是按執行鍵}
　if not (ActiveControl is TDbgrid) Then
　Begin { 不是在TDbgrid控制項內}
　　key:=#0;
　　perform(WM_NEXTDLGCTL,0,0);{移動到下一個控制項}
　end else
　if (ActiveControl is TDbgrid) Then{是在 TDbgrid 控制項內}
　begin
　　With TDbgrid(ActiveControl) Do
　　if Selectedindex<(FieldCount-1) then
　　Selectedindex:=Selectedindex+1{ 移動到下一欄位}
　　else Selectedindex:=0;
　end;
End;

模擬按下某鍵

   讓 WIN95 類比按了一個按鍵，就向某表單發送按鍵一樣，例如按下 ENTER 或者 TAB 鍵，或者按 7 鍵
postMessage(Object.Handle, WM_KEYDOWN, VK_TAB, 0);
{Object表示表單名，WM_KEYDOWN是按下，VK_TAB是發送的按鍵}
postMessage(edit1.Handle, WM_KEYDOWN, 55, 0);
{向edit1發送一個7字}

隱藏桌面上的圖示

   使桌面上的圖示消失，連桌面上的右鍵功能也不能使用如果不讓初學者亂用“我的電腦”的話，那麼把程式放到“啟動”裏，順便把“Windows資源管理器”也去掉， 再加上個多用戶密碼，那麼想破壞電腦檔也無從下手了。該程式Delphi 4裏通過
var
hDesktop : THandle;
begin
hDesktop := FindWindow('Progman', nil);
ShowWindow(hDesktop, SW_HIDE);
end;
 DELPHI教學－04

返回程式執行參數

   有關 Delphi 傳入應用程式的命令列參數, 請參考以下的說明：
用ParamCount函數取得命令參數的個數:
呼叫 ParamStr(0), 傳回執行檔的檔名(含路徑)
呼叫 ParamStr(n), 傳回第ｎ個參數的內容
procedure TForm1.FormCreate(Sender: TObject);
var
sFileName: string;
begin
if ParamCount > 0 then begin (* 有執行參數傳入 *)
sFileName := ParamStr(1); (* 取得參數內容 *)
if FileExists(sFileName) then
Memo1.Lines.LoadFromFile(sFileName)
else
Application.MessageBox('找不到指定的檔案', '訊息', 48);
end;
end;

轉讓控制權

   有時由於長時間的迴圈語句佔用了cpu的處理權，無法運行 其他程式，照成閉環。這時用以下命令轉讓控制權，讓作業系統處理其他事件。Application.ProcessMessages;

關閉Windows

   控制WINDOWS的開關：如關閉WINDOWS，重新啟動WINDOWS等, ExitWindowsEx(UINT uFlags,DWORD dwReserved);是實現這一功能的API函數首先定義常數
const
EWX_FORCE=4; //關閉所有程式並以其他用戶身份登錄
EWX_LOGOFF=0; //重新啟動電腦並切換到MS-DOS方式
EWX_REBOOT=2; //重新啟動電腦
EWX_SHUTDOWN=1;//關閉電腦
運行時給How賦值，讓他等於EWX_SHUTDOWN或其他，調用以下語句
ExitWindowsEx(How,0);

實現超連結

   在程式中實現打開流覽器，打開郵件程式的功能首先要在uses部分加入uses Shellapi;
   接著在需要超連結的地方使用
ShllExecute(handle,nil,pchar('mailto:guihong@163.net'),nil,nil,sw_shownormal);
   其中pchar()中的mailtos是打開郵件程式的，可以換成http://、ftp://、gopher://、new:、telnet:等多種形式

程式啟動畫面

　　在啟動程式之前出現啟動畫面的方法多得是，但有些是調用“記時器”來延時的，這種方法有時拖慢了程式的啟動速度，下面介紹又一方法，給大家參考對比一下。
　　建一個啟動封面表單，假設為Form2，先設置好BorderIcons、BorderStyle、FormStyle、position，接著在表單上加入圖片框、文本框，設置好後在菜單裏選Project裏的Options，把Form2從Auto-create forms裏轉到Available forms。再接著就是按Ctrl+F12鍵，選Project1，出現工程單元，其內容如下
...
Application.CreateForm(TForm1, Form1);
Application.Run;
..
　　在Application.CreateForm(TForm1, Form1); 前加入如下語句：
form2:=tform2.create(application);
form2.Show;
form2.Update;
　　然後在Application.Run;前面加入如下語句：
form2.hide;
form2.free;

豐富多彩的標籤

   如果你不滿足於Delphi提供的簡單的標籤提示，想要在標籤中有不同的字體，有不同的顏色來豐富我們的表現能力，而且不用第三方提供的控制項的話。那麼只要巧妙的利用Delphi自己提供的TRichEdit就可以了。
   首先將TRichEdit控制項的邊框屬性RichEdit1.BorderStyle設為bsNone;同時設置唯讀屬性RichEdit1.ReadOnly為True；然後利用Windows提供的“寫字板”之類的軟體製作好RichText格式的文本，通過以下語句就可以顯示出來了：
RichEdit1.PlainText：False;
RichEdit1.Lines.LoadFromFile('c:test.rtf');
DELPHI教學－05

檢測磁片是否變化

   最簡單的檢查CD－ROM或是磁片是否有過變化的方法 是檢查其volume號碼。你可以簡單地運用下面的函數來返 回磁片的volume系列號碼GetDiskVolSerialID('E'), 函數代碼如下：
function GetDiskVolSerialID(cDriveName:char):DWord;
var
dwTemp1，dwTemp2：DWord;
begin
GetVolumeInformation(PChar(cDriveName+':l'), Nil,0,Result, dwTemp2,dwTemp2,Nil,0);
end;

滑鼠擊了哪一個物件

   在Win95中，滑鼠的右鍵起到了很大的作用，但是，由於歷史的原因，對於右鍵的使用即使在Delphi中，也還不夠有效，下面的程式可以告訴你如何知道剛才滑鼠右擊的物件名稱。首先建立一個popmenu，然後以下的代碼就可以告訴你剛才右擊的物件名稱：
PopupMenu1.PopupComponent.ClassName

控制INI文件幾法

   要利用.INI檔做程式有關資料的存儲工作，就需要能讀和寫.INI檔，所以列了如下方法給大家參考：
從.INI檔中獲取字串
var
strResult:pchar;
begin
GetPrivateProfileString(
'windows', // []中標題的名字
'NullPort', // =號前的名字
'NIL', // 如果沒有找到字串時，返回的預設值
strResult, //存放取得字元
100, //取得字元的允許最大長度
'c:\forwin95\win.ini' // 調用的檔案名
);
edit1.text:=strResult; //顯示取得字串
從.INI檔中獲取整數
edit1.text:=inttostr(GetPrivateProfileInt(
'intl', // []中標題的名字
'iCountry', // =號前的名字
0,// 如果沒有找到整數時，返回的預設值
'c:\forwin95\win.ini' // 調用的檔案名
));
向.INI檔寫入字串
WritePrivateProfileString(
'windows', // []中標題的名字
'load', // 要寫入“=”號前的字串
'accca', //要寫入的資料
'c:\forwin95\win.ini' // 調用的檔案名
);
向.INI檔寫入整數
WritePrivateProfileSection(
'windows', // []中標題的名字
'read=100', // 要寫入的資料
'c:\forwin95\win.ini' // 調用的檔案名
);
上面的方法是調用API函數，下面介紹另一種不用API從.INI檔中獲取字元的方法
var MyIni: TIniFile;
begin
MyIni := TIniFile.Create('WIN.INI');//調用的檔案名
edit1.text:=MyIni.ReadString('Desktop', 'Wallpaper', '');//取得字元
end;
向.INI檔中寫入字元的方法
var MyIni: TIniFile;
begin
MyIni := TIniFile.Create('WIN.INI');//調用的檔案名
DelphiIni.WriteString('Desktop', 'Wallpaper', 'c:\a.bmp');
end;

防止Win95顯示嚴重錯誤

   不管你的程式如何反復調試，交給用戶之後，總有可能發生你意想不到的錯誤，如何避免Win95顯示出白色的視窗，告訴你的用戶發生了難堪的意外錯誤呢？我們可以這樣做：
var
wOldErrorMode:Word;
begin
wOldErrorMode:=SetErrorMode(SEM_FAILCRITICALERRORS);
try
finally
SetErrorMode(wOldErrorMode);
end;
end;
主要是利用SetErrorMode（）來完成這一功能。

狀態條插入可視控制項

　　首先,在FROM中放置一個狀態條控制項Status。調節Status.Panels，在其中插入3個狀態條嵌板。把第二個嵌板的參數Style設置成psOwnerDraw。這一點很重要，如果沒有這樣做，將永遠無法顯示文字以外的東西。然後在狀態條的OnDrawPanel事件中插入一行StatusDrawRect:=rect;以記錄參數Style設置成psOwnerDraw的嵌板的座標。
   第二步，在FROM的Private中申明一個TProgressBar類型的變數Progress。然後在一個功能表的消息回應過程中調用Create方法把它建立起來，再設定狀態條為該進程條的父視窗，進而設定進程條的一些必要參數。例如：最大值、最小值、原點座標、高度和寬度等。
   最後編譯一下該程式，你就會發現在狀態條中被插入了一個運動著的進程條。
   類似地，你還可以在狀態條中插入其他可視控制項，如：按鍵、點陣圖和動畫控制項等等。
以下是範例程式：
type
TForm1 = class(TForm)//定義一個視窗類
Status: TStatusBar;
MainMenu1: TMainMenu;
file1: TMenuItem;
insertprocressbar1: TMenuItem;
N1: TMenuItem;
exit1: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure StatusDrawPanel(StatusBar: TStatusBar; Panel:
TStatusPanel;const Rect: TRect);
procedure FormDestroy(Sender: TObject);
procedure exit1Click(Sender: TObject);
posprocedure insertprocressbar1Click(Sender: TObject);
private
colorindex : integer; BookOpen:Boolean;
ssbmp:Tbitmap; progress:TProgressbar;
StatusDrawRect:TRect; //記錄要插入狀態條特技的座標範圍
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
end;
procedure TForm1.StatusDrawPanel(StatusBar: TStatusBar;
Panel: TStatusPanel; const Rect: TRect);
begin
StatusDrawRect:=rect; //記錄要實現狀態條特技的座標範圍
end;
procedure TForm1.exit1Click(Sender: TObject);
begin
close;
end;
procedure TForm1.insertprocressbar1Click(Sender: TObject);
var i,count:integer;
staPanleWidth:integer;
begin
progress:=TProgressbar.create(form1);
count:=3000; //進程條的最大值
staPanleWidth:=status.Panels.Items[2].width;
//由於進程條的很寬，所以需要改變狀態條嵌板的寬度，這裏先保存它的寬度。
status.Panels.Items[2].width:=150; // 改變寬度
status.repaint;
with progress do
begin
top:=StatusDrawRect.top;
left:=StatusDrawRect.left;
width:=StatusDrawRect.right-StatusDrawRect.left;
height:=StatusDrawRect.bottom-StatusDrawRect.top;
//設定進程條的寬度和高度
visible:=true;
try
Parent := status; //該進程條的擁有者為狀態條status
Min := 0; Max := Count; //進程條的最大和最小值
Step := 1; //進程條的步長
for i := 1 to Count do
Stepit; // 累加進程條
ShowMessage('現在，進程條將要從記憶體中被釋放');
finally
Free; //釋放進程條
end; //try
end; //with
status.Panels.Items[2].width:=staPanleWidth; //恢復狀態條嵌板的寬度
end; //begin
end.

臨時路徑

   有時需要Windows的臨時路徑來做備份等工作，那麼就要知道路徑在哪，下面的程式幫你忙：
var aa:pchar;
begin
GetTempPath(20,aa); //返回路徑名
edit1.text:=aa;
end;
 DELPHI教學－06

檢測驅動器類型

   當要知道所選的驅動器屬於什麼類型時，請看下面的程式
var x:integer;
driver:pchar;
begin
driver:='f:\';
x := GetDriveType(driver);
Case x of
2: Label1.Caption := '該驅動器是可移動驅動器';
3: Label1.Caption := '該驅動器是固定驅動器';
4: Label1.Caption := '該驅動器是網路驅動器';
5: Label1.Caption := '該驅動器是CD-ROM驅動器';
6: Label1.Caption := '該驅動器是虛擬驅動器';
Else Label1.Caption := '該驅動器無效';
End;
end;

驅動器容量

   要得到驅動器的容量和剩餘容量，用下麵的程式
var
driver:pchar;
sec1, byt1, cl1, cl2:longword;
begin
driver:='c:\';//要顯示的驅動器名
GetDiskFreeSpace(driver, sec1, byt1, cl1, cl2);
cl1 := cl1 * sec1 * byt1;
cl2 := cl2 * sec1 * byt1;
Label1.Caption := '該驅動器總共容量' + Formatfloat('###,##0',cl2) + '位元組';
Label2.Caption := '該驅動器可用容量' + Formatfloat('###,##0',cl1) + '位元組';
end;

辨別解析度

   要得到顯示器的解析度，由下列程式得到：
var
x:longint;
a:string;
begin
x := GetSystemMetrics(SM_CXSCREEN);
Str(x,a);
Label1.Caption := '顯示器水準解析度' + a;
x := GetSystemMetrics(SM_CYSCREEN);
Str(x,a);
Label2.Caption := '顯示器垂直解析度' + a;
end;

控制熱啟動

   要使系統的熱啟動鍵（Ctrl+Alt+Del）失效，使用以下語句
SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, 0, 0);
要恢復系統的熱啟動鍵（Ctrl+Alt+Del），使用以下語句
SystemParametersInfo(SPI_SCREENSAVERRUNNING, 0, 0, 0);

啟動螢幕保護

   執行下列語句開始Windows螢幕保護程式
SendMessage(HWND_BROADCAST,WM_SYSCOMMAND,SC_SCREENSAVE,0);

取系統顏色

   要取得系統顏色，把參數換一下就可以
COLOR_SCROLLBAR　　　　　　捲軸
COLOR_BACKGROUND　　　　 　桌面背景
COLOR_ACTIVECAPTION 　 　　活動窗口標題
cOLOR_INACTIVECAPTION　　　非活動窗口標題
cOLOR_MENU　　　　　　 　　菜單
COLOR_WINDOW　　　　　 　　窗口背景
cOLOR_WINDOWFRAME　　　　　窗口框
COLOR_MENUTEXT　　　　 　　視窗文字
COLOR_WINDOWTEXT　　　 　　3D 陰影 (Win95)
COLOR_CAPTIONTEXT　　　　　標題文字
COLOR_ACTIVEBORDER　　 　　活動窗口邊框
COLOR_INACTIVEBORDER　 　　非活動窗口邊框
COLOR_APPWORKSPACE　　 　　MDI 窗口背景
COLOR_HIGHLIGHT　　　　　　選擇條背景
COLOR_HIGHLIGHTTEXT　　　　選擇條文字
COLOR_BTNFACE　　　　　　　按鈕
COLOR_BTNSHADOW　　　　　　3D 按鈕陰影
COLOR_GRAYTEXT　　　　 　　灰度文字
COLOR_BTNTEXT　　　　　　　按鈕文字
COLOR_INACTIVECAPTIONTEXT　非活動視窗文字
COLOR_BTNHIGHLIGHT　　 　　3D 選擇按鈕}
var i:integer;
begin
//取得活動窗口標題顏色
i :=GetSysColor(COLOR_ACTIVECAPTION);
end;
   DELPHI教學－07

改電腦名

   改變電腦在網路中的名字，重新啟動後才生效
SetComputerName('Hello World');

控制壁紙

   控制Windows 95的壁紙，以下程式使壁紙變為我們想要的點陣圖，如果THEPCHAR為空，那麼就取消壁紙，變為Win默認色彩； 但這種方法只是暫時的，在WINDOWS重新啟動後還是原來的點陣圖，這時就需要對WIN.INI檔進行寫操作，才能保存住我們改動的圖片不被替換。
var THEPCHAR:pchar;
begin
THEPCHAR:='e:\a.bmp';
SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, THEPCHAR, SPIF_SENDWININICHANGE)
end;

計算欄位值

   需要對某欄位的所有記錄求和，使用如下代碼：
var i:double;
{$R *.DFM}
procedure TForm1.Table1CalcFields(dataset: Tdataset);
var
Goodsgold:double;
begin
Goodsgold:=table1.fieldbyname('金額').asfloat;
i:=i+Goodsgold;
label1.caption:=formatfloat('0.00',i);
end;
其中的i是求得的總和，在必要時才將他復位為0，要不他總是有增無減。

鏈結的視覺效果

   要有類似WIN98那樣指向字體，該字體就出現下劃線，滑鼠指標變為一支手指，按下後就打開流覽器或郵件編寫器的功能，按下列辦法做（該方法只是在前面講的實現超鏈結的方法上加入一些效果）：
   先在一個表單中加入一個Label1，加入下列代碼
procedure TForm1.Label1MouseMove(Sender: TObject;shift:Tshiftstate;x,y:integer);
begin
Label1.Font.Style:=[fsbold,fsunderline];
Label1.Font.Color:=clYellow;
end;

procedure TForm1.FormMouseMove(Sender: TObject;shift:Tshiftstate;x,y:integer);
begin
Label1.Font.Style:=[fsbold];
Label1.Font.Color :=clmaroon;
end;

procedure TForm1.Label1Click(Sender: TObject);
begin
Shellexecute(handle,nil,pchar('mailto:guihong@163.net'),nil,nil,sw_shownormal);
end;
再將Label1.Cursor設為crHandPoint，Label1的OnMouseMove事件設為Label1MouseMove， Form1的OnMouseMove事件設為FormMouseMove，Label1的OnClick事件設為Label1Click，那麼就這種效果了。

替換指定串函數

一個替換指定串的函數，從一個字串中找出指定子串，並替換為另一子串。
function replacing(S,source,target:string):string;
var site,StrLen:integer;
begin
{source在S中出現的位置}
site:=pos(source,s);
{source的長度}
StrLen:=length(source);
{刪除source字串}
delete(s,site,StrLen);
{插入target字串到S中}
insert(target,s,site);
{返回新串}
replacing:=s;
end;

資料庫日期顯示

   在使用DBGRID控制項時顯示DATATIME時其年份是為2位的，但我們在步入2000年後需要顯示的日期是4位元，如：1998、2001。在資料庫中該欄位只有在2000年後才會顯示4位元，怎麼辦呢？ 下面我們就讓該欄位在DBGRID控制項中也顯示4位元的日期格式： 雙擊Table1控制項，就會出現form1.table表單，擊右鍵，選Add Fields...，選擇日期欄位後按ok，表單中就出現了資料庫的日期欄位名，點日期的那個欄位名，屬性框裏就出現了該欄位的資訊，裏面有一項DispalyFormat，在該顯示格式裏輸入yyyy.mm.dd，那麼DBGRID控制項就出現完整的日期了。
  DELPHI教學－08

寫小執行程式
轉載至http://www.nease.net/~ganglion

   象C語言一樣，用Delphi也能寫出只有幾十K、十幾K、甚至只有幾K的小程式，本文將 以一個能將Win95桌面藏起來的僅有38K的小程式為例教會讀者這一技巧，同時本文還 將涉及Win95 TrayIcon的顯示。

本程式能寫得很小的訣竅是：根本沒有用任何的 Form 。也就是說，根源程式只有一個 Desktop.dpr 檔，程式完全用標準的 WINAPI 寫成，由於用到的資源很少，所以程式的體積也很小。當然，用這樣的方法編程時不能使用 Delphi的所見即所得的編程方式。}

{首先看看程式頭的寫法：}
    program DeskPop;
    uses Windows, Messages, ShellAPI, sysutils;
    {$R *.RES}

{可以看出本程式比普通的 Delphi 程式用到的 Unit 少的多。 下面聲明了全局常量和變數，暫時可以不管他們。}
    const
    AppName = 'DeskTop Hide';
    var
    x: integer;
    tid: TNotifyIconData;
    WndClass: array[0..50] of char;

{現在進入程式的主要部分，首先是定義了一批過程，為了能讓讀者更好地理解，我們先把這些過程跳過去，先說主程序。主程序位於程式的最後，這樣做的好處是可以直接使用程式中定義的過程。主程序十分簡單：}
    begin
    WinMain;
    end.
{看來所有的工作都由 WinMain 完成了。這個 WinMain 使用標準的 WinAPI 函數進行編程，主要步驟是：先聲明一個視窗類，然後創建一個主視窗，最後進入消息迴圈，直到程式結束。}

procedure WinMain;
var
Wnd: hWnd; {聲明視窗控制碼(Handle)變數}
Msg: TMsg; {聲明消息變數}
cls: TWndClass; {視窗類變數}
begin
{ Previous instance running ? If so, exit }
{ 檢查是否程式已經運行，如果已經運行則調用Panic過程退出 }
if FindWindow (AppName, Nil) <> 0 then
Panic (AppName + ' is already running.');

{ Register the window class }
{ 這裏的註冊視窗類程式是例行公事，照抄即可}
FillChar (cls, sizeof (cls), 0); {用這一句將視窗類變數cls清零)
cls.lpfnWndProc := @DummyWindowProc; {取回調函數DummyWindowProc的位址}
cls.hInstance := hInstance; {實例控制碼}
cls.lpszClassName := AppName; {窗口類名}
RegisterClass (cls); {註冊視窗類cls}

{ 現在可以創建程式的主視窗了-在本程式中是個虛擬視窗}
{ Now create the dummy window }
Wnd := CreateWindow (AppName, AppName, ws_OverlappedWindow,
cw_UseDefault, cw_UseDefault, cw_UseDefault, cw_UseDefault,
0, 0, hInstance, Nil);
x:= 0; {變數X其實是個開關變數，記錄現在是否已經隱藏了桌面}

{ 如果視窗創建成功，則顯示視窗，並進入消息迴圈 }
if Wnd <> 0 then
begin
ShowWindow (Wnd, sw_Hide);{本例中視窗是隱藏的}
{ 下面進入消息迴圈，該迴圈將不斷運行直到 GetMessage返回0 }
while GetMessage (Msg, 0, 0, 0) do
begin
TranslateMessage (Msg);
DispatchMessage (Msg);
end;
end;
end;

   {現在看來，程式的主框架很明瞭，但是它還不能完成任何任務。過程 Panic將顯示一個對話方塊後退出程式，它在 Winmain 過程的開始部分被調用，其實 Panic的功能很簡單，之所以要寫成一個函數的原因恐怕一方面是結構化編程的需要，另一方面借此避開了 String 和 PChar 的轉換。}
procedure Panic (szMessage: PChar);
begin
if szMessage <> Nil then
MessageBox (0, szMessage, AppName, mb_ok);
posHalt (0);
end;

   {下面是回調(Callback)函數 DummyWindowProc，如果說 Winmain 過程是本程式-或者說是本應用或實例的生命，那麼這個回調函數可以說是主視窗的靈魂。每一個標準的或者說是規範的Windows視窗都有一個回調函數，以處理發給該視窗的消息。所謂“回調”的意思是這個函數不是由程式直接調用的，而是由 Windows 系統調用(還記得我們在視窗類中給lpfnWndProc賦過值嗎)， 這就是事件驅動編程。}
function DummyWindowProc (Wnd: hWnd; Msg, wParam: Word; lParam: LongInt)
:LongInt; stdcall; {注意這裏有一個 stdcall;定義了回調函數}
var
TrayHandle: THandle;
dc: hDC;
i: Integer;
pm: HMenu;
pt: TPoint;
begin
DummyWindowProc := 0;
{下面兩句是找到 Win95 任務欄的控制碼}
StrPCopy(@WndClass[0], 'Progman');
TrayHandle := FindWindow(@WndClass[0], nil);
{下面開始處理消息}
case Msg of
{收到視窗創建消息 - 在任務欄上顯示一個圖示}
wm_Create: // Program initialisation - just set up a tray icon
begin
tid.cbSize := sizeof (tid);
tid.Wnd := Wnd;
tid.uID := 1;
tid.uFlags := nif_Message or nif_Icon or nif_Tip;
tid.uCallBackMessage := wm_User;
tid.hIcon := LoadIcon (hInstance, 'MAINICON');
lstrcpy (tid.szTip,'Desktop is on');
Shell_NotifyIcon (nim_Add, @tid);
end;

wm_Destroy: {收到關閉視窗消息時的處理}
begin
Shell_NotifyIcon (nim_Delete, @tid);
postQuitMessage (0);
ShowWindow(TrayHandle, SW_RESTORE);
end;
{收到功能表消息時調用 HandleCommand 過程，並退出函數}
wm_Command: // Command notification
begin
HandleCommand (Wnd, LoWord (wParam));
Exit;
end;
{收到其他用戶消息時的處理}
wm_User: // Had a tray notification - see what to do
{如果單擊了滑鼠左鍵， 則打開或關閉桌面}
if (lParam = wm_LButtonDown) then
begin
if x = 0 then
begin
ShowWindow(TrayHandle, SW_HIDE);
tid.hIcon := LoadIcon (hInstance, 'offICON');
lstrcpy (tid.szTip,'Desktop is off');
Shell_NotifyIcon (NIM_MODIFY, @tid);
x:=1
end else
begin
ShowWindow(TrayHandle, SW_RESTORE);
tid.hIcon := LoadIcon (hInstance, 'ONICON');
lstrcpy (tid.szTip,'Desktop is on');
Shell_NotifyIcon (NIM_MODIFY, @tid);
x:= 0;
end; {end of if}
end else
{如果是滑鼠右鍵，則動態生成一個彈出式功能表}
if (lParam = wm_RButtonDown) then
begin
GetCursorpos (pt);
pm := CreatePopupMenu;
AppendMenu (pm, 0, Ord ('A'), 'About DeskTop Hide...');
AppendMenu (pm, mf_Separator, 0, Nil);
AppendMenu (pm, 0, Ord ('E'), 'Exit DeskTop Hide');
SetForegroundWindow (Wnd);
dc := GetDC (0);
if TrackPopupMenu (pm, tpm_BottomAlign or tpm_RightAlign,
pt.x,GetDeviceCaps(dc,HORZRES){pt.y}, 0, Wnd, Nil)
then SetForegroundWindow (Wnd);
DestroyMenu (pm)
end; {end of if}
end; {end of case}
{在處理過消息之後，還要調用默認函數，以完成標準的Windows程式應該執行的任務，所以這一句非常重要}
DummyWindowProc := DefWindowProc (Wnd, Msg, wParam, lParam);
end;

{這個就是處理功能表消息的過程}
procedure HandleCommand (Wnd: hWnd; Cmd: Word);
begin
case Cmd of
Ord ('A'): MessageBox (0, 'Freeware brian.slack@strath.ac.uk 1997',
AppName, mb_ok);
Ord ('E'): postMessage (Wnd, wm_Close, 0, 0);
end;
end;

至此我們已經完成了這個只有38K的能將Win95桌面隱藏起來的程式，只要將本文中所有的函數和過程的順序倒置，並將主程序放到最後，即可編譯通過。

避免二次運行
轉載至http://www.nease.net/~ganglion

   實現單實例運行的關鍵是判斷前一實例是否存在，Win3.x中運行的程式能獲知前一實例的控制碼，從而可以方便地進行判斷，但 Windows 95 是搶先式多工系統，其程式的前一實例控制碼恒為零，所以只有另尋其他辦法。目前最有效的辦法是通過查看是否有相同視窗類名的常式存在來進行判斷。下面介紹在Delphi中實現的方法。

1、對主視窗程式的改動：

在主視窗(即程式創建的第一個視窗)中interface節加入
const
CM_RESTORE = WM_USER + $1000; {自定義的“恢復”消息}
MYAPPNAME = "My Delphi Program";
並在Form的定義的public節中加入
procedure CreateParams(var Params: TCreateParams); override;
Procedure RestoreRequest(var message: TMessage); message CM_RESTORE;
在implementation節中加入
{指定視窗名稱}
procedure TForm1.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.WinClassName := MYAPPNAME;
end;

{處理“恢復”消息}
procedure TForm1.RestoreRequest(var message: TMessage);
begin
if IsIconic(Application.Handle) = TRUE then
Application.Restore
else
Application.BringToFront;
end;

   經過以上修改，程式的主視窗的類名已經被指定了，這是進行判斷的基礎。一般在程式剛開始運行的時候進行判斷，所以還要對DPR檔進行修改。

2、對DPR文件的改動
在 uses 節中添加 windows、messages這兩個單元加入下列語句，注意兩個檔中常量CM_RESTORE和MYAPPNAME的定義必須一致
const
CM_RESTORE = WM_USER + $1000; {自定義的“恢復”消息}
MYAPPNAME = "My Delphi Program";
var
RvHandle : hWnd;

將下列語句插到程式最前部(在Application.Initialize之前)

RvHandle := FindWindow(MYAPPNAME, NIL);
if RvHandle > 0 then
begin
postMessage(RvHandle, CM_RESTORE, 0, 0);
Exit;
end;
   這段程式的意思是如果找到一個類名相同的視窗，則向該視窗發送一個消息，並退出，而本例中原視窗收到該消息後會自動啟動或從圖示還原，從而達到了避免二次運行且能自動調出前一常式的目的。

控制面板大全

   在程式運行過程中啟動控制面板的各個設置功能：
var x:cardinal;
begin
{啟動控制面板}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL',9);
{輔助選項 屬性-鍵盤}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL access.cpl,,1',9);
{輔助選項 屬性-聲音}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL access.cpl,,2',9);
{輔助選項 屬性-顯示}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL access.cpl,,3',9);
{輔助選項 屬性-滑鼠}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL access.cpl,,4',9);
{輔助選項 屬性-常規}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL access.cpl,,5',9);
{添加/刪除程式 屬性-安裝/卸載}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Appwiz.cpl,,1',9);
{添加/刪除程式 屬性-Windows安裝程式}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Appwiz.cpl,,2',9);
{添加/刪除程式 屬性-啟動盤}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Appwiz.cpl,,3',9);
{顯示 屬性-背景}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,0',9);
{顯示 屬性-螢幕保護程式}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,1',9);
{顯示 屬性-外觀}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,2',9);
{顯示 屬性-設置}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,3',9);
{Internet 屬性-常規}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Inetcpl.cpl,,0',9);
{Internet 屬性-安全}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Inetcpl.cpl,,1',9);
{Internet 屬性-內容}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Inetcpl.cpl,,2',9);
{Internet 屬性-連接}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Inetcpl.cpl,,3',9);
{Internet 屬性-程式}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Inetcpl.cpl,,4',9);
{Internet 屬性-高級}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Inetcpl.cpl,,5',9);
{區域設置 屬性-區域設置}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Intl.cpl,,0',9);
{區域設置 屬性-數位}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Intl.cpl,,1',9);
{區域設置 屬性-貨幣}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Intl.cpl,,2',9);
{區域設置 屬性-時間}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Intl.cpl,,3',9);
{區域設置 屬性-日期}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Intl.cpl,,4',9);
{遊戲控制器-一般}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Joy.cpl,,0',9);
{遊戲控制器-高級}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Joy.cpl,,1',9);
{滑鼠 屬性}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Main.cpl',9);
{多媒體 屬性-音頻}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Mmsys.cpl,,0',9);
{多媒體 屬性-視頻}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Mmsys.cpl,,1',9);
{多媒體 屬性-MIDI}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Mmsys.cpl,,2',9);
{多媒體 屬性-CD音樂}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Mmsys.cpl,,3',9);
{多媒體 屬性-設備}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Mmsys.cpl,,4',9);
{數據機 屬性}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Modem.cpl',9);
{網路}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Netcpl.cpl',9);
{密碼 屬性}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Password.cpl',9);
{掃描器與數位相機 屬性}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Sticpl.cpl',9);
{系統 屬性-常規}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Sysdm.cpl,,0',9);
{系統 屬性-設備管理器}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Sysdm.cpl,,1',9);
{系統 屬性-硬體配置檔}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Sysdm.cpl,,2',9);
{系統 屬性-性能}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Sysdm.cpl,,3',9);
{日期/時間 屬性}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL timedate.cpl',9);
{電源管理 屬性}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Powercfg.cpl',9);
{撥號屬性}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Telephon.cpl',9);
{----------------------調用錯誤----------------------}
if x=0 then messagebox(0,'程式超出記憶體','錯誤',0);
if x=ERROR_BAD_FORMAT then messagebox(0,'該程式非一個合法的Win32.EXE程式).','錯誤',0);
if x=ERROR_FILE_NOT_FOUND then messagebox(0,'指定檔沒找到','錯誤',0);
if x=ERROR_PATH_NOT_FOUND then messagebox(0,'指定路徑沒找到','錯誤',0);
end;

打開撥號連接

   調用撥號網路裏的撥號程式來連接：其中'連接Internet'為你創建的撥號程式名稱
winexec('rundll32.exe rnaui.dll,RnaDial '+'連接Internet',9);

檢測程式是否運行

　　在某些情況下，我們編寫的應用程式同時只能有一個實例在記憶體中運行，例如伺服器程式、需要獨佔某設備的程式，甚至我們僅僅是讓程式同時只有一個實例運行（如UltraEdit就是這樣做的，讓你不能同時運行多個UltraEdit）。要實現此功能，需要在程式中加一點判斷的代碼，在Windows 95或Win32環境下的Delphi版本中實現的程式如下：
按Ctrl+F12鍵，選擇Project1，加入下列語句
program Project1;

uses
windows, {加入該句才能調用函數}
Forms,
Unit1 in 'Unit1.pas'{Form1};

{$R *.RES}
const classname='TForm1'; {聲明為主表單的類名}
var handle:integer; {變數}

begin
{-----------------主要為該判斷部分----------------------}
handle:=findwindow(classname,nil);{查找是否有此類的表單}
if handle<>0 then {不為0則程式已運行}
begin
messagebox(0,'該程式已經有一個在運行中！','運行',0);{提示程式已運行}
halt; {退出程式}
end;
{------------------------------------------------------}
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
　　該程式在測試時由於Delphi也生成了此類實例表單，所以會出現提示框，只有關閉Delphi後單獨運行程式才能實現。

不用標題欄也移動表單

   一般情況下，移動一個表單需要將滑鼠放置在標題欄上才能拖動表單，為 什麼非要使用標題欄呢？其實我們可以使用一個巧妙的方法來實現將滑鼠放置 在表單上按下就可拖動表單，下面先看實現代碼。在Form1的“Private”部分聲明過程：

在private部分加入下列代碼：
procedure wmnchittest(var msg:twmnchittest);
message wm_nchittest;
pos在程式部分加入以下代碼：
procedure TForm1.wmnchittest(var msg:twmnchittest);
begin
inherited;
if (htclient=msg.result) then msg.result:=htcaption;
end;
  DELPHI教學－09

去除無用代碼

   在程式反復調試過程中，可能有些代碼已沒有作用，從調試視窗可以看到，可是由於程式比較複雜，無用的代碼佔據大量空間，為了整理代碼，不用編譯或保存，只需打開File功能表，選擇Save File As...，在保存檔對話方塊中選擇Cancel即可去除無用代碼，方便快捷。

變色窗口背景

   我們看到有些安裝程式的背景色自上由下由藍變黑，我們可以通過下列程式實現
雙擊表單的OnPaint事件，然後編寫如下程式：
procedure TForm1.FormPaint(Sender: TObject);
var i:word;
dy,y:real;
begin
dy:=clientheight/256;
y:=0;
for i:=255 downto 0 do
begin
canvas.brush.color:=$00000000+i*$10000;
canvas.fillrect(rect(0,round(y),clientwidth,round(y+dy)));
y:=y+dy;
end;
end;

程式不出現在任務欄

   一般Windows 95運行程式時都會在任務欄上出現按鈕，如果你的程式是一個監視程式，那麼出現按鈕就不是明智之舉了。要實現該功能就要在OnCreate事件裏利用到API函數SetWindowLong
procedure TForm1.FormCreate(sender:TObject);
begin
SetWindowLong(Application,Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);
end;

小寫金額轉換

   如下為一個簡單的小寫金額轉換為大寫的函數，其思路簡單（可以說爛吧，居然利用了位置來轉換），但是它幾乎可以無限制的轉換，只要你能讀得出來和寫得進去：
function Tform1.SmallTOBig(small:real):string;
var SmallMonth,BigMonth:string;
wei1,qianwei1:string[2];
wei,qianwei,dianweizhi,qian:integer;
begin
{------- 修改參數令值更精確 -------}
{小數點後的位置，需要的話也可以改動-2值}
qianwei:=-2;
{轉換成貨幣形式，需要的話小數點後加多幾個零}
Smallmonth:=formatfloat('0.00',small);
{---------------------------------}
dianweizhi :=pos('.',Smallmonth);{小數點的位置}
{迴圈小寫貨幣的每一位，從小寫的右邊位置到左邊}
for qian:=length(Smallmonth) downto 1 do
begin
{如果讀到的不是小數點就繼續}
if qian<>dianweizhi then
begin
{位置上的數轉換成大寫}
case strtoint(copy(Smallmonth,qian,1)) of
1:wei1:='壹'; 2:wei1:='貳';
3:wei1:='三'; 4:wei1:='肆';
5:wei1:='伍'; 6:wei1:='陸';
7:wei1:='柒'; 8:wei1:='捌';
9:wei1:='玖'; 0:wei1:='零';
end;
{判斷大寫位置，可以繼續增大到real類型的最大值}
case qianwei of
-3:qianwei1:='厘';
-2:qianwei1:='分';
-1:qianwei1:='角';
0 :qianwei1:='元';
1 :qianwei1:='拾';
2 :qianwei1:='佰';
3 :qianwei1:='千';
4 :qianwei1:='萬';
5 :qianwei1:='拾';
6 :qianwei1:='佰';
7 :qianwei1:='千';
8 :qianwei1:='億';
9 :qianwei1:='十';
10:qianwei1:='佰';
11:qianwei1:='千';
end;
inc(qianwei);
BigMonth :=wei1+qianwei1+BigMonth;{組合成大寫金額}
end;
end;
SmallTOBig:=BigMonth;
end;
調用如下“edit1.text:=SmallTOBig(1234567890.1234);”他自動默認小數點後兩位

自創讀INI文件

...
function GetINIfile(lpAppNameL,lpKeyName,lpDefault:string;
lpsize:integer;lpFileName:string):string;
{讀取ini檔函數}
var f:textfile;
sn:string;
begin
assignfile(f,lpFileName);
reset(f);
repeat
readln(f,sn);
if sn='['+lpAppNameL+']' then
begin
readln(f,sn);
while(copy(sn,1,1)<>'[')or(not(eof(f)))do
begin
if copy(sn,1,pos('=',sn)-1)=lpKeyName then
begin
GetINIfile:=copy(sn,pos('=',sn)+1,lpsize);
exit;
end;
readln(f,sn);
end;
end
else GetINIfile:=lpDefault;
until eof(f);
closefile(f);
end;
{------------}
Timeout:=GetINIfile('MailSetup','Timeout','0',5,prgpath+'\CNMSet.ini');

Windows類型和版本

從註冊表中得到目前作業系統是Windows95還是WindowsNT，並得到其版本，首先要在USES段加入下面的內容
uses Registry, ComCtrls, ExtCtrls;
然後才在需要的地方加入下面語句var
MyVersionInfo: TOSVersionInfo;
MyReg: TRegistry;
IsNT: Boolean;
begin
MyReg := TRegistry.Create;
MyReg.RootKey := HKEY_LOCAL_MACHINE;

IsNT := False;

MyVersionInfo.dwOSVersionInfoSize := sizeof(TOSVERSIONINFO);

if GetVersionEx(MyVersionInfo) then
Label1.Caption := IntToStr(MyVersionInfo.dwPlatformId)
else Label1.Caption := 'false';

if MyVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS then
Label1.Caption := 'Windows 95';
if MyVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT then
begin
IsNT := True;
Label1.Caption := 'Windows NT';
end;

try
if IsNT then
if not MyReg.OpenKey('\SOFTWARE\Microsoft\Windows NT\CurrentVersion', FALSE) then
else Label2.Caption := MyReg.ReadString('CurrentVersion')
else
if not MyReg.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion', FALSE) then
else Label2.Caption := MyReg.ReadString('VersionNumber');
finally
end; // try..finally
end;
DELPHI教學－10

改變圖片效果

   想不想另圖片有另一番效果，使用下列語句實現吧，增加兩個TImage圖片框，分別為Image1、Image2，用Image1引入一張圖片，按下按鈕就可以在Image2上出現驚人的效果
procedure TForm1.Button1Click(Sender: TObject);
begin
Image2.Canvas.Brush.Style := bsCross;
Image2.Canvas.CopyMode := cmMergeCopy;

Image2.Canvas.Draw(0,0, Image1.Picture.Graphic);
end;

移動滑鼠到控制項

   讓滑鼠移動到控制項上的方法
procedure MoveMouseIntoControl(AWinControl: TWincontrol);
var
rtControl: TRect;
begin
rtControl := AWinControl.BoundsRect;
MapWindowPoints(AWinControl.Parent.Handle, 0, rtControl, 2);
SetCursorpos(rtControl.Left + (rtControl.Right - rtControl.Left) div 2,
rtControl.Top + (rtControl.Bottom - rtControl.Top) div 2);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
MoveMouseIntoControl(Button1);
end;

讓字體左、右對齊

   做文字編輯器時少不了對字體的各種操作，而TRichEdit控制項是必不可少的。最基本的就是文本的靠齊方式了，需要對文本進行左靠齊、右靠齊、中間靠齊時就可以利用以下語句了：
   左靠齊
RichEdit1.Paragraph.Alignment := taLeftJustify;
   中間對齊
RichEdit1.Paragraph.Alignment := taCenter;
   右靠齊
RichEdit1.Paragraph.Alignment := taRightJustify;

向資料庫發送密碼

   編輯資料庫軟體時，為了資料安全，往往需要在資料庫裏加入密碼，打開時就需要密碼才能流覽，但是當我們在程式裏調用時也需要不時的輸入密碼，這就照成了不遍，所以利用以下辦法，輸入密碼後才打開資料庫：
Session.GetPassword;
Table1.Open;

生成非矩形窗口

   利用win32 API函數setwindowrgn可以將視窗定義為任何形狀，以下是將窗口定義為園角矩形的例子：
procedure TPortForm.FormCreate(Sender: TObject);
var hr :thandle;
begin
hr:=createroundrectrgn(0,0,width,height,20,20);//定義園角矩形(win API函數)
setwindowrgn(handle,hr,true); //設置園角視窗
end;
為了使該視窗更好，應在onResize事件處理程式放相同的代碼。
 DELPHI教學－11

統計中英文字個數

   想在文本控制項TMemo中，分別對中、英文的字元數進行統計，我們可以通過把字元轉換為數值來進行判斷，Ord()函數把字元轉換為對應的數值，值33-126為鍵盤可使用字元，值127以上的為未知字元，即為漢字
procedure TForm1.Button1Click(Sender: TObject);
var s:string;
i,e,c:integer;
begin
s:=memo1.text;
e:=0;c:=0;
for i:=1 to length(s) do
begin
if (ord(s[i])>=33)and(ord(s[i])<=126) then
begin
inc(e);
label1.caption:='英文個數：'+inttostr(e);
end
else
if (ord(s[i])>=127) then
begin
inc(c);
label2.caption:='中文個數：'+inttostr(c div 2);
end;
end;
end;

　
 編程技巧

遮罩系統功能鍵

　　當你不需要讓用戶按Alt+Enter、Ctrl+Alt+Del、Ctrl+Esc等功能鍵的時候加入以下代碼：
Var
temp:integer;
begin
SystemParametersInfo(Spi_screensaverrunning,1,@temp,0);
end;
　　當你要恢復功能鍵時用以下代碼：
Var
Temp:integer;
begin
SystemParametersInfo(spi_screensaverrunning,0,@temp,0);
end;

--------------------------------------------------------------------------------

查閱可視窗口標題

下面只是舉出一個例子提供參考:
運用API函數GetWindow()配合GetWindowText()逐一查出各視窗的標題
1. File | New Project 開始一個新的工程
2. 在 Form1 中安排 Button 與 Memo 各一
3. 在 Button1 的 OnClick 事件中撰寫程式如下:
procedure TForm1.Button1Click(Sender: TObject);
var
　hCurrentWindow: HWnd;
　szText: array[0..254] of char;
begin
　hCurrentWindow := GetWindow(Handle, GW_HWNDFIRST);
　while hCurrentWindow <> 0 do
　begin
　if GetWindowText(hCurrentWindow, @szText, 255)>0 then
　Memo1.Lines.Add(StrPas(@szText));
　hCurrentWindow:=GetWindow(hCurrentWindow, GW_HWNDNEXT);
　end;
end;

--------------------------------------------------------------------------------

返回程式執行參數

　　有關 Delphi 傳入應用程式的命令列參數, 請參考以下的說明：
用ParamCount函數取得命令參數的個數:
呼叫 ParamStr(0), 傳回執行檔的檔名(含路徑)
呼叫 ParamStr(n), 傳回第ｎ個參數的內容
procedure TForm1.FormCreate(Sender: TObject);
var
sFileName: string;
begin
if ParamCount > 0 then begin (* 有執行參數傳入 *)
sFileName := ParamStr(1); (* 取得參數內容 *)
if FileExists(sFileName) then
Memo1.Lines.LoadFromFile(sFileName)
else
Application.MessageBox('找不到指定的檔案', '訊息', 48);
end;
end;

--------------------------------------------------------------------------------

轉讓控制權

　　有時由於長時間的迴圈語句佔用了cpu的處理權，無法運行 其他程式，照成閉環。這時用以下命令轉讓控制權，讓作業系統處理其他事件。
Application.ProcessMessages;

相當於VB的Do events.

--------------------------------------------------------------------------------

關閉Windows

控制WINDOWS的開關：如關閉WINDOWS，重新啟動WINDOWS等, ExitWindowsEx(UINT uFlags,DWORD dwReserved);是實現這一功能的API函數
首先定義常數
const
EWX_FORCE=4; //關閉所有程式並以其他用戶身份登錄
EWX_LOGOFF=0; //重新啟動電腦並切換到MS-DOS方式
EWX_REBOOT=2; //重新啟動電腦
EWX_SHUTDOWN=1;//關閉電腦
運行時給How賦值，讓他等於EWX_SHUTDOWN或其他，調用以下語句
ExitWindowsEx(How,0);

--------------------------------------------------------------------------------

檢測磁片是否變化

　　最簡單的檢查CD－ROM或是磁片是否有過變化的方法 是檢查其volume號碼。你可以簡單地運用下面的函數來返 回磁片的volume系列號碼GetDiskVolSerialID('E'), 函數代碼如下：
function GetDiskVolSerialID(cDriveName:char):DWord;
var
dwTemp1，dwTemp2：DWord;
begin
GetVolumeInformation(PChar(cDriveName+':l'), Nil,0,Result, dwTemp2,dwTemp2,Nil,0);
end;

--------------------------------------------------------------------------------

滑鼠擊了哪一個物件

　　在Win95中，滑鼠的右鍵起到了很大的作用，但是，由於歷史的原因，對於右鍵的使用即使在Delphi中，也還不夠有效，下面的程式可以告訴你如何知道剛才滑鼠右擊的物件名稱。首先建立一個popmenu，然後以下的代碼就可以告訴你剛才右擊的物件名稱：
PopupMenu1.PopupComponent.ClassName

--------------------------------------------------------------------------------

控制INI文件幾法

要利用.INI檔做程式有關資料的存儲工作，就需要能讀和寫.INI檔，所以列了如下方法給大家參考：
從.INI檔中獲取字串
var
strResult:pchar;
begin
GetPrivateProfileString(
'windows', // []中標題的名字
'NullPort', // =號前的名字
'NIL', // 如果沒有找到字串時，返回的預設值
strResult, //存放取得字元
100, //取得字元的允許最大長度
'c:\forwin95\win.ini' // 調用的檔案名
);
edit1.text:=strResult; //顯示取得字串
從.INI檔中獲取整數
edit1.text:=inttostr(GetPrivateProfileInt(
'intl', // []中標題的名字
'iCountry', // =號前的名字
0,// 如果沒有找到整數時，返回的預設值
'c:\forwin95\win.ini' // 調用的檔案名
));
向.INI檔寫入字串
WritePrivateProfileString(
'windows', // []中標題的名字
'load', // 要寫入“=”號前的字串
'accca', //要寫入的資料
'c:\forwin95\win.ini' // 調用的檔案名
);
向.INI檔寫入整數
WritePrivateProfileSection(
'windows', // []中標題的名字
'read=100', // 要寫入的資料
'c:\forwin95\win.ini' // 調用的檔案名
);
上面的方法是調用API函數，下面介紹另一種不用API從.INI檔中獲取字元的方法
var MyIni: TIniFile;
begin
MyIni := TIniFile.Create('WIN.INI');//調用的檔案名
edit1.text:=MyIni.ReadString('Desktop', 'Wallpaper', '');//取得字元
end;
向.INI檔中寫入字元的方法
var MyIni: TIniFile;
begin
MyIni := TIniFile.Create('WIN.INI');//調用的檔案名
DelphiIni.WriteString('Desktop', 'Wallpaper', 'c:\a.bmp');
end;

--------------------------------------------------------------------------------

防止Win95顯示嚴重錯誤

　　不管你的程式如何反復調試，交給用戶之後，總有可能發生你意想不到的錯誤，如何避免Win95顯示出白色的視窗，告訴你的用戶發生了難堪的意外錯誤呢？我們可以這樣做：
var
wOldErrorMode:Word;
begin
wOldErrorMode:=SetErrorMode(SEM_FAILCRITICALERRORS);
try
finally
SetErrorMode(wOldErrorMode);
end;
end;