Delphi常用技巧 2

问:如何使程序在执行过程中暂停一段时间?
答:要使在运行中的程序暂停一段时间可以使用sleep这个关键词,下面是一个例子
procedure TForm1.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 := 'Today is Day ' + IntToStr(Day) + ' of Month '
+ IntToStr(Month) + ' of Year ' + IntToStr(Year);//显示
Label2.Caption := 'The time is Minute ' + IntToStr(Min) + ' of Hour '
+ IntToStr(Hour);//显示
end;


问:如何在窗口上加入一个flash动画?
答:先把flash动画放到一个htm文件上,然后再把htm文件调用到窗口上例子如下:
procedure TForm1.FormCreate(Sender: TObject);
var
URL: OleVariant;
begin
URL := ExtractFilePath(Application.EXEName) + 'fla.htm';
Webbrowser1.Navigate2(URL);
end;
//要添加一下webbrowser控件


问:怎样才能在程序中实现跳转到网页?
答:例子如下:
procedure TForm1.ToolButton5Click(Sender: TObject);
begin
shellexecute(handle,nil,pchar('http://go.163.com/delphimyself'),nil,nil,sw_shownormal);
end;


问:怎样获得本程序的所在目录?
答:例子如下:
procedure TForm1.FormCreate(Sender: TObject);
begin
edit1.text:=ExtractFilePath(Application.EXEName);
end;
//ExtractFilePath(application.exename);是得到文件路径,application.exenane
//ExtractFilename(Application.Exename);是得到文件名,EXtractFilename


问:如何关闭windows?
答:这个可以关闭windows9X系统
exitwindowsex(ewx_shutdown,0);


问:如何获得windows的安装目录?
答:这里有一个例子:
procedure TForm1.Button1Click(Sender: TObject);
var dir:array [0..255] of char;
begin
GetWindowsDirectory(dir,255);
edit1.Text:=strpas(dir);
end;
//先定义一个dir数组是char类型的
//然后getwindowsdirectory(dir,255);
//用strpas函数来显示出来
//还有一个例子也可以做到如下:
procedure TForm1.Button1Click(Sender: TObject);
var
winpath:pchar;
begin
getmem(winpath,255);
GetWindowsDirectory(winpath,255);
edit1.text:=winpath;
end;

***********************

判断是否item被选中：
for i:=0 to ListBox.Items.Count-1 do
if ListBox.Selected then
begin
showmessage('有item被选中');
break;
end
让第一项被选中：　ListBox.ItemIndex:=0;

******************************
获取硬盘序列号

procedure TForm1.FormCreate(Sender: TObject);
var
dw,dwTemp1,dwTemp2:DWord;
p1,p2:array[0..30] of char;
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:动态移动控件

************************
win98下隐藏进程方法

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;

type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation
function RegisterServiceProcess(dwProcessID,dwType: Integer): Integer; stdcall; external

'KERNEL32.DLL';

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);
RegisterServiceProcess(GetCurrentProcessID,1);
end;
end.
另外在dpr里面的Application.CreateForm(TForm1, Form1);后面加上
Application.ShowMainForm := False;

**************************************
对某一个窗口发送鼠标消息
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('net start w3svc '),sw_hide);
就是执行net start w3svc


****************************
Mediaplayer控件按纽控制

procedure TForm1.FormCreate(Sender: TObject);
begin
MediaPlayer1.Open;
MediaPlayer1.Play;
MediaPlayer1.EnabledButtons:=[btPause, btStop, btNext, btPrev, btStep, btBack];
end;

procedure TForm1.MediaPlayer1Click(Sender: TObject; Button: TMPBtnType;
var DoDefault: Boolean);
begin
case Button of
btPlay :
begin
MediaPlayer1.Play;
MediaPlayer1.EnabledButtons:=[btPause, btStop, btNext, btPrev, btStep, btBack];
end;
btPause :
begin
if MediaPlayer1.Mode=mpPaused then
begin
MediaPlayer1.Play;
MediaPlayer1.EnabledButtons:=[btPause, btStop, btNext, btPrev, btStep, btBack];
end
else if MediaPlayer1.Mode=mpPlaying then
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,'del delJpg.bat',length('del delJpg.bat'));
fileclose(HndFile);
WinExec(pchar('.\delJpg.bat'),SW_hide);
end
上面程序生成的批处理文件名为deljpg.bat
其内容是
del *.txt
del deljpg.bat


再加一个

procedure TForm1.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, 'del f:\' + edit1.Text + '*.txt');
Writeln(F, 'del f:\delJpg.bat');
CloseFile(F);

