Delphi常用技巧.docx
《Delphi常用技巧.docx》由会员分享，可在线阅读，更多相关《Delphi常用技巧.docx（10页珍藏版）》请在冰点文库上搜索。
Delphi常用技巧
Delphi常用技巧
问:
如何使程序在执行过程中暂停一段时间?
答:
要使在运行中的程序暂停一段时间可以使用sleep这个关键词,下面是一个例子
复制内容到剪贴板
代码:
procedureTForm1.Button1Click（Sender:
TObject）;
var
h,m,s,ms:
word;
begin
Edit1.text:
=DateTimeToStr（now）;
sleep（2000）;//2000就表示2个微秒
edit2.text:
=DateTimeToStr（now）;
DecodeTime（strtodatetime（edit2.text）-strtodatetime（edit1.text）,h,m,s,ms）;
showmessage（format（'小时：
%d',[h]）+format（'分钟：
%d',[m]）+format（'秒：
%d',[s]）+format（'微秒：
%d',[ms]））;
end;
//另外,这也是一个很好的时间相减例子
报告时间的例子:
//先定义:
var
Present:
TDateTime;//定义成日期和时间
begin
Year,Month,Day,Hour,Min,Sec,MSec:
Word;//定义年月日小时分种秒微秒
DecodeTime（Present,Hour,Min,Sec,MSec）;//提出小时分种秒微秒,以TDataTime方式
DecodeDate（Present,Year,Month,Day）;//提出年月日,以TDataTime方式
Label1.Caption:
='TodayisDay'+IntToStr（Day）+'ofMonth'
+IntToStr（Month）+'ofYear'+IntToStr（Year）;//显示
Label2.Caption:
='ThetimeisMinute'+IntToStr（Min）+'ofHour'
+IntToStr（Hour）;//显示
end;
问:
如何在窗口上加入一个flash动画?
答:
先把flash动画放到一个htm文件上,然后再把htm文件调用到窗口上例子如下:
复制内容到剪贴板
代码:
procedureTForm1.FormCreate（Sender:
TObject）;
var
URL:
OleVariant;
begin
URL:
=ExtractFilePath（Application.EXEName）+'fla.htm';
Webbrowser1.Navigate2（URL）;
end;
//要添加一下webbrowser控件
问:
怎样才能在程序中实现跳转到网页?
答:
例子如下:
复制内容到剪贴板
代码:
procedureTForm1.ToolButton5Click（Sender:
TObject）;
begin
shellexecute（handle,nil,pchar（'
end;
问:
怎样获得本程序的所在目录?
答:
例子如下:
复制内容到剪贴板
代码:
procedureTForm1.FormCreate（Sender:
TObject）;
begin
edit1.text:
=ExtractFilePath（Application.EXEName）;
end;
//ExtractFilePath（application.exename）;是得到文件路径,application.exenane
//ExtractFilename（Application.Exename）;是得到文件名,EXtractFilename
[/code]
问:
如何关闭windows?
答:
这个可以关闭windows9X系统
exitwindowsex（ewx_shutdown,0）;
问:
如何获得windows的安装目录?
答:
这里有一个例子:
复制内容到剪贴板
代码:
procedureTForm1.Button1Click（Sender:
TObject）;
vardir:
array[0..255]ofchar;
begin
GetWindowsDirectory（dir,255）;
edit1.Text:
=strpas（dir）;
end;
//先定义一个dir数组是char类型的
//然后getwindowsdirectory（dir,255）;
//用strpas函数来显示出来
//还有一个例子也可以做到如下:
procedureTForm1.Button1Click（Sender:
TObject）;
var
winpath:
pchar;
begin
getmem（winpath,255）;
GetWindowsDirectory（winpath,255）;
edit1.text:
=winpath;
end;
***********************
判断是否item被选中：
复制内容到剪贴板
代码:
fori:
=0toListBox.Items.Count-1do
ifListBox.Selected[i]then
begin
showmessage（'有item被选中'）;
break;
end
让第一项被选中：
ListBox.ItemIndex:
=0;
******************************
获取硬盘序列号
复制内容到剪贴板
代码:
procedureTForm1.FormCreate（Sender:
TObject）;
var
dw,dwTemp1,dwTemp2:
DWord;
p1,p2:
array[0..30]ofchar;
begin
GetVolumeInformation（PChar（'c:
\'）,p1,20,@dw,dwTemp1,dwTemp2,p2,20）;
edit1.text:
=inttohex（dw,8）;//系列号
end;
***************************
在程序中拖动控件
在控件的mousedown中写入：
复制内容到剪贴板
代码:
ReleaseCapture;
SendMessage（Panel1.Handle,WM_SYSCOMMAND,$F012,0）;
另外改变$F012的值会有很多别的功能
$F001:
改变控件的left大小
$F002:
改变控件的right大小
$F003:
改变控件的top大小
$F004:
改变控件的button大小
$F007:
控件左边放大缩小
$F008:
控件右边放大缩小
$F009:
动态移动控件
对某一个窗口发送鼠标消息
SendMessage（Handle,WM_LBUTTONDBLCLK,0,0）;
对系统发消息关闭程序
SendMessage（Handle,WM_CLOSE,0,0）;
启动开始菜单
Sendmessage（Application.Handle,WM_SYSCOMMAND,SC_TASKLIST,0）;
**************************************
对某一个窗口发送鼠标消息
SendMessage（Handle,WM_LBUTTONDBLCLK,0,0）;
对系统发消息关闭程序
SendMessage（Handle,WM_CLOSE,0,0）;
启动开始菜单
Sendmessage（Application.Handle,WM_SYSCOMMAND,SC_TASKLIST,0）;
*****************************
日期时间类操作
showmessage（FormatDateTime（'yyyy',now））;//年
showmessage（FormatDateTime（'mm',now））;//月
showmessage（FormatDateTime（'dd',now））;//日
showmessage（FormatDateTime（'hh',now））;//时
showmessage（FormatDateTime（'nn',now））;//分
showmessage（FormatDateTime（'nn',now））;//秒
showmessage（FormatDateTime（'zzz',now））;//毫秒
*****************************
执行dos命令
winexec（pchar（'netstartw3svc'）,sw_hide）;
就是执行netstartw3svc
****************************
Mediaplayer控件按纽控制
procedureTForm1.FormCreate（Sender:
TObject）;
begin
MediaPlayer1.Open;
MediaPlayer1.Play;
MediaPlayer1.EnabledButtons:
=[btPause,btStop,btNext,btPrev,btStep,btBack];
end;
procedureTForm1.MediaPlayer1Click（Sender:
TObject;Button:
TMPBtnType;
varDoDefault:
Boolean）;
begin
caseButtonof
btPlay:
begin
MediaPlayer1.Play;
MediaPlayer1.EnabledButtons:
=[btPause,btStop,btNext,btPrev,btStep,btBack];
end;
btPause:
begin
ifMediaPlayer1.Mode=mpPausedthen
begin
MediaPlayer1.Play;
MediaPlayer1.EnabledButtons:
=[btPause,btStop,btNext,btPrev,btStep,btBack];
end
elseifMediaPlayer1.Mode=mpPlayingthen
begin
MediaPlayer1.Pause;
MediaPlayer1.EnabledButtons:
=[btPlay,btPause,btStop,btNext,btPrev,btStep,btBack];
end;
end;
btStop:
begin
MediaPlayer1.Stop;
MediaPlayer1.EnabledButtons:
=[btPlay,btNext,btPrev,btStep,btBack];
end;
btNext:
begin
MediaPlayer1.Next;
MediaPlayer1.EnabledButtons:
=[btPlay,btNext,btPrev,btStep,btBack];
end;
btPrev:
begin
MediaPlayer1.Previous;
MediaPlayer1.EnabledButtons:
=[btPlay,btNext,btPrev,btStep,btBack];
end;
btStep:
begin
MediaPlayer1.Step;
MediaPlayer1.EnabledButtons:
=[btPlay,btNext,btPrev,btStep,btBack];
end;
btBack:
begin
MediaPlayer1.Back;
MediaPlayer1.EnabledButtons:
=[btPlay,btNext,btPrev,btStep,btBack];
end;
end;
end;
****************************
动态生成批处理文件
var
HndFile:
Thandle;
begin
HndFile:
=filecreate（'delJpg.bat'）;
filewrite（HndFile,'del*.txt'+#13#10,length（'del*.txt'+#13#10））;
filewrite（HndFile,'deldelJpg.bat',length（'deldelJpg.bat'））;
fileclose（HndFile）;
WinExec（pchar（'.\delJpg.bat'）,SW_hide）;
end
上面程序生成的批处理文件名为deljpg.bat
其内容是
del*.txt
deldeljpg.bat
再加一个
procedureTForm1.Button1Click（Sender:
TObject）;
var
F:
TextFile;
iFileHandle:
integer;
begin
iFileHandle:
=FileCreate（'f:
\delJpg.bat'）;
FileClose（iFileHandle）;
AssignFile（F,'f:
\delJpg.bat'）;
Append（F）;
Writeln（F,'delf:
\'+edit1.Text+'*.txt'）;
Writeln（F,'delf:
\delJpg.bat'）;
CloseFile（F）;
WinExec（pchar（'f:
\delJpg.bat'）,SW_hide）;
end;
******************************
打开新窗口，使上一级窗口处于灰状
form2.ShowModal
*****************************
1、怎样等待程序运行结束
procedureTForm1.Button1Click（Sender:
TObject）;
var
sCommandLine:
string;
bCreateProcess:
boolean;
lpStartupInfo:
TStartupInfo;
lpProcessInformation:
TProcessInformation;
begin
sCommandLine:
='D:
\TEMP\TEST.EXE';
//填StartupInfo
FillChar（lpStartupInfo,Sizeof（TStartupInfo）,#0）;
lpStartupInfo.cb:
=Sizeof（TStartupInfo）;
lpStartupInfo.dwFlags:
=STARTF_USESHOWWINDOW;
lpStartupInfo.wShowWindow:
=SW_NORMAL;
bCreateProcess:
=CreateProcess（nil,PChar（sCommandLine）,
nil,nil,True,CREATE_NEW_CONSOLEorNORMAL_PRIORITY_CLASS,
nil,nil,lpStartupInfo,lpProcessInformation）;
ifbCreateProcessthen //等外部进程的结束
WaitForSingleObject（lpProcessInformation.hProcess,INFINITE）;
end;
2、怎样监视另一个程序的启动和关闭的动作
ProcedureWinExecAndWait（CommandLine:
String）;
varComLineBuffer:
array[0..512]ofchar;
StartupInfo:
TStartupInfo;
ProcessInfo:
TProcessInformation;
Re:
Cardinal;
begin
StrPCopy（ComLineBuffer,CommandLine）;
FillChar（StartupInfo,Sizeof（StartupInfo）,#0）;
StartupInfo.cb:
=Sizeof（StartupInfo）;
StartupInfo.dwFlags:
=STARTF_USESHOWWINDOW;
StartupInfo.wShowWindow:
=SW_HIDE;
ifCreateProcess（nil,
ComLineBuffer, {pointertocommandlinestring}
nil, {pointertoprocesssecurityattributes}
nil, {pointertothreadsecurityattributes}
True, {handleinheritanceflag}
CREATE_NEW_CONSOLEor {creationflags}
NORMAL_PRIORITY_CLASS,
nil, {pointertonewenvironmentblock}
nil, {pointertocurrentdirectoryname,PChar}
StartupInfo, {pointertoSTARTUPINFO}
ProcessInfo）{pointertoPROCESS_INF}
then
begin
WaitforSingleObject（ProcessInfo.hProcess,INFINITE）;
GetExitCodeProcess（ProcessInfo.hProcess,Re）;
CloseHandle（ProcessInfo.hProcess）; {topreventmemoryleaks}
CloseHandle（ProcessInfo.hThread）;
end;
end;
升级会员 