Delphi小技巧雜記 收藏
//獲取任務(wù)欄尺寸
procedure TForm1.Button1Click(Sender: TObject);
var
TaskList: HWnd;
Bordered: TRect;
begin
TaskList := FindWindow(’Shell_TrayWnd’, nil);
GetWindowRect(TaskList, Bordered);
Label1.Caption := ’Left: ’ + IntToStr(Bordered.Left);
Label2.Caption := ’Right: ’ + IntToStr(Bordered.Right);
Label3.Caption := ’Top: ’ + IntToStr(Bordered.Top);
Label4.Caption := ’Bottom: ’ + IntToStr(Bordered.Bottom);
end;
//修改指定路徑下的文件只讀屬性
function PathSetAttr(sFilePath: string): Boolean;
var
SearchRec: TSearchRec;
begin
Result := False;
if Copy(sFilePath, Length(sFilePath) - 1, Length(sFilePath)) <> ’\’ then
sFilePath := sFilePath + ’\’;
if DirectoryExists(sFilePath) then
begin
if FindFirst(sFilePath+’*.*’, faAnyFile, SearchRec) = 0 then
begin
FileSetAttr(SearchRec.Name, 32);
while FindNext(SearchRec) = 0 do
FileSetAttr(SearchRec.Name, 32);
end;
Result := True;
end;
end;
//為控件加邊框
procedure WMNCPaint(var Msg: TWMNCPaint); message WM_NCPAINT;
procedure TForm1.WMNCPaint(var Msg: TWMNCPaint);
var
dc: hDC;
Pen: hPen;
OldPen: hPen;
OldBrush: hBrush;
begin
inherited;
dc := GetWindowDC(Handle);
msg.Result := 1;
Pen := CreatePen(PS_SOLID, 1, RGB(255, 0, 0));
OldPen := SelectObject(dc, Pen);
OldBrush := SelectObject(dc, GetStockObject(NULL_BRUSH));
Rectangle(dc, 0, 0, Self.Width, Self.Height);
SelectObject(dc, OldBrush);
SelectObject(dc, OldPen);
DeleteObject(Pen);
ReleaseDC(Handle, Canvas.Handle);
end;
//制作透明窗體
procedure CreateParams(var Params: TCreateParams); override; //重載 CreateParams 過(guò)程的實(shí)現(xiàn)
procedure TForm1.CreateParams(var Params: TCreateParams);
begin
//先繼承原來(lái)的 CreateParams 過(guò)程
inherited;
//然后修改 Param.ExStyle 的值，使窗體具有透明效果
Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
inherited;
//將畫(huà)布的筆刷樣式改成 bsClear 以及時(shí)清除窗體原來(lái)的內(nèi)容，這樣窗體就有透明效果
Canvas.Brush.Style := bsClear;
end;
//Memo 組件的光標(biāo)定位
procedure TForm1.Memo1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
Lpos, Cpos, Linelength: integer;
begin
Lpos := SendMessage(Memo1.Handle, EM_LineFromChar, Memo1.SelStart, 0);
Cpos := SendMessage(Memo1.Handle, EM_LineIndex, Lpos, 0);
LineLength := SendMessage(Memo1.Handle, EM_LineLength, Cpos, 0);
Cpos := Memo1.SelStart - Cpos;
Label1.Caption := IntToStr(Lpos);
Label2.Caption := IntToStr(Cpos);
Label3.Caption := IntToStr(LineLength);
end;
//點(diǎn)擊客戶(hù)區(qū)也能拖動(dòng)窗口
procedure WmNCHitTest(var Msg: TWMNCHitTest); message WM_NCHitTest;
procedure TForm1.WmNCHitTest(var Msg: TWMNCHitTest);
begin
DefaultHandler(Msg);
if Msg.Result = HTClient then
Msg.Result := HTCaption;
end;
//自定義Memo控件的邊界
procedure TForm1.Button1Click(Sender: TObject);
var
Rect: TRect;
begin
SendMessage(Memo1.Handle, EM_GETRECT, 0, LongInt(@Rect));
Rect.Left := 20;
Rect.Top := 20;
Rect.Right := Rect.Right - 19;
Rect.Bottom := Rect.Bottom - 19;
SendMessage(Memo1.Handle, EM_SETRECT, 0, LongInt(@Rect));
Memo1.Refresh;
end;
//在系統(tǒng)菜單上添加自定義菜單項(xiàng)
procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND;
const
idMyFunc = $f200;
procedure TForm1.FormCreate(Sender: TObject);
begin
AppendMenu(GetSystemMenu(Handle, False), MF_STRING, idMyFunc, ’我的系統(tǒng)菜單項(xiàng)’);
end;
procedure TForm1.WMSysCommand(var Msg: TWMSysCommand);
begin
inherited;
if Msg.CmdType and $FFF0 = idMyFunc then
ShowMessage(’我的系統(tǒng)菜單項(xiàng)’);
end;
COOLBAR內(nèi)嵌TOOLBAR,但是TOOLBAR的按鈕偏上的解決辦法：把COOLBAR的COOLBAND的BORDERSTYLE設(shè)為SINGLE。
另外，如果想把主菜單弄到TOOLBAR里面，只要把TOOLBAR的MENU設(shè)為主菜單名,并把主菜單的AUTOMERGE設(shè)為T(mén)RUE即可。
------------------------------------
listbox從文件中讀取列表的操作
ListBox1.Items.LoadFromFile(ExtractFilePath(Application.ExeName)+’aaa.txt’);
ListBox1.Items.Add(Edit1.Text); //添加了一個(gè)項(xiàng)目
ListBox1.Items.SaveToFile(ExtractFilePath(Application.ExeName)+’aaa.txt’);
刪除項(xiàng)目ListBox1.Items.Delete(listbox1.itemindex);
------------------------------------
判斷窗體是否已經(jīng)打開(kāi)
if frmPriceInput <> nil then ....
注意：有時(shí)窗體雖然已經(jīng)關(guān)閉，但沒(méi)完全釋放，最好在該窗體關(guān)閉的CLOSE事件里加入 frmPrintInput = nil;
------------------------------------
關(guān)閉MDI子窗口的方法
在子窗口的OnClose事件處理過(guò)程中加入如下代碼
Action := caFree;
Delphi為一個(gè)Form的關(guān)閉行為指定了四種方式，分別是：
caNone -- 禁止Form被關(guān)閉
caHide -- Form不被關(guān)閉，但是被隱藏。被隱藏的Form仍然可以被程序訪(fǎng)問(wèn)。
caFree -- Form被關(guān)閉，并且釋放其占用的資源。
caMinimize -- Form被最小化而不是被關(guān)閉，這是MDI子窗口的默認(rèn)關(guān)閉行為。
------------------------------------
系統(tǒng)配置文件 *.INI 的操作
頭部要引用IniFiles
1、聲明變量
Inifile:TiniFile;
2、指明路徑
IniFile := TIniFile.Create(ExtractFilePath(Application.ExeName)+’option.ini’);
3、讀取變量,注意變量有類(lèi)型之分readstring,readinteger...等
titleBMPfile:=IniFile.ReadString(’TitleImage’,’FileName’,’’); //IniFile.ReadString(’組名’,’變量’,’默認(rèn)值’)
IniFile.ReadInteger
IniFile.ReadBool
4、寫(xiě)入或修改變量
IniFile.WriteString(’標(biāo)題’,’變量1’,’值’);
5、用完后釋放
IniFile.Free;
------------------------------------
動(dòng)態(tài)讀取圖象
Image1.Picture.LoadFromFile(titleBMPFile);
------------------------------------
fastreport自定義函數(shù)的用法
1、先在普通工程窗體上定義好函數(shù)
2、在frreport控件的userfunction中寫(xiě)入
if ansicomparetext( ’My_StrToRMB’ , Name ) = 0 then
val:=My_StrToRMB(frparser.Calc(p1));
//MY_STRTORMB是函數(shù)名
//如果定義多個(gè)函數(shù)，就多來(lái)幾個(gè)IF即可。
在報(bào)表設(shè)計(jì)視圖中就可以調(diào)用這個(gè)函數(shù)了。
------------------------------------
數(shù)組是這樣定義的
sbh:array [0..9999999,0..1] of string;
------------------------------------
treeview的用法
//先定義項(xiàng)目序數(shù)和節(jié)點(diǎn)
n: Integer;
Node: TTreeNode;
Node := Tree1.Selected;
if (Node = nil) or (Node.StateIndex = -1) then Exit;//一般可以把不作反應(yīng)的列的stateindex定為-1
n := Node.StateIndex;
------------------------------------
Fields[] 通過(guò)索引返回字段,要自己選擇返回的類(lèi)型!
FieldByName() 通過(guò)名字返回字段,要自己選擇返回的類(lèi)型!
Fieldvalues[] 通過(guò)名字返回字段的值,自動(dòng)化類(lèi)型!
------------------------------------
調(diào)用外部程序方法
用ShellExecute，在USES段加入SHELLAPI，使用時(shí)如：
ShellExecute(handle,’open’,’c:\myapp\myapp.exe’,’-s’,’’,SW_SHOWNORMAL);
第一個(gè)參數(shù)為父窗口句柄；
第二個(gè)參數(shù)為打開(kāi)方式（OPEN，PRINT兩種）；
第三個(gè)參數(shù)為執(zhí)行文件全路徑；
第四個(gè)參數(shù)為執(zhí)行文件參數(shù)；
第五個(gè)參數(shù)為執(zhí)行文件開(kāi)始運(yùn)行時(shí)的初始目錄；
第六個(gè)參數(shù)為為執(zhí)行文件運(yùn)行方式(SW_HIDE,SW_MAXIMIZE,SW_MINIMIZE,
SW_RESTORE,SW_SHOW,SW_SHOWDEFAULT,SW_SHOWMAXIMIZED,SW_SHOWMINIMIZED,
SW_SHOWMINNOACTIVE,SW_SHOWNA,SW_SHOWNOACTIVATE,SW_SHOWNORMAL);
------------------------------------
判斷文件是否存在
if not fileexists(’db2.mdb.bak’) then ...
------------------------------------
判斷按鍵
if Key=#13 then //如果回車(chē)則。。。
------------------------------------
退出
關(guān)閉窗口 close;
關(guān)閉程序：Application.Terminate;
退出事件 exit;
------------------------------------
檢測(cè)軟件是否已在運(yùn)行
if GetLastError = ERROR_ALREADY_EXISTS then...
------------------------------------
定義函數(shù)是這樣寫(xiě)的
function IsReadOnly(b: Boolean; colors: Tcolor): Boolean;
------------------------------------
fastreport直接打印
FrReport1.PrepareReport; //初始化
FrReport1.PrintPreparedReport(’1’,1,True,frAll); //打印
預(yù)覽FrReport1.showreport;
------------------------------------
找開(kāi)瀏覽器，進(jìn)入某站點(diǎn)。（或調(diào)用WINDOWS程序）
進(jìn)入站點(diǎn)ShellExecute(Handle, PChar(’OPEN’), PChar(’http://www.devexpress.com/downloads/index.asp’), nil, nil, SW_SHOWMAXIMIZED);
發(fā)送郵件ShellExecute(Handle, ’open’, PChar(’mailto:’ + edtemail.Text + ’?subject=’), nil, nil, SW_SHOW);
------------------------------------
打開(kāi)文件對(duì)話(huà)框
if OpenPictureDialog.Execute then
------------------------------------
調(diào)用幫助文件
Application.HelpFile := ’..\..\Help\eBars.hlp’;
------------------------------------
打開(kāi)窗口
TForm1.Create(self).ShowModal;
------------------------------------
取得當(dāng)前執(zhí)行程序的路徑
FPath := ExtractFilePath(Application.ExeName);
或
FileName := ExtractFilePath(ParamStr(0)) + ’\MDB\電子通訊錄.mdb’;
------------------------------------
當(dāng)前路徑
getcurrentdir
------------------------------------
判斷當(dāng)前鼠標(biāo)處于某個(gè)位置（TAG）
case TComponent(Sender).Tag of
0: begin
...
lbBarBackgroud.Caption := sCustomImage;
end;
1: begin
...
lbBarBackgroud.Caption := sCustomImage;
end;
2: begin
...
lbBarBackgroud.Caption := sCustomImage;
end;
------------------------------------
數(shù)據(jù)庫(kù)連接
1、建立一個(gè)adoconnection控件，命名為conn
2、建立一個(gè)adodataset控件,命名為ds
然后就可以用以下語(yǔ)句連接并執(zhí)行SQL查詢(xún)(本例是access的數(shù)據(jù)庫(kù)，帶密碼)。
conn.ConnectionString:=’Provider=Microsoft.Jet.OLEDB.4.0;Data Source=’+getcurrentdir+’\data\pn.mdb;Persist Security Info=False;jet oledb:database password=80513’;
conn.Connected:=true;
ds.Active:=false;
ds.CommandText:=’select 拜訪(fǎng)日期,拜訪(fǎng)時(shí)間,拜訪(fǎng)客戶(hù),拜訪(fǎng)地點(diǎn),談話(huà)內(nèi)容 from khbf order by 拜訪(fǎng)日期 desc’;
ds.Active:=true;
------------------------------------
ADODataSet1.State的用法
if ADODataSet1.State in [dsEdit,dsInsert] then
ADODataSet1.Post ;
------------------------------------
ADOQuery.open和ADOQuery.execSQL的區(qū)別
用于存貯時(shí)如insert 只能用execSQL
------------------------------------
------------------------------------
------------------------------------
------------------------------------
回車(chē)光標(biāo)移到另一個(gè)輸入框
if key=#13 then
cmb_name.SetFocus;
------------------------------------
播放聲音
playsound(’c:\windows\media\start.wav’,0,SND_ASYNC);
------------------------------------
列表框listbox增加項(xiàng)目
cmb_name.Items.Add(adotable1.Fieldvalues[’賬號(hào)’]);
------------------------------------
listview用法
ListView.Selected := ListView.Items[0];
ListView.Selected.Focused := True;
ListView.Selected.MakeVisible(False);
ListView.Selected.Index
ListView.Items.Count
ListView.Items.Delete(3) //刪除第3個(gè)項(xiàng)目
ListView.Items.Add.Caption:=’dddddddd’; //增加一個(gè)項(xiàng)目
ListView.Items.BeginUpdate;
ListView.Items.EndUpdate
ListView.Canvas.Font.Color := clGrayText;
if ListView.Selected <> nil then。。。。。
//往listview添加項(xiàng)目
先定義
var itm: TListItem;
然后
listview.Items.Clear;
itm := listview.Items.Add;
itm.ImageIndex := 5;
itm.Caption := Msg.Subject;
itm.SubItems.Add(’aaaaa’);
itm.SubItems.Add(’ffffff’);
itm.SubItems.Add(’ffdfdfdf’);
itm.SubItems.Add(’oooo’);
------------------------------------
靜態(tài)調(diào)用DLL的方法
有參數(shù)
procedure CreateSms(Text: Pchar);stdcall;External ’SmsLib.dll’;
無(wú)參數(shù)
procedure CreateSms;stdcall;External ’SmsLib.dll’;
------------------------------------
確定、取消對(duì)話(huà)框作用
if application.MessageBox(’真的退出?’,’提示’,mb_okcancel)=idok then
application.Terminate; //Terminate是終止程序
showmessage(’請(qǐng)先選中要修改的班級(jí)’); //這個(gè)是簡(jiǎn)單的顯示提示框
messagebox(self.Handle ,’價(jià)格輸入不合法!’,’提示’,MB_OK or MB_ICONASTERISK);
------------------------------------
調(diào)用窗體的步驟
先引用該窗體的單元，然后建立窗體，最后顯示出來(lái)。
例1：
use uxsgl;
Application.CreateForm(TFmXsgl, FmXsgl);
fmxsgl.ShowModal;
例2：
Frm_LendDetail:=TFrm_LendDetail.Create(self);
Try
Frm_LendDetail.ShowModal;
Finally
Frm_LendDetail.Free;
End;
------------------------------------
數(shù)據(jù)庫(kù)查詢(xún)
先建立數(shù)據(jù)源，然后添加一個(gè)TADOQUERY
adoquery1.SQL.Clear ;
adoquery1.Close;
adoquery1.SQL.Add(’select * from tkcb order by ckcb_kh’);
adoquery1.Open;
aaa=adoquery1.Fieldvalues[’ckcb_kc’]; //取出當(dāng)前記錄某字段的值
adoquery1.Next; //下一記錄
adoquery1.Close; //關(guān)閉查詢(xún)
------------------------------------
判斷鍵盤(pán)輸入字符-chr(13)是回車(chē)
if key=chr(13) then
bitbtn1.SetFocus;
------------------------------------
時(shí)間格式
lblTime.Caption := FormatDateTime(’yyyymmdd hh:nn:ss’,Now);
------------------------------------
表數(shù)據(jù)的添加添加
dmd是數(shù)據(jù)模塊 tbl_zgdb是表名
with dmd.tbl_zgdb do begin
Append;
Fieldvalues[’HYZH’] := Edt_HYZH.text;
Fieldvalues[’XM’] := Edt_xm.text;
Fieldvalues[’XB’] := Edt_xb.text;
Fieldvalues[’dw’] := Edt_dw.text;
Fieldvalues[’ZZMM’] := zzmm;
Fieldvalues[’CSNY’] := trim(Edt_csny.text);
Fieldvalues[’GZSJ’] := Edt_gzsj.text;
Fieldvalues[’DBLB’] := dblb;
Fieldvalues[’ZCLB’] := zclb;
Fieldvalues[’XL’] := xl;
Fieldvalues[’BZ’] := Edt_bz.text;
Post;
close;
end;
------------------------------------
列表框的選項(xiàng)值
Edit1.Text:=listbox1.Items.Strings[listbox1.itemindex];
------------------------------------
Delphi鍵盤(pán)按鍵偽碼
用法：if key = chr(VK_RETURN) then...
常數(shù)名稱(chēng) 十六進(jìn)制值 十進(jìn)制值 對(duì)應(yīng)按鍵
VK_LBUTTON 01 1 鼠標(biāo)的左鍵
VK_RBUTTON 02 2 鼠標(biāo)的右鍵
VK-CANCEL 03 3 Contol-break 執(zhí)行
VK_MBUTTON 04 4 鼠標(biāo)的中鍵（三按鍵鼠標(biāo))
VK_BACK 08 8 Backspace鍵
VK_TAB 09 9 Tab鍵
VK_CLEAR 0C 12 Clear鍵
VK_RETURN 0D 13 Enter鍵
VK_SHIFT 10 16 Shift鍵
VK_CONTROL 11 17 Ctrl鍵
VK_MENU 12 18 Alt鍵
VK_PAUSE 13 19 Pause鍵
VK_CAPITAL 14 20 Caps Lock鍵
VK_ESCAPE 1B 27 Ese鍵
VK_SPACE 20 32 Spacebar鍵
VK_PRIOR 21 33 Page Up鍵
VK_NEXT 22 34 Page Domw鍵
VK_END 23 35 End鍵
VK_HOME 24 36 Home鍵
VK_LEFT 25 37 LEFT ARROW 鍵(←)
VK_UP 26 38 UP ARROW鍵(↑)
VK_RIGHT 27 39 RIGHT ARROW鍵(→)
VK_DOWN 28 40 DOWN ARROW鍵(↓)
VK_SELECT 29 41 SELECT鍵
VK_EXECUTE 2B 43 EXECUTE鍵
VK_SNAPSHOT 2C 44 Print Screen鍵
VK_INSERT 2D 45 Ins鍵
VK_DELETE 2E 46 Del鍵
VK_HELP 2F 47 Help鍵
VK_0 30 48 0鍵
VK_1 31 49 1鍵
VK_2 32 50 2鍵
VK_3 33 51 3鍵
VK_4 34 52 4鍵
VK_5 35 53 5鍵
VK_6 36 54 6鍵
VK_7 37 55 7鍵
VK_8 38 56 8鍵
VK_9 39 57 9鍵
VK_A 41 65 A鍵
VK_B 42 66 B鍵
VK_C 43 67 C鍵
VK_D 44 68 D鍵
VK_E 45 69 E鍵
VK_F 46 70 F鍵
VK_G 47 71 G鍵
VK_H 48 72 H鍵
VK_I 49 73 I鍵
VK_J 4A 74 J鍵
VK_K 4B 75 K鍵
VK_L 4C 76 L鍵
VK_M 4D 77 M鍵
VK_N 4E 78 N鍵
VK_O 4F 79 O鍵
VK_P 50 80 P鍵
VK_Q 51 81 Q鍵
VK_R 52 82 R鍵
VK_S 53 83 S鍵
VK_T 54 84 T鍵
VK_U 55 85 U鍵
VK_V 56 86 V鍵
VK_W 57 87 W鍵
VK_X 58 88 X鍵
VK_Y 59 89 Y鍵
VK_BZ 5A 90 Z鍵
VK_NUMPAD0 60 96 數(shù)字鍵0鍵
VK_NUMPAD1 61 97 數(shù)字鍵1鍵
VK_NUMPAD2 62 98 數(shù)字鍵2鍵
VK_NUMPAD3 63 99 數(shù)字鍵3鍵
VK_NUMPAD4 64 100 數(shù)字鍵4鍵
VK_NUMPAD5 65 101 數(shù)字鍵5鍵
VK_NUMPAD6 66 102 數(shù)字鍵6鍵
VK_NUMPAD7 67 103 數(shù)字鍵7鍵
VK_NUMPAD8 68 104 數(shù)字鍵8鍵
VK_NUMPAD9 69 105 數(shù)字鍵9鍵
VK_MULTIPLY 6A 106 *鍵
VK_ADD 6B 107 +鍵
VK_SEPARATOR 6C 108 Separator鍵
VK_SUBTRACT 6D 109 -鍵
VK_DECIMAL 6E 110 .鍵
VK_DIVIDE 6F 111 鍵
VK_F1 70 112 F1鍵
VK_F2 71 113 F2鍵
VK_F3 72 114 F3鍵
VK_F4 73 115 F4鍵
VK_F5 74 116 F5鍵
VK_F6 75 117 F6鍵
VK_F7 76 118 F7鍵
VK_F8 77 119 F8鍵
VK_F9 78 120 F9鍵
VK_F10 79 121 F10鍵
VK_F11 7A 122 F11鍵
VK_F12 7B 123 F12鍵
VK_NUMLOCK 90 144 Num Lock 鍵
VK_SCROLL 91 145 Scroll Lock鍵
1、判斷機(jī)器是否網(wǎng)絡(luò)狀態(tài)
答：
uses WinInet;
procedure TForm1.Button1Click(Sender: TObject);
function GetOnlineStatus : Boolean;
var ConTypes : Integer;
begin
ConTypes := INTERNET_CONNECTION_MODEM + INTERNET_CONNECTION_LAN + INTERNET_CONNECTION_PROXY;
if (InternetGetConnectedState(@ConTypes, 0) = False)
then Result := False
else Result := True;
end;
begin
if not GetOnlineStatus then ShowMessage(’Not Connected’);
end;
=========================================
2、[DELPHI]窗體漸漸出現(xiàn)
答：
AnimateWindow(Handle,1000,AW_CENTER);
//在窗體創(chuàng)建事件中
=========================================
3、如何取得一臺(tái)機(jī)器的CPU占用率 ？
答：
使用下面的方法
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
const
SystemBasicInformation = 0;
SystemPerformanceInformation = 2;
SystemTimeInformation = 3;
type
TPDWord = ^DWORD;
TSystem_Basic_Information = packed record
dwUnknown1: DWORD;
uKeMaximumIncrement: ULONG;
uPageSize: ULONG;
uMmNumberOfPhysicalPages: ULONG;
uMmLowestPhysicalPage: ULONG;
uMmHighestPhysicalPage: ULONG;
uAllocationGranularity: ULONG;
pLowestUserAddress: Pointer;
pMmHighestUserAddress: Pointer;
uKeActiveProcessors: ULONG;
bKeNumberProcessors: byte;
bUnknown2: byte;
wUnknown3: word;
end;
type
TSystem_Performance_Information = packed record
liIdleTime: LARGE_INTEGER; {LARGE_INTEGER}
dwSpare: array[0..75] of DWORD;
end;
type
TSystem_Time_Information = packed record
liKeBootTime: LARGE_INTEGER;
liKeSystemTime: LARGE_INTEGER;
liExpTimeZoneBias: LARGE_INTEGER;
uCurrentTimeZoneId: ULONG;
dwReserved: DWORD;
end;
var
NtQuerySystemInformation: function(infoClass: DWORD;
buffer: Pointer;
bufSize: DWORD;
returnSize: TPDword): DWORD; stdcall = nil;
liOldIdleTime: LARGE_INTEGER = ();
liOldSystemTime: LARGE_INTEGER = ();
SysBaseInfo: TSystem_Basic_Information;
SysPerfInfo: TSystem_Performance_Information;
SysTimeInfo: TSystem_Time_Information;
status: Longint; {long}
dbSystemTime: Double;
dbIdleTime: Double;
function GetCPUUsage:Double;
implementation
function Li2Double(x: LARGE_INTEGER): Double;
begin
Result := x.HighPart * 4.294967296E9 + x.LowPart
end;
function GetCPUUsage:Double;
var
bLoopAborted : boolean;
begin
if @NtQuerySystemInformation = nil then
NtQuerySystemInformation := GetProcAddress(GetModuleHandle(‘ntdll.dll‘),
‘NtQuerySystemInformation‘);
// get number of processors in the system
status := NtQuerySystemInformation(SystemBasicInformation, @SysBaseInfo, SizeOf(SysBaseInfo), nil);
if status <> 0 then Exit;
// Show some information
{with SysBaseInfo do
begin
ShowMessage(
Format(‘uKeMaximumIncrement: %d‘#13‘uPageSize: %d‘#13+
‘uMmNumberOfPhysicalPages: %d‘+#13+‘uMmLowestPhysicalPage: %d‘+#13+
‘uMmHighestPhysicalPage: %d‘+#13+‘uAllocationGranularity: %d‘#13+
‘uKeActiveProcessors: %d‘#13‘bKeNumberProcessors: %d‘,
[uKeMaximumIncrement, uPageSize, uMmNumberOfPhysicalPages,
uMmLowestPhysicalPage, uMmHighestPhysicalPage, uAllocationGranularity,
uKeActiveProcessors, bKeNumberProcessors]));
end;
}
bLoopAborted := False;
while not bLoopAborted do
begin
// get new system time
status := NtQuerySystemInformation(SystemTimeInformation, @SysTimeInfo, SizeOf(SysTimeInfo), 0);
if status <> 0 then Exit;
// get new CPU‘s idle time
status := NtQuerySystemInformation(SystemPerformanceInformation, @SysPerfInfo, SizeOf(SysPerfInfo), nil);
if status <> 0 then Exit;
// if it‘s a first call - skip it
if (liOldIdleTime.QuadPart <> 0) then
begin
// Currentvalue = Newvalue - Oldvalue
dbIdleTime := Li2Double(SysPerfInfo.liIdleTime) - Li2Double(liOldIdleTime);
dbSystemTime := Li2Double(SysTimeInfo.liKeSystemTime) - Li2Double(liOldSystemTime);
// CurrentCpuIdle = IdleTime / SystemTime
dbIdleTime := dbIdleTime / dbSystemTime;
// CurrentCpuUsage% = 100 - (CurrentCpuIdle * 100) / NumberOfProcessors
dbIdleTime := 100.0 - dbIdleTime * 100.0 / SysBaseInfo.bKeNumberProcessors + 0.5;
// Show Percentage
//Form1.Label1.Caption := FormatFloat(‘CPU Usage: 0.0 %‘,dbIdleTime);
//Application.ProcessMessages;
// Abort if user pressed ESC or Application is terminated
Result:=dbIdleTime;
bLoopAborted:=True;
//bLoopAborted := (GetKeyState(VK_ESCAPE) and 128 = 128) or Application.Terminated;
end;
// store new CPU‘s idle and
=========================================
4、動(dòng)態(tài)生成控件？
答：
var
TeSpeedButtonX:TTeSpeedButton;
begin
TeSpeedButtonX:=TTeSpeedButton.Create(nil);
TeSpeedButtonX.Caption:=’標(biāo)題’;
TeSpeedButtonX.Name:=’按鈕’+inttostr(X);
TeSpeedButtonX.Parent:=Tetoolbar2;
X:=X+1;
end;
=========================================
5、我動(dòng)態(tài)創(chuàng)建了多個(gè)button，使用時(shí)，我怎么判斷出用戶(hù)點(diǎn)擊的是哪個(gè)button呢？button的各項(xiàng)屬性都邊成最后創(chuàng)建的那個(gè)button的了，怎么辦哦？
答1：
教你一招,先設(shè)置每個(gè)button的tag屬性.然后在onclick事件中用(sender as button).tag來(lái)判斷,相信我,沒(méi)錯(cuò)的!
答2：
如果你生成的控件不是很多的話(huà)，最簡(jiǎn)單的方法就是，假如你生成控件的父控件是FORM1，利用循環(huán)判斷控件是否等于FORM1.ACTIVECONTROL，我就是這么用的。ACTIVECONTROL就是記錄當(dāng)前被點(diǎn)擊的控件，你也可以直接用它，不過(guò)直接只能用到CONTROL的一般屬性和方法，循環(huán)判斷的話(huà)就可以用到你生成控件的相關(guān)屬性。
=========================================
6、窗體釋放問(wèn)題
答：
在Form2.OnClose事件中
Action:=caFree;
1、怎么樣在delphi中調(diào)動(dòng)其它*.exe文件？
例如：winexec(’d:\鄭洽\Project1.exe’,sw_show);
================================
2、如何讓工程運(yùn)行時(shí)主窗體就是最大化的？
答：設(shè)置主窗體的WindowsState屬性為wsMaximized就可以了!
wsNormal 窗體以普通狀態(tài)顯示
wsMinimized 窗體以最小化狀態(tài)顯示。
wsMaximized 窗體以最大化狀態(tài)顯示。
================================
3、我想先->閃現(xiàn)窗體->主窗體->登錄窗體，工程源文件怎么設(shè)置？
答：
⒈開(kāi)始一個(gè)新工程。給表格起名為MainForm,MainForm的單元起名為Main, 工程文 件起名為T(mén)est。
⒉在MainForm中插入一個(gè)Button部件，將其Caption屬性設(shè)為“關(guān)閉”，為該部件 的onClick事件創(chuàng)建一個(gè)過(guò)程，并在過(guò)程的begin和end之間插入Close語(yǔ)句。
⒊在應(yīng)用程序添加一個(gè)表格，將這個(gè)表格起名為MoveForm，MoveForm 的單元起名 為Move。
⒋為便于演示，在MoveForm中插入一個(gè)Label部件，設(shè)置其Caption 屬性為“歡迎 進(jìn)入本系統(tǒng)”。
5.下一步修改工程的源代碼。選擇View/Project Source，修改begin和end之間的 語(yǔ)句如下：
程序清單Test.Dpr
program Test
uses
forms,
Main in ’MAIN.PAS’{MainForm},
Move in ’Move.PAS’{MoveForm}
{$R *.RES}
begin
MoveForm:=TMoveForm.Create(Application);{Create創(chuàng)建閃現(xiàn)窗口對(duì)象}
MoveForm.Show;
MoveForm.Update;
Application.CreateForm(TMainForm,MainForm);
MoveForm.Hide;
MoveForm.Free;{Free從內(nèi)存中釋放對(duì)象}
Application.Run;
end.
第一條語(yǔ)句創(chuàng)建了對(duì)象，該對(duì)象存在內(nèi)存中，但還不能看見(jiàn)， 為了讓它出現(xiàn)并更 新它的內(nèi)容，調(diào)用對(duì)象的Show和Update成員函數(shù)：Show和Update。 當(dāng)閃現(xiàn)窗口使 用完后，用Hide函數(shù)將它隱藏起來(lái)，然后用Free函數(shù)釋放它所占據(jù)的內(nèi)存。
6.如果此刻你編譯和運(yùn)行程序，MoveForm窗口一閃而過(guò)， 你可能未來(lái)得及看 清。為使MoveForm窗口顯示幾秒種，我們可為MainForm的OnCreate 事件創(chuàng)建一個(gè) 處理程序，延遲MoveForm窗口的顯現(xiàn)時(shí)間。
program TMainForm.FormCreate(sender:Tobject);
var
currentTime:LongInt;
begin
currentTime:=GetTickCount div 1000;
while ((GetTickCount div 1000)<(currentTime+3) do
{不做任何事);
end;
end.
GetTickCount函數(shù)返回窗口啟動(dòng)后過(guò)去的毫秒數(shù)，這個(gè)值除以1000 轉(zhuǎn)化為秒數(shù)。 此時(shí)你編譯運(yùn)行程序，就能得到一個(gè)延遲3秒多的閃現(xiàn)窗口。
為閃現(xiàn)窗口添加上Image部件，再對(duì)字體及窗口進(jìn)行修飾，我們就能為應(yīng)用程 序，創(chuàng)建一個(gè)精美的封面或在程序啟動(dòng)時(shí)顯示重要提示。
制作登錄窗體一個(gè)很方便的方法就是主窗體作為主窗體，登錄成功Hide掉就行了。
如果登錄窗體不可以作為主窗體，那么和閃現(xiàn)窗體一樣的方法創(chuàng)建登錄窗體，加在Application.Run;之前，MoveForm.Free;之后，
用showmodal顯示登錄窗體
================================
4、button上面的文字怎么樣換行？
答：
button控件不行
bitbtn控件可以。
bitbtn1.caption:=’aaaa’#13’bbbbb’
================================
5、怎么樣判別焦點(diǎn)是否在某個(gè)控件上？
答：
if Tobject.focused then
//焦點(diǎn)在某某控件上
else
================================
6、怎么樣在程序中使一個(gè)節(jié)點(diǎn)的子節(jié)點(diǎn)展開(kāi)及收閉？
答：
treeview1.selected.Expanded; //判斷節(jié)點(diǎn)的子節(jié)點(diǎn)是否展開(kāi)True展開(kāi)，否則閉攏
treeview1.selected.Expand(True);//子節(jié)點(diǎn)展開(kāi)
treeview1.selected.collapse(True)://子節(jié)點(diǎn)閉攏
樹(shù)節(jié)點(diǎn)全部展開(kāi)：
procedure TForm1.Button1Click(Sender: TObject);
var node:TTreeNode;
begin
if treeview1.Items[0]<>nil then
begin
node:=treeview1.Items[0];
node.Expand(true);
while node.getNextSibling<>nil do
begin
node:=node.getNextSibling;
node.Expand(true);
end;
end;
end;
樹(shù)節(jié)點(diǎn)全部收縮：
procedure TForm1.Button2Click(Sender: TObject);
var node:TTreeNode;
begin
if treeview1.Items[0]<>nil then
begin
node:=treeview1.Items[0];
node.Collapse(true);
while node.getNextSibling<>nil do
begin
node:=node.getNextSibling;
node.Collapse(true);
end;
end;
end;
================================
7、如何用delphi編程實(shí)現(xiàn)給access數(shù)據(jù)庫(kù)加密碼?
答：1，新建Project。
2，在FORM中放入ADOConnection控件。
3，雙擊ADOConnection控件，然后點(diǎn)擊Build...按鈕，在“提供者”頁(yè)中選擇“Microsoft Jet 4.0 OLE DB Provider”，然后點(diǎn)擊“下一步”按鈕，在“連接”頁(yè)中選擇要連接的Access數(shù)據(jù)庫(kù)的路徑和數(shù)據(jù)庫(kù)的文件名，這時(shí)如果點(diǎn)“測(cè)試連接”按鈕時(shí)，出現(xiàn)“初始化提供者時(shí)發(fā)生錯(cuò)誤，測(cè)試連接失敗，密碼無(wú)效”的錯(cuò)誤提示。
4，這時(shí)點(diǎn)“所有”頁(yè)，然后雙擊“Jet OLEDB:Database Password”，出現(xiàn)對(duì)話(huà)框，添入密碼后，選擇“連接”頁(yè)中的“測(cè)試連接”按鈕，出現(xiàn)“測(cè)試連接成功”的對(duì)話(huà)框。把ADOConnection控件的LoginPromtp設(shè)為false.
5，設(shè)置連接完成。
================================
8、如何判斷Treeview中我選中的節(jié)點(diǎn)是否有子節(jié)點(diǎn)？如果沒(méi)有給出提示啊?
答：
if Treeview.Selected.HasChildren then
//有
else
//無(wú)
var
Node :TTreeNode;
begin
Node :=TreeView1.Selected;
if Node.HasChildren then
....
對(duì)復(fù)雜的程序最好用Node過(guò)渡
================================
9、能否解釋一下try...except...end及try...finally...end;?
1.(1)是用于撲捉異常，(2)是用于保證代碼執(zhí)行的完整性
2.(1)中finally處的代碼不管什么情況都會(huì)被執(zhí)行，(2)中except處的代碼僅在發(fā)生異常時(shí)才會(huì)執(zhí)行
3.try finally之間的代碼雖可保證finally 和 end之間的程序能執(zhí)行,但不能保證程序不崩潰,
而try except就不會(huì)使程序崩潰
================================
10、怎么樣在主程序控制器中加入音樂(lè)？
在implementation下加入 mmsystem單元（windows多媒體函數(shù)動(dòng)態(tài)聯(lián)結(jié)庫(kù)）。然後在的onShow,onCreate事件中編寫(xiě)代碼：sndplaysound(’sound.wav’,snd_async)
================================
11、我在form1上有四個(gè)edit,輸完后我想用下上箭頭鍵進(jìn)行上移下移？怎么辦？
答：
procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key=vk_down then perform(WM_NEXTDLGCTL,0,0) else
if key=vk_up then perform(WM_NEXTDLGCTL,1,0);
end;
================================
12、如何用delphi5實(shí)現(xiàn)讀文本文件指定的一行，并得到文本文件的總行數(shù)？謝謝！
答：
Delphi讀文件文件一般使用Readln過(guò)程，如要讀第3行可以這樣：
var
i : Integer;
F: TextFile;
S: string;
begin
if OpenDialog1.Execute then { Display Open dialog box }
begin
AssignFile(F, OpenDialog1.FileName); { File selected in dialog }
Reset(F);
For i = 1 To 3 Do
Readln(F, S);
Edit1.Text := S; { Put string in a TEdit control }
CloseFile(F);
.
end;
要統(tǒng)計(jì)總行數(shù)，只能從頭逐行讀，直到文件尾（Eof函數(shù)為T(mén)rue），每讀一行計(jì)數(shù)器加1。
不過(guò)由于文本文件的每行長(zhǎng)度不相等，它不能象數(shù)據(jù)庫(kù)文件那樣想讀那行就讀哪行，只能順序讀。
上面的方法容易理解，也容易實(shí)現(xiàn)。如果希望提高速度，編程上要麻煩一些，可以以二進(jìn)制方式打開(kāi)文件，將所有內(nèi)容讀入一個(gè)內(nèi)存變量，然后使用Pos函數(shù)查找其中的回車(chē)（#13）個(gè)數(shù)，這樣可以快速地統(tǒng)計(jì)總行數(shù)并能快速地找到指定行。
================================
13、制作主窗口顯示前的版權(quán)窗口
答：
在工程文件中選File->New Form新建一個(gè)窗口，設(shè)計(jì)好窗口的外觀(guān)。給窗口起名為AboutBox,選Project->Options，將新建的窗口從自動(dòng)建立中去掉。 選View->Project Source，打開(kāi)工程文件的源文件，在下面加入紅色的句子。
Uses AboutBox
Var
lTime :TDateTime;
Begin
Application.Initialize();
AboutBox=TAboutBox.Create(AboutBox);
AboutBox.Show;
AboutBox.Update;
lTime=GetTickCount;
Application.CreateForm(TMainForm,MainForm);
while((GetTickCount-lTime) / 1000 <3) do;
AboutBox.Hide;
AboutBox.Free;
Application.Run;
end;
================================
14、Delphi中RichEdit的奧妙
一、如何得知當(dāng)前行號(hào)
用RichEdit（或者memo）控件制作文本編輯器時(shí)，通過(guò)訪(fǎng)問(wèn)lines?count屬性可以得到總行數(shù)，但是若想知道光標(biāo)當(dāng)前所在行的行號(hào)就麻煩了，因?yàn)閐elphi沒(méi)有提供這個(gè)屬性。要實(shí)現(xiàn)這個(gè)編輯器必備功能，就須調(diào)用em_ LineFromChar。
請(qǐng)?jiān)囋囅旅娴某绦颉?
先在窗口中布置一個(gè)RichEdit或者memo（命名為editor），以及一個(gè)button。在button的onclick事件中寫(xiě)入下列代碼。
var
CurrentLine:Integer;
begin
CurrentLine:=Editor.Perform(em_ LineFromChar,SFFFF,0);
Application.MessageBox(PChar(′當(dāng)前行號(hào)是′＋I(xiàn)ntToStr(CurrentLine)),′消息′,mb_ iconinformation);
end;
需要注意的是，第一行的行號(hào)為零。
二、如何撤消操作（undo）
對(duì)于memo來(lái)說(shuō)，實(shí)現(xiàn)undo是不需編程的，只要讓popupmenu屬性為空，運(yùn)行時(shí)就能用鼠標(biāo)右鍵激活一個(gè)常用操作菜單，其中包括撤消、剪切、復(fù)制、粘貼、刪除和全選六項(xiàng)。 但可惜的是，這一招對(duì)于功能強(qiáng)大的RichEdit控件居然行不通，害得我們還要自己設(shè)計(jì)一個(gè)popupmemu。當(dāng)你用CutToClipBoard等語(yǔ)句輕松而順利地完成了“剪切”等功能，接著便會(huì)無(wú)奈地發(fā)現(xiàn)，竟找不到undo或cancel之類(lèi)的語(yǔ)句來(lái)執(zhí)行“撤消”。 這時(shí)你需要這樣處理：
RichEdit1?Perform(EM_UNDO,0,0);
另外還應(yīng)檢查是否允許撤消，從而開(kāi)啟或關(guān)閉彈出菜單中的“撤消”項(xiàng)：
Undo1?Enabled:=RichEdit?
Perform(EM_CANUNDO,0,0)<>0;
以上程序在Delphi3中調(diào)試通過(guò)?！ ?
================================
15、在主窗口中打開(kāi)另一個(gè)獨(dú)立的窗口,而這個(gè)被打開(kāi)的窗口固定顯示在..?
答：
procedure TForm2.FormCreate(Sender: TObject);
begin
form2.Hide;
self.Parent:=form1.Panel1;
end;
================================
16、SaveDialog1確認(rèn)文件存不存在的辦法？
答：
procedure TForm1.SaveDialog1CanClose(Sender: TObject;
var CanClose: Boolean);
begin
if FileExists(SaveDialog1.FileName) then //如果文件已經(jīng)存在
if MessageDlg(’文件已經(jīng)存在，保存嗎？’, mtConfirmation, [mbYes, mbNo], 0) <> mrYes then
Button2.Click ; //如果選擇了覆蓋，則退出，否則，重新讓用戶(hù)選擇文件
end;
================================
17、正確關(guān)閉一個(gè)MDI子窗口？
答：
Delphi中MDI子窗口的關(guān)閉方式默認(rèn)為縮小而不是關(guān)閉，所以當(dāng)你單擊子窗口右上角的關(guān)閉按鈕時(shí)會(huì)發(fā)覺(jué)該子窗口只是最小化，而不是你預(yù)期的那樣被關(guān)閉。解決辦法是在子窗口的OnClose事件處理過(guò)程中加入如下代碼，示例：
procedure ChildForm.OnClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
end;
Delphi為一個(gè)Form的關(guān)閉行為指定了四種方式，分別是：
caNone 禁止Form被關(guān)閉
caHide Form不被關(guān)閉，但是被隱藏。被隱藏的Form仍然可以被程序訪(fǎng)問(wèn)。
caFree Form被關(guān)閉，并且釋放其占用的資源。
caMinimize Form被最小化而不是被關(guān)閉，這是MDI子窗口的默認(rèn)關(guān)閉行為。
================================
18、怎樣記MDI子窗口不在母體運(yùn)行時(shí)就被打開(kāi)？
答：
在project下的options中forms里面除了form1外，其余的移到右邊的框里，然后在調(diào)用顯示的按鈕下編寫(xiě)語(yǔ)句，以form2調(diào)用為例：
form2:=Tform2.create(self);
form2.show;
================================
19、限制FORM的大小
答：
在FORM私有聲明部分加上如下一行：
procedure WMGetMinMaxInfo( var Message:TWMGetMinMaxInfo );message WM_GETMINMAXINFO;
在聲明部分加上如下幾行:
procedure TForm1.WMGetMinMaxInfo( var Message :TWMGetMinMaxInfo );
begin
with Message.MinMaxInfo^ do
begin
ptMaxSize.X := 200; {最大化時(shí)寬度}
ptMaxSize.Y := 200; {最大化時(shí)高度}
ptMaxPosition.X := 99; {最大化時(shí)左上角橫坐標(biāo)}
ptMaxPosition.Y := 99; {最大化時(shí)左上角縱坐標(biāo)}
end;
Message.Result := 0; {告訴Windows你改變了 minmaxinfo}
inherited;
end;
================================
20、隨機(jī)數(shù)生成法
答：
Randomize;
rn:=inttostr(random(9999));
rn1:=inttostr(random(9999));
.....
================================
21、怎樣把程序隱藏起來(lái)，在WINDOWS界面上沒(méi)有顯示？？
答：
在application.run之前加入application.showmain:=false!
================================
22、怎樣將一個(gè)form1.free的form1窗體重新顯示？
答：
form2:=TForm2.Create(application);
form2.Show;
如果你要?jiǎng)?chuàng)建的Form2窗體能嵌入一個(gè)Panel中，指定Parent:
form2:=TForm2.Create(application);
form2.Parent:=panel1;
form2.Show;
================================
23、我想在bitbtn上設(shè)快捷按鈕Esc，怎么辦？
答：
procedure TForm1.BitBtn1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key=27 then
application.Terminate;
end;
設(shè)它的cancel屬性為true就行了~~
================================
24、什么叫做托盤(pán)區(qū)？
答：
托盤(pán)區(qū)就是在windows的狀態(tài)欄下方顯示時(shí)鐘、輸入法狀態(tài)的地方，
要把你的程序顯示在托盤(pán)區(qū)：
下面是一個(gè)托盤(pán)類(lèi)，只要把下面粘貼到文本文件中，改成TrayIcon.pas，使用時(shí)uses TrayIcon就可以了。
先聲明一個(gè)全局變量：
var tray:TTrayNotifyIcon;
然后在窗體的OnCreate事件中：
tray:=TTrayNotifyIcon.Create(self);//將窗體創(chuàng)建為托盤(pán)
tray.Icon:=application.Icon;//定義托盤(pán)的顯示圖標(biāo)
tray.IconVisible:=true;//托盤(pán)可見(jiàn)
tray.PopupMenu:=popmenu;//給托盤(pán)定義一個(gè)右擊時(shí)的彈出菜單
tray.OnDblClick:=trayDblClick;//給托盤(pán)定義一個(gè)雙擊事件(當(dāng)然要自己寫(xiě)了，不過(guò)多數(shù)情況只有一行，就是Form1.show);
unit TrayIcon;
interface
uses Windows, SysUtils, Messages, ShellAPI, Classes, Graphics, Forms, Menus,
StdCtrls, ExtCtrls;
type
ENotifyIconError = class(Exception);
TTrayNotifyIcon = class(TComponent)
private
FDefaultIcon: THandle;
FIcon: TIcon;
FHideTask: Boolean;
FHint: string;
FIconVisible: Boolean;
FPopupMenu: TPopupMenu;
FonClick: TNotifyEvent;
FOnDblClick: TNotifyEvent;
FNoShowClick: Boolean;
FTimer: TTimer;
Tnd: TNotifyIconData;
procedure SetIcon(value: TIcon);
procedure SetHideTask(value: Boolean);
procedure SetHint(value: string);
procedure SetIconVisible(value: Boolean);
procedure SetPopupMenu(value: TPopupMenu);
procedure SendTrayMessage(Msg: DWORD; Flags: UINT);
function ActiveIconHandle: THandle;
procedure OnButtonTimer(Sender: TObject);
protected
procedure Loaded; override;
procedure LoadDefaultIcon; virtual;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Icon: TIcon read FIcon write SetIcon;
property HideTask: Boolean read FHideTask write SetHideTask default False;
property Hint: String read FHint write SetHint;
property IconVisible: Boolean read FIconVisible write SetIconVisible default False;
property PopupMenu: TPopupMenu read FPopupMenu write SetPopupMenu;
property onClick: TNotifyEvent read FonClick write FonClick;
property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
end;
implementation
{ TIconManager }
{ This class creates a hidden window which handles and routes }
{ tray icon messages }
type
TIconManager = class
private
FHWindow: HWnd;
procedure TrayWndProc(var Message: TMessage);
public
constructor Create;
destructor Destroy; override;
property HWindow: HWnd read FHWindow write FHWindow;
end;
var
IconMgr: TIconManager;
DDGM_TRAYICON: Cardinal;
constructor TIconManager.Create;
begin
FHWindow := AllocateHWnd(TrayWndProc);
end;
destructor TIconManager.Destroy;
begin
if FHWindow <> 0 then DeallocateHWnd(FHWindow);
inherited Destroy;
end;
procedure TIconManager.TrayWndProc(var Message: TMessage);
{ This allows us to handle all tray callback messages }
{ from within the context of the component. }
var
Pt: TPoint;
TheIcon: TTrayNotifyIcon;
begin
with Message do
begin
{ if it’s the tray callback message }
if (Msg = DDGM_TRAYICON) then
begin
TheIcon := TTrayNotifyIcon(WParam);
case lParam of
{ enable timer on first mouse down. }
{ onClick will be fired by OnTimer method, provided }
{ double click has not occurred. }
WM_LBUTTONDOWN: TheIcon.FTimer.Enabled := True;
{ Set no click flag on double click. This will supress }
{ the single click. }
WM_LBUTTONDBLCLK:
begin
TheIcon.FNoShowClick := True;
if Assigned(TheIcon.FOnDblClick) then TheIcon.FOnDblClick(Self);
end;
WM_RBUTTONDOWN:
begin
if Assigned(TheIcon.FPopupMenu) then
begin
{ Call to SetForegroundWindow is required by API }
SetForegroundWindow(IconMgr.HWindow);
{ Popup local menu at the cursor position. }
GetCursorPos(Pt);
TheIcon.FPopupMenu.Popup(Pt.X, Pt.Y);
{ Message post required by API to force task switch }
PostMessage(IconMgr.HWindow, WM_USER, 0, 0);
end;
end;
end;
end
else
{ If it isn’t a tray callback message, then call DefWindowProc }
Result := DefWindowProc(FHWindow, Msg, wParam, lParam);
end;
end;
{ TTrayNotifyIcon }
constructor TTrayNotifyIcon.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FIcon := TIcon.Create;
FTimer := TTimer.Create(Self);
with FTimer do
begin
Enabled := False;
Interval := GetDoubleClickTime;
OnTimer := OnButtonTimer;
end;
{ Keep default windows icon handy... }
LoadDefaultIcon;
end;
destructor TTrayNotifyIcon.Destroy;
begin
if FIconVisible then SetIconVisible(False); // destroy icon
FIcon.Free; // free stuff
FTimer.Free;
inherited Destroy;
end;
function TTrayNotifyIcon.ActiveIconHandle: THandle;
{ Returns handle of active icon }
begin
{ If no icon is loaded, then return default icon }
if (FIcon.Handle <> 0) then
Result := FIcon.Handle
else
Result := FDefaultIcon;
end;
procedure TTrayNotifyIcon.LoadDefaultIcon;
{ Loads default window icon to keep it handy. }
{ This will allow the component to use the windows logo }
{ icon as the default when no icon is selected in the }
{ Icon property. }
begin
FDefaultIcon := LoadIcon(0, IDI_WINLOGO);
end;
procedure TTrayNotifyIcon.Loaded;
{ Called after component is loaded from stream }
begin
inherited Loaded;
{ if icon is supposed to be visible, create it. }
if FIconVisible then
SendTrayMessage(NIM_ADD, NIF_MESSAGE or NIF_ICON or NIF_TIP);
end;
procedure TTrayNotifyIcon.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = PopupMenu) then
PopupMenu := nil;
end;
procedure TTrayNotifyIcon.OnButtonTimer(Sender: TObject);
{ Timer used to keep track of time between two clicks of a }
{ double click. This delays the first click long enough to }
{ ensure that a double click hasn’t occurred. The whole }
{ point of these gymnastics is to allow the component to }
{ receive onClicks and OnDblClicks independently. }
begin
{ Disable timer because we only want it to fire once. }
FTimer.Enabled := False;
{ if double click has not occurred, then fire single click. }
if (not FNoShowClick) and Assigned(FonClick) then
FonClick(Self);
FNoShowClick := False; // reset flag
end;
procedure TTrayNotifyIcon.SendTrayMessage(Msg: DWORD; Flags: UINT);
{ This method wraps up the call to the API’s Shell_NotifyIcon }
begin
{ Fill up record with appropriate values }
with Tnd do
begin
cbSize := SizeOf(Tnd);
StrPLCopy(szTip, PChar(FHint), SizeOf(szTip));
uFlags := Flags;
uID := UINT(Self);
Wnd := IconMgr.HWindow;
uCallbackMessage := DDGM_TRAYICON;
hIcon := ActiveIconHandle;
end;
Shell_NotifyIcon(Msg, @Tnd);
end;
procedure TTrayNotifyIcon.SetHideTask(value: Boolean);
{ Write method for HideTask property }
const
{ Flags to show application normally or hide it }
ShowArray: array[Boolean] of integer = (sw_ShowNormal, sw_Hide);
begin
if FHideTask <> value then
begin
FHideTask := value;
{ Don’t do anything in design mode }
if not (csDesigning in ComponentState) then
ShowWindow(Application.Handle, ShowArray[FHideTask]);
end;
end;
procedure TTrayNotifyIcon.SetHint(value: string);
{ Set method for Hint property }
begin
if FHint <> value then
begin
FHint := value;
if FIconVisible then
{ Change hint on icon on tray notification area }
SendTrayMessage(NIM_MODIFY, NIF_TIP);
end;
end;
procedure TTrayNotifyIcon.SetIcon(value: TIcon);
{ Write method for Icon property. }
begin
FIcon.Assign(value); // set new icon
{ Change icon on notification tray }
if FIconVisible then SendTrayMessage(NIM_MODIFY, NIF_ICON);
end;
procedure TTrayNotifyIcon.SetIconVisible(value: Boolean);
{ Write method for IconVisible property }
const
{ Flags to add or delete a tray notification icon }
MsgArray: array[Boolean] of DWORD = (NIM_DELETE, NIM_ADD);
begin
if FIconVisible <> value then
begin
FIconVisible := value;
{ Set icon as appropriate }
SendTrayMessage(MsgArray[value], NIF_MESSAGE or NIF_ICON or NIF_TIP);
end;
end;
procedure TTrayNotifyIcon.SetPopupMenu(value: TPopupMenu);
{ Write method for PopupMenu property }
begin
FPopupMenu := value;
if value <> nil then value.FreeNotification(Self);
end;
const
{ String to identify registered window message }
TrayMsgStr = ’DDG.TrayNotifyIconMsg’;
initialization
{ Get a unique windows message ID for tray callback }
DDGM_TRAYICON := RegisterWindowMessage(TrayMsgStr);
IconMgr := TIconManager.Create;
finalization
IconMgr.Free;
end.
================================
25、關(guān)于窗體釋放的問(wèn)題(formX.free)？
答：
這個(gè)我知道,模式窗口用:form2 := TForm2.Create(Application);
try
if form2.showModal = mrOK then
{do Something}
finally
form2.free;
form2 := nil;
end; 非模式窗口用:if not Assigned(form2) then
form2 := Tfrom2.Create(Application);
form2.show;
//然后在form2的Close事件中加入以下句
Action := caFree;
//在from2的Destory事件中加入以下句
form2 := nil; 搞定!!!
================================
26、關(guān)于MDI窗體的問(wèn)題？
答：
我不知道是如何實(shí)現(xiàn),但我知道一個(gè)方法可以實(shí)現(xiàn)同樣的功能,在打開(kāi)子窗體前加一句
button1.SendToBack;
================================
27、小數(shù)點(diǎn)’.’的鍵號(hào)是什么？回車(chē)是#13，’.’是什么？
答：
你可以用此得出所有鍵的值procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
label1.caption:=IntToStr(key);
end;