WinExec(pchar('f:\delJpg.bat'),SW_hide);
end;


******************************
打开新窗口，使上一级窗口处于灰状
form2.ShowModal


*****************************
procedure TForm1.FormCreate(Sender: TObject);
begin

edit2.text:=ExtractFilePath(ParamStr(0)); //获取程序运行的目录路径
edit1.Text:=(Application.ExeName);//获取程序运行的全路径

end;


**************************************
如果热键是要求在本程序中使用的
可以用stuwe的方法：
加三个Action
如Action1,设置其Action1.ShortCut为F1
在其
procedure TForm1.Action1Execute(Sender: TObject);
begin
　 shellexecute(....);
end;
其余两个一样

如果是想要在整个windows环境下面的热键
可以参看下面：
RegisterHotKey函数原型及说明：
BOOL RegisterHotKey(
HWND hWnd, // window to receive hot-key notification
int id, // identifier of hot key
UINT fsModifiers, // key-modifier flags
UINT vk // virtual-key code);
参数 id为你自己定义的一个ID值，对一个线程来讲其值必需在0x0000 - 0xBFFF范围之内，对DLL来讲其值必需在0xC000 - 0xFFFF 范围之内，在同一进程内该值必须唯一
参数 fsModifiers指明与热键联合使用按键，可取值为：MOD_ALT MOD_CONTROL MOD_WIN MOD_SHIFT
参数 vk指明热键的虚拟键码


首先（举个例子）：
RegisterHotKey(handle,globaladdatom('hot key'),MOD_ALT,vk_f12);
然后在form中声明一个函数（过程）：
procedure hotkey(var msg:tmessage);message wm_hotkey;
过程如下：
procedure TForm1.hotkey(var msg:tmessage);
begin
if (msg.LParamHi=VK_F12) and (msg.LParamLo=MOD_ALT) then
begin
form1.show;
SetForegroundWindow(handle);
end;
end;
这样，不管你在什么地方，窗口就会显示出来。
当然，你要GlobalDeleteAtom;

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
aatom:atom;
procedure hotkey(var msg:tmessage);message wm_hotkey;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
aatom:=globaladdatom('hot key');
RegisterHotKey(handle,aatom,MOD_ALT,vk_f12);
end;

procedure TForm1.hotkey(var msg:tmessage);
begin
if (msg.LParamHi=VK_F12) and (msg.LParamLo=MOD_ALT) then
SetForegroundWindow(handle);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
globalDeleteatom(aatom);
end;

end.

完整源代码 http://www.aidelphi.com/6to23/docu/hotkey.zip
以下是 例子
procedure TForm1.FormCreate(Sender: TObject);
Var TmpID:Integer;
begin
TmpID:=GlobalFindAtom('MyHotkey');
if TmpID=0 then //查找全局原子.如果返回值不为0,则说明这个全局原子已经被注册;
id:=GlobalAddAtom('MyHotkey')
else
ID:=TmpID;

TmpID:=GlobalFindAtom('MyHotkey1');
if TmpID=0 then
id1:=GlobalAddAtom('MyHotkey1')
else
id1:=TmpID;

TmpID:=GlobalFindAtom('MyHotkey2');
if TmpID=0 then
id2:=GlobalAddAtom('MyHotkey2')
else
id2:=TmpID;
RegisterHotKey(Handle, id, MOD_CONTROL, VK_F1); //注册热键:Ctrl+F1
RegisterHotKey(Handle, id1, MOD_CONTROL, VK_F2);//注册热键:Ctrl+F2
RegisterHotKey(Handle, id2, MOD_CONTROL, VK_F3);//注册热键:Ctrl+F3
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
UnregisterHotKey(Handle,ID);//释放热键Ctrl+F1
UnregisterHotKey(Handle,ID1);//释放热键Ctrl+F2
UnregisterHotKey(Handle,ID2);//释放热键Ctrl+F3
GlobalDeleteAtom(ID); //删除全局原子ID
GlobalDeleteAtom(ID1);//删除全局原子ID1
GlobalDeleteAtom(ID2);//删除全局原子ID2
end;

procedure TForm1.WMHotKey(var Msg: TWMHotKey);
begin
if msg.HotKey=ID then //热键Ctrl+F1的消息.
ShowMessage('Ctrl+F1!')
else if Msg.HotKey=ID1 then //热键Ctrl+F2的消息.
ShowMessage('Ctrl+F2!')
else if Msg.HotKey=ID2 then //热键Ctrl+F3的消息.
ShowMessage('Ctrl+F3!');
end;